BCHEXRE ; IHS/CMI/LAB - REDO A PREVIOUS CHR EXPORT ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - $J to tmp
START ;
S BCHO("RUN")="REDO" ; Let ^BCHEXDI know this is a 'REDO'
D ^BCHEXDI ;
I BCH("QFLG") D EOJ W !!,"Bye",!! Q
D INIT ; Get Log entry to redo
I BCH("QFLG") D EOJ W !!,"Bye",!! Q
D QUEUE^BCHEXDI
I BCH("QFLG") D EOJ W !!,"Bye",!! Q
I $D(BCHO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q
;
EN ;EP FROM TASKMAN
S BCHCNT=$S('$D(ZTQUEUED):"X BCHCNT1 X BCHCNT2",1:"S BCHCNTR=BCHCNTR+1"),BCHCNT1="F BCHCNTL=1:1:$L(BCHCNTR)+1 W @BCHBS",BCHCNT2="S BCHCNTR=BCHCNTR+1 W BCHCNTR,"")"""
D NOW^%DTC S BCH("RUN START")=%,BCH("MAIN TX DATE")=$P(%,".") K %,%H,%I
I BCH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
S BCH("BT")=$HOROLOG
D PROCESS ; Generate transactions
I BCH("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination! QFLG=",BCH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D ^BCHEXRLG ; Update Log entry
I BCH("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",BCH("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) RUNTIME^BCHEXEOJ
I BCH("QFLG") W:'$D(ZTQUEUED) !!,"Tape creation error! QFLG=",BCH("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) K DIR W !! S DIR(0)="E",DIR("A")="DONE -- press any key to continue" K DA D ^DIR K DIR
D EOJ
K BCH
Q
;
PROCESS ;
K ^BCHXLOG(BCH("RUN LOG"),51)
S (BCH("U"),BCH("D"),BCH("COUNT"),BCH("ERROR COUNT"))=0
;build header record
;S BCH("COUNT")=BCH("COUNT")+1,^BCHRDATA(BCH("COUNT"))="CR^"
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)" S BCHCNTR=0
S BCHR=0 F S BCHR=$O(^BCHXLOG(BCH("RUN LOG"),21,BCHR)) Q:BCHR'=+BCHR S BCHRTYPE=$P(^BCHXLOG(BCH("RUN LOG"),21,BCHR,0),U,3) D PROCESS2 Q:BCH("QFLG")
;D DELETES
Q
PROCESS2 ;
K BCHE,BCHCPOV,BCH("POVS")
X BCHCNT
S ^TMP("BCHREDO",$J,"MAIN TX",BCHR)="",BCHV("TX GENERATED")=0
Q:'$D(^BCHR(BCHR))
I '$D(^BCHRPROB("AD",BCHR)) S BCHE="E021" D CNTBUILD Q
S BCHREC=^BCHR(BCHR,0)
K BCHE,BCHTX S (BCHCPOV,BCHPOVD)=0 F S BCHPOVD=$O(^BCHRPROB("AD",BCHR,BCHPOVD)) Q:BCHPOVD'=+BCHPOVD D
.I $P(^BCHRPROB(BCHPOVD,0),U,4)="" S BCHE="E021" Q
.I $P(^BCHRPROB(BCHPOVD,0),U,6)="" S BCHE="E021" Q
.;D RECORD^BCHEXD2
.;D CNTBUILD
.Q
I $D(BCHE) D CNTBUILD Q
D RECORD^BCHEXD2
D CNTBUILD
Q
CNTBUILD ;EP - count and build tx
I BCHE]"" S BCH("ERROR COUNT")=BCH("ERROR COUNT")+1 D ^BCHEXERR Q
S BCH("COUNT")=BCH("COUNT")+1
S BCH(BCHRTYPE)=BCH(BCHRTYPE)+1
S BCHV("TX GENERATED")=1,^TMP("BCH"_$S(BCHO("RUN")="NEW":"DR",BCHO("RUN")="REDO":"REDO",1:"DR"),$J,"MAIN TX",BCHR)=BCH("MAIN TX DATE")
S ^BCHRDATA(BCH("COUNT"))=BCHTX
S X=0 F S X=$O(BCH("POVS",X)) Q:X'=+X S BCH("COUNT")=BCH("COUNT")+1,^BCHRDATA(BCH("COUNT"))=BCH("POVS",X) ;IHS/CMI/LAB - new format
SETUTIL S ^TMP("BCHREDO",$J,BCHR)=BCHR_U_BCHV("TX GENERATED")_U_BCHRTYPE
Q
;
TAPE ; COPY TRANSACTIONS TO TAPE
D TAPE^BCHEXTAP
Q
DELETES ;
D DELETES^BCHEXRE1
Q
CHKLOG ; CHECK LOG FILE
S BCH("X")=0 F BCH("I")=BCH("RUN LOG"):-1:1 Q:'$D(^BCHXLOG(BCH("I"))) I $O(^BCHXLOG(BCH("I"),21,0)) S BCH("X")=BCH("X")+1
I BCH("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 BCHCNTR=0
S BCH("X")="" F S BCH("X")=$O(^TMP("BCHREDO",$J,BCH("X"))) Q:BCH("X")'=+BCH("X") S BCH("Y")=^(BCH("X")),^BCHXLOG(BCH("RUN LOG"),21,BCH("X"),0)=BCH("Y") X BCHCNT
W:'$D(ZTQUEUED) !,"Resetting RECORD TX Flags. (1)" S BCHCNTR=0
S BCH("X")="" F S BCH("X")=$O(^TMP("BCHREDO",$J,"MAIN TX",BCH("X"))) Q:BCH("X")'=+BCH("X") D
.S DIE="^BCHR(",DA=BCH("X"),DR=".24///"_$S(^TMP("BCHREDO",$J,"MAIN TX",BCH("X"))]"":^TMP("BCHREDO",$J,"MAIN TX",BCH("X")),1:"@") D CALLDIE^BCHUTIL K DA,DR X BCHCNT
.Q
K ^TMP("BCHREDO")
Q
;
INIT ;
D INIT^BCHEXRE1
Q
ABORT ; ABNORMAL TERMINATION
I $D(BCH("RUN LOG")) S BCH("QFLG1")=$O(^BCHERR("B",BCH("QFLG"),"")),DA=BCH("RUN LOG"),DIE="^BCHXLOG(",DR=".15///F;.16////"_BCH("QFLG1")
I $D(ZTQUEUED) D ERRBULL^BCHEXDI3,ABORT,EOJ Q
W !!,"Abnormal termination!! QFLG=",BCH("QFLG")
S DIR(0)="E",DIR("A")="Press any key to continue" K DA D ^DIR K DIR
Q
;
EOJ ;
D ^BCHEXEOJ
Q
BCHEXRE ; IHS/CMI/LAB - REDO A PREVIOUS CHR EXPORT ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - $J to tmp
START ;
+1 ; Let ^BCHEXDI know this is a 'REDO'
SET BCHO("RUN")="REDO"
+2 ;
DO ^BCHEXDI
+3 IF BCH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+4 ; Get Log entry to redo
DO INIT
+5 IF BCH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+6 DO QUEUE^BCHEXDI
+7 IF BCH("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+8 IF $DATA(BCHO("QUEUE"))
DO EOJ
WRITE !!,"Okay your request is queued!",!!
QUIT
+9 ;
EN ;EP FROM TASKMAN
+1 SET BCHCNT=$SELECT('$DATA(ZTQUEUED):"X BCHCNT1 X BCHCNT2",1:"S BCHCNTR=BCHCNTR+1")
SET BCHCNT1="F BCHCNTL=1:1:$L(BCHCNTR)+1 W @BCHBS"
SET BCHCNT2="S BCHCNTR=BCHCNTR+1 W BCHCNTR,"")"""
+2 DO NOW^%DTC
SET BCH("RUN START")=%
SET BCH("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+3 IF BCH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+4 SET BCH("BT")=$HOROLOG
+5 ; Generate transactions
DO PROCESS
+6 IF BCH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Abnormal termination! QFLG=",BCH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+7 ; Update Log entry
DO ^BCHEXRLG
+8 IF BCH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Log error! ",BCH("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+9 IF '$DATA(ZTQUEUED)
DO RUNTIME^BCHEXEOJ
+10 IF BCH("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Tape creation error! QFLG=",BCH("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)
KILL DIR
WRITE !!
SET DIR(0)="E"
SET DIR("A")="DONE -- press any key to continue"
KILL DA
DO ^DIR
KILL DIR
+15 DO EOJ
+16 KILL BCH
+17 QUIT
+18 ;
PROCESS ;
+1 KILL ^BCHXLOG(BCH("RUN LOG"),51)
+2 SET (BCH("U"),BCH("D"),BCH("COUNT"),BCH("ERROR COUNT"))=0
+3 ;build header record
+4 ;S BCH("COUNT")=BCH("COUNT")+1,^BCHRDATA(BCH("COUNT"))="CR^"
+5 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
SET BCHCNTR=0
+6 SET BCHR=0
FOR
SET BCHR=$ORDER(^BCHXLOG(BCH("RUN LOG"),21,BCHR))
IF BCHR'=+BCHR
QUIT
SET BCHRTYPE=$PIECE(^BCHXLOG(BCH("RUN LOG"),21,BCHR,0),U,3)
DO PROCESS2
IF BCH("QFLG")
QUIT
+7 ;D DELETES
+8 QUIT
PROCESS2 ;
+1 KILL BCHE,BCHCPOV,BCH("POVS")
+2 XECUTE BCHCNT
+3 SET ^TMP("BCHREDO",$JOB,"MAIN TX",BCHR)=""
SET BCHV("TX GENERATED")=0
+4 IF '$DATA(^BCHR(BCHR))
QUIT
+5 IF '$DATA(^BCHRPROB("AD",BCHR))
SET BCHE="E021"
DO CNTBUILD
QUIT
+6 SET BCHREC=^BCHR(BCHR,0)
+7 KILL BCHE,BCHTX
SET (BCHCPOV,BCHPOVD)=0
FOR
SET BCHPOVD=$ORDER(^BCHRPROB("AD",BCHR,BCHPOVD))
IF BCHPOVD'=+BCHPOVD
QUIT
Begin DoDot:1
+8 IF $PIECE(^BCHRPROB(BCHPOVD,0),U,4)=""
SET BCHE="E021"
QUIT
+9 IF $PIECE(^BCHRPROB(BCHPOVD,0),U,6)=""
SET BCHE="E021"
QUIT
+10 ;D RECORD^BCHEXD2
+11 ;D CNTBUILD
+12 QUIT
End DoDot:1
+13 IF $DATA(BCHE)
DO CNTBUILD
QUIT
+14 DO RECORD^BCHEXD2
+15 DO CNTBUILD
+16 QUIT
CNTBUILD ;EP - count and build tx
+1 IF BCHE]""
SET BCH("ERROR COUNT")=BCH("ERROR COUNT")+1
DO ^BCHEXERR
QUIT
+2 SET BCH("COUNT")=BCH("COUNT")+1
+3 SET BCH(BCHRTYPE)=BCH(BCHRTYPE)+1
+4 SET BCHV("TX GENERATED")=1
SET ^TMP("BCH"_$SELECT(BCHO("RUN")="NEW":"DR",BCHO("RUN")="REDO":"REDO",1:"DR"),$JOB,"MAIN TX",BCHR)=BCH("MAIN TX DATE")
+5 SET ^BCHRDATA(BCH("COUNT"))=BCHTX
+6 ;IHS/CMI/LAB - new format
SET X=0
FOR
SET X=$ORDER(BCH("POVS",X))
IF X'=+X
QUIT
SET BCH("COUNT")=BCH("COUNT")+1
SET ^BCHRDATA(BCH("COUNT"))=BCH("POVS",X)
SETUTIL SET ^TMP("BCHREDO",$JOB,BCHR)=BCHR_U_BCHV("TX GENERATED")_U_BCHRTYPE
+1 QUIT
+2 ;
TAPE ; COPY TRANSACTIONS TO TAPE
+1 DO TAPE^BCHEXTAP
+2 QUIT
DELETES ;
+1 DO DELETES^BCHEXRE1
+2 QUIT
CHKLOG ; CHECK LOG FILE
+1 SET BCH("X")=0
FOR BCH("I")=BCH("RUN LOG"):-1:1
IF '$DATA(^BCHXLOG(BCH("I")))
QUIT
IF $ORDER(^BCHXLOG(BCH("I"),21,0))
SET BCH("X")=BCH("X")+1
+2 IF BCH("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 BCHCNTR=0
+2 SET BCH("X")=""
FOR
SET BCH("X")=$ORDER(^TMP("BCHREDO",$JOB,BCH("X")))
IF BCH("X")'=+BCH("X")
QUIT
SET BCH("Y")=^(BCH("X"))
SET ^BCHXLOG(BCH("RUN LOG"),21,BCH("X"),0)=BCH("Y")
XECUTE BCHCNT
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting RECORD TX Flags. (1)"
SET BCHCNTR=0
+4 SET BCH("X")=""
FOR
SET BCH("X")=$ORDER(^TMP("BCHREDO",$JOB,"MAIN TX",BCH("X")))
IF BCH("X")'=+BCH("X")
QUIT
Begin DoDot:1
+5 SET DIE="^BCHR("
SET DA=BCH("X")
SET DR=".24///"_$SELECT(^TMP("BCHREDO",$JOB,"MAIN TX",BCH("X"))]"":^TMP("BCHREDO",$JOB,"MAIN TX",BCH("X")),1:"@")
DO CALLDIE^BCHUTIL
KILL DA,DR
XECUTE BCHCNT
+6 QUIT
End DoDot:1
+7 KILL ^TMP("BCHREDO")
+8 QUIT
+9 ;
INIT ;
+1 DO INIT^BCHEXRE1
+2 QUIT
ABORT ; ABNORMAL TERMINATION
+1 IF $DATA(BCH("RUN LOG"))
SET BCH("QFLG1")=$ORDER(^BCHERR("B",BCH("QFLG"),""))
SET DA=BCH("RUN LOG")
SET DIE="^BCHXLOG("
SET DR=".15///F;.16////"_BCH("QFLG1")
+2 IF $DATA(ZTQUEUED)
DO ERRBULL^BCHEXDI3
DO ABORT
DO EOJ
QUIT
+3 WRITE !!,"Abnormal termination!! QFLG=",BCH("QFLG")
+4 SET DIR(0)="E"
SET DIR("A")="Press any key to continue"
KILL DA
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
EOJ ;
+1 DO ^BCHEXEOJ
+2 QUIT
