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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm
2 ;;5.3;Registration;**554,650**;Aug 13, 1993;Build 3
3 ;
4 ;This routine will be used to display or print all of the patient
5 ;assignment history records that are not linked to a progress note.
6 ;
7 ; Input: The following sort array contains the report parameters:
8 ; DGSORT("DGCAT") = Flag Category to report on
9 ; = 1:National, 2:Local, 3:Both
10 ; DGSORT("DGBEG") = Beginning date to report on
11 ; DGSORT("DGEND") = Ending date to report on
12 ;
13 ; Output: A formatted report of patient Assignment History Actions
14 ; that are not linked to a TIU Progress Note.
15 ;
16 ;- no direct entry
17 QUIT
18 ;
19START ; compile and print report
20 I $E(IOST)="C" D WAIT^DICD
21 N DGLIST ;temp global name used for report list
22 S DGLIST=$NA(^TMP("DGPFRAL1",$J))
23 K @DGLIST
24 D LOOP(.DGSORT,DGLIST)
25 D PRINT(.DGSORT,DGLIST)
26 K @DGLIST
27 D EXIT
28 Q
29 ;
30LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
31 ; Input:
32 ; DGSORT - array of user selected report parameters
33 ; DGLIST - temp global name
34 ;
35 ; Output:
36 ; ^TMP("DGPFRAL1",$J) - temp global containing report output
37 ;
38 N DGBEG ;beginning date
39 N DGC ;var used to check which category is being reported on
40 N DGCAT ;flag category
41 N DGCATG ;category 1 or 2
42 N DGCNT ;flag counter
43 N DGDFN ;pointer to patient being reported on
44 N DGDFNLST ;array of dfn's assigned to the flag
45 N DGEND ;ending date
46 N DGHIENS ;array subscripted by assignment history date
47 N DGIEN ;assignment ien
48 N DGPAT ;patient data array
49 N DGPFA ;assignment data array
50 N DGQ ;quit var
51 N DGSUB ;loop flag
52 N DGX ;loop var
53 ;
54 ; setup variables equal to user input parameter subscripts
55 ; "DGCAT", "DGBEG", "DGEND"
56 S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
57 S DGC=$S(+DGCAT=3:0,1:+DGCAT)
58 S:DGC DGC=$S(DGC=1:26.15,1:26.11)
59 ;
60 ; loop assignment variable pointer flag x-ref file to run report
61 S (DGDFN,DGIEN)="",(DGQ,DGSUB,DGCNT)=0
62 F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ
63 . I DGC,DGSUB'[DGC Q ;not correct file based on category
64 . S DGCATG=$S(DGSUB[26.15:1,1:2)
65 . K DGDFNLST
66 . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)
67 . Q:'DGCNT
68 . S DGDFN=""
69 . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
70 . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
71 . . ; get assignment record
72 . . K DGPFA
73 . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
74 . . ; check if calling site is owner site
75 . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U))
76 . . ;
77 . . ;filter patient when last action is ENTERED IN ERROR
78 . . Q:$$ENTINERR(DGIEN)
79 . . ;
80 . . ;action ien array subscripted by assignment history date
81 . . K DGHIENS
82 . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
83 . . ; check if any Action's fall within the Begin and End dates
84 . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'<DGBEG) D
85 . . . ;delete any action that is not within Begin and End dates
86 . . . S DGX=0 F S DGX=$O(DGHIENS(DGX)) Q:DGX="" D
87 . . . . I $P(DGX,".")<DGBEG!($P(DGX,".")>DGEND) K DGHIENS(DGX)
88 . . . Q:'$O(DGHIENS(""))
89 . . . ;
90 . . . ; get patient demographics
91 . . . K DGPAT
92 . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
93 . . . ;
94 . . . ; call to build temp global
95 . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)
96 ;
97 Q
98 ;
99BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder
100 ; Input:
101 ; DGPFA - array of assignment record data
102 ; DGPAT - array of patient demographics
103 ; DGHIENS - array of history action IEN's sorted by d/t
104 ; DGCATG - category of flag 1=National, 2=Local
105 ; DGLIST - temp global name used for report list
106 ;
107 ; Output:
108 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
109 ;
110 N DGACTDT ;initial entry date
111 N DGFGNM ;flag name
112 N DGHIEN ;assignment ien
113 N DGLINE ;report detail line
114 N DGLNCNT ;unique subscript counter
115 N DGPDFN ;pointer to patient
116 N DGPFAH ;assignment history record data
117 N DGPNM ;patient name
118 ;
119 ; loop all assignment history ien's
120 S DGHIEN="",DGLNCNT=0
121 F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D
122 . ; get assignment history record
123 . K DGPFAH
124 . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)
125 . Q:+$G(DGPFAH("TIULINK")) ;progress note pointer is setup
126 . Q:+$G(DGPFAH("ACTION"))=5 ;don't report on ENTERED IN ERROR action
127 . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
128 . S DGPNM=DGPAT("NAME")
129 . S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
130 . S DGPDFN=$P(DGPFA("DFN"),U)
131 . S DGFGNM=$P(DGPFA("FLAG"),U,2)
132 . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
133 . S DGLINE=DGPAT("SSN")_U_$E(DGFGNM,1,17)_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT
134 . S DGLNCNT=DGLNCNT+1
135 . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE
136 ;
137 Q
138 ;
139PRINT(DGSORT,DGLIST) ;output report
140 ; Input:
141 ; DGSORT - array of user selected report parameters
142 ; DGLIST - temp global name used for report list
143 ;
144 ; Output: Formatted report to user selected device
145 ;
146 N DGCAT ;flag category
147 N DGCNT ;counter of detail lines
148 N DGDFN ;ien of patient
149 N DGDT ;date time report printed
150 N DGFG ;flag name
151 N DGGRAND ;flag to print grand totals
152 N DGLINE ;string of hyphens (80) for report header format
153 N DGLN ;loop var
154 N DGNAM ;patient name
155 N DGODFN ;print loop var flag
156 N DGOFG ;print loop var flag
157 N DGPCAT ;print form of category
158 N DGPAGE ;page counter
159 N DGQ ;quit flag
160 N DGSTR ;string of detail line to display
161 N X,Y
162 ;
163 S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",81)=""
164 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
165 S (DGCAT,DGPCAT)=+DGSORT("DGCAT")
166 ;
167 I $O(@DGLIST@(""))="" D Q
168 . D HEAD
169 . W !!," >>> No Record Flag Assignments were found using the report criteria.",!
170 ;
171 ; loop and print report
172 S (DGCAT,DGFG,DGNAM,DGDFN,DGODFN,DGOFG,DGLN,DGSTR)=""
173 F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
174 . D HEAD S DGCNT=0
175 . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
176 .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
177 ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
178 .... F S DGLN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
179 ..... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN))
180 ..... W !
181 ..... I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD S DGODFN="" W !
182 ..... ; - write name and ssn once
183 ..... I DGODFN'=DGDFN S DGODFN=DGDFN,DGOFG=DGFG D
184 ...... W $E(DGNAM,1,18),?20,$P(DGSTR,U),?32,$E($P(DGSTR,U,2),1,17)
185 ..... ; - write new flag name
186 ..... I DGOFG'=DGFG S DGOFG=DGFG W ?32,$E($P(DGSTR,U,2),1,17)
187 ..... ; - write action detail
188 ..... W ?51,$P(DGSTR,U,3),?69,$P(DGSTR,U,4)
189 ..... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
190 . Q:DGQ
191 . I DGCNT D
192 .. W !!,"Total Actions not Linked for Category "_$S(DGCAT=1:"I",1:"II")_": ",?46,$J(+$G(DGCNT(DGCAT)),6)
193 .. S DGCNT=0,DGODFN=""
194 .. D:DGPCAT=3 PAUSE(.DGQ)
195 ;
196 ;Shutdown if stop task requested
197 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
198 ;
199 I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
200 . S DGCAT=3,DGGRAND=1
201 . D HEAD
202 . W !!,"REPORT SUMMARY:",!,"---------------"
203 . F DGCAT=1,2,3 D
204 .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
205 .. W:DGCAT=3 !?48,"-------"
206 .. W !,"Total Actions not Linked for Category "
207 .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
208 .. W ?49,$J(+$G(DGCNT(DGCAT)),6)
209 ;
210 W !!,"<End of Report>"
211 Q
212 ;
213PAUSE(DGQ) ; pause screen display
214 ; Input:
215 ; DGQ - var used to quit report processing to user CRT
216 ; Output:
217 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
218 ;
219 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
220 Q
221 ;
222HEAD ;Print/Display page header
223 ;
224 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
225 ;
226 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
227 ;
228 S DGPAGE=$G(DGPAGE)+1
229 W !?25,"PATIENT RECORD FLAGS"
230 W !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$G(DGPAGE)
231 W !,"Report Selected: "_$S($G(DGPCAT)=1:"Category I (National)",$G(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
232 W !?5,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
233 W ?50,"Printed: ",DGDT
234 W !,DGLINE
235 ;
236 Q:DGGRAND
237 ;
238 W !!,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
239 W !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE"
240 W !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?69,"-----------"
241 Q
242 ;
243EXIT ;
244 I $D(ZTQUEUED) S ZTREQ="@"
245 I '$D(ZTQUEUED) D
246 . K %ZIS,POP
247 . D ^%ZISC,HOME^%ZIS
248 Q
249 ;
250ENTINERR(DGIEN) ;is last action ENTERED IN ERROR
251 ; Input:
252 ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
253 ;
254 ; Output:
255 ; Function Value - Return 1 on success, 0 on failure
256 ;
257 N DGPFAH
258 ;
259 I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)
260 Q +$G(DGPFAH("ACTION"))=5
Note: See TracBrowser for help on using the repository browser.