AMHEYD.m

AMHEYD ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ; 22 Jun 2017  12:04 PM

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5,6,8,9,10**;JUN 02, 2010;Build 15

START ;

 I $D(ZTQUEUED) S AMHO("SCHEDULED")=""

 S AMHO("RUN")="NEW" ;      Let AMHEYDI know this is a new run.

 D ^AMHEYDI ;           Do initialization

 I $D(AMHO("QUEUE")) D EOJ W !!,"Okay, your request is queued!  Bye",! Q

 I AMH("QFLG")=99 D EOJ W !!,"Bye",!! Q

 I AMH("QFLG") D ABORT Q

DRIVER ;called from TSKMN+2

 S AMH("BT")=$H

 D NOW^%DTC S AMH("RUN START")=%,AMH("MAIN TX DATE")=$P(%,".") K %,%H,%I

 S DIE="^AMHXLOG(",DA=AMH("RUN LOG"),DR=".15///R"_";.03////"_AMH("RUN START") D CALLDIE^AMHLEIN

 I $D(Y) D ABORT Q

 S AMHCNT=$S('$D(ZTQUEUED):"X AMHCNT1  X AMHCNT2",1:"S AMHCNTR=AMHCNTR+1"),AMHCNT1="F AMHCNTL=1:1:$L(AMHCNTR)+1 W @AMHBS",AMHCNT2="S AMHCNTR=AMHCNTR+1 W AMHCNTR,"")"""

 D PROCESS ;            Generate trasactions

 I AMH("QFLG") D ABORT Q

 D ^AMHEYLOG ;                Update Log

 I AMH("QFLG") D ABORT Q

 D PURGE,PURGESF ;              Purge AEX xref entries

 D RUNTIME^AMHEYEOJ ;            Show run time

 D TAPE ; Write transactions to tape

 I AMH("QFLG") D ABORT Q

 I '$D(ZTQUEUED) W !! S DIR(0)="E",DIR("A")="DONE  --  Press ENTER to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 D EOJ

 Q

 ;

PROCESS ;

 W:'$D(ZTQUEUED) !,"Generating transactions.  Counting records.  (1)"

 S AMHCNTR=0,AMHTOTV=0,AMH("CONTROL DATE")=AMH("RUN BEGIN")-1,AMH("T-INIT")="  ",AMH("POSTING DATE")="      "

 F  S AMH("CONTROL DATE")=$O(^AMHREC("AEX",AMH("CONTROL DATE"))) Q:AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))  D PROCESS2 Q:AMH("QFLG")

 ;now process suicide forms

 W:'$D(ZTQUEUED) !,"Generating suicide forms..."

 S AMHCNTR=0,AMH("CONTROL DATE")="",AMHSFR=0

 F  S AMH("CONTROL DATE")=$O(^AMHPSUIC("AEX",AMH("CONTROL DATE"))) Q:AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))  D

 .S AMHSFIEN=0 F  S AMHSFIEN=$O(^AMHPSUIC("AEX",AMH("CONTROL DATE"),AMHSFIEN)) Q:AMHSFIEN'=+AMHSFIEN  D

 ..I '$D(^AMHPSUIC(AMHSFIEN,0)) K ^AMHPSUIC("AEX",AMH("CONTROL DATE"),AMHSFIEN) Q

 ..S AMHSREC=^AMHPSUIC(AMHSFIEN,0)

 ..S DFN=$P(AMHSREC,U,4),AMHRACE=""

 ..S AMHRIEN=$O(^AMHRECD("B","BH2",0))

 ..I 'AMHRIEN Q

 ..S AMHY=0,AMHTX="" F  S AMHY=$O(^AMHRECD(AMHRIEN,11,"B",AMHY)) Q:AMHY'=+AMHY  D

 ...S X=""

 ...S AMHZ=$O(^AMHRECD(AMHRIEN,11,"B",AMHY,0))

 ...Q:'$D(^AMHRECD(AMHRIEN,11,AMHZ,1))

 ...X ^AMHRECD(AMHRIEN,11,AMHZ,1)

 ...S $P(AMHTX,U,AMHY)=X

 ...;I DUZ=2881 S LORICNT=$G(LORICNT)+1,^LORITEST(LORICNT)=AMHSFIEN_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,1)_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,2)_"^"_X

 ..S AMH("COUNT")=AMH("COUNT")+1,AMHSFC=AMHSFC+1

 ..S ^XTMP("AMHSF",AMH("CONTROL DATE"),AMHSFIEN)=AMH("MAIN TX DATE")

 ..S ^BHSXDATA(AMH("COUNT"))=AMHTX

 ..Q:$D(^AMHXLOG(AMH("RUN LOG"),31,"B",AMHSFIEN))  ;already have that one in the log

 ..S DA=AMH("RUN LOG"),DR="3101///"_AMHSFIEN,DIE="^AMHXLOG(" D CALLDIE^AMHLEIN

 Q

