- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDBA1.m
r613 r623 1 ORWDBA1 ;; 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 ; 12 GETORDX(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 ; 44 SCLST(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 ; 56 CPLSTBA(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 ; 88 SCPRE(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 ; 125 ORPKGTYP(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 ; 137 ORPKG1(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 ; 161 BASTATUS(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 ; 170 BASTAT() ; Internal version of BASTATUS 171 ; Returns 0 if disabled or 1 if enabled 172 Q $$CHKPS1^ORWDBA5 173 ; 174 RCVORCI(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 ; 200 TFSTGS ; 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 ; 210 TFGUIGBL(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 ; 226 TFGBLGUI(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 ; 241 PRVKEY(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 ; 250 ORESKEY(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 1 ORWDBA1 ;; SLC OIFO/DKK/GSS - Order Dialogs Billing Awareness;[10/21/03 3:16pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,229,215**;Dec 17, 1997 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 11 ; 12 GETORDX(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 ; 44 SCLST(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 ; 56 CPLSTBA(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 F I=1:1 S ORPKG=$P("GMRC;LR;PSO;RA",";",I) Q:ORPKG="" D 71 . S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=1 ; ^DIC(9.4) is package file 72 ; 73 ; get Treatment Factors (TxF) for patient 74 D SCPRE(.DR,DFN) 75 ; 76 ; set TxF's if order is for a package for which BA data is collected 77 F S ORI=$O(ORLST(ORI)) Q:'ORI S ORD=+ORLST(ORI) D 78 . I $G(^OR(100,ORD,0))="" Q 79 . I $D(TEST(ORD))!'$D(ORPKG($P($G(^OR(100,ORD,0)),U,14))) Q 80 . S TEST(ORD)=ORLST(ORI)_DR 81 Q 82 ; 83 SCPRE(DR,DFN) ; Dialog validation, to ask BA questions 84 ; 85 ; DR = return value 86 ; DFN = input patient IEN 87 ; 88 Q:$G(DFN)="" 89 N CPNODE,CT,I,ORX,ORSDCARY,TF,X 90 K ORSDCARY 91 S (CPNODE,DR,ORX,TF)="",CT=0,X="T" 92 ; Call API to acquire Treatment Factors in force 93 D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY) ;DBIA 406 94 ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV, e.g., ORSDCARY(3) for SC 95 ; Convert to ^OR/CPRS GUI order: SC,MST,AO,IR,EC,HNC,CV 96 F I=3,5,1,2,4,6,7 S TF=0,CT=CT+1 S:$D(ORSDCARY(I)) TF=1 S $P(CPNODE,U,CT)=TF 97 ; 98 S X=$S($P(CPNODE,U)=1:"SC",1:""),DR=$S($L(X):DR_U_X,1:DR) 99 S X=$S($P(CPNODE,U,2)=1:"MST",1:""),DR=$S($L(X):DR_U_X,1:DR) 100 S X=$S($P(CPNODE,U,3)=1:"AO",1:""),DR=$S($L(X):DR_U_X,1:DR) 101 S X=$S($P(CPNODE,U,4)=1:"IR",1:""),DR=$S($L(X):DR_U_X,1:DR) 102 S X=$S($P(CPNODE,U,5)=1:"EC",1:""),DR=$S($L(X):DR_U_X,1:DR) 103 S X=$S($P(CPNODE,U,6)=1:"HNC",1:""),DR=$S($L(X):DR_U_X,1:DR) 104 S X=$S($P(CPNODE,U,7)=1:"CV",1:""),DR=$S($L(X):DR_U_X,1:DR) 105 ; 106 ; TxF's for patient (TxF's include SC,AO,IR,EC,MST,HNC,CV) where 107 ; SC = Service Connected 108 ; AO = Agent Orange 109 ; IR = Ionizing Radiation 110 ; EC = Environmental Contaminants 111 ; MST = Military Sexual Trauma 112 ; HNC = Head and Neck Cancer 113 ; CV = Combat Veteran 114 F I="SC","AO","IR","EC","MST","HNC","CV" D 115 . I $D(ORX(I)) S DR=DR_U_I_$S($L(ORX(I)):";"_ORX(I),1:"") 116 Q 117 ; 118 ORPKGTYP(Y,ORLST) ; Build BA supported packages array 119 ; GMRC=Prosthetics, LR=Lab, PSO=Pharmacy, RA=Radiology 120 N OIREC,OIV,OIVN 121 F I=1:1 S ORPKG=$P("GMRC;LR;PSO;RA",";",I) Q:ORPKG="" D 122 . S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=ORPKG ; ^DIC(9.4) is package file 123 S GMRCPROS=+$O(^DIC(9.4,"C","GMRC",0)) 124 ; see if order is for a package which BA supports 125 D ORPKG1(.Y,.ORLST) 126 Q 127 ; 128 ORPKG1(TEST,ORIFNS) ; Order for package BA supports? TEST(ORI)=1 is YES 129 S U="^",ORI="" 130 F I=1:1:5 S OIV(I)=$P("PROSTHETICS REQUEST^EYEGLASS REQUEST^CONTACT LENS REQUEST^HOME OXYGEN REQUEST^AMPUTEE/PROSTHETICS CLINIC",U,I) 131 F S ORI=$O(ORIFNS(ORI)) Q:'ORI S ORD=+ORIFNS(ORI),TEST(ORI)=0 D 132 . I ORD=0 Q ;document/note not an order 133 . ;I ORD="CONSULT_DX" S TEST(ORI)=1 Q ;consult dx prev entered 134 . I '$D(^OR(100,ORD,0)) Q ;invalid order # 135 . I $P(^OR(100,ORD,0),U,14)'?1N.N Q ;invalid order # or entry 136 . I $E($P(ORIFNS(ORI),";",2))>1 Q ;canceled order (2) & ? (3) 137 . I $D(^OR(100,ORD,5.1,1,0)) S TEST(ORI)=1 Q ; 138 . I '$D(ORPKG($P(^OR(100,ORD,0),U,14))) Q ;pkg not supported 139 . ; IPt OPt (ask BA questions?) 140 . ; Pros Y Y GMRC 141 . ; Rad Y Y RA 142 . ; Lab N Y LR 143 . ; Phrm Y Y PSO 144 . ; Pt Class = 'I' or 'O' in ^OR 145 . I $P(^OR(100,ORD,0),U,12)="I"&(ORPKG($P(^OR(100,ORD,0),U,14))="LR") Q 146 . I $P(^OR(100,ORD,0),U,14)=GMRCPROS D Q ;check for Pros consult order 147 .. S OIREC=$G(^ORD(101.43,$G(^OR(100,ORD,4.5,1,1)),0)),OIVN="" 148 .. F S OIVN=$O(OIV(OIVN)) Q:OIVN="" I OIV(OIVN)=$E($P(OIREC,U),1,$L(OIV(OIVN))) S TEST(ORI)=1 Q 149 . S TEST(ORI)=1 ;order is for a supported pkg (also note Pros ck above) 150 Q 151 ; 152 BASTATUS(Y) ;RPC to retrieve the status of the Billing Awareness software 153 ; Y = Returned Value (1=BA usable, 0=BA not-usable) 154 ; Check for installation of CIDC ancillary build 155 S Y=$D(^XPD(9.7,"B","PX CLINICAL INDICATOR DATA CAPTURE 1.0")) 156 Q:'Y 157 ; Check if system parameter switch set 158 S Y=$$CHKPS1^ORWDBA5 159 Q 160 ; 161 BASTAT() ; Internal version of BASTATUS 162 ; Returns 0 if disabled or 1 if enabled 163 Q $$CHKPS1^ORWDBA5 164 ; 165 RCVORCI(Y,DIAG) ;Receive order related Clinical Indicators & Diagnoses from GUI 166 ; Store data in ^OR(100,ODN,5.1) & ^OR(100,0DN,5.2) 167 ; 168 N DXIEN,ODN,ORIEN,SCI,OCDXCT,OCT 169 S ODN="",OCDXCT=0,Y="" 170 F S ODN=$O(DIAG(ODN)) Q:ODN="" D 171 . S ORIEN=$P(DIAG(ODN),";",1) ;Order IEN 172 . I ORIEN'?1N.N S Y=0 Q 173 . K ^OR(100,ORIEN,5.1) ;Clear currently stored diagnosis for rewrite 174 . ; Data from Delphi format: ORIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4 175 . ; Convert 7 Tx Factors 176 . S SCI=$$TFGUIGBL($RE($E($RE($P(DIAG(ODN),U)),1,7))) 177 . S ^OR(100,ORIEN,5.2)=SCI ;Store TFs (SC,MST,AO,IR,EC..) 178 . ; Get order date for CSV/CTD/HIPAA 179 . S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN) 180 . ; Go through the diagnoses entered 181 . F OCT=2:1 Q:$P(DIAG(ODN),U,OCT)="" D 182 .. S DXIEN=$P($$ICDDX^ICDCODE($P(DIAG(ODN),U,OCT),ORFMDAT),U,1) ;Dx IEN 183 .. I DXIEN=-1!(DXIEN="") Q ;No or invalid code passed in 184 .. S OCDXCT=OCDXCT+1 185 .. S ^OR(100,ORIEN,5.1,0)="^100.051PA^"_OCDXCT_U_OCDXCT ;Set 5.1 zero node 186 .. S ^OR(100,ORIEN,5.1,OCDXCT,0)=DXIEN ;Store a diagnosis for order 187 .. S ^OR(100,ORIEN,5.1,"B",DXIEN,OCDXCT)="" ;Index diagnosis for order 188 S:Y="" Y=1 189 Q 190 ; 191 TFSTGS ; Set Treatment Factor strings sequence order 192 ; TFGBL is order of TxFs in ^OR(100,ORIEN,5) & ^OR(100,ORIEN,5.2) 193 ; TFGUI is order of TxFs to/from GUI 194 ; TFTBL is order of TxFs for table SD008 (used in ZCL segment) 195 ; NOTE: change examples in TFGUIGBL and TFGBLGUI if order changed 196 S TFGBL="SC^MST^AO^IR^EC^HNC^CV" 197 S TFGUI="SC^AO^IR^EC^MST^HNC^CV" 198 S TFTBL="AO^IR^SC^EC^MST^HNC^CV" 199 Q 200 ; 201 TFGUIGBL(GUI) ;Convert Treatment Factors from GUI to Global order & format 202 ; 203 ; Input: GUI in CNU?NCU: C=checked, N=not checked, U=unchecked 204 ; Output: GBL in 1^^^0^?^1^0 (global) format (reordered for storage) 205 ; 206 N GBL,J,NTF,TF,TFGBL,TFGUI,TFTBL 207 S GBL="",NTF=7 ;NTF=# of Treatment Factors (TxF) 208 ;I $L(GUI)'=NTF Q -1 ;invalid # of TxF 209 ; Get Treatment Factor sequence order strings 210 D TFSTGS 211 ; Convert from GBL to GUI format and sequence 212 F J=1:1:NTF S TF=$E(GUI,J) D 213 . S TF($P(TFGUI,U,J))=$S(TF="C":1,TF="U":0,TF="?":"?",1:"") 214 F J=1:1:NTF S GBL=GBL_U_TF($P(TFGBL,U,J)) 215 Q $P(GBL,U,2,NTF+1) 216 ; 217 TFGBLGUI(GBL) ;Convert Treatment Factors from Global to GUI order & format 218 ; 219 ; Input: GBL in 1^0^1^1^^0^? (global) format 220 ; Output: GUI in CCCNUU? (GUI) format (also reordered) 221 ; 222 N GUI,J,NTF,TF,TFGBL,TFGUI,TFTBL 223 S GUI="",NTF=7 ;NCI=# of TxF 224 ; Get Treatment Factor sequence order strings 225 D TFSTGS 226 ; Convert from GUI to GBL format and sequence 227 F J=1:1:NTF S TF=$P(GBL,U,J) D 228 . S TF($P(TFGBL,U,J))=$S(TF=1:"C",TF=0:"U",TF="?":"?",1:"N") 229 F J=1:1:NTF S GUI=GUI_TF($P(TFGUI,U,J)) 230 Q GUI 231 ; 232 PRVKEY(X) ;Check for active & provider key - to be deleted in CPRS v26 233 N PTD 234 Q:'+$G(X) 0 235 Q:$G(^VA(200,X,0))="" 0 236 S PTD=+$P(^VA(200,X,0),"^",11) 237 I $$DT^XLFDT'<PTD,PTD>0 Q 0 238 Q:$D(^XUSEC("PROVIDER",X)) 1 239 Q 0 240 ; 241 ORESKEY(X) ;Does 'X' hold ORES key, returns: 1=true, 0=false 242 Q:'+$G(X) 0 243 Q:$D(^XUSEC("ORES",X)) 1 244 Q 0
Note:
See TracChangeset
for help on using the changeset viewer.
