| 1 | ABSVLBL3 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE ;1/11/01 10:18 AM
|
---|
| 2 | V ;;4.0;VOLUNTARY SERVICE;**23**;JULY 6, 1994
|
---|
| 3 | ;PRINT MULTI COLUMN LABEL
|
---|
| 4 | VOL() 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
|
---|
| 10 | DIR() 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
|
---|
| 16 | 1 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
|
---|
| 20 | 2 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
|
---|
| 24 | 3 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
|
---|
| 28 | 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
|
---|
| 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
|
---|
| 35 | 5 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
|
---|
| 42 | 6 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
|
---|
| 49 | 7 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
|
---|
| 53 | 8 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
|
---|
| 67 | 20 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
|
---|
| 71 | 21 ;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
|
---|
| 77 | 22 ;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
|
---|
| 83 | 23 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
|
---|
| 90 | 24 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
|
---|
| 93 | 25 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
|
---|
| 96 | 31 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
|
---|
| 102 | 32 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
|
---|
| 108 | 33 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
|
---|
| 116 | 34 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
|
---|
| 119 | NO S X="No Selection Made, Option Terminating!*" D MSG^ABSVQ
|
---|
| 120 | QUIT
|
---|