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

BDWCVAR.m

Go to the documentation of this file. 
  1. BDWCVAR ; IHS/CMI/LAB - visit audit report ;
  1.  ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
  1.  ;
  1.  ;
  1.  ;
  1. START ;
  1.  I $D(^BDWDATA) W !!,"Audit already running or not completed successfully, cannot continue." Q
  1.  W !!,"This option is used to create a visit audit report to accompany a data",!,"warehouse export.",!!
  1.  S BDW("QFLG")=""
  1.  D BASICS
  1.  Q:BDW("QFLG")
  1.  S BDW("QFLG")=""
  1.  D GETLOG^BDWRDRI2 ;      Get last log entry and display data.
  1.  I BDW("QFLG") D EXIT Q
  1.  D CHKOLD^BDWRDRI2
  1.  I BDW("QFLG") D EXIT Q
  1.  D CURRUN^BDWRDRI2 ;      Compute run dates for current run.
  1.  I BDW("QFLG") D EXIT Q
  1.  D CHKVISIT^BDWRDRI2 ;    Check VISIT xref for date range
  1.  I BDW("QFLG") D EXIT Q
  1.  D CONFIRM^BDWRDRI2 ;     Get ok from operator.
  1.  I BDW("QFLG") D EXIT Q
  1.  D PROCESS
  1.  S X=$$WRITE
  1.  I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press ENTER to Continue" K DA D ^DIR K DIR
  1.  D EXIT
  1.  Q
  1. PROCESS ;
  1.  W:'$D(ZTQUEUED) !!,"Generating visit audit report..Please wait."
  1.  S BDWCNTR=0,BDW("CONTROL DATE")=BDW("RUN BEGIN")-1
  1.  F  S BDW("CONTROL DATE")=$O(^AUPNVSIT("ADWO",BDW("CONTROL DATE"))) Q:BDW("CONTROL DATE")=""!(BDW("CONTROL DATE")>BDW("RUN END"))  D PROCESS2 Q:BDW("QFLG")
  1.  Q
  1. PROCESS2 ;
  1.  S BDW("V DFN")="" F  S BDW("V DFN")=$O(^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN"))) Q:BDW("V DFN")=""  D PROCESS3 Q:BDW("QFLG")
  1.  Q
  1. PROCESS3 ;
  1.  K BDWT,BDWV,BDWE
  1.  D KILL^AUPNPAT
  1.  I '$D(^AUPNVSIT(BDW("V DFN"),0)) K ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")) Q
  1.  D GENREC
  1.  S BDWCNTR=BDWCNTR+1 W:'(BDWCNTR#100) "."
  1.  Q
  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($G(^BDWSITE(1,0)),U),BDW("QFLG")=0
  1.  I DUZ(2)'=BDW("RUN LOCATION") W !,"You need to be logged in as ",$P(^DIC(4,BDW("RUN LOCATION"),0),U)," in order to do this audit report.",! S BDW("QFLG")=1 Q
  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.  I $P(^BDWSITE(1,0),U,7) S BDWVA=1
  1.  S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
  1.  Q
  1.  ;
  1. EXIT ;
  1.  D EN^XBVK("BDW")
  1.  Q
  1. GENREC ;
  1.  S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
  1.  K BDWE
  1.  D VISIT
  1.  I '$D(BDWE) Q
  1.  D PROCTX
  1.  K BDWE,BDWT,BDWH
  1.  Q
  1.  ;
  1. VISIT ;EP
  1.  K BDWE
  1.  I $P(BDWV("V REC"),U,23)=.5 Q
  1.  I '$P(BDWV("V REC"),U,9),'$P(BDWV("V REC"),U,11) Q
  1.  I $P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" Q
  1.  S BDWV("TYPE")=$P(BDWV("V REC"),U,3)
  1.  I BDWV("TYPE")="" Q
  1.  S BDWV("SRV CAT")=$P(BDWV("V REC"),U,7)
  1.  I BDWV("SRV CAT")="" Q
  1.  S BDWV("LOC DFN")=$P(BDWV("V REC"),U,6)
  1.  I BDWV("LOC DFN")="" Q
  1.  S BDWV("IHS LOCATION CODE")=$P(^AUTTLOC(BDWV("LOC DFN"),0),U,10) I BDWV("IHS LOCATION CODE")="" Q
  1.  S BDWV("PATIENT DFN")=$P(BDWV("V REC"),U,5) I BDWV("PATIENT DFN")="" Q
  1.  I '$D(^DPT(BDWV("PATIENT DFN"))) Q
  1.  S Y=BDWV("PATIENT DFN") D ^AUPNPAT
  1.  S BDWV("PATIENT NAME")=$P(^DPT(BDWV("PATIENT DFN"),0),U)
  1.  I BDWV("PATIENT NAME")["DEMO,PATIENT" Q
  1.  S BDWE=1
  1.  Q
  1.  ;
  1. PROCTX ; process and generate appropriate hl7 message
  1.  D VA^BDW1VBL2
  1.  Q
  1.  ;
  1. WRITE() ; 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 Visit 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(DUZ(2),0)),U,10)  ;asufac for file name
  1.  S XBFN="BDWDWVX"_BDWASU_"."_BDWJUL
  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.  ;
  1.  D ^XBGSAVE
  1.  ;
  1.  I XBFLG=0 D
  1.  . W:'$D(ZTQUEUED) !,"VISIT 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.  Q XBFLG