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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1DGPFAA ;ALB/RPM - PRF ASSIGNMENT API'S ; 3/27/03
2 ;;5.3;Registration;**425**;Aug 13, 1993
3 ;
4 Q ;no direct entry
5 ;
6GETALL(DGDFN,DGIENS,DGSTAT,DGCAT) ;retrieve list of assignment IENs
7 ;This function returns an array of patient record flag assignment IENs
8 ;for a given patient. The returned IEN array may optionally be
9 ;filtered by Active or Inactive status and by flag category.
10 ;
11 ; Input:
12 ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
13 ; DGIENS - (required) Result array passed by reference
14 ; DGSTAT - (optional) Status filter (0:Inactive,1:Active,"":Both).
15 ; Defaults to Both.
16 ; DGCAT - (optional) Category filter
17 ; (1:Category I,2:Category II,"":Both). Defaults to Both.
18 ;
19 ; Output:
20 ; Function Value - Count of returned IENs
21 ; DGIENS - Output array subscripted by the assignment IENs
22 ;
23 N DGCNT ;number of returned values
24 N DGIEN ;single IEN
25 N DGCKS ;check status flag (1:check, 0:ignore)
26 N DGFLAG ;pointer to #26.11 or #26.15
27 ;
28 S DGCNT=0
29 I $G(DGDFN)>0,$D(^DGPF(26.13,"B",DGDFN)) D
30 . S DGFLAG=""
31 . S DGCKS=0
32 . S DGSTAT=$G(DGSTAT)
33 . I DGSTAT=0!(DGSTAT=1) S DGCKS=1
34 . S DGCAT=+$G(DGCAT)
35 . S DGCAT=$S(DGCAT=1:"26.15",DGCAT=2:"26.11",1:0)
36 . F S DGFLAG=$O(^DGPF(26.13,"C",DGDFN,DGFLAG)) Q:(DGFLAG="") D
37 . . I DGCAT,DGFLAG'[DGCAT Q
38 . . S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGFLAG,0))
39 . . I DGCKS,'$D(^DGPF(26.13,"D",DGDFN,DGSTAT,DGIEN)) Q
40 . . S DGCNT=DGCNT+1
41 . . S DGIENS(DGIEN)=""
42 Q DGCNT
43 ;
44GETASGN(DGPFIEN,DGPFA) ;retrieve a single assignment record
45 ;This function returns a single patient record flag assignment in an
46 ;array format.
47 ;
48 ; Input:
49 ; DGPFIEN - (required) Pointer to patient record flag assignment in
50 ; PRF ASSIGNMENT (#26.13) file
51 ; DGPFA - (required) Result array passed by reference
52 ;
53 ; Output:
54 ; Function Value - Returns 1 on success, 0 on failure
55 ; DGPFA - Output array containing assignment record field
56 ; values.
57 ; Subscript Field# Data
58 ; -------------- ------- ---------------------
59 ; "DFN" .01 internal^external
60 ; "FLAG" .02 internal^external
61 ; "STATUS" .03 internal^external
62 ; "OWNER" .04 internal^external
63 ; "ORIGSITE" .05 internal^external
64 ; "REVIEWDT" .06 internal^external
65 ; "NARR",line#,0 1 character string
66 ;
67 N DGIENS ;IEN string for DIQ
68 N DGFLDS ;results array for DIQ
69 N DGERR ;error arrary for DIQ
70 N DGRSLT
71 ;
72 S DGRSLT=0
73 I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
74 . S DGIENS=DGPFIEN_","
75 . D GETS^DIQ(26.13,DGIENS,"*","IEZ","DGFLDS","DGERR")
76 . Q:$D(DGERR)
77 . S DGRSLT=1
78 . S DGPFA("DFN")=$G(DGFLDS(26.13,DGIENS,.01,"I"))_U_$G(DGFLDS(26.13,DGIENS,.01,"E"))
79 . S DGPFA("FLAG")=$G(DGFLDS(26.13,DGIENS,.02,"I"))_U_$G(DGFLDS(26.13,DGIENS,.02,"E"))
80 . S DGPFA("STATUS")=$G(DGFLDS(26.13,DGIENS,.03,"I"))_U_$G(DGFLDS(26.13,DGIENS,.03,"E"))
81 . S DGPFA("OWNER")=$G(DGFLDS(26.13,DGIENS,.04,"I"))_U_$G(DGFLDS(26.13,DGIENS,.04,"E"))
82 . S DGPFA("ORIGSITE")=$G(DGFLDS(26.13,DGIENS,.05,"I"))_U_$G(DGFLDS(26.13,DGIENS,.05,"E"))
83 . S DGPFA("REVIEWDT")=$G(DGFLDS(26.13,DGIENS,.06,"I"))_U_$G(DGFLDS(26.13,DGIENS,.06,"E"))
84 . ;build assignment narrative word processing array
85 . M DGPFA("NARR")=DGFLDS(26.13,DGIENS,1)
86 . K DGPFA("NARR","E"),DGPFA("NARR","I")
87 Q DGRSLT
88 ;
89FNDASGN(DGPFDFN,DGPFFLG) ;Find Assignment
90 ; This function finds a patient record flag assignment record.
91 ;
92 ; Input:
93 ; DGDFN - Pointer to patient in the PATIENT (#2) file
94 ; DGFLAG - Pointer to flag in either the PRF LOCAL FLAG (#26.11)
95 ; file or the PRF NATIONAL FLAG (#26.15) file
96 ;
97 ; Output:
98 ; Function Value - Returns IEN of existing record on success, 0 on
99 ; failure
100 ;
101 N DGIEN
102 ;
103 I $G(DGPFDFN)>0,($G(DGPFFLG)>0) D
104 . S DGIEN=$O(^DGPF(26.13,"C",DGPFDFN,DGPFFLG,0))
105 Q $S($G(DGIEN)>0:DGIEN,1:0)
106 ;
107STOASGN(DGPFA,DGPFERR) ;store a single PRF ASSIGNMENT (#26.13) file record
108 ;
109 ; Input:
110 ; DGPFA - (required) array of values to be filed (see GETASGN tag
111 ; above for valid array structure)
112 ; DGPFERR - (optional) passed by reference to contain error messages
113 ;
114 ; Output:
115 ; Function Value - Returns IEN of record on success, 0 on failure
116 ; DGPFERR - Undefined on success, error message on failure
117 ;
118 N DGSUB
119 N DGFLD
120 N DGIEN
121 N DGIENS
122 N DGFDA
123 N DGFDAIEN
124 N DGERR
125 F DGSUB="DFN","FLAG","STATUS","OWNER","ORIGSITE" D
126 . S DGFLD(DGSUB)=$P($G(DGPFA(DGSUB)),U,1)
127 ;
128 ;only build DGFLD("REVIEWDT") if "REVIEWDT" is passed
129 I $D(DGPFA("REVIEWDT"))=1 S DGFLD("REVIEWDT")=$P(DGPFA("REVIEWDT"),U,1)
130 ;
131 I $D(DGPFA("NARR")) M DGFLD("NARR")=DGPFA("NARR")
132 I $$VALID^DGPFUT("DGPFAA1",26.13,.DGFLD,.DGPFERR) D
133 . S DGIEN=$$FNDASGN^DGPFAA(DGFLD("DFN"),DGFLD("FLAG"))
134 . I DGIEN S DGIENS=DGIEN_","
135 . E S DGIENS="+1,"
136 . S DGFDA(26.13,DGIENS,.01)=DGFLD("DFN")
137 . S DGFDA(26.13,DGIENS,.02)=DGFLD("FLAG")
138 . S DGFDA(26.13,DGIENS,.03)=DGFLD("STATUS")
139 . S DGFDA(26.13,DGIENS,.04)=DGFLD("OWNER")
140 . S DGFDA(26.13,DGIENS,.05)=DGFLD("ORIGSITE")
141 . ;
142 . ;only touch REVIEW DATE (#.06) field if "REVIEWDT" is passed
143 . I $D(DGFLD("REVIEWDT")) S DGFDA(26.13,DGIENS,.06)=DGFLD("REVIEWDT")
144 . ;
145 . S DGFDA(26.13,DGIENS,1)="DGFLD(""NARR"")"
146 . I DGIEN D
147 . . D FILE^DIE("","DGFDA","DGERR")
148 . . I $D(DGERR) S DGIEN=0
149 . E D
150 . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
151 . . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1))
152 Q $S($G(DGIEN)>0:DGIEN,1:0)
153 ;
154STOALL(DGPFA,DGPFAH,DGPFERR) ;store both the assignment and history record
155 ;This function acts as a wrapper around the $$STOASGN and $$STOHIST
156 ;filer calls.
157 ;
158 ; Input:
159 ; DGPFA - (required) array of assignment values to be filed (see
160 ; $$GETASGN^DGPFAA for valid array structure)
161 ; DGPFAH - (required) array of assignment history values to be filed
162 ; (see $$STOHIST^DGPFAAH for valid array structure)
163 ; DGPFERR - (optional) passed by reference to contain error messages
164 ;
165 ; Output:
166 ; Function Value - Returns circumflex("^") delimited results of
167 ; $$STOASGN^DGPFAA and $$STOHIST^DGPFAAH calls
168 ; DGPFERR - Undefined on success, error message on failure
169 ;
170 N DGOIEN ;existing assignment file IEN used for "roll-back"
171 N DGPFOA ;existing assignment data array used for "roll-back"
172 N DGAIEN ;assignment file IEN
173 N DGAHIEN ;assignment history file IEN
174 N DGDFN ;"DFN" value
175 N DGFLG ;"FLAG" value
176 ;
177 S (DGAIEN,DGAHIEN)=0
178 S DGDFN=$P($G(DGPFA("DFN")),U,1)
179 S DGFLG=$P($G(DGPFA("FLAG")),U,1)
180 S DGOIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
181 D ;drops out of block if can't rollback or assignment filer fails
182 . I DGOIEN,'$$GETASGN^DGPFAA(DGOIEN,.DGPFOA) Q ;can't rollback, so quit
183 . ;
184 . ;store the assignment
185 . S DGAIEN=$$STOASGN^DGPFAA(.DGPFA,.DGPFERR)
186 . I $D(DGPFERR) S DGAIEN=0
187 . Q:'DGAIEN ;assignment filer failed, so quit
188 . ;
189 . ;store the assignment history
190 . S DGPFAH("ASSIGN")=DGAIEN
191 . S DGAHIEN=$$STOHIST^DGPFAAH(.DGPFAH,.DGPFERR)
192 . I $D(DGPFERR) S DGAHIEN=0
193 . I DGAHIEN=0 D ;history filer failed, so rollback the assignment
194 . . I 'DGOIEN,'$D(DGPFOA) S DGPFOA("DFN")="@"
195 . . I $$ROLLBACK^DGPFAA2(DGAIEN,.DGPFOA) S DGAIEN=0
196 Q $S(+$G(DGAHIEN)=0:0,1:DGAIEN_"^"_DGAHIEN)
Note: See TracBrowser for help on using the repository browser.