source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXANUT.m@ 1635

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