PROCESS2 ;

 S AMHR="" F  S AMHR=$O(^AMHREC("AEX",AMH("CONTROL DATE"),AMHR)) Q:AMHR=""  D PROCESS3 Q:AMH("QFLG")

 Q

PROCESS3 ;

 K AMHT,AMHV,AMHE

 D KILL^AUPNPAT

 Q:$D(^AMHXLOG(AMH("RUN LOG"),21,AMHR))  ;already in log so don't bother, already processed

 S AMHV("TX GENERATED")=0,^XTMP("AMHDR",AMH("CONTROL DATE"),AMHR)="",^XTMP("AMHDR","MAIN TX",AMHR)=""

 X AMHCNT

 S AMHTOTV=AMHTOTV+1

 S AMHREC=^AMHREC(AMHR,0)

 S AMHV("R DATE")=+AMHREC\1

 K AMHE,AMHTX D RECORD^AMHEYD2

 D CNTBUILD

 D ^XBFMK

 I $D(^AMHXLOG(AMH("RUN LOG"),21,AMHR,0)) Q  ;already in log

 S DA=AMH("RUN LOG"),DR="2101///""`"_AMHR_"""",DIE="^AMHXLOG("

 S DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")

 D CALLDIE^AMHLEIN

 Q

 ;

PURGE ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"

 S AMHCNTR=0,AMHV("R DATE")=""

 F  S AMHV("R DATE")=$O(^XTMP("AMHDR",AMHV("R DATE"))) Q:AMHV("R DATE")'=+AMHV("R DATE")  D PURGE2

 K ^XTMP("AMHDR")

 Q

PURGE2 ;

 S AMHR="" F  S AMHR=$O(^XTMP("AMHDR",AMHV("R DATE"),AMHR)) Q:AMHR=""  D RESET

 Q

 ;

RESET ; kill MHSS xref and set flag if tx 23 or 24 generated

 K ^AMHREC("AEX",AMHV("R DATE"),AMHR)

 I ^XTMP("AMHDR","MAIN TX",AMHR)]"" S DIE="^AMHREC(",DA=AMHR,DR=".24///"_^XTMP("AMHDR","MAIN TX",AMHR)_";.22///@" D CALLDIE^AMHLEIN

 X AMHCNT

 Q

 ;

PURGESF ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 W:'$D(ZTQUEUED) !,"Deleting cross-reference entries on suicide forms. (1)"

 S AMHCNTR=0,AMHV("R DATE")=""

 F  S AMHV("R DATE")=$O(^XTMP("AMHSF",AMHV("R DATE"))) Q:AMHV("R DATE")'=+AMHV("R DATE")  D PURGE2SF

 K ^XTMP("AMHSF")

 Q

PURGE2SF ;

 S AMHR="" F  S AMHR=$O(^XTMP("AMHSF",AMHV("R DATE"),AMHR)) Q:AMHR=""  D RESETSF

 Q

 ;

RESETSF ; kill MHSS xref and set flag if tx 23 or 24 generated

 K ^AMHPSUIC("AEX",AMHV("R DATE"),AMHR)

 S DIE="^AMHPSUIC(",DA=AMHR,DR=".23///"_^XTMP("AMHSF",AMHV("R DATE"),AMHR) D CALLDIE^AMHLEIN

 X AMHCNT

 Q

 ;

CNTBUILD ;count and build tx

 I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ERRLOG Q

 S AMH("COUNT")=AMH("COUNT")+1

 S AMHV("TX GENERATED")=1,^XTMP("AMH"_$S(AMHO("RUN")="NEW":"DR",AMHO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",AMHR)=AMH("MAIN TX DATE")

 S ^BHSXDATA(AMH("COUNT"))=AMHTX

 Q

TAPE ; COPY TRANSACTIONS TO TAPE

 D EN^AMHEYTAP I $D(ZTQUEUED),AMH("QFLG") D ERRBULL^AMHEYDI3

 Q

 ;

CHKLOG ; CHECK LOG FILE

 Q

 S AMH("X")=0 F AMH("I")=AMH("RUN LOG"):-1:1 Q:'$D(^AMHXLOG(AMH("I")))  I $O(^AMHXLOG(AMH("I"),21,0)) S AMH("X")=AMH("X")+1

 I AMH("X")>12 W !,"-->There are more than twelve generations of MHSS RECORDs stored in the LOG file.",!,"-->Time to do a purge."

 Q

 ;

ABORT ; ABNORMAL TERMINATION

 I $D(AMH("RUN LOG")) S AMH("QFLG1")=$O(^AMHDTER("B",AMH("QFLG"),"")),DA=AMH("RUN LOG"),DIE="^AMHXLOG(",DR=".15///F;.16////"_AMH("QFLG1")

 I $D(ZTQUEUED) D ERRBULL^AMHEYDI3,EOJ Q

 W !!,"Abnormal termination!!  QFLG=",AMH("QFLG")

 S DIR(0)="E",DIR("A")="DONE  --  Press ENTER to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 D EOJ

 Q

 ;

EOJ ; EOJ

 D ^AMHEYEOJ

 Q

ERRLOG ;EP

 S AMHE("ERR DFN")=$O(^AMHERR("B",AMHE,"")) I AMHE("ERR DFN")="" S AMHE("MSG")=AMHE_"-ERROR INFORMATION NOT IN ERROR FILE" G ERR

 S AMHE("MSG")=AMHE_"-"_$P(^AMHERR(AMHE("ERR DFN"),0),U,2) S:$L(AMHE("MSG"))=5 AMHE("MSG")=AMHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE" S AMHE("MSG")=$E(AMHE("MSG"),1,45)

ERR ;

 K DIE,DR S DA=AMH("RUN LOG"),DR="5101///""`"_AMHR_"""",DR(2,9002014.05101)=".02///"_AMHE("MSG"),DIE="^AMHXLOG("

 D CALLDIE^AMHLEIN

 I $D(Y) S AMH("QFLG")=25 W:'$D(ZTQUEUED) !!,"Error encountered in ^AMHERR.  Notify programmer!",! I $D(ZTQUEUED) D ERRBULL^AMHEYDI3

 Q

