source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFRU1.m@ 1424

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1DGPTFRU1 ; ALB/SCK - PTF RECORDS CLOSEOUT RPT FOR MT INDICATOR = U ; 21 JULY 2003
2 ;;5.3;Registration;**537**;Aug 13, 1993
3 ;
4EN ; Main entry point for report
5 N DIR,DIRUT,DGBEG,DGEND,RSLT,Y,X
6 ;
7 S DIR("A")="Please Select Date Range for patient discharges",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) for the date range. 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(.DGBEG,.DGEND)
16 E I RSLT="B" D
17 . D CURYR(.DGBEG,.DGEND)
18 E D
19 . D GETDT(.DGBEG,.DGEND)
20 Q:'$G(DGBEG)!('$G(DGEND))
21 W !!?3,"Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
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,ZTQUEUED
32 S %ZIS="Q" D ^%ZIS G:POP EXIT
33 I $D(IO("Q")) D Q
34 . S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")="",ZTSAVE("DUZ")=""
35 . S ZTRTN="RUN^DGPTFRU1"
36 . S ZTDESC="PTF CLOSEOUT 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("DGPTFRU",$J),^TMP("DGPTFRUS",$J)
45 ;
46 D BLD(DGBEG,DGEND)
47 D CHKMT
48 D SRTNAME
49 D PRINT
50 D MAIL
51 K ^TMP("DGPTFRU",$J),^TMP("DGPTFRUS",$J)
52 Q
53 ;
54PASTYR(DGBEG,DGEND) ; Set dates for previous fiscal year
55 N CURYR,PRVYR,CURMN,%I
56 ;
57 ; Input/Output - See GETDT
58 ;
59 D NOW^%DTC
60 S CURYR=%I(3),CURMN=%I(1)
61 I CURMN>9 D
62 . S CURYR=CURYR+1
63 S PRVYR=CURYR-1
64 S DGEND=$$FMADD^XLFDT(PRVYR_"1001",-1)
65 S DGBEG=$$FMADD^XLFDT(PRVYR_"1001",-365)
66 Q
67 ;
68CURYR(DGBEG,DGEND) ; Set dates for current fiscal year
69 N CURYR,CURMN,%I
70 ;
71 ; Input/Output - See GETDT
72 ;
73 D NOW^%DTC
74 S CURYR=%I(3),CURMN=%I(1)
75 I CURMN<10 D
76 . S CURYR=CURYR-1
77 S DGBEG=CURYR_"1001"
78 S DGEND=$P($$NOW^XLFDT,".")
79 Q
80 ;
81GETDT(DGBEG,DGEND) ; Get beginning and ending date for search
82 ; Output DGBEG Beginning for date range, passed in by reference
83 ; DGEND End of date range, passed in by reference
84 ; result 1 - If function successful
85 ; 0 - If function NOT successful (User quit)
86 ;
87 N DIR,DIRUT,Y
88 ;
89 W !!?3,"You have selected to specify your own date range. Please note that by"
90 W !?3,"doing so you may not generate an accurate picture of the transmitted PTF"
91 W !?3,"closeouts where the means test indicator equals 'U'.",!
92 ;
93 S DIR(0)="DAO^:DT:EX"
94 S DIR("A")="Beginning Date: "
95 S DIR("?")="^D HELP^%DTC"
96 D ^DIR
97 I $D(DIRUT) D Q
98 . S DGBEG=0
99 S DGBEG=Y
100 ;
101 S DIR(0)="DAO^:DT:EX"
102 S DIR("A")="Ending Date: "
103 D ^DIR
104 I $D(DIRUT) D Q
105 . S DGEND=0
106 S DGEND=Y
107 Q
108 ;
109BLD(DGBEG,DGEND) ; Build list of PTF records for discharge date range
110 N DGX,DGMAX,CNT,DGPIEN,DFN
111 ;
112 ; Input/Output - See GETDT
113 ;
114 S DGX=$$FMADD^XLFDT(DGBEG,0,0,0,-1) ; set inital search DT to beginning date minus one second
115 S DGMAX=$$FMADD^XLFDT(DGEND,0,23,59,59) ; set search end date to end date plus one day
116 ;
117 S ^TMP("DGPTFRU",$J,0,"BEGIN")=$H
118 F S DGX=$O(^DGPT("ADS",DGX)) Q:'DGX D Q:DGX>DGMAX ; Search PTF Discharge Dates
119 . S DGPIEN=0
120 . F S DGPIEN=$O(^DGPT("ADS",DGX,DGPIEN)) Q:'DGPIEN D
121 . . S DFN=$P($G(^DGPT(DGPIEN,0)),U,1)
122 . . Q:'DFN
123 . . S ^TMP("DGPTFRU",$J,DFN,DGPIEN)=DGX_U_$$GET1^DIQ(45,DGPIEN,10,"I")_U_+$P($G(^DGPT(DGPIEN,0)),U,11)
124 . . S ^TMP("DGPTFRU",$J,0,"CNT")=$G(^TMP("DGPTFRU",$J,0,"CNT"))+1
125 S ^TMP("DGPTFRU",$J,0,"END")=$H
126 Q
127 ;
128CHKMT ; Clean out all PTF records except those meeting the MT=U conditions
129 N DFN,DGPIEN,DGIND
130 ;
131 S DFN=0
132 F S DFN=$O(^TMP("DGPTFRU",$J,DFN)) Q:'DFN D
133 . S DGPIEN=0
134 . F S DGPIEN=$O(^TMP("DGPTFRU",$J,DFN,DGPIEN)) Q:'DGPIEN D
135 . . S DGIND=$P($G(^TMP("DGPTFRU",$J,DFN,DGPIEN)),U,2)
136 . . ; If the MT INDICATOR of any of the closeout records for the patient is a value other than 'U', then delete all the entries for the patient
137 . . I DGIND'="U" D Q
138 . . . K ^TMP("DGPTFRU",$J,DFN)
139 S ^TMP("DGPTFRU",$J,0,"END")=$H
140 Q
141 ;
142SRTNAME ; Sort remaining PTF records by patient name and discharge date
143 N DFN,DGNAME,DGPIEN,DGPDT
144 ;
145 S DFN=0
146 F S DFN=$O(^TMP("DGPTFRU",$J,DFN)) Q:'DFN D
147 . S DGNAME=$$GET1^DIQ(2,DFN,.01)
148 . Q:DGNAME']""
149 . S ^TMP("DGPTFRU",$J,0,"PATCNT")=$G(^TMP("DGPTFRU",$J,0,"PATCNT"))+1
150 . S DGPIEN=0
151 . F S DGPIEN=$O(^TMP("DGPTFRU",$J,DFN,DGPIEN)) Q:'DGPIEN D
152 . . S ^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)=DFN_U_$P($G(^TMP("DGPTFRU",$J,DFN,DGPIEN)),U,3)
153 . . S ^TMP("DGPTFRU",$J,0,"FINAL CNT")=$G(^TMP("DGPTFRU",$J,0,"FINAL CNT"))+1
154 S ^TMP("DGPTFRU",$J,0,"END")=$H
155 Q
156 ;
157MAIL ; send message with report statistics
158 N MSG,XMSUB,XMY,XMTEXT,XMDUZ
159 ;
160 S MSG(1)="Date Range for Report "_$$FMTE^XLFDT(DGBEG,2)_" to "_$$FMTE^XLFDT(DGEND,2)
161 S MSG(2)=""
162 S MSG(3)="Report Started "_$$HTE^XLFDT(^TMP("DGPTFRU",$J,0,"BEGIN"),2)
163 S MSG(4)="Report Finished "_$$HTE^XLFDT(^TMP("DGPTFRU",$J,0,"END"),2)
164 S MSG(5)="Total Time for Report "_$$HDIFF^XLFDT(^TMP("DGPTFRU",$J,0,"END"),^TMP("DGPTFRU",$J,0,"BEGIN"),3)
165 S MSG(6)=""
166 S MSG(7)="PTF Records Scanned "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"CNT")),","),20)
167 S MSG(8)="PTF Records Reported "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"FINAL CNT")),","),20)
168 S MSG(9)="Patient Count "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"PATCNT")),","),20)
169 ;
170 S XMSUB="MEANS TEST = 'U' REPORT STATISTICS"
171 S XMTEXT="MSG("
172 S XMY(DUZ)=""
173 S XMDUZ="DG PTF MT=U STATS"
174 D ^XMD
175 Q
176 ;
177PRINT ; Print Report
178 N DGNAME,DFN,LAST4,VA,PAGE,DGPIEN,DGDOD,NEWNAME
179 ;
180 S PAGE=0
181 D HDR
182 S DGNAME=""
183 F S DGNAME=$O(^TMP("DGPTFRUS",$J,DGNAME)) Q:DGNAME']"" D
184 . S DGPIEN=0,NEWNAME=1
185 . F S DGPIEN=$O(^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)) Q:'DGPIEN D
186 . . S DFN=$P($G(^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)),U,1)
187 . . S LAST4=$$LAST4(DFN)
188 . . S DGDOD=$$DOFD(DFN)
189 . . I NEWNAME D
190 . . . W !,$E(DGNAME,1,30),LAST4
191 . . E W !
192 . . W ?35,DGPIEN
193 . . W ?48,$$GET1^DIQ(45,DGPIEN,11)
194 . . W ?57,$$GET1^DIQ(45,DGPIEN,6)
195 . . W ?80,$$GET1^DIQ(45,DGPIEN,7.4)
196 . . W:NEWNAME ?97,DGDOD
197 . . S NEWNAME=0
198 . . I ($Y+5)>IOSL D HDR Q
199 S ^TMP("DGPTFRU",$J,0,"END")=$H
200 Q
201 ;
202LAST4(DFN) ; Print last four of SSN
203 N VA
204 ;
205 D PID^VADPT6
206 Q " ("_VA("BID")_")"
207 ;
208DOFD(DFN) ; Print Date of Death, if there is one
209 N VADM
210 ;
211 D DEM^VADPT
212 Q $P($G(VADM(6)),U,2)
213 ;
214HDR ; Report Header
215 N SPACE,LINE,TAB,PRNTLN
216 ;
217 W:PAGE>0 @IOF
218 S PAGE=PAGE+1
219 ;
220 S PRNTLN="PTF Records Transmitted with MT Indicator of U Report"
221 S TAB=(IOM-$L(PRNTLN))\2
222 W !?TAB,PRNTLN
223 S PRNTLN="Date Range: "_$$FMTE^XLFDT(DGBEG)_" thru "_$$FMTE^XLFDT(DGEND)
224 S TAB=(IOM-$L(PRNTLN))\2
225 W !!?TAB,PRNTLN
226 S PRNTLN="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
227 S TAB=(IOM-$L(PRNTLN))\2
228 W !?TAB,PRNTLN
229 S PRNTLN="Page: "_PAGE
230 S TAB=(IOM-$L(PRNTLN))\2
231 W !?TAB,PRNTLN
232 W !!?35,"Record",?80,"Transmission",?97,"Date of"
233 W !,"Patient Name",?35,"Number",?48,"Type",?57,"Status",?80,"Date",?97,"Death"
234 S $P(LINE,"=",IOM)="" W !,LINE
235 Q
Note: See TracBrowser for help on using the repository browser.