DGPWPOST ;ALB/CM POST INIT FOR WRISTBAND ; 12/4/95
;;5.3;Registration;**62**;Aug 13, 1993
;
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPWPOST 2191 printed Apr 09, 2024@21:43:02 Page 2
DGPWPOST ;ALB/CM POST INIT FOR WRISTBAND ; 12/4/95
+1 ;;5.3;Registration;**62**;Aug 13, 1993
+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
