AMHEYRE ; IHS/CMI/LAB - REDO A PREVIOUS MHSS EXPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
S AMHO("RUN")="REDO" ; Let ^AMHEYDI know this is a 'REDO'
D ^AMHEYDI ;
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^AMHEYDI
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 ^AMHEYRLG ; Update Log entry
I AMH("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",AMH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) RUNTIME^AMHEYEOJ
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")
S AMHCNTR=0,AMH("CONTROL DATE")="",AMHSFR=0
W:'$D(ZTQUEUED) !,"Generating suicide forms.."
S AMHSFIEN=0 F S AMHSFIEN=$O(^AMHXLOG(AMH("RUN LOG"),31,"B",AMHSFIEN)) Q:AMHSFIEN'=+AMHSFIEN D
.I '$D(^AMHPSUIC(AMHSFIEN,0)) Q
.S AMHSREC=^AMHPSUIC(AMHSFIEN,0)
.S DFN=$P(AMHSREC,U,4)
.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
.S AMH("COUNT")=AMH("COUNT")+1,AMHSFC=AMHSFC+1
.S ^XTMP("AMHSF","MAIN TX",AMHSFIEN)=AMH("MAIN TX DATE")
.S ^BHSXDATA(AMH("COUNT"))=AMHTX
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^AMHEYD2
CNTBUILD ;count and build tx
I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ERRLOG^AMHEYD 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
SETUTIL S ^XTMP("AMHREDO",AMHR)=AMHR_U_AMHV("TX GENERATED")
Q
;
TAPE ; COPY TRANSACTIONS TO TAPE
D EN^AMHEYTAP I $D(ZTQUEUED),AMH("QFLG") D ABORT
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")
;NOW RESET SUICIDE FORMS
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
I ^XTMP("AMHSF","MAIN TX",AMHR)]"" S DIE="^AMHPSUIC(",DA=AMHR,DR=".23///"_^XTMP("AMHSF","MAIN TX",AMHR) D CALLDIE^AMHLEIN
X AMHCNT
Q
;
INIT ;
D INIT^AMHEYRE1
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^AMHEYDI3,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 ^AMHEYEOJ
Q
AMHEYRE ; IHS/CMI/LAB - REDO A PREVIOUS MHSS EXPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
+1 ; Let ^AMHEYDI know this is a 'REDO'
SET AMHO("RUN")="REDO"
+2 ;
DO ^AMHEYDI
+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^AMHEYDI
+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 ^AMHEYRLG
+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^AMHEYEOJ
+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 SET AMHCNTR=0
SET AMH("CONTROL DATE")=""
SET AMHSFR=0
+6 IF '$DATA(ZTQUEUED)
WRITE !,"Generating suicide forms.."
+7 SET AMHSFIEN=0
FOR
SET AMHSFIEN=$ORDER(^AMHXLOG(AMH("RUN LOG"),31,"B",AMHSFIEN))
IF AMHSFIEN'=+AMHSFIEN
QUIT
Begin DoDot:1
+8 IF '$DATA(^AMHPSUIC(AMHSFIEN,0))
QUIT
+9 SET AMHSREC=^AMHPSUIC(AMHSFIEN,0)
+10 SET DFN=$PIECE(AMHSREC,U,4)
+11 SET AMHRIEN=$ORDER(^AMHRECD("B","BH2",0))
+12 IF 'AMHRIEN
QUIT
+13 SET AMHY=0
SET AMHTX=""
FOR
SET AMHY=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY))
IF AMHY'=+AMHY
QUIT
Begin DoDot:2
+14 SET X=""
+15 SET AMHZ=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY,0))
+16 IF '$DATA(^AMHRECD(AMHRIEN,11,AMHZ,1))
QUIT
+17 XECUTE ^AMHRECD(AMHRIEN,11,AMHZ,1)
+18 SET $PIECE(AMHTX,U,AMHY)=X
End DoDot:2
+19 SET AMH("COUNT")=AMH("COUNT")+1
SET AMHSFC=AMHSFC+1
+20 SET ^XTMP("AMHSF","MAIN TX",AMHSFIEN)=AMH("MAIN TX DATE")
+21 SET ^BHSXDATA(AMH("COUNT"))=AMHTX
End DoDot:1
+22 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^AMHEYD2
CNTBUILD ;count and build tx
+1 IF AMHE]""
SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1
DO ERRLOG^AMHEYD
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
SETUTIL SET ^XTMP("AMHREDO",AMHR)=AMHR_U_AMHV("TX GENERATED")
+1 QUIT
+2 ;
TAPE ; COPY TRANSACTIONS TO TAPE
+1 DO EN^AMHEYTAP
IF $DATA(ZTQUEUED)
IF AMH("QFLG")
DO ABORT
+2 QUIT
+3 ;
+4 ;
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 ;NOW RESET SUICIDE FORMS
+9 SET AMHCNTR=0
SET AMHV("R DATE")=""
+10 FOR
SET AMHV("R DATE")=$ORDER(^XTMP("AMHSF",AMHV("R DATE")))
IF AMHV("R DATE")'=+AMHV("R DATE")
QUIT
DO PURGE2SF
+11 KILL ^XTMP("AMHSF")
+12 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 IF ^XTMP("AMHSF","MAIN TX",AMHR)]""
SET DIE="^AMHPSUIC("
SET DA=AMHR
SET DR=".23///"_^XTMP("AMHSF","MAIN TX",AMHR)
DO CALLDIE^AMHLEIN
+2 XECUTE AMHCNT
+3 QUIT
+4 ;
INIT ;
+1 DO INIT^AMHEYRE1
+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^AMHEYDI3
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 ^AMHEYEOJ
+2 QUIT
