source: FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLPOST16.m@ 636

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