121 lines
4.9 KiB
Mathematica
121 lines
4.9 KiB
Mathematica
ABSVLBL3 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE ;1/11/01 10:18 AM
|
|
V ;;4.0;VOLUNTARY SERVICE;**23**;JULY 6, 1994
|
|
;PRINT MULTI COLUMN LABEL
|
|
VOL() N DIR
|
|
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"
|
|
S DIR("A")="Sort Labels By",DIR("?")="^D SETOFCDS^ABSVU2" D ^DIR
|
|
K DIR
|
|
I $$DIR^ABSVU2 QUIT 0
|
|
QUIT +Y
|
|
DIR() N DIR
|
|
S DIR(0)="SO^1:FACILITY;2:STATE;3:VISN;4:ALL"
|
|
S DIR("A")="Sort Labels By",DIR("?")="^D SETOFCDS^ABSVU2" D ^DIR
|
|
K DIR
|
|
I $$DIR^ABSVU2 QUIT 0
|
|
QUIT +Y+30
|
|
1 S DIC=503330,L=0,FLDS="",BY=.01
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
2 S BY="34;.01",FR="?",TO="?",DIC=503330,L=0,FLDS=""
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
3 S DIC=503330,L=0,FLDS="",BY="[ABSV AGE]",FR="?",TO="?"
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
4 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
|
|
K DIR
|
|
I $$DIR^ABSVU2 K BY,FR,TO D NO QUIT
|
|
S DIC=503330,L=0,FLDS="",BY="[ABSV BIRTH MONTH]",FR=+Y,TO=+Y
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
5 N X,Y
|
|
S DIC=503334,DIC(0)="AEMNQ",DIC("A")="Select ORGANIZATION CODE: " D ^DIC
|
|
I Y<0 D NO QUIT
|
|
S DIC=503330,L=0,FLDS="",FR=+Y_","_ABSV("SITE"),TO=FR,BY="[ABSV ORG LABEL]"
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
6 N X,Y
|
|
S DIC=503332,DIC(0)="AEMNZQ",DIC("A")="Select SERVICE CODE: "
|
|
D ^DIC I Y<0 D NO QUIT
|
|
S DIC=503330,L=0,FLDS="",(FR,TO)=+Y_","_ABSV("SITE"),BY="[ABSV SERVICE LABEL]"
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
7 S DIC=503330,L=0,FLDS="",BY=.01
|
|
S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_"))>9,$P(^("_ABSV("INST")_",0),U,8)="""""_",$$REP^ABSVU2(D0,"_""""_ABSV("SITE")_""""_")"
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
8 K ^TMP("VLABEL")
|
|
N COUNT
|
|
F COUNT=0:1 D Q:Y<0
|
|
. S DIC=503330,DIC(0)="AQEMNZ"
|
|
. S DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST"")))"
|
|
. S:'$D(DIC("A")) DIC("A")="Select First Volunteer: "
|
|
. W ! D MDIV^ABSVSITE,^DIC Q:Y<0
|
|
. S ^TMP("VLABEL",$P(Y,"^",2),+Y)=""
|
|
. S DIC("A")="Select Next Volunteer: "
|
|
. QUIT
|
|
I $D(DUOUT)!('$D(^TMP("VLABEL"))) D NO QUIT
|
|
S FLDS="",DIC=503330,BY(0)="^TMP(""VLABEL"",",L(0)=2,L=0
|
|
S LABELDR=".6;2;2.5;5.5",LABELDIC=503330
|
|
QUIT
|
|
20 S BY="[ABSV MINUTES]",FR="",L=0,DIC="^ABS(503334.1,",FLDS=""
|
|
S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
|
|
S LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
|
|
QUIT
|
|
21 ;ASK ORG
|
|
S DIC=503334,DIC(0)="AMENZ",DIC("A")="Select Certifying Official for Organization: " D ^DIC
|
|
I 'Y D NO QUIT
|
|
S DIS(0)="I 1"
|
|
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
|
|
QUIT
|
|
22 ;ASK ORG
|
|
S DIC=503334,DIC(0)="AMENZ",DIC("A")="Select National Rep for Organization: " D ^DIC
|
|
I 'Y D NO QUIT
|
|
S DIS(0)="I 1"
|
|
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
|
|
QUIT
|
|
23 S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
|
|
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
|
|
K DIR
|
|
I $$DIR^ABSVU2 K BY,FR,TO D NO QUIT
|
|
S BY="[ABSV AJR LABELS]",(FR,TO)=+Y,L=0,DIC="^ABS(503334.1,",FLDS=""
|
|
S LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
|
|
QUIT
|
|
24 S DIS(0)="I 1"
|
|
S BY="[ABSV ALL REPRESENTATIVES]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
|
|
QUIT
|
|
25 S DIS(0)="I $$AFFIL^ABSVLBL1(D0,"_ABSV("INST")_","_""""_ABSV("SITE")_""""_")"
|
|
S BY="[ABSV ALL REPRESENTATIVES]",DIC="^ABS(503334.1,",FLDS="",LABELDR="2.5;2;.6;3;4;3.6",LABELDIC=503334.1
|
|
QUIT
|
|
31 K DIC
|
|
S DIC=503339.2,DIC(0)="AEMNZQ",DIC("A")="Select Primary Station Number: " D ^DIC
|
|
I Y<0 D NO QUIT
|
|
S BY=.01,(FR,TO)=$P(Y,"^",2),FLDS="",L=0,DIC=503339.2
|
|
S LABELDR="3;4;4.5;22",LABELDIC=DIC
|
|
QUIT
|
|
32 K DIC
|
|
S DIC=5,DIC(0)="AEMNZQ" D ^DIC
|
|
I Y<0 D NO QUIT
|
|
S DIC=503339.2,L=0,FLDS="",BY=6,(FR,TO)=$P(Y,"^",2)
|
|
S LABELDR="3;4;4.5;22",LABELDIC=DIC
|
|
QUIT
|
|
33 K DIR
|
|
S DIR(0)="NA^1:22:0",DIR("A")="Select VISN Number: "
|
|
D ^DIR
|
|
K DIR
|
|
I $$DIR^ABSVU2 QUIT
|
|
S DIC=503339.2,L=0,FLDS="",BY=2,(FR,TO)=+Y
|
|
S LABELDR="3;4;4.5;22",LABELDIC=DIC
|
|
QUIT
|
|
34 S DIC=503339.2,L=0,FLDS="",BY=1,FR="A",TO="ZZZ"
|
|
S LABELDR="3;4;4.5;22",LABELDIC=DIC
|
|
QUIT
|
|
NO S X="No Selection Made, Option Terminating!*" D MSG^ABSVQ
|
|
QUIT
|