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

ECXANUT.m

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