1 | ANRVML ;AUG/JLTP - MAILING LABELS FOR VIST FM SORT ; 28 Apr 98 / 2:09 PM
|
---|
2 | ;;4.0; Visual Impairment Service Team ;;12 Jun 98
|
---|
3 | EN ;------ The print template should call this tag ------
|
---|
4 | N ADD,AD1,AD2,CTY,ST,SN,ZIP
|
---|
5 | D GETADR
|
---|
6 | PRINT ;
|
---|
7 | I $D(NULL),NULL Q
|
---|
8 | W !,DPT01 S LINE=1
|
---|
9 | I $D(AD1),$L(AD1) W !,AD1 S LINE=LINE+1
|
---|
10 | I $D(AD2),$L(AD2) W !,AD2 S LINE=LINE+1
|
---|
11 | I $L(CTY)!$L(ST)!$L(ZIP) W ! S LINE=LINE+1
|
---|
12 | W:$L(CTY) CTY_", " W:$L(ST) ST_" " W:$L(ZIP) ZIP
|
---|
13 | F I=1:1:6-LINE W !
|
---|
14 | QUIT ;
|
---|
15 | K DPT01,LINE,NULL
|
---|
16 | Q
|
---|
17 | GETADR ;
|
---|
18 | S NULL=0,DPT01=$P(^DPT(DFN,0),U),DPT01=$P(DPT01,",",2)_" "_$P(DPT01,",",1)
|
---|
19 | D ADD^VADPT
|
---|
20 | S AD1=VAPA(1),AD2=VAPA(2),CTY=VAPA(4),ZIP=VAPA(6)
|
---|
21 | S ST=+VAPA(5) I ST S ST=$P(^DIC(5,ST,0),"^",2)
|
---|
22 | I ST=0 S ST=""
|
---|
23 | Q
|
---|
24 | TEST ;------ Call this line tag to test label alignment ------
|
---|
25 | 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
|
---|
26 | Q:Y=0
|
---|
27 | 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
|
---|
28 | DEV U IO D TLBL,^%ZISC Q
|
---|
29 | TLBL ;------ Print test label ------
|
---|
30 | S DPT01="JOHN DOE"
|
---|
31 | S AD1="ONE FREEDOM WAY"
|
---|
32 | S AD2="APT C-13"
|
---|
33 | S CTY="MUSKOGEE"
|
---|
34 | S ST="OK"
|
---|
35 | S ZIP=79285
|
---|
36 | D PRINT
|
---|
37 | EXIT K AD1,AD2,CTY,DPT01,DTOUT,DUOUT,DIRUT,DIROUT,LINE,ST,ZIP Q
|
---|