AMHEXRE ; IHS/CMI/LAB - REDO A PREVIOUS MHSS EXPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
S AMHO("RUN")="REDO" ; Let ^AMHEXDI know this is a 'REDO'
D ^AMHEXDI ;
I AMH("QFLG") D EOJ W !!,"Bye",!! Q
D INIT ; Get Log entry to redo
I AMH("QFLG") D EOJ W !!,"Bye",!! Q
D QUEUE^AMHEXDI
I AMH("QFLG") D EOJ W !!,"Bye",!! Q
I $D(AMHO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q
;
EN ;EP FROM TASKMAN
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 NOW^%DTC S AMH("RUN START")=%,AMH("MAIN TX DATE")=$P(%,".") K %,%H,%I
I AMH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
S AMH("BT")=$HOROLOG
D PROCESS ; Generate transactions
I AMH("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination! QFLG=",AMH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D ^AMHEXRLG ; Update Log entry
I AMH("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",AMH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) RUNTIME^AMHEXEOJ
I AMH("QFLG") W:'$D(ZTQUEUED) !!,"Tape creation error! QFLG=",AMH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
D RESETV ; Reset RECORDs processed in Log
D TAPE ; Write transactions to tape
I '$D(ZTQUEUED) S DIR(0)="E",DIR("A")="DONE--Press enter to continue" K DA D ^DIR K DIR
D EOJ
K AMH
Q
;
PROCESS ;
K ^AMHXLOG(AMH("RUN LOG"),51)
S (AMH("A"),AMH("D"),AMH("M"),AMH("COUNT"),AMH("ERROR COUNT"))=0
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)" S AMHCNTR=0
S AMHR=0 F S AMHR=$O(^AMHXLOG(AMH("RUN LOG"),21,AMHR)) Q:AMHR'=+AMHR D PROCESS2 Q:AMH("QFLG")
Q
PROCESS2 ;
K AMHE,AMHV,AMHTX
X AMHCNT
S ^XTMP("AMHREDO","MAIN TX",AMHR)="",AMHV("TX GENERATED")=0
Q:'$D(^AMHREC(AMHR))
S AMHREC=^AMHREC(AMHR,0)
S AMHV("V DATE")=+AMHREC\1
D KILL^AUPNPAT D RECORD^AMHEXD2
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
SETUTIL S ^XTMP("AMHREDO",AMHR)=AMHR_U_AMHV("TX GENERATED")_U_$E(AMHTX)
Q
;
TAPE ; COPY TRANSACTIONS TO TAPE
;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,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
D EN^AMHEXTAP I $D(ZTQUEUED),AMH("QFLG") D ABORT
;Q:AMH("QFLG")
;Q:$D(ZTQUEUED)
;Q:$P(^AMHSITE(DUZ(2),0),U,11)="Y"
;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
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")>3 W !!,"-->There are more than three generations of RECORDs stored in the LOG file.",!,"-->Time to do a purge."
Q
;
RESETV ; RESET RECORD DATA IN LOG
W:'$D(ZTQUEUED) !,"Resetting RECORD specific data in Log file. (1)" S AMHCNTR=0
S AMH("X")="" F S AMH("X")=$O(^XTMP("AMHREDO",AMH("X"))) Q:AMH("X")'=+AMH("X") S AMH("Y")=^(AMH("X")),^AMHXLOG(AMH("RUN LOG"),21,AMH("X"),0)=AMH("Y") X AMHCNT ;FORGIVE ME LORD
W:'$D(ZTQUEUED) !,"Resetting RECORD TX Flags. (1)" S AMHCNTR=0
S AMH("X")="" F S AMH("X")=$O(^XTMP("AMHREDO","MAIN TX",AMH("X"))) Q:AMH("X")'=+AMH("X") D
.S DIE="^AMHREC(",DA=AMH("X"),DR=".24///"_$S(^XTMP("AMHREDO","MAIN TX",AMH("X"))]"":^XTMP("AMHREDO","MAIN TX",AMH("X")),1:"@") D CALLDIE^AMHLEIN K DA,DR X AMHCNT
.Q
K ^XTMP("AMHREDO")
Q
;
INIT ;
D INIT^AMHEXRE1
Q
ABORT ; ABNORMAL TERMINATION
I $D(AMH("RUN LOG")) S AMH("QFLG1")=$O(^AMHERRC("B",AMH("QFLG"),"")),DA=AMH("RUN LOG"),DIE="^AMHXLOG(",DR=".15///F;.16////"_AMH("QFLG1")
I $D(ZTQUEUED) D ERRBULL^AMHEXDI3,ABORT,EOJ Q
W !!,"Abnormal termination!! QFLG=",AMH("QFLG")
S DIR(0)="EO",DIR("A")="Press enter to continue" K DA D ^DIR K DIR
Q
;
EOJ ;
D ^AMHEXEOJ
Q
AMHEXRE ; IHS/CMI/LAB - REDO A PREVIOUS MHSS EXPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
+1 ; Let ^AMHEXDI know this is a 'REDO'
SET AMHO("RUN")="REDO"
+2 ;
DO ^AMHEXDI
+3 IF AMH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+4 ; Get Log entry to redo
DO INIT
+5 IF AMH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+6 DO QUEUE^AMHEXDI
+7 IF AMH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+8 IF $DATA(AMHO("QUEUE"))
DO EOJ
WRITE !!,"Okay your request is queued!",!!
QUIT
+9 ;
EN ;EP FROM TASKMAN
+1 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,"")"""
+2 DO NOW^%DTC
SET AMH("RUN START")=%
SET AMH("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+3 IF AMH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+4 SET AMH("BT")=$HOROLOG
+5 ; Generate transactions
DO PROCESS
+6 IF AMH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Abnormal termination! QFLG=",AMH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+7 ; Update Log entry
DO ^AMHEXRLG
+8 IF AMH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Log error! ",AMH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+9 IF '$DATA(ZTQUEUED)
DO RUNTIME^AMHEXEOJ
+10 IF AMH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Tape creation error! QFLG=",AMH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+11 ; See if Log needs cleaning
IF '$DATA(ZTQUEUED)
DO CHKLOG
+12 ; Reset RECORDs processed in Log
DO RESETV
+13 ; Write transactions to tape
DO TAPE
+14 IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
SET DIR("A")="DONE--Press enter to continue"
KILL DA
DO ^DIR
KILL DIR
+15 DO EOJ
+16 KILL AMH
+17 QUIT
+18 ;
PROCESS ;
+1 KILL ^AMHXLOG(AMH("RUN LOG"),51)
+2 SET (AMH("A"),AMH("D"),AMH("M"),AMH("COUNT"),AMH("ERROR COUNT"))=0
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
SET AMHCNTR=0
+4 SET AMHR=0
FOR
SET AMHR=$ORDER(^AMHXLOG(AMH("RUN LOG"),21,AMHR))
IF AMHR'=+AMHR
QUIT
DO PROCESS2
IF AMH("QFLG")
QUIT
+5 QUIT
PROCESS2 ;
+1 KILL AMHE,AMHV,AMHTX
+2 XECUTE AMHCNT
+3 SET ^XTMP("AMHREDO","MAIN TX",AMHR)=""
SET AMHV("TX GENERATED")=0
+4 IF '$DATA(^AMHREC(AMHR))
QUIT
+5 SET AMHREC=^AMHREC(AMHR,0)
+6 SET AMHV("V DATE")=+AMHREC\1
+7 DO KILL^AUPNPAT
DO RECORD^AMHEXD2
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
SETUTIL SET ^XTMP("AMHREDO",AMHR)=AMHR_U_AMHV("TX GENERATED")_U_$EXTRACT(AMHTX)
+1 QUIT
+2 ;
TAPE ; COPY TRANSACTIONS TO TAPE
+1 ;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,2)
+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 ABORT
+4 ;Q:AMH("QFLG")
+5 ;Q:$D(ZTQUEUED)
+6 ;Q:$P(^AMHSITE(DUZ(2),0),U,11)="Y"
+7 ;Q:$D(ZTQUEUED)
+8 ;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
+9 ;Q:$D(DIRUT)
+10 ;Q:'Y
+11 ;I Y=1 S AMH("AMHTAPE")="" D EN^AMHEXTAP
+12 ;I AMH("QFLG")=99 S AMH("QFLG")=0
+13 QUIT
+14 ;
+15 ;
CHKLOG ; CHECK LOG FILE
+1 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
+2 IF AMH("X")>3
WRITE !!,"-->There are more than three generations of RECORDs stored in the LOG file.",!,"-->Time to do a purge."
+3 QUIT
+4 ;
RESETV ; RESET RECORD DATA IN LOG
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting RECORD specific data in Log file. (1)"
SET AMHCNTR=0
+2 ;FORGIVE ME LORD
SET AMH("X")=""
FOR
SET AMH("X")=$ORDER(^XTMP("AMHREDO",AMH("X")))
IF AMH("X")'=+AMH("X")
QUIT
SET AMH("Y")=^(AMH("X"))
SET ^AMHXLOG(AMH("RUN LOG"),21,AMH("X"),0)=AMH("Y")
XECUTE AMHCNT
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting RECORD TX Flags. (1)"
SET AMHCNTR=0
+4 SET AMH("X")=""
FOR
SET AMH("X")=$ORDER(^XTMP("AMHREDO","MAIN TX",AMH("X")))
IF AMH("X")'=+AMH("X")
QUIT
Begin DoDot:1
+5 SET DIE="^AMHREC("
SET DA=AMH("X")
SET DR=".24///"_$SELECT(^XTMP("AMHREDO","MAIN TX",AMH("X"))]"":^XTMP("AMHREDO","MAIN TX",AMH("X")),1:"@")
DO CALLDIE^AMHLEIN
KILL DA,DR
XECUTE AMHCNT
+6 QUIT
End DoDot:1
+7 KILL ^XTMP("AMHREDO")
+8 QUIT
+9 ;
INIT ;
+1 DO INIT^AMHEXRE1
+2 QUIT
ABORT ; ABNORMAL TERMINATION
+1 IF $DATA(AMH("RUN LOG"))
SET AMH("QFLG1")=$ORDER(^AMHERRC("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 ABORT
DO EOJ
QUIT
+3 WRITE !!,"Abnormal termination!! QFLG=",AMH("QFLG")
+4 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue"
KILL DA
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
EOJ ;
+1 DO ^AMHEXEOJ
+2 QUIT
