source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFLMQ2.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.6 KB
Line 
1DGPFLMQ2 ;ALB/RPM - PRF HL7 QUERY RESULTS DISPLAY UTILITIES ; 1/25/06 11:24
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6EN(DGARY,DGSET,DGCNT) ;display ORF query results
7 ;
8 ; Input:
9 ; DGARY - global array subscript
10 ; DGSET - set id representing a single PRF assignment
11 ;
12 ; Output:
13 ; DGCNT - number of lines in list, pass by reference
14 ;
15 N DGADT ;assignment date
16 N DGHISCNT ;history action counter
17 N DGLINE ;list line counter
18 N DGPFA ;assignment data array
19 N DGPFAH ;assignment history data array
20 ;
21 S (DGLINE,VALMBEG)=1
22 S DGCNT=0
23 ;
24 ;load assignment data array
25 D LDASGN(DGSET,DGORF,.DGPFA)
26 S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date
27 ;
28 ;get most recent assignment history to calculate current status
29 S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1)
30 S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION")))
31 ;
32 ;build Assignment Details area
33 D ASGN(DGARY,.DGPFA,.DGLINE,.DGCNT)
34 ;
35 ;build Assignment History heading
36 S DGLINE=DGLINE+1
37 D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT)
38 D SET(DGARY,DGLINE,"<Assignment History>",30,IORVON,IORVOFF,.DGCNT)
39 ;
40 S DGHISCNT=0
41 S DGADT=9999999.999999 ;each DGADT represents a single PRF history action
42 F S DGADT=$O(@DGORF@(DGSET,DGADT),-1) Q:'DGADT D
43 . N DGPFAH ;assignment history data array
44 . S DGHISCNT=DGHISCNT+1
45 . ;
46 . ;load assignment history data array
47 . D LDHIST(DGSET,DGADT,DGORF,.DGPFAH)
48 . ;
49 . ;build History Details area
50 . D HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT)
51 S ^TMP(DGARY,$J,"SET")=DGSET
52 Q
53 ;
54 ;
55LDASGN(DGSET,DGORF,DGPFA) ;load assignment data array
56 ;
57 ; Input:
58 ; DGSET - set id representing a single PRF assignment
59 ; DGORF - parsed ORF segments data array
60 ;
61 ; Output:
62 ; DGPFA - assignment data array
63 ;
64 S DGPFA("DFN")=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
65 S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG"))
66 Q:DGPFA("FLAG")']""
67 ;
68 ;init STATUS as a placeholder, set value following history retrieval
69 S DGPFA("STATUS")=""
70 S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER"))
71 S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE"))
72 M DGPFA("NARR")=@DGORF@(DGSET,"NARR")
73 ;
74 Q
75 ;
76 ;
77LDHIST(DGSET,DGADT,DGORF,DGPFAH) ;load assignment history data array
78 ;
79 ; Input:
80 ; DGSET - set id representing a single PRF assignment
81 ; DGADT - assignment date
82 ; DGORF - parsed ORF segments data array
83 ;
84 ; Output:
85 ; DGPFAH - assignment history data array
86 ;
87 S DGPFAH("ASSIGNDT")=DGADT
88 S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION"))
89 S DGPFAH("ENTERBY")=.5 ;POSTMASTER
90 S DGPFAH("APPRVBY")=.5 ;POSTMASTER
91 M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
92 Q
93 ;
94 ;
95ASGN(DGARY,DGPFA,DGLINE,DGCNT) ;format assignment details
96 ;This procedure will build and format the lines of FLAG ASSIGNMENT
97 ;details.
98 ;
99 ; Input:
100 ; DGARY - global array subscript
101 ; DGPFA - assignment array, pass by reference
102 ; DGLINE - line counter, pass by reference
103 ;
104 ; Output:
105 ; DGCNT - number of lines in the list, pass by reference
106 ;
107 ;temporary variables used
108 N DGSUB
109 N DGTMP
110 N DGTXT
111 ;
112 ;set flag name
113 S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
114 I DGTXT="" S DGTXT="**FLAG not defined**"
115 D SET(DGARY,DGLINE,"Flag Name: "_DGTXT,12,,,.DGCNT)
116 ;
117 ;set flag assignment status
118 S DGLINE=DGLINE+1
119 S DGTXT=$$EXTERNAL^DILFD(26.13,.03,"F",$G(DGPFA("STATUS")))
120 D SET(DGARY,DGLINE,"Assignment Status: "_DGTXT,4,,,.DGCNT)
121 ;
122 ;set initial assignment date
123 S DGLINE=DGLINE+1
124 S DGTXT=$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U))
125 D SET(DGARY,DGLINE,"Initial Assignment: "_DGTXT,3,,,.DGCNT)
126 ;
127 ;set owner site
128 S DGLINE=DGLINE+1
129 S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
130 D SET(DGARY,DGLINE,"Owner Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT)
131 ;
132 ;set originating site
133 S DGLINE=DGLINE+1
134 S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("ORIGSITE")))
135 D SET(DGARY,DGLINE,"Originating Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT)
136 ;
137 ;set assignment narrative
138 S DGLINE=DGLINE+1
139 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
140 S DGLINE=DGLINE+1
141 D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT)
142 I '$D(DGPFA("NARR",1,0)) D Q
143 . S DGLINE=DGLINE+1
144 . D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT)
145 S (DGSUB,DGTMP)=""
146 F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB D
147 . S DGTMP=$G(DGPFA("NARR",DGSUB,0))
148 . S DGLINE=DGLINE+1
149 . D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
150 ;
151 ;set blank lines
152 S DGLINE=DGLINE+2
153 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
154 ;
155 Q
156 ;
157 ;
158HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;format history details
159 ;This procedure will build and format the lines of FLAG ASSIGNMENT
160 ;HISTORY details.
161 ;
162 ; Input:
163 ; DGARY - global array subscript
164 ; DGPFAH - assignment history array, pass by reference
165 ; DGLINE - line counter, pass by reference
166 ; DGHISCNT - counter of history record
167 ;
168 ; Output:
169 ; DGCNT - number of lines in the list, pass by reference
170 ;
171 ;temporary variables used
172 N DGTMP
173 N DGSUB
174 ;
175 ;set blank line
176 S DGLINE=DGLINE+1
177 D SET(DGARY,DGLINE,"",1,,,.DGCNT)
178 ;
179 ;add an additional blank line except on the first history
180 I DGHISCNT>1 D
181 . S DGLINE=DGLINE+1
182 . D SET(DGARY,DGLINE,"",1,,,.DGCNT)
183 ;
184 ;set action
185 S DGLINE=DGLINE+1
186 S DGTMP=DGHISCNT_"."
187 D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT)
188 D SET(DGARY,DGLINE,"Action: "_$$EXTERNAL^DILFD(26.14,.03,"F",$G(DGPFAH("ACTION"))),10,IORVON,IORVOFF,.DGCNT)
189 ;
190 ;set assignment date
191 S DGLINE=DGLINE+1
192 D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT)
193 ;
194 ;set history comments
195 S DGLINE=DGLINE+1
196 D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT)
197 S DGLINE=DGLINE+1
198 D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT)
199 I $D(DGPFAH("COMMENT",1,0)) D
200 . S (DGSUB,DGTMP)=""
201 . F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D
202 .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0))
203 .. S DGLINE=DGLINE+1
204 .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT)
205 E D
206 . S DGLINE=DGLINE+1
207 . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT)
208 ;
209 Q
210 ;
211 ;
212SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area.
213 ;
214 ; Input:
215 ; DGARY - global array subscript
216 ; DGLINE - line number
217 ; DGTEXT - text
218 ; DGCOL - starting column
219 ; DGON - highlighting on
220 ; DGOFF - highlighting off
221 ;
222 ; Output:
223 ; DGCNT - number of lines in the list, pass by reference
224 ;
225 N DGX ;temp variable for line of display text
226 ;
227 S DGCNT=DGLINE
228 S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
229 S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT))
230 D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
231 Q
Note: See TracBrowser for help on using the repository browser.