source: FOIAVistA/trunk/r/QUASAR-ACKQ/ACKQPCE1.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: 9.2 KB
Line 
1ACKQPCE1 ;HCIOFO/AG - Quasar/PCE Interface; August 1999. ; 5/6/03 11:06am
2 ;;3.0;QUASAR;**1,2,5,7,8**;Feb 11, 2000
3 ;
4 ; this routine contains the code for sending a Quasar visit to PCE
5 ; it is called from ACKQPCE.
6 ;
7SENDPCE(ACKVIEN,ACKPKG,ACKSRC) ; send a Quasar Visit to PCE.
8 ; see SENDPCE^ACKQPCE for entry parameters and processing notes.
9 ; this routine should not be called directly, only from ACKQPCE
10 ; (this routine assumes all the entry parameters are passed!)
11 N ACKSENT,ACKLOCK,ACKRSN,ACKMSG,ACKFDA,ACKFDA2,ACKPCE,ACKE,ACKERR,ACKNARR
12 N ACKVDT,ACKVTM,ACKPAT,ACKSC,ACKAO,ACKIR,ACKEC,ACKCHKDT,ACKELIG,ACKPROCP
13 N ACKVSC,ACKCAT,ACKAPI,ACKCT,ACKPRIM,ACKSCND,ACKSTUD,ACKIEN,ACKICD9
14 N ACKCPT,ACKVOL,ACKIEN2,ACKMOD,ACKPROB,ACKARR,ACKDATE,ACKDPRIM,ACKK5
15 ; initialize
16 S ACKSENT=0,ACKLOCK=0,ACKERR=0
17 D NOW^%DTC S ACKDATE=% ; to be used for LAST SENT TO PCE field
18 ;
19 ; lock the visit
20 L +^ACK(509850.6,ACKVIEN):0 S ACKLOCK=$T
21 ; if unable to lock then exit
22 I 'ACKLOCK G SENDPCEX
23 ;
24 ; initialize temp file
25 K ^TMP("ACKQPCE1",$J)
26 ;
27 ; remove PCE errors from the visit
28 D CLEAR^ACKQPCE(ACKVIEN)
29 ;
30 ; get the visit data and place in temp file
31 D GETDATA
32 ;
33 ; if this visit exists in PCE then remove workload data
34 D CHKPCE I ACKERR G SENDPCEX
35 ;
36 ; build the temp file for sending to PCE
37 D BUILD
38 ;
39 ; now send
40 D SENDIT
41 ;
42SENDPCEX ; exit point
43 ;
44 ; if visit was locked, unlock it
45 I ACKLOCK L -^ACK(509850.6,ACKVIEN)
46 ;
47 ; clear the temp file
48 ;K ^TMP("ACKQPCE1",$J)
49 ;
50 ; return
51 Q ACKSENT
52 ;
53GETDATA ; get the visit data and place in temp file
54 S ACKFDA=$NA(^TMP("ACKQPCE1",$J,"FDA"))
55 D GETS^DIQ(509850.6,ACKVIEN_",","**","I",ACKFDA,"")
56 S ACKFDA2=$NA(^TMP("ACKQPCE1",$J,"FDA",509850.6,ACKVIEN_","))
57 ; data now stored in ..
58 ; ^TMP("ACKQPCE1",$J,"FDA",509850.6,visit_",",fldnum,"I")=internal value
59 ; simplified to @ACKFDA2@(fldnum,"I")=internal value
60 ; get the PCE visit ien
61 S ACKPCE=@ACKFDA2@(125,"I")
62 ; get the visit date and time, patient and clinic
63 S ACKVDT=@ACKFDA2@(.01,"I")
64 S ACKVTM=@ACKFDA2@(55,"I")
65 S ACKPAT=@ACKFDA2@(1,"I")
66 S ACKCLN=@ACKFDA2@(2.6,"I")
67 ; end of getdata
68 Q
69 ;
70CHKPCE ; check if the visit is already in PCE and remove workload if it is
71 I 'ACKPCE Q
72 ;
73 ; check PCE visit is for same Patient, Clinic, Date and Time
74 ; if any item different then this Qsr visit is treated as new
75 ; and any data from Quasar is deleted from the original PCE visit
76 ; (sending ACKPKG and ACKSRC ensures that only data that originally
77 ; came from Quasar will be removed).
78 I +$$PCECHK^ACKQUTL3(ACKPCE,ACKVDT,ACKVTM,ACKPAT,ACKCLN)'=2 D Q
79 . S ACKE=$$DELVFILE^PXAPI("ALL",ACKPCE,ACKPKG,ACKSRC,0,0,"")
80 . S ACKPCE="" ; remove PCE Visit ien from Qsr visit
81 . K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
82 . D FILE^DIE("","ACKARR","")
83 ;
84 ; remove all workload data from the PCE visit
85 S ACKE=$$DELVFILE^PXAPI("CPT^POV^PRV^VISIT",ACKPCE,"","",0,0,"")
86 S ACKERR=$S(ACKE>-1:0,ACKE=-4:0,1:1)
87 ;
88 ; if error occurred then store on visit file
89 I ACKERR D Q
90 . K ACKRSN S ACKMSG="Unable to delete original PCE visit data (error code="_ACKE_")"
91 . D ADDRSN^ACKQPCE2("PCE VISIT",ACKPCE,"",ACKMSG,.ACKRSN)
92 . D FILERSN^ACKQPCE(ACKVIEN,.ACKRSN) ; file errors on visit file
93 ;
94 ; if no error, check to see if the entire PCE visit has been deleted
95 ; and if so, blank out the PCE Visit ien variable so that a new one
96 ; can be allocated.
97 K ^TMP("PXKENC",$J)
98 D ENCEVENT^PXAPI(ACKPCE)
99 I '$D(^TMP("PXKENC",$J,ACKPCE)) D
100 . K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
101 . D FILE^DIE("","ACKARR","")
102 . S ACKPCE=""
103 K ^TMP("PXKENC",$J)
104 ;
105 ; return
106 Q
107 ;
108 ;
109BUILD ; now build array for passing data to PCE
110 K ^TMP("ACKQPCE1",$J,"PXAPI")
111 S ACKAPI=$NA(^TMP("ACKQPCE1",$J,"PXAPI"))
112 ;
113 ; ----------encounter date/time----------------
114 S @ACKAPI@("ENCOUNTER",1,"ENC D/T")=(ACKVDT\1+ACKVTM)
115 ; --------------patient-----------------------
116 S @ACKAPI@("ENCOUNTER",1,"PATIENT")=ACKPAT
117 ; ---------------clinic-----------------------
118 S @ACKAPI@("ENCOUNTER",1,"HOS LOC")=ACKCLN
119 ; ------------service connected---------------
120 S ACKSC=@ACKFDA2@(20,"I")
121 S @ACKAPI@("ENCOUNTER",1,"SC")=ACKSC
122 ; -------------agent orange,MST etc---------------
123 S ACKAO=@ACKFDA2@(25,"I")
124 S @ACKAPI@("ENCOUNTER",1,"AO")=ACKAO
125 S ACKIR=@ACKFDA2@(30,"I")
126 S @ACKAPI@("ENCOUNTER",1,"IR")=ACKIR
127 S ACKEC=@ACKFDA2@(35,"I")
128 S @ACKAPI@("ENCOUNTER",1,"EC")=ACKEC
129 S ACKMST=@ACKFDA2@(90,"I")
130 S @ACKAPI@("ENCOUNTER",1,"MST")=ACKMST
131 ; -------------checkout date/time-------------
132 D NOW^%DTC S ACKCHKDT=%
133 S @ACKAPI@("ENCOUNTER",1,"CHECKOUT D/T")=ACKCHKDT
134 ; -------------visit eligibility--------------
135 S ACKELIG=@ACKFDA2@(80,"I")
136 S @ACKAPI@("ENCOUNTER",1,"ELIGIBILITY")=ACKELIG
137 ; --------------service category--------------
138 S ACKVSC=@ACKFDA2@(4,"I")
139 S ACKCAT=$S(ACKVSC="AT":"T",ACKVSC="ST":"T",1:"X")
140 S @ACKAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=ACKCAT
141 ; ---------------encounter type---------------
142 S @ACKAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
143 ;
144 S ACKCT=0
145 ; ------------secondary provider-------------
146 S ACKK5=""
147 F S ACKK5=$O(^TMP("ACKQPCE1",$J,"FDA",509850.66,ACKK5)) Q:ACKK5="" D
148 . I $P(ACKK5,",",2)'=ACKVIEN Q
149 . S ACKSCND=$G(^TMP("ACKQPCE1",$J,"FDA",509850.66,ACKK5,".01","I"))
150 . I ACKSCND="" Q
151 . S ACKSCND=$$CONVERT1^ACKQUTL4(ACKSCND)
152 . S ACKCT=ACKCT+1,@ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKSCND
153 ; ------------primary provider----------------
154 S ACKPRIM=@ACKFDA2@(6,"I")
155 I ACKPRIM'="" D
156 . S ACKPRIM=$$CONVERT1^ACKQUTL4(ACKPRIM)
157 . S ACKCT=ACKCT+1,@ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKPRIM
158 . S @ACKAPI@("PROVIDER",ACKCT,"PRIMARY")=1
159 ;
160 ; ----------------diagnosis------------------
161 N ACKPBLM,ACKPBLMP,ACKIFN,ACKPLQT
162 S ACKCT=0,(ACKIEN,ACKDPRIM,ACKNARR,ACKPBLM,ACKPBLMP)=""
163 F S ACKIEN=$O(@ACKFDA@(509850.63,ACKIEN)) Q:ACKIEN="" D
164 . I $P(ACKIEN,",",2)'=ACKVIEN Q
165 . S ACKICD9=@ACKFDA@(509850.63,ACKIEN,.01,"I")
166 . S ACKCT=ACKCT+1,@ACKAPI@("DX/PL",ACKCT,"DIAGNOSIS")=ACKICD9
167 . S ACKNARR=$$LDIAGTXT^ACKQUTL8(ACKICD9,ACKVD)
168 . I ACKNARR'="" S @ACKAPI@("DX/PL",ACKCT,"NARRATIVE")=ACKNARR
169 . ; check for updating PCE problem list flag
170 . S ACKPBLM=@ACKFDA@(509850.63,ACKIEN,.13,"I") I ACKPBLM D
171 . . ; don't send if diagnosis provider blank
172 . . S ACKPBLMP=@ACKFDA@(509850.63,ACKIEN,.14,"I") Q:'ACKPBLMP
173 . . S ACKPLQT=$$PLIST^ACKQUTL6(ACKPAT,ACKICD9)
174 . . ; send new problem if not on list
175 . . I 'ACKPLQT S @ACKAPI@("DX/PL",ACKCT,"PL ADD")=1
176 . . ; make existing problem active if currently inactive
177 . . I +ACKPLQT=1 D
178 . . . S @ACKAPI@("DX/PL",ACKCT,"PL IEN")=$P(ACKPLQT,U,2)
179 . . . S @ACKAPI@("DX/PL",ACKCT,"PL ACTIVE")="A"
180 . . ; send event date and encounter provider if updating list
181 . . I +ACKPLQT'=2 D
182 . . . S @ACKAPI@("DX/PL",ACKCT,"EVENT D/T")=ACKVD
183 . . . S ACKPBLMP=$$CONVERT1^ACKQUTL4(ACKPBLMP)
184 . . . S @ACKAPI@("DX/PL",ACKCT,"ENC PROVIDER")=ACKPBLMP
185 . ; Check for primary diagnosis
186 . I 'ACKDPRIM,@ACKFDA@(509850.63,ACKIEN,.12,"I")=1 D
187 . . S @ACKAPI@("DX/PL",ACKCT,"PRIMARY")=1
188 . . S ACKDPRIM=1
189 ; First Diagnosis sent as Primary if No Primary defined on Visit file
190 I 'ACKDPRIM,ACKCT>0 S @ACKAPI@("DX/PL",1,"PRIMARY")=1
191 ;
192 ; -----------------procedures----------------
193 S ACKCT=0,ACKIEN="",ACKPROCP=""
194 F S ACKIEN=$O(@ACKFDA@(509850.61,ACKIEN)) Q:ACKIEN="" D
195 . I $P(ACKIEN,",",2)'=ACKVIEN Q
196 . S ACKCPT=@ACKFDA@(509850.61,ACKIEN,.01,"I") ; CPT IEN
197 . S ACKVOL=@ACKFDA@(509850.61,ACKIEN,.03,"I") ; Volume
198 . S ACKPROCP=@ACKFDA@(509850.61,ACKIEN,.05,"I") ; Provider
199 . I ACKPROCP'="" S ACKPROCP=$$CONVERT1^ACKQUTL4(ACKPROCP) ; Convert from QSR to Vista
200 . S ACKCT=ACKCT+1,@ACKAPI@("PROCEDURE",ACKCT,"PROCEDURE")=ACKCPT
201 . S @ACKAPI@("PROCEDURE",ACKCT,"QTY")=$S(ACKVOL:ACKVOL,1:1)
202 . I ACKPROCP'="" S @ACKAPI@("PROCEDURE",ACKCT,"ENC PROVIDER")=ACKPROCP
203 . ; --------------procedure modifiers-------------
204 . S ACKIEN2=""
205 . F S ACKIEN2=$O(@ACKFDA@(509850.64,ACKIEN2)) Q:ACKIEN2="" D
206 . . I $P(ACKIEN2,",",2,3)'=$P(ACKIEN,",",1,2) Q
207 . . S ACKMOD=@ACKFDA@(509850.64,ACKIEN2,.01,"I")
208 . . S ACKMOD=$$GET1^DIQ(509850.5,ACKMOD,.01,"E")
209 . . I $D(@ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS"))#10=0 D
210 . . . S @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS")=""
211 . . S @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS",ACKMOD)=""
212 ;
213 ; end of build
214 Q
215 ;
216SENDIT ; send the data to PCE
217 K ACKPROB
218 ;
219 ; call the PCE package API
220 S ACKE=$$DATA2PCE^PXAPI($NA(^TMP("ACKQPCE1",$J,"PXAPI")),ACKPKG,ACKSRC,.ACKPCE,"",0,.ACKE2,"",.ACKPROB)
221 ;
222 ; check for returned error messages
223 K ACKRSN S ACKRSN=0
224 I $D(ACKPROB) D CONVERT^ACKQPCE2(.ACKPROB,ACKAPI,.ACKRSN)
225 ;
226 ; if update failed but no errors were returned then create a message
227 I ACKE'=1,'ACKRSN D
228 . S ACKMSG="Unable to update PCE Visit (error code="_ACKE_")"
229 . D ADDRSN^ACKQPCE2("PCE VISIT","","",ACKMSG,.ACKRSN)
230 . I ACKPCE'>0 D ; pce ien has been corrupted by the API
231 . . K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
232 . . D FILE^DIE("","ACKARR","")
233 ;
234 ; if errors found then file them on the Visit file and create exception
235 I ACKE'=1,ACKRSN D
236 . D FILERSN^ACKQPCE(ACKVIEN,.ACKRSN)
237 . K ACKARR
238 . S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE ; for new visits!
239 . D FILE^DIE("","ACKARR","")
240 ;
241 ; if no errors update the PCE fields
242 I ACKE=1 D
243 . K ACKARR
244 . S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE ; for new visits!
245 . S ACKARR(509850.6,ACKVIEN_",",135)=ACKDATE ; date last sent
246 . D FILE^DIE("","ACKARR","")
247 . S ACKSENT=1 ; return flag (1=sent,0=not sent)
248 ;
249 ; end of sendit
250 Q
251 ;
Note: See TracBrowser for help on using the repository browser.