HLPOST16.m

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 ---HLPOST16   4610     printed  Feb 18, 2025@23:26:09                                                                                                                                                                                                    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