DG5382PT ; ALBANY/GTS - DG*5.3*82 POST INIT; 1/30/96-11:45AM
;;5.3;Registration;**82**;Jan 30, 1996
;
MAIN ;
D SETWARD ;** Correct the WARD LOCATION entry in file 39.2
D SETCARD ;** Change the layout of the WRISTBAND entry in file 39.1
D:XPDQUES("POS1 QUESTION") SETTERM ;** Set Term Type file (#3.2) entry
Q
;
SETWARD ;** Change the mumps code for the WARD LOCATION lookup
N DGWLDA,CODE
S CODE="S Y="""" I $G(^DPT(DFN,.1))]"""" S Y=$O(^DIC(42,""B"",$G(^DPT(DFN,.1)),0)) S Y=$S($P($G(^DIC(42,+Y,0)),U,4)=""N"":"""",1:$P($G(^DIC(42,+Y,0)),U))"
S DIC="^DIC(39.2,",DIC(0)="M",X="WARD LOCATION"
D ^DIC
S DGWLDA=+Y
K DIC,X,Y
I DGWLDA DO
.S DIE="^DIC(39.2,",DA=DGWLDA
.S DR="1///^S X=CODE"
.D ^DIE
.K DIE,DA,DR
Q
;
SETCARD ;** Change the layout of the WRISTAND in the EMBOSSED CARD TYPE file
;** VARIABLE DEFS
;
; DGECDA - IEN for 39.1 file
; DGLNDA - IEN for 39.11 file
; DGECLNDA - Value of LINE NUMBER field
; DGLNX - One line from WBDEF defining an entry in 39.11
; DGDATA - One piece of WBDEF text defining an entry in 39.12
; DGITEM - DATA ITEM field literal value for field
; DGCOL - Value of STARTING COLUMN field
; DGLNG - Value of LENGTH field
;
N DGECDA,DGECLNDA,DGDATA,DGLNX,DGITEM,DGCOL,DGLNG,DGLNDA
S DIC="^DIC(39.1,",DIC(0)="M",X="WRISTBAND"
D ^DIC ;** Get WRISTBAND DA from file 39.1
S DGECDA=+Y
K DIC,X,Y
I DGECDA DO
.S DGECLNDA=0
.F S DGECLNDA=DGECLNDA+1 S DGLNX=$P($T(WBDEF+DGECLNDA),";;",2) Q:DGLNX["QUIT" DO
..S DA(1)=DGECDA,DIC="^DIC(39.1,"_DA(1)_",1,"
..S DIC(0)="L"
..S DIC("P")=$P(^DD(39.1,10,0),"^",2)
..S X=DGECLNDA
..K DD,DO
..D FILE^DICN
..S DGLNDA=+Y
..K DIC,DA,X,Y
..S DGPCE=1
..D SUBENT ;** Pull one data item from DGLNX, add to multiple
K DIC,DA,X,Y
Q
;
SUBENT ;** Create the data items on one line of the wristband
F S DGDATA=$P(DGLNX,"~~",DGPCE) Q:DGDATA="" DO
.S DGPCE=DGPCE+1
.I DGLNDA DO
..S X=""
..S DGITEM=$P(DGDATA,"^",1)
..S:DGITEM'="" X=$O(^DIC(39.2,"B",DGITEM,X))
..I X DO
...S DGCOL=$P(DGDATA,"^",2)
...S DGLNG=$P(DGDATA,"^",3)
...S DA(2)=DGECDA,DA(1)=DGLNDA,DIC="^DIC(39.1,"_DA(2)_",1,"_DA(1)_",1,"
...S DIC(0)="L"
...S DIC("P")=$P(^DD(39.11,1,0),"^",2)
...S DIC("DR")="1///^S X=DGCOL;2///^S X=DGLNG"
...K DD,DO
...D FILE^DICN
..K DIC,DA,X,Y
Q
;
SETTERM ;** Edit entry in TERMINAL TYPE file (#3.2)
N DGTTDA,CODE1,CODE2,CODE3,CODE4,OPENE,BARON,BAROFF
S DIC="^%ZIS(2,",DIC(0)="M",X="P-BARCODE BLAZER"
D ^DIC
S DGTTDA=+Y
K DIC,X,Y
I DGTTDA DO
.S CODE1="U B9X12 (3,2,90) 160 100 "
.S CODE2="U B9X12 (2,2,90) 140 100 "
.S CODE3="R90 9X12 130 100 "
.S CODE4="R90 9X12 125 100 "
.S OPENE="W ""! 0 75 750 1"",!,""V MODE 0"",!,""V ENCODER 1"",!,""V SPEED 3.25 1.2"",!,""PITCH 100"",!"
.S BARON="""BARCODER CODE39(2:4) 80 100 40 *"",VARIABLE,""*"",!"
.S BAROFF="""END"",!"
.S DIE="^%ZIS(2,",DA=DGTTDA
.S DR="6///^S X=OPENE;60///^S X=BARON;61///^S X=BAROFF;203///^S X=CODE1;205///^S X=CODE2;207///^S X=CODE3;209///^S X=CODE4"
.D ^DIE
.K DIE,DA,DR
Q
;
WBDEF ;;**Define wristband layout
;;NAME^1^30
;;PID^1^14~~DOB^16^6~~WARD LOCATION^14^15
;;BLANK^1^1
;;ALLERGY^1^40~~RELIGION^30^2
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5382PT 3241 printed Dec 13, 2024@02:38:57 Page 2
DG5382PT ; ALBANY/GTS - DG*5.3*82 POST INIT; 1/30/96-11:45AM
+1 ;;5.3;Registration;**82**;Jan 30, 1996
+2 ;
MAIN ;
+1 ;** Correct the WARD LOCATION entry in file 39.2
DO SETWARD
+2 ;** Change the layout of the WRISTBAND entry in file 39.1
DO SETCARD
+3 ;** Set Term Type file (#3.2) entry
if XPDQUES("POS1 QUESTION")
DO SETTERM
+4 QUIT
+5 ;
SETWARD ;** Change the mumps code for the WARD LOCATION lookup
+1 NEW DGWLDA,CODE
+2 SET CODE="S Y="""" I $G(^DPT(DFN,.1))]"""" S Y=$O(^DIC(42,""B"",$G(^DPT(DFN,.1)),0)) S Y=$S($P($G(^DIC(42,+Y,0)),U,4)=""N"":"""",1:$P($G(^DIC(42,+Y,0)),U))"
+3 SET DIC="^DIC(39.2,"
SET DIC(0)="M"
SET X="WARD LOCATION"
+4 DO ^DIC
+5 SET DGWLDA=+Y
+6 KILL DIC,X,Y
+7 IF DGWLDA
Begin DoDot:1
+8 SET DIE="^DIC(39.2,"
SET DA=DGWLDA
+9 SET DR="1///^S X=CODE"
+10 DO ^DIE
+11 KILL DIE,DA,DR
End DoDot:1
+12 QUIT
+13 ;
SETCARD ;** Change the layout of the WRISTAND in the EMBOSSED CARD TYPE file
+1 ;** VARIABLE DEFS
+2 ;
+3 ; DGECDA - IEN for 39.1 file
+4 ; DGLNDA - IEN for 39.11 file
+5 ; DGECLNDA - Value of LINE NUMBER field
+6 ; DGLNX - One line from WBDEF defining an entry in 39.11
+7 ; DGDATA - One piece of WBDEF text defining an entry in 39.12
+8 ; DGITEM - DATA ITEM field literal value for field
+9 ; DGCOL - Value of STARTING COLUMN field
+10 ; DGLNG - Value of LENGTH field
+11 ;
+12 NEW DGECDA,DGECLNDA,DGDATA,DGLNX,DGITEM,DGCOL,DGLNG,DGLNDA
+13 SET DIC="^DIC(39.1,"
SET DIC(0)="M"
SET X="WRISTBAND"
+14 ;** Get WRISTBAND DA from file 39.1
DO ^DIC
+15 SET DGECDA=+Y
+16 KILL DIC,X,Y
+17 IF DGECDA
Begin DoDot:1
+18 SET DGECLNDA=0
+19 FOR
SET DGECLNDA=DGECLNDA+1
SET DGLNX=$PIECE($TEXT(WBDEF+DGECLNDA),";;",2)
if DGLNX["QUIT"
QUIT
Begin DoDot:2
+20 SET DA(1)=DGECDA
SET DIC="^DIC(39.1,"_DA(1)_",1,"
+21 SET DIC(0)="L"
+22 SET DIC("P")=$PIECE(^DD(39.1,10,0),"^",2)
+23 SET X=DGECLNDA
+24 KILL DD,DO
+25 DO FILE^DICN
+26 SET DGLNDA=+Y
+27 KILL DIC,DA,X,Y
+28 SET DGPCE=1
+29 ;** Pull one data item from DGLNX, add to multiple
DO SUBENT
End DoDot:2
End DoDot:1
+30 KILL DIC,DA,X,Y
+31 QUIT
+32 ;
SUBENT ;** Create the data items on one line of the wristband
+1 FOR
SET DGDATA=$PIECE(DGLNX,"~~",DGPCE)
if DGDATA=""
QUIT
Begin DoDot:1
+2 SET DGPCE=DGPCE+1
+3 IF DGLNDA
Begin DoDot:2
+4 SET X=""
+5 SET DGITEM=$PIECE(DGDATA,"^",1)
+6 if DGITEM'=""
SET X=$ORDER(^DIC(39.2,"B",DGITEM,X))
+7 IF X
Begin DoDot:3
+8 SET DGCOL=$PIECE(DGDATA,"^",2)
+9 SET DGLNG=$PIECE(DGDATA,"^",3)
+10 SET DA(2)=DGECDA
SET DA(1)=DGLNDA
SET DIC="^DIC(39.1,"_DA(2)_",1,"_DA(1)_",1,"
+11 SET DIC(0)="L"
+12 SET DIC("P")=$PIECE(^DD(39.11,1,0),"^",2)
+13 SET DIC("DR")="1///^S X=DGCOL;2///^S X=DGLNG"
+14 KILL DD,DO
+15 DO FILE^DICN
End DoDot:3
+16 KILL DIC,DA,X,Y
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
SETTERM ;** Edit entry in TERMINAL TYPE file (#3.2)
+1 NEW DGTTDA,CODE1,CODE2,CODE3,CODE4,OPENE,BARON,BAROFF
+2 SET DIC="^%ZIS(2,"
SET DIC(0)="M"
SET X="P-BARCODE BLAZER"
+3 DO ^DIC
+4 SET DGTTDA=+Y
+5 KILL DIC,X,Y
+6 IF DGTTDA
Begin DoDot:1
+7 SET CODE1="U B9X12 (3,2,90) 160 100 "
+8 SET CODE2="U B9X12 (2,2,90) 140 100 "
+9 SET CODE3="R90 9X12 130 100 "
+10 SET CODE4="R90 9X12 125 100 "
+11 SET OPENE="W ""! 0 75 750 1"",!,""V MODE 0"",!,""V ENCODER 1"",!,""V SPEED 3.25 1.2"",!,""PITCH 100"",!"
+12 SET BARON="""BARCODER CODE39(2:4) 80 100 40 *"",VARIABLE,""*"",!"
+13 SET BAROFF="""END"",!"
+14 SET DIE="^%ZIS(2,"
SET DA=DGTTDA
+15 SET DR="6///^S X=OPENE;60///^S X=BARON;61///^S X=BAROFF;203///^S X=CODE1;205///^S X=CODE2;207///^S X=CODE3;209///^S X=CODE4"
+16 DO ^DIE
+17 KILL DIE,DA,DR
End DoDot:1
+18 QUIT
+19 ;
WBDEF ;;**Define wristband layout
+1 ;;NAME^1^30
+2 ;;PID^1^14~~DOB^16^6~~WARD LOCATION^14^15
+3 ;;BLANK^1^1
+4 ;;ALLERGY^1^40~~RELIGION^30^2
+5 ;;QUIT
