HLPAT120 ;OIFO-OAKLAND/RAM & RJH - HL7 PATCH 120 PRE&POST-INIT ;01/19/06 11:07
;;1.6;HEALTH LEVEL SEVEN;**120**;Oct 13, 1995;Build 12
;
Q
PRE ;
; disable identifier for file #779.004 to prevent from duplicate
; caused by field #2 (Description)
K ^DD(779.004,0,"ID")
;
N HLCCARY,HLAPPARY
D CC
D APP771
Q:'$D(HLCCARY)
;
I $D(^XTMP("HLPAT120")) K ^XTMP("HLPAT120")
M ^XTMP("HLPAT120","CC")=HLCCARY
S ^XTMP("HLPAT120",0)=$$FMADD^XLFDT(DT,90)_U_DT
Q:'$D(HLAPPARY)
;
M ^XTMP("HLPAT120","APP")=HLAPPARY
Q
CC ;
; find entries US" and "USA" in file #779.004
N HLIEN,HLCC
S HLIEN=0
F S HLIEN=$O(^HL(779.004,HLIEN)) Q:'HLIEN D
. I $D(^HL(779.004,HLIEN,0)) D
.. S HLCC=$P(^HL(779.004,HLIEN,0),"^")
.. I (HLCC="US")!(HLCC="USA") D
... ; no duplicate country code is assumed
... S HLCCARY(HLCC)=HLIEN
Q
APP771 ;
; find pointer in file #771, pointing to entries US" in file #779.004
N HLIEN,HLCCPTR,HLCCPNEW
S HLIEN=0
Q:'$G(HLCCARY("US"))
Q:'$G(HLCCARY("USA"))
;
F S HLIEN=$O(^HL(771,HLIEN)) Q:'HLIEN D
. I $D(^HL(771,HLIEN,0)) D
.. S HLCCPTR=$P(^HL(771,HLIEN,0),"^",7)
.. S HLCCPNEW=0
.. I HLCCPTR>0,HLCCPTR=HLCCARY("US") D
... ;
... ; redirect pointer for field #771,7
... S $P(^HL(771,HLIEN,0),"^",7)=HLCCARY("USA")
... S HLAPPARY(HLIEN,HLCCARY("US"))=HLCCARY("USA")
;
; delete entry "US" from file #779.004
N DA,DIK
S DIK="^HL(779.004,"
S DA=HLCCARY("US")
D ^DIK
Q
POST ;
; enable identifier for file #779.004
S ^DD(779.004,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
;
N FDA,IEN,IENS,VUID,IFN
;
S IFN=779.00409
K FDA
;
S VUID=0
F S VUID=$O(^HL(779.004,"AMASTERVUID",VUID)) Q:'VUID D
.S IEN=$O(^HL(779.004,"AMASTERVUID",VUID,1,0)) Q:'IEN
.K ^HL(779.004,IEN,"TERMSTATUS")
.S IENS=IEN_","
.K FDA
.S FDA(IFN,"?+1,"_IENS,.01)=$$NOW^XLFDT
.S FDA(IFN,"?+1,"_IENS,.02)=1
.D UPDATE^DIE(,"FDA")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPAT120 1939 printed Dec 13, 2024@01:59:34 Page 2
HLPAT120 ;OIFO-OAKLAND/RAM & RJH - HL7 PATCH 120 PRE&POST-INIT ;01/19/06 11:07
+1 ;;1.6;HEALTH LEVEL SEVEN;**120**;Oct 13, 1995;Build 12
+2 ;
+3 QUIT
PRE ;
+1 ; disable identifier for file #779.004 to prevent from duplicate
+2 ; caused by field #2 (Description)
+3 KILL ^DD(779.004,0,"ID")
+4 ;
+5 NEW HLCCARY,HLAPPARY
+6 DO CC
+7 DO APP771
+8 if '$DATA(HLCCARY)
QUIT
+9 ;
+10 IF $DATA(^XTMP("HLPAT120"))
KILL ^XTMP("HLPAT120")
+11 MERGE ^XTMP("HLPAT120","CC")=HLCCARY
+12 SET ^XTMP("HLPAT120",0)=$$FMADD^XLFDT(DT,90)_U_DT
+13 if '$DATA(HLAPPARY)
QUIT
+14 ;
+15 MERGE ^XTMP("HLPAT120","APP")=HLAPPARY
+16 QUIT
CC ;
+1 ; find entries US" and "USA" in file #779.004
+2 NEW HLIEN,HLCC
+3 SET HLIEN=0
+4 FOR
SET HLIEN=$ORDER(^HL(779.004,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+5 IF $DATA(^HL(779.004,HLIEN,0))
Begin DoDot:2
+6 SET HLCC=$PIECE(^HL(779.004,HLIEN,0),"^")
+7 IF (HLCC="US")!(HLCC="USA")
Begin DoDot:3
+8 ; no duplicate country code is assumed
+9 SET HLCCARY(HLCC)=HLIEN
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
APP771 ;
+1 ; find pointer in file #771, pointing to entries US" in file #779.004
+2 NEW HLIEN,HLCCPTR,HLCCPNEW
+3 SET HLIEN=0
+4 if '$GET(HLCCARY("US"))
QUIT
+5 if '$GET(HLCCARY("USA"))
QUIT
+6 ;
+7 FOR
SET HLIEN=$ORDER(^HL(771,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+8 IF $DATA(^HL(771,HLIEN,0))
Begin DoDot:2
+9 SET HLCCPTR=$PIECE(^HL(771,HLIEN,0),"^",7)
+10 SET HLCCPNEW=0
+11 IF HLCCPTR>0
IF HLCCPTR=HLCCARY("US")
Begin DoDot:3
+12 ;
+13 ; redirect pointer for field #771,7
+14 SET $PIECE(^HL(771,HLIEN,0),"^",7)=HLCCARY("USA")
+15 SET HLAPPARY(HLIEN,HLCCARY("US"))=HLCCARY("USA")
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 ; delete entry "US" from file #779.004
+18 NEW DA,DIK
+19 SET DIK="^HL(779.004,"
+20 SET DA=HLCCARY("US")
+21 DO ^DIK
+22 QUIT
POST ;
+1 ; enable identifier for file #779.004
+2 SET ^DD(779.004,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
+3 ;
+4 NEW FDA,IEN,IENS,VUID,IFN
+5 ;
+6 SET IFN=779.00409
+7 KILL FDA
+8 ;
+9 SET VUID=0
+10 FOR
SET VUID=$ORDER(^HL(779.004,"AMASTERVUID",VUID))
if 'VUID
QUIT
Begin DoDot:1
+11 SET IEN=$ORDER(^HL(779.004,"AMASTERVUID",VUID,1,0))
if 'IEN
QUIT
+12 KILL ^HL(779.004,IEN,"TERMSTATUS")
+13 SET IENS=IEN_","
+14 KILL FDA
+15 SET FDA(IFN,"?+1,"_IENS,.01)=$$NOW^XLFDT
+16 SET FDA(IFN,"?+1,"_IENS,.02)=1
+17 DO UPDATE^DIE(,"FDA")
End DoDot:1
+18 ;
+19 QUIT
+20 ;
