source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXANUT.m@ 1610

Last change on this file since 1610 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 7.7 KB
Line 
1ECXANUT ;ALB/JRC - NUT Extract Audit Report ; 1/24/08 8:28am
2 ;;3.0;DSS EXTRACTS;**105,111**;Dec 22, 1997;Build 4
3 Q
4EN ;entry point for NUT extract audit report
5 N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT
6 N SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP
7 N ZTQUEUED,ZTSTOP
8 S SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"
9 K @SCRNARR@("DIVISION")
10 S (ECXERR,FLAG)=0
11 ;ecxaud=0 for 'extract' audit
12 S ECXHEAD="NUT",ECXAUD=0
13 W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
14 ;select extract
15 D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
16 Q:ECXERR
17 W !!
18 ;select divisions/sites; all divisions if ecxall=1
19 S ECXERR=$$NUT^ECXDVSN()
20 I ECXERR=1 D Q
21 .W !!,?5,"Try again later... exiting.",!
22 .K @SCRNARR@("DIVISION")
23 .D AUDIT^ECXKILL
24 S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
25 W !
26 ;prompt for report type, (s)ummary or (d)etail
27 S REPORT=$$REPORT() Q:FLAG
28 ;if detail selected, prompt for (i)npatient, (o)utpatient or (b)oth
29 I REPORT="D" S STATUS=$$STATUS() Q:FLAG
30 ;determine output device and queue if requested
31 S ECXPGM="PROCESS^ECXANUT",ECXDESC="NUT Extract Audit Report"
32 S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("STATUS")="",ECXSAVE("REPORT")="",ECXSAVE("FLAG")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="",ECXSAVE("SCRNARR")="",TMP=$$OREF^DILF(SCRNARR),ECXSAVE(TMP)=""
33 W !
34 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
35 I ECXSAVE("POP")=1 D Q
36 .W !!,?5,"Try again later... exiting.",!
37 .K @SCRNARR@("DIVISION")
38 .D AUDIT^ECXKILL
39 I ECXSAVE("ZTSK")=0 D
40 .K ECXSAVE,ECXPGM,ECXDESC
41 .D PROCESS^ECXANUT
42 I IO'=IO(0) D ^%ZISC
43 D HOME^%ZIS
44 D AUDIT^ECXKILL
45 Q
46 ;
47PROCESS ;process data in file #727.832 and store in ^tmp global
48 N %,ARRAY,ECXEXT,ECXDEF,X,ECXSTART,ECXEND,ECXRUN,IEN,NODE0,NODE1,DATE,FKEY,DIV,OBS,DLTYPE,DFL,ENC,FPD,FPF,I,PFK,DLDIV
49 S ARRAY="^TMP($J,""ECXORDER"")"
50 S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
51 S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
52 ;get run date in external format
53 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
54 ;get records in date range and set values
55 S IEN=0 F S IEN=$O(^ECX(727.832,"AC",ECXEXT,IEN)) Q:IEN="" D Q:FLAG
56 .S NODE0=$G(^ECX(727.832,IEN,0)),NODE1=$G(^(1))
57 .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)
58 .;filter out divisions if not all selected
59 .Q:$G(@SCRNARR@("DIVISION"))'=1&'$D(@SCRNARR@("DIVISION",+$G(DIV)))
60 .;convert free text date to fm internal format date
61 .S $E(DATE,1,2)=$E(DATE,1,2)-17
62 .Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
63 .;Update totals and store in ^tmp global, add count for each unique
64 .;feeder key/delivery location. Under each unique key create a record
65 .;for each unique combination of in/out code, observation status
66 .;save it in ^tmp global for later use.
67 .I REPORT="S" D
68 ..F I="DIV","DLT","STAT","OBS","PFK" I @I="" S @I="UNKNOWN"
69 ..;Increment delivery location type (dlt) counter
70 ..;S ^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS)=$G(^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS))+1
71 ..S ^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS)=$G(^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS))+1
72 ..;Increment feeder key (fk) counter
73 ..;S ^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS)=$G(^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS))+1
74 ..S ^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS)=$G(^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS))+1
75 .I REPORT="D" D
76 ..F I="FPD","FPF","PFK","OBS","ENC" I $G(@I)="" S @I="UNKNOWN"
77 ..F I="DIV","DLDIV","DFL","DLT" I $G(@I)="" S @I="UNK"
78 ..;Check patient status and screen if necessary
79 ..Q:STATUS'="B"&(STATUS'=STAT)
80 ..;Increment fpd, fpf, pfk, obs counter
81 ..S ^TMP($J,DIV,FPD,FPF,PFK,OBS)=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))+1
82 ..;Increment div, dfl, dlt counter
83 ..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
84 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
85 D PRINT
86 D AUDIT^ECXKILL
87 Q
88 ;
89PRINT ;print report
90 N FLAG,PG,LN,KEY,DLT,STAT,OBS,TOTAL,TCNT,CNT
91 U IO
92 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
93 S (FLAG,PG)=0,$P(LN,"-",80)=""
94 I '$D(^TMP($J)) D Q
95 .S DIV=0 F S DIV=$O(@SCRNARR@("DIVISION",DIV)) Q:'DIV D
96 ..D HEADER
97 ..W !
98 ..W !,"**************************************************"
99 ..W !,"* No data available for this patient division. *"
100 ..W !,"**************************************************"
101 I REPORT="S" D
102 .S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
103 ..D HEADER Q:FLAG
104 ..S KEY="" F S KEY=$O(^TMP($J,DIV,KEY)) Q:KEY']"" D Q:FLAG
105 ...S PFK="" F S PFK=$O(^TMP($J,DIV,KEY,PFK)) Q:PFK']"" D Q:FLAG
106 ....D SUB Q:FLAG
107 ....S STAT="" F S STAT=$O(^TMP($J,DIV,KEY,PFK,STAT)) Q:STAT']"" D Q:FLAG
108 .....S OBS="" F S OBS=$O(^TMP($J,DIV,KEY,PFK,STAT,OBS)) Q:OBS']"" D Q:FLAG
109 ......S TOTAL=$P(^TMP($J,DIV,KEY,PFK,STAT,OBS),U)
110 ......;Print by delivery location type (feeder key)
111 ......D:($Y+3>IOSL) HEADER,SUB Q:FLAG
112 ......W !,?1,STAT,?12,$S(OBS="NO":" NO",1:"YES"),?30,TOTAL
113 ;detail report print
114 I REPORT="D" D
115 .S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
116 ..S FPD="" F S FPD=$O(^TMP($J,DIV,FPD)) Q:FPD']"" D Q:FLAG
117 ...S FPF="" F S FPF=$O(^TMP($J,DIV,FPD,FPF)) Q:FPF']"" D Q:FLAG
118 ....S PFK="" F S PFK=$O(^TMP($J,DIV,FPD,FPF,PFK)) Q:PFK']"" D Q:FLAG
119 .....S OBS="" F S OBS=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS)) Q:OBS']"" D Q:FLAG
120 ......S TCNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))
121 ......D HEADER
122 ......S ENC="" F S ENC=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC)) Q:ENC']"" D Q:FLAG
123 .......S DLDIV="" F S DLDIV=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV)) Q:DLDIV']"" D Q:FLAG
124 ........S DFL="" F S DFL=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL)) Q:DFL']"" D Q:FLAG
125 .........S DLT="" F S DLT=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)) Q:DLT']"" D Q:FLAG
126 ..........S CNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))
127 ..........W !,?1,$E(ENC,1,25),?28,DLDIV,?42,DFL,?60,DLT,?71,CNT
128 ..........D:($Y+3>IOSL) HEADER Q:FLAG
129 Q
130 ;
131HEADER ;header and page control
132 N JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
133 I $E(IOST)="C" D
134 .S SS=22-$Y F JJ=1:1:SS W !
135 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y FLAG=1
136 Q:FLAG
137 S DSSID=$S($G(DIV):$$NNT^XUAF4(DIV),1:"UNKNOWN^^")
138 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
139 W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"_$S(REPORT="S":" (Summary)",1:" (Detail)")
140 W !,"DSS Extract Log #: "_ECXEXT
141 W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
142 W !,"Report Run Date/Time: "_ECXRUN
143 W !,"Patient Division: "_$P(DSSID,U)_$S($P(DSSID,U,2)'="":" ("_$P(DSSID,U,2)_")",1:""),?68,$S(REPORT="S":"Page: "_PG,1:"")
144 ;Detailed report sub-header
145 Q:'$D(^TMP($J))
146 I REPORT="D" D
147 .W !,"Patient Status: "_$S(STATUS="I":"Inpatient",STATUS="O":"Outpatient",1:"Inpatient and Outpatient"),?68,"Page: "_PG
148 .W !!,"Prod Div: "_FPD_" Prod Fac: "_FPF_" Prod FK: "_PFK_" OBS: "_OBS,?60," TOTAL: ",TCNT
149 .W !,?1,"Encounter Number",?28,"Del Div",?42,"Del Feed Loc",?60,"Loc Type",?71,"Count"
150 Q
151SUB ;Summary report sub-header
152 I REPORT="S" D
153 .W !!,"FEEDER KEY: "_PFK
154 .W !!,"I/O",?12,"OBS",?30,"TOTAL"
155 Q
156 ;
157REPORT() ;Select report type
158 ;
159 ; Output - S = summary
160 ; D = detail
161 ;Init variables
162 N DIR,DIRUT,DUOUT,X,Y
163 S DIR(0)="S^S:SUMMARY;D:DETAIL"
164 S DIR("A")="Select type of report"
165 S DIR("?",1)="S = Summary"
166 S DIR("?",2)="D = Detail"
167 D ^DIR
168 I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
169 Q Y
170 ;
171STATUS() ;Select patient status for report
172 ;
173 ; Output - I = inpatient
174 ; O = outpatient
175 ; B = both
176 ;Init variables
177 N DIR,DIRUT,DUOUT,X,Y
178 S DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"
179 S DIR("A")=" report?"
180 S DIR("A")="Select patient status for report"
181 S DIR("?",1)="I = Inpatient"
182 S DIR("?",2)="O = Outpatient"
183 S DIR("?",3)="B = Both"
184 D ^DIR
185 I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
186 Q Y
Note: See TracBrowser for help on using the repository browser.