source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFLFD1.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: 6.5 KB
Line 
1DGPFLFD1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL BUILD LIST AREA ; 6/9/04 2:49pm
2 ;;5.3;Registration;**425,554**;Aug 13, 1993
3 ;
4 ;no direct entry
5 QUIT
6 ;
7EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build flag detail list area.
8 ;
9 ; Input:
10 ; DGARY - global array subscript
11 ; DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL
12 ; FLAG file [ex: "1;DGPF(26.15,"]
13 ;
14 ; Output:
15 ; DGCNT - number of lines in the list, pass by reference
16 ;
17 N DGPFF ;flag array
18 N DGPFFH ;flag history array
19 N DGFHIENS ;contains flag history ien's
20 N DGFHIEN ;flag history ien
21 N DGHISCNT ;history record counter
22 N DGLINE ;line counter
23 N DGSUB ;subscript of flag history ien's
24 ;
25 ;quit if required input paramater not passed
26 Q:'$G(DGPFIEN)
27 ;
28 ;init variables
29 S (DGCNT,DGLINE,DGHISCNT)=0
30 K DGPFF
31 ;
32 ;get flag into DGPFF array
33 Q:'$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFF)
34 S DGPFF("PTR")=DGPFIEN
35 ;
36 ;build 'Flag Details' list area
37 D FLAGDET(DGARY,.DGPFF,.DGLINE,.DGCNT)
38 ;
39 ;quit if NATIONAL flag, they don't have a history
40 Q:DGPFF("PTR")'["26.11"
41 ;
42 ;set history heading into list area
43 D HISTHDR(DGARY,.DGLINE,.DGCNT)
44 ;
45 ;get all history ien's associated with the flag
46 K DGFHIENS
47 Q:'$$GETALLDT^DGPFALH(+DGPFF("PTR"),.DGFHIENS)
48 ;
49 ;reverse loop through each flag history ien
50 S DGSUB=9999999.999999
51 F S DGSUB=$O(DGFHIENS(DGSUB),-1) Q:DGSUB="" D
52 . S DGFHIEN=$G(DGFHIENS(DGSUB))
53 . K DGPFFH
54 . ;- for each ien, get flag history into DGPFFH array
55 . I $$GETHIST^DGPFALH(DGFHIEN,.DGPFFH) D
56 . . ;
57 . . ;-- count of history records
58 . . S DGHISCNT=DGHISCNT+1
59 . . ;
60 . . ;-- build flag history details list area
61 . . D HISTDET(DGARY,.DGPFFH,.DGLINE,DGHISCNT,.DGCNT)
62 ;
63 Q
64 ;
65 ;
66FLAGDET(DGARY,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG details in the list area.
67 ;
68 ; Input:
69 ; DGARY - global array subscript
70 ; DGPFF - flag array, pass by reference
71 ; DGLINE - line counter
72 ;
73 ; Output:
74 ; DGCNT - number of lines in the list, pass by reference
75 ;
76 ;temp vars used
77 N DGSUB ;array subscript
78 N DGTEMP ;temp text holder
79 N DGCOUNT ;principal investigator count
80 ;
81 ;set flag name
82 S DGLINE=DGLINE+1
83 D SET^DGPFLF1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFF("FLAG")),U,2),11,,,,,.DGCNT)
84 ;
85 ;set flag category
86 S DGLINE=DGLINE+1
87 S DGTEMP=$S(DGPFF("PTR")["26.11":"II (LOCAL)",DGPFF("PTR")["26.15":"I (NATIONAL)",1:"UNKNOWN")
88 D SET^DGPFLF1(DGARY,DGLINE,"Flag Category: "_DGTEMP,7,,,,,.DGCNT)
89 ;
90 ;set flag type
91 S DGLINE=DGLINE+1
92 D SET^DGPFLF1(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),11,,,,,.DGCNT)
93 ;
94 ;set flag status
95 S DGLINE=DGLINE+1
96 D SET^DGPFLF1(DGARY,DGLINE,"Flag Status: "_$P($G(DGPFF("STAT")),U,2),9,,,,,.DGCNT)
97 ;
98 ;set flag review frequency
99 S DGLINE=DGLINE+1
100 D SET^DGPFLF1(DGARY,DGLINE,"Review Freq Days: "_$P($G(DGPFF("REVFREQ")),U,2),4,,,,,.DGCNT)
101 ;
102 ;set notification days
103 S DGLINE=DGLINE+1
104 D SET^DGPFLF1(DGARY,DGLINE,"Notification Days: "_$P($G(DGPFF("NOTIDAYS")),U,2),3,,,,,.DGCNT)
105 ;
106 ;set flag review mail group
107 S DGLINE=DGLINE+1
108 D SET^DGPFLF1(DGARY,DGLINE,"Review Mail Group: "_$P($G(DGPFF("REVGRP")),U,2),3,,,,,.DGCNT)
109 ;
110 ;set associated progress note title
111 S DGLINE=DGLINE+1
112 D SET^DGPFLF1(DGARY,DGLINE,"Progress Note Title: "_$E($P($G(DGPFF("TIUTITLE")),U,2),1,59),1,,,,,.DGCNT)
113 ;
114 ;set if principal investigator(s)
115 I $D(DGPFF("PRININV")) D
116 . S (DGSUB,DGTEMP)=""
117 . S DGCOUNT=1
118 . F S DGSUB=$O(DGPFF("PRININV",DGSUB)) Q:'DGSUB D
119 . . Q:$G(DGPFF("PRININV",DGSUB,0))="@"
120 . . I DGCOUNT=1 D
121 . . . S DGLINE=DGLINE+1
122 . . . S DGTEMP="Principal"
123 . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
124 . . . S DGLINE=DGLINE+1
125 . . . S DGTEMP="Investigator(s): "_$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
126 . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
127 . . I DGCOUNT>1 D
128 . . . S DGTEMP=$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
129 . . . S DGLINE=DGLINE+1
130 . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,22,,,,,.DGCNT)
131 . . S DGCOUNT=DGCOUNT+1
132 ;
133 ;set flag description
134 S DGLINE=DGLINE+1
135 D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
136 S DGLINE=DGLINE+1
137 D SET^DGPFLF1(DGARY,DGLINE,"Flag Description:",1,IORVON,IORVOFF,,,.DGCNT)
138 S DGLINE=DGLINE+1
139 D SET^DGPFLF1(DGARY,DGLINE,"-----------------",1,,,,,.DGCNT)
140 I '$D(DGPFF("DESC",1,0)) D Q
141 . S DGLINE=DGLINE+1
142 . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
143 S DGSUB=0,DGTEMP=""
144 F S DGSUB=$O(DGPFF("DESC",DGSUB)) Q:'DGSUB D
145 . S DGTEMP=$G(DGPFF("DESC",DGSUB,0))
146 . S DGLINE=DGLINE+1
147 . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
148 ;
149 Q
150 ;
151 ;
152HISTDET(DGARY,DGPFFH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG HISTORY details in the list area.
153 ;
154 ; Input:
155 ; DGARY - global array subscript
156 ; DGPFFH - flag history array, pass by reference
157 ; DGLINE - line counter
158 ; DGHISCNT - history record counter
159 ;
160 ; Output:
161 ; DGCNT - number of lines in the list, pass by reference
162 ;
163 ;temporary variables used
164 N DGTEMP
165 N DGSUB
166 S DGTEMP=""
167 ;
168 ;set blank line
169 S DGLINE=DGLINE+1
170 D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
171 ;
172 ;add an additional blank line except on the first history
173 I DGHISCNT>1 D
174 . S DGLINE=DGLINE+1
175 . D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
176 ;
177 ;set history counter
178 S DGLINE=DGLINE+1
179 S DGTEMP=DGHISCNT_"."
180 D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,IORVON,IORVOFF,,,.DGCNT)
181 ;
182 ;set edit date/time
183 D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit On: "_$$FDTTM^VALM1($P($G(DGPFFH("ENTERDT")),U)),14,IORVON,IORVOFF,,,.DGCNT)
184 ;
185 ;set entered by
186 S DGLINE=DGLINE+1
187 D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit By: "_$P($G(DGPFFH("ENTERBY")),U,2),14,,,,,.DGCNT)
188 ;
189 ;set blank line
190 S DGLINE=DGLINE+1
191 D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
192 ;
193 ;set edit reason text
194 S DGLINE=DGLINE+1
195 D SET^DGPFLF1(DGARY,DGLINE,"Reason For Flag Enter/Edit:",1,,,,,.DGCNT)
196 S DGLINE=DGLINE+1
197 D SET^DGPFLF1(DGARY,DGLINE,"---------------------------",1,,,,,.DGCNT)
198 I $D(DGPFFH("REASON",1,0)) D
199 . S DGSUB=0,DGTEMP=""
200 . F S DGSUB=$O(DGPFFH("REASON",DGSUB)) Q:'DGSUB D
201 .. S DGTEMP=$G(DGPFFH("REASON",DGSUB,0))
202 .. S DGLINE=DGLINE+1
203 .. D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
204 E D
205 . S DGLINE=DGLINE+1
206 . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
207 ;
208 Q
209 ;
210 ;
211HISTHDR(DGARY,DGLINE,DGCNT) ;Set history heading into list area.
212 ;
213 ; Input:
214 ; DGARY - global array subscript
215 ; DGLINE - line counter
216 ;
217 ; Output:
218 ; DGCNT - number of lines in the list, pass by reference
219 ;
220 ;set blank line
221 S DGLINE=DGLINE+1
222 D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
223 ;
224 ;set hist heading
225 S DGLINE=DGLINE+1
226 D SET^DGPFLF1(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,,,.DGCNT)
227 D SET^DGPFLF1(DGARY,DGLINE,"<Flag Enter/Edit History>",28,IORVON,IORVOFF,,,.DGCNT)
228 ;
229 Q
Note: See TracBrowser for help on using the repository browser.