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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1DGPFRAB1 ;ALB/RBS - PRF APPROVED BY REPORT CONT. ; 6/4/04 11:17am
2 ;;5.3;Registration;**554**;Aug 13, 1993
3 ;
4 ;This routine will be used to display or print all Patient Record
5 ;Flag Assignment History Actions for the Approved By Person who
6 ;authorized the new entry or edit of an assignment to the patient.
7 ;
8 ; Input: The following sort array contains the report parameters:
9 ; DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
10 ; or
11 ; = "A" = All approved by persons
12 ; DGSORT("DGCAT") = CATEGORY
13 ; 1^Category I (National)
14 ; 2^Category II (Local)
15 ; 3^Both
16 ; DGSORT("DGSTATUS") = Assignment Status to report on
17 ; 1^Active
18 ; 2^Inactive
19 ; 3^Both
20 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
21 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
22 ;
23 ; Output: A formatted report of the Approved By person's assignments
24 ; that they have authorized to be assigned to a patient.
25 ;
26 ;- no direct entry
27 QUIT
28 ;
29START ; compile and print report
30 I $E(IOST)="C" D WAIT^DICD
31 N DGLIST ;temp global name used for report list
32 S DGLIST=$NA(^TMP("DGPFRAB1",$J))
33 K @DGLIST
34 D LOOP(.DGSORT,DGLIST)
35 D PRINT(.DGSORT,DGLIST)
36 K @DGLIST
37 D EXIT
38 Q
39 ;
40LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
41 ; Input:
42 ; DGSORT - array of user selected report parameters
43 ; DGLIST - temp global name
44 ;
45 ; Output:
46 ; ^TMP("DGPFRAB1",$J) - temp global containing report output
47 ;
48 N DGABIEN ;approved by person ien
49 N DGAIEN ;approved by history assignment ien
50 N DGAPROV ;approved by sort
51 N DGBEG ;sort beginning date
52 N DGC ;var used to check which category is being reported on
53 N DGCAT ;sort flag category
54 N DGCATG ;category 1 or 2
55 N DGEND ;sort ending date
56 N DGHIEN ;history assignment ien
57 N DGPFA ;assignment data array
58 N DGPFAH ;assignment history data array
59 N DGQ ;quit var
60 N DGSTAT ;status of assignment
61 N DGSTATUS ;sort status
62 N DGSUB ;loop flag
63 N DGX ;loop var
64 ;
65 ; setup variables equal to user input parameter subscripts
66 ; "DGAPROV", "DGCAT", "DGSTATUS", "DGBEG", "DGEND"
67 S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
68 ;
69 S DGABIEN=+DGAPROV ; if 0, then All Approved By sort
70 S DGC=$S(+DGCAT=3:0,1:+DGCAT) ; 0=Both categories sort
71 S:DGC DGC=$S(DGC=1:26.15,1:26.11) ; specific file
72 S DGSTAT=+DGSTATUS ; assignments status to report on
73 S:DGSTAT=2 DGSTAT=0 ; inactive status value is '0'
74 ;
75 ; seed var to start at user selected values
76 S (DGQ,DGSUB)=0
77 S DGSUB=DGBEG-1
78 ;
79 ; loop history assignment d/t & approve by x-ref file
80 F S DGSUB=$O(^DGPF(26.14,"D",DGSUB)) Q:DGSUB="" D Q:DGQ
81 . I DGSUB>(DGEND+.999999999) S DGQ=1 Q
82 . S DGAIEN=""
83 . S:DGABIEN DGAIEN=DGABIEN-1 ;seed var to start before selection
84 . F S DGAIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN)) Q:DGAIEN="" D
85 .. I DGABIEN,(DGAIEN>DGABIEN) Q
86 .. S DGHIEN=""
87 .. F S DGHIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN,DGHIEN)) Q:DGHIEN="" D
88 ...K DGPFAH
89 ...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
90 ...I DGABIEN,(+DGPFAH("APPRVBY")'=DGABIEN) Q
91 ...K DGPFA
92 ...Q:'$$GETASGN^DGPFAA(+DGPFAH("ASSIGN"),.DGPFA)
93 ...I DGC,DGPFA("FLAG")'[DGC Q ;not correct category
94 ...I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q ;not correct status
95 ...S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2)
96 ...D BLDTMP(.DGPFA,.DGPFAH,DGHIEN,DGCATG,DGLIST)
97 Q
98 ;
99BLDTMP(DGPFA,DGPFAH,DGHIEN,DGCATG,DGLIST) ; list global builder
100 ; Input:
101 ; DGPFA - array of assignment record data
102 ; DGPFAH - array of assignment history record data
103 ; DGHIEN - ien to PRF ASSIGNMENT HISTORY (#26.14) file record
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 DG1,DG2 ;subscript var's
111 N DGACTDT ;initial entry date
112 N DGDFN ;pointer to patient being reported on
113 N DGFGNM ;flag name
114 N DGLINE ;report detail line
115 N DGPAT ;array of patient demographics
116 N DGPNM ;patient name
117 N DGREV ;review date
118 ;
119 ; get patient demographics
120 S DGDFN=$P(DGPFA("DFN"),U)
121 K DGPAT
122 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
123 S DGPNM=DGPAT("NAME")
124 S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
125 S DGFGNM=$P(DGPFA("FLAG"),U,2)
126 S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
127 S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
128 I +DGPFA("REVIEWDT") D
129 .S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
130 E S DGREV="N/A"
131 S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
132 ; setup subscripts -
133 ; - Approved By Name, IEN, Cat, Flag Name, Pat Name, DFN, History IEN
134 S DG1=$P(DGPFAH("APPRVBY"),U,2),DG2=$P(DGPFAH("APPRVBY"),U)
135 S @DGLIST@(DG1,DG2,DGCATG,DGFGNM,DGPNM,DGDFN,DGHIEN)=DGLINE
136 Q
137 ;
138PRINT(DGSORT,DGLIST) ;output report
139 ; Input:
140 ; DGSORT - array of user selected report parameters
141 ; DGLIST - temp global name used for report list
142 ;
143 ; Output: Formatted report to user selected device
144 ;
145 N DGAPNM ;approved by name
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 DGIEN ;approved by ien
152 N DGLINE ;string of hyphens (80) for report header format
153 N DGLN ;loop var
154 N DGNAM ;patient name
155 N DGOCAT ;category switch flag
156 N DGODFN ;loop var flag
157 N DGOFG ;name switch flag
158 N DGOIEN ;ien switch flag
159 N DGPAGE ;page counter
160 N DGQ ;quit flag
161 N DGSTR ;string of detail line to display
162 N X,Y
163 ;
164 S (DGCNT,DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
165 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
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 (DGIEN,DGOIEN,DGAPNM,DGCAT,DGOCAT,DGFG,DGOFG,DGNAM,DGDFN,DGODFN,DGLN,DGSTR)=""
173 D HEAD
174 F S DGAPNM=$O(@DGLIST@(DGAPNM)) Q:DGAPNM="" D Q:DGQ
175 . F S DGIEN=$O(@DGLIST@(DGAPNM,DGIEN)) Q:DGIEN="" D Q:DGQ
176 . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1 S DGOIEN=DGIEN
177 . . I DGOIEN'=DGIEN S DGOIEN=DGIEN W:DGCNT ! D HEAD1
178 . . F S DGCAT=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT)) Q:DGCAT="" D Q:DGQ
179 . . . F S DGFG=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
180 . . . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGOFG=DGFG
181 . . . . I DGOFG'=DGFG W:DGOFG]"" !! D HEAD2 S DGOFG=DGFG
182 . . . . ; print patient detail line
183 . . . . D PRNTPAT
184 . ; reset var's to pop header's
185 . S (DGOIEN,DGOCAT,DGOFG)=""
186 ;
187 ;Shutdown if stop task requested
188 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
189 ;
190 W !!,"<End of Report>"
191 Q
192 ;
193PRNTPAT ; loop and print all patients for flag
194 ;
195 S DGODFN=""
196 F S DGNAM=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
197 . F S DGDFN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
198 . . F S DGLN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
199 . . . I $Y>(IOSL-3) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGODFN=""
200 . . . S DGSTR=$G(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
201 . . . W !
202 . . . I DGODFN'=DGDFN S DGODFN=DGDFN D ;only print name once
203 . . . . W $E(DGNAM,1,16),?18,$P(DGSTR,U)
204 . . . W ?30,$P(DGSTR,U,2),?48,$P(DGSTR,U,3),?60,$P(DGSTR,U,4),?71,$P(DGSTR,U,5)
205 . . . S DGCNT=DGCNT+1
206 Q
207 ;
208PAUSE(DGQ) ; pause screen display
209 ; Input:
210 ; DGQ - var used to quit report processing to user CRT
211 ; Output:
212 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
213 ;
214 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
215 Q
216 ;
217HEAD ;Print/Display page header
218 ;
219 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
220 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
221 ;
222 S DGPAGE=$G(DGPAGE)+1
223 W !?25,"PATIENT RECORD FLAGS"
224 W !?20,"ASSIGNMENTS APPROVED BY REPORT",?68,"Page: ",$G(DGPAGE)
225 W !,"Date Range: ",$$FDATE^VALM1(DGSORT("DGBEG"))_" to "_$$FDATE^VALM1(DGSORT("DGEND"))
226 W ?50,"Printed: ",DGDT
227 W !,DGLINE
228 Q
229 ;
230HEAD1 W !!,"Approved By: ",DGAPNM
231 Q
232 ;
233HEAD2 W !,"Flag Name: ",$G(DGFG)," - ",$S(+DGCAT=1:"Category I (National)",1:"Category II (Local)")
234 ;
235 W !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
236 W !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
237 Q
238 ;
239EXIT ;
240 I $D(ZTQUEUED) S ZTREQ="@"
241 I '$D(ZTQUEUED) D
242 . K %ZIS,POP
243 . D ^%ZISC,HOME^%ZIS
244 Q
Note: See TracBrowser for help on using the repository browser.