AHHLBL  ;NCH/RLP   Patient Mailing Labels - Excel delimited   12-Feb-02
        ;;V1.0
        ;
        ; *** This routine can be called by FM - Print File Entries
        ; *** example PRINT FIELD: W $$BEG^AHHLBL(D0)
        ;
        ; *** NOTE: kill the variable PRTHEAD before you call BEG(DFN).
        ; *** If you don't, the second run will not print the Header for
        ; *** the columns.
        ;
BEG(DFN)        ;
        I $G(DFN)'>0 Q ""
        ;
        N XUNAME,NAME,ADD1,ADD2,ADD3,CITY,STATE,STATEABB,ZIP,SEX,COURTESY
        N RECSTAT,LABEL,IEN,FMLNAME,LGTHNAME,LASTNAME,LGTHCNME,ADDLINE,FIELD
        N CHARCTER,NUMBER
        ;
        ;
        ; --- If var PRTHEAD equal to 0, Heading will NOT Print ---
        ; --- If var PRTHEAD equal to 1, Heading Will Print ---
        ; --- If var PRTHEAD is not present, Heading will Print ---
        ;
HEAD    S PRTHEAD=$G(PRTHEAD,1)
        I PRTHEAD D  W LABEL,! S PRTHEAD=0
        . S LABEL="DFN^"_"Mr/s^"_"Last Name^"_"Full Name^"_"Add1^"_"Add2^"_"Add3
^"_"City^"_"State^"_"StateAbb^"_"Zip^"_"NameLgth^"_"NameLgth Mr/s^"_"Status^"
        ;
        S IEN=DFN_"^"
        S RECSTAT=""
        ;
        ;
        ; --- Format Name, First Middle Last Prefix, Upper/Lower case ---
        ;
E1      S XUNAME("FILE")=2,XUNAME("FIELD")=.01,XUNAME("IENS")=DFN
        S NAME=$$NAMEFMT^XLFNAME1(.XUNAME,"G","M")
        S FMLNAME=NAME_"^"
        S LGTHNAME=($L(NAME)-1)_"^"
        ;
        ;
        ; --- Extract Last Name and Gender ---
        ;
E2      D DEM^VADPT
        S LASTNAME=$P(VADM(1),",",1)_"^"
        S SEX=$P(VADM(5),"^",1)
        S COURTESY=$S(SEX="M":"Mr.",SEX="F":"Ms.",1:"")_"^"
        S LGTHCNME=$L(COURTESY)+LGTHNAME_"^"
        ;
        ;
        ; --- Extract Address fields and make upper/lower case ---
        ; --- Flag record if No State Abbreviation ---
        ;
E3      D ADD^VADPT
        S ADD1=$$MIX^XLFNAME1(VAPA(1))_"^"
        S ADD2=$$MIX^XLFNAME1(VAPA(2))_"^"
        S ADD3=$$MIX^XLFNAME1(VAPA(3))_"^"
        S CITY=$$MIX^XLFNAME1(VAPA(4))_"^"
        S STATE=$P(VAPA(5),"^",2),STATE=$$MIX^XLFNAME1(STATE)_"^"
        S STATEABB=$P(VAPA(5),"^",1) D  S STATEABB=STATEABB_"^"
        . I STATEABB]"" S STATEABB=$P($G(^DIC(5,STATEABB,0)),"^",2)
        . E  S RECSTAT="REVIEW^"
        S ZIP=$P(VAPA(6),"^",1)_"^"
        ;
        ;
        ; --- Lets check the integrity of the Address ---
        ; --- Flag record if there is No data in the Address Fields ---
        ;
INTEG   F FIELD=FMLNAME,ADD1,CITY,STATE,ZIP Q:RECSTAT]""  D  ;
        . I $P(FIELD,"^",1)']"" S RECSTAT="REVIEW^"
        ;
        ;
        ; --- Flag record if 1st Address Line does not have a Number in it ---
        ;
        I RECSTAT']"" S NUMBER=0 D  I 'NUMBER S RECSTAT="REVIEW^"
        . F CHARCTER=1:1:$L(ADD1) Q:NUMBER  D  ;
        . . I "0123456789"[$E(ADD1,CHARCTER) S NUMBER=1
        ;
        ;
        ; --- Flag record if NC VAMC is the address ---
        ;
        F ADDLINE=1:1:3 Q:RECSTAT]""  I VAPA(ADDLINE)]"" D  ;
        . I "3001 GREEN BAY"[$$UP^XLFSTR(VAPA(ADDLINE)) S RECSTAT="REVIEW^"
        . I "3001 GREENBAY"[$$UP^XLFSTR(VAPA(ADDLINE)) S RECSTAT="REVIEW^"
        . ;I "UPDATE"[$$UP^XLFSTR(VAPA(ADDLINE)) S RECSTAT="REVIEW^"
        ;
PRT     S LABEL=IEN_COURTESY_LASTNAME_FMLNAME_ADD1_ADD2_ADD3_CITY_STATE_STATEABB
_ZIP_LGTHNAME_LGTHCNME_RECSTAT
        ;
        K VADM,VAPA
        Q LABEL
        ;
        ;
        ;
        ; --- Excute this Line Tag to get 'a feel' of the data layout ---
        ;
TEST    D ^%ZIS U IO K PRTHEAD S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:DFN>100  W !,$$B
EG(DFN)
        D ^%ZISC
        Q