ANRVML ;AUG/JLTP - MAILING LABELS FOR VIST FM SORT ; 28 Apr 98 / 2:09 PM
;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN ;------ The print template should call this tag ------
N ADD,AD1,AD2,CTY,ST,SN,ZIP
D GETADR
PRINT ;
I $D(NULL),NULL Q
W !,DPT01 S LINE=1
I $D(AD1),$L(AD1) W !,AD1 S LINE=LINE+1
I $D(AD2),$L(AD2) W !,AD2 S LINE=LINE+1
I $L(CTY)!$L(ST)!$L(ZIP) W ! S LINE=LINE+1
W:$L(CTY) CTY_", " W:$L(ST) ST_" " W:$L(ZIP) ZIP
F I=1:1:6-LINE W !
QUIT ;
K DPT01,LINE,NULL
Q
GETADR ;
S NULL=0,DPT01=$P(^DPT(DFN,0),U),DPT01=$P(DPT01,",",2)_" "_$P(DPT01,",",1)
D ADD^VADPT
S AD1=VAPA(1),AD2=VAPA(2),CTY=VAPA(4),ZIP=VAPA(6)
S ST=+VAPA(5) I ST S ST=$P(^DIC(5,ST,0),"^",2)
I ST=0 S ST=""
Q
TEST ;------ Call this line tag to test label alignment ------
K DIR S DIR(0)="Y^A",DIR("A")="Do you want to test label alignment",DIR("B")="YES" D ^DIR G:$D(DUOUT)!$D(DTOUT) EXIT
Q:Y=0
S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DEV^ANRVML",ZTDESC="PRINT TEST LABEL",ZTDTH=$H D ^%ZTLOAD Q
DEV U IO D TLBL,^%ZISC Q
TLBL ;------ Print test label ------
S DPT01="JOHN DOE"
S AD1="ONE FREEDOM WAY"
S AD2="APT C-13"
S CTY="MUSKOGEE"
S ST="OK"
S ZIP=79285
D PRINT
EXIT K AD1,AD2,CTY,DPT01,DTOUT,DUOUT,DIRUT,DIROUT,LINE,ST,ZIP Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVML 1295 printed Oct 16, 2024@18:46 Page 2
ANRVML ;AUG/JLTP - MAILING LABELS FOR VIST FM SORT ; 28 Apr 98 / 2:09 PM
+1 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN ;------ The print template should call this tag ------
+1 NEW ADD,AD1,AD2,CTY,ST,SN,ZIP
+2 DO GETADR
PRINT ;
+1 IF $DATA(NULL)
IF NULL
QUIT
+2 WRITE !,DPT01
SET LINE=1
+3 IF $DATA(AD1)
IF $LENGTH(AD1)
WRITE !,AD1
SET LINE=LINE+1
+4 IF $DATA(AD2)
IF $LENGTH(AD2)
WRITE !,AD2
SET LINE=LINE+1
+5 IF $LENGTH(CTY)!$LENGTH(ST)!$LENGTH(ZIP)
WRITE !
SET LINE=LINE+1
+6 if $LENGTH(CTY)
WRITE CTY_", "
if $LENGTH(ST)
WRITE ST_" "
if $LENGTH(ZIP)
WRITE ZIP
+7 FOR I=1:1:6-LINE
WRITE !
QUIT ;
+1 KILL DPT01,LINE,NULL
+2 QUIT
GETADR ;
+1 SET NULL=0
SET DPT01=$PIECE(^DPT(DFN,0),U)
SET DPT01=$PIECE(DPT01,",",2)_" "_$PIECE(DPT01,",",1)
+2 DO ADD^VADPT
+3 SET AD1=VAPA(1)
SET AD2=VAPA(2)
SET CTY=VAPA(4)
SET ZIP=VAPA(6)
+4 SET ST=+VAPA(5)
IF ST
SET ST=$PIECE(^DIC(5,ST,0),"^",2)
+5 IF ST=0
SET ST=""
+6 QUIT
TEST ;------ Call this line tag to test label alignment ------
+1 KILL DIR
SET DIR(0)="Y^A"
SET DIR("A")="Do you want to test label alignment"
SET DIR("B")="YES"
DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+2 if Y=0
QUIT
+3 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DEV^ANRVML"
SET ZTDESC="PRINT TEST LABEL"
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
QUIT
DEV USE IO
DO TLBL
DO ^%ZISC
QUIT
TLBL ;------ Print test label ------
+1 SET DPT01="JOHN DOE"
+2 SET AD1="ONE FREEDOM WAY"
+3 SET AD2="APT C-13"
+4 SET CTY="MUSKOGEE"
+5 SET ST="OK"
+6 SET ZIP=79285
+7 DO PRINT
EXIT KILL AD1,AD2,CTY,DPT01,DTOUT,DUOUT,DIRUT,DIROUT,LINE,ST,ZIP
QUIT
