BDWREDO ; IHS/CMI/LAB - REDO A RUN ;
;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24
START ;
D EN^XBVK("BDW")
I $D(^BDWTMP) W !!,"Previous run not completed." Q
S BDWO("RUN")="REDO" ; Let ^BDWRDRI know this is a 'REDO'
S BDWO("RUN TYPE")="REX"
D ^BDWRDRI ;
I BDW("QFLG")=66 W:'$D(ZTQUEUED) !,"Contact your site manager. ^BDWTMP still exists." D D EOJ Q
.S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR
I BDW("QFLG") D EOJ W !!,"Bye",!! Q
D INIT ; Get Log entry to redo
I BDW("QFLG") D EOJ W !!,"Bye",!! Q
D QUEUE^BDWRDRI
I BDW("QFLG") D EOJ W !!,"Bye",!! Q
I $D(BDWO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q
;
EN ;EP FROM TASKMAN
S BDWLOG=BDW("RUN LOG")
S BDWCNT=$S('$D(ZTQUEUED):"X BDWCNT1 X BDWCNT2",1:"S BDWCNTR=BDWCNTR+1"),BDWCNT1="F BDWCNTL=1:1:$L(BDWCNTR)+1 W @BDWBS",BDWCNT2="S BDWCNTR=BDWCNTR+1 W BDWCNTR,"")"""
D NOW^%DTC S BDW("RUN START")=%,BDW("MAIN TX DATE")=$P(%,".") K %,%H,%I
D ^XBFMK S DA=BDWLOG,DIE="^BDWXLOG(",DR=".03////"_BDW("RUN START")_";.15///R"_";.22///1" D ^DIE,^XBFMK
S BDW("BT")=$HOROLOG
D PROCESS ; Generate transactions
I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination! QFLG=",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D ALPMR^BDWRDR2 ;generate ALPMR patient centric messages
I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination! QFLG=",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D LOG ; Update Log entry
I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D RUNTIME^BDWRDR
S BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
S ^BDWTMP(BDWIEDST,BDWMSGT)=""
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C" D ^DIE
D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
D RESETV ; Reset VISITs processed in Log
I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press ENTER to Continue" K DA D ^DIR K DIR
D EOJ
Q
;
PROCESS ;
D GIS^BDW1VBLI
S BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))
S ^BDWTMP(BDWIEDST,BDWMSGH)=""
D ^XBFMK S DA=BDWLOG,DIE="^BDWXLOG(",DR=".12////"_BDWMSGH D ^DIE,^XBFMK
S ^XTMP("BDWREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"DATA WAREHOUSE EXPORT REDO" ;IHS/CMI/LAB
W:'$D(ZTQUEUED) !,"Generating transactions. Counting encounters. (1)" S BDWCNTR=0
S BDWDFN=0 F S BDWDFN=$O(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN)) Q:BDWDFN'=+BDWDFN D
.K INA("DELETE"),BDWDELF,BDWDELT
.I '$D(^AUPNPAT(BDWDFN,0)) Q
.I '$D(^DPT(BDWDFN,0)) Q
.S BDWDELF=$P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13),BDWDELT=$P(^DPT(BDWDFN,0),U,19)
.I 'BDWDELF,'$$ORF^BDWUTIL1(BDWDFN) Q
.K BDWR S Y=^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),BDWR("BASE")=$P(Y,U,2),BDWR("DEMO")=$P(Y,U,3),BDWR("ALIAS")=$P(Y,U,4),BDWR("CHART")=$P(Y,U,5),BDWR("ELIG")=$P(Y,U,6)
.I BDWDELF S INA("DELETE")=BDWDELT
.S INA=0
.I BDWDELF D
..S INA("DELETE")=BDWDFN
..S BDWM=$$DW1MRG^BHLEVENT(BDWDELT,.INA)
.I 'BDWDELF D
..S BDWM=$$DW1REG^BHLEVENT(BDWDFN,.INA)
.S BDW("REG")=BDW("REG")+1,^BDWTMP(BDWIEDST,BDWM)=""
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,7)=BDWM
.K INA("DELETE"),BDWDELT,BDWDELF
K ^BDWXLOG(BDW("RUN LOG"),51) ;clean out old error log
S BDW("V DFN")=0 F S BDW("V DFN")=$O(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"))) Q:BDW("V DFN")'=+BDW("V DFN") D PROCESS2 Q:BDW("QFLG")
Q
PROCESS2 ;
K BDWE,BDWV
X BDWCNT
S ^XTMP("BDWREDO","MAIN TX",BDW("V DFN"))="",BDWV("TX GENERATED")=0
I '$D(^AUPNVSIT(BDW("V DFN"))) Q
S BDW("VPROC")=BDW("VPROC")+1
S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
S BDWV("V DATE")=+BDWV("V REC")\1
I $P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" D G SETUTIL
.S BDWE("ERROR")=100 D ^BDWRERR
K BDWVMSG D ^BDWRDR2
SETUTIL S ^XTMP("BDWREDO",BDW("V DFN"))=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$G(BDWVMSG)
Q
;
;
CHKLOG ; CHECK LOG FILE
S BDW("X")=0 F BDW("I")=BDW("RUN LOG"):-1:1 Q:'$D(^BDWXLOG(BDW("I"))) I $O(^BDWXLOG(BDW("I"),21,0)) S BDW("X")=BDW("X")+1
I BDW("X")>3 W !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
Q
;
RESETV ; RESET VISIT DATA IN LOG
W:'$D(ZTQUEUED) !,"Resetting VISIT specific data in Log file. (1)" S BDWCNTR=0
S BDW("X")=0 F S BDW("X")=$O(^XTMP("BDWREDO",BDW("X"))) Q:BDW("X")'=+BDW("X") S BDW("Y")=^(BDW("X")),^BDWXLOG(BDW("RUN LOG"),21,BDW("X"),0)=BDW("Y") X BDWCNT ;FORGIVE ME LORD
W:'$D(ZTQUEUED) !,"Resetting VISIT TX Flags. (1)" S BDWCNTR=0
S BDW("X")=0 F S BDW("X")=$O(^XTMP("BDWREDO","MAIN TX",BDW("X"))) Q:BDW("X")'=+BDW("X") D
.S DIE="^AUPNVSIT(",DA=BDW("X"),DR="1106///"_$S(^XTMP("BDWREDO","MAIN TX",BDW("X"))]"":^XTMP("BDWREDO","MAIN TX",BDW("X")),1:"@") D ^DIE K DA,DR X BDWCNT
.Q
K ^XTMP("BDWREDO")
Q
;
LOG ; UPDATE LOG
S BDW("COUNT")=BDW("REG")+BDW("VISITS") W:'$D(ZTQUEUED) !!,BDW("COUNT")," HL7 Messages were generated."
W:'$D(ZTQUEUED) !,"Updating log entry."
D NOW^%DTC S BDW("RUN STOP")=%
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC") D ^DIE I $D(Y) S BDW("QFLG")=26 Q
K DIE,DA,DR
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$G(BDW("VISITS"))_";.23///REX" D ^DIE I $D(Y) S BDW("QFLG")=26 Q
K DR,DIE,DA,DIV,DIU
S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")
D ^DIE I $D(Y) S BDW("QFLG")=26 Q
S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" D IX1^DIK K DA,DIK
D ^XBFMK
;
Q
INIT ;
D INIT^BDWRED1
Q
ABORT ; ABNORMAL TERMINATION
I $D(BDW("RUN LOG")) S BDW("QFLG1")=$O(^BDWERRC("B",BDW("QFLG"),"")),DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".15///F;.16////"_BDW("QFLG1")
I $D(ZTQUEUED) D ERRBULL^BDWRDRI3,EOJ Q
W !!,"Abnormal termination!! QFLG=",BDW("QFLG")
S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR
Q
;
EOJ ;
K AUPNVSIT
D EN^XBVK("BDW"),KILL^AUPNPAT
I $D(ZTQUEUED) S ZTREQ="@"
Q
BDWREDO ; IHS/CMI/LAB - REDO A RUN ;
+1 ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24
START ;
+1 DO EN^XBVK("BDW")
+2 IF $DATA(^BDWTMP)
WRITE !!,"Previous run not completed."
QUIT
+3 ; Let ^BDWRDRI know this is a 'REDO'
SET BDWO("RUN")="REDO"
+4 SET BDWO("RUN TYPE")="REX"
+5 ;
DO ^BDWRDRI
+6 IF BDW("QFLG")=66
IF '$DATA(ZTQUEUED)
WRITE !,"Contact your site manager. ^BDWTMP still exists."
Begin DoDot:1
+7 SET DIR(0)="EO"
SET DIR("A")="Press any key to continue"
KILL DA
DO ^DIR
KILL DIR
End DoDot:1
DO EOJ
QUIT
+8 IF BDW("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+9 ; Get Log entry to redo
DO INIT
+10 IF BDW("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+11 DO QUEUE^BDWRDRI
+12 IF BDW("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+13 IF $DATA(BDWO("QUEUE"))
DO EOJ
WRITE !!,"Okay your request is queued!",!!
QUIT
+14 ;
EN ;EP FROM TASKMAN
+1 SET BDWLOG=BDW("RUN LOG")
+2 SET BDWCNT=$SELECT('$DATA(ZTQUEUED):"X BDWCNT1 X BDWCNT2",1:"S BDWCNTR=BDWCNTR+1")
SET BDWCNT1="F BDWCNTL=1:1:$L(BDWCNTR)+1 W @BDWBS"
SET BDWCNT2="S BDWCNTR=BDWCNTR+1 W BDWCNTR,"")"""
+3 DO NOW^%DTC
SET BDW("RUN START")=%
SET BDW("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+4 DO ^XBFMK
SET DA=BDWLOG
SET DIE="^BDWXLOG("
SET DR=".03////"_BDW("RUN START")_";.15///R"_";.22///1"
DO ^DIE
DO ^XBFMK
+5 SET BDW("BT")=$HOROLOG
+6 ; Generate transactions
DO PROCESS
+7 IF BDW("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Abnormal termination! QFLG=",BDW("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+8 ;generate ALPMR patient centric messages
DO ALPMR^BDWRDR2
+9 IF BDW("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Abnormal termination! QFLG=",BDW("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+10 ; Update Log entry
DO LOG
+11 IF BDW("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Log error! ",BDW("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+12 DO RUNTIME^BDWRDR
+13 SET BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
+14 SET ^BDWTMP(BDWIEDST,BDWMSGT)=""
+15 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C"
DO ^DIE
+16 ; See if Log needs cleaning
IF '$DATA(ZTQUEUED)
DO CHKLOG
+17 ; Reset VISITs processed in Log
DO RESETV
+18 IF '$DATA(ZTQUEUED)
SET DIR(0)="EO"
SET DIR("A")="DONE -- Press ENTER to Continue"
KILL DA
DO ^DIR
KILL DIR
+19 DO EOJ
+20 QUIT
+21 ;
PROCESS ;
+1 DO GIS^BDW1VBLI
+2 SET BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))
+3 SET ^BDWTMP(BDWIEDST,BDWMSGH)=""
+4 DO ^XBFMK
SET DA=BDWLOG
SET DIE="^BDWXLOG("
SET DR=".12////"_BDWMSGH
DO ^DIE
DO ^XBFMK
+5 ;IHS/CMI/LAB
SET ^XTMP("BDWREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"DATA WAREHOUSE EXPORT REDO"
+6 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting encounters. (1)"
SET BDWCNTR=0
+7 SET BDWDFN=0
FOR
SET BDWDFN=$ORDER(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN))
IF BDWDFN'=+BDWDFN
QUIT
Begin DoDot:1
+8 KILL INA("DELETE"),BDWDELF,BDWDELT
+9 IF '$DATA(^AUPNPAT(BDWDFN,0))
QUIT
+10 IF '$DATA(^DPT(BDWDFN,0))
QUIT
+11 SET BDWDELF=$PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13)
SET BDWDELT=$PIECE(^DPT(BDWDFN,0),U,19)
+12 IF 'BDWDELF
IF '$$ORF^BDWUTIL1(BDWDFN)
QUIT
+13 KILL BDWR
SET Y=^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0)
SET BDWR("BASE")=$PIECE(Y,U,2)
SET BDWR("DEMO")=$PIECE(Y,U,3)
SET BDWR("ALIAS")=$PIECE(Y,U,4)
SET BDWR("CHART")=$PIECE(Y,U,5)
SET BDWR("ELIG")=$PIECE(Y,U,6)
+14 IF BDWDELF
SET INA("DELETE")=BDWDELT
+15 SET INA=0
+16 IF BDWDELF
Begin DoDot:2
+17 SET INA("DELETE")=BDWDFN
+18 SET BDWM=$$DW1MRG^BHLEVENT(BDWDELT,.INA)
End DoDot:2
+19 IF 'BDWDELF
Begin DoDot:2
+20 SET BDWM=$$DW1REG^BHLEVENT(BDWDFN,.INA)
End DoDot:2
+21 SET BDW("REG")=BDW("REG")+1
SET ^BDWTMP(BDWIEDST,BDWM)=""
+22 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,7)=BDWM
+23 KILL INA("DELETE"),BDWDELT,BDWDELF
End DoDot:1
+24 ;clean out old error log
KILL ^BDWXLOG(BDW("RUN LOG"),51)
+25 SET BDW("V DFN")=0
FOR
SET BDW("V DFN")=$ORDER(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN")))
IF BDW("V DFN")'=+BDW("V DFN")
QUIT
DO PROCESS2
IF BDW("QFLG")
QUIT
+26 QUIT
PROCESS2 ;
+1 KILL BDWE,BDWV
+2 XECUTE BDWCNT
+3 SET ^XTMP("BDWREDO","MAIN TX",BDW("V DFN"))=""
SET BDWV("TX GENERATED")=0
+4 IF '$DATA(^AUPNVSIT(BDW("V DFN")))
QUIT
+5 SET BDW("VPROC")=BDW("VPROC")+1
+6 SET BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
+7 SET BDWV("V DATE")=+BDWV("V REC")\1
+8 IF $PIECE(BDWV("V REC"),U,11)
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,6)=""
Begin DoDot:1
+9 SET BDWE("ERROR")=100
DO ^BDWRERR
End DoDot:1
GOTO SETUTIL
+10 KILL BDWVMSG
DO ^BDWRDR2
SETUTIL SET ^XTMP("BDWREDO",BDW("V DFN"))=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$GET(BDWVMSG)
+1 QUIT
+2 ;
+3 ;
CHKLOG ; CHECK LOG FILE
+1 SET BDW("X")=0
FOR BDW("I")=BDW("RUN LOG"):-1:1
IF '$DATA(^BDWXLOG(BDW("I")))
QUIT
IF $ORDER(^BDWXLOG(BDW("I"),21,0))
SET BDW("X")=BDW("X")+1
+2 IF BDW("X")>3
WRITE !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
+3 QUIT
+4 ;
RESETV ; RESET VISIT DATA IN LOG
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting VISIT specific data in Log file. (1)"
SET BDWCNTR=0
+2 ;FORGIVE ME LORD
SET BDW("X")=0
FOR
SET BDW("X")=$ORDER(^XTMP("BDWREDO",BDW("X")))
IF BDW("X")'=+BDW("X")
QUIT
SET BDW("Y")=^(BDW("X"))
SET ^BDWXLOG(BDW("RUN LOG"),21,BDW("X"),0)=BDW("Y")
XECUTE BDWCNT
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting VISIT TX Flags. (1)"
SET BDWCNTR=0
+4 SET BDW("X")=0
FOR
SET BDW("X")=$ORDER(^XTMP("BDWREDO","MAIN TX",BDW("X")))
IF BDW("X")'=+BDW("X")
QUIT
Begin DoDot:1
+5 SET DIE="^AUPNVSIT("
SET DA=BDW("X")
SET DR="1106///"_$SELECT(^XTMP("BDWREDO","MAIN TX",BDW("X"))]"":^XTMP("BDWREDO","MAIN TX",BDW("X")),1:"@")
DO ^DIE
KILL DA,DR
XECUTE BDWCNT
+6 QUIT
End DoDot:1
+7 KILL ^XTMP("BDWREDO")
+8 QUIT
+9 ;
LOG ; UPDATE LOG
+1 SET BDW("COUNT")=BDW("REG")+BDW("VISITS")
IF '$DATA(ZTQUEUED)
WRITE !!,BDW("COUNT")," HL7 Messages were generated."
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Updating log entry."
+3 DO NOW^%DTC
SET BDW("RUN STOP")=%
+4 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC")
DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+5 KILL DIE,DA,DR
+6 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$GET(BDW("VISITS"))_";.23///REX"
DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+7 KILL DR,DIE,DA,DIV,DIU
+8 SET DIE="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")
+9 DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+10 SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
DO IX1^DIK
KILL DA,DIK
+11 DO ^XBFMK
+12 ;
+13 QUIT
INIT ;
+1 DO INIT^BDWRED1
+2 QUIT
ABORT ; ABNORMAL TERMINATION
+1 IF $DATA(BDW("RUN LOG"))
SET BDW("QFLG1")=$ORDER(^BDWERRC("B",BDW("QFLG"),""))
SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".15///F;.16////"_BDW("QFLG1")
+2 IF $DATA(ZTQUEUED)
DO ERRBULL^BDWRDRI3
DO EOJ
QUIT
+3 WRITE !!,"Abnormal termination!! QFLG=",BDW("QFLG")
+4 SET DIR(0)="EO"
SET DIR("A")="Press any key to continue"
KILL DA
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
EOJ ;
+1 KILL AUPNVSIT
+2 DO EN^XBVK("BDW")
DO KILL^AUPNPAT
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
