- 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