VERSION() ;EP

 Q "V40P10"

AMHEYD    ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ; 22 Jun 2017  12:04 PM

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5,6,8,9,10**;JUN 02, 2010;Build 15

START     ;

 +1        IF $DATA(ZTQUEUED)

               SET AMHO("SCHEDULED")=""

 +2       ;      Let AMHEYDI know this is a new run.

           SET AMHO("RUN")="NEW"

 +3       ;           Do initialization

           DO ^AMHEYDI

 +4        IF $DATA(AMHO("QUEUE"))

               DO EOJ

               WRITE !!,"Okay, your request is queued!  Bye",!

               QUIT 

 +5        IF AMH("QFLG")=99

               DO EOJ

               WRITE !!,"Bye",!!

               QUIT 

 +6        IF AMH("QFLG")

               DO ABORT

               QUIT 

DRIVER    ;called from TSKMN+2

 +1        SET AMH("BT")=$HOROLOG

 +2        DO NOW^%DTC

           SET AMH("RUN START")=%

           SET AMH("MAIN TX DATE")=$PIECE(%,".")

           KILL %,%H,%I

 +3        SET DIE="^AMHXLOG("

           SET DA=AMH("RUN LOG")

           SET DR=".15///R"_";.03////"_AMH("RUN START")

           DO CALLDIE^AMHLEIN

 +4        IF $DATA(Y)

               DO ABORT

               QUIT 

 +5        SET AMHCNT=$SELECT('$DATA(ZTQUEUED):"X AMHCNT1  X AMHCNT2",1:"S AMHCNTR=AMHCNTR+1")

           SET AMHCNT1="F AMHCNTL=1:1:$L(AMHCNTR)+1 W @AMHBS"

           SET AMHCNT2="S AMHCNTR=AMHCNTR+1 W AMHCNTR,"")"""

 +6       ;            Generate trasactions

           DO PROCESS

 +7        IF AMH("QFLG")

               DO ABORT

               QUIT 

 +8       ;                Update Log

           DO ^AMHEYLOG

 +9        IF AMH("QFLG")

               DO ABORT

               QUIT 

 +10      ;              Purge AEX xref entries

           DO PURGE

           DO PURGESF

 +11      ;            Show run time

           DO RUNTIME^AMHEYEOJ

 +12      ; Write transactions to tape

           DO TAPE

 +13       IF AMH("QFLG")

               DO ABORT

               QUIT 

 +14       IF '$DATA(ZTQUEUED)

               WRITE !!

               SET DIR(0)="E"

               SET DIR("A")="DONE  --  Press ENTER to Continue"

               DO ^DIR

               KILL DIR

               IF $DATA(DUOUT)

                   SET DIRUT=1

 +15       DO EOJ

 +16       QUIT 

 +17      ;

PROCESS   ;

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Generating transactions.  Counting records.  (1)"

 +2        SET AMHCNTR=0

           SET AMHTOTV=0

           SET AMH("CONTROL DATE")=AMH("RUN BEGIN")-1

           SET AMH("T-INIT")="  "

           SET AMH("POSTING DATE")="      "

 +3        FOR 

               SET AMH("CONTROL DATE")=$ORDER(^AMHREC("AEX",AMH("CONTROL DATE")))

               IF AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))

                   QUIT 

               DO PROCESS2

               IF AMH("QFLG")

                   QUIT 

 +4       ;now process suicide forms

 +5        IF '$DATA(ZTQUEUED)

               WRITE !,"Generating suicide forms..."

 +6        SET AMHCNTR=0

           SET AMH("CONTROL DATE")=""

           SET AMHSFR=0

 +7        FOR 

               SET AMH("CONTROL DATE")=$ORDER(^AMHPSUIC("AEX",AMH("CONTROL DATE")))

               IF AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))

                   QUIT 

               Begin DoDot:1

 +8                SET AMHSFIEN=0

                   FOR 

                       SET AMHSFIEN=$ORDER(^AMHPSUIC("AEX",AMH("CONTROL DATE"),AMHSFIEN))

                       IF AMHSFIEN'=+AMHSFIEN

                           QUIT 

                       Begin DoDot:2

 +9                        IF '$DATA(^AMHPSUIC(AMHSFIEN,0))

                               KILL ^AMHPSUIC("AEX",AMH("CONTROL DATE"),AMHSFIEN)

                               QUIT 

 +10                       SET AMHSREC=^AMHPSUIC(AMHSFIEN,0)

 +11                       SET DFN=$PIECE(AMHSREC,U,4)

                           SET AMHRACE=""

 +12                       SET AMHRIEN=$ORDER(^AMHRECD("B","BH2",0))

 +13                       IF 'AMHRIEN

                               QUIT 

 +14                       SET AMHY=0

                           SET AMHTX=""

                           FOR 

                               SET AMHY=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY))

                               IF AMHY'=+AMHY

                                   QUIT 

                               Begin DoDot:3

 +15                               SET X=""

 +16                               SET AMHZ=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY,0))

 +17                               IF '$DATA(^AMHRECD(AMHRIEN,11,AMHZ,1))

                                       QUIT 

 +18                               XECUTE ^AMHRECD(AMHRIEN,11,AMHZ,1)

 +19                               SET $PIECE(AMHTX,U,AMHY)=X

 +20      ;I DUZ=2881 S LORICNT=$G(LORICNT)+1,^LORITEST(LORICNT)=AMHSFIEN_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,1)_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,2)_"^"_X

                               End DoDot:3

 +21                       SET AMH("COUNT")=AMH("COUNT")+1

                           SET AMHSFC=AMHSFC+1

 +22                       SET ^XTMP("AMHSF",AMH("CONTROL DATE"),AMHSFIEN)=AMH("MAIN TX DATE")

 +23                       SET ^BHSXDATA(AMH("COUNT"))=AMHTX

 +24      ;already have that one in the log

                           IF $DATA(^AMHXLOG(AMH("RUN LOG"),31,"B",AMHSFIEN))

                               QUIT 

 +25                       SET DA=AMH("RUN LOG")

                           SET DR="3101///"_AMHSFIEN

                           SET DIE="^AMHXLOG("

                           DO CALLDIE^AMHLEIN

                       End DoDot:2

               End DoDot:1

 +26       QUIT 

PROCESS2  ;

 +1        SET AMHR=""

           FOR 

               SET AMHR=$ORDER(^AMHREC("AEX",AMH("CONTROL DATE"),AMHR))

               IF AMHR=""

                   QUIT 

               DO PROCESS3

               IF AMH("QFLG")

                   QUIT 

 +2        QUIT 

PROCESS3  ;

 +1        KILL AMHT,AMHV,AMHE

 +2        DO KILL^AUPNPAT

 +3       ;already in log so don't bother, already processed

           IF $DATA(^AMHXLOG(AMH("RUN LOG"),21,AMHR))

               QUIT 

 +4        SET AMHV("TX GENERATED")=0

           SET ^XTMP("AMHDR",AMH("CONTROL DATE"),AMHR)=""

           SET ^XTMP("AMHDR","MAIN TX",AMHR)=""

 +5        XECUTE AMHCNT

 +6        SET AMHTOTV=AMHTOTV+1

 +7        SET AMHREC=^AMHREC(AMHR,0)

 +8        SET AMHV("R DATE")=+AMHREC\1

 +9        KILL AMHE,AMHTX

           DO RECORD^AMHEYD2

 +10       DO CNTBUILD

 +11       DO ^XBFMK

 +12      ;already in log

           IF $DATA(^AMHXLOG(AMH("RUN LOG"),21,AMHR,0))

               QUIT 

 +13       SET DA=AMH("RUN LOG")

           SET DR="2101///""`"_AMHR_""""

           SET DIE="^AMHXLOG("

 +14       SET DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")

 +15       DO CALLDIE^AMHLEIN

 +16       QUIT 

 +17      ;

PURGE     ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Deleting cross-reference entries. (1)"

 +2        SET AMHCNTR=0

           SET AMHV("R DATE")=""

 +3        FOR 

               SET AMHV("R DATE")=$ORDER(^XTMP("AMHDR",AMHV("R DATE")))

               IF AMHV("R DATE")'=+AMHV("R DATE")

                   QUIT 

               DO PURGE2

 +4        KILL ^XTMP("AMHDR")

 +5        QUIT 

PURGE2    ;

 +1        SET AMHR=""

           FOR 

               SET AMHR=$ORDER(^XTMP("AMHDR",AMHV("R DATE"),AMHR))

               IF AMHR=""

                   QUIT 

               DO RESET

 +2        QUIT 

 +3       ;

RESET     ; kill MHSS xref and set flag if tx 23 or 24 generated

 +1        KILL ^AMHREC("AEX",AMHV("R DATE"),AMHR)

 +2        IF ^XTMP("AMHDR","MAIN TX",AMHR)]""

               SET DIE="^AMHREC("

               SET DA=AMHR

               SET DR=".24///"_^XTMP("AMHDR","MAIN TX",AMHR)_";.22///@"

               DO CALLDIE^AMHLEIN

 +3        XECUTE AMHCNT

 +4        QUIT 

 +5       ;

PURGESF   ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Deleting cross-reference entries on suicide forms. (1)"

 +2        SET AMHCNTR=0

           SET AMHV("R DATE")=""

 +3        FOR 

               SET AMHV("R DATE")=$ORDER(^XTMP("AMHSF",AMHV("R DATE")))

               IF AMHV("R DATE")'=+AMHV("R DATE")

                   QUIT 

               DO PURGE2SF

 +4        KILL ^XTMP("AMHSF")

 +5        QUIT 

PURGE2SF  ;

 +1        SET AMHR=""

           FOR 

               SET AMHR=$ORDER(^XTMP("AMHSF",AMHV("R DATE"),AMHR))

               IF AMHR=""

                   QUIT 

               DO RESETSF

 +2        QUIT 

 +3       ;

RESETSF   ; kill MHSS xref and set flag if tx 23 or 24 generated

 +1        KILL ^AMHPSUIC("AEX",AMHV("R DATE"),AMHR)

 +2        SET DIE="^AMHPSUIC("

           SET DA=AMHR

           SET DR=".23///"_^XTMP("AMHSF",AMHV("R DATE"),AMHR)

           DO CALLDIE^AMHLEIN

 +3        XECUTE AMHCNT

 +4        QUIT 

 +5       ;

CNTBUILD  ;count and build tx

 +1        IF AMHE]""

               SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1

               DO ERRLOG

               QUIT 

 +2        SET AMH("COUNT")=AMH("COUNT")+1

 +3        SET AMHV("TX GENERATED")=1

           SET ^XTMP("AMH"_$SELECT(AMHO("RUN")="NEW":"DR",AMHO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",AMHR)=AMH("MAIN TX DATE")

 +4        SET ^BHSXDATA(AMH("COUNT"))=AMHTX

 +5        QUIT 

TAPE      ; COPY TRANSACTIONS TO TAPE

 +1        DO EN^AMHEYTAP

           IF $DATA(ZTQUEUED)

               IF AMH("QFLG")

                   DO ERRBULL^AMHEYDI3

 +2        QUIT 

 +3       ;

CHKLOG    ; CHECK LOG FILE

 +1        QUIT 

 +2        SET AMH("X")=0

           FOR AMH("I")=AMH("RUN LOG"):-1:1

               IF '$DATA(^AMHXLOG(AMH("I")))

                   QUIT 

               IF $ORDER(^AMHXLOG(AMH("I"),21,0))

                   SET AMH("X")=AMH("X")+1

 +3        IF AMH("X")>12

               WRITE !,"-->There are more than twelve generations of MHSS RECORDs stored in the LOG file.",!,"-->Time to do a purge."

 +4        QUIT 

 +5       ;

ABORT     ; ABNORMAL TERMINATION

 +1        IF $DATA(AMH("RUN LOG"))

               SET AMH("QFLG1")=$ORDER(^AMHDTER("B",AMH("QFLG"),""))

               SET DA=AMH("RUN LOG")

               SET DIE="^AMHXLOG("

               SET DR=".15///F;.16////"_AMH("QFLG1")

 +2        IF $DATA(ZTQUEUED)

               DO ERRBULL^AMHEYDI3

               DO EOJ

               QUIT 

 +3        WRITE !!,"Abnormal termination!!  QFLG=",AMH("QFLG")

 +4        SET DIR(0)="E"

           SET DIR("A")="DONE  --  Press ENTER to Continue"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        DO EOJ

 +6        QUIT 

 +7       ;

EOJ       ; EOJ

 +1        DO ^AMHEYEOJ

 +2        QUIT 

ERRLOG    ;EP

 +1        SET AMHE("ERR DFN")=$ORDER(^AMHERR("B",AMHE,""))

           IF AMHE("ERR DFN")=""

               SET AMHE("MSG")=AMHE_"-ERROR INFORMATION NOT IN ERROR FILE"

               GOTO ERR

 +2        SET AMHE("MSG")=AMHE_"-"_$PIECE(^AMHERR(AMHE("ERR DFN"),0),U,2)

           IF $LENGTH(AMHE("MSG"))=5

               SET AMHE("MSG")=AMHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE"

           SET AMHE("MSG")=$EXTRACT(AMHE("MSG"),1,45)

ERR       ;

 +1        KILL DIE,DR

           SET DA=AMH("RUN LOG")

           SET DR="5101///""`"_AMHR_""""

           SET DR(2,9002014.05101)=".02///"_AMHE("MSG")

           SET DIE="^AMHXLOG("

 +2        DO CALLDIE^AMHLEIN

 +3        IF $DATA(Y)

               SET AMH("QFLG")=25

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Error encountered in ^AMHERR.  Notify programmer!",!

               IF $DATA(ZTQUEUED)

                   DO ERRBULL^AMHEYDI3

 +4        QUIT 

VERSION() ;EP

 +1        QUIT "V40P10"