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

BDWRDRI.m

Go to the documentation of this file.
  1. BDWRDRI ; IHS/CMI/LAB - INIT FOR DW ;
  1. ;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
  1. ;
  1. START ;
  1. D BASICS ; Set variables like U,DT,DUZ(2) etc.
  1. D CHKSITE ; Make sure Site file has correct fields.
  1. D CLNADWO ; Clean out ADWO cross references that have a time stamp
  1. Q:BDW("QFLG")
  1. ;
  1. D:BDWO("RUN")="NEW" ^BDWRDRI2 ; Do new run initialization.
  1. Q:$D(ZTQUEUED)
  1. Q:BDW("QFLG")
  1. D:BDWO("RUN")="NEW" QUEUE
  1. Q
  1. ;
  1. BASICS ;EP - BASIC INITS
  1. K ^BDWDATA ;export global
  1. S BDWVA("COUNT")=0
  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($P(^AUTTSITE(1,0),U),0),U,10),BDW("QFLG")=0
  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 (BDW("MODS"),BDW("ADDS"),BDW("DELS"))=0
  1. S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
  1. D TAXCHK
  1. Q
  1. ;
  1. CHKSITE ;EP
  1. S BDWS("PROV FILE")=$S($P(^DD(9000010.06,.01,0),U,2)[200:200,1:6)
  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,6)="" W:'$D(ZTQUEUED) !!,"VISIT backloading has not been completed. Must be finished first." S BDW("QFLG")=3 Q
  1. I $P($G(^BDWSITE(1,11)),U) S BDW("DNS")=1
  1. S X=$O(^INRHD("B","HL IHS DW1 IE",0))
  1. I $D(^BDWTMP(X)) W:'$D(ZTQUEUED) !!,"previous DW export not written to host file" S BDW("QFLG")=4 Q
  1. K ^BDWTMP(X)
  1. Q
  1. CLNADWO ;EP cleanup ADWO cross references that are invalid
  1. W:'$D(ZTQUEUED) !,"Checking ADWO cross reference for invalid data"
  1. N BDWDA,BDWDIEN
  1. S BDWDA=0 F S BDWDA=$O(^AUPNVSIT("ADWO",BDWDA)) Q:'BDWDA D
  1. . S BDWDIEN=0 F S BDWDIEN=$O(^AUPNVSIT("ADWO",BDWDA,BDWDIEN)) Q:'BDWDIEN D
  1. .. I $L(BDWDA)'=7 K ^AUPNVSIT("ADWO",BDWDA,BDWDIEN) W "."
  1. Q
  1. ;
  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 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
  1. I BDWO("RUN")="REDO",$D(DIRUT) S BDW("QFLG")=99 Q
  1. Q
  1. QUEUE1 ;
  1. S ZTRTN=$S(BDWO("RUN")="NEW":"DRIVER^BDWRDR",1:"EN^BDWREDO")
  1. S ZTIO="",ZTDTH="",ZTDESC="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),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
  1. S BDWO("QUEUE")=""
  1. S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
  1. K ZTSK
  1. Q
  1. TAXCHK ;EP
  1. I $D(BDWO("SCHEDULED")) Q ;don't do this if scheduled
  1. K BDWQUIT
  1. I '$D(ZTQUEUED) W !,"Checking for Taxonomies to support the Data Warehouse Extract...",!
  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) W:'$D(ZTQUEUED) !,"All okay.",! K A,BDWX,Y,I,Z Q
  1. I $D(ZTQUEUED) Q
  1. 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:"
  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. HIT ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  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. ;;