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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGPFRFR1 ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT CONT. ; 5/21/03 4:40pm
2 ;;5.3;Registration;**425**;Aug 13, 1993
3 ;
4 ;This routine will create the ASSIGNMENTS DUE FOR REVIEW REPORT.
5 ;This routine will be used to display or print all of the patient
6 ; assignments due for Review for Category I and Category II PRF's.
7 ;
8 ;All sort input was created in routine DGPFRFR.
9 ; Input: The following array contains the sort var's:
10 ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth)
11 ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
12 ; = IEN of a (S)ingle Flag (#26.11)/(#26.15)
13 ; example: "1;DGPF(26.15,"
14 ; DGSORT("DGBEG") = Beginning date to report on
15 ; DGSORT("DGEND") = Ending date to report on
16 ;
17 ; Output: Formatted report of Record Flag Assignments due for review.
18 ;
19 ;- no direct entry
20 QUIT
21 ;
22START ; compile and print report
23 I $E(IOST)="C" D WAIT^DICD
24 N DGLIST
25 S DGLIST=$NA(^TMP("DGPFRFR1",$J))
26 K @DGLIST
27 D LOOP(.DGSORT)
28 D PRINT(.DGSORT,DGLIST)
29 D EXIT
30 Q
31 ;
32LOOP(DGSORT) ;use sort var's for record searching to build list
33 ; Input:
34 ; DGSORT - array of user selected report parameters
35 ;
36 ; Output:
37 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
38 ;
39 N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGC,DGX,DGQ,DGFG,DGSUB,DGNOW
40 S (DGQ,DGFG)=0
41 S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
42 S DGC=$S(+DGCAT=3:0,1:+DGCAT) ; 0 = both cat. I,II (National,Local)
43 S:DGC DGC=$S(DGC=1:26.15,1:26.11)
44 S DGFG=$P(DGFLAG,U) ;"A"=all flags or "5;DGPF(26.11," is selection
45 S DGSUB=DGBEG-1 ; seed var to start at user selected beginning date
46 F S DGSUB=$O(^DGPF(26.13,"AFREV",DGSUB)) Q:DGSUB="" D Q:DGQ
47 . I DGSUB>DGEND S DGQ=1 Q
48 . S DGDFN=""
49 . F S DGDFN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN)) Q:DGDFN="" D
50 .. S DGIEN=""
51 .. F S DGIEN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN,DGIEN)) Q:DGIEN="" D
52 ... Q:'$D(^DGPF(26.13,"D",DGDFN,1,DGIEN)) ;status not active
53 ... I +DGFG,'$D(^DGPF(26.13,"C",DGDFN,DGFG,DGIEN)) Q ;flag not found
54 ... D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
55 Q
56 ;
57BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
58 ; Input:
59 ; DGSORT - array of user selected report parameters
60 ; DGDFN - ien of patient in PATIENT (#2) file
61 ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
62 ;
63 ; Output:
64 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
65 ;
66 N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG
67 N DGLINE,DGNAME,DGREV,DGFG,DGNOT,DGYN
68 S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGNOT,DGYN)=""
69 K DGPFA,DGPFAH,DGPFPAT
70 ;retrieve a single assign record
71 Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
72 I +DGC,$P(DGPFA("FLAG"),U)'[+DGC Q ;not category selected
73 ;retrieve initial history assign record
74 Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
75 ;-- get 'initial assignment' date
76 S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
77 Q:'DGPFAH("INITASSIGN")
78 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
79 S DGCATG=$S($P(DGPFA("FLAG"),U)[26.15:1,1:2)
80 S DGFG=$P(DGPFA("FLAG"),U,2)
81 S DGNAME=DGPFPAT("NAME")
82 S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
83 I +DGPFA("REVIEWDT") D
84 . S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
85 . I +DGPFA("REVIEWDT")<DGNOW S DGREV=DGREV_" *" ;past due indicator
86 . ; calulate the notification date
87 . S DGNOT=$$NOTIFYDT^DGPFAA3($P(DGPFA("FLAG"),U),$P(DGPFA("REVIEWDT"),U))
88 . S DGYN=$S($D(^DGPF(26.13,"ANDAT",DGNOT,DGIEN)):"NO",1:"YES")
89 E S (DGREV,DGNOT,DGYN)="N/A"
90 S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_DGYN
91 S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
92 K DGPFA,DGPFAH,DGPFPAT
93 Q
94 ;
95PRINT(DGSORT,DGLIST) ;output report
96 ; Input:
97 ; DGSORT - array of user selected report parameters
98 ;
99 ; Output: Formated report to user selected device
100 ;
101 N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,DGPAGE,DGDT,DGCNT,DGOFG,X,Y,DGGRAND,DGLINE
102 S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
103 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
104 I $O(@DGLIST@(""))="" D Q
105 . S DGCAT=+DGSORT("DGCAT")
106 . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
107 . D HEAD
108 . W !!," >>> No Record Flag Assignments were found using the report criteria."
109 ; loop and print report
110 S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
111 F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
112 . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
113 .. I DGFG'=DGOFG D
114 ... D:DGCNT SUB(.DGCNT,1)
115 ... D HEAD
116 ... S DGOFG=DGFG,DGCNT=0
117 .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
118 ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
119 .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
120 .... D:$Y>(IOSL-4) HEAD
121 .... Q:DGQ
122 .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
123 .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?60,$P(DGSTR,U,4)
124 . Q:DGQ
125 . I DGCNT D
126 .. D SUB(.DGCNT,1)
127 .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags
128 .. S DGOFG="",DGCNT=0
129 ;
130 ;Shutdown if stop task requested
131 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
132 ;
133 I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
134 . S DGCAT=3,DGFG="All Flags",DGGRAND=1
135 . D HEAD
136 . W !!,"REPORT SUMMARY:",!,"---------------"
137 . F DGCAT=1,2,3 D
138 .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
139 .. W:DGCAT=3 !?46,"-------"
140 .. W !,"Total Review Assignments for Category "
141 .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
142 .. W ?47,$J(+$G(DGCNT(DGCAT)),6)
143 ;
144 W !!,"<End of Report>"
145 Q
146 ;
147PAUSE(DGQ) ; pause screen display
148 ; Input:
149 ; DGQ - var used to quit report processing to user CRT
150 ; Output:
151 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
152 ;
153 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
154 Q
155 ;
156SUB(CNT,TYP) ; print sub-totals
157 ; Input:
158 ; CNT - count of records printed
159 ; TYP - indicator of which total count is being printed
160 ; Output: Write lines of Sub-Totals and Totals per Flag and Category
161 ;
162 N DGTYPE,DGCOUNT
163 S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
164 S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
165 W:TYP=1 !
166 W !,"Total Review Assignments for "_DGTYPE_": ",DGCOUNT
167 W:TYP=1 !,"Note: "" * "" indicates that review date is past due",!
168 Q
169 ;
170HEAD ;Print/Display page header
171 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
172 D PAUSE(.DGQ)
173 Q:DGQ
174 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
175 S DGPAGE=$G(DGPAGE)+1
176 W !?22,"PATIENT RECORD FLAGS"
177 W !?16,"ASSIGNMENTS DUE FOR REVIEW REPORT",?70,"Page: ",$G(DGPAGE)
178 W !?16,"---------------------------------",?51,"Printed: ",DGDT
179 W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
180 W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
181 W !?1,"FLAG NAME: ",$G(DGFG),!
182 I DGGRAND W DGLINE Q
183 W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?54,"NOTIFICATION SENT"
184 W !,"--------------------",?22,"---------",?33,"--------",?43,"---------",?54,"-----------------"
185 Q
186 ;
187EXIT ;
188 I $D(ZTQUEUED) S ZTREQ="@"
189 K @DGLIST
190 I '$D(ZTQUEUED) D
191 . K %ZIS,POP
192 . D ^%ZISC,HOME^%ZIS
193 Q
Note: See TracBrowser for help on using the repository browser.