source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFHLUQ.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: 6.0 KB
Line 
1DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6EN ;entry point
7 ;This procedure prompts the user to select a patient and the facility
8 ;that they wish to check for existing Category I patient record flags.
9 ;An HL7 query is then sent to the selected facility.
10 ;
11 N DGDFN ;pointer to patient in PATIENT (#2) file
12 N DGFAC ;selected facility
13 N DGTF ;array of treating facilities
14 N DGPAT ;selected patient
15 N DGRSLT ;result of query call
16 ;
17 ;select patient
18 W !!
19 D SELPAT^DGPFUT1(.DGPAT)
20 Q:+$G(DGPAT)'>0
21 S DGDFN=+DGPAT
22 ;
23 ;build list of valid query facilities
24 I '$$BLDTFL^DGPFUT2(DGDFN,.DGTF) D Q
25 . N DGLINE
26 . S DGLINE(1)=""
27 . S DGLINE(3)="* No treating facilities are available to query. *"
28 . S $P(DGLINE(2),"*",$L(DGLINE(3)))="*"
29 . S DGLINE(4)=DGLINE(2)
30 . S DGLINE(5)=""
31 . D EN^DDIOL(.DGLINE)
32 . I $$CONTINUE^DGPFUT()
33 ;
34 ;select facility
35 S DGFAC=$$ANSWER^DGPFUT("Select facility to query",$P($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))")
36 Q:DGFAC'>0
37 S DGFAC=$$STA^XUAF4(DGFAC)
38 ;
39 ;send query and build display
40 S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC)
41 ;
42 Q
43 ;
44 ;
45DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS
46 ;This procedure is the entry point called from SNDQRY^DGPFHLS that
47 ;parses and displays the returned Response to Observation Query
48 ;(ORF~R04) HL7 message.
49 ;
50 ; Input:
51 ; DGMTIEN - if positive a response was returned from destination;
52 ; otherwise, no response was returned
53 ; DGRESULT - result parameter from HLMA call
54 ;
55 ; Output: none
56 ;
57 N DGANS ;pause response
58 N DGCNT ;continuation node counter
59 N DGERR ;parsed message error results array
60 N DGFACNAM ;facility name
61 N DGORF ;parsed data array name
62 N DGSEGCNT ;segment counter
63 N DGSTA ;station number
64 N DGTEXT ;message text array
65 N DGWRK ;HL7 segments array name
66 ;
67 ;if HL7 package reports failure, notify user and quit
68 I +$G(DGMTIEN)<1!(+$P($G(DGRESULT),U,2)) D Q
69 . K DGTEXT
70 . S DGTEXT(1)="The facility failed to respond to the query request."
71 . D SHOWMSG(.DGTEXT,"*")
72 . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
73 ;
74 S DGWRK=$NA(^TMP("DGPFHL7",$J))
75 K @DGWRK
76 S DGORF=$NA(^TMP("DGPF",$J))
77 K @DGORF
78 ;
79 ;load work global with segments
80 F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
81 . S DGCNT=0
82 . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
83 . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
84 . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
85 ;
86 ;parse segments and load into data array
87 D PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR)
88 ;
89 ;get facility name from message
90 S DGSTA=$G(@DGORF@("SNDFAC"))
91 S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA))
92 ;
93 ;when assignments are returned, file any that are missing locally
94 ;and display all returned assignments
95 I $O(@DGORF@(0)) D
96 . ;
97 . N DGDFN ;patient
98 . N DGFLG ;flag name
99 . N DGI ;generic index
100 . N DGPRE ;list of flag assignments prior to filing
101 . N DGPRECNT ;count of flag assignments prior to filing
102 . N DGPST ;list of flag assignments following filing
103 . ;
104 . S DGDFN=$$GETDFN^MPIF001(+$G(@DGORF@("ICN")))
105 . ;
106 . ;get list of existing Cat I assignments
107 . S DGPRECNT=$$GETFNAME(DGDFN,.DGPRE)
108 . ;
109 . ;store the returned assignments
110 . I $$STOORF^DGPFHLR(DGDFN,DGORF) ;naked IF
111 . ;
112 . ;get updated list of Cat I assignments and notify user when
113 . ;assignments are added
114 . I $$GETFNAME(DGDFN,.DGPST)>DGPRECNT D
115 . . K DGTEXT
116 . . ;
117 . . ;remove pre-existing flags from assignment list
118 . . S DGFLG=""
119 . . F S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" K:$D(DGPRE(DGFLG)) DGPST(DGFLG)
120 . . ;build user message
121 . . S DGTEXT(1)="The following Category I Patient Record Flag Assignments"
122 . . S DGTEXT(2)="were returned and filed on your system:"
123 . . S DGFLG=""
124 . . F DGI=3:1 S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" D
125 . . . S DGTEXT(DGI)=" "_DGFLG
126 . . D SHOWMSG(.DGTEXT,"*")
127 . . S DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E")
128 . ;
129 . ;display query results
130 . I +$G(DGANS)>-1 D EN^DGPFLMQ(DGORF)
131 ;
132 ;otherwise notify user that none were found
133 E D
134 . K DGTEXT
135 . S DGTEXT(1)="No Category I Patient Record Flag Assignments found for"
136 . S DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")."
137 . D SHOWMSG(.DGTEXT,"*")
138 . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
139 ;
140 ;cleanup
141 K @DGWRK
142 K @DGORF
143 Q
144 ;
145GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names
146 ;
147 ; Input:
148 ; DGDFN
149 ;
150 ; Output:
151 ; Function value - count of assigned flag names
152 ; DGFLGS - array of assigned flag names
153 ; Ex. DGFLGS("FLAGNAME")=""
154 ;
155 N DGASGN ;PRF assignments array
156 N DGCNT ;assigned flag name count
157 N DGPFA ;assignment data array
158 N DGIEN ;assignment record#
159 ;
160 S DGCNT=0
161 I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) D
162 . S DGIEN=0
163 . F S DGIEN=$O(DGASGN(DGIEN)) Q:'DGIEN D
164 . . I $$GETASGN^DGPFAA(DGIEN,.DGPFA) D
165 . . . S DGFLGS($P(DGPFA("FLAG"),U,2))=""
166 . . . S DGCNT=DGCNT+1
167 Q DGCNT
168 ;
169SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message
170 ;
171 ; Input:
172 ; DGTEXT - array of lines to display
173 ; DGBCHAR - border character (optional [DEFAULT="*"])
174 ;
175 ; Output: none
176 ;
177 N DGBLNK ;blank line
178 N DGBORDER ;border string
179 N DGCNT ;line counter
180 N DGI ;generic index
181 N DGLEN ;line length
182 N DGLINE ;formatted text line
183 N DGMAX ;max line length
184 ;
185 S DGBCHAR=$S($G(DGBCHAR)?1.ANP:$E(DGBCHAR),1:"*")
186 ;determine max line length
187 S (DGI,DGCNT,DGMAX)=0
188 F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
189 . S DGLEN=$L(DGTEXT(DGI))
190 . I DGLEN>(IOM-4) D
191 . . S DGTEXT(DGI+.1)=$E(DGTEXT(DGI),IOM-3,DGLEN)
192 . . S DGTEXT(DGI)=$E(DGTEXT(DGI),1,IOM-4)
193 . . S DGLEN=IOM-4
194 . S:DGLEN>DGMAX DGMAX=DGLEN
195 S $P(DGBLNK," ",DGMAX+1)=""
196 S $P(DGBORDER,DGBCHAR,DGMAX+5)=""
197 S DGCNT=DGCNT+1
198 S DGLINE(DGCNT)=""
199 S DGCNT=DGCNT+1
200 S DGLINE(DGCNT)=DGBORDER
201 S DGI=0
202 F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
203 . S DGCNT=DGCNT+1
204 . S DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$E(DGBLNK,1,$L(DGBLNK)-$L(DGTEXT(DGI)))_" "_DGBCHAR
205 S DGCNT=DGCNT+1
206 S DGLINE(DGCNT)=DGBORDER
207 S DGCNT=DGCNT+1
208 S DGLINE(DGCNT)=""
209 D EN^DDIOL(.DGLINE)
210 ;
211 Q
Note: See TracBrowser for help on using the repository browser.