187 lines
7.7 KiB
Mathematica
187 lines
7.7 KiB
Mathematica
ECXANUT ;ALB/JRC - NUT Extract Audit Report ; 1/24/08 8:28am
|
|
;;3.0;DSS EXTRACTS;**105,111**;Dec 22, 1997;Build 4
|
|
Q
|
|
EN ;entry point for NUT extract audit report
|
|
N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT
|
|
N SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP
|
|
N ZTQUEUED,ZTSTOP
|
|
S SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"
|
|
K @SCRNARR@("DIVISION")
|
|
S (ECXERR,FLAG)=0
|
|
;ecxaud=0 for 'extract' audit
|
|
S ECXHEAD="NUT",ECXAUD=0
|
|
W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
|
|
;select extract
|
|
D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
|
|
Q:ECXERR
|
|
W !!
|
|
;select divisions/sites; all divisions if ecxall=1
|
|
S ECXERR=$$NUT^ECXDVSN()
|
|
I ECXERR=1 D Q
|
|
.W !!,?5,"Try again later... exiting.",!
|
|
.K @SCRNARR@("DIVISION")
|
|
.D AUDIT^ECXKILL
|
|
S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
|
|
W !
|
|
;prompt for report type, (s)ummary or (d)etail
|
|
S REPORT=$$REPORT() Q:FLAG
|
|
;if detail selected, prompt for (i)npatient, (o)utpatient or (b)oth
|
|
I REPORT="D" S STATUS=$$STATUS() Q:FLAG
|
|
;determine output device and queue if requested
|
|
S ECXPGM="PROCESS^ECXANUT",ECXDESC="NUT Extract Audit Report"
|
|
S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("STATUS")="",ECXSAVE("REPORT")="",ECXSAVE("FLAG")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="",ECXSAVE("SCRNARR")="",TMP=$$OREF^DILF(SCRNARR),ECXSAVE(TMP)=""
|
|
W !
|
|
D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
|
|
I ECXSAVE("POP")=1 D Q
|
|
.W !!,?5,"Try again later... exiting.",!
|
|
.K @SCRNARR@("DIVISION")
|
|
.D AUDIT^ECXKILL
|
|
I ECXSAVE("ZTSK")=0 D
|
|
.K ECXSAVE,ECXPGM,ECXDESC
|
|
.D PROCESS^ECXANUT
|
|
I IO'=IO(0) D ^%ZISC
|
|
D HOME^%ZIS
|
|
D AUDIT^ECXKILL
|
|
Q
|
|
;
|
|
PROCESS ;process data in file #727.832 and store in ^tmp global
|
|
N %,ARRAY,ECXEXT,ECXDEF,X,ECXSTART,ECXEND,ECXRUN,IEN,NODE0,NODE1,DATE,FKEY,DIV,OBS,DLTYPE,DFL,ENC,FPD,FPF,I,PFK,DLDIV
|
|
S ARRAY="^TMP($J,""ECXORDER"")"
|
|
S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
|
|
S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
|
|
;get run date in external format
|
|
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
|
|
;get records in date range and set values
|
|
S IEN=0 F S IEN=$O(^ECX(727.832,"AC",ECXEXT,IEN)) Q:IEN="" D Q:FLAG
|
|
.S NODE0=$G(^ECX(727.832,IEN,0)),NODE1=$G(^(1))
|
|
.S DATE=$P(NODE0,U,9),STAT=$P(NODE0,U,8),PFK=$P(NODE1,U,8),DIV=$P(NODE1,U,5),OBS=$P(NODE1,U,2),DLT=$P(NODE1,U,10),FPD=$P(NODE1,U,6),FPF=$P(NODE1,U,9),ENC=$P(NODE1,U,4),DFL=$P(NODE1,U,11),DLDIV=$P(NODE1,U,7)
|
|
.;filter out divisions if not all selected
|
|
.Q:$G(@SCRNARR@("DIVISION"))'=1&'$D(@SCRNARR@("DIVISION",+$G(DIV)))
|
|
.;convert free text date to fm internal format date
|
|
.S $E(DATE,1,2)=$E(DATE,1,2)-17
|
|
.Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
|
|
.;Update totals and store in ^tmp global, add count for each unique
|
|
.;feeder key/delivery location. Under each unique key create a record
|
|
.;for each unique combination of in/out code, observation status
|
|
.;save it in ^tmp global for later use.
|
|
.I REPORT="S" D
|
|
..F I="DIV","DLT","STAT","OBS","PFK" I @I="" S @I="UNKNOWN"
|
|
..;Increment delivery location type (dlt) counter
|
|
..;S ^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS)=$G(^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS))+1
|
|
..S ^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS)=$G(^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS))+1
|
|
..;Increment feeder key (fk) counter
|
|
..;S ^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS)=$G(^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS))+1
|
|
..S ^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS)=$G(^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS))+1
|
|
.I REPORT="D" D
|
|
..F I="FPD","FPF","PFK","OBS","ENC" I $G(@I)="" S @I="UNKNOWN"
|
|
..F I="DIV","DLDIV","DFL","DLT" I $G(@I)="" S @I="UNK"
|
|
..;Check patient status and screen if necessary
|
|
..Q:STATUS'="B"&(STATUS'=STAT)
|
|
..;Increment fpd, fpf, pfk, obs counter
|
|
..S ^TMP($J,DIV,FPD,FPF,PFK,OBS)=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))+1
|
|
..;Increment div, dfl, dlt counter
|
|
..S ^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))+1
|
|
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
|
|
D PRINT
|
|
D AUDIT^ECXKILL
|
|
Q
|
|
;
|
|
PRINT ;print report
|
|
N FLAG,PG,LN,KEY,DLT,STAT,OBS,TOTAL,TCNT,CNT
|
|
U IO
|
|
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
|
|
S (FLAG,PG)=0,$P(LN,"-",80)=""
|
|
I '$D(^TMP($J)) D Q
|
|
.S DIV=0 F S DIV=$O(@SCRNARR@("DIVISION",DIV)) Q:'DIV D
|
|
..D HEADER
|
|
..W !
|
|
..W !,"**************************************************"
|
|
..W !,"* No data available for this patient division. *"
|
|
..W !,"**************************************************"
|
|
I REPORT="S" D
|
|
.S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
|
|
..D HEADER Q:FLAG
|
|
..S KEY="" F S KEY=$O(^TMP($J,DIV,KEY)) Q:KEY']"" D Q:FLAG
|
|
...S PFK="" F S PFK=$O(^TMP($J,DIV,KEY,PFK)) Q:PFK']"" D Q:FLAG
|
|
....D SUB Q:FLAG
|
|
....S STAT="" F S STAT=$O(^TMP($J,DIV,KEY,PFK,STAT)) Q:STAT']"" D Q:FLAG
|
|
.....S OBS="" F S OBS=$O(^TMP($J,DIV,KEY,PFK,STAT,OBS)) Q:OBS']"" D Q:FLAG
|
|
......S TOTAL=$P(^TMP($J,DIV,KEY,PFK,STAT,OBS),U)
|
|
......;Print by delivery location type (feeder key)
|
|
......D:($Y+3>IOSL) HEADER,SUB Q:FLAG
|
|
......W !,?1,STAT,?12,$S(OBS="NO":" NO",1:"YES"),?30,TOTAL
|
|
;detail report print
|
|
I REPORT="D" D
|
|
.S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
|
|
..S FPD="" F S FPD=$O(^TMP($J,DIV,FPD)) Q:FPD']"" D Q:FLAG
|
|
...S FPF="" F S FPF=$O(^TMP($J,DIV,FPD,FPF)) Q:FPF']"" D Q:FLAG
|
|
....S PFK="" F S PFK=$O(^TMP($J,DIV,FPD,FPF,PFK)) Q:PFK']"" D Q:FLAG
|
|
.....S OBS="" F S OBS=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS)) Q:OBS']"" D Q:FLAG
|
|
......S TCNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))
|
|
......D HEADER
|
|
......S ENC="" F S ENC=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC)) Q:ENC']"" D Q:FLAG
|
|
.......S DLDIV="" F S DLDIV=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV)) Q:DLDIV']"" D Q:FLAG
|
|
........S DFL="" F S DFL=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL)) Q:DFL']"" D Q:FLAG
|
|
.........S DLT="" F S DLT=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)) Q:DLT']"" D Q:FLAG
|
|
..........S CNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))
|
|
..........W !,?1,$E(ENC,1,25),?28,DLDIV,?42,DFL,?60,DLT,?71,CNT
|
|
..........D:($Y+3>IOSL) HEADER Q:FLAG
|
|
Q
|
|
;
|
|
HEADER ;header and page control
|
|
N JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
|
|
I $E(IOST)="C" D
|
|
.S SS=22-$Y F JJ=1:1:SS W !
|
|
.I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y FLAG=1
|
|
Q:FLAG
|
|
S DSSID=$S($G(DIV):$$NNT^XUAF4(DIV),1:"UNKNOWN^^")
|
|
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
|
|
W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"_$S(REPORT="S":" (Summary)",1:" (Detail)")
|
|
W !,"DSS Extract Log #: "_ECXEXT
|
|
W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
|
|
W !,"Report Run Date/Time: "_ECXRUN
|
|
W !,"Patient Division: "_$P(DSSID,U)_$S($P(DSSID,U,2)'="":" ("_$P(DSSID,U,2)_")",1:""),?68,$S(REPORT="S":"Page: "_PG,1:"")
|
|
;Detailed report sub-header
|
|
Q:'$D(^TMP($J))
|
|
I REPORT="D" D
|
|
.W !,"Patient Status: "_$S(STATUS="I":"Inpatient",STATUS="O":"Outpatient",1:"Inpatient and Outpatient"),?68,"Page: "_PG
|
|
.W !!,"Prod Div: "_FPD_" Prod Fac: "_FPF_" Prod FK: "_PFK_" OBS: "_OBS,?60," TOTAL: ",TCNT
|
|
.W !,?1,"Encounter Number",?28,"Del Div",?42,"Del Feed Loc",?60,"Loc Type",?71,"Count"
|
|
Q
|
|
SUB ;Summary report sub-header
|
|
I REPORT="S" D
|
|
.W !!,"FEEDER KEY: "_PFK
|
|
.W !!,"I/O",?12,"OBS",?30,"TOTAL"
|
|
Q
|
|
;
|
|
REPORT() ;Select report type
|
|
;
|
|
; Output - S = summary
|
|
; D = detail
|
|
;Init variables
|
|
N DIR,DIRUT,DUOUT,X,Y
|
|
S DIR(0)="S^S:SUMMARY;D:DETAIL"
|
|
S DIR("A")="Select type of report"
|
|
S DIR("?",1)="S = Summary"
|
|
S DIR("?",2)="D = Detail"
|
|
D ^DIR
|
|
I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
|
|
Q Y
|
|
;
|
|
STATUS() ;Select patient status for report
|
|
;
|
|
; Output - I = inpatient
|
|
; O = outpatient
|
|
; B = both
|
|
;Init variables
|
|
N DIR,DIRUT,DUOUT,X,Y
|
|
S DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"
|
|
S DIR("A")=" report?"
|
|
S DIR("A")="Select patient status for report"
|
|
S DIR("?",1)="I = Inpatient"
|
|
S DIR("?",2)="O = Outpatient"
|
|
S DIR("?",3)="B = Both"
|
|
D ^DIR
|
|
I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
|
|
Q Y
|