- 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 ;;