HLPAT19 ;SFIRMFO/RSD Pre & Post Install for HL7 patch 19 ;11/20/98 09:54
;;1.6;HEALTH LEVEL SEVEN;**19**;JUL 17, 1995
;
;check that conversion already run
I @XPDGREF@("POST") D BMES^XPDUTL("Conversion already run!") Q
;convert pointer in File 772 to Date/Time
L +^HL(772),+^HLMA
S XPDIDCNT=0,XPDIDTOT=+$P(^HL(772,0),U,4)
N DA2,DA3,DIK,MID,MDT,WORK,X,Y
S (DA2,WORK)=0
;find pointers to file 773 = DA3
F S DA2=$O(^HL(772,DA2)) Q:'DA2 S DA3=+$G(^(DA2,0)) D:DA3
. ;quit if pointer to 773 doesn't exist
. Q:'$D(^HLMA(DA3,0))
. S MDT=$P(^HLMA(DA3,0),U),WORK=1
. D CNV2(DA2)
. S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#10) UPDATE^XPDID(XPDIDCNT)
;
;nothing was converted
I 'WORK L Q
;remove all remaining entries in 773
S DA3=0
F S DA3=$O(^HLMA(DA3)) Q:DA3="" K ^HLMA(DA3)
;re-index file 773
S DIK="^HLMA(",DIK(1)=.01 D ENALL^DIK
L
Q
CNV2(DA) ;convert .01 field in 772 from pointer to Date/Time
K ^HL(772,"B",DA3,DA)
S $P(^HL(772,DA,0),U)=MDT,^HL(772,"B",MDT,DA)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPAT19 1021 printed Dec 13, 2024@01:59:36 Page 2
HLPAT19 ;SFIRMFO/RSD Pre & Post Install for HL7 patch 19 ;11/20/98 09:54
+1 ;;1.6;HEALTH LEVEL SEVEN;**19**;JUL 17, 1995
+2 ;
+3 ;check that conversion already run
+4 IF @XPDGREF@("POST")
DO BMES^XPDUTL("Conversion already run!")
QUIT
+5 ;convert pointer in File 772 to Date/Time
+6 LOCK +^HL(772),+^HLMA
+7 SET XPDIDCNT=0
SET XPDIDTOT=+$PIECE(^HL(772,0),U,4)
+8 NEW DA2,DA3,DIK,MID,MDT,WORK,X,Y
+9 SET (DA2,WORK)=0
+10 ;find pointers to file 773 = DA3
+11 FOR
SET DA2=$ORDER(^HL(772,DA2))
if 'DA2
QUIT
SET DA3=+$GET(^(DA2,0))
if DA3
Begin DoDot:1
+12 ;quit if pointer to 773 doesn't exist
+13 if '$DATA(^HLMA(DA3,0))
QUIT
+14 SET MDT=$PIECE(^HLMA(DA3,0),U)
SET WORK=1
+15 DO CNV2(DA2)
+16 SET XPDIDCNT=XPDIDCNT+1
if '(XPDIDCNT#10)
DO UPDATE^XPDID(XPDIDCNT)
End DoDot:1
+17 ;
+18 ;nothing was converted
+19 IF 'WORK
LOCK
QUIT
+20 ;remove all remaining entries in 773
+21 SET DA3=0
+22 FOR
SET DA3=$ORDER(^HLMA(DA3))
if DA3=""
QUIT
KILL ^HLMA(DA3)
+23 ;re-index file 773
+24 SET DIK="^HLMA("
SET DIK(1)=.01
DO ENALL^DIK
+25 LOCK
+26 QUIT
CNV2(DA) ;convert .01 field in 772 from pointer to Date/Time
+1 KILL ^HL(772,"B",DA3,DA)
+2 SET $PIECE(^HL(772,DA,0),U)=MDT
SET ^HL(772,"B",MDT,DA)=""
+3 QUIT
