HLPOST16 ;AISC/SAW,JRP - Post-init Routine for DHCP HL7 v. 1.6 ;1/24/95
;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
;Declare variables
N DA,DIC,DIE,DR,X,Y,HLAPP,HLMID,HLST,HLX,HLORIGDT,HLORIGMI
N HLX1,HLCNVCNT,HLPRTDOT,HLABORT,HLAPNM,HLTMP,HLORIGAP,HLORIGST
S HLABORT=0
W !!,"- File conversions started on ",$$DH4PRT^HLCSFMN1()," -"
;Add entries in file 770 into file 771
W !!,"Copying entries from HL7 NON-DHCP APPLICATION PARAMETER file (#770)"
W !,"to HL7 APPLICATION PARAMETER file (#771) "
;Lock files
L +^HL(771):10 I ('$T) D Q
.W !!,"** Conversion halted **"
.W !,"** Unable to lock HL7 APPLICATION PARAMETER file **"
.W !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
.S:($D(ZTQUEUED)) ZTREQ="@"
L +^HL(770):10 I ('$T) D Q
.L -^HL(771)
.W !!,"** Conversion halted **"
.W !,"** Unable to lock HL7 NON-DHCP APPLICATION PARAMETER file **"
.W !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
.S:($D(ZTQUEUED)) ZTREQ="@"
;Loop through 770
S HLX=0 F HLCNVCNT=1:1 S HLX=$O(^HL(770,HLX)) Q:HLX'>0 D Q:(HLABORT)
.W:('(HLCNVCNT#5)) "." W:($X>(IOM-2)) !
.;User aborted
.S HLABORT=$$S^%ZTLOAD
.Q:(HLABORT)
.;Get application name
.S HLX1=$G(^HL(770,HLX,0))
.S HLAPNM=$P(HLX1,"^",1)
.I (HLAPNM="") D Q
..W !,?5,"* Entry number ",HLX," does not have an application name"
.;Entry already converted
.Q:($P(HLX1,"^",12))
.;If entry exists in 770 and 771 with same name, change name of
.; entry in 771 by appending "-DHCP" to it
.S DA=$O(^HL(771,"B",HLAPNM,0)) I DA D
..S DIE="^HL(771,",DR=".01///"_HLAPNM_"-DHCP" D ^DIE K DIE,DR
.K DA,DD,DO S DIC="^HL(771,",X=HLAPNM,DIC(0)="" D FILE^DICN
.I ('Y) D Q
..W !,?5,"* Unable to copy ",HLAPNM," (entry #",HLX,")"
.S DIE="^HL(771,",DR="2///a;3///"_$P(HLX1,"^",3),DA=+Y D ^DIE K DIE,DR
.;Stuff pointer to 771 in field 12 of file 770
.S DR="12///"_DA,DA=HLX,DIE="^HL(770," D ^DIE
L -^HL(771)
L -^HL(770)
I (HLABORT) D Q
.W !!,"** Conversion of files has been asked to stop **"
.W !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
.S:($D(ZTQUEUED)) ZTREQ="@"
;Purge data in file 772 so that only last seven days are retained
W !!,"Purging data from HL7 MESSAGE TEXT file (#772) "
S HLPRTDOT=1
D DQ^HLUOPT1
I ($$S^%ZTLOAD) D Q
.W !!,"** Conversion of files has been asked to stop **"
.W !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
.S:($D(ZTQUEUED)) ZTREQ="@"
;Convert data in fields .01,3 and 20 of file 772 to new format
W !!,"Converting newly defined fields in HL7 MESSAGE TEXT file (#772) "
;Loop through 772
S HLX=0
F HLCNVCNT=1:1 S HLX=+$O(^HL(772,HLX)) Q:(HLX'>0) D Q:(HLABORT)
.;Lock entry
.L +^HL(772,HLX):10 I ('$T) D Q
..W !,?5,"* Unable to lock entry number ",HLX," - entry not converted"
..;Check for user aborted
..S HLABORT=$$S^%ZTLOAD
.W:('(HLCNVCNT#5)) "." W:($X>(IOM-2)) !
.;User aborted
.S HLABORT=$$S^%ZTLOAD
.I (HLABORT) L -^HL(772,HLX) Q
.;Get date/time of message (field #.01)
.S HLX1=$G(^HL(772,HLX,0))
.S HLORIGDT=+HLX1
.I ('HLORIGDT) D Q
..W !,?5,"* Entry number ",HLX," does not have a date & time of message"
..L -^HL(772,HLX)
.;Already converted
.I ((HLORIGDT'?7N.1".".6N)!($D(^HLMA(HLORIGDT)))) L -^HL(772,HLX) Q
.;Get application name (field #3)
.S HLORIGAP=$P($G(^HL(770,+$P(HLX1,"^",3),0)),"^")
.;Get status (field #20)
.S HLORIGST=$P($G(^HL(772,HLX,"P")),"^")
.;Get message ID (field #6)
.S HLORIGMI=$P(HLX1,"^",6)
.;Convert .01 field by creating entry in file #773 to point to
.; HLMID will be a pointer to file #773, if it is KILLED before
.; making the call
.K HLMID D MA^HLTF(HLORIGDT) K HLDT
.;Convert field 3
.S HLAPP=""
.S:(HLORIGAP'="") HLAPP=+$O(^HL(771,"B",HLORIGAP,0))
.;Convert field 20
.S HLST=$S(HLORIGST="P":1,HLORIGST="A":2,HLORIGST="E":4,1:3)
.;Store converted values
.I $G(HLMID) D
..S DIE="^HL(772,"
..S DA=HLX
..S DR=".01////"_HLMID_";3////"_HLAPP_";20////"_HLST
..D ^DIE
..;Change message IDs to match original message ID
..S DIE="^HL(772,"
..S DA=HLX
..S DR="6////"_HLORIGMI
..D ^DIE
..S DIE="^HLMA("
..S DA=HLMID
..S DR="2////"_HLORIGMI
..D ^DIE
.;Unlock entry
.L -^HL(772,HLX)
I (HLABORT) D Q
.W !!,"** Conversion of files has been asked to stop **"
.W !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
.S:($D(ZTQUEUED)) ZTREQ="@"
W !!,"- File conversions completed on ",$$DH4PRT^HLCSFMN1()," -",!!
S:($D(ZTQUEUED)) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPOST16 4610 printed Dec 13, 2024@01:59:45 Page 2
HLPOST16 ;AISC/SAW,JRP - Post-init Routine for DHCP HL7 v. 1.6 ;1/24/95
+1 ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
+2 ;Declare variables
+3 NEW DA,DIC,DIE,DR,X,Y,HLAPP,HLMID,HLST,HLX,HLORIGDT,HLORIGMI
+4 NEW HLX1,HLCNVCNT,HLPRTDOT,HLABORT,HLAPNM,HLTMP,HLORIGAP,HLORIGST
+5 SET HLABORT=0
+6 WRITE !!,"- File conversions started on ",$$DH4PRT^HLCSFMN1()," -"
+7 ;Add entries in file 770 into file 771
+8 WRITE !!,"Copying entries from HL7 NON-DHCP APPLICATION PARAMETER file (#770)"
+9 WRITE !,"to HL7 APPLICATION PARAMETER file (#771) "
+10 ;Lock files
+11 LOCK +^HL(771):10
IF ('$TEST)
Begin DoDot:1
+12 WRITE !!,"** Conversion halted **"
+13 WRITE !,"** Unable to lock HL7 APPLICATION PARAMETER file **"
+14 WRITE !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
+15 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
End DoDot:1
QUIT
+16 LOCK +^HL(770):10
IF ('$TEST)
Begin DoDot:1
+17 LOCK -^HL(771)
+18 WRITE !!,"** Conversion halted **"
+19 WRITE !,"** Unable to lock HL7 NON-DHCP APPLICATION PARAMETER file **"
+20 WRITE !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
+21 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
End DoDot:1
QUIT
+22 ;Loop through 770
+23 SET HLX=0
FOR HLCNVCNT=1:1
SET HLX=$ORDER(^HL(770,HLX))
if HLX'>0
QUIT
Begin DoDot:1
+24 if ('(HLCNVCNT#5))
WRITE "."
if ($X>(IOM-2))
WRITE !
+25 ;User aborted
+26 SET HLABORT=$$S^%ZTLOAD
+27 if (HLABORT)
QUIT
+28 ;Get application name
+29 SET HLX1=$GET(^HL(770,HLX,0))
+30 SET HLAPNM=$PIECE(HLX1,"^",1)
+31 IF (HLAPNM="")
Begin DoDot:2
+32 WRITE !,?5,"* Entry number ",HLX," does not have an application name"
End DoDot:2
QUIT
+33 ;Entry already converted
+34 if ($PIECE(HLX1,"^",12))
QUIT
+35 ;If entry exists in 770 and 771 with same name, change name of
+36 ; entry in 771 by appending "-DHCP" to it
+37 SET DA=$ORDER(^HL(771,"B",HLAPNM,0))
IF DA
Begin DoDot:2
+38 SET DIE="^HL(771,"
SET DR=".01///"_HLAPNM_"-DHCP"
DO ^DIE
KILL DIE,DR
End DoDot:2
+39 KILL DA,DD,DO
SET DIC="^HL(771,"
SET X=HLAPNM
SET DIC(0)=""
DO FILE^DICN
+40 IF ('Y)
Begin DoDot:2
+41 WRITE !,?5,"* Unable to copy ",HLAPNM," (entry #",HLX,")"
End DoDot:2
QUIT
+42 SET DIE="^HL(771,"
SET DR="2///a;3///"_$PIECE(HLX1,"^",3)
SET DA=+Y
DO ^DIE
KILL DIE,DR
+43 ;Stuff pointer to 771 in field 12 of file 770
+44 SET DR="12///"_DA
SET DA=HLX
SET DIE="^HL(770,"
DO ^DIE
End DoDot:1
if (HLABORT)
QUIT
+45 LOCK -^HL(771)
+46 LOCK -^HL(770)
+47 IF (HLABORT)
Begin DoDot:1
+48 WRITE !!,"** Conversion of files has been asked to stop **"
+49 WRITE !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
+50 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
End DoDot:1
QUIT
+51 ;Purge data in file 772 so that only last seven days are retained
+52 WRITE !!,"Purging data from HL7 MESSAGE TEXT file (#772) "
+53 SET HLPRTDOT=1
+54 DO DQ^HLUOPT1
+55 IF ($$S^%ZTLOAD)
Begin DoDot:1
+56 WRITE !!,"** Conversion of files has been asked to stop **"
+57 WRITE !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
+58 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
End DoDot:1
QUIT
+59 ;Convert data in fields .01,3 and 20 of file 772 to new format
+60 WRITE !!,"Converting newly defined fields in HL7 MESSAGE TEXT file (#772) "
+61 ;Loop through 772
+62 SET HLX=0
+63 FOR HLCNVCNT=1:1
SET HLX=+$ORDER(^HL(772,HLX))
if (HLX'>0)
QUIT
Begin DoDot:1
+64 ;Lock entry
+65 LOCK +^HL(772,HLX):10
IF ('$TEST)
Begin DoDot:2
+66 WRITE !,?5,"* Unable to lock entry number ",HLX," - entry not converted"
+67 ;Check for user aborted
+68 SET HLABORT=$$S^%ZTLOAD
End DoDot:2
QUIT
+69 if ('(HLCNVCNT#5))
WRITE "."
if ($X>(IOM-2))
WRITE !
+70 ;User aborted
+71 SET HLABORT=$$S^%ZTLOAD
+72 IF (HLABORT)
LOCK -^HL(772,HLX)
QUIT
+73 ;Get date/time of message (field #.01)
+74 SET HLX1=$GET(^HL(772,HLX,0))
+75 SET HLORIGDT=+HLX1
+76 IF ('HLORIGDT)
Begin DoDot:2
+77 WRITE !,?5,"* Entry number ",HLX," does not have a date & time of message"
+78 LOCK -^HL(772,HLX)
End DoDot:2
QUIT
+79 ;Already converted
+80 IF ((HLORIGDT'?7N.1".".6N)!($DATA(^HLMA(HLORIGDT))))
LOCK -^HL(772,HLX)
QUIT
+81 ;Get application name (field #3)
+82 SET HLORIGAP=$PIECE($GET(^HL(770,+$PIECE(HLX1,"^",3),0)),"^")
+83 ;Get status (field #20)
+84 SET HLORIGST=$PIECE($GET(^HL(772,HLX,"P")),"^")
+85 ;Get message ID (field #6)
+86 SET HLORIGMI=$PIECE(HLX1,"^",6)
+87 ;Convert .01 field by creating entry in file #773 to point to
+88 ; HLMID will be a pointer to file #773, if it is KILLED before
+89 ; making the call
+90 KILL HLMID
DO MA^HLTF(HLORIGDT)
KILL HLDT
+91 ;Convert field 3
+92 SET HLAPP=""
+93 if (HLORIGAP'="")
SET HLAPP=+$ORDER(^HL(771,"B",HLORIGAP,0))
+94 ;Convert field 20
+95 SET HLST=$SELECT(HLORIGST="P":1,HLORIGST="A":2,HLORIGST="E":4,1:3)
+96 ;Store converted values
+97 IF $GET(HLMID)
Begin DoDot:2
+98 SET DIE="^HL(772,"
+99 SET DA=HLX
+100 SET DR=".01////"_HLMID_";3////"_HLAPP_";20////"_HLST
+101 DO ^DIE
+102 ;Change message IDs to match original message ID
+103 SET DIE="^HL(772,"
+104 SET DA=HLX
+105 SET DR="6////"_HLORIGMI
+106 DO ^DIE
+107 SET DIE="^HLMA("
+108 SET DA=HLMID
+109 SET DR="2////"_HLORIGMI
+110 DO ^DIE
End DoDot:2
+111 ;Unlock entry
+112 LOCK -^HL(772,HLX)
End DoDot:1
if (HLABORT)
QUIT
+113 IF (HLABORT)
Begin DoDot:1
+114 WRITE !!,"** Conversion of files has been asked to stop **"
+115 WRITE !,"** Use the entry point REQUEUE^HLPOST to requeue the file conversions **"
+116 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
End DoDot:1
QUIT
+117 WRITE !!,"- File conversions completed on ",$$DH4PRT^HLCSFMN1()," -",!!
+118 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
+119 QUIT
