HLPAT96.m

HLPAT96 ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/25/03  18:12 [ 12/23/2003  3:59 PM ]

 ;;1.6;HEALTH LEVEL SEVEN;**96,1005**;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

 ;

HLPAT96   ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/25/03  18:12 [ 12/23/2003  3:59 PM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**96,1005**;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      ;