source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW81.m@ 1005

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

initial load of WorldVistAEHR
File size: 7.7 KB
Line 
1SCRPW81 ; ALB/SCK - SCDX AMB CARE CLOSEOUT RPT FOR MT INDICATOR = U ; 9 JULY 2003
2 ;;5.3;Scheduling;**302,440,474**;AUG 13, 1993;Build 4
3 ;
4EN ; Main entry point for report
5 N DIR,DIRUT,SDBEG,SDEND,RSLT,Y,X
6 ;
7 S DIR("A")="Please select fiscal year",DIR(0)="SM^A:Previous Fiscal Year;B:Current Fiscal Year;O:Other Date Range"
8 S DIR("B")="B"
9 S DIR("?")="You may select either the previous fiscal year (A) or the current fiscal year (B). Select (O) if you choose to specify your own date range."
10 D ^DIR K DIR
11 Q:$D(DIRUT)
12 S RSLT=Y
13 ;
14 I RSLT="A" D
15 . D PASTYR(.SDBEG,.SDEND)
16 E I RSLT="B" D
17 . D CURYR(.SDBEG,.SDEND)
18 E D
19 . D GETDT(.SDBEG,.SDEND)
20 Q:'$G(SDBEG)!('$G(SDEND))
21 W !!?3,"Date Range: "_$$FMTE^XLFDT(SDBEG)_" to "_$$FMTE^XLFDT(SDEND)
22 ;
23 N X,Y,IORVON,IORVOFF
24 S X="IORVON;IORVOFF"
25 D ENDR^%ZISS
26 W:$D(IORVON) IORVON
27 W !,"A 132-Column printer is required for this report."
28 W !,"This report will NOT print correctly to the screen!"
29 W:$D(IORVOFF) IORVOFF
30 ;
31 N ZTSAVE,ZTRTN,ZTDESC,POP,%ZIS
32 S %ZIS="Q" D ^%ZIS G:POP EXIT
33 I $D(IO("Q")) D Q
34 . S ZTSAVE("SDBEG")="",ZTSAVE("SDEND")="",ZTSAVE("DUZ")=""
35 . S ZTRTN="RUN^SCRPW81"
36 . S ZTDESC="XMITED OE MT=U RPT"
37 . D ^%ZTLOAD D HOME^%ZIS K IO("Q")
38 D RUN
39 D ^%ZISC
40EXIT S:$D(ZTQUEUED) ZTREQ="@" Q
41 ;
42RUN ; Run report
43 U IO
44 K ^TMP("SCDX MTU",$J),^TMP("SCDX ASORT",$J)
45 ;
46 D BLD(SDBEG,SDEND)
47 D CHKMT
48 D SRTNAME
49 D MAIL
50 D PRINT
51 K ^TMP("SCDX MTU",$J),^TMP("SCDX ASORT",$J)
52 Q
53 ;
54PASTYR(SDBEG,SDEND) ; Set dates for previous fiscal year
55 N CURYR,PRVYR,CURMN,%I
56 ;
57 D NOW^%DTC
58 S CURYR=%I(3),CURMN=%I(1)
59 I CURMN>9 D
60 . S CURYR=CURYR+1
61 S PRVYR=CURYR-1
62 S SDEND=$$FMADD^XLFDT(PRVYR_"1001",-1)
63 S SDBEG=$$FMADD^XLFDT(PRVYR_"1001",-365)
64 Q
65 ;
66CURYR(SDBEG,SDEND) ; Set dates for current fiscal year
67 N CURYR,CURMN,%I
68 ;
69 D NOW^%DTC
70 S CURYR=%I(3),CURMN=%I(1)
71 I CURMN<10 D
72 . S CURYR=CURYR-1
73 S SDBEG=CURYR_"1001"
74 S SDEND=$P($$NOW^XLFDT,".")
75 Q
76 ;
77GETDT(SDBEG,SDEND) ; Get beginning and ending date for search
78 ; Output SDBEG Beginning for date range
79 ; SDEND End of date range
80 ; result 1 - If function successful
81 ; 0 - If function NOT successful (User quit)
82 ;
83 N DIR,DIRUT,Y
84 ;
85 W !!?3,"You have selected to specify your own date range. Please note that by"
86 W !?3,"doing so you may not generate an accurate picture of the AMB CARE"
87 W !?3,"closeouts where the means test indicator equals 'U'.",!
88 ;
89 S DIR(0)="DAO^:DT:EX"
90 S DIR("A")="Beginning Date: "
91 S DIR("?")="^D HELP^%DTC"
92 D ^DIR
93 I $D(DIRUT) D Q
94 . S SDBEG=0
95 S SDBEG=Y
96 ;
97 S DIR(0)="DAO^:DT:EX"
98 S DIR("A")="Ending Date: "
99 D ^DIR
100 I $D(DIRUT) D Q
101 . S SDEND=0
102 S SDEND=Y
103 Q
104 ;
105BLD(SDBEG,SDEND) ; Build list of patient OE's for date range
106 ; Input SDBEG
107 ; SDEND
108 ;
109 N SDX,SDMAX,SDOEI,CNT,NODE,SDOEX,SDLOC
110 ;
111 S SDX=$$FMADD^XLFDT(SDBEG,0,0,0,-1) ; set inital search DT to beginning date minus one second
112 S SDMAX=$$FMADD^XLFDT(SDEND,0,23,59,59) ; set search end date to end date plus one day
113 ;
114 S ^TMP("SCDX MTU",$J,0,"BEGIN")=$H
115 F S SDX=$O(^SCE("B",SDX)) Q:'SDX D Q:SDX>SDMAX
116 . S SDOEI=0
117 . F S SDOEI=$O(^SCE("B",SDX,SDOEI)) Q:'SDOEI D
118 . . S NODE=$G(^SCE(SDOEI,0))
119 . . Q:$P(NODE,U,6)>0 ; Quit if not parent encounter
120 . . Q:$P(NODE,U,8)>3 ; Quit if Originating process is for credit stop code
121 . . S SDLOC=+$P(NODE,U,4)
122 . . Q:$$GET1^DIQ(44,SDLOC,2502,"I")="Y" ; Quit if non-count clinic
123 . . S SDOEX=$O(^SD(409.73,"AENC",SDOEI,0))
124 . . Q:'$P(NODE,U,2)
125 . . S ^TMP("SCDX MTU",$J,$P(NODE,U,2),SDOEI)=$P(NODE,U,1)_U_SDOEX
126 . . S ^TMP("SCDX MTU",$J,0,"CNT")=$G(^TMP("SCDX MTU",$J,0,"CNT"))+1
127 S ^TMP("SCDX MTU",$J,0,"END")=$H
128 Q
129 ;
130CHKMT ; Clean out all except those meeting the MT=U conditions
131 N DFN,SDOEI,SDOEDT,SDMT,SDO,SDR,SDN,SDAT,SDEC,SDMTI,SDMTT
132 ;
133 S DFN=0
134 F S DFN=$O(^TMP("SCDX MTU",$J,DFN)) Q:'DFN D
135 . I '$D(^DGMT(408.31,"C",DFN)) D Q ; No MT Data, bypass patient
136 . . K ^TMP("SCDX MTU",$J,DFN)
137 . S (SDR,SDO,SDN,SDOEI)=0
138 . F S SDOEI=$O(^TMP("SCDX MTU",$J,DFN,SDOEI)) Q:'SDOEI D
139 . . S SDOEDT=$P($G(^TMP("SCDX MTU",$J,DFN,SDOEI)),U,1)
140 . . Q:'SDOEDT
141 . . S SDEC=$$GET1^DIQ(409.68,SDOEI,.13,"I")
142 . . S SDAT=$$GET1^DIQ(409.68,SDOEI,.1,"I")
143 . . S SDMTI=$$MTI^SCDXUTL0(DFN,SDOEDT,SDEC,SDAT,SDOEI)
144 . . I SDMTI'="U" D Q
145 . . . K ^TMP("SCDX MTU",$J,DFN)
146 . . S SDMTT=$$LST^DGMTU(DFN,SDOEDT,1) I $P(SDMTT,U,4)="N" D Q
147 . . . K ^TMP("SCDX MTU",$J,DFN)
148 . . S $P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,4)=SDMTI
149 S ^TMP("SCDX MTU",$J,0,"END")=$H K SDMTT
150 Q
151 ;
152SRTNAME ; Sort remaining encounters by patient name and OE date
153 N DFN,SDOEI,SDNAME,SDOEDT
154 ;
155 S DFN=0
156 F S DFN=$O(^TMP("SCDX MTU",$J,DFN)) Q:'DFN D
157 . S SDNAME=$$GET1^DIQ(2,DFN,.01)
158 . Q:SDNAME']""
159 . S ^TMP("SCDX MTU",$J,0,"PATNUM")=$G(^TMP("SCDX MTU",$J,0,"PATNUM"))+1
160 . S SDOEI=0
161 . F S SDOEI=$O(^TMP("SCDX MTU",$J,DFN,SDOEI)) Q:'SDOEI D
162 . . S SDOEDT=$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,1)
163 . . S ^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)=$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,2)_U_SDOEI_U_DFN_U_$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,4)
164 . . S ^TMP("SCDX MTU",$J,0,"FINAL CNT")=$G(^TMP("SCDX MTU",$J,0,"FINAL CNT"))+1
165 S ^TMP("SCDX MTU",$J,0,"END2")=$H
166 Q
167 ;
168MAIL ; send message with report statistics
169 N MSG,XMSUB,XMY,XMTEXT,XMDUZ
170 ;
171 S MSG(1)="Date Range for Report "_$$FMTE^XLFDT(SDBEG,2)_" to "_$$FMTE^XLFDT(SDEND,2)
172 S MSG(2)=""
173 S MSG(3)="Report Started "_$$HTE^XLFDT(^TMP("SCDX MTU",$J,0,"BEGIN"),2)
174 S MSG(4)="Report Finished "_$$HTE^XLFDT(^TMP("SCDX MTU",$J,0,"END2"),2)
175 S MSG(5)="Total Time for Report "_$$HDIFF^XLFDT(^TMP("SCDX MTU",$J,0,"END2"),^TMP("SCDX MTU",$J,0,"BEGIN"),3)
176 S MSG(6)=""
177 S MSG(7)="Outpatient Encounters Scanned "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"CNT")),","),20)
178 S MSG(8)="Outpatient Encounters Reported "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"FINAL CNT")),","),20)
179 S MSG(9)="Patient Count "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"PATNUM")),","),20)
180 ;
181 S XMSUB="MEANS TEST = 'U' REPORT STATISTICS"
182 S XMTEXT="MSG("
183 S XMY(DUZ)=""
184 S XMDUZ="ACRP MT=U STATS"
185 D ^XMD
186 Q
187 ;
188PRINT ; Print Report
189 ;SD*5.3*474 added SDFLAG and corresponding logic
190 N SDNAME,SDNODE,SDXNODE,SDOEI,SDOEX,SDOEDT,DFN,PRNTL4,VA,PAGE,SDFLAG
191 ;
192 S PAGE=0
193 D HDR
194 S SDNAME=""
195 F S SDNAME=$O(^TMP("SCDX ASORT",$J,SDNAME)) Q:SDNAME']"" D
196 . W !,$E(SDNAME,1,30)
197 . S PRNTL4=0,SDFLAG=1
198 . S SDOEDT=0
199 . F S SDOEDT=$O(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)) Q:'SDOEDT D
200 . . S DFN=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,3)
201 . . S SDOEX=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,1)
202 . . S SDOEI=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,2)
203 . . I 'PRNTL4 D S PRNTL4=1
204 . . . D PID^VADPT6
205 . . . W ?($L(SDNAME)+1),"(",VA("BID"),")"
206 . . I 'SDFLAG D S SDFLAG=1
207 . . . W !,$E(SDNAME,1,30)
208 . . . D PID^VADPT6
209 . . . W ?($L(SDNAME)+1),"(",VA("BID"),")"
210 . . W ?35,$$FMTE^XLFDT(SDOEDT,"D"),$S(SDOEX>0:" *",1:" ")
211 . . W ?56,$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,4)
212 . . S SDNODE=$G(^SCE(SDOEI,0))
213 . . W ?68,$E($$GET1^DIQ(40.8,$P(SDNODE,U,11),.01),1,30)
214 . . W ?100,$E($$GET1^DIQ(44,$P(SDNODE,U,4),.01),1,30)
215 . . I ($Y+5)>IOSL D HDR S SDFLAG=0 Q
216 . . W !
217 D FTR1
218 Q
219 ;
220HDR ; Report Header
221 N SPACE,LINE,TAB,PRNTLN
222 ;
223 I PAGE>0 D FTR
224 W:PAGE>0 @IOF
225 S PAGE=PAGE+1
226 ;
227 S PRNTLN="Transmitted Outpatient Encounters with Means Test = 'U'"
228 S TAB=(IOM-$L(PRNTLN))\2
229 W !?TAB,PRNTLN
230 S PRNTLN="Date Range: "_$$FMTE^XLFDT(SDBEG)_" thru "_$$FMTE^XLFDT(SDEND)
231 S TAB=(IOM-$L(PRNTLN))\2
232 W !!?TAB,PRNTLN
233 S PRNTLN="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
234 S TAB=(IOM-$L(PRNTLN))\2
235 W !?TAB,PRNTLN
236 S PRNTLN="Page: "_PAGE
237 S TAB=(IOM-$L(PRNTLN))\2
238 W !?TAB,PRNTLN
239 ;
240 W !!?35,"Outpatient",?52,"",?68,"Medical Ctr"
241 W !,"PATIENT NAME",?35,"Encounter Date",?52,"MT Indicator",?68,"Division",?100,"Clinic"
242 ;
243 S $P(LINE,"=",IOM)="" W !,LINE
244 Q
245 ;
246FTR ; Report Footer
247 N SDX
248 ;
249 F SDX=$Y:1:IOSL-2 W !
250 W ?5,"* - Transmitted Outpatient Encounter"
251 Q
252 ;
253FTR1 ;
254 W !?5,"* - Transmitted Outpatient Encounter"
255 Q
256 ;
Note: See TracBrowser for help on using the repository browser.