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