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

BDW1VBLI.m

Go to the documentation of this file. 
  1. BDW1VBLI ;IHS/CMI/LAB - Initialization for DW Visit backloading;
  1.  ;;1.0;IHS DATA WAREHOUSE;**2**;JAN 23, 2006
  1.  ;
  1. START ;
  1.  W !,"This routine will generate IHS Data Warehouse HL7 messages"
  1.  W !,"for the purpose of backloading the data warehouse with several years worth",!,"of encounter data.",!
  1.  W !,"Due to the time it takes to process encounters for export it is suggested that",!,"you do the export in increments.  For example, you can export 6 months worth",!,"of encounters each day until you are done.",!
  1.  ;
  1.  D BASICS ;      Set variables like U,DT,DUZ(2) etc.
  1.  D CHKSITE ;     Make sure Site file has correct fields.
  1.  Q:BDW("QFLG")
  1.  D GETLOG
  1.  Q:BDW("QFLG")
  1.  D VAUDIT
  1.  D GENLOG
  1.  D GIS
  1.  ;
  1.  D QUEUE
  1.  Q
  1.  ;
  1. VAUDIT ;
  1.  S BDWVA=1 Q  ;always create on backload per Lisa P. 5-5-04
  1.  S BDWVA=""
  1.  S DIR(0)="Y",DIR("A")="Do you want to create an ENCOUNTER AUDIT report for this batch of encounters",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I Y S BDWVA=1
  1.  Q
  1. GIS ;EP-- check background jobs for gis
  1.  W:'$D(ZTQUEUED) !!,"Checking GIS Background Jobs..."
  1.  N BDWGISI
  1.  F BDWGISI="FORMAT CONTROLLER" D
  1.  . N BDWGISS
  1.  . S BDWGISS=$$CHK^BHLBCK(BDWGISI,0)
  1.  Q
  1.  ;
  1. GETLOG ;
  1.  W !,"Encounters from October 1, 2000 through ",$$FMTE^XLFDT($P(^BDWSITE(1,0),U,2))," will be exported",!,"to the Data Warehouse before you can begin the normal data warehouse",!,"export process."
  1.  W "  This site has approximately ",$P(^BDWSITE(1,0),U,5)," encounters to export ",!,"via this special export process."
  1.  I '$O(^BDWBLOG(0)) D
  1.  .W !!,"This is the first backload run.  The beginning date for this run is 10/01/2000.",!
  1.  I $O(^BDWBLOG(0)) D
  1.  .W !!,"Thus far, you have backloaded the following encounters:"
  1.  .W !,"LOG",?6,"BEG DATE",?30,"END DATE",?55,"# ENCS",?67,"ELAPSED TIME"
  1.  .S (T,BDWX)=0 F  S BDWX=$O(^BDWBLOG(BDWX)) Q:BDWX'=+BDWX  S BDWY=^BDWBLOG(BDWX,0) D
  1.  ..W !,BDWX,?6,$$FMTE^XLFDT($P(BDWY,U,1)),?30,$$FMTE^XLFDT($P(BDWY,U,2)),?55,$P(BDWY,U,18),?67,$P(BDWY,U,13) S T=T+$P(BDWY,U,18)
  1.  .W !,"You have approximately ",($P(^BDWSITE(1,0),U,5)-T)," encounters left to export to complete",!,"the backloading process.",!
  1.  .;get last log entry
  1.  D GETLAST
  1.  Q:BDW("QFLG")
  1.  ;
  1.  ;get data for this run
  1.  D D
  1.  Q
  1. GETLAST ;
  1.  S (X,BDW("LAST LOG"))=0 F  S X=$O(^BDWBLOG(X)) Q:X'=+X  S BDW("LAST LOG")=X
  1.  I 'BDW("LAST LOG") S BDWBIEN=0,BDW("RUN BEGIN")=3001001 Q
  1.  I $P(^BDWBLOG(BDW("LAST LOG"),0),U,15)="C" D  Q
  1.  .S BDW("RUN BEGIN")=$P(^BDWBLOG(BDW("LAST LOG"),0),U,2),BDW("RUN BEGIN")=$$FMADD^XLFDT(BDW("RUN BEGIN"),1)
  1.  D ERROR
  1.  Q
  1. ERROR ;
  1.  S BDW("QFLG")=12
  1.  S BDW("PREV STATUS")=$P(^BDWBLOG(BDW("LAST LOG"),0),U,15)
  1.  I BDW("PREV STATUS")="" D EERR Q
  1.  D @(BDW("PREV STATUS")_"ERR") Q
  1.  Q
  1. EERR ;
  1.  S BDW("QFLG")=13
  1.  W $C(7),$C(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last DW DW never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
  1.  Q
  1. RERR ;
  1.  S BDW("QFLG")=15
  1.  W $C(7),$C(7),!!,"Data Warehouse Export is currently running!!"
  1.  Q
  1. QERR ;
  1.  S BDW("QFLG")=16
  1.  W !!,$C(7),$C(7),"Data Warehouse Export is already queued to run!!"
  1.  Q
  1.  ;
  1. D ;
  1.  S DIR(0)="D^:"_$P(^BDWSITE(1,0),U,2)_":EP",DIR("A")="Export encounters from "_$$FMTE^XLFDT(BDW("RUN BEGIN"))_" to what ending date" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S BDW("QFLG")=7 Q
  1.  S BDW("RUN END")=Y
  1.  Q
  1. BASICS ;EP BASIC INITS
  1.  D HOME^%ZIS S BDWBS=$S('$D(ZTQUEUED):IOBS,1:"")
  1.  K BDW,BDWS,BDWV,BDWT,BDWE,BDWERRC
  1.  S BDW("RUN LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,10),BDW("QFLG")=0
  1.  I $P($G(^BDWSITE(1,11)),U) S BDW("DNS")=1
  1.  S APCDOVRR=1 ; Allow VISIT lookup with 0 'dependent entry count'.
  1.  S (BDW("SKIP"),BDW("TXS"),BDW("VPROC"),BDW("COUNT"),BDW("VISITS"),BDWERRC,BDW("REG"),BDW("DEMO"),BDW("ZERO"),BDW("DEL"),BDW("NO PAT"),BDW("NO LOC"),BDW("NO TYPE"),BDW("NO CAT"),BDW("MFI"),BDWVA("COUNT"))=0
  1.  S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
  1.  D TAXCHK
  1.  Q
  1.  ;
  1. CHKSITE ;EP
  1.  I $D(^XTMP("BDWBLOG")) W:'$D(ZTQUEUED) !!,"** XTMP Nodes exist from previous run" S BDW("QFLG")=1 Q
  1.  I '$D(^AUTTSITE(1,0)) W:'$D(ZTQUEUED) !!,"*** RPMS SITE FILE has not been set up! ***" S BDW("QFLG")=1 Q
  1.  I $P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)="" W:'$D(ZTQUEUED) !!,"No ASUFAC for facility in RPMS Site file!!" S BDW("QFLG")=1 Q
  1.  I '$D(^BDWSITE(1,0)) W:'$D(ZTQUEUED) !!,"*** Site file has not been setup! ***" S BDW("QFLG")=1 Q
  1.  I $P(^BDWSITE(1,0),U)'=DUZ(2) W:'$D(ZTQUEUED) !!,"*** RUN LOCATION not in SITE file!" S BDW("QFLG")=2 Q
  1.  I $P(^BDWSITE(1,0),U,4)="" D
  1.  .W:'$D(ZTQUEUED) !!,"*** The Full Patient registration DW export has not been completed."
  1.  .W !,"Cannot continue.",!,"Please complete option 'Data Warehouse Full Registration Export'",!,"before you begin the encounter backload.",! S BDW("QFLG")=3 Q
  1.  Q
  1. QUEUE ;EP
  1.  K ZTSK
  1.  S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y=1 D QUEUE1 Q
  1.  I $D(DIRUT) S BDW("QFLG")=99 S DA=BDW("RUN LOG"),DIK="^BDWBLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
  1.  Q
  1. QUEUE1 ;
  1.  S ZTRTN="DRIVER^BDW1VBL"
  1.  S ZTIO="",ZTDTH="",ZTDESC="DW DATA WAREHOUSE DATA TRANSMISSION" S ZTSAVE("BDW*")="",ZTSAVE("APCD*")=""
  1.  D ^%ZTLOAD
  1.  W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
  1.  I '$D(ZTSK) S BDW("QFLG")=99 S DA=BDW("RUN LOG"),DIK="^BDWBLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
  1.  S BDWO("QUEUE")=""
  1.  S DIE="^BDWBLOG(",DA=BDW("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
  1.  K ZTSK
  1.  Q
  1. TAXCHK ;EP
  1.  K BDWQUIT
  1.  NEW A,BDWX,I,Y,Z,J
  1.  K A
  1.  S T="TAXS" F J=1:1 S Z=$T(@T+J),BDWX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BDWX=""  D
  1.  .I '$D(^ATXAX("B",BDWX)) S A(BDWX)=Y_"^is Missing" Q
  1.  .S I=$O(^ATXAX("B",BDWX,0))
  1.  .I '$D(^ATXAX(I,21,"B")) S A(BDWX)=Y_"^has no entries "
  1.  S T="LAB" F J=1:1 S Z=$T(@T+J),BDWX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BDWX=""  D
  1.  .I '$D(^ATXLAB("B",BDWX)) S A(BDWX)=Y_"^is Missing " Q
  1.  .S I=$O(^ATXLAB("B",BDWX,0))
  1.  .I '$D(^ATXLAB(I,21,"B")) S A(BDWX)=Y_"^has no entries "
  1.  I '$D(A) K A,BDWX,Y,I,Z Q
  1.  W !!,"In order for the Data Warehouse software to find all necessary data, several",!,"taxonomies must be established.  The following taxonomies are missing or have",!,"no entries:"
  1.  S BDWX="" F  S BDWX=$O(A(BDWX)) Q:BDWX=""!($D(BDWQUIT))  D
  1.  .I $Y>(IOSL-2) D PAGE Q:$D(BDWQUIT)
  1.  .W !,$P(A(BDWX),U)," [",BDWX,"] ",$P(A(BDWX),U,2)
  1.  .Q
  1. DONE ;
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of taxonomy check.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. WRITE() ;EP use XBGSAVE to save the temp global (BDWDATA) to a delimited
  1.  ; file that is exported to the DW system at 127.0.0.1
  1.  ;
  1.  N XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
  1.  N BDWASU,BDWJUL,DT,X2,X1,X
  1.  S BDWVA("COUNT")=BDWVA("COUNT")+1,^BDWDATA(BDWVA("COUNT"))="T0^"_$P($$DATE^INHUT($$NOW^XLFDT,1),"-")
  1.  S XBGL="BDWDATA",XBMED="F",XBQ="N",XBFLT=1
  1.  S XBNAR="DW Encounter Audit"
  1.  I '$D(DT) D DT^DICRW     ;get julian date for file name
  1.  S X2=$E(DT,1,3)_"0101",X1=DT
  1.  D ^%DTC
  1.  S BDWJUL=X+1
  1.  S BDWASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)  ;asufac for file name
  1.  S XBFN="BDWDWVX"_BDWASU_"."_BDW("RUN LOG")
  1.  NEW DA,DIE,DR
  1.  S DA=BDW("RUN LOG"),DIE="^BDWBLOG(",DR=".21///"_XBFN D ^DIE K DA,DIE,DR
  1.  ;S XBUF="/usr3/dsd/ljara/"  ;used in testing to make it fail
  1.  ;S XBQTO="-l dwxfer:regpcc 127.0.0.1"
  1.  S XBS1="DATA WAREHOUSE SEND"
  1.  D ^XBGSAVE
  1.  ;
  1.  I XBFLG=0 D
  1.  . W:'$D(ZTQUEUED) !,"Encounter audit file successfully created and transferred.",!!
  1.  . K ^BDWDATA
  1.  ;
  1.  I XBFLG'=0 D
  1.  . I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"VISIT audit file successfully created",!! K ^BDWDATA
  1.  . I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"VISIT audit file NOT successfully created",!!
  1.  . W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to the data warehouse",!,"you will need to manually ftp it.",!
  1.  . W:'$D(ZTQUEUED) !,XBFLG(1),!!
  1.  ;
  1.  ;
  1.  Q XBFLG
  1. GENLOG ;
  1.  D ^XBFMK
  1.  K DD,D0,DO
  1.  S X=BDW("RUN BEGIN"),DIC(0)="L",DIADD=1,DLAYGO=90214,DIC="^BDWBLOG(",DIC("DR")=".02////"_BDW("RUN END")_";.09////"_DUZ(2)_";8801////"_DUZ_";.23///EBL" D FILE^DICN
  1.  K DIADD,DLAYGO,DIC,DD,DO,D0
  1.  I Y=-1 W !!,"Error generating new log entry." S BDW("QFLG")=8 D ^XBFMK Q
  1.  S BDW("RUN LOG")=+Y
  1.  D ^XBFMK
  1.  Q
  1. PAGE ;
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDWQUIT="" Q
  1.  Q
  1. TAXS ;
  1.  ;;DM AUDIT DIET EDUC TOPICS;;Diabetes Diet Education Topics
  1.  ;;DM AUDIT ACE INHIBITORS;;ACE Inhibitor Drug Taxonomy
  1.  ;;
  1. LAB ;
  1.  ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy
  1.  ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy
  1.  ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy
  1.  ;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests Taxonomy
  1.  ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
  1.  ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy
  1.  ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
  1.  ;;APCH FECAL OCCULT BLOOD
  1.  ;;BDW PAP SMEAR LAB TESTS
  1.  ;;BDW PSA TESTS TAX
  1.  ;;