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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1DGPFLMU1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM UTILITIES CONT ; 10/12/05 10:26am
2 ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7EN(DGARY,DGIEN,DGDFN,DGCNT) ;Entry point to build flag assignment detail list area.
8 ;
9 ; Input:
10 ; DGARY - global array subscript
11 ; DGIEN - ien of PATIENT ASSIGNMENT (#26.13) file
12 ; DGDFN - ien of PATIENT (#2) file
13 ;
14 ; Output:
15 ; DGCNT - number of lines in the list, pass by reference
16 ;
17 N DGHIEN ;assignment history ien
18 N DGHIENS ;contains assignment history ien's
19 N DGHISCNT ;count of history records
20 N DGLINE ;line counter
21 N DGPFA ;assignment array
22 N DGPFAH ;assignment history array
23 N DGPFF ;flag array
24 N DGSUB ;subscript of history ien's array
25 ;
26 ;init variables
27 S DGCNT=0
28 S (DGLINE,VALMBEG)=1
29 K DGPFA
30 K DGPFAH
31 K DGPFF
32 K DGHIENS
33 ;
34 Q:'$G(DGIEN)
35 ;
36 ;get assignment into DGPFA array
37 Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
38 S DGPFA("INITASSIGN")=$$GETADT^DGPFAAH(DGIEN) ;initial assign date
39 ;
40 ;get most recent assignment history and place in DGPFAH array
41 Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)
42 ;
43 ;get record flag into DGPFF array
44 Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFF)
45 ;
46 ;build Assignment Details area
47 D ASGN(DGARY,.DGPFA,.DGPFAH,.DGPFF,.DGLINE,.DGCNT)
48 ;
49 ;build Assignment History heading
50 S DGLINE=DGLINE+1
51 D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT)
52 D SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
53 ;
54 ;get all history ien's associated with the assignment
55 Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
56 ;
57 ;reverse loop through each assignment history ien
58 ;and get record into DGPFAH array
59 S DGHISCNT=0,DGSUB=9999999.999999
60 F S DGSUB=$O(DGHIENS(DGSUB),-1) Q:DGSUB="" D
61 . S DGHIEN=+$G(DGHIENS(DGSUB))
62 . K DGPFAH
63 . I $$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D
64 . . ;
65 . . ;-history record counter
66 . . S DGHISCNT=DGHISCNT+1
67 . . ;
68 . . ;-build assignment history area
69 . . D HIST(DGARY,.DGPFAH,.DGPFA,.DGLINE,DGHISCNT,.DGCNT)
70 Q
71 ;
72 ;
73ASGN(DGARY,DGPFA,DGPFAH,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT details.
74 ;
75 ; Input:
76 ; DGARY - global array subscript
77 ; DGPFF - flag array, pass by reference
78 ; DGPFA - assignment array, pass by reference
79 ; DGPFAH - assignment history array, pass by reference
80 ; DGLINE - line counter
81 ;
82 ; Output:
83 ; DGCNT - number of lines in the list, pass by reference
84 ;
85 ;temporary variables used
86 N DGSUB
87 N DGTMP
88 ;
89 ;set flag name
90 D SET(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),12,,,.DGCNT)
91 ;
92 ;set flag type
93 S DGLINE=DGLINE+1
94 D SET(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),12,,,.DGCNT)
95 ;
96 ;set flag category
97 S DGLINE=DGLINE+1
98 S DGTMP=$S($P($G(DGPFA("FLAG")),U)["26.11":"II (LOCAL)",1:"I (NATIONAL)")
99 D SET(DGARY,DGLINE,"Flag Category: "_DGTMP,8,,,.DGCNT)
100 ;
101 ;set flag assignment status
102 S DGLINE=DGLINE+1
103 D SET(DGARY,DGLINE,"Assignment Status: "_$P($G(DGPFA("STATUS")),U,2),4,,,.DGCNT)
104 ;
105 ;set initial assignment date
106 S DGLINE=DGLINE+1
107 D SET(DGARY,DGLINE,"Initial Assignment: "_$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U)),3,,,.DGCNT)
108 ;
109 ;set last review date (do not set if only initial assignment)
110 S DGLINE=DGLINE+1
111 I (+$G(DGPFAH("ASSIGNDT")))=(+$G(DGPFA("INITASSIGN"))) D
112 . S DGTMP="N/A"
113 E S DGTMP=$$FDATE^VALM1(+$G(DGPFAH("ASSIGNDT")))
114 D SET(DGARY,DGLINE,"Last Review Date: "_DGTMP,5,,,.DGCNT)
115 ;
116 ;set next review date
117 S DGLINE=DGLINE+1
118 S DGTMP=+$G(DGPFA("REVIEWDT"))
119 S DGTMP=$S(DGTMP:$$FDATE^VALM1(DGTMP),1:"N/A")
120 D SET(DGARY,DGLINE,"Next Review Date: "_DGTMP,5,,,.DGCNT)
121 ;
122 ;set owner site
123 S DGLINE=DGLINE+1
124 D SET(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT)
125 ;
126 ;set originating site
127 S DGLINE=DGLINE+1
128 D SET(DGARY,DGLINE,"Originating Site: "_$P($G(DGPFA("ORIGSITE")),U,2)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
129 ;
130 ;set assignment narrative
131 S DGLINE=DGLINE+1
132 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
133 S DGLINE=DGLINE+1
134 D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
135 I '$D(DGPFA("NARR",1,0)) D Q
136 . S DGLINE=DGLINE+1
137 . D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
138 S (DGSUB,DGTMP)=""
139 F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB D
140 . S DGTMP=$G(DGPFA("NARR",DGSUB,0))
141 . S DGLINE=DGLINE+1
142 . D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
143 ;
144 ;set blank lines
145 S DGLINE=DGLINE+2
146 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
147 ;
148 Q
149 ;
150 ;
151HIST(DGARY,DGPFAH,DGPFA,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT HISTORY details.
152 ;
153 ; Input:
154 ; DGARY - global array subscript
155 ; DGPFAH - assignment history array, pass by reference
156 ; DGPFA - assignment array, pass by reference
157 ; DGLINE - line counter
158 ; DGHISCNT - counter of history record
159 ;
160 ; Output:
161 ; DGCNT - number of lines in the list, pass by reference
162 ;
163 ;temporary variables used
164 N DGTMP
165 N DGSUB
166 ;
167 ;set blank line
168 S DGLINE=DGLINE+1
169 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
170 ;
171 ;add an additional blank line except on the first history
172 I DGHISCNT>1 D
173 . S DGLINE=DGLINE+1
174 . D SET(DGARY,DGLINE,"",1,,,.DGCNT)
175 ;
176 ;set action
177 S DGLINE=DGLINE+1
178 S DGTMP=DGHISCNT_"."
179 D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
180 D SET(DGARY,DGLINE,"Action: "_$P($G(DGPFAH("ACTION")),U,2),10,IORVON,IORVOFF,.DGCNT)
181 ;
182 ;set assignment date
183 S DGLINE=DGLINE+1
184 D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
185 ;
186 ;set entered by
187 S DGLINE=DGLINE+1
188 D SET(DGARY,DGLINE,"Entered By: "_$P($G(DGPFAH("ENTERBY")),U,2),6,,,.DGCNT)
189 ;
190 ;set approved by
191 S DGLINE=DGLINE+1
192 D SET(DGARY,DGLINE,"Approved By: "_$P($G(DGPFAH("APPRVBY")),U,2),5,,,.DGCNT)
193 ;
194 ;set progress note linked
195 I $D(^DG(40.8,"AD",+$P($G(DGPFA("OWNER")),U))) D
196 . Q:+$G(DGPFAH("ACTION"))=5 ;don't display ENTERED IN ERROR action
197 . S DGLINE=DGLINE+1
198 . D SET(DGARY,DGLINE,"Progress Note: "_$P($G(DGPFAH("TIULINK")),U,2),3,,,.DGCNT)
199 ;
200 ;set history comments
201 S DGLINE=DGLINE+1
202 D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
203 S DGLINE=DGLINE+1
204 D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
205 I $D(DGPFAH("COMMENT",1,0)) D
206 . S (DGSUB,DGTMP)=""
207 . F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D
208 .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0))
209 .. S DGLINE=DGLINE+1
210 .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
211 E D
212 . S DGLINE=DGLINE+1
213 . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
214 ;
215 Q
216 ;
217 ;
218SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area.
219 ;
220 ; Input:
221 ; DGARY - global array subscript
222 ; DGLINE - line number
223 ; DGTEXT - text
224 ; DGCOL - starting column
225 ; DGON - highlighting on
226 ; DGOFF - highlighting off
227 ;
228 ; Output:
229 ; DGCNT - number of lines in the list, pass by reference
230 ;
231 N DGX ;temp variable for line of display text
232 ;
233 S DGCNT=DGLINE
234 S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
235 S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT))
236 D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
237 Q
Note: See TracBrowser for help on using the repository browser.