Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDWRDR

BDWRDR.m

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