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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1DGMSTR2 ;ALB/SCK - MST DETAILED DEMOGRAPHIC REPORT ; 11/19/03 10:56am
2 ;;5.3;Registration;**195,555**;Aug 13, 1993
3 ;
4EN ; Main entry point for report
5 ; Variable List
6 ; DGBEG - Beginning of date range (FM date)
7 ; DGEND - End of date range (FM Date)
8 ; DGMST - array of MST status codes
9 ; DGSEX - Patient gender to filter on
10 ; DGPOS - array of period of service values to filter on
11 ; DGDISP - Sort report on
12 ; DGSDAT - start date selection
13 ; DGEDAT - end date selection
14 ; RPTREF - location of report data array
15 ; RPTARRY - temporary location of report array
16 ; DGX - temporary variable
17 ; MSTST - temporary variable holding MST status
18 ; MSTPOS - temporary array of selected POS's
19 ; MSTNAME - temporary variable, patient name
20 ; MSTIEN - temporary variable, IEN in MST HISTORY File (#29.11)
21 ; MSTACT - temporary array, service in country indicated
22 ; MSTDT - temporary variable, MST status change date
23 ;
24 N DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,DGSDAT,DGEDAT,DIC,Y,X,ZTSAVE
25 ;
26 ;; Get beginning date for report
27 K DIRUT
28 S DIR(0)="DAO^:"_$$DT^XLFDT_":EX",DIR("A")="Start Date: "
29 S DIR("?")="Enter beginning date of the reports date range."
30 D ^DIR K DIR
31 Q:$D(DIRUT)
32 S DGSDAT=+Y
33 ;
34 ;; Get ending date for report
35 K DIRUT
36 S DIR(0)="DAO^"_DGSDAT_":"_DT_":EX",DIR("A")="End Date: "
37 S DIR("?")="Enter the ending date of the reports date range."
38 D ^DIR K DIR
39 Q:$D(DIRUT)
40 S DGEDAT=+Y_.9999
41 ;
42 ; Call procedure to select MST status codes to include
43 D GETMST(.DGMST)
44 Q:($O(DGMST(""))="")
45 ;
46 ;; Select gender for report
47 K DIRUT
48 S DIR(0)="SAO^M:Male;F:Female;B:Both"
49 S DIR("A")="Gender to display MST status for: ",DIR("B")="Both"
50 S DIR("?",1)="Select the gender to include on the report, either male,"
51 S DIR("?")="female or both."
52 D ^DIR K DIR
53 Q:$D(DIRUT)
54 S DGSEX=Y
55 ;
56 ;; Select period of service to include
57 N VAUTNI,VAUTSTR,VAUTVB
58 S VAUTNI=0,VAUTSTR="Period of Service to include"
59 S VAUTVB="DGPOS",DIC=21
60 D FIRST^VAUTOMA
61 ;
62 ;; Select sort criteria
63 K DIRUT
64 S DIR(0)="SAO^P:Patient Name;S:Period of Service/Patient Name"
65 S DIR("A")="Sort report by ",DIR("B")="Patient Name"
66 S DIR("?",1)="Sort the report by either patient name, or by Period of"
67 S DIR("?")="Service and within POS, by patient name."
68 D ^DIR K DIR
69 Q:$D(DIRUT)
70 S DGDISP=Y
71 ;
72 ;; Set up print device using KERNEL utility
73 N ZTSAVE
74 F X="DGPOS","DGPOS(","DGDISP","DGSEX","DGSDAT","DGEDAT","DGMST(" D
75 . S ZTSAVE(X)=""
76 W !!,"This report is formatted for 132 characters, and will not format"
77 W !,"correctly on either an 80 column terminal or printer."
78 W !!,"This report may take a while to build and print. In order to"
79 W !,"free up your workstation, please queue this report to print device."
80 D EN^XUTMDEVQ("RPT^DGMSTR2","MST Detailed Report",.ZTSAVE)
81 D HOME^%ZIS
82 Q
83 ;
84RPT ; Main entry point for printing report form KERNEL device utility
85 N FRSTPAS
86 S RPTREF="^TMP(""DGMST DEM"","_$J_")"
87 K @RPTREF
88 D BUILD(DGSDAT,DGEDAT,.DGMST,DGSEX,.DGPOS,DGDISP,RPTREF)
89 I DGDISP["P" D PRNNAME(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
90 I DGDISP["S" D PRNPOS(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
91 K @RPTREF,RPTREF
92 Q
93 ;
94BUILD(DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,RPTARRY) ;
95 ;; Build the report array using the parameters entered by the user
96 ;
97 N MSTDT,DFN,LINE,MSTIEN,DGX,MSTDAT,VADM,VAEL,VAPA,VA
98 S MSTDT=DGBEG
99 F S MSTDT=$O(^DGMS(29.11,"B",MSTDT)) Q:'MSTDT!(MSTDT>DGEND) D
100 . S MSTIEN=0
101 . F S MSTIEN=$O(^DGMS(29.11,"B",MSTDT,MSTIEN)) Q:'MSTIEN D
102 .. S MSTDAT=$G(^DGMS(29.11,MSTIEN,0))
103 .. S DGX=$P(MSTDAT,U,3)
104 .. Q:'($D(DGMST(DGX)))
105 .. S DFN=$P(MSTDAT,U,2)
106 .. S DGX=$$GETSTAT^DGMSTAPI(DFN)
107 .. Q:MSTIEN'=+DGX
108 .. D DEM^VADPT
109 .. I '(DGSEX["B") Q:'(DGSEX[$P(VADM(5),U))
110 .. D ELIG^VADPT
111 .. I 'DGPOS S DGX=$P(VAEL(2),U) Q:'($D(DGPOS(+DGX)))
112 .. S LINE=$G(LINE)+1
113 .. I DGDISP["P" D
114 ... S @RPTARRY@($P(MSTDAT,U,3),VADM(1),LINE)=DFN_U_MSTIEN
115 .. E D
116 ... S @RPTARRY@($P(MSTDAT,U,3),$S(VAEL(2)]"":VAEL(2),1:"UNKNOWN"),VADM(1),LINE)=DFN_U_MSTIEN
117 .. D KVAR^VADPT
118 Q
119 ;
120PRNNAME(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
121 ; Print out report on patient name sort. One level of sort in the ^TMP global
122 N MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGNDX,MSTDAT
123 ;
124 S MSTST=""
125 F S MSTST=$O(DGMST(MSTST)) Q:'(MSTST]"") D Q:$G(DGQUIT)
126 . I $O(@RPTARRY@(MSTST,""))="" D Q
127 .. S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) ;DG*5.3*264
128 .. W !!?5,"No data for MST status "_MSTST_" found."
129 . S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
130 . S (DGNDX,MSTNAME)=""
131 . F S MSTNAME=$O(@RPTARRY@(MSTST,MSTNAME)) Q:'(MSTNAME]"") D Q:$G(DGQUIT)
132 .. F S DGNDX=$O(@RPTARRY@(MSTST,MSTNAME,DGNDX)) Q:'(DGNDX]"") D Q:$G(DGQUIT)
133 ... S MSTDAT=$G(^(DGNDX))
134 ... S DFN=$P(MSTDAT,U),MSTIEN=$P(MSTDAT,U,2)
135 ... D PRNTLN1(DFN,MSTIEN)
136 ... I $Y+5>$G(IOSL) S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
137 Q
138 ;
139PRNPOS(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
140 ; Print out report on period of service sort, Two levels of sort.
141 N MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGX,DGNDX
142 ;
143 I '$O(@RPTARRY@(""))="" D Q
144 . S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
145 . W !!?5,"No data for these parameters found."
146 ;
147 S MSTST=""
148 F S MSTST=$O(DGMST(MSTST)) Q:'(MSTST]"") D Q:$G(DGQUIT)
149 . I $O(@RPTARRY@(MSTST,""))="" D Q
150 .. S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
151 .. W !!?5,"No data for MST status "_MSTST_" found."
152 . S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
153 . S MSTPOS=""
154 . F S MSTPOS=$O(@RPTARRY@(MSTST,MSTPOS)) Q:'(MSTPOS]"") D Q:$G(DGQUIT)
155 .. S (MSTNAME,DGNDX)=""
156 .. F S MSTNAME=$O(@RPTARRY@(MSTST,MSTPOS,MSTNAME)) Q:'(MSTNAME]"") D Q:$G(DGQUIT)
157 ... F S DGNDX=$O(@RPTARRY@(MSTST,MSTPOS,MSTNAME,DGNDX)) Q:'(DGNDX]"") D Q:$G(DGQUIT)
158 .... S MSTDAT=$G(^(DGNDX))
159 .... S DFN=$P(MSTDAT,U),MSTIEN=$P(MSTDAT,U,2)
160 .... D PRNTLN1(DFN,MSTIEN)
161 .... I $Y+5>$G(IOSL) S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
162 Q
163 ;
164PRNTLN1(DFN,MSTIEN) ; Format and print data for patient passed in
165 N MSTACT,DGX,VADM,VAEL,VAPA,VA
166 D DEM^VADPT,ELIG^VADPT,ADD^VADPT,ACTION(DFN,.MSTACT)
167 ;
168 W !,VA("BID")
169 W ?6,$E(VADM(1),1,25)
170 W ?32,$E(VAPA(1),1,25)
171 W ?58,$P(VADM(5),U)
172 W ?61,$E($P(VAEL(1),U,2),1,15)
173 W ?80,$E($P(VAEL(2),U,2),1,15)
174 W ?100,$G(MSTACT(1))
175 W !
176 S DGX=$E(VAPA(4),1,$L(VAPA(4)))_$S(VAPA(6)]"":", ",1:" ")_$P(VAPA(5),U,2)_" "_VAPA(6)
177 W ?32,$S($G(VAPA(2))]"":$E(VAPA(2),1,25),1:DGX)
178 W ?100,$G(MSTACT(2))
179 W !
180 W ?32,$S($G(VAPA(2))]"":DGX,1:VAPA(8))
181 W ?100,$G(MSTACT(3))
182 W !
183 W ?32,$S($G(VAPA(2))]"":VAPA(8),1:"")
184 W ?100,$G(MSTACT(4))
185 ;
186 I $G(MSTACT(5))]"" D
187 . W !?100,$G(MSTACT(5))
188 . I $G(MSTACT(6))]"" D
189 .. W !?100,$G(MSTACT(6))
190 E W !
191 ;
192 D KVAR^VADPT
193 Q
194 ;
195HEADER(MSTST,DGDISP,DGBEG,DGEND) ; Print report header
196 N LINE,STR,SDASH
197 I $G(FRSTPAS),$E(IOST,1,2)="C-" D PAUSE^VALM1 Q:'Y 1
198 I '$G(FRSTPAS) D
199 . S FRSTPAS=1
200 . W @IOF
201 E D
202 . W @IOF
203 ;
204 S STR="MST Detailed Demographic Report"
205 S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
206 W !,LINE_STR
207 S STR="MST Status: "_$S(MSTST["Y":"Yes",MSTST["N":"No",MSTST["D":"Declined",1:"Unknown")
208 K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
209 W !,LINE_STR
210 S STR="Sorted by: "_$S(DGDISP["P":"Patient",1:"Period of Service\Patient")
211 K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
212 W !,LINE_STR
213 S STR="Date Range: "_$$FMTE^XLFDT(DGBEG,"D")_" - "_$$FMTE^XLFDT(DGEND,"D")
214 K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
215 W !,LINE_STR
216 S STR="Date printed: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
217 K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
218 W !,LINE_STR
219 W !!
220 W !?32,"ADDRESS",?82,"PERIOD"
221 W !?6,"PATIENT",?32,"AND",?63,"ELIGIBILITY",?82,"OF"
222 W !,"SSN",?6,"NAME",?32,"PHONE",?57,"SEX",?63,"CODE",?82,"SERVICE",?100,"SERVICE IND."
223 W !
224 S $P(SDASH,"-",IOM+1)=""
225 W SDASH,!
226 Q 0
227 ;
228ACTION(DFN,MSTRSLT) ; Check for service indicated fields in PATIENT File (#2) for
229 ; patient passed in. Return local array with all entries flaged as yes in the
230 ; respective fields
231 ; .32101 - Vietnam
232 ; .3221 - Lebanon
233 ; .3224 - Grenada
234 ; .3227 - Panama
235 ; .32201 - Persian Gulf
236 ; .322016 - Somalia
237 ; Output
238 ; MSTRSLT(n)="VIETNAM"
239 ;
240 N MSTACTN,NDX,LINE
241 S DFN=DFN_","
242 D GETS^DIQ(2,DFN,".32101;.3221;.3224;.3227;.32201;.322016","E","MSTACTN")
243 S NDX=""
244 F S NDX=$O(MSTACTN(2,DFN,NDX)) Q:'NDX D
245 . S:MSTACTN(2,DFN,NDX,"E")["YES" LINE=$G(LINE)+1,MSTRSLT(LINE)=$$SERVICE(NDX)
246 ;
247 Q
248 ;
249SERVICE(NDX) ; Convert field number to text value
250 Q $S(NDX=.32101:"VIETNAM",NDX=.3221:"LEBANON",NDX=.3224:"GRENADA",NDX=.3227:"PANAMA",NDX=.32201:"PERSIAN GULF",NDX=.322016:"SOMALIA",1:"UNKNOWN")
251 ;
252 ;
253GETMST(MST) ; Multiple MST status code seletion, loops until user quites
254NEXT S DIR(0)="29.11,3AO"
255 S DIR("A")="Select MST status code: "
256 S DIR("?")="Select one of the current MST status codes: Y/N/D/U."
257 D ^DIR K DIR
258 Q:$D(DIRUT)
259 S:'$D(MST(Y)) MST(Y)=""
260 G NEXT
261 Q
Note: See TracBrowser for help on using the repository browser.