source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVLBL3.m@ 789

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1ABSVLBL3 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE ;1/11/01 10:18 AM
2V ;;4.0;VOLUNTARY SERVICE;**23**;JULY 6, 1994
3 ;PRINT MULTI COLUMN LABEL
4VOL() N DIR
5 S DIR(0)="SO^1:VOLUNTEER NAME;2:ZIP CODE;3:AGE;4:BIRTH MONTH;5:ORGANIZATION;6:SERVICE;7:VAVS REPS;8:RANDOM/SINGLE"
6 S DIR("A")="Sort Labels By",DIR("?")="^D SETOFCDS^ABSVU2" D ^DIR
7 K DIR
8 I $$DIR^ABSVU2 QUIT 0
9 QUIT +Y
10DIR() N DIR
11 S DIR(0)="SO^1:FACILITY;2:STATE;3:VISN;4:ALL"
12 S DIR("A")="Sort Labels By",DIR("?")="^D SETOFCDS^ABSVU2" D ^DIR
13 K DIR
14 I $$DIR^ABSVU2 QUIT 0
15 QUIT +Y+30
161 S DIC=503330,L=0,FLDS="",BY=.01
17 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
18 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
19 QUIT
202 S BY="34;.01",FR="?",TO="?",DIC=503330,L=0,FLDS=""
21 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
22 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
23 QUIT
243 S DIC=503330,L=0,FLDS="",BY="[ABSV AGE]",FR="?",TO="?"
25 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
26 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
27 QUIT
284 S DIR(0)="SA^1:JAN;2:FEB;3:MAR;4:APR;5:MAY;6:JUN;7:JUL;8:AUG;9:SEP;10:OCT;11:NOV;12:DEC",DIR("?")="^D SETOFCDS^ABSVU2",DIR("A")="Select MONTH: " D ^DIR
29 K DIR
30 I $$DIR^ABSVU2 K BY,FR,TO D NO QUIT
31 S DIC=503330,L=0,FLDS="",BY="[ABSV BIRTH MONTH]",FR=+Y,TO=+Y
32 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
33 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
34 QUIT
355 N X,Y
36 S DIC=503334,DIC(0)="AEMNQ",DIC("A")="Select ORGANIZATION CODE: " D ^DIC
37 I Y<0 D NO QUIT
38 S DIC=503330,L=0,FLDS="",FR=+Y_","_ABSV("SITE"),TO=FR,BY="[ABSV ORG LABEL]"
39 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
40 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
41 QUIT
426 N X,Y
43 S DIC=503332,DIC(0)="AEMNZQ",DIC("A")="Select SERVICE CODE: "
44 D ^DIC I Y<0 D NO QUIT
45 S DIC=503330,L=0,FLDS="",(FR,TO)=+Y_","_ABSV("SITE"),BY="[ABSV SERVICE LABEL]"
46 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
47 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
48 QUIT
497 S DIC=503330,L=0,FLDS="",BY=.01
50 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""_",$$REP^ABSVU2(D0,"_""""_ABSV("SITE")_""""_")"
51 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
52 QUIT
538 K ^TMP("VLABEL")
54 N COUNT
55 F COUNT=0:1 D Q:Y<0
56 . S DIC=503330,DIC(0)="AQEMNZ"
57 . S DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST"")))"
58 . S:'$D(DIC("A")) DIC("A")="Select First Volunteer: "
59 . W ! D MDIV^ABSVSITE,^DIC Q:Y<0
60 . S ^TMP("VLABEL",$P(Y,"^",2),+Y)=""
61 . S DIC("A")="Select Next Volunteer: "
62 . QUIT
63 I $D(DUOUT)!('$D(^TMP("VLABEL"))) D NO QUIT
64 S FLDS="",DIC=503330,BY(0)="^TMP(""VLABEL"",",L(0)=2,L=0
65 S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
66 QUIT
6720 S BY="[ABSV MINUTES]",FR="",L=0,DIC="^ABS(503334.1,",FLDS=""
68 S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
69 S LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
70 QUIT
7121 ;ASK ORG
72 S DIC=503334,DIC(0)="AMENZ",DIC("A")="Select Certifying Official for Organization: " D ^DIC
73 I 'Y D NO QUIT
74 S DIS(0)="I 1"
75 S (FR,TO)=+Y,BY="[ABSV CERTIFYING LABEL]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
76 QUIT
7722 ;ASK ORG
78 S DIC=503334,DIC(0)="AMENZ",DIC("A")="Select National Rep for Organization: " D ^DIC
79 I 'Y D NO QUIT
80 S DIS(0)="I 1"
81 S (FR,TO)=+Y,BY="[ABSV NATIONAL REP LABEL]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
82 QUIT
8323 S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
84 S DIR(0)="SA^1:JAN;2:FEB;3:MAR;4:APR;5:MAY;6:JUN;7:JUL;8:AUG;9:SEP;10:OCT;11:NOV;12:DEC",DIR("?")="^D SETOFCDS^ABSVU2",DIR("A")="Select MONTH: " D ^DIR
85 K DIR
86 I $$DIR^ABSVU2 K BY,FR,TO D NO QUIT
87 S BY="[ABSV AJR LABELS]",(FR,TO)=+Y,L=0,DIC="^ABS(503334.1,",FLDS=""
88 S LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
89 QUIT
9024 S DIS(0)="I 1"
91 S BY="[ABSV ALL REPRESENTATIVES]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
92 QUIT
9325 S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
94 S BY="[ABSV ALL REPRESENTATIVES]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
95 QUIT
9631 K DIC
97 S DIC=503339.2,DIC(0)="AEMNZQ",DIC("A")="Select Primary Station Number: " D ^DIC
98 I Y<0 D NO QUIT
99 S BY=.01,(FR,TO)=$P(Y,"^",2),FLDS="",L=0,DIC=503339.2
100 S LABELDR="3;4;4.5;22",LABELDIC=DIC
101 QUIT
10232 K DIC
103 S DIC=5,DIC(0)="AEMNZQ" D ^DIC
104 I Y<0 D NO QUIT
105 S DIC=503339.2,L=0,FLDS="",BY=6,(FR,TO)=$P(Y,"^",2)
106 S LABELDR="3;4;4.5;22",LABELDIC=DIC
107 QUIT
10833 K DIR
109 S DIR(0)="NA^1:22:0",DIR("A")="Select VISN Number: "
110 D ^DIR
111 K DIR
112 I $$DIR^ABSVU2 QUIT
113 S DIC=503339.2,L=0,FLDS="",BY=2,(FR,TO)=+Y
114 S LABELDR="3;4;4.5;22",LABELDIC=DIC
115 QUIT
11634 S DIC=503339.2,L=0,FLDS="",BY=1,FR="A",TO="ZZZ"
117 S LABELDR="3;4;4.5;22",LABELDIC=DIC
118 QUIT
119NO S X="No Selection Made, Option Terminating!*" D MSG^ABSVQ
120 QUIT
Note: See TracBrowser for help on using the repository browser.