BDWRDRI ; IHS/CMI/LAB - INIT FOR DW ;
;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
;
START ;
D BASICS ; Set variables like U,DT,DUZ(2) etc.
D CHKSITE ; Make sure Site file has correct fields.
D CLNADWO ; Clean out ADWO cross references that have a time stamp
Q:BDW("QFLG")
;
D:BDWO("RUN")="NEW" ^BDWRDRI2 ; Do new run initialization.
Q:$D(ZTQUEUED)
Q:BDW("QFLG")
D:BDWO("RUN")="NEW" QUEUE
Q
;
BASICS ;EP - BASIC INITS
K ^BDWDATA ;export global
S BDWVA("COUNT")=0
D HOME^%ZIS S BDWBS=$S('$D(ZTQUEUED):IOBS,1:"")
K BDW,BDWS,BDWV,BDWT,BDWE,BDWERRC
S BDW("RUN LOCATION")=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10),BDW("QFLG")=0
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 (BDW("MODS"),BDW("ADDS"),BDW("DELS"))=0
S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
D TAXCHK
Q
;
CHKSITE ;EP
S BDWS("PROV FILE")=$S($P(^DD(9000010.06,.01,0),U,2)[200:200,1:6)
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,6)="" W:'$D(ZTQUEUED) !!,"VISIT backloading has not been completed. Must be finished first." S BDW("QFLG")=3 Q
I $P($G(^BDWSITE(1,11)),U) S BDW("DNS")=1
S X=$O(^INRHD("B","HL IHS DW1 IE",0))
I $D(^BDWTMP(X)) W:'$D(ZTQUEUED) !!,"previous DW export not written to host file" S BDW("QFLG")=4 Q
K ^BDWTMP(X)
Q
CLNADWO ;EP cleanup ADWO cross references that are invalid
W:'$D(ZTQUEUED) !,"Checking ADWO cross reference for invalid data"
N BDWDA,BDWDIEN
S BDWDA=0 F S BDWDA=$O(^AUPNVSIT("ADWO",BDWDA)) Q:'BDWDA D
. S BDWDIEN=0 F S BDWDIEN=$O(^AUPNVSIT("ADWO",BDWDA,BDWDIEN)) Q:'BDWDIEN D
.. I $L(BDWDA)'=7 K ^AUPNVSIT("ADWO",BDWDA,BDWDIEN) W "."
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 BDWO("RUN")="NEW",$D(DIRUT) S BDW("QFLG")=99 S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
I BDWO("RUN")="REDO",$D(DIRUT) S BDW("QFLG")=99 Q
Q
QUEUE1 ;
S ZTRTN=$S(BDWO("RUN")="NEW":"DRIVER^BDWRDR",1:"EN^BDWREDO")
S ZTIO="",ZTDTH="",ZTDESC="DATA WAREHOUSE DATA TRANSMISSION" S ZTSAVE("BDW*")="",ZTSAVE("APCD*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),BDWO("RUN")="NEW" S BDW("QFLG")=99 S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" 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="^BDWXLOG(",DA=BDW("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
TAXCHK ;EP
I $D(BDWO("SCHEDULED")) Q ;don't do this if scheduled
K BDWQUIT
I '$D(ZTQUEUED) W !,"Checking for Taxonomies to support the Data Warehouse Extract...",!
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) W:'$D(ZTQUEUED) !,"All okay.",! K A,BDWX,Y,I,Z Q
I $D(ZTQUEUED) Q
W:'$D(ZTQUEUED) !!,"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. HIT ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
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
;;
BDWRDRI ; IHS/CMI/LAB - INIT FOR DW ;
+1 ;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
+2 ;
START ;
+1 ; Set variables like U,DT,DUZ(2) etc.
DO BASICS
+2 ; Make sure Site file has correct fields.
DO CHKSITE
+3 ; Clean out ADWO cross references that have a time stamp
DO CLNADWO
+4 IF BDW("QFLG")
QUIT
+5 ;
+6 ; Do new run initialization.
IF BDWO("RUN")="NEW"
DO ^BDWRDRI2
+7 IF $DATA(ZTQUEUED)
QUIT
+8 IF BDW("QFLG")
QUIT
+9 IF BDWO("RUN")="NEW"
DO QUEUE
+10 QUIT
+11 ;
BASICS ;EP - BASIC INITS
+1 ;export global
KILL ^BDWDATA
+2 SET BDWVA("COUNT")=0
+3 DO HOME^%ZIS
SET BDWBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+4 KILL BDW,BDWS,BDWV,BDWT,BDWE,BDWERRC
+5 SET BDW("RUN LOCATION")=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)
SET BDW("QFLG")=0
+6 ; Allow VISIT lookup with 0 'dependent entry count'.
SET APCDOVRR=1
+7 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
+8 SET (BDW("MODS"),BDW("ADDS"),BDW("DELS"))=0
+9 SET BDWIEDST=$ORDER(^INRHD("B","HL IHS DW1 IE",0))
+10 DO TAXCHK
+11 QUIT
+12 ;
CHKSITE ;EP
+1 SET BDWS("PROV FILE")=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:200,1:6)
+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,6)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT backloading has not been completed. Must be finished first."
SET BDW("QFLG")=3
QUIT
+7 IF $PIECE($GET(^BDWSITE(1,11)),U)
SET BDW("DNS")=1
+8 SET X=$ORDER(^INRHD("B","HL IHS DW1 IE",0))
+9 IF $DATA(^BDWTMP(X))
IF '$DATA(ZTQUEUED)
WRITE !!,"previous DW export not written to host file"
SET BDW("QFLG")=4
QUIT
+10 KILL ^BDWTMP(X)
+11 QUIT
CLNADWO ;EP cleanup ADWO cross references that are invalid
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Checking ADWO cross reference for invalid data"
+2 NEW BDWDA,BDWDIEN
+3 SET BDWDA=0
FOR
SET BDWDA=$ORDER(^AUPNVSIT("ADWO",BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+4 SET BDWDIEN=0
FOR
SET BDWDIEN=$ORDER(^AUPNVSIT("ADWO",BDWDA,BDWDIEN))
IF 'BDWDIEN
QUIT
Begin DoDot:2
+5 IF $LENGTH(BDWDA)'=7
KILL ^AUPNVSIT("ADWO",BDWDA,BDWDIEN)
WRITE "."
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
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 BDWO("RUN")="NEW"
IF $DATA(DIRUT)
SET BDW("QFLG")=99
SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 IF BDWO("RUN")="REDO"
IF $DATA(DIRUT)
SET BDW("QFLG")=99
QUIT
+6 QUIT
QUEUE1 ;
+1 SET ZTRTN=$SELECT(BDWO("RUN")="NEW":"DRIVER^BDWRDR",1:"EN^BDWREDO")
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="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)
IF BDWO("RUN")="NEW"
SET BDW("QFLG")=99
SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
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="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR=".15///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
TAXCHK ;EP
+1 ;don't do this if scheduled
IF $DATA(BDWO("SCHEDULED"))
QUIT
+2 KILL BDWQUIT
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Checking for Taxonomies to support the Data Warehouse Extract...",!
+4 NEW A,BDWX,I,Y,Z,J
+5 KILL A
+6 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
+7 IF '$DATA(^ATXAX("B",BDWX))
SET A(BDWX)=Y_"^is Missing"
QUIT
+8 SET I=$ORDER(^ATXAX("B",BDWX,0))
+9 IF '$DATA(^ATXAX(I,21,"B"))
SET A(BDWX)=Y_"^has no entries "
End DoDot:1
+10 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
+11 IF '$DATA(^ATXLAB("B",BDWX))
SET A(BDWX)=Y_"^is Missing "
QUIT
+12 SET I=$ORDER(^ATXLAB("B",BDWX,0))
+13 IF '$DATA(^ATXLAB(I,21,"B"))
SET A(BDWX)=Y_"^has no entries "
End DoDot:1
+14 IF '$DATA(A)
IF '$DATA(ZTQUEUED)
WRITE !,"All okay.",!
KILL A,BDWX,Y,I,Z
QUIT
+15 IF $DATA(ZTQUEUED)
QUIT
+16 IF '$DATA(ZTQUEUED)
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:"
+17 SET BDWX=""
FOR
SET BDWX=$ORDER(A(BDWX))
IF BDWX=""!($DATA(BDWQUIT))
QUIT
Begin DoDot:1
+18 IF $Y>(IOSL-2)
DO PAGE
IF $DATA(BDWQUIT)
QUIT
+19 WRITE !,$PIECE(A(BDWX),U)," [",BDWX,"] ",$PIECE(A(BDWX),U,2)
+20 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. HIT ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 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 ;;
