BDWRDR ; IHS/CMI/LAB - MAIN DRIVER DW EXPORT ;
;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
;
START ;EP - called from option
K BDWDDR
I $D(ZTQUEUED) S BDWO("SCHEDULED")=""
S BDWO("RUN")="NEW" ; Let BDWDRI know this is a new run.
D ^BDWRDRI ; Do initialization
I $D(BDWO("QUEUE")) D EOJ W !!,"Okay, request queued!!",!! Q
I BDW("QFLG")=99 D EOJ W !!,"Bye",!! Q
I BDW("QFLG")=4 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 ABORT Q
DRIVER ;EP called from TSKMN+2
S BDW("BT")=$H
D NOW^%DTC S BDW("RUN START")=%,BDW("MAIN TX DATE")=$P(%,".") K %,%H,%I
S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR=".15///R"_";.03////"_BDW("RUN START")_";.23////GDW" D ^DIE K DA,DIE,DR
I BDW("QFLG") D ABORT Q
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 PROCESS ; Generate trasactions
I BDW("QFLG") D ABORT Q
;maw TODO uncomment this when ready to try the other messages
D ALPMR^BDWRDR2 ;generate ALPMR patient centric messages
I BDW("QFLG") D ABORT Q
D LOG ; Update Log
I BDW("QFLG") D ABORT Q
S BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
S ^BDWTMP(BDWIEDST,BDWMSGT)=""
D PURGE ; Purge ADW xref entries
D RUNTIME
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C" D ^DIE
I BDW("QFLG") D ABORT Q
D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
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
K ^TMP($J,"BDWTRAILER")
I '$D(ZTQUEUED) W !,"Generating Registration HL7 messages (1)"
S BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))
S ^BDWTMP(BDWIEDST,BDWMSGH)=""
K DIE,DR,DA S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR=".12////"_BDWMSGH D ^DIE K DIE,DA,DR
S ^XTMP("BDWDR",0)=$$FMADD^XLFDT(DT,14)_U_DT_"DATA WAREHOUSE EXPORT"
;do patient registration first
S (BDWDFN,BDWCNTR)=0 F S BDWDFN=$O(^AUPNDWAF(BDWDFN)) Q:BDWDFN'=+BDWDFN D I '$D(ZTQUEUED) X BDWCNT
.K INA("DELETE"),BDWDELF,BDWDELT
.S INA=0 ;not backload
.I '$D(^AUPNPAT(BDWDFN,0)) S DA=BDWDFN,DIK="^AUPNDWAF(" D ^DIK K DA,DIK Q
.I '$D(^DPT(BDWDFN,0)) S DA=BDWDFN,DIK="^AUPNDWAF(" D ^DIK K DA,DIK Q
.I $P(^DPT(BDWDFN,0),U)["DEMO,PATIENT" S DA=BDWDFN,DIK="^AUPNDWAF(" D ^DIK K DA,DIK Q
.S BDWDELF=$P(^AUPNDWAF(BDWDFN,0),U,13),BDWDELT=$P(^DPT(BDWDFN,0),U,19)
.I 'BDWDELF,'$$ORF^BDWUTIL1(BDWDFN) S DA=BDWDFN,DIK="^AUPNDWAF(" D ^DIK K DA,DIK Q ;no originating facility hrn
.K BDWR S BDWR("BASE")=$P(^AUPNDWAF(BDWDFN,0),U,2),BDWR("DEMO")=$P(^AUPNDWAF(BDWDFN,0),U,4),BDWR("ALIAS")=$P(^AUPNDWAF(BDWDFN,0),U,6),BDWR("CHART")=$P(^AUPNDWAF(BDWDFN,0),U,8),BDWR("ELIG")=$P(^AUPNDWAF(BDWDFN,0),U,11)
.; set original flags for 4 segments
.S BDWZRBFL=$$FLG^BDWBHL("ZRB",BDWDFN)
.S BDWZRLFL=$$FLG^BDWBHL("ZRL",BDWDFN)
.S BDWZRCFL=$$FLG^BDWBHL("ZRC",BDWDFN)
.S BDWZRDFL=$$FLG^BDWBHL("ZRD",BDWDFN)
.S BDWZINFL=$$FLG^BDWBHL("ZIN",BDWDFN)
.I BDWDELF D
..S INA("DELETE")=BDWDFN
..S BDWRMSG=$$DW1MRG^BHLEVENT(BDWDELT,.INA)
.I 'BDWDELF D
..S BDWRMSG=$$DW1REG^BHLEVENT(BDWDFN,.INA)
.S ^BDWTMP(BDWIEDST,BDWRMSG)=""
.S BDW("REG")=BDW("REG")+1
.S ^XTMP("BDWDR","PATIENT REG",BDWDFN)=""
.S:'$D(^BDWXLOG(BDW("RUN LOG"),41,0)) ^BDWXLOG(BDW("RUN LOG"),41,0)="^90213.4101PA^^"
.S X=^AUPNDWAF(BDWDFN,0),^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0)=BDWDFN_U_$P(X,U,2)_U_$P(X,U,4)_U_$P(X,U,6)_U_$P(X,U,8)_U_$P(X,U,11)_U_BDWRMSG
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13)=BDWDELF
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,8)=BDWZRBFL
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,9)=BDWZRLFL
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,10)=BDWZRCFL
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,11)=BDWZRDFL
.S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,12)=BDWZINFL
.S $P(^BDWXLOG(BDW("RUN LOG"),41,0),U,3)=BDWDFN,$P(^(0),U,4)=$P(^(0),U,4)+1
.K INA("DELETE"),BDWDELT,BDWDELF
K BDWC,BDW("X"),BDWDFN,BDWRMSG
W:'$D(ZTQUEUED) !!,"Generating transactions. Counting encounters. (1)"
S BDWCNTR=0,BDW("CONTROL DATE")=BDW("RUN BEGIN")-1
F S BDW("CONTROL DATE")=$O(^AUPNVSIT("ADWO",BDW("CONTROL DATE"))) Q:BDW("CONTROL DATE")=""!(BDW("CONTROL DATE")>BDW("RUN END")) D PROCESS2 Q:BDW("QFLG")
Q
PROCESS2 ;
S BDW("V DFN")="" F S BDW("V DFN")=$O(^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN"))) Q:BDW("V DFN")="" D PROCESS3 Q:BDW("QFLG")
Q
PROCESS3 ;
K BDWT,BDWV,BDWE
D KILL^AUPNPAT
Q:$D(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN")))
I '$D(^AUPNVSIT(BDW("V DFN"),0)) K ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")) Q
S BDWV("TX GENERATED")=0,^XTMP("BDWDR",BDW("CONTROL DATE"),BDW("V DFN"))="",^XTMP("BDWDR","MAIN TX",BDW("V DFN"))=""
S BDW("VPROC")=$G(BDW("VPROC"))+1
X BDWCNT
S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
I BDWO("RUN")="NEW",$P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" D G SET
.K ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")) S BDWE("ERROR")=100,BDW("DEL")=BDW("DEL")+1 D ^BDWRERR
I $P($G(^AUPNVSIT(BDW("V DFN"),11)),U,4)="" D ^XBFMK S DIE="^AUPNVSIT(",DA=BDW("V DFN"),DR="1104////"_$$UID^AUPNVSIT(BDW("V DFN")) D ^DIE,^XBFMK
I $P($G(^AUPNVSIT(BDW("V DFN"),11)),U,4)="" D ^XBFMK S DIE="^AUPNVSIT(",DA=BDW("V DFN"),DR="1114////"_$$UIDV^BDWAID(BDW("V DFN")) D ^DIE,^XBFMK ;cmi/anch/maw 9/6/2007 patch 2
S BDWV("V DATE")=+BDWV("V REC")\1
K BDWVMSG D ^BDWRDR2
SET S:'$D(^BDWXLOG(BDW("RUN LOG"),21,0)) ^BDWXLOG(BDW("RUN LOG"),21,0)="^90213.2101PA^^"
S ^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"),0)=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$G(BDWVMSG)
S $P(^BDWXLOG(BDW("RUN LOG"),21,0),U,3)=BDW("V DFN"),$P(^(0),U,4)=$P(^(0),U,4)+1
K DIE,DR,DIC
Q
;
PURGE ; PURGE 'ADW' XREF FOR VISITS JUST DONE
W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
S BDWCNTR=0,BDWV("V DATE")=0
F S BDWV("V DATE")=$O(^XTMP("BDWDR",BDWV("V DATE"))) Q:BDWV("V DATE")'=+BDWV("V DATE") D PURGE2
K ^XTMP("BDWDR")
Q
PURGE2 ;
S BDW("V DFN")="" F S BDW("V DFN")=$O(^XTMP("BDWDR",BDWV("V DATE"),BDW("V DFN"))) Q:BDW("V DFN")="" D RESET
Q
;
RESET ; kill ADW xref and set flag if tx 23 or 24 generated
K ^AUPNVSIT("ADWO",BDWV("V DATE"),BDW("V DFN"))
I ^XTMP("BDWDR","MAIN TX",BDW("V DFN"))]"" S DIE="^AUPNVSIT(",DA=BDW("V DFN"),DR="1106///"_^XTMP("BDWDR","MAIN TX",BDW("V DFN")) D ^DIE K DA,DIE,DR
X BDWCNT
Q
;
RST4AF(BDWLOG) ;EP
S BDWX=0 F S BDWX=$O(^BDWXLOG(BDWLOG,41,BDWX)) Q:BDWX'=+BDWX D
.Q:'$D(^AUPNPAT(BDWX,0))
.Q:'$D(^DPT(BDWX,0))
.I '$P(^DPT(BDWX,0),U,19) D
..S Y=^AUPNDWAF(BDWX,0),DA=BDWX,DIE="^AUPNPAT(",DR=".41///"_$P(Y,U,2)_";.42////"_$P(Y,U,4)_";.43////"_$P(Y,U,6)_";.44////"_$P(Y,U,8)_";.45////"_$P(Y,U,11)
..D ^DIE K DA,DIE,DR
.S DA=BDWX,DIK="^AUPNDWAF(" D ^DIK K DA,DIK
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")>25 W !,"-->There are more than 25 generations of ENCOUNTERs stored in the LOG file.",!,"-->Time to do a purge."
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^BDWRDRI2,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
D EOJ
Q
;
LOG ; UPDATE LOG
S BDW("COUNT")=BDW("REG")+BDW("VISITS")+$G(BDW("ALPMR")) 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"))_";.19////"_$G(BDW("ALPMR")) 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
K DR,DIE,DA,DIV,DIU
S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR="3108////"_BDW("ADDS")_";3109////"_BDW("MODS")_";3110////"_BDW("DELS")
D ^DIE I $D(Y) S BDW("QFLG")=26 Q
TR ;trailer report
S BDWLOC=0,BDWLOCC=0,BDWTYPE="",BDWMODE="",BDWDATE="",BDWLC=0
S X="EXPORT SITE: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.09) D S
S X="DATE OF EXPORT: "_$$FMTE^XLFDT($P($P(^BDWXLOG(BDW("RUN LOG"),0),U,3),".")) D S
S X="TOTAL NUMBER OF ENCOUNTERS EXPORTED: "_$P(^BDWXLOG(BDW("RUN LOG"),0),U,18) D S
S X="TOTAL NUMBER OF ADDS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3108) D S
S X="TOTAL NUMBER OF MODS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3109) D S
S X="TOTAL NUMBER OF DELETES: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3110) D S
;cmi/maw alpmr follows
S X="TOTAL NUMBER OF PATIENT RECORDS EXPORTED: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.19) D S
S X="" D S
S X="" D S
F S BDWLOC=$O(^TMP($J,"BDWTRAILER",BDWLOC)) Q:BDWLOC'=+BDWLOC D
.S BDWLC=BDWLC+1,BDWLOCC=BDWLOCC+1
.S X=BDWLOCC_". Location of Encounter "_$P(^AUTTLOC(BDWLOC,0),U,10) D S
.S X="" D S
.S X="Type/Cat",$E(X,30)="TOTAL COUNT",$E(X,49)="ADDS",$E(X,58)="DELETES",$E(X,70)="CHANGES" D S
.S X="---------------------------------------------------------------------------" D S
.S BDWTYPE="" F S BDWTYPE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE)) Q:BDWTYPE="" D
..S X=BDWTYPE,$E(X,33)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"TOT")),0,9),$E(X,46)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"A")),0,9)
..S $E(X,58)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"D")),0,9),$E(X,70)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"M")),0,9)
..D S
.S X="" D S
.S X="" D S
.S X="COUNT BY DATE OF ENCOUNTERS" D S
.S X="TYPE/CAT",$E(X,33)="MONTH/YR",$E(X,49)="TOTAL" D S
.S X="---------------------------------------------------------------------------" D S
.S BDWTYPE="" F S BDWTYPE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE)) Q:BDWTYPE="" D
..S BDWDATE=0 F S BDWDATE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE)) Q:BDWDATE="" D
...S X=BDWTYPE,$E(X,33)=$$FMTE^XLFDT(BDWDATE),$E(X,46)=$$C(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE),0,9) D S
...Q
..Q
.S X="" D S
.S X="" D S
.Q
S ^BDWXLOG(BDW("RUN LOG"),99,0)="^^"_BDWLC_"^"_BDWLC_"^"_DT
S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" D IX1^DIK K DA,DIK
D ^XBFMK
;
Q
C(X,X2,X3) ;
I X="" Q ""
D COMMA^%DTC
Q X
S ;
S BDWLC=BDWLC+1
S ^BDWXLOG(BDW("RUN LOG"),99,BDWLC,0)=X
K X
Q
EOJ ; EOJ
K ^TMP($J)
K AUPNVSIT
K DIADD,DLAYGO
D ^XBFMK
D KILL^AUPNPAT
D EN^XBVK("BDW"),EN^XBVK("APCD")
I $D(ZTQUEUED) S ZTREQ="@"
Q
RUNTIME ;EP - SHOW RUN
S B=BDW("BT")
S E=$HOROLOG
S T=(86400*($P(E,",")-$P(B,",")))+($P(E,",",2)-$P(B,",",2)),H=$P(T/3600,".")
S:H="" H=0
S T=T-(H*3600),M=$P(T/60,".")
S:M="" M=0
S T=T-(M*60),S=T
W:'$D(ZTQUEUED) !!,"RUN TIME (H.M.S): ",H,".",M,".",S
S BDWRUN=H_"."_M_"."_S
K B,E,H,M,S,T
Q
QUEUE ;EP - called from option that can be scheduled to run automatically
K BDWDDR
I $D(ZTQUEUED) S BDWO("SCHEDULED")=""
S BDWO("RUN")="NEW" ; Let BDWDRI know this is a new run.
D ^BDWRDRI ; Do initialization
I BDW("QFLG") D ABORT Q
D DRIVER
Q
BDWRDR ; IHS/CMI/LAB - MAIN DRIVER DW EXPORT ;
+1 ;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
+2 ;
START ;EP - called from option
+1 KILL BDWDDR
+2 IF $DATA(ZTQUEUED)
SET BDWO("SCHEDULED")=""
+3 ; Let BDWDRI know this is a new run.
SET BDWO("RUN")="NEW"
+4 ; Do initialization
DO ^BDWRDRI
+5 IF $DATA(BDWO("QUEUE"))
DO EOJ
WRITE !!,"Okay, request queued!!",!!
QUIT
+6 IF BDW("QFLG")=99
DO EOJ
WRITE !!,"Bye",!!
QUIT
+7 IF BDW("QFLG")=4
IF '$DATA(ZTQUEUED)
WRITE !,"Contact your site manager. ^BDWTMP still exists."
Begin DoDot:1
+8 SET DIR(0)="EO"
SET DIR("A")="Press any key to continue"
KILL DA
DO ^DIR
KILL DIR
End DoDot:1
DO EOJ
QUIT
+9 IF BDW("QFLG")
DO ABORT
QUIT
DRIVER ;EP called from TSKMN+2
+1 SET BDW("BT")=$HOROLOG
+2 DO NOW^%DTC
SET BDW("RUN START")=%
SET BDW("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+3 SET DIE="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR=".15///R"_";.03////"_BDW("RUN START")_";.23////GDW"
DO ^DIE
KILL DA,DIE,DR
+4 IF BDW("QFLG")
DO ABORT
QUIT
+5 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,"")"""
+6 ; Generate trasactions
DO PROCESS
+7 IF BDW("QFLG")
DO ABORT
QUIT
+8 ;maw TODO uncomment this when ready to try the other messages
+9 ;generate ALPMR patient centric messages
DO ALPMR^BDWRDR2
+10 IF BDW("QFLG")
DO ABORT
QUIT
+11 ; Update Log
DO LOG
+12 IF BDW("QFLG")
DO ABORT
QUIT
+13 SET BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
+14 SET ^BDWTMP(BDWIEDST,BDWMSGT)=""
+15 ; Purge ADW xref entries
DO PURGE
+16 DO RUNTIME
+17 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C"
DO ^DIE
+18 IF BDW("QFLG")
DO ABORT
QUIT
+19 ; See if Log needs cleaning
IF '$DATA(ZTQUEUED)
DO CHKLOG
+20 IF '$DATA(ZTQUEUED)
SET DIR(0)="EO"
SET DIR("A")="DONE -- Press ENTER to Continue"
KILL DA
DO ^DIR
KILL DIR
+21 DO EOJ
+22 QUIT
+23 ;
PROCESS ;
+1 DO GIS^BDW1VBLI
+2 KILL ^TMP($JOB,"BDWTRAILER")
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Generating Registration HL7 messages (1)"
+4 SET BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))
+5 SET ^BDWTMP(BDWIEDST,BDWMSGH)=""
+6 KILL DIE,DR,DA
SET DIE="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR=".12////"_BDWMSGH
DO ^DIE
KILL DIE,DA,DR
+7 SET ^XTMP("BDWDR",0)=$$FMADD^XLFDT(DT,14)_U_DT_"DATA WAREHOUSE EXPORT"
+8 ;do patient registration first
+9 SET (BDWDFN,BDWCNTR)=0
FOR
SET BDWDFN=$ORDER(^AUPNDWAF(BDWDFN))
IF BDWDFN'=+BDWDFN
QUIT
Begin DoDot:1
+10 KILL INA("DELETE"),BDWDELF,BDWDELT
+11 ;not backload
SET INA=0
+12 IF '$DATA(^AUPNPAT(BDWDFN,0))
SET DA=BDWDFN
SET DIK="^AUPNDWAF("
DO ^DIK
KILL DA,DIK
QUIT
+13 IF '$DATA(^DPT(BDWDFN,0))
SET DA=BDWDFN
SET DIK="^AUPNDWAF("
DO ^DIK
KILL DA,DIK
QUIT
+14 IF $PIECE(^DPT(BDWDFN,0),U)["DEMO,PATIENT"
SET DA=BDWDFN
SET DIK="^AUPNDWAF("
DO ^DIK
KILL DA,DIK
QUIT
+15 SET BDWDELF=$PIECE(^AUPNDWAF(BDWDFN,0),U,13)
SET BDWDELT=$PIECE(^DPT(BDWDFN,0),U,19)
+16 ;no originating facility hrn
IF 'BDWDELF
IF '$$ORF^BDWUTIL1(BDWDFN)
SET DA=BDWDFN
SET DIK="^AUPNDWAF("
DO ^DIK
KILL DA,DIK
QUIT
+17 KILL BDWR
SET BDWR("BASE")=$PIECE(^AUPNDWAF(BDWDFN,0),U,2)
SET BDWR("DEMO")=$PIECE(^AUPNDWAF(BDWDFN,0),U,4)
SET BDWR("ALIAS")=$PIECE(^AUPNDWAF(BDWDFN,0),U,6)
SET BDWR("CHART")=$PIECE(^AUPNDWAF(BDWDFN,0),U,8)
SET BDWR("ELIG")=$PIECE(^AUPNDWAF(BDWDFN,0),U,11)
+18 ; set original flags for 4 segments
+19 SET BDWZRBFL=$$FLG^BDWBHL("ZRB",BDWDFN)
+20 SET BDWZRLFL=$$FLG^BDWBHL("ZRL",BDWDFN)
+21 SET BDWZRCFL=$$FLG^BDWBHL("ZRC",BDWDFN)
+22 SET BDWZRDFL=$$FLG^BDWBHL("ZRD",BDWDFN)
+23 SET BDWZINFL=$$FLG^BDWBHL("ZIN",BDWDFN)
+24 IF BDWDELF
Begin DoDot:2
+25 SET INA("DELETE")=BDWDFN
+26 SET BDWRMSG=$$DW1MRG^BHLEVENT(BDWDELT,.INA)
End DoDot:2
+27 IF 'BDWDELF
Begin DoDot:2
+28 SET BDWRMSG=$$DW1REG^BHLEVENT(BDWDFN,.INA)
End DoDot:2
+29 SET ^BDWTMP(BDWIEDST,BDWRMSG)=""
+30 SET BDW("REG")=BDW("REG")+1
+31 SET ^XTMP("BDWDR","PATIENT REG",BDWDFN)=""
+32 IF '$DATA(^BDWXLOG(BDW("RUN LOG"),41,0))
SET ^BDWXLOG(BDW("RUN LOG"),41,0)="^90213.4101PA^^"
+33 SET X=^AUPNDWAF(BDWDFN,0)
SET ^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0)=BDWDFN_U_$PIECE(X,U,2)_U_$PIECE(X,U,4)_U_$PIECE(X,U,6)_U_$PIECE(X,U,8)_U_$PIECE(X,U,11)_U_BDWRMSG
+34 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13)=BDWDELF
+35 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,8)=BDWZRBFL
+36 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,9)=BDWZRLFL
+37 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,10)=BDWZRCFL
+38 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,11)=BDWZRDFL
+39 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,12)=BDWZINFL
+40 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,0),U,3)=BDWDFN
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+41 KILL INA("DELETE"),BDWDELT,BDWDELF
End DoDot:1
IF '$DATA(ZTQUEUED)
XECUTE BDWCNT
+42 KILL BDWC,BDW("X"),BDWDFN,BDWRMSG
+43 IF '$DATA(ZTQUEUED)
WRITE !!,"Generating transactions. Counting encounters. (1)"
+44 SET BDWCNTR=0
SET BDW("CONTROL DATE")=BDW("RUN BEGIN")-1
+45 FOR
SET BDW("CONTROL DATE")=$ORDER(^AUPNVSIT("ADWO",BDW("CONTROL DATE")))
IF BDW("CONTROL DATE")=""!(BDW("CONTROL DATE")>BDW("RUN END"))
QUIT
DO PROCESS2
IF BDW("QFLG")
QUIT
+46 QUIT
PROCESS2 ;
+1 SET BDW("V DFN")=""
FOR
SET BDW("V DFN")=$ORDER(^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")))
IF BDW("V DFN")=""
QUIT
DO PROCESS3
IF BDW("QFLG")
QUIT
+2 QUIT
PROCESS3 ;
+1 KILL BDWT,BDWV,BDWE
+2 DO KILL^AUPNPAT
+3 IF $DATA(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN")))
QUIT
+4 IF '$DATA(^AUPNVSIT(BDW("V DFN"),0))
KILL ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN"))
QUIT
+5 SET BDWV("TX GENERATED")=0
SET ^XTMP("BDWDR",BDW("CONTROL DATE"),BDW("V DFN"))=""
SET ^XTMP("BDWDR","MAIN TX",BDW("V DFN"))=""
+6 SET BDW("VPROC")=$GET(BDW("VPROC"))+1
+7 XECUTE BDWCNT
+8 SET BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
+9 IF BDWO("RUN")="NEW"
IF $PIECE(BDWV("V REC"),U,11)
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,6)=""
Begin DoDot:1
+10 KILL ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN"))
SET BDWE("ERROR")=100
SET BDW("DEL")=BDW("DEL")+1
DO ^BDWRERR
End DoDot:1
GOTO SET
+11 IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,4)=""
DO ^XBFMK
SET DIE="^AUPNVSIT("
SET DA=BDW("V DFN")
SET DR="1104////"_$$UID^AUPNVSIT(BDW("V DFN"))
DO ^DIE
DO ^XBFMK
+12 ;cmi/anch/maw 9/6/2007 patch 2
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,4)=""
DO ^XBFMK
SET DIE="^AUPNVSIT("
SET DA=BDW("V DFN")
SET DR="1114////"_$$UIDV^BDWAID(BDW("V DFN"))
DO ^DIE
DO ^XBFMK
+13 SET BDWV("V DATE")=+BDWV("V REC")\1
+14 KILL BDWVMSG
DO ^BDWRDR2
SET IF '$DATA(^BDWXLOG(BDW("RUN LOG"),21,0))
SET ^BDWXLOG(BDW("RUN LOG"),21,0)="^90213.2101PA^^"
+1 SET ^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"),0)=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$GET(BDWVMSG)
+2 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),21,0),U,3)=BDW("V DFN")
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+3 KILL DIE,DR,DIC
+4 QUIT
+5 ;
PURGE ; PURGE 'ADW' XREF FOR VISITS JUST DONE
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Deleting cross-reference entries. (1)"
+2 SET BDWCNTR=0
SET BDWV("V DATE")=0
+3 FOR
SET BDWV("V DATE")=$ORDER(^XTMP("BDWDR",BDWV("V DATE")))
IF BDWV("V DATE")'=+BDWV("V DATE")
QUIT
DO PURGE2
+4 KILL ^XTMP("BDWDR")
+5 QUIT
PURGE2 ;
+1 SET BDW("V DFN")=""
FOR
SET BDW("V DFN")=$ORDER(^XTMP("BDWDR",BDWV("V DATE"),BDW("V DFN")))
IF BDW("V DFN")=""
QUIT
DO RESET
+2 QUIT
+3 ;
RESET ; kill ADW xref and set flag if tx 23 or 24 generated
+1 KILL ^AUPNVSIT("ADWO",BDWV("V DATE"),BDW("V DFN"))
+2 IF ^XTMP("BDWDR","MAIN TX",BDW("V DFN"))]""
SET DIE="^AUPNVSIT("
SET DA=BDW("V DFN")
SET DR="1106///"_^XTMP("BDWDR","MAIN TX",BDW("V DFN"))
DO ^DIE
KILL DA,DIE,DR
+3 XECUTE BDWCNT
+4 QUIT
+5 ;
RST4AF(BDWLOG) ;EP
+1 SET BDWX=0
FOR
SET BDWX=$ORDER(^BDWXLOG(BDWLOG,41,BDWX))
IF BDWX'=+BDWX
QUIT
Begin DoDot:1
+2 IF '$DATA(^AUPNPAT(BDWX,0))
QUIT
+3 IF '$DATA(^DPT(BDWX,0))
QUIT
+4 IF '$PIECE(^DPT(BDWX,0),U,19)
Begin DoDot:2
+5 SET Y=^AUPNDWAF(BDWX,0)
SET DA=BDWX
SET DIE="^AUPNPAT("
SET DR=".41///"_$PIECE(Y,U,2)_";.42////"_$PIECE(Y,U,4)_";.43////"_$PIECE(Y,U,6)_";.44////"_$PIECE(Y,U,8)_";.45////"_$PIECE(Y,U,11)
+6 DO ^DIE
KILL DA,DIE,DR
End DoDot:2
+7 SET DA=BDWX
SET DIK="^AUPNDWAF("
DO ^DIK
KILL DA,DIK
End DoDot:1
+8 QUIT
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")>25
WRITE !,"-->There are more than 25 generations of ENCOUNTERs stored in the LOG file.",!,"-->Time to do a purge."
+3 QUIT
+4 ;
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^BDWRDRI2
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 DO EOJ
+6 QUIT
+7 ;
LOG ; UPDATE LOG
+1 SET BDW("COUNT")=BDW("REG")+BDW("VISITS")+$GET(BDW("ALPMR"))
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"))_";.19////"_$GET(BDW("ALPMR"))
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 KILL DR,DIE,DA,DIV,DIU
+11 SET DIE="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR="3108////"_BDW("ADDS")_";3109////"_BDW("MODS")_";3110////"_BDW("DELS")
+12 DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
TR ;trailer report
+1 SET BDWLOC=0
SET BDWLOCC=0
SET BDWTYPE=""
SET BDWMODE=""
SET BDWDATE=""
SET BDWLC=0
+2 SET X="EXPORT SITE: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.09)
DO S
+3 SET X="DATE OF EXPORT: "_$$FMTE^XLFDT($PIECE($PIECE(^BDWXLOG(BDW("RUN LOG"),0),U,3),"."))
DO S
+4 SET X="TOTAL NUMBER OF ENCOUNTERS EXPORTED: "_$PIECE(^BDWXLOG(BDW("RUN LOG"),0),U,18)
DO S
+5 SET X="TOTAL NUMBER OF ADDS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3108)
DO S
+6 SET X="TOTAL NUMBER OF MODS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3109)
DO S
+7 SET X="TOTAL NUMBER OF DELETES: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3110)
DO S
+8 ;cmi/maw alpmr follows
+9 SET X="TOTAL NUMBER OF PATIENT RECORDS EXPORTED: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.19)
DO S
+10 SET X=""
DO S
+11 SET X=""
DO S
+12 FOR
SET BDWLOC=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC))
IF BDWLOC'=+BDWLOC
QUIT
Begin DoDot:1
+13 SET BDWLC=BDWLC+1
SET BDWLOCC=BDWLOCC+1
+14 SET X=BDWLOCC_". Location of Encounter "_$PIECE(^AUTTLOC(BDWLOC,0),U,10)
DO S
+15 SET X=""
DO S
+16 SET X="Type/Cat"
SET $EXTRACT(X,30)="TOTAL COUNT"
SET $EXTRACT(X,49)="ADDS"
SET $EXTRACT(X,58)="DELETES"
SET $EXTRACT(X,70)="CHANGES"
DO S
+17 SET X="---------------------------------------------------------------------------"
DO S
+18 SET BDWTYPE=""
FOR
SET BDWTYPE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE))
IF BDWTYPE=""
QUIT
Begin DoDot:2
+19 SET X=BDWTYPE
SET $EXTRACT(X,33)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"TOT")),0,9)
SET $EXTRACT(X,46)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"A")),0,9)
+20 SET $EXTRACT(X,58)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"D")),0,9)
SET $EXTRACT(X,70)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"M")),0,9)
+21 DO S
End DoDot:2
+22 SET X=""
DO S
+23 SET X=""
DO S
+24 SET X="COUNT BY DATE OF ENCOUNTERS"
DO S
+25 SET X="TYPE/CAT"
SET $EXTRACT(X,33)="MONTH/YR"
SET $EXTRACT(X,49)="TOTAL"
DO S
+26 SET X="---------------------------------------------------------------------------"
DO S
+27 SET BDWTYPE=""
FOR
SET BDWTYPE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE))
IF BDWTYPE=""
QUIT
Begin DoDot:2
+28 SET BDWDATE=0
FOR
SET BDWDATE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE))
IF BDWDATE=""
QUIT
Begin DoDot:3
+29 SET X=BDWTYPE
SET $EXTRACT(X,33)=$$FMTE^XLFDT(BDWDATE)
SET $EXTRACT(X,46)=$$C(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE),0,9)
DO S
+30 QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 SET X=""
DO S
+33 SET X=""
DO S
+34 QUIT
End DoDot:1
+35 SET ^BDWXLOG(BDW("RUN LOG"),99,0)="^^"_BDWLC_"^"_BDWLC_"^"_DT
+36 SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
DO IX1^DIK
KILL DA,DIK
+37 DO ^XBFMK
+38 ;
+39 QUIT
C(X,X2,X3) ;
+1 IF X=""
QUIT ""
+2 DO COMMA^%DTC
+3 QUIT X
S ;
+1 SET BDWLC=BDWLC+1
+2 SET ^BDWXLOG(BDW("RUN LOG"),99,BDWLC,0)=X
+3 KILL X
+4 QUIT
EOJ ; EOJ
+1 KILL ^TMP($JOB)
+2 KILL AUPNVSIT
+3 KILL DIADD,DLAYGO
+4 DO ^XBFMK
+5 DO KILL^AUPNPAT
+6 DO EN^XBVK("BDW")
DO EN^XBVK("APCD")
+7 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
RUNTIME ;EP - SHOW RUN
+1 SET B=BDW("BT")
+2 SET E=$HOROLOG
+3 SET T=(86400*($PIECE(E,",")-$PIECE(B,",")))+($PIECE(E,",",2)-$PIECE(B,",",2))
SET H=$PIECE(T/3600,".")
+4 IF H=""
SET H=0
+5 SET T=T-(H*3600)
SET M=$PIECE(T/60,".")
+6 IF M=""
SET M=0
+7 SET T=T-(M*60)
SET S=T
+8 IF '$DATA(ZTQUEUED)
WRITE !!,"RUN TIME (H.M.S): ",H,".",M,".",S
+9 SET BDWRUN=H_"."_M_"."_S
+10 KILL B,E,H,M,S,T
+11 QUIT
QUEUE ;EP - called from option that can be scheduled to run automatically
+1 KILL BDWDDR
+2 IF $DATA(ZTQUEUED)
SET BDWO("SCHEDULED")=""
+3 ; Let BDWDRI know this is a new run.
SET BDWO("RUN")="NEW"
+4 ; Do initialization
DO ^BDWRDRI
+5 IF BDW("QFLG")
DO ABORT
QUIT
+6 DO DRIVER
+7 QUIT
