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

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6NOTIFYDT(DGFLG,DGRDT) ;calculate the notificaton date
7 ;
8 ; Input:
9 ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
10 ; PRF NATIONAL FLAG (#26.15) file
11 ; DGRDT - (required) review date in FM format
12 ;
13 ; Output:
14 ; Function Value - notification date in FM format on success, 0 on
15 ; failure.
16 ;
17 N DGFLGA ;flag file data array
18 N DGNDT ;function value
19 ;
20 S DGNDT=0
21 I $G(DGFLG)]"",+$G(DGRDT)>0 D
22 . ;
23 . ;Retrieve the flag data array
24 . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
25 . ;
26 . ;must have a review frequency
27 . Q:(+$G(DGFLGA("REVFREQ"))=0)
28 . ;
29 . ;determine notification date
30 . S DGFLGA("NOTIDAYS")=$G(DGFLGA("NOTIDAYS"),0)
31 . S DGRDT=+$$FMTH^XLFDT(DGRDT)
32 . S DGNDT=+$$HTFM^XLFDT(DGRDT-DGFLGA("NOTIDAYS"))
33 ;
34 Q DGNDT
35 ;
36GETRDT(DGFLG,DGADT) ;calculate the review date
37 ;
38 ; Input:
39 ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
40 ; PRF NATIONAL FLAG (#26.15) file
41 ; DGADT - (required) assignment date in FM format
42 ;
43 ; Output:
44 ; Function Value - review date in FM format on success, 0 on failure
45 ;
46 N DGFLGA ;flag file data array
47 N DGRDT ;function value
48 ;
49 S DGRDT=0
50 I $G(DGFLG)]"",+$G(DGADT)>0 D
51 . ;
52 . ;Retrieve the flag data array
53 . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
54 . ;
55 . ;must have a review frequency
56 . Q:(+$G(DGFLGA("REVFREQ"))=0)
57 . ;
58 . ;determine review date
59 . S DGADT=+$$FMTH^XLFDT(DGADT)
60 . S DGRDT=+$$HTFM^XLFDT(DGADT+DGFLGA("REVFREQ"))
61 ;
62 Q DGRDT
63 ;
64LOCK(DGAIEN) ;Lock assignment record.
65 ;
66 ; This function is used to prevent another process from editing a
67 ; patient's record flag assignment.
68 ;
69 ; Input:
70 ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
71 ;
72 ; Output:
73 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
74 ;
75 I $G(DGAIEN) L +^DGPF(26.13,DGAIEN):10
76 ;
77 Q $T
78 ;
79UNLOCK(DGAIEN) ;Unlock assignment record.
80 ;
81 ; This procedure is used to release the lock created by $$LOCK.
82 ;
83 ; Input:
84 ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
85 ;
86 ; Output: None
87 ;
88 I $G(DGAIEN) L -^DGPF(26.13,DGAIEN)
89 ;
90 Q
91 ;
92STOHL7(DGPFA,DGPFAH,DGEROOT) ;store a valid assignment from HL7 message
93 ; This function files an assignment if the originating site is
94 ; authorized to update an existing record and if the action is valid for
95 ; the status of an existing record.
96 ;
97 ; Input:
98 ; DGPFA - (required) array of assignment values to be filed (see
99 ; $$GETASGN^DGPFAA for valid array structure)
100 ; DGPFAH - (required) array of assignment history values to be filed
101 ; (see $$STOHIST^DGPFAAH for valid array structure)
102 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
103 ; error dialog returned from BLD^DIALOG. If not passed, error
104 ; dialog is returned in ^TMP("DIERR",$J) global.
105 ;
106 ; Output:
107 ; Function Value - Returns 1 on sucess, 0 on failure
108 ; DGEROOT() - error output array from BLD^DIALOG
109 ;
110 N DGDFN
111 N DGFLG
112 N DGORIG
113 N DGACT
114 N DGMSG
115 N DGRSLT
116 N DIERR ;var returned from BLD^DIALOG
117 ;
118 S DGDFN=+$G(DGPFA("DFN"))
119 S DGFLG=$G(DGPFA("FLAG"))
120 S DGORIG=+$G(DGPFA("SNDFAC"))
121 S DGACT=+$G(DGPFAH("ACTION"))
122 ;
123 S DGRSLT=0
124 ;
125 D ;drops out of block on failure
126 . ;
127 . ;check input params
128 . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
129 . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
130 . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
131 . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
132 . ;
133 . ;new assignment action
134 . I DGACT=1,'$$ADDOK^DGPFAA2(DGDFN,DGFLG,DGEROOT) Q
135 . ;
136 . ;all other actions
137 . I DGACT'=1,'$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) Q
138 . ;
139 . ;file the assignment and history
140 . I '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGMSG)!($D(DGMSG)) D Q
141 . . D BLD^DIALOG(261120,,,DGEROOT,"F")
142 . ;
143 . ;success
144 . S DGRSLT=1
145 ;
146 Q DGRSLT
147 ;
148HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) ;Is site allowed to edit assignment?
149 ; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits
150 ; that originate from PRF HL7 message processing.
151 ;
152 ; Supported DBIA #2171: This DBIA is used to access the KERNEL
153 ; INSTITUTION (#4) file API PARENT^XUAF4.
154 ;
155 ; Input:
156 ; DGDFN - IEN of patient in PATIENT (#2) file
157 ; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15)
158 ; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"]
159 ; DGORIG - IEN of originating site in INSTITUTION (#4) file
160 ; DGACT - Assignment edit action in internal format
161 ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
162 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
163 ; error dialog returned from BLD^DIALOG. If not passed, error
164 ; dialog is returned in ^TMP("DIERR",$J) global.
165 ;
166 ; Output:
167 ; Function value - 1 if authorized, 0 if not authorized
168 ; DGEROOT() - error output array from BLD^DIALOG
169 ;
170 N DGIEN ;pointer to PRF ASSIGNMENT (#26.13) file
171 N DGPFA ;assignment data array
172 N DGFARRY ;flag data array
173 N DGOWNER ;IEN of owner site in INSTITUTION (#4) file
174 N DGRSLT ;function value
175 N DIERR ;var returned from BLD^DIALOG
176 ;
177 ;init error output array if passed
178 S DGEROOT=$G(DGEROOT)
179 I DGEROOT]"" K @DGEROOT
180 ;
181 S DGACT=+$G(DGACT)
182 S DGDFN=+$G(DGDFN)
183 S DGFLG=$G(DGFLG)
184 S DGORIG=+$G(DGORIG)
185 S DGRSLT=0
186 ;
187 D ;drops out of block on failure
188 . ;
189 . ;check input params
190 . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
191 . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
192 . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
193 . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
194 . ;
195 . ;retrieve existing assignment data
196 . S DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
197 . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q
198 . . D BLD^DIALOG(261102,,,DGEROOT,"F")
199 . ;
200 . ;SENDING FACILITY be the OWNER or parent of the OWNER
201 . S DGOWNER=+$G(DGPFA("OWNER"))
202 . I DGORIG'=DGOWNER,DGORIG'=+$$PARENT^DGPFUT1(DGOWNER) D Q
203 . . D BLD^DIALOG(261116,,,DGEROOT,"F")
204 . ;
205 . ;quit if flag STATUS is INACTIVE
206 . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY)
207 . I '+$G(DGFARRY("STAT")) D Q
208 . . D BLD^DIALOG(261113,,,DGEROOT,"F")
209 . ;
210 . ;quit if no TIU PN TITLE IEN is found for the record flag
211 . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
212 . . D BLD^DIALOG(261114,,,DGEROOT,"F")
213 . ;
214 . ;ACTION must be valid for current assignment STATUS
215 . Q:('$$ACTIONOK^DGPFAA2(.DGPFA,DGACT,DGEROOT))
216 . ;
217 . ;success
218 . S DGRSLT=1
219 ;
220 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.