source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCEA.m@ 949

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1RMPRPCEA ;HCIOFO/RVD - Prosthetics/PCE Interface; 05/31/01
2 ;;3.0;PROSTHETICS;**62,82,78,114,120,128,131,133**;Feb 09, 1996;Build 2
3 ;
4 ; RMS 10/1/03 Patch 78 - Change Service connected, and environmental
5 ; indicators (Agent Orange, Ionizing Radiation,
6 ; Environmental Contaminants, Military Sexual
7 ; Trauma, Head/Neck Cancer, and Combat Veteran
8 ; Status) to come from new BA fields if they
9 ; exist.
10 ;
11 ;This routine contains the code for sending a Prosthetic visit to PCE.
12 ;
13 ;DBIA #1889-A - this API is used to add, edit and delete the
14 ; of encounter, provider, diagnosis and procedure
15 ; data to VISIT and V files in the PCE module.
16 ; 04/23/2004 KAM RMPR*3*82 Make Background Message more Robust
17 ;
18 ;RMIE60 - ien in file #660
19SENDPCE(RMIE60) ; send a Prosthetic Visit to PCE.
20 ; D NEWVAR subroutine removed for functionality 01/31/05 WLC
21 ;
22 N RMPCE,RME2,RMSENT,RMLOCK,RMERR,RMPKG,RMSRC,RMDIAG,RMQTY
23 N RMSCAT,RMPROC,RMUPD,RMIEPCE,RMHLOC,RMLOC,RMPAT,RMDATE,RMINST
24 N RMETYP,RMCDAT,RMPCAT,RMDANOW,DIE,DA,DIC,RMAO,RMEC,RMIR,DFN,RMSCON
25 N RMMST,RMHNC,RMCBV,RMPRTPCE,STOP
26 ; PATCH 78, RMS - 10/1/2003, Billing aware related variables
27 N RMBASCON,RMBAAO,RMBAIR,RMBAEC,RMBAMST,RMBAHNC,RMBACBV,RMBAICD9,RMLOOP
28 N RMPROV,RMCPDT,DXERR,SICD
29 ;
30 S RMERR=1
31 S RMSRC="PROSTHETICS DATA"
32 S RMPKG=$O(^DIC(9.4,"B","PROSTHETICS",0))
33 I '$G(RMPKG) S RMERR=-2 G SENDPCEX
34 S RMSTA=$P(^RMPR(660,RMIE60,0),U,10)
35 S (RMLOC,RERRMSG,RERRMSG2)=""
36 F I=0:0 S I=$O(^RMPR(669.9,"C",RMSTA,I)) Q:I'>0 D
37 .I ($D(^RMPR(669.9,I,0))),($D(^RMPR(669.9,I,"PCE"))) S RMLOC=$P(^RMPR(669.9,I,"PCE"),U,3)
38 ;exit if Hospital Location (clinic) not defined.
39 I '$G(RMLOC) D G SENDPCEX
40 .S RMERR=-2
41 .;RMPR*3*82 04/23/2004 KAM Added next 8 lines
42 .N SPACES,VNAME,ENDAT
43 .S VNAME=$$GET1^DIQ(2,$P(^RMPR(660,RMIE60,0),U,2),.01)
44 .S ENDAT=$$GET1^DIQ(660,RMIE60,.01),SPACES=""
45 .I $G(ENDAT)="" S ENDAT=" No Entry Data Found"
46 .F I=1:1:42-($L(VNAME)+$L(ENDAT)) S SPACES=$G(SPACES)_" "
47 .S RERRMSG=" *** NAME = "_VNAME_" ENTRY DATE = "_ENDAT_SPACES
48 .I $G(RMSTA),$D(^DIC(4,RMSTA,99)) S RMSTAW=$P(^DIC(4,RMSTA,99),U)
49 .S RERRMSG=RERRMSG_" *** Clinic is not defined....Please ask your ADPAC to enter a prosthetics *** clinic in the Prosthetics Site Parameters file for station # = "_$G(RMSTAW)
50 .S RERRMSG2=" *** Using option 'Enter/Edit Station Site Parameters'"
51 .W !,"*** Clinic is not defined....."
52 .W !,"*** Please ask your ADPAC to enter a prosthetics clinic in the"
53 .W !,"*** Prosthetics Site Parameters file for station # = ",RMSTAW
54 .W !,"*** Using option 'Enter/Edit Station Site Parameters'"
55 S RMSENT=0,RMLOCK=0
56 ; initialize temp file.
57 K ^TMP("RMPRPCE1",$J),RMSTAW
58 ;
59 ; get the visit data (#660) and place in temp file.
60 D GETDATA G:$G(DXERR) SENDPCEX ;quit if inactive diagnosis RMPR*120
61 ;don't create a PCE encounter if Date of Death is before the transaction
62 I $D(VADM(6)),$P(VADM(6),U,1),$P(VADM(6),U,1)<(RMDATE) G SENDPCEX
63 ;
64 ; build the temp file for sending to PCE
65 D BUILD
66 ;
67 ; now send
68 D SENDIT
69 ;
70SENDPCEX ; exit point
71 ;
72 ; clear the temp file
73 K ^TMP("RMPRPCE1",$J)
74 ;
75 ; return
76 Q RMERR
77 ;
78GETDATA ; get the visit data and place in temp file
79 K RMDA,RMDA2
80 S RMDA=$NA(^TMP("RMPRPCE1",$J,"RM"))
81 D GETS^DIQ(660,RMIE60_",","*","I",RMDA,"")
82 S RMDA2=$NA(^TMP("RMPRPCE1",$J,"RM",660,RMIE60_","))
83 D NOW^%DTC
84 S RMDANOW=%
85 S RMDATE=@RMDA2@(.01,"I"),RMDATE=RMDATE_"."_$P(%,".",2)
86 S (DFN,RMPAT)=@RMDA2@(.02,"I")
87 S RMHLOC=RMLOC
88 S RMINST=@RMDA2@(8.11,"I")
89 S RMPCAT=@RMDA2@(62,"I")
90 S RMSCON=0
91 I (RMPCAT=1)!(RMPCAT=2) S RMSCON=1
92 ;==============================
93 S RMSCAT="A"
94 S RMETYP="P"
95 S RMUSER=@RMDA2@(27,"I")
96 S RMDIAG=@RMDA2@(8.8,"I")
97 S RMPROC=@RMDA2@(4.1,"I")
98 S RMPROV=@RMDA2@(8.6,"I")
99 S RMCPDT=@RMDA2@(8.4,"I")
100 S RMQTY=@RMDA2@(5,"I")
101 S RMCDAT=@RMDA2@(10,"I")
102 S (RMPCE,RMIEPCE)=@RMDA2@(8.12,"I")
103 ; PATCH 78, RMS - 10/1/2003, billing aware related variables
104 K RMBAICD9,RMBAAO,RMBASCON,RMBAAIR,RMBAEC,RMBAMST,RMBAHNC,RMBACBV
105 I '$D(^RMPR(660,RMIE60,"BA1")) G GTDT ; no BA data, skip retrieval
106 F RMLOOP=30:1:33 D
107 . N RMBAREC S RMBAREC=RMLOOP-29
108 . S RMBAICD9(RMBAREC)=@RMDA2@(RMLOOP,"I"),SICD=RMBAICD9(RMBAREC) I SICD'="" S:$P($G(^ICD9(SICD,0)),U,9) DXERR=1
109 . S RMBAAO(RMBAREC)=@RMDA2@((RMLOOP+.1),"I")
110 . S RMBAIR(RMBAREC)=@RMDA2@((RMLOOP+.2),"I")
111 . S RMBASCON(RMBAREC)=@RMDA2@((RMLOOP+.3),"I")
112 . S RMBAEC(RMBAREC)=@RMDA2@((RMLOOP+.4),"I")
113 . S RMBAMST(RMBAREC)=@RMDA2@((RMLOOP+.5),"I")
114 . S RMBAHNC(RMBAREC)=@RMDA2@((RMLOOP+.6),"I")
115 . S RMBACBV(RMBAREC)=@RMDA2@((RMLOOP+.7),"I")
116 ; Retrieve order number
117GTDT S RMPTR123=@RMDA2@(8.9,"I")
118 S RMODENT=$$GET1^DIQ(123,RMPTR123_",",.03)
119 ;get Date of Death.
120 D DEM^VADPT
121 ;get Agent Orange and Radiation.
122 D SVC^VADPT S RMAO=VASV(2),RMIR=VASV(3)
123 ;get environmental contaminants.
124 S RMEC=$$GET1^DIQ(2,DFN,.322013,"I") I RMEC="Y" S RMEC=1
125 S:RMEC'=1 RMEC=0
126 ;
127 S RMMST="",RMCBV="",RMHNC=""
128 Q
129 ;
130BUILD ; now build array for passing data to PCE
131 K ^TMP("RMPRPCE1",$J,"PXAPI"),RMAPI
132 S RMAPI=$NA(^TMP("RMPRPCE1",$J,"PXAPI"))
133 ; ---------encounter date/time----------------
134 S @RMAPI@("ENCOUNTER",1,"ENC D/T")=RMDATE
135 ; --------------patient-----------------------
136 S @RMAPI@("ENCOUNTER",1,"PATIENT")=RMPAT
137 ; ---------------clinic-----------------------
138 S @RMAPI@("ENCOUNTER",1,"HOS LOC")=RMHLOC
139 ; -------------checkout date/time-------------
140 S @RMAPI@("ENCOUNTER",1,"CHECKOUT D/T")=RMDATE
141 ; ------------agent orange--------------------
142 S @RMAPI@("ENCOUNTER",1,"AO")=RMAO
143 ;--------------ionizing radiation-------------
144 S @RMAPI@("ENCOUNTER",1,"IR")=RMIR
145 ;-----------environmental contaminants--------
146 S @RMAPI@("ENCOUNTER",1,"EC")=RMEC
147 ; --------------service connected--------------
148 S @RMAPI@("ENCOUNTER",1,"SC")=RMSCON
149 ; ------------Military Sexual Trauma----------
150 S @RMAPI@("ENCOUNTER",1,"MST")=RMMST
151 ; -------------Head/Neck Cancer---------------
152 S @RMAPI@("ENCOUNTER",1,"HNC")=RMHNC
153 ; --------------Combat Veteran---------
154 S @RMAPI@("ENCOUNTER",1,"CV")=RMCBV
155 ; --------------service category--------------
156 S @RMAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=RMSCAT
157 ; ---------------encounter type---------------
158 S @RMAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")=RMETYP
159 ; ------------primary provider----------------
160 S @RMAPI@("PROVIDER",1,"NAME")=RMUSER
161 ; ----------------diagnosis------------------
162 S @RMAPI@("DX/PL",1,"DIAGNOSIS")=RMDIAG
163 S @RMAPI@("DX/PL",1,"PRIMARY")=1
164 ; -------------- procedures -----------------
165 S @RMAPI@("PROCEDURE",1,"PROCEDURE")=RMPROC
166 ; ---------------- Quantity -----------------
167 S @RMAPI@("PROCEDURE",1,"QTY")=RMQTY
168 ; -------------- Procedures -----------------
169 I ($D(RMBAICD9(1))&($P($G(RMBAICD9(1)),U)=""))!('$D(RMBAICD9(1))) D Q
170 . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=RMDIAG
171 ;
172 F RMLOOP=1:1:99 Q:$G(RMBAICD9(RMLOOP))="" D
173 . S @RMAPI@("DX/PL",RMLOOP,"DIAGNOSIS")=$G(RMBAICD9(RMLOOP))
174 . S @RMAPI@("DX/PL",RMLOOP,"PL AO")=$G(RMBAAO(RMLOOP))
175 . S @RMAPI@("DX/PL",RMLOOP,"PL IR")=$G(RMBAIR(RMLOOP))
176 . S @RMAPI@("DX/PL",RMLOOP,"PL SC")=$G(RMBASCON(RMLOOP))
177 . S @RMAPI@("DX/PL",RMLOOP,"PL EC")=$G(RMBAEC(RMLOOP))
178 . S @RMAPI@("DX/PL",RMLOOP,"PL MST")=$G(RMBAMST(RMLOOP))
179 . S @RMAPI@("DX/PL",RMLOOP,"PL HNC")=$G(RMBAHNC(RMLOOP))
180 . S @RMAPI@("DX/PL",RMLOOP,"PL CV")=$G(RMBACBV(RMLOOP))
181 . I RMLOOP=1 D Q
182 . . S @RMAPI@("DX/PL",RMLOOP,"PRIMARY")=RMLOOP
183 . . S RMDIAG=$G(RMBAICD9(RMLOOP))
184 . . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=$G(RMBAICD9(RMLOOP))
185 . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS "_RMLOOP)=$G(RMBAICD9(RMLOOP)) ; only one procedure per send
186 ;
187 ; -----------------procedures----------------
188 S @RMAPI@("PROCEDURE",1,"PROCEDURE")=RMPROC
189 S @RMAPI@("PROCEDURE",1,"ORD PROVIDER")=RMPROV
190 S @RMAPI@("PROCEDURE",1,"EVENT D/T")=RMCPDT
191 ; ------------- Order Reference -------------
192 S @RMAPI@("PROCEDURE",1,"ORD REFERENCE")=RMODENT
193 ; -----------------Quantity------------------
194 S @RMAPI@("PROCEDURE",1,"QTY")=RMQTY
195 ; -----------------diagnosis-----------------
196 S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=RMDIAG
197 Q
198 ;
199SENDIT ; send the data to PCE. API (1891)
200 K RMPROB,RMPRTPCE,RMPCE
201 S (RMPRCPER,RMPROB,STOP)=0
202 D PRV^RMPRPCED
203 ; call the PCE package API.
204 I RMERR'<1 S RMERR=$$DATA2PCE^PXAPI($NA(^TMP("RMPRPCE1",$J,"PXAPI")),RMPKG,RMSRC,.RMPCE,RMUSER,0,,"",.RMPROB)
205 ;To check for returned error messages, list the RMPROB array.
206 I RMERR<1 W !,"File #660 IEN="_RMIE60_" - Error in PCE interface !!!"
207 ;delete PCE entry if Provider and CPT CODE error, but send an error
208 ;message to RMPR PCE mailgroup.
209 I $D(RMPROB($J)) D CHECK^RMPRPCED
210 I $G(RMPCE),$G(RMPRCPER) S RMPRTPCE=RJ_"^"_RMHLOC,RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"") Q
211 ;
212 Q:'$G(RMPCE)
213 ;update PCE pointer and date last sent in #660.
214 K RMUPD
215 S RMUPD(660,RMIE60_",",8.12)=RMPCE
216 S RMUPD(660,RMIE60_",",8.13)=RMDANOW
217 D FILE^DIE("","RMUPD","")
218 Q
219 ;
Note: See TracBrowser for help on using the repository browser.