source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFUT1.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: 6.3 KB
Line 
1DGPFUT1 ;ALB/RBS - PRF UTILITIES CONTINUED ; 6/9/06 10:56am
2 ;;5.3;Registration;**425,607,650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6DISPACT(DGPFAPI) ;Display all ACTIVE Patient Record Flag's for a patient
7 ; Input: DGPFAPI() = Array of patients active flags
8 ; (passed by reference)
9 ; See $$GETACT^DGPFAPI for array format.
10 ; Output: None
11 ;
12 I '$G(DGPFAPI) Q ;no flags
13 ;
14 N DGPF,DGPFIEN,DGPFFLAG,DGPFCAT,IORVON,IORVOFF
15 N DGCNT ;flag display count
16 N DGRET ;return
17 ;
18 I $D(DDS) D CLRMSG^DDS
19 W:'$D(DDS) !! W ">>> Active Patient Record Flag(s):"
20 ;
21 ; setup for reverse video display
22 ;
23 S (IORVON,IORVOFF)=""
24 D:$D(IOST(0))
25 . N X S X="IORVON;IORVOFF" D ENDR^%ZISS
26 ;
27 ; loop all returned Active Record Flag Assignment ien's
28 S DGCNT=0
29 S DGPFIEN="" F S DGPFIEN=$O(DGPFAPI(DGPFIEN)) Q:DGPFIEN="" D
30 . I $D(DDS),DGCNT=4 D
31 . . W !,"Press RETURN to continue..."
32 . . R DGRET:$S('$D(DTIME):300,1:DTIME)
33 . . D CLRMSG^DDS
34 . . W ">>> Active Patient Record Flag(s):"
35 . . S DGCNT=0
36 . S DGPFFLAG=$P($G(DGPFAPI(DGPFIEN,"FLAG")),U,2)
37 . Q:(DGPFFLAG'["")
38 . S DGPFCAT=$P($P($G(DGPFAPI(DGPFIEN,"CATEGORY")),U,2)," ")
39 . W !?5,IORVON,"<"_DGPFFLAG_">",IORVOFF,?45,"CATEGORY ",DGPFCAT
40 . S DGCNT=DGCNT+1
41 W:'$D(DDS) !
42 Q
43 ;
44ASKDET() ;does user want to display flag details?
45 ;
46 ; Input:
47 ; None
48 ;
49 ; Output:
50 ; Function value - return 1 on YES; otherwise 0
51 ;
52 N YN,%,%Y
53 F D Q:"^YN"[YN
54 . W !,"Do you wish to view active patient record flag details"
55 . S %=1 ;default to YES
56 . D YN^DICN
57 . S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
58 . I YN="?" D:$D(DDS) CLRMSG^DDS W !,"Enter either 'Y' or 'N'."
59 Q (YN="Y")
60 ;
61DISPPRF(DGDFN) ; Patient Record Flags screen Display
62 ;
63 ; Supported References:
64 ; DBIA #10096 Z OPERATING SYSTEM FILE (%ZOSF)
65 ; DBIA #10150 ScreenMan API: Form Utilities
66 ;
67 ; Input:
68 ; DGDFN - pointer to patient in PATIENT (#2) file
69 ;
70 ; Output:
71 ; none
72 ;
73 ; patient ien not setup
74 S DGDFN=+$G(DGDFN)
75 Q:'DGDFN
76 ;
77 N DGPFAPI
78 ;
79 ; call API to get the display array for ALL Active Assignments
80 S DGPFAPI=$$GETACT^DGPFAPI(DGDFN,"DGPFAPI") ;DBIA #3860
81 ;
82 ; quit if no Active Record Flags to display
83 Q:'+DGPFAPI
84 ;
85 ; call api to display Active Record Flags
86 D DISPACT(.DGPFAPI)
87 ;
88 ; prompt and display assignment details
89 I $$ASKDET() D EN^DGPFLMD(DGDFN,.DGPFAPI) ;ListMan
90 ;
91 ; cleanup display for ScreenMan
92 I $D(DDS) D D CLRMSG^DDS D REFRESH^DDSUTL
93 . ;set right margin to zero - needed for Cache
94 . N X
95 . S X=0 X ^%ZOSF("RM")
96 Q
97 ;
98SELPAT(DGPAT) ;This procedure is used to perform a patient lookup for an existing patient in the PATIENT (#2) file.
99 ;
100 ; Input: None
101 ;
102 ; Output:
103 ; DGPAT - result array containing the patient selection on success,
104 ; pass by reference. Array will have same structure as the Y
105 ; variable returned by the ^DIC call.
106 ; Array Format:
107 ; -------------
108 ; DGPAT = IEN of patient in PATIENT (#2) file on
109 ; success, -1 on failure
110 ; DGPAT(0) = zero node of entry selected
111 ; DGPAT(0,0) = external form of the .01 field of the entry
112 ;
113 ;- int input vars for ^DIC call
114 N DIC,DTOUT,DUPOT,X,Y
115 S DIC="^DPT(",DIC(0)="AEMQZV"
116 ;
117 ;- lookup patient
118 D ^DIC K DIC
119 ;
120 ;- result of lookup
121 S DGPAT=Y
122 ;
123 ;- if success, setup return array using output vars from ^DIC call
124 I (+DGPAT>0) D
125 . S DGPAT=+Y ;patient ien
126 . S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#2) file
127 . S DGPAT(0,0)=$G(Y(0,0)) ;external form of the .01 field
128 ;
129 Q
130 ;
131GETFLAG(DGPFPTR,DGPFLAG) ;retrieve a single FLAG record
132 ; This function acts as a wrapper around the $$GETLF and $$GETNF
133 ; API's. Function will be used to obtain a single flag record from
134 ; either the PRF LOCAL FLAG (#26.11) file or the PRF NATIONAL FLAG
135 ; (#26.15) file depending on the value of the DGPFPTR input parameter.
136 ;
137 ; Input:
138 ; DGPFPTR - (required) IEN of patient record flag in PRF NATIONAL
139 ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file.
140 ; [ex: "1;DGPF(26.15,"]
141 ;
142 ; Output:
143 ; Function Value - returns 1 on success, 0 on failure
144 ; DGPFLAG - (required) result array passed by reference. See the
145 ; $$GETLF and $$GETNF for the result array structure.
146 ;
147 N RESULT ;returned function value
148 N DGPFIEN ;ien of PRF local or national flag file
149 N DGPFILE ;file # of PRF local or national flag file
150 ;
151 S RESULT=0
152 ;
153 D
154 . ;-- quit if pointer is not valid
155 . Q:$G(DGPFPTR)']""
156 . Q:'$$TESTVAL^DGPFUT(26.13,.02,DGPFPTR)
157 . ;
158 . ;-- get ien and file from pointer value
159 . S DGPFIEN=+$G(DGPFPTR)
160 . S DGPFILE=$P($G(DGPFPTR),";",2)
161 . ;
162 . ;-- if local flag file, get local flag into DGPFLAG array
163 . I DGPFILE["26.11" D
164 . . Q:'$$GETLF^DGPFALF(+DGPFIEN,.DGPFLAG)
165 . . S RESULT=1 ;success
166 . ;
167 . ;-- if national flag file, get national flag into DGPFLAG array
168 . I DGPFILE["26.15" D
169 . . Q:'$$GETNF^DGPFANF(+DGPFIEN,.DGPFLAG)
170 . . S RESULT=1 ;success
171 ;
172 Q RESULT
173 ;
174PARENT(DGCHILD) ;lookup and return the parent of a child
175 ;
176 ; Input:
177 ; DGCHILD - pointer to INSTITUTION (#4) file
178 ;
179 ; Output:
180 ; Function value - INSTITUTION file pointer^institution name^station#
181 ; of parent facility on success; 0 on failure
182 ;
183 N DGPARENT ;function value
184 N DGPARR ;return array from XUAF4
185 ;
186 S DGCHILD=+$G(DGCHILD)
187 D PARENT^XUAF4("DGPARR","`"_DGCHILD,"PARENT FACILITY")
188 S DGPARENT=+$O(DGPARR("P",0))
189 I DGPARENT S DGPARENT=DGPARENT_U_$P(DGPARR("P",DGPARENT),U)_U_$P(DGPARR("P",DGPARENT),U,2)
190 Q DGPARENT
191 ;
192FMTPRNT(DGCHILD) ;lookup and return parent of a child in display format
193 ;
194 ; Input:
195 ; DGCHILD - pointer to INSTITUTION (#4) file
196 ;
197 ; Output:
198 ; Function value - formatted name of parent institution on success;
199 ; null on failure
200 ;
201 N DGPARENT ;parent facility name
202 S DGCHILD=+$G(DGCHILD)
203 S DGPARENT=$P($$PARENT(DGCHILD),U,2)
204 Q $S(DGPARENT]"":"("_DGPARENT_")",1:"")
205 ;
206CNTRECS(DGFILE) ;return number of records of a file
207 ;
208 ; Input:
209 ; DGFILE - (Required) file number to search
210 ;
211 ; Output:
212 ; Function Value - number of records found
213 ;
214 N DGCNT ;returned function value
215 N DGERR ;FM error message array
216 N DGLIST ;FM array of record ien's
217 ;
218 S DGCNT=0
219 I $G(DGFILE)]"" D
220 . D LIST^DIC(DGFILE,"","@","Q","*","","","","","","DGLIST","DGERR")
221 . Q:$D(DGERR)
222 . S DGCNT=+$G(DGLIST("DILIST",0))
223 Q DGCNT
Note: See TracBrowser for help on using the repository browser.