AMHEXD ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
Q
I $D(ZTQUEUED) S AMHO("SCHEDULED")=""
S AMHO("RUN")="NEW" ; Let AMHEXDI know this is a new run.
D ^AMHEXDI ; 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 ^AMHEXLOG ; Update Log
I AMH("QFLG") D ABORT Q
D PURGE ; Purge AEX xref entries
D RUNTIME^AMHEXEOJ ; Show run time
L
D TAPE ; Write transactions to tape
I AMH("QFLG") D ABORT Q
;D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
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,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")
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))
S AMHV("TX GENERATED")=0,^XTMP("AMHDR",AMH("CONTROL DATE"),AMHR)="",^XTMP("AMHDR","MAIN TX",AMHR)=""
X AMHCNT
S AMHREC=^AMHREC(AMHR,0)
S AMHV("R DATE")=+AMHREC\1
K AMHE,AMHTX D RECORD^AMHEXD2
D CNTBUILD
D ^XBFMK
S DA=AMH("RUN LOG"),DR="2101///""`"_AMHR_"""",DIE="^AMHXLOG("
S DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")_";.03///"_$E(AMHTX)
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"),^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
;
;
CNTBUILD ;count and build tx
I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ^AMHEXERR 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 AMH($E(AMHTX))=AMH($E(AMHTX))+1
S ^AMHSDATA(AMH("COUNT"))="MH^"_AMHTX
Q
TAPE ; COPY TRANSACTIONS TO TAPE
;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,7)
;I AMH("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S AMH("QFLG")=4 Q
D EN^AMHEXTAP I $D(ZTQUEUED),AMH("QFLG") D ERRBULL^AMHEXDI3
;Q:AMH("DEF DEVICE")="F"
;Q:AMH("QFLG")
;Q:$D(ZTQUEUED)
;S DIR(0)="Y",DIR("A")="Do you want to write the MHSS transactions to an output device",DIR("B")="N" K DA D ^DIR K DIR
;Q:$D(DIRUT)
;Q:'Y
;I Y=1 S AMH("AMHTAPE")="" D EN^AMHEXTAP
;I AMH("QFLG")=99 S AMH("QFLG")=0
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^AMHEXDI3,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 ^AMHEXEOJ
Q
AMHEXD ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
+1 QUIT
+2 IF $DATA(ZTQUEUED)
SET AMHO("SCHEDULED")=""
+3 ; Let AMHEXDI know this is a new run.
SET AMHO("RUN")="NEW"
+4 ; Do initialization
DO ^AMHEXDI
+5 IF $DATA(AMHO("QUEUE"))
DO EOJ
WRITE !!,"Okay, your request is queued! Bye",!
QUIT
+6 IF AMH("QFLG")=99
DO EOJ
WRITE !!,"Bye",!!
QUIT
+7 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 ^AMHEXLOG
+9 IF AMH("QFLG")
DO ABORT
QUIT
+10 ; Purge AEX xref entries
DO PURGE
+11 ; Show run time
DO RUNTIME^AMHEXEOJ
+12 LOCK
+13 ; Write transactions to tape
DO TAPE
+14 IF AMH("QFLG")
DO ABORT
QUIT
+15 ;D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
+16 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
+17 DO EOJ
+18 QUIT
+19 ;
PROCESS ;
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting records. (1)"
+2 SET AMHCNTR=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 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 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 AMHREC=^AMHREC(AMHR,0)
+7 SET AMHV("R DATE")=+AMHREC\1
+8 KILL AMHE,AMHTX
DO RECORD^AMHEXD2
+9 DO CNTBUILD
+10 DO ^XBFMK
+11 SET DA=AMH("RUN LOG")
SET DR="2101///""`"_AMHR_""""
SET DIE="^AMHXLOG("
+12 SET DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")_";.03///"_$EXTRACT(AMHTX)
+13 DO CALLDIE^AMHLEIN
+14 QUIT
+15 ;
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"),^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 ;
+6 ;
CNTBUILD ;count and build tx
+1 IF AMHE]""
SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1
DO ^AMHEXERR
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 AMH($EXTRACT(AMHTX))=AMH($EXTRACT(AMHTX))+1
+5 SET ^AMHSDATA(AMH("COUNT"))="MH^"_AMHTX
+6 QUIT
TAPE ; COPY TRANSACTIONS TO TAPE
+1 ;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,7)
+2 ;I AMH("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S AMH("QFLG")=4 Q
+3 DO EN^AMHEXTAP
IF $DATA(ZTQUEUED)
IF AMH("QFLG")
DO ERRBULL^AMHEXDI3
+4 ;Q:AMH("DEF DEVICE")="F"
+5 ;Q:AMH("QFLG")
+6 ;Q:$D(ZTQUEUED)
+7 ;S DIR(0)="Y",DIR("A")="Do you want to write the MHSS transactions to an output device",DIR("B")="N" K DA D ^DIR K DIR
+8 ;Q:$D(DIRUT)
+9 ;Q:'Y
+10 ;I Y=1 S AMH("AMHTAPE")="" D EN^AMHEXTAP
+11 ;I AMH("QFLG")=99 S AMH("QFLG")=0
+12 QUIT
+13 ;
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^AMHEXDI3
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 ^AMHEXEOJ
+2 QUIT
