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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1DGPFDD ;ALB/RPM - PRF DATA DICTIONARY UTILITIES ; 9/06/06 1:14pm
2 ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3
3 ;
4 Q ;No direct entry
5 ;
6INACT(DGIEN,DGSTAT,DGFILE,DGUSER) ;Inactivate flag trigger
7 ; This procedure is used as a trigger that is fired when the
8 ; STATUS (#.02) field of a record in either the PRF LOCAL FLAG (#26.11)
9 ; file or PRF NATIONAL FLAG (#26.15) file is changed from Active to
10 ; Inactive. The trigger will inactivate all Patient Record
11 ; Flag assignments associated with the inactivated Flag.
12 ;
13 ; Input:
14 ; DGIEN - IEN of entry in PRF LOCAL FLAG file or PRF NATIONAL
15 ; FLAG file
16 ; DGSTAT - Flag Status
17 ; DGFILE - PRF LOCAL FLAG file number (26.11) or PRF NATIONAL
18 ; FLAG file number (26.15)
19 ; DGUSER - IEN of user in NEW PERSON file
20 ;
21 ; Output: none
22 ;
23 N DGAIEN ;assignment record IEN
24 N DGSUB ;variable ptr index subscript
25 ;
26 Q:('$G(DGIEN))
27 Q:($G(DGSTAT)'=0)
28 Q:(($G(DGFILE)'=26.11)&($G(DGFILE)'=26.15))
29 Q:('$G(DGUSER))
30 ;
31 S DGSUB=DGIEN_";DGPF("_DGFILE_","
32 S DGAIEN=0
33 F S DGAIEN=$O(^DGPF(26.13,"ASTAT",1,DGSUB,DGAIEN)) Q:'DGAIEN D
34 . N DGPFA ;assignment data array
35 . N DGPFAH ;assignment history data array
36 . I $$GETASGN^DGPFAA(DGAIEN,.DGPFA) D
37 . . Q:($P($G(DGPFA("STATUS")),U,1)=0)
38 . . S DGPFA("STATUS")=0
39 . . S DGPFA("REVIEWDT")=""
40 . . S DGPFAH("ACTION")=3
41 . . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()
42 . . S DGPFAH("ENTERBY")=DGUSER
43 . . S DGPFAH("APPRVBY")=DGUSER
44 . . S DGPFAH("COMMENT",1,0)="Assignment Inactivated automatically due to Flag Inactivation."
45 . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH)
46 Q
47 ;
48PIHELP ;Executable help for PRINCIPAL INVESTIGATOR(S) (#.01) sub-field of
49 ;PRINCIPLE INVESTIGATOR(S) (#2) multiple field of PRF LOCAL FLAG
50 ;(#26.11) file.
51 ;
52 ;This sub-routine displays individuals selected as a principal
53 ;investigator for a research type patient record flag.
54 ;
55 ; Input:
56 ; DGLKUP - (required) array of principal investigators subscripted
57 ; by the pointer to the NEW PERSON (#200) file and the
58 ; pointer to the PRF LOCAL FLAG (#26.11) file.
59 ; Example: DGLKUP(11744,6)=""
60 ;
61 ; Output:
62 ; none
63 ;
64 Q:'$D(DGLKUP)
65 ;
66 N DGCNT
67 N DGIEN
68 N DGNAMES
69 ;
70 S DGIEN=0,DGCNT=0
71 F S DGIEN=$O(DGLKUP(DGIEN)) Q:'DGIEN D
72 . S DGCNT=DGCNT+1
73 . S DGNAMES(DGCNT)=$$EXTERNAL^DILFD(26.112,.01,"F",DGIEN)
74 S DGNAMES(DGCNT+1)="" ;add a blank line
75 D EN^DDIOL(.DGNAMES)
76 Q
77 ;
78COS(DGAPRV) ;transform POSTMASTER to CHIEF OF STAFF
79 ;This output transform converts the internal field value of .5
80 ;(POSTMASTER) to CHIEF OF STAFF.
81 ;
82 ; Supported DBIA #10060 - This supported DBIA permits FileMan reads
83 ; on all fields of the NEW PERSON (#200) file.
84 ;
85 ; Input:
86 ; DGAPRV - internal value of PRF ASSIGNMENT HISTORY (#26.14) file
87 ; APPROVED BY (#.05) field
88 ;
89 ; Output:
90 ; Function Value - Returns "CHIEF OF STAFF" when input value is .5 or
91 ; external value from NAME (.01) field of the NEW
92 ; PERSON (#200) file on success.
93 ; Returns null ("") on failure.
94 ;
95 N DGERR
96 ;
97 Q:(+$G(DGAPRV)'>0) ""
98 ;
99 Q $S(DGAPRV=.5:"CHIEF OF STAFF",1:$$GET1^DIQ(200,DGAPRV_",",.01,"","","DGERR"))
100 ;
101TIULIST(DGTIUIEN) ;DD lookup screen for (#26.11) file (#.07) field
102 ;Get list of TIU Progress Note Titles for Category II (Local) Flags.
103 ;This function will assist the DIC("S") lookup screen of allowable
104 ;TIU Progress Note Titles the user can see and select from.
105 ;
106 ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF
107 ; #4383 - $$FNDTITLE^DGPFAPI1
108 ;
109 ; Input:
110 ; DGTIUIEN - [Required] IEN of (#8925.1) entry being screened
111 ;
112 ; Output:
113 ; Function Value - Returns 1 on success, 0 on failure
114 ;
115 N DGPNLIST ;temporary file name to hold list of titles
116 N DGRSLT ;function return value
117 N DGX ;loop var
118 N DGY ;loop var
119 ;
120 Q:DGTIUIEN']"" 0
121 ;
122 S DGRSLT=0
123 ;
124 ; get list from TIU Progress Note Title API call IA #4380
125 S DGPNLIST=$NA(^TMP("DGPNLIST",$J))
126 K @DGPNLIST
127 ;
128 ; only get Category II (Local) TIU PN Titles (pass a 2)
129 I $$GETLIST(2,DGPNLIST) D
130 . S (DGX,DGY)="" F S DGX=$O(@DGPNLIST@("CAT II",DGX)) Q:DGX="" D
131 . . S DGY=$G(@DGPNLIST@("CAT II",DGX))
132 . . ; Need to setup the current assigned progress note title as a
133 . . ; selectable entry or the ^DIR call won't accept the default
134 . . ; entry when the user hits the retrun key to go to next prompt.
135 . . ; Only setup if called by PRF action protocol DGPF EDIT FLAG
136 . . I $P($G(XQORNOD(0)),U,3)="Edit Record Flag",+DGY=$P($G(DGPFORIG("TIUTITLE")),U) D Q
137 . . . S @DGPNLIST@(+DGY)=""
138 . . Q:'DGY
139 . . I '$$FNDTITLE^DGPFAPI1($P(DGY,U,1)) S @DGPNLIST@(+DGY)=""
140 ;
141 I $D(@DGPNLIST@(DGTIUIEN)) S DGRSLT=1
142 K @DGPNLIST
143 ;
144 Q DGRSLT
145 ;
146GETLIST(DGCAT,DGLIST) ;Get list of TIU Progress Note Titles
147 ; This function is used to retrieve a list of active TIU Progress
148 ; Note Titles that can be associated with Category I or Category II
149 ; Record Flags.
150 ;
151 ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF
152 ;
153 ; Input: [Required]
154 ; DGCAT - Category of TIU Progress Note Titles to look for
155 ; 1:Category I
156 ; 2:Category II
157 ; 3:Both Category I and II
158 ; DGLIST - Closed root reference array name to return values
159 ;
160 ; Output:
161 ; Function Value - returns 1 on success, 0 on failure
162 ; DGLIST() - Closed Root reference name of returned data
163 ;
164 N DGRSLT ;function value
165 S DGRSLT=0
166 ;
167 I $G(DGCAT)>0,DGLIST]"",$$GETLIST^TIUPRF(DGCAT,DGLIST) S DGRSLT=1
168 ;
169 Q DGRSLT
170 ;
171EVENT(DGDFN) ;PRF HL7 EVENT trigger
172 ;This trigger creates an entry in the PRF HL7 EVENT (#26.21) file
173 ;with an INCOMPLETE status.
174 ;
175 ; Input:
176 ; DGDFN - pointer to patient in PATIENT (#2) file
177 ;
178 ; Output: none
179 ;
180 N DGASGN
181 ;
182 ;validate input parameter
183 Q:'$G(DGDFN)!('$D(^DPT(+$G(DGDFN),0)))
184 ;
185 ;don't record event when file re-indexing
186 I $D(DIU(0))!($D(DIK)&$D(DIKJ)&$D(DIKLK)&$D(DIKS)&$D(DIN)) Q
187 ;
188 ;ICN must be national value
189 Q:'$$MPIOK^DGPFUT(DGDFN)
190 ;
191 ;limit to one event per patient
192 Q:$$FNDEVNT^DGPFHLL1(DGDFN)
193 ;
194 ;don't trigger when Category I PRF assignments exist
195 Q:$$GETALL^DGPFAA(DGDFN,.DGASGN,"",1)
196 ;
197 ;record event
198 D STOEVNT^DGPFHLL1(DGDFN)
199 ;
200 Q
201 ;
202SCRNSEL(DGIEN,DGSEL) ;screen user selection
203 ;This function checks that the selected action does not equal the
204 ;current field value.
205 ;
206 ; Input:
207 ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file (IEN)
208 ;
209 ; DGSEL - (required) user selected action [1=enable, 0=disable]
210 ;
211 ; Output:
212 ; Function value - returns 1 on success, 0 on failure
213 ;
214 N DGERR ;error root
215 N DGFLD ;field value
216 N DGRSLT ;function result
217 ;
218 S DGRSLT=0
219 ;
220 I +$G(DGIEN)>0,($G(DGSEL)]"") D
221 . ;
222 . S DGFLD=+$$GET1^DIQ(40.8,DGIEN_",",26.01,"I","","DGERR")
223 . Q:$D(DGERR)
224 . Q:(DGFLD=DGSEL)
225 . ;
226 . S DGRSLT=1
227 ;
228 Q DGRSLT
229 ;
230SCRNDIV(DGIEN,DGSEL) ;division screen
231 ;This function contains the screen logic for enabling/disabling a
232 ;medical center division.
233 ;
234 ;The function (screen) is called from the following locations:
235 ; Function: $$ASKDIV^DGPFDIV
236 ; DD: Screen code for PRF ASSIGNMENT OWNERSHIP (#26.01) field
237 ; of the MEDICAL CENTER DIVISION (#40.8) file
238 ;
239 ;Entries will be screened if:
240 ; - division is enabled and active assignments are associated with
241 ; the division
242 ; - division is not associated with an active institution
243 ; - division does not have a PARENT association in the
244 ; INSTITUTION (#4) file
245 ;
246 ; Input:
247 ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file entry (IEN)
248 ; being screened
249 ; DGSEL - (required) user selected action [1=enable, 0=disable]
250 ;
251 ; Output:
252 ; Function value - returns 1 on success, 0 on failure
253 ;
254 N DGINST ;ptr to INSTITUTION file
255 N DGRSLT ;function result
256 ;
257 S DGRSLT=0
258 ;
259 I +$G(DGIEN)>0,($G(DGSEL)]"") D
260 . ;
261 . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7)
262 . I DGSEL=0,($D(^DGPF(26.13,"AOWN",DGINST,1))) Q
263 . I DGSEL=1,'$$ACTIVE^XUAF4(DGINST) Q
264 . I DGSEL=1,'$$PARENT^DGPFUT1(DGINST) Q
265 . ;
266 . S DGRSLT=1
267 ;
268 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.