source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVML.m@ 1663

Last change on this file since 1663 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1ANRVML ;AUG/JLTP - MAILING LABELS FOR VIST FM SORT ; 28 Apr 98 / 2:09 PM
2 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
3EN ;------ The print template should call this tag ------
4 N ADD,AD1,AD2,CTY,ST,SN,ZIP
5 D GETADR
6PRINT ;
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 !
14QUIT ;
15 K DPT01,LINE,NULL
16 Q
17GETADR ;
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
24TEST ;------ 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
28DEV U IO D TLBL,^%ZISC Q
29TLBL ;------ 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
37EXIT K AD1,AD2,CTY,DPT01,DTOUT,DUOUT,DIRUT,DIROUT,LINE,ST,ZIP Q
Note: See TracBrowser for help on using the repository browser.