HLPAT96 ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/25/03 18:12
;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
;
; Pre-install:
; 1. find the duplicate entries in file #779.001, #771.2 and #771.3
; 2. resolve the pointers for fields: #101,770.4(event type),
; #101,770.3(message type), #101,770.11(message type).
; 3. resolve the pointers for fields: #773,16(event type),
; #773,15(message type).
; 4. resolve the pointer for sub-field: #771.06,.01(message type)
; of field #771,6, and #771.05,.01(segment type) of field #771,5.
; 5. delete duplicates in files #779.001, #771.2 and #771.3.
; and disable the Identifiers for files: #779.001, #771.2, #771.3
Q
PRE ;
N HLTEMP
S HLTEMP=$$NEWCP^XPDUTL("PRE1","PRE1^HLPAT96")
S HLTEMP=$$NEWCP^XPDUTL("PRE2","PRE2^HLPAT96")
S HLTEMP=$$NEWCP^XPDUTL("PRE3","PRE3^HLPAT96")
S HLTEMP=$$NEWCP^XPDUTL("PRE4","PRE4^HLPAT96")
S HLTEMP=$$NEWCP^XPDUTL("PRE5","PRE5^HLPAT96")
Q
PRE1 ;
N HLEVNARY,HLMSGARY,HLSEGARY
D CHANGE
D EVN^HLPAT96B
D MSG^HLPAT96B
D SEG^HLPAT96B
I $D(^XTMP("HLPAT96")) K ^XTMP("HLPAT96")
I $D(HLEVNARY) M ^XTMP("HLPAT96","EVN")=HLEVNARY
I $D(HLMSGARY) M ^XTMP("HLPAT96","MSG")=HLMSGARY
I $D(HLSEGARY) M ^XTMP("HLPAT96","SEG")=HLSEGARY
I $D(HLEVNARY)!$D(HLMSGARY)!$D(HLSEGARY) S ^XTMP("HLPAT96",0)=$$FMADD^XLFDT(DT,90)_U_DT
Q
PRE2 ;
Q:'$D(^XTMP("HLPAT96","EVN"))&'$D(^XTMP("HLPAT96","MSG"))&'$D(^XTMP("HLPAT96","SEG"))
I $D(^XTMP("HLPAT96","EVN")) M HLEVNARY=^XTMP("HLPAT96","EVN")
I $D(^XTMP("HLPAT96","MSG")) M HLMSGARY=^XTMP("HLPAT96","MSG")
D PTR101
Q
PRE3 ;
Q:'$D(^XTMP("HLPAT96","EVN"))&'$D(^XTMP("HLPAT96","MSG"))&'$D(^XTMP("HLPAT96","SEG"))
I $D(^XTMP("HLPAT96","EVN")) M HLEVNARY=^XTMP("HLPAT96","EVN")
I $D(^XTMP("HLPAT96","MSG")) M HLMSGARY=^XTMP("HLPAT96","MSG")
D PTR773
Q
PRE4 ;
Q:'$D(^XTMP("HLPAT96","EVN"))&'$D(^XTMP("HLPAT96","MSG"))&'$D(^XTMP("HLPAT96","SEG"))
I $D(^XTMP("HLPAT96","EVN")) M HLEVNARY=^XTMP("HLPAT96","EVN")
I $D(^XTMP("HLPAT96","MSG")) M HLMSGARY=^XTMP("HLPAT96","MSG")
I $D(^XTMP("HLPAT96","SEG")) M HLSEGARY=^XTMP("HLPAT96","SEG")
D PTR771^HLPAT96A
Q
PRE5 ;
D IDOFF^HLPAT96B
Q:'$D(^XTMP("HLPAT96","EVN"))&'$D(^XTMP("HLPAT96","MSG"))&'$D(^XTMP("HLPAT96","SEG"))
I $D(^XTMP("HLPAT96","EVN")) M HLEVNARY=^XTMP("HLPAT96","EVN")
I $D(^XTMP("HLPAT96","MSG")) M HLMSGARY=^XTMP("HLPAT96","MSG")
I $D(^XTMP("HLPAT96","SEG")) M HLSEGARY=^XTMP("HLPAT96","SEG")
D DELETE^HLPAT96B
Q
CHANGE ; change message structure code entry from "RRI-I12" to "RRI_I12"
N HLIEN,DIE,DA,DR
S DIE="^HL(779.005,"
S HLIEN=0
F S HLIEN=$O(^HL(779.005,"B","RRI-I12",HLIEN)) Q:'HLIEN D
. I $D(^HL(779.005,HLIEN)) D
.. S DA=HLIEN
.. S DR=".01///RRI_I12"
.. D ^DIE
Q
PTR101 ; resolve pointers for file #101
;
; HLEVNP: pointer to file #779.001
; HLMSGP: pointer to file #771.2
; HLEVNPN: redirected new pointer to file #779.001
; HLMSGPN: redirected new pointer to file #771.2
;
N HLIEN,HLEVNP,HLMSGP,HLEVNPN,HLMSGPN,DIE,DA,DR
S HLIEN=0
S DIE="^ORD(101,"
F S HLIEN=$O(^ORD(101,HLIEN)) Q:'HLIEN D
. I $D(^ORD(101,HLIEN,770)) D
.. S HLEVNP=$P(^ORD(101,HLIEN,770),"^",4)
.. S HLEVNPN=0
.. I HLEVNP>0 S HLEVNPN=$$PEVN^HLPAT96A(HLEVNP)
.. ; redirect pointer for field #101,770.4
.. I HLEVNPN D
... S DA=HLIEN
... S DR="770.4////"_HLEVNPN
... D ^DIE
.. ;
.. S HLMSGP=$P(^ORD(101,HLIEN,770),"^",3)
.. S HLMSGPN=0
.. I HLMSGP>0 S HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
.. ; redirect pointer for filed #101,770.3
.. I HLMSGPN D
... S DA=HLIEN
... S DR="770.3////"_HLMSGPN
... D ^DIE
.. ;
.. S HLMSGP=$P(^ORD(101,HLIEN,770),"^",11)
.. S HLMSGPN=0
.. I HLMSGP>0 S HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
.. ; redirect pointer for field #101,770.11
.. I HLMSGPN D
... S DA=HLIEN
... S DR="770.11////"_HLMSGPN
... D ^DIE
Q
;
PTR773 ; resolve pointers for file #773
;
; HLEVNP: pointer to file #779.001
; HLMSGP: pointer to file #771.2
; HLEVNPN: redirected new pointer to file #779.001
; HLMSGPN: redirected new pointer to file #771.2
;
N HLIEN,HLEVNP,HLMSGP,HLEVNPN,HLMSGPN,DIE,DA,DR
S HLIEN=0
S DIE="^HLMA("
F S HLIEN=$O(^HLMA(HLIEN)) Q:'HLIEN D
. I $D(^HLMA(HLIEN,0)) D
.. S HLEVNP=$P(^HLMA(HLIEN,0),"^",14)
.. S HLEVNPN=0
.. I HLEVNP>0 S HLEVNPN=$$PEVN^HLPAT96A(HLEVNP)
.. ; redirect pointer for field #773,16
.. I HLEVNPN D
... S DA=HLIEN
... S DR="16////"_HLEVNPN
... D ^DIE
.. ;
.. S HLMSGP=$P(^HLMA(HLIEN,0),"^",13)
.. S HLMSGPN=0
.. I HLMSGP>0 S HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
.. ; redirect pointer for filed #773,15
.. I HLMSGPN D
... S DA=HLIEN
... S DR="15////"_HLMSGPN
... D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPAT96 4717 printed Dec 13, 2024@01:59:42 Page 2
HLPAT96 ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/25/03 18:12
+1 ;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
+2 ;
+3 ; Pre-install:
+4 ; 1. find the duplicate entries in file #779.001, #771.2 and #771.3
+5 ; 2. resolve the pointers for fields: #101,770.4(event type),
+6 ; #101,770.3(message type), #101,770.11(message type).
+7 ; 3. resolve the pointers for fields: #773,16(event type),
+8 ; #773,15(message type).
+9 ; 4. resolve the pointer for sub-field: #771.06,.01(message type)
+10 ; of field #771,6, and #771.05,.01(segment type) of field #771,5.
+11 ; 5. delete duplicates in files #779.001, #771.2 and #771.3.
+12 ; and disable the Identifiers for files: #779.001, #771.2, #771.3
+13 QUIT
PRE ;
+1 NEW HLTEMP
+2 SET HLTEMP=$$NEWCP^XPDUTL("PRE1","PRE1^HLPAT96")
+3 SET HLTEMP=$$NEWCP^XPDUTL("PRE2","PRE2^HLPAT96")
+4 SET HLTEMP=$$NEWCP^XPDUTL("PRE3","PRE3^HLPAT96")
+5 SET HLTEMP=$$NEWCP^XPDUTL("PRE4","PRE4^HLPAT96")
+6 SET HLTEMP=$$NEWCP^XPDUTL("PRE5","PRE5^HLPAT96")
+7 QUIT
PRE1 ;
+1 NEW HLEVNARY,HLMSGARY,HLSEGARY
+2 DO CHANGE
+3 DO EVN^HLPAT96B
+4 DO MSG^HLPAT96B
+5 DO SEG^HLPAT96B
+6 IF $DATA(^XTMP("HLPAT96"))
KILL ^XTMP("HLPAT96")
+7 IF $DATA(HLEVNARY)
MERGE ^XTMP("HLPAT96","EVN")=HLEVNARY
+8 IF $DATA(HLMSGARY)
MERGE ^XTMP("HLPAT96","MSG")=HLMSGARY
+9 IF $DATA(HLSEGARY)
MERGE ^XTMP("HLPAT96","SEG")=HLSEGARY
+10 IF $DATA(HLEVNARY)!$DATA(HLMSGARY)!$DATA(HLSEGARY)
SET ^XTMP("HLPAT96",0)=$$FMADD^XLFDT(DT,90)_U_DT
+11 QUIT
PRE2 ;
+1 if '$DATA(^XTMP("HLPAT96","EVN"))&'$DATA(^XTMP("HLPAT96","MSG"))&'$DATA(^XTMP("HLPAT96","SEG"))
QUIT
+2 IF $DATA(^XTMP("HLPAT96","EVN"))
MERGE HLEVNARY=^XTMP("HLPAT96","EVN")
+3 IF $DATA(^XTMP("HLPAT96","MSG"))
MERGE HLMSGARY=^XTMP("HLPAT96","MSG")
+4 DO PTR101
+5 QUIT
PRE3 ;
+1 if '$DATA(^XTMP("HLPAT96","EVN"))&'$DATA(^XTMP("HLPAT96","MSG"))&'$DATA(^XTMP("HLPAT96","SEG"))
QUIT
+2 IF $DATA(^XTMP("HLPAT96","EVN"))
MERGE HLEVNARY=^XTMP("HLPAT96","EVN")
+3 IF $DATA(^XTMP("HLPAT96","MSG"))
MERGE HLMSGARY=^XTMP("HLPAT96","MSG")
+4 DO PTR773
+5 QUIT
PRE4 ;
+1 if '$DATA(^XTMP("HLPAT96","EVN"))&'$DATA(^XTMP("HLPAT96","MSG"))&'$DATA(^XTMP("HLPAT96","SEG"))
QUIT
+2 IF $DATA(^XTMP("HLPAT96","EVN"))
MERGE HLEVNARY=^XTMP("HLPAT96","EVN")
+3 IF $DATA(^XTMP("HLPAT96","MSG"))
MERGE HLMSGARY=^XTMP("HLPAT96","MSG")
+4 IF $DATA(^XTMP("HLPAT96","SEG"))
MERGE HLSEGARY=^XTMP("HLPAT96","SEG")
+5 DO PTR771^HLPAT96A
+6 QUIT
PRE5 ;
+1 DO IDOFF^HLPAT96B
+2 if '$DATA(^XTMP("HLPAT96","EVN"))&'$DATA(^XTMP("HLPAT96","MSG"))&'$DATA(^XTMP("HLPAT96","SEG"))
QUIT
+3 IF $DATA(^XTMP("HLPAT96","EVN"))
MERGE HLEVNARY=^XTMP("HLPAT96","EVN")
+4 IF $DATA(^XTMP("HLPAT96","MSG"))
MERGE HLMSGARY=^XTMP("HLPAT96","MSG")
+5 IF $DATA(^XTMP("HLPAT96","SEG"))
MERGE HLSEGARY=^XTMP("HLPAT96","SEG")
+6 DO DELETE^HLPAT96B
+7 QUIT
CHANGE ; change message structure code entry from "RRI-I12" to "RRI_I12"
+1 NEW HLIEN,DIE,DA,DR
+2 SET DIE="^HL(779.005,"
+3 SET HLIEN=0
+4 FOR
SET HLIEN=$ORDER(^HL(779.005,"B","RRI-I12",HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+5 IF $DATA(^HL(779.005,HLIEN))
Begin DoDot:2
+6 SET DA=HLIEN
+7 SET DR=".01///RRI_I12"
+8 DO ^DIE
End DoDot:2
End DoDot:1
+9 QUIT
PTR101 ; resolve pointers for file #101
+1 ;
+2 ; HLEVNP: pointer to file #779.001
+3 ; HLMSGP: pointer to file #771.2
+4 ; HLEVNPN: redirected new pointer to file #779.001
+5 ; HLMSGPN: redirected new pointer to file #771.2
+6 ;
+7 NEW HLIEN,HLEVNP,HLMSGP,HLEVNPN,HLMSGPN,DIE,DA,DR
+8 SET HLIEN=0
+9 SET DIE="^ORD(101,"
+10 FOR
SET HLIEN=$ORDER(^ORD(101,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+11 IF $DATA(^ORD(101,HLIEN,770))
Begin DoDot:2
+12 SET HLEVNP=$PIECE(^ORD(101,HLIEN,770),"^",4)
+13 SET HLEVNPN=0
+14 IF HLEVNP>0
SET HLEVNPN=$$PEVN^HLPAT96A(HLEVNP)
+15 ; redirect pointer for field #101,770.4
+16 IF HLEVNPN
Begin DoDot:3
+17 SET DA=HLIEN
+18 SET DR="770.4////"_HLEVNPN
+19 DO ^DIE
End DoDot:3
+20 ;
+21 SET HLMSGP=$PIECE(^ORD(101,HLIEN,770),"^",3)
+22 SET HLMSGPN=0
+23 IF HLMSGP>0
SET HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
+24 ; redirect pointer for filed #101,770.3
+25 IF HLMSGPN
Begin DoDot:3
+26 SET DA=HLIEN
+27 SET DR="770.3////"_HLMSGPN
+28 DO ^DIE
End DoDot:3
+29 ;
+30 SET HLMSGP=$PIECE(^ORD(101,HLIEN,770),"^",11)
+31 SET HLMSGPN=0
+32 IF HLMSGP>0
SET HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
+33 ; redirect pointer for field #101,770.11
+34 IF HLMSGPN
Begin DoDot:3
+35 SET DA=HLIEN
+36 SET DR="770.11////"_HLMSGPN
+37 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
PTR773 ; resolve pointers for file #773
+1 ;
+2 ; HLEVNP: pointer to file #779.001
+3 ; HLMSGP: pointer to file #771.2
+4 ; HLEVNPN: redirected new pointer to file #779.001
+5 ; HLMSGPN: redirected new pointer to file #771.2
+6 ;
+7 NEW HLIEN,HLEVNP,HLMSGP,HLEVNPN,HLMSGPN,DIE,DA,DR
+8 SET HLIEN=0
+9 SET DIE="^HLMA("
+10 FOR
SET HLIEN=$ORDER(^HLMA(HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+11 IF $DATA(^HLMA(HLIEN,0))
Begin DoDot:2
+12 SET HLEVNP=$PIECE(^HLMA(HLIEN,0),"^",14)
+13 SET HLEVNPN=0
+14 IF HLEVNP>0
SET HLEVNPN=$$PEVN^HLPAT96A(HLEVNP)
+15 ; redirect pointer for field #773,16
+16 IF HLEVNPN
Begin DoDot:3
+17 SET DA=HLIEN
+18 SET DR="16////"_HLEVNPN
+19 DO ^DIE
End DoDot:3
+20 ;
+21 SET HLMSGP=$PIECE(^HLMA(HLIEN,0),"^",13)
+22 SET HLMSGPN=0
+23 IF HLMSGP>0
SET HLMSGPN=$$PMSG^HLPAT96A(HLMSGP)
+24 ; redirect pointer for filed #773,15
+25 IF HLMSGPN
Begin DoDot:3
+26 SET DA=HLIEN
+27 SET DR="15////"_HLMSGPN
+28 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
