HLPAT96B ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/06/03 14:49
;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
;
; Part III of Pre-install and Post-install
; Entries: EVN, MSG, SEG, DELETE, and IDOFF, are called from HLPAT96
Q
EVN ; find duplicate entries in file #779.001(Event Type)
N HLEVN,HLIEN,SUB
S HLEVN=""
F S HLEVN=$O(^HL(779.001,"B",HLEVN)) Q:HLEVN="" D
. S HLIEN=0,SUB=0
. F S HLIEN=$O(^HL(779.001,"B",HLEVN,HLIEN)) Q:'HLIEN D
.. I $D(^HL(779.001,HLIEN,0)),$P(^HL(779.001,HLIEN,0),"^")=HLEVN D
... S SUB=SUB+1
... S HLEVNARY(HLEVN,SUB)=HLIEN
. I SUB=1 K HLEVNARY(HLEVN)
Q
MSG ; find duplicate entries in file #771.2(Message Type)
N HLMSG,HLIEN,SUB
S HLMSG=""
F S HLMSG=$O(^HL(771.2,"B",HLMSG)) Q:HLMSG="" D
. S HLIEN=0,SUB=0
. F S HLIEN=$O(^HL(771.2,"B",HLMSG,HLIEN)) Q:'HLIEN D
.. I $D(^HL(771.2,HLIEN,0)),$P(^HL(771.2,HLIEN,0),"^")=HLMSG D
... S SUB=SUB+1
... S HLMSGARY(HLMSG,SUB)=HLIEN
. I SUB=1 K HLMSGARY(HLMSG)
Q
SEG ; find duplicate entries in file #771.3(Segment Type)
N HLSEG,HLIEN,SUB
S HLSEG=""
F S HLSEG=$O(^HL(771.3,"B",HLSEG)) Q:HLSEG="" D
. S HLIEN=0,SUB=0
. F S HLIEN=$O(^HL(771.3,"B",HLSEG,HLIEN)) Q:'HLIEN D
.. I $D(^HL(771.3,HLIEN,0)),$P(^HL(771.3,HLIEN,0),"^")=HLSEG D
... S SUB=SUB+1
... S HLSEGARY(HLSEG,SUB)=HLIEN
. I SUB=1 K HLSEGARY(HLSEG)
Q
DELETE ; delete duplicate entries in file #779.001, #771.2 and #771.3
N HLEVN,HLMSG,HLSEG,HLSUB,DIK,DA
; delete duplicate entries in file #779.001
S HLEVN="",DIK="^HL(779.001,"
F S HLEVN=$O(HLEVNARY(HLEVN)) Q:HLEVN="" D
. S HLSUB=1
. F S HLSUB=$O(HLEVNARY(HLEVN,HLSUB)) Q:'HLSUB D
.. S DA=HLEVNARY(HLEVN,HLSUB)
.. D ^DIK
;
; delete duplicate entries in file #771.2
S HLMSG="",DIK="^HL(771.2,"
F S HLMSG=$O(HLMSGARY(HLMSG)) Q:HLMSG="" D
. S HLSUB=1
. F S HLSUB=$O(HLMSGARY(HLMSG,HLSUB)) Q:'HLSUB D
.. S DA=HLMSGARY(HLMSG,HLSUB)
.. D ^DIK
;
; delete duplicate entries in file #771.3
S HLSEG="",DIK="^HL(771.3,"
F S HLSEG=$O(HLSEGARY(HLSEG)) Q:HLSEG="" D
. S HLSUB=1
. F S HLSUB=$O(HLSEGARY(HLSEG,HLSUB)) Q:'HLSUB D
.. S DA=HLSEGARY(HLSEG,HLSUB)
.. D ^DIK
;
Q
IDOFF ; disable identifier for file #779.001 and #771.2
K ^DD(779.001,0,"ID")
K ^DD(771.2,0,"ID")
K ^DD(771.3,0,"ID")
Q
POST ;enable identifier for file #779.001 and #771.2
S ^DD(779.001,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
S ^DD(771.2,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
S ^DD(771.3,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPAT96B 2562 printed Oct 16, 2024@18:00:30 Page 2
HLPAT96B ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/06/03 14:49
+1 ;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
+2 ;
+3 ; Part III of Pre-install and Post-install
+4 ; Entries: EVN, MSG, SEG, DELETE, and IDOFF, are called from HLPAT96
+5 QUIT
EVN ; find duplicate entries in file #779.001(Event Type)
+1 NEW HLEVN,HLIEN,SUB
+2 SET HLEVN=""
+3 FOR
SET HLEVN=$ORDER(^HL(779.001,"B",HLEVN))
if HLEVN=""
QUIT
Begin DoDot:1
+4 SET HLIEN=0
SET SUB=0
+5 FOR
SET HLIEN=$ORDER(^HL(779.001,"B",HLEVN,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:2
+6 IF $DATA(^HL(779.001,HLIEN,0))
IF $PIECE(^HL(779.001,HLIEN,0),"^")=HLEVN
Begin DoDot:3
+7 SET SUB=SUB+1
+8 SET HLEVNARY(HLEVN,SUB)=HLIEN
End DoDot:3
End DoDot:2
+9 IF SUB=1
KILL HLEVNARY(HLEVN)
End DoDot:1
+10 QUIT
MSG ; find duplicate entries in file #771.2(Message Type)
+1 NEW HLMSG,HLIEN,SUB
+2 SET HLMSG=""
+3 FOR
SET HLMSG=$ORDER(^HL(771.2,"B",HLMSG))
if HLMSG=""
QUIT
Begin DoDot:1
+4 SET HLIEN=0
SET SUB=0
+5 FOR
SET HLIEN=$ORDER(^HL(771.2,"B",HLMSG,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:2
+6 IF $DATA(^HL(771.2,HLIEN,0))
IF $PIECE(^HL(771.2,HLIEN,0),"^")=HLMSG
Begin DoDot:3
+7 SET SUB=SUB+1
+8 SET HLMSGARY(HLMSG,SUB)=HLIEN
End DoDot:3
End DoDot:2
+9 IF SUB=1
KILL HLMSGARY(HLMSG)
End DoDot:1
+10 QUIT
SEG ; find duplicate entries in file #771.3(Segment Type)
+1 NEW HLSEG,HLIEN,SUB
+2 SET HLSEG=""
+3 FOR
SET HLSEG=$ORDER(^HL(771.3,"B",HLSEG))
if HLSEG=""
QUIT
Begin DoDot:1
+4 SET HLIEN=0
SET SUB=0
+5 FOR
SET HLIEN=$ORDER(^HL(771.3,"B",HLSEG,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:2
+6 IF $DATA(^HL(771.3,HLIEN,0))
IF $PIECE(^HL(771.3,HLIEN,0),"^")=HLSEG
Begin DoDot:3
+7 SET SUB=SUB+1
+8 SET HLSEGARY(HLSEG,SUB)=HLIEN
End DoDot:3
End DoDot:2
+9 IF SUB=1
KILL HLSEGARY(HLSEG)
End DoDot:1
+10 QUIT
DELETE ; delete duplicate entries in file #779.001, #771.2 and #771.3
+1 NEW HLEVN,HLMSG,HLSEG,HLSUB,DIK,DA
+2 ; delete duplicate entries in file #779.001
+3 SET HLEVN=""
SET DIK="^HL(779.001,"
+4 FOR
SET HLEVN=$ORDER(HLEVNARY(HLEVN))
if HLEVN=""
QUIT
Begin DoDot:1
+5 SET HLSUB=1
+6 FOR
SET HLSUB=$ORDER(HLEVNARY(HLEVN,HLSUB))
if 'HLSUB
QUIT
Begin DoDot:2
+7 SET DA=HLEVNARY(HLEVN,HLSUB)
+8 DO ^DIK
End DoDot:2
End DoDot:1
+9 ;
+10 ; delete duplicate entries in file #771.2
+11 SET HLMSG=""
SET DIK="^HL(771.2,"
+12 FOR
SET HLMSG=$ORDER(HLMSGARY(HLMSG))
if HLMSG=""
QUIT
Begin DoDot:1
+13 SET HLSUB=1
+14 FOR
SET HLSUB=$ORDER(HLMSGARY(HLMSG,HLSUB))
if 'HLSUB
QUIT
Begin DoDot:2
+15 SET DA=HLMSGARY(HLMSG,HLSUB)
+16 DO ^DIK
End DoDot:2
End DoDot:1
+17 ;
+18 ; delete duplicate entries in file #771.3
+19 SET HLSEG=""
SET DIK="^HL(771.3,"
+20 FOR
SET HLSEG=$ORDER(HLSEGARY(HLSEG))
if HLSEG=""
QUIT
Begin DoDot:1
+21 SET HLSUB=1
+22 FOR
SET HLSUB=$ORDER(HLSEGARY(HLSEG,HLSUB))
if 'HLSUB
QUIT
Begin DoDot:2
+23 SET DA=HLSEGARY(HLSEG,HLSUB)
+24 DO ^DIK
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
IDOFF ; disable identifier for file #779.001 and #771.2
+1 KILL ^DD(779.001,0,"ID")
+2 KILL ^DD(771.2,0,"ID")
+3 KILL ^DD(771.3,0,"ID")
+4 QUIT
POST ;enable identifier for file #779.001 and #771.2
+1 SET ^DD(779.001,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
+2 SET ^DD(771.2,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
+3 SET ^DD(771.3,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
+4 QUIT
