source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFAAH.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: 7.0 KB
Line 
1DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/8/04 4:13pm
2 ;;5.3;Registration;**425,554**;Aug 13, 1993
3 Q ;no direct entry
4 ;
5GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
6 ;
7 ; Input:
8 ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
9 ; DGPFIENS - (required) Result array passed by reference
10 ;
11 ; Output:
12 ; Function Value - Count of returned IENs
13 ; DGPFIENS - Output array subscripted by assignment history IENs
14 ;
15 N DGCNT ;number of returned values
16 N DGHIEN ;single history IEN
17 ;
18 S DGCNT=0
19 I $G(DGPFIEN)>0,$D(^DGPF(26.14,"B",DGPFIEN)) D
20 . S DGHIEN=0
21 . F S DGHIEN=$O(^DGPF(26.14,"B",DGPFIEN,DGHIEN)) Q:'DGHIEN D
22 . . S DGPFIENS(DGHIEN)=""
23 . . S DGCNT=DGCNT+1
24 Q DGCNT
25 ;
26GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
27 ;
28 ; Input:
29 ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
30 ; DGPFIENS - (required) Result array passed by reference
31 ;
32 ; Output:
33 ; Function Value - Count of returned IENs
34 ; DGPFIENS - Output array subscripted by assignment history date
35 ;
36 N DGADT ;assignment date
37 N DGCNT ;number of returned values
38 N DGHIEN ;single history IEN
39 ;
40 S DGCNT=0
41 I $G(DGPFIEN)>0,$D(^DGPF(26.14,"C",DGPFIEN)) D
42 . S DGADT=0
43 . F S DGADT=$O(^DGPF(26.14,"C",DGPFIEN,DGADT)) Q:'DGADT D
44 . . S DGHIEN=0
45 . . F S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGADT,DGHIEN)) Q:'DGHIEN D
46 . . . S DGPFIENS(DGADT)=DGHIEN
47 . . . S DGCNT=DGCNT+1
48 Q DGCNT
49 ;
50GETHIST(DGPFIEN,DGPFAH) ;retrieve a single assignment history record
51 ;
52 ; Input:
53 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT HISTORY
54 ; (#26.14) file
55 ; DGPFAH - (required) Result array passed by reference
56 ;
57 ; Output:
58 ; Function Value - Return 1 on success, 0 on failure
59 ; DGPFAH - Output array containing the field values
60 ; Subscript Field#
61 ; ----------------- ------
62 ; "ASSIGN" .01
63 ; "ASSIGNDT" .02
64 ; "ACTION" .03
65 ; "ENTERBY" .04
66 ; "APPRVBY" .05
67 ; "TIULINK" .06
68 ; "COMMENT",line#,0 1
69 ;
70 N DGIENS ;IEN string for DIQ
71 N DGFLDS ;results array for DIQ
72 N DGERR ;error array for DIQ
73 N DGRSLT
74 S DGRSLT=0
75 I $G(DGPFIEN)>0,$D(^DGPF(26.14,DGPFIEN)) D
76 . S DGIENS=DGPFIEN_","
77 . D GETS^DIQ(26.14,DGIENS,"*","IEZ","DGFLDS","DGERR")
78 . Q:$D(DGERR)
79 . S DGRSLT=1
80 . S DGPFAH("ASSIGN")=$G(DGFLDS(26.14,DGIENS,.01,"I"))_U_$G(DGFLDS(26.14,DGIENS,.01,"E"))
81 . S DGPFAH("ASSIGNDT")=$G(DGFLDS(26.14,DGIENS,.02,"I"))_U_$G(DGFLDS(26.14,DGIENS,.02,"E"))
82 . S DGPFAH("ACTION")=$G(DGFLDS(26.14,DGIENS,.03,"I"))_U_$G(DGFLDS(26.14,DGIENS,.03,"E"))
83 . S DGPFAH("ENTERBY")=$G(DGFLDS(26.14,DGIENS,.04,"I"))_U_$G(DGFLDS(26.14,DGIENS,.04,"E"))
84 . S DGPFAH("APPRVBY")=$G(DGFLDS(26.14,DGIENS,.05,"I"))_U_$G(DGFLDS(26.14,DGIENS,.05,"E"))
85 . S DGPFAH("TIULINK")=$G(DGFLDS(26.14,DGIENS,.06,"I"))_U_$G(DGFLDS(26.14,DGIENS,.06,"E"))
86 . ;build review comments word processing array
87 . M DGPFAH("COMMENT")=DGFLDS(26.14,DGIENS,1)
88 . K DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
89 . ;
90 Q DGRSLT
91 ;
92GETFIRST(DGPFIEN) ;get IEN of the initial assignment
93 ;This function returns the IEN of the initial history record for a
94 ;given patient record flag assignment.
95 ;
96 ; Input:
97 ; DGPFIEN - (required) IEN of record in PRF ASSIGNMENT (#26.13) file
98 ;
99 ; Output:
100 ; Function Value - IEN of initial history record on success
101 ; 0 on failure
102 ;
103 N DGHIEN ;history IEN
104 N DGEDT ;edit date
105 N DGPFAH ;history record data array
106 ;
107 S DGHIEN=0
108 I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
109 . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
110 . I DGEDT>0 D
111 . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
112 Q $S($G(DGHIEN)>0:DGHIEN,1:0)
113 ;
114GETLAST(DGPFIEN) ;determine IEN of last assignment history record
115 ;This function returns the IEN of the most recent history record for a
116 ;given patient record flag assignment.
117 ;
118 ; Input:
119 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
120 ;
121 ; Output:
122 ; Function Value - IEN of last history record on success, 0 on failure
123 ;
124 N DGDAT
125 N DGHIEN
126 S DGHIEN=0
127 I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
128 . S DGDAT=$O(^DGPF(26.14,"C",DGPFIEN,""),-1)
129 . I DGDAT>0 D
130 . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGDAT,0))
131 Q $S($G(DGHIEN)>0:DGHIEN,1:0)
132 ;
133GETADT(DGPFIEN) ;get the initial assignment date
134 ;This function returns the initial assignment date for a given patient
135 ;record flag assignment.
136 ;
137 ; Input:
138 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
139 ;
140 ; Output:
141 ; Function Value - assignment date in internal^external format on
142 ; success, 0 on failure
143 ;
144 N DGHIEN ;history IEN
145 N DGEDT ;edit date
146 N DGADT ;assignment date
147 N DGPFAH ;history record data array
148 ;
149 S DGADT=0
150 S DGHIEN=0
151 I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
152 . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
153 . I DGEDT>0 D
154 . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
155 . . I DGHIEN>0,$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D
156 . . . I $P($G(DGPFAH("ACTION")),U,2)="NEW ASSIGNMENT" D
157 . . . . S DGADT=$G(DGPFAH("ASSIGNDT"))
158 Q DGADT
159 ;
160FNDHIST(DGAIEN,DGADT) ;Find Assignment
161 ; This function finds a patient record flag assignment record.
162 ;
163 ; Input:
164 ; DGAIEN - Pointer to assignment in the PRF ASSIGNMENT (#26.13) file
165 ; DGADT - Assignment date
166 ;
167 ; Output:
168 ; Function Value - Returns IEN of existing record on success, 0 on
169 ; failure
170 ;
171 N DGIEN
172 ;
173 I $G(DGAIEN)>0,($G(DGADT)>0) D
174 . S DGIEN=$O(^DGPF(26.14,"C",DGAIEN,DGADT,0))
175 Q $S($G(DGIEN)>0:DGIEN,1:0)
176 ;
177STOHIST(DGPFAH,DGPFERR) ;file a PRF ASSIGNMENT HISTORY (#26.14) file record
178 ;
179 ; Input:
180 ; DGPFAH - (required) Array of values to be filed (see GETHIST tag
181 ; above for valid array structure)
182 ; DGPFERR - (optional) Passed by reference to contain error messages
183 ;
184 ; Output:
185 ; Function Value - Returns IEN of record on success, 0 on failure
186 ; DGPFERR - Undefined on success, error message on failure
187 ;
188 N DGSUB
189 N DGFLD
190 N DGIEN
191 N DGIENS
192 N DGFDA
193 N DGFDAIEN
194 N DGERR
195 F DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK" D
196 . S DGFLD(DGSUB)=$P($G(DGPFAH(DGSUB)),U)
197 I $D(DGPFAH("COMMENT")) M DGFLD("COMMENT")=DGPFAH("COMMENT")
198 I $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR) D
199 . S DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT"))
200 . I DGIEN S DGIENS=DGIEN_","
201 . E S DGIENS="+1,"
202 . S DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN")
203 . S DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT")
204 . S DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION")
205 . S DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY")
206 . S DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY")
207 . S DGFDA(26.14,DGIENS,.06)=DGFLD("TIULINK")
208 . S DGFDA(26.14,DGIENS,1)="DGFLD(""COMMENT"")"
209 . I DGIEN D
210 . . D FILE^DIE("","DGFDA","DGERR")
211 . . I $D(DGERR) S DGIEN=0
212 . E D
213 . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
214 . . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1))
215 Q $S($G(DGIEN)>0:DGIEN,1:0)
Note: See TracBrowser for help on using the repository browser.