BDWCVAR ; IHS/CMI/LAB - visit audit report ;
;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
;
;
;
START ;
I $D(^BDWDATA) W !!,"Audit already running or not completed successfully, cannot continue." Q
W !!,"This option is used to create a visit audit report to accompany a data",!,"warehouse export.",!!
S BDW("QFLG")=""
D BASICS
Q:BDW("QFLG")
S BDW("QFLG")=""
D GETLOG^BDWRDRI2 ; Get last log entry and display data.
I BDW("QFLG") D EXIT Q
D CHKOLD^BDWRDRI2
I BDW("QFLG") D EXIT Q
D CURRUN^BDWRDRI2 ; Compute run dates for current run.
I BDW("QFLG") D EXIT Q
D CHKVISIT^BDWRDRI2 ; Check VISIT xref for date range
I BDW("QFLG") D EXIT Q
D CONFIRM^BDWRDRI2 ; Get ok from operator.
I BDW("QFLG") D EXIT Q
D PROCESS
S X=$$WRITE
I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press ENTER to Continue" K DA D ^DIR K DIR
D EXIT
Q
PROCESS ;
W:'$D(ZTQUEUED) !!,"Generating visit audit report..Please wait."
S BDWCNTR=0,BDW("CONTROL DATE")=BDW("RUN BEGIN")-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")
Q
PROCESS2 ;
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")
Q
PROCESS3 ;
K BDWT,BDWV,BDWE
D KILL^AUPNPAT
I '$D(^AUPNVSIT(BDW("V DFN"),0)) K ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")) Q
D GENREC
S BDWCNTR=BDWCNTR+1 W:'(BDWCNTR#100) "."
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($G(^BDWSITE(1,0)),U),BDW("QFLG")=0
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
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
I $P(^BDWSITE(1,0),U,7) S BDWVA=1
S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
Q
;
EXIT ;
D EN^XBVK("BDW")
Q
GENREC ;
S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
K BDWE
D VISIT
I '$D(BDWE) Q
D PROCTX
K BDWE,BDWT,BDWH
Q
;
VISIT ;EP
K BDWE
I $P(BDWV("V REC"),U,23)=.5 Q
I '$P(BDWV("V REC"),U,9),'$P(BDWV("V REC"),U,11) Q
I $P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" Q
S BDWV("TYPE")=$P(BDWV("V REC"),U,3)
I BDWV("TYPE")="" Q
S BDWV("SRV CAT")=$P(BDWV("V REC"),U,7)
I BDWV("SRV CAT")="" Q
S BDWV("LOC DFN")=$P(BDWV("V REC"),U,6)
I BDWV("LOC DFN")="" Q
S BDWV("IHS LOCATION CODE")=$P(^AUTTLOC(BDWV("LOC DFN"),0),U,10) I BDWV("IHS LOCATION CODE")="" Q
S BDWV("PATIENT DFN")=$P(BDWV("V REC"),U,5) I BDWV("PATIENT DFN")="" Q
I '$D(^DPT(BDWV("PATIENT DFN"))) Q
S Y=BDWV("PATIENT DFN") D ^AUPNPAT
S BDWV("PATIENT NAME")=$P(^DPT(BDWV("PATIENT DFN"),0),U)
I BDWV("PATIENT NAME")["DEMO,PATIENT" Q
S BDWE=1
Q
;
PROCTX ; process and generate appropriate hl7 message
D VA^BDW1VBL2
Q
;
WRITE() ; 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 Visit 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(DUZ(2),0)),U,10) ;asufac for file name
S XBFN="BDWDWVX"_BDWASU_"."_BDWJUL
;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) !,"VISIT 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
BDWCVAR ; IHS/CMI/LAB - visit audit report ;
+1 ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
+2 ;
+3 ;
+4 ;
START ;
+1 IF $DATA(^BDWDATA)
WRITE !!,"Audit already running or not completed successfully, cannot continue."
QUIT
+2 WRITE !!,"This option is used to create a visit audit report to accompany a data",!,"warehouse export.",!!
+3 SET BDW("QFLG")=""
+4 DO BASICS
+5 IF BDW("QFLG")
QUIT
+6 SET BDW("QFLG")=""
+7 ; Get last log entry and display data.
DO GETLOG^BDWRDRI2
+8 IF BDW("QFLG")
DO EXIT
QUIT
+9 DO CHKOLD^BDWRDRI2
+10 IF BDW("QFLG")
DO EXIT
QUIT
+11 ; Compute run dates for current run.
DO CURRUN^BDWRDRI2
+12 IF BDW("QFLG")
DO EXIT
QUIT
+13 ; Check VISIT xref for date range
DO CHKVISIT^BDWRDRI2
+14 IF BDW("QFLG")
DO EXIT
QUIT
+15 ; Get ok from operator.
DO CONFIRM^BDWRDRI2
+16 IF BDW("QFLG")
DO EXIT
QUIT
+17 DO PROCESS
+18 SET X=$$WRITE
+19 IF '$DATA(ZTQUEUED)
SET DIR(0)="EO"
SET DIR("A")="DONE -- Press ENTER to Continue"
KILL DA
DO ^DIR
KILL DIR
+20 DO EXIT
+21 QUIT
PROCESS ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Generating visit audit report..Please wait."
+2 SET BDWCNTR=0
SET BDW("CONTROL DATE")=BDW("RUN BEGIN")-1
+3 FOR
SET BDW("CONTROL DATE")=$ORDER(^AUPNVSIT("ADWO",BDW("CONTROL DATE")))
IF BDW("CONTROL DATE")=""!(BDW("CONTROL DATE")>BDW("RUN END"))
QUIT
DO PROCESS2
IF BDW("QFLG")
QUIT
+4 QUIT
PROCESS2 ;
+1 SET BDW("V DFN")=""
FOR
SET BDW("V DFN")=$ORDER(^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN")))
IF BDW("V DFN")=""
QUIT
DO PROCESS3
IF BDW("QFLG")
QUIT
+2 QUIT
PROCESS3 ;
+1 KILL BDWT,BDWV,BDWE
+2 DO KILL^AUPNPAT
+3 IF '$DATA(^AUPNVSIT(BDW("V DFN"),0))
KILL ^AUPNVSIT("ADWO",BDW("CONTROL DATE"),BDW("V DFN"))
QUIT
+4 DO GENREC
+5 SET BDWCNTR=BDWCNTR+1
IF '(BDWCNTR#100)
WRITE "."
+6 QUIT
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($GET(^BDWSITE(1,0)),U)
SET BDW("QFLG")=0
+6 IF DUZ(2)'=BDW("RUN LOCATION")
WRITE !,"You need to be logged in as ",$PIECE(^DIC(4,BDW("RUN LOCATION"),0),U)," in order to do this audit report.",!
SET BDW("QFLG")=1
QUIT
+7 ; Allow VISIT lookup with 0 'dependent entry count'.
SET APCDOVRR=1
+8 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
+9 SET (BDW("MODS"),BDW("ADDS"),BDW("DELS"))=0
+10 IF $PIECE(^BDWSITE(1,0),U,7)
SET BDWVA=1
+11 SET BDWIEDST=$ORDER(^INRHD("B","HL IHS DW1 IE",0))
+12 QUIT
+13 ;
EXIT ;
+1 DO EN^XBVK("BDW")
+2 QUIT
GENREC ;
+1 SET BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
+2 KILL BDWE
+3 DO VISIT
+4 IF '$DATA(BDWE)
QUIT
+5 DO PROCTX
+6 KILL BDWE,BDWT,BDWH
+7 QUIT
+8 ;
VISIT ;EP
+1 KILL BDWE
+2 IF $PIECE(BDWV("V REC"),U,23)=.5
QUIT
+3 IF '$PIECE(BDWV("V REC"),U,9)
IF '$PIECE(BDWV("V REC"),U,11)
QUIT
+4 IF $PIECE(BDWV("V REC"),U,11)
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,6)=""
QUIT
+5 SET BDWV("TYPE")=$PIECE(BDWV("V REC"),U,3)
+6 IF BDWV("TYPE")=""
QUIT
+7 SET BDWV("SRV CAT")=$PIECE(BDWV("V REC"),U,7)
+8 IF BDWV("SRV CAT")=""
QUIT
+9 SET BDWV("LOC DFN")=$PIECE(BDWV("V REC"),U,6)
+10 IF BDWV("LOC DFN")=""
QUIT
+11 SET BDWV("IHS LOCATION CODE")=$PIECE(^AUTTLOC(BDWV("LOC DFN"),0),U,10)
IF BDWV("IHS LOCATION CODE")=""
QUIT
+12 SET BDWV("PATIENT DFN")=$PIECE(BDWV("V REC"),U,5)
IF BDWV("PATIENT DFN")=""
QUIT
+13 IF '$DATA(^DPT(BDWV("PATIENT DFN")))
QUIT
+14 SET Y=BDWV("PATIENT DFN")
DO ^AUPNPAT
+15 SET BDWV("PATIENT NAME")=$PIECE(^DPT(BDWV("PATIENT DFN"),0),U)
+16 IF BDWV("PATIENT NAME")["DEMO,PATIENT"
QUIT
+17 SET BDWE=1
+18 QUIT
+19 ;
PROCTX ; process and generate appropriate hl7 message
+1 DO VA^BDW1VBL2
+2 QUIT
+3 ;
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
+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 Visit 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(DUZ(2),0)),U,10)
+13 SET XBFN="BDWDWVX"_BDWASU_"."_BDWJUL
+14 ;S XBUF="/usr3/dsd/ljara/" ;used in testing to make it fail
+15 ;S XBQTO="-l dwxfer:regpcc 127.0.0.1"
+16 SET XBS1="DATA WAREHOUSE SEND"
+17 ;
+18 DO ^XBGSAVE
+19 ;
+20 IF XBFLG=0
Begin DoDot:1
+21 IF '$DATA(ZTQUEUED)
WRITE !,"VISIT audit file successfully created and transferred.",!!
+22 KILL ^BDWDATA
End DoDot:1
+23 ;
+24 IF XBFLG'=0
Begin DoDot:1
+25 IF XBFLG(1)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT audit file successfully created",!!
KILL ^BDWDATA
+26 IF XBFLG(1)]""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT audit file NOT successfully created",!!
+27 IF '$DATA(ZTQUEUED)
WRITE !,"File was NOT successfully transferred to the data warehouse",!,"you will need to manually ftp it.",!
+28 IF '$DATA(ZTQUEUED)
WRITE !,XBFLG(1),!!
End DoDot:1
+29 ;
+30 QUIT XBFLG
