DGPWPOST.m

DGPWPOST ;ALB/CM POST INIT FOR WRISTBAND ; 12/4/95

 ;;5.3;Registration;**62,1015**;Aug 13, 1993;Build 21

 ;

 ;This post init will add the Wristband entry to the EMBOSSED CARD

 ;TYPE file #39.1.  The entry is added via the post init due to the

 ;pointer values that are included in the entry, they could be different

 ;values from site to site.

 ;

EN ;

 ;Add WRISTBAND entry to the file

 W !!,"Post Init...."

 S DIC="^DIC(39.1,",DIC(0)="LZM",DLAYGO=39.1,X="WRISTBAND"

 D ^DIC

 K DIC,DLAYGO,X

 I +Y<0 W !,"Unable to add WRISTBAND entry to file 39.1",!,"Contact your IRMFO for assistance.",! Q

 I $P(Y,U,3)'=1 W !,"An entry already exists for WRISTBAND in EMBOSSED CARD file (#39.1)." Q

 N ENTRY

 S ENTRY=+Y

 W !,"Adding WRISTBAND entry to EMBOSSED CARD TYPE file (#39.1)...",!

 ;

 ;look up data items in Embossing Data file #39.2 to be added to the

 ;WRISTBAND entry

 ;

 N WARD,PID,BIRTH,BLANK,ALL,REL,NAME

 ;

 F X="WARD LOCATION","PID","NAME","DOB","RELIGION","BLANK","ALLERGY" D

 .S DIC="^DIC(39.2,",DIC(0)="ZMOX",DLAYGO=39.2

 .D ^DIC

 .I +Y<0 W !,"Unable to find "_X_" in file 39.2.",!,"Contact your IRMFO for assistance.",! Q

 .I X="WARD LOCATION" S WARD=+Y

 .I X="PID" S PID=+Y

 .I X="NAME" S NAME=+Y

 .I X="DOB" S BIRTH=+Y

 .I X="RELIGION" S REL=+Y

 .I X="BLANK" S BLANK=+Y

 .I X="ALLERGY" S ALL=+Y

 .K Y,X,DIC

 ;

 ;Hard set the global entry

 ;

 S ^DIC(39.1,ENTRY,0)="WRISTBAND^^^1^^"_ENTRY

 S ^DIC(39.1,ENTRY,1,0)="^39.11^^4"

 S ^DIC(39.1,ENTRY,1,1,0)=1

 S ^DIC(39.1,ENTRY,1,1,1,0)="^39.12P^2^2"

 S ^DIC(39.1,ENTRY,1,1,1,1,0)=NAME_"^1^30"

 S ^DIC(39.1,ENTRY,1,1,1,2,0)=WARD_"^32^30"

 S ^DIC(39.1,ENTRY,1,2,0)=2

 S ^DIC(39.1,ENTRY,1,2,1,0)="^39.12P^3^3"

 S ^DIC(39.1,ENTRY,1,2,1,1,0)=PID_"^1^14"

 S ^DIC(39.1,ENTRY,1,2,1,2,0)=BIRTH_"^17^12"

 S ^DIC(39.1,ENTRY,1,2,1,3,0)=REL_"^35^2"

 S ^DIC(39.1,ENTRY,1,3,0)=3

 S ^DIC(39.1,ENTRY,1,3,1,0)="^39.12P^1^1"

 S ^DIC(39.1,ENTRY,1,3,1,1,0)=BLANK_"^1"

 S ^DIC(39.1,ENTRY,1,4,0)=4

 S ^DIC(39.1,ENTRY,1,4,1,0)="^39.12P^1^1"

 S ^DIC(39.1,ENTRY,1,4,1,1,0)=ALL_"^1^40"

 ;

 ;Re-index "C" cross reference

 S DIK="^DIC(39.1,",DA=ENTRY,DIK(1)="5^C"

 D EN^DIK

 K DIK,DA

 ;

 W !,"Post Init completed."

 Q

DGPWPOST  ;ALB/CM POST INIT FOR WRISTBAND ; 12/4/95

 +1       ;;5.3;Registration;**62,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ;This post init will add the Wristband entry to the EMBOSSED CARD

 +4       ;TYPE file #39.1.  The entry is added via the post init due to the

 +5       ;pointer values that are included in the entry, they could be different

 +6       ;values from site to site.

 +7       ;

EN        ;

 +1       ;Add WRISTBAND entry to the file

 +2        WRITE !!,"Post Init...."

 +3        SET DIC="^DIC(39.1,"

           SET DIC(0)="LZM"

           SET DLAYGO=39.1

           SET X="WRISTBAND"

 +4        DO ^DIC

 +5        KILL DIC,DLAYGO,X

 +6        IF +Y<0

               WRITE !,"Unable to add WRISTBAND entry to file 39.1",!,"Contact your IRMFO for assistance.",!

               QUIT 

 +7        IF $PIECE(Y,U,3)'=1

               WRITE !,"An entry already exists for WRISTBAND in EMBOSSED CARD file (#39.1)."

               QUIT 

 +8        NEW ENTRY

 +9        SET ENTRY=+Y

 +10       WRITE !,"Adding WRISTBAND entry to EMBOSSED CARD TYPE file (#39.1)...",!

 +11      ;

 +12      ;look up data items in Embossing Data file #39.2 to be added to the

 +13      ;WRISTBAND entry

 +14      ;

 +15       NEW WARD,PID,BIRTH,BLANK,ALL,REL,NAME

 +16      ;

 +17       FOR X="WARD LOCATION","PID","NAME","DOB","RELIGION","BLANK","ALLERGY"

               Begin DoDot:1

 +18               SET DIC="^DIC(39.2,"

                   SET DIC(0)="ZMOX"

                   SET DLAYGO=39.2

 +19               DO ^DIC

 +20               IF +Y<0

                       WRITE !,"Unable to find "_X_" in file 39.2.",!,"Contact your IRMFO for assistance.",!

                       QUIT 

 +21               IF X="WARD LOCATION"

                       SET WARD=+Y

 +22               IF X="PID"

                       SET PID=+Y

 +23               IF X="NAME"

                       SET NAME=+Y

 +24               IF X="DOB"

                       SET BIRTH=+Y

 +25               IF X="RELIGION"

                       SET REL=+Y

 +26               IF X="BLANK"

                       SET BLANK=+Y

 +27               IF X="ALLERGY"

                       SET ALL=+Y

 +28               KILL Y,X,DIC

               End DoDot:1

 +29      ;

 +30      ;Hard set the global entry

 +31      ;

 +32       SET ^DIC(39.1,ENTRY,0)="WRISTBAND^^^1^^"_ENTRY

 +33       SET ^DIC(39.1,ENTRY,1,0)="^39.11^^4"

 +34       SET ^DIC(39.1,ENTRY,1,1,0)=1

 +35       SET ^DIC(39.1,ENTRY,1,1,1,0)="^39.12P^2^2"

 +36       SET ^DIC(39.1,ENTRY,1,1,1,1,0)=NAME_"^1^30"

 +37       SET ^DIC(39.1,ENTRY,1,1,1,2,0)=WARD_"^32^30"

 +38       SET ^DIC(39.1,ENTRY,1,2,0)=2

 +39       SET ^DIC(39.1,ENTRY,1,2,1,0)="^39.12P^3^3"

 +40       SET ^DIC(39.1,ENTRY,1,2,1,1,0)=PID_"^1^14"

 +41       SET ^DIC(39.1,ENTRY,1,2,1,2,0)=BIRTH_"^17^12"

 +42       SET ^DIC(39.1,ENTRY,1,2,1,3,0)=REL_"^35^2"

 +43       SET ^DIC(39.1,ENTRY,1,3,0)=3

 +44       SET ^DIC(39.1,ENTRY,1,3,1,0)="^39.12P^1^1"

 +45       SET ^DIC(39.1,ENTRY,1,3,1,1,0)=BLANK_"^1"

 +46       SET ^DIC(39.1,ENTRY,1,4,0)=4

 +47       SET ^DIC(39.1,ENTRY,1,4,1,0)="^39.12P^1^1"

 +48       SET ^DIC(39.1,ENTRY,1,4,1,1,0)=ALL_"^1^40"

 +49      ;

 +50      ;Re-index "C" cross reference

 +51       SET DIK="^DIC(39.1,"

           SET DA=ENTRY

           SET DIK(1)="5^C"

 +52       DO EN^DIK

 +53       KILL DIK,DA

 +54      ;

 +55       WRITE !,"Post Init completed."

 +56       QUIT