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"
