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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm
2 ;;5.3;Registration;**425,554**;Aug 13, 1993
3 ;
4 ;This routine will compile and produce the FLAG ASSIGNMENT REPORT.
5 ;This routine will be used to display or print all of the patient
6 ; assignments for Category I and Category II Patient Record Flags.
7 ;
8 ;All sort input was created in routine DGPFRFA.
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: A formatted report of Record Flag Assignments to patients.
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("DGPFRFA1",$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,DGDFNLST
40 N DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT
41 S (DGQ,DGFG,DGSUB,DGCNT)=0
42 S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
43 S DGC=$S(+DGCAT=3:0,1:+DGCAT) ;0 = both categories (National & Local)
44 S:DGC DGC=$S(DGC=1:26.15,1:26.11)
45 S DGF=$P(DGFLAG,U) ;"A"=all flags - "5;DGPF(26.11," is selection
46 ; re-seed var to start looping before actual selection
47 D:+DGF
48 . S DGSUB=$O(^DGPF(26.13,"AFLAG",DGF),-1) ;previous value or NULL
49 ; ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien
50 ;
51 S (DGDFN,DGIEN)=""
52 F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ
53 . I DGC,DGSUB'[DGC Q ;not correct file based on category
54 . I +DGF,DGSUB'[DGF S:DGSUB>DGF DGQ=1 Q ;don't setup or quit loop
55 . K DGDFNLST
56 . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) ;get list of dfn's
57 . Q:'DGCNT
58 . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
59 . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
60 . . D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
61 K DGDFNLST
62 Q
63 ;
64BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
65 ; Input:
66 ; DGSORT - array of user selected report parameters
67 ; DGDFN - ien of patient in PATIENT (#2) file
68 ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
69 ; DGLIST - temp global name used for report list
70 ;
71 ; Output:
72 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
73 ;
74 N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG
75 S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)=""
76 K DGPFA,DGPFAH,DGPFPAT
77 ;retrieve a single assign record
78 Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
79 ;retrieve initial history assign record
80 Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
81 ;-- get 'initial assignment' date
82 S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
83 Q:'DGPFAH("INITASSIGN")
84 S DGINIT=+DGPFAH("INITASSIGN")
85 I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
86 . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
87 . S DGCATG=$S(DGSUB[26.15:1,1:2)
88 . S DGFG=$P(DGPFA("FLAG"),U,2)
89 . S DGNAME=DGPFPAT("NAME")
90 . S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
91 . I +DGPFA("REVIEWDT") D
92 .. S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
93 . E S DGREV="N/A"
94 . S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
95 . S DGLINE=DGLINE_U_$P(DGPFA("OWNER"),U,2)
96 . S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
97 K DGPFA,DGPFAH,DGPFPAT
98 Q
99 ;
100PRINT(DGSORT,DGLIST) ;output report
101 ; Input:
102 ; DGSORT - array of user selected report parameters
103 ; DGLIST - temp global name used for report list
104 ;
105 ; Output: Formated report to user selected device
106 ;
107 N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE
108 S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
109 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
110 I $O(@DGLIST@(""))="" D Q
111 . S DGCAT=+DGSORT("DGCAT")
112 . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
113 . D HEAD
114 . W !!," >>> No Record Flag Assignments were found using the report criteria."
115 ; loop and print report
116 S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
117 F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
118 . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
119 .. I DGFG'=DGOFG D
120 ... D:DGCNT SUB(.DGCNT,1)
121 ... D HEAD
122 ... S DGOFG=DGFG,DGCNT=0
123 .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
124 ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
125 .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
126 .... D:$Y>(IOSL-4) HEAD
127 .... Q:DGQ
128 .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
129 .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?53,$P(DGSTR,U,4),?63,$E($P(DGSTR,U,5),1,17)
130 . Q:DGQ
131 . I DGCNT D
132 .. D SUB(.DGCNT,1)
133 .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags
134 .. S DGOFG="",DGCNT=0
135 ;
136 ;Shutdown if stop task requested
137 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
138 ;
139 I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
140 . S DGCAT=3,DGFG="All Flags",DGGRAND=1
141 . D HEAD
142 . W !!,"REPORT SUMMARY:",!,"---------------"
143 . F DGCAT=1,2,3 D
144 .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
145 .. W:DGCAT=3 !?39,"-------"
146 .. W !,"Total Assignments for Category "
147 .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
148 .. W ?40,$J(+$G(DGCNT(DGCAT)),6)
149 ;
150 W !!,"<End of Report>"
151 Q
152 ;
153PAUSE(DGQ) ; pause screen display
154 ; Input:
155 ; DGQ - var used to quit report processing to user CRT
156 ; Output:
157 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
158 ;
159 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
160 Q
161 ;
162SUB(CNT,TYP) ; print sub-totals
163 ; Input:
164 ; CNT - count of records printed
165 ; TYP - indicator of which total count is being printed
166 ; Output: Write lines of Sub-Totals and Totals per Flag and Category
167 ;
168 N DGTYPE,DGCOUNT
169 S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
170 S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
171 W:TYP=1 !
172 W !,"Total Assignments for "_DGTYPE_": ",DGCOUNT
173 Q
174 ;
175HEAD ;Print/Display page header
176 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
177 D PAUSE(.DGQ)
178 Q:DGQ
179 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
180 S DGPAGE=$G(DGPAGE)+1
181 W !?25,"PATIENT RECORD FLAGS"
182 W !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$G(DGPAGE)
183 W !?24,"----------------------",?48,"Printed: ",DGDT
184 W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
185 W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
186 W !?1,"FLAG NAME: ",$G(DGFG),!
187 I DGGRAND W DGLINE Q
188 W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
189 W !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------"
190 Q
191 ;
192EXIT ;
193 I $D(ZTQUEUED) S ZTREQ="@"
194 K @DGLIST
195 I '$D(ZTQUEUED) D
196 . K %ZIS,POP
197 . D ^%ZISC,HOME^%ZIS
198 Q
Note: See TracBrowser for help on using the repository browser.