source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDBA1.m@ 619

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

initial load of WorldVistAEHR
File size: 9.4 KB
Line 
1ORWDBA1 ;; SLC OIFO/DKK/GSS - Order Dialogs Billing Awareness;[10/21/03 3:16pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,229,215,243**;Dec 17, 1997;Build 242
3 ;
4 ; External References
5 ; DBIA 406 CL^SDCO21 - call to determine Treatment Factors
6 ;
7 ;Ref to ^DIC(9.4 - DBIA ___
8 ;BA refers to Billing Awareness Project
9 ;CIDC refers to Clinical Indicator Data Capture (same project 3/10/2004)
10 ;Treatment Factors (TxF) refer to SC,AO,IR,EC,MST,HNC,CV,SHD
11 ;
12GETORDX(Y,ORIEN) ; Retrieve Diagnoses for an order - RPC
13 ; Input:
14 ; ORIEN Order Internal ID#
15 ; Output:
16 ; Y Array of Diagnoses (Dx) - Y(#)=#^DxInt#^ICD9^DxDesc^TxF
17 ; Variables used:
18 ; CT Counter for # of Dx related to order
19 ; DXIEN Dx internal ID
20 ; DXN Internal (to ^OR(100)) sequence # for Dx storage
21 ; DXREC Dx record from Order file
22 ; DXV Dx description
23 ; ICD9 External ICD9 #
24 ; TXFACTRS Treatment Factors (TxF)
25 ;
26 N CT,DXIEN,DXN,DXREC,DXV,ICD9,ICDR,ORFMDAT,TXFACTRS
27 S (CT,DXN)=0
28 I '$G(^OR(100,ORIEN,0)) S Y=-1
29 I '$D(^OR(100,ORIEN,5.1,1,0)) S Y=0
30 E D S Y=CT
31 . ; Get order date for CSV/CTD/HIPAA usage
32 . S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
33 . ; Go through all Dx's for an order
34 . F S DXN=$O(^OR(100,ORIEN,5.1,DXN)) Q:DXN'?1N.N D
35 .. ; Get diagnosis record and IEN
36 .. S DXREC=$G(^OR(100,ORIEN,5.1,DXN,0)),DXIEN=$P(DXREC,U)
37 .. S ICDR=$$ICDDX^ICDCODE($G(DXIEN),ORFMDAT)
38 .. S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
39 .. ; Convert internal to external Treatment Factors
40 .. S TXFACTRS=$$TFGBLGUI(^OR(100,ORIEN,5.2))
41 .. S CT=CT+1,Y(CT)=DXN_U_$G(DXIEN)_U_ICD9_U_DXV_U_TXFACTRS
42 Q
43 ;
44SCLST(Y,DFN,ORLST) ; RPC for compiling appropriate TxF's
45 ; RPC titled ORWDBA1 SCLST
46 ;
47 ; Y = Returned value
48 ; DFN = Patient IEN
49 ; ORLST = List of orders
50 ;
51 ; call for BA/TF
52 N GMRCPROS,ORD,ORI,ORPKG
53 D CPLSTBA(.Y,DFN,.ORLST)
54 Q
55 ;
56CPLSTBA(TEST,PTIFN,ORIFNS) ; set-up SC/TFs for BA
57 ;
58 ; TEST = Returned value
59 ; PTIFN = Patient IEN
60 ; ORIFNS = List of orders
61 ;
62 S ORI=""
63 ;
64 ; define array of packages for which BA data collected (SC/CIs)
65 ; GMRC = Consult/Request Tracking (#128) - Prosthetics
66 ; LR = Lab Services (#26) - Lab
67 ; PSO = Outpt Pharmacy (#112) - Outpt Pharmacy (orig. Co-Pay)
68 ; RA = Radiology/Nuclear Medicine (#31) - Radiology
69 ;
70 S ORPKG(+$O(^DIC(9.4,"C","PSO",0)))=1
71 ; See ISWITCH^ORWDBA7 for insurance/Ed switch, i.e., $$CIDC^IBBAPI
72 ; Also check provider switch via 'OR BILLING AWARENESS BY USER'
73 I $$BASTAT&$$CIDC^IBBAPI(DFN)&$$GET^XPAR(DUZ_";VA(200,","OR BILLING AWARENESS BY USER",1,"Q") F I=1:1 S ORPKG=$P("GMRC;LR;RA",";",I) Q:ORPKG="" D
74 . S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=1 ; ^DIC(9.4) is package file
75 ;
76 ; get Treatment Factors (TxF) for patient
77 D SCPRE(.DR,DFN)
78 ;
79 ; set TxF's if order is for a package for which BA data is collected
80 F S ORI=$O(ORLST(ORI)) Q:'ORI S ORD=+ORLST(ORI) D
81 . I $G(^OR(100,ORD,0))="" Q
82 . I $P($G(^OR(100,ORD,0)),U,14)="" Q
83 . I $D(TEST(ORD))!'$D(ORPKG($P($G(^OR(100,ORD,0)),U,14))) Q
84 . I $E($P(ORIFNS(ORI),";",2))>1 Q ;canceled order (2) & ? (3)
85 . S TEST(ORD)=ORLST(ORI)_DR
86 Q
87 ;
88SCPRE(DR,DFN) ; Dialog validation, to ask BA questions
89 ;
90 ; DR = return value
91 ; DFN = input patient IEN
92 ;
93 Q:$G(DFN)=""
94 N CPNODE,CT,I,ORX,ORSDCARY,TF,X
95 K ORSDCARY
96 S (CPNODE,DR,ORX,TF)="",CT=0,X="T"
97 ; Call API to acquire Treatment Factors in force
98 D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY) ;DBIA 406
99 ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD e.g., ORSDCARY(3) for SC
100 ; Convert to ^OR/CPRS GUI order: SC,MST,AO,IR,EC,HNC,CV,SHD
101 F I=3,5,1,2,4,6,7,8 S TF=0,CT=CT+1 S:$D(ORSDCARY(I)) TF=1 S $P(CPNODE,U,CT)=TF
102 ;
103 S X=$S($P(CPNODE,U)=1:"SC",1:""),DR=$S($L(X):DR_U_X,1:DR)
104 S X=$S($P(CPNODE,U,2)=1:"MST",1:""),DR=$S($L(X):DR_U_X,1:DR)
105 S X=$S($P(CPNODE,U,3)=1:"AO",1:""),DR=$S($L(X):DR_U_X,1:DR)
106 S X=$S($P(CPNODE,U,4)=1:"IR",1:""),DR=$S($L(X):DR_U_X,1:DR)
107 S X=$S($P(CPNODE,U,5)=1:"EC",1:""),DR=$S($L(X):DR_U_X,1:DR)
108 S X=$S($P(CPNODE,U,6)=1:"HNC",1:""),DR=$S($L(X):DR_U_X,1:DR)
109 S X=$S($P(CPNODE,U,7)=1:"CV",1:""),DR=$S($L(X):DR_U_X,1:DR)
110 S X=$S($P(CPNODE,U,8)=1:"SHD",1:""),DR=$S($L(X):DR_U_X,1:DR)
111 ;
112 ; TxF's for patient (TxF's include SC,AO,IR,EC,MST,HNC,CV,SHD) where
113 ; SC = Service Connected
114 ; AO = Agent Orange
115 ; IR = Ionizing Radiation
116 ; EC = Environmental Contaminants
117 ; MST = Military Sexual Trauma
118 ; HNC = Head and Neck Cancer
119 ; CV = Combat Veteran
120 ; SHD = Shipboard Disability
121 F I="SC","AO","IR","EC","MST","HNC","CV","SHD" D
122 . I $D(ORX(I)) S DR=DR_U_I_$S($L(ORX(I)):";"_ORX(I),1:"")
123 Q
124 ;
125ORPKGTYP(Y,ORLST) ; Build BA supported packages array
126 ; GMRC=Prosthetics, LR=Lab, PSO=Pharmacy, RA=Radiology
127 N OIREC,OIV,OIVN
128 ;
129 F I=1:1 S ORPKG=$P("GMRC;LR;PSO;RA",";",I) Q:ORPKG="" D
130 . S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=ORPKG ; ^DIC(9.4) is package file
131 ;
132 S GMRCPROS=+$O(^DIC(9.4,"C","GMRC",0))
133 ; see if order is for a package which BA supports
134 D ORPKG1(.Y,.ORLST)
135 Q
136 ;
137ORPKG1(TEST,ORIFNS) ; Order for package BA supports? TEST(ORI)=1 is YES
138 S U="^",ORI=""
139 F I=1:1:5 S OIV(I)=$P("PROSTHETICS REQUEST^EYEGLASS REQUEST^CONTACT LENS REQUEST^HOME OXYGEN REQUEST^AMPUTEE/PROSTHETICS CLINIC",U,I)
140 F S ORI=$O(ORIFNS(ORI)) Q:'ORI S ORD=+ORIFNS(ORI),TEST(ORI)=0 D
141 . I ORD=0 Q ;document/note not an order
142 . ;I ORD="CONSULT_DX" S TEST(ORI)=1 Q ;consult dx prev entered
143 . I '$D(^OR(100,ORD,0)) Q ;invalid order #
144 . I $P(^OR(100,ORD,0),U,14)'?1N.N Q ;invalid order # or entry
145 . I $E($P(ORIFNS(ORI),";",2))>1 Q ;canceled order (2) & ? (3)
146 . I $D(^OR(100,ORD,5.1,1,0)) S TEST(ORI)=1 Q ;
147 . I '$D(ORPKG($P(^OR(100,ORD,0),U,14))) Q ;pkg not supported
148 . ; IPt OPt (ask BA questions?)
149 . ; Pros Y Y GMRC
150 . ; Rad Y Y RA
151 . ; Lab N Y LR
152 . ; Phrm Y Y PSO
153 . ; Pt Class = 'I' or 'O' in ^OR
154 . I $P(^OR(100,ORD,0),U,12)="I"&(ORPKG($P(^OR(100,ORD,0),U,14))="LR") Q
155 . I $P(^OR(100,ORD,0),U,14)=GMRCPROS D Q ;check for Pros consult order
156 .. S OIREC=$G(^ORD(101.43,$G(^OR(100,ORD,4.5,1,1)),0)),OIVN=""
157 .. F S OIVN=$O(OIV(OIVN)) Q:OIVN="" I OIV(OIVN)=$E($P(OIREC,U),1,$L(OIV(OIVN))) S TEST(ORI)=1 Q
158 . S TEST(ORI)=1 ;order is for a supported pkg (also note Pros ck above)
159 Q
160 ;
161BASTATUS(Y) ;RPC to retrieve the status of the Billing Awareness software
162 ; Y = Returned Value (1=BA usable, 0=BA not-usable)
163 ; Check for installation of CIDC ancillary build
164 S Y=$D(^XPD(9.7,"B","PX CLINICAL INDICATOR DATA CAPTURE 1.0"))
165 Q:'Y
166 ; Check if system parameter switch set
167 S Y=$$CHKPS1^ORWDBA5
168 Q
169 ;
170BASTAT() ; Internal version of BASTATUS
171 ; Returns 0 if disabled or 1 if enabled
172 Q $$CHKPS1^ORWDBA5
173 ;
174RCVORCI(Y,DIAG) ;Receive order related Clinical Indicators & Diagnoses from GUI
175 ; Store data in ^OR(100,ODN,5.1) & ^OR(100,0DN,5.2)
176 ;
177 N DXIEN,ODN,ORIEN,SCI,OCDXCT,OCT
178 S ODN="",OCDXCT=0,Y=""
179 F S ODN=$O(DIAG(ODN)) Q:ODN="" D
180 . S ORIEN=$P(DIAG(ODN),";",1) ;Order IEN
181 . I ORIEN'?1N.N S Y=0 Q
182 . K ^OR(100,ORIEN,5.1) ;Clear currently stored diagnosis for rewrite
183 . ; Data from Delphi format: ORIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
184 . ; Convert 8 Tx Factors
185 . S SCI=$$TFGUIGBL($RE($E($RE($P(DIAG(ODN),U)),1,8)))
186 . S ^OR(100,ORIEN,5.2)=SCI ;Store TFs (SC,MST,AO,IR,EC,HNC,CV,SHD)
187 . ; Get order date for CSV/CTD/HIPAA
188 . S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
189 . ; Go through the diagnoses entered
190 . F OCT=2:1 Q:$P(DIAG(ODN),U,OCT)="" D
191 .. S DXIEN=$P($$ICDDX^ICDCODE($P(DIAG(ODN),U,OCT),ORFMDAT),U,1) ;Dx IEN
192 .. I DXIEN=-1!(DXIEN="") Q ;No or invalid code passed in
193 .. S OCDXCT=OCDXCT+1
194 .. S ^OR(100,ORIEN,5.1,0)="^100.051PA^"_OCDXCT_U_OCDXCT ;Set 5.1 zero node
195 .. S ^OR(100,ORIEN,5.1,OCDXCT,0)=DXIEN ;Store a diagnosis for order
196 .. S ^OR(100,ORIEN,5.1,"B",DXIEN,OCDXCT)="" ;Index diagnosis for order
197 S:Y="" Y=1
198 Q
199 ;
200TFSTGS ; Set Treatment Factor strings sequence order
201 ; TFGBL is order of TxFs in ^OR(100,ORIEN,5) & ^OR(100,ORIEN,5.2)
202 ; TFGUI is order of TxFs to/from GUI
203 ; TFTBL is order of TxFs for table SD008 (used in ZCL segment)
204 ; NOTE: change examples in TFGUIGBL and TFGBLGUI if order changed
205 S TFGBL="SC^MST^AO^IR^EC^HNC^CV^SHD"
206 S TFGUI="SC^AO^IR^EC^MST^HNC^CV^SHD"
207 S TFTBL="AO^IR^SC^EC^MST^HNC^CV^SHD"
208 Q
209 ;
210TFGUIGBL(GUI) ;Convert Treatment Factors from GUI to Global order & format
211 ;
212 ; Input: GUI in CNU?NCU: C=checked, N=not checked, U=unchecked
213 ; Output: GBL in 1^^^0^?^1^0^ (global) format (reordered for storage)
214 ;
215 N GBL,J,NTF,TF,TFGBL,TFGUI,TFTBL
216 S GBL="",NTF=8 ;NTF=# of Treatment Factors (TxF)
217 ;I $L(GUI)'=NTF Q -1 ;invalid # of TxF
218 ; Get Treatment Factor sequence order strings
219 D TFSTGS
220 ; Convert from GBL to GUI format and sequence
221 F J=1:1:NTF S TF=$E(GUI,J) D
222 . S TF($P(TFGUI,U,J))=$S(TF="C":1,TF="U":0,TF="?":"?",1:"")
223 F J=1:1:NTF S GBL=GBL_U_TF($P(TFGBL,U,J))
224 Q $P(GBL,U,2,NTF+1)
225 ;
226TFGBLGUI(GBL) ;Convert Treatment Factors from Global to GUI order & format
227 ;
228 ; Input: GBL in 1^0^1^1^^0^?^ (global) format
229 ; Output: GUI in CCCNUU? (GUI) format (also reordered)
230 ;
231 N GUI,J,NTF,TF,TFGBL,TFGUI,TFTBL
232 S GUI="",NTF=8 ;NCI=# of TxF
233 ; Get Treatment Factor sequence order strings
234 D TFSTGS
235 ; Convert from GUI to GBL format and sequence
236 F J=1:1:NTF S TF=$P(GBL,U,J) D
237 . S TF($P(TFGBL,U,J))=$S(TF=1:"C",TF=0:"U",TF="?":"?",1:"N")
238 F J=1:1:NTF S GUI=GUI_TF($P(TFGUI,U,J))
239 Q GUI
240 ;
241PRVKEY(X) ;Check for active & provider key - to be deleted in CPRS v26
242 N PTD
243 Q:'+$G(X) 0
244 Q:$G(^VA(200,X,0))="" 0
245 S PTD=+$P(^VA(200,X,0),"^",11)
246 I $$DT^XLFDT'<PTD,PTD>0 Q 0
247 Q:$D(^XUSEC("PROVIDER",X)) 1
248 Q 0
249 ;
250ORESKEY(X) ;Does 'X' hold ORES key, returns: 1=true, 0=false
251 Q:'+$G(X) 0
252 Q:$D(^XUSEC("ORES",X)) 1
253 Q 0
Note: See TracBrowser for help on using the repository browser.