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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 3/22/05
2 ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7ADDOK(DGDFN,DGFLG,DGEROOT) ;This function will be used to determine if a flag may be assigned to a patient.
8 ;
9 ; Input:
10 ; DGDFN - (required) IEN of patient in PATIENT (#2) file
11 ; DGFLG - (required) IEN of patient record flag in PRF NATIONAL
12 ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file
13 ; [ex: "1;DGPF(26.15,"]
14 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for error
15 ; dialog returned from BLD^DIALOG. If not passed, error
16 ; dialog is returned in ^TMP("DIERR",$J) global.
17 ;
18 ; Output:
19 ; Function Value - returns 1 on success, 0 on failure
20 ; DGEROOT() - error output array from BLD^DIALOG
21 ;
22 N DGRSLT ;function result
23 N DGFARRY ;contains flag array
24 K DGFARRY
25 N DIERR ;var returned from BLD^DIALOG
26 ;
27 ;init error output array if passed
28 S DGEROOT=$G(DGEROOT)
29 I DGEROOT]"" K @DGEROOT
30 ;
31 S DGRSLT=0
32 ;
33 D ;drops out of block on failure
34 . ;
35 . ;quit if DFN invalid
36 . I '$G(DGDFN)!'$D(^DPT(+$G(DGDFN),0)) D Q
37 . . D BLD^DIALOG(261110,,,DGEROOT,"F")
38 . ;
39 . ;quit if flag ien invalid
40 . I '$$TESTVAL^DGPFUT(26.13,.02,DGFLG) D Q
41 . . D BLD^DIALOG(261111,,,DGEROOT,"F")
42 . ;
43 . ;quit if flag already assigned to patient
44 . I $$FNDASGN^DGPFAA(DGDFN,DGFLG) D Q
45 . . D BLD^DIALOG(261112,,,DGEROOT,"F")
46 . ;
47 . ;quit if flag STATUS is INACTIVE
48 . I $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY),('+$G(DGFARRY("STAT"))) D Q
49 . . D BLD^DIALOG(261113,,,DGEROOT,"F")
50 . ;
51 . ;quit if no TIU PN TITLE IEN is found for the record flag
52 . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
53 . . D BLD^DIALOG(261114,,,DGEROOT,"F")
54 . ;
55 . ;success
56 . S DGRSLT=1
57 ;
58 Q DGRSLT
59 ;
60EDTOK(DGPFA,DGORIG,DGEROOT) ;This function will be used to determine if a flag assignment may be edited.
61 ;
62 ; Input:
63 ; DGPFA - (required) array containing the flag assignment values
64 ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
65 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
66 ; error dialog returned from BLD^DIALOG. If not passed,
67 ; error dialog is returned in ^TMP("DIERR",$J) global.
68 ;
69 ; Output:
70 ; Function Value - returns 1 on success, 0 on failure
71 ; DGEROOT() - error output array from BLD^DIALOG
72 ;
73 N DGRSLT ;function result
74 N DGFARRY ;contains flag array
75 K DGFARRY
76 N DIERR ;var returned from BLD^DIALOG
77 ;
78 ;init error output array if passed
79 S DGEROOT=$G(DGEROOT)
80 I DGEROOT]"" K @DGEROOT
81 ;
82 S DGRSLT=0
83 ;
84 D ;drops out of block on failure
85 . ;
86 . ;quit if current site is not the owner site
87 . I +$G(DGORIG)'>0 S DGORIG=+$$SITE^VASITE()
88 . I +$G(DGPFA("OWNER"))'=DGORIG D Q
89 . . D BLD^DIALOG(261115,,,DGEROOT,"F")
90 . ;
91 . ;quit if flag STATUS is INACTIVE
92 . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY)
93 . I '+$G(DGFARRY("STAT")) D Q
94 . . D BLD^DIALOG(261113,,,DGEROOT,"F")
95 . ;
96 . ;quit if no TIU PN TITLE is found for the record flag
97 . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
98 . . D BLD^DIALOG(261114,,,DGEROOT,"F")
99 . ;
100 . ;success
101 . S DGRSLT=1
102 ;
103 Q DGRSLT
104 ;
105ACTIONOK(DGPFA,DGACT,DGEROOT) ;This function will be used to verify that an assignment edit ACTION is appropriate for the current assignment STATUS.
106 ;
107 ; Input:
108 ; DGPFA - (required) assignment array data from current record
109 ; DGACT - Assignment edit action in internal format
110 ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
111 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
112 ; error dialog returned from BLD^DIALOG. If not passed, error
113 ; dialog is returned in ^TMP("DIERR",$J) global.
114 ;
115 ; Output:
116 ; Function Value - returns 1 on success, 0 on failure
117 ; DGEROOT() - error output array from BLD^DIALOG
118 ;
119 N DGRSLT ;function result
120 N DGSTAT ;current assignment status
121 N DIERR ;var returned from BLD^DIALOG
122 ;
123 ;init error output array if passed
124 S DGEROOT=$G(DGEROOT)
125 I DGEROOT]"" K @DGEROOT
126 ;
127 S DGACT=+$G(DGACT)
128 S DGSTAT=$P($G(DGPFA("STATUS")),U,1)
129 S DGRSLT=0
130 ;
131 D ;drops out of block on failure
132 . ;
133 . ;is ACTION valid?
134 . I '$$TESTVAL^DGPFUT(26.14,.03,DGACT),'DGSTAT?1N D Q
135 . . D BLD^DIALOG(261118,,,DGEROOT,"F")
136 . ;
137 . ;must not CONTINUE inactive assignments
138 . I DGACT=2,DGSTAT=0 D Q
139 . . D BLD^DIALOG(261121,,,DGEROOT,"F")
140 . ;
141 . ;must not INACTIVATE inactive assignments
142 . I DGACT=3,DGSTAT=0 D Q
143 . . D BLD^DIALOG(261122,,,DGEROOT,"F")
144 . ;
145 . ;must not ENTERED IN ERROR inactive assignments
146 . I DGACT=5,DGSTAT=0 D Q
147 . . D BLD^DIALOG(261123,,,DGEROOT,"F")
148 . ;
149 . ;must not REACTIVATE active assignments
150 . I DGACT=4,DGSTAT=1 D Q
151 . . D BLD^DIALOG(261124,,,DGEROOT,"F")
152 . ;
153 . ;success
154 . S DGRSLT=1
155 ;
156 Q DGRSLT
157 ;
158CHGOWN(DGPFA,DGORIG,DGEROOT) ;This function is used to determine if a site is allowed to change ownership of a record flag assignment?
159 ;
160 ; Input:
161 ; DGPFA - (required) array containing the flag assignment values
162 ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
163 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
164 ; error dialog returned from BLD^DIALOG. If not passed,
165 ; error dialog is returned in ^TMP("DIERR",$J) global.
166 ;
167 ; Output:
168 ; Function Value - returns 1 on success, 0 on failure
169 ; DGEROOT() - error output array from BLD^DIALOG
170 ;
171 N DGRSLT ;function result
172 N DIERR ;var returned from BLD^DIALOG
173 ;
174 ;init error output array if passed
175 S DGEROOT=$G(DGEROOT)
176 I DGEROOT]"" K @DGEROOT
177 ;
178 S:(+$G(DGORIG)'>0) DGORIG=(+$$SITE^VASITE())
179 S DGRSLT=0
180 ;
181 D ;drops out of block on failure
182 . ;
183 . ;ORIGINATING SITE must be OWNER and flag must be ACTIVE
184 . Q:('$$EDTOK(.DGPFA,DGORIG,.DGEROOT))
185 . ;
186 . ;can't CHANGE OWNERSHIP for an INACTIVE assignment
187 . I '+$G(DGPFA("STATUS")) D Q
188 . . D BLD^DIALOG(261117,,,DGEROOT,"F")
189 . ;
190 . ;success
191 . S DGRSLT=1
192 ;
193 Q DGRSLT
194 ;
195ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record
196 ;
197 ; Input:
198 ; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT
199 ; (#26.13) file
200 ; DGPFOA - Assignment data array prior to record modification
201 ;
202 ; Output:
203 ; Function value - 1 on successful rollback, 0 on failure
204 ;
205 N DGIENS
206 N DGFDA
207 N DGEROOT
208 N DGRSLT ;function result
209 ;
210 S DGRSLT=0
211 I +$G(DGAIEN),$D(^DGPF(26.13,DGAIEN)),$D(DGPFOA) D
212 . S DGIENS=DGAIEN_","
213 . I $G(DGPFOA("DFN"))="@" D
214 . . S DGFDA(26.13,DGIENS,.01)=DGPFOA("DFN")
215 . . D FILE^DIE("","DGFDA","DGEROOT")
216 . . I '$D(DGEROOT) S DGRSLT=1
217 . E D
218 . . I $$STOASGN^DGPFAA(.DGPFOA,.DGEROOT),'$D(DGEROOT) S DGRSLT=1
219 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.