ORWDBA1 ;; SLC OIFO/DKK/GSS - Order Dialogs Billing Awareness;[10/21/03 3:16pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,229,215,243**;Dec 17, 1997;Build 242
;
; External References
; DBIA 406 CL^SDCO21 - call to determine Treatment Factors
;
;Ref to ^DIC(9.4 - DBIA ___
;BA refers to Billing Awareness Project
;CIDC refers to Clinical Indicator Data Capture (same project 3/10/2004)
;Treatment Factors (TxF) refer to SC,AO,IR,EC,MST,HNC,CV,SHD
;
GETORDX(Y,ORIEN) ; Retrieve Diagnoses for an order - RPC
; Input:
; ORIEN Order Internal ID#
; Output:
; Y Array of Diagnoses (Dx) - Y(#)=#^DxInt#^ICD9^DxDesc^TxF
; Variables used:
; CT Counter for # of Dx related to order
; DXIEN Dx internal ID
; DXN Internal (to ^OR(100)) sequence # for Dx storage
; DXREC Dx record from Order file
; DXV Dx description
; ICD9 External ICD9 #
; TXFACTRS Treatment Factors (TxF)
;
N CT,DXIEN,DXN,DXREC,DXV,ICD9,ICDR,ORFMDAT,TXFACTRS
S (CT,DXN)=0
I '$G(^OR(100,ORIEN,0)) S Y=-1
I '$D(^OR(100,ORIEN,5.1,1,0)) S Y=0
E D S Y=CT
. ; Get order date for CSV/CTD/HIPAA usage
. S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
. ; Go through all Dx's for an order
. F S DXN=$O(^OR(100,ORIEN,5.1,DXN)) Q:DXN'?1N.N D
.. ; Get diagnosis record and IEN
.. S DXREC=$G(^OR(100,ORIEN,5.1,DXN,0)),DXIEN=$P(DXREC,U)
.. S ICDR=$$ICDDX^ICDCODE($G(DXIEN),ORFMDAT)
.. S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
.. ; Convert internal to external Treatment Factors
.. S TXFACTRS=$$TFGBLGUI(^OR(100,ORIEN,5.2))
.. S CT=CT+1,Y(CT)=DXN_U_$G(DXIEN)_U_ICD9_U_DXV_U_TXFACTRS
Q
;
SCLST(Y,DFN,ORLST) ; RPC for compiling appropriate TxF's
; RPC titled ORWDBA1 SCLST
;
; Y = Returned value
; DFN = Patient IEN
; ORLST = List of orders
;
; call for BA/TF
N GMRCPROS,ORD,ORI,ORPKG
D CPLSTBA(.Y,DFN,.ORLST)
Q
;
CPLSTBA(TEST,PTIFN,ORIFNS) ; set-up SC/TFs for BA
;
; TEST = Returned value
; PTIFN = Patient IEN
; ORIFNS = List of orders
;
S ORI=""
;
; define array of packages for which BA data collected (SC/CIs)
; GMRC = Consult/Request Tracking (#128) - Prosthetics
; LR = Lab Services (#26) - Lab
; PSO = Outpt Pharmacy (#112) - Outpt Pharmacy (orig. Co-Pay)
; RA = Radiology/Nuclear Medicine (#31) - Radiology
;
S ORPKG(+$O(^DIC(9.4,"C","PSO",0)))=1
; See ISWITCH^ORWDBA7 for insurance/Ed switch, i.e., $$CIDC^IBBAPI
; Also check provider switch via 'OR BILLING AWARENESS BY USER'
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
. S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=1 ; ^DIC(9.4) is package file
;
; get Treatment Factors (TxF) for patient
D SCPRE(.DR,DFN)
;
; set TxF's if order is for a package for which BA data is collected
F S ORI=$O(ORLST(ORI)) Q:'ORI S ORD=+ORLST(ORI) D
. I $G(^OR(100,ORD,0))="" Q
. I $P($G(^OR(100,ORD,0)),U,14)="" Q
. I $D(TEST(ORD))!'$D(ORPKG($P($G(^OR(100,ORD,0)),U,14))) Q
. I $E($P(ORIFNS(ORI),";",2))>1 Q ;canceled order (2) & ? (3)
. S TEST(ORD)=ORLST(ORI)_DR
Q
;
SCPRE(DR,DFN) ; Dialog validation, to ask BA questions
;
; DR = return value
; DFN = input patient IEN
;
Q:$G(DFN)=""
N CPNODE,CT,I,ORX,ORSDCARY,TF,X
K ORSDCARY
S (CPNODE,DR,ORX,TF)="",CT=0,X="T"
; Call API to acquire Treatment Factors in force
D NOW^%DTC,CL^SDCO21(DFN,%,"",.ORSDCARY) ;DBIA 406
; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD e.g., ORSDCARY(3) for SC
; Convert to ^OR/CPRS GUI order: SC,MST,AO,IR,EC,HNC,CV,SHD
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
;
S X=$S($P(CPNODE,U)=1:"SC",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,2)=1:"MST",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,3)=1:"AO",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,4)=1:"IR",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,5)=1:"EC",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,6)=1:"HNC",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,7)=1:"CV",1:""),DR=$S($L(X):DR_U_X,1:DR)
S X=$S($P(CPNODE,U,8)=1:"SHD",1:""),DR=$S($L(X):DR_U_X,1:DR)
;
; TxF's for patient (TxF's include SC,AO,IR,EC,MST,HNC,CV,SHD) where
; SC = Service Connected
; AO = Agent Orange
; IR = Ionizing Radiation
; EC = Environmental Contaminants
; MST = Military Sexual Trauma
; HNC = Head and Neck Cancer
; CV = Combat Veteran
; SHD = Shipboard Disability
F I="SC","AO","IR","EC","MST","HNC","CV","SHD" D
. I $D(ORX(I)) S DR=DR_U_I_$S($L(ORX(I)):";"_ORX(I),1:"")
Q
;
ORPKGTYP(Y,ORLST) ; Build BA supported packages array
; GMRC=Prosthetics, LR=Lab, PSO=Pharmacy, RA=Radiology
N OIREC,OIV,OIVN
;
F I=1:1 S ORPKG=$P("GMRC;LR;PSO;RA",";",I) Q:ORPKG="" D
. S ORPKG(+$O(^DIC(9.4,"C",ORPKG,0)))=ORPKG ; ^DIC(9.4) is package file
;
S GMRCPROS=+$O(^DIC(9.4,"C","GMRC",0))
; see if order is for a package which BA supports
D ORPKG1(.Y,.ORLST)
Q
;
ORPKG1(TEST,ORIFNS) ; Order for package BA supports? TEST(ORI)=1 is YES
S U="^",ORI=""
F I=1:1:5 S OIV(I)=$P("PROSTHETICS REQUEST^EYEGLASS REQUEST^CONTACT LENS REQUEST^HOME OXYGEN REQUEST^AMPUTEE/PROSTHETICS CLINIC",U,I)
F S ORI=$O(ORIFNS(ORI)) Q:'ORI S ORD=+ORIFNS(ORI),TEST(ORI)=0 D
. I ORD=0 Q ;document/note not an order
. ;I ORD="CONSULT_DX" S TEST(ORI)=1 Q ;consult dx prev entered
. I '$D(^OR(100,ORD,0)) Q ;invalid order #
. I $P(^OR(100,ORD,0),U,14)'?1N.N Q ;invalid order # or entry
. I $E($P(ORIFNS(ORI),";",2))>1 Q ;canceled order (2) & ? (3)
. I $D(^OR(100,ORD,5.1,1,0)) S TEST(ORI)=1 Q ;
. I '$D(ORPKG($P(^OR(100,ORD,0),U,14))) Q ;pkg not supported
. ; IPt OPt (ask BA questions?)
. ; Pros Y Y GMRC
. ; Rad Y Y RA
. ; Lab N Y LR
. ; Phrm Y Y PSO
. ; Pt Class = 'I' or 'O' in ^OR
. I $P(^OR(100,ORD,0),U,12)="I"&(ORPKG($P(^OR(100,ORD,0),U,14))="LR") Q
. I $P(^OR(100,ORD,0),U,14)=GMRCPROS D Q ;check for Pros consult order
.. S OIREC=$G(^ORD(101.43,$G(^OR(100,ORD,4.5,1,1)),0)),OIVN=""
.. F S OIVN=$O(OIV(OIVN)) Q:OIVN="" I OIV(OIVN)=$E($P(OIREC,U),1,$L(OIV(OIVN))) S TEST(ORI)=1 Q
. S TEST(ORI)=1 ;order is for a supported pkg (also note Pros ck above)
Q
;
BASTATUS(Y) ;RPC to retrieve the status of the Billing Awareness software
; Y = Returned Value (1=BA usable, 0=BA not-usable)
; Check for installation of CIDC ancillary build
S Y=$D(^XPD(9.7,"B","PX CLINICAL INDICATOR DATA CAPTURE 1.0"))
Q:'Y
; Check if system parameter switch set
S Y=$$CHKPS1^ORWDBA5
Q
;
BASTAT() ; Internal version of BASTATUS
; Returns 0 if disabled or 1 if enabled
Q $$CHKPS1^ORWDBA5
;
RCVORCI(Y,DIAG) ;Receive order related Clinical Indicators & Diagnoses from GUI
; Store data in ^OR(100,ODN,5.1) & ^OR(100,0DN,5.2)
;
N DXIEN,ODN,ORIEN,SCI,OCDXCT,OCT
S ODN="",OCDXCT=0,Y=""
F S ODN=$O(DIAG(ODN)) Q:ODN="" D
. S ORIEN=$P(DIAG(ODN),";",1) ;Order IEN
. I ORIEN'?1N.N S Y=0 Q
. K ^OR(100,ORIEN,5.1) ;Clear currently stored diagnosis for rewrite
. ; Data from Delphi format: ORIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
. ; Convert 8 Tx Factors
. S SCI=$$TFGUIGBL($RE($E($RE($P(DIAG(ODN),U)),1,8)))
. S ^OR(100,ORIEN,5.2)=SCI ;Store TFs (SC,MST,AO,IR,EC,HNC,CV,SHD)
. ; Get order date for CSV/CTD/HIPAA
. S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
. ; Go through the diagnoses entered
. F OCT=2:1 Q:$P(DIAG(ODN),U,OCT)="" D
.. S DXIEN=$P($$ICDDX^ICDCODE($P(DIAG(ODN),U,OCT),ORFMDAT),U,1) ;Dx IEN
.. I DXIEN=-1!(DXIEN="") Q ;No or invalid code passed in
.. S OCDXCT=OCDXCT+1
.. S ^OR(100,ORIEN,5.1,0)="^100.051PA^"_OCDXCT_U_OCDXCT ;Set 5.1 zero node
.. S ^OR(100,ORIEN,5.1,OCDXCT,0)=DXIEN ;Store a diagnosis for order
.. S ^OR(100,ORIEN,5.1,"B",DXIEN,OCDXCT)="" ;Index diagnosis for order
S:Y="" Y=1
Q
;
TFSTGS ; Set Treatment Factor strings sequence order
; TFGBL is order of TxFs in ^OR(100,ORIEN,5) & ^OR(100,ORIEN,5.2)
; TFGUI is order of TxFs to/from GUI
; TFTBL is order of TxFs for table SD008 (used in ZCL segment)
; NOTE: change examples in TFGUIGBL and TFGBLGUI if order changed
S TFGBL="SC^MST^AO^IR^EC^HNC^CV^SHD"
S TFGUI="SC^AO^IR^EC^MST^HNC^CV^SHD"
S TFTBL="AO^IR^SC^EC^MST^HNC^CV^SHD"
Q
;
TFGUIGBL(GUI) ;Convert Treatment Factors from GUI to Global order & format
;
; Input: GUI in CNU?NCU: C=checked, N=not checked, U=unchecked
; Output: GBL in 1^^^0^?^1^0^ (global) format (reordered for storage)
;
N GBL,J,NTF,TF,TFGBL,TFGUI,TFTBL
S GBL="",NTF=8 ;NTF=# of Treatment Factors (TxF)
;I $L(GUI)'=NTF Q -1 ;invalid # of TxF
; Get Treatment Factor sequence order strings
D TFSTGS
; Convert from GBL to GUI format and sequence
F J=1:1:NTF S TF=$E(GUI,J) D
. S TF($P(TFGUI,U,J))=$S(TF="C":1,TF="U":0,TF="?":"?",1:"")
F J=1:1:NTF S GBL=GBL_U_TF($P(TFGBL,U,J))
Q $P(GBL,U,2,NTF+1)
;
TFGBLGUI(GBL) ;Convert Treatment Factors from Global to GUI order & format
;
; Input: GBL in 1^0^1^1^^0^?^ (global) format
; Output: GUI in CCCNUU? (GUI) format (also reordered)
;
N GUI,J,NTF,TF,TFGBL,TFGUI,TFTBL
S GUI="",NTF=8 ;NCI=# of TxF
; Get Treatment Factor sequence order strings
D TFSTGS
; Convert from GUI to GBL format and sequence
F J=1:1:NTF S TF=$P(GBL,U,J) D
. S TF($P(TFGBL,U,J))=$S(TF=1:"C",TF=0:"U",TF="?":"?",1:"N")
F J=1:1:NTF S GUI=GUI_TF($P(TFGUI,U,J))
Q GUI
;
PRVKEY(X) ;Check for active & provider key - to be deleted in CPRS v26
N PTD
Q:'+$G(X) 0
Q:$G(^VA(200,X,0))="" 0
S PTD=+$P(^VA(200,X,0),"^",11)
I $$DT^XLFDT'<PTD,PTD>0 Q 0
Q:$D(^XUSEC("PROVIDER",X)) 1
Q 0
;
ORESKEY(X) ;Does 'X' hold ORES key, returns: 1=true, 0=false
Q:'+$G(X) 0
Q:$D(^XUSEC("ORES",X)) 1
Q 0
ORWDBA1 ;; SLC OIFO/DKK/GSS - Order Dialogs Billing Awareness;[10/21/03 3:16pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,229,215,243**;Dec 17, 1997;Build 242
+2 ;
+3 ; External References
+4 ; DBIA 406 CL^SDCO21 - call to determine Treatment Factors
+5 ;
+6 ;Ref to ^DIC(9.4 - DBIA ___
+7 ;BA refers to Billing Awareness Project
+8 ;CIDC refers to Clinical Indicator Data Capture (same project 3/10/2004)
+9 ;Treatment Factors (TxF) refer to SC,AO,IR,EC,MST,HNC,CV,SHD
+10 ;
GETORDX(Y,ORIEN) ; Retrieve Diagnoses for an order - RPC
+1 ; Input:
+2 ; ORIEN Order Internal ID#
+3 ; Output:
+4 ; Y Array of Diagnoses (Dx) - Y(#)=#^DxInt#^ICD9^DxDesc^TxF
+5 ; Variables used:
+6 ; CT Counter for # of Dx related to order
+7 ; DXIEN Dx internal ID
+8 ; DXN Internal (to ^OR(100)) sequence # for Dx storage
+9 ; DXREC Dx record from Order file
+10 ; DXV Dx description
+11 ; ICD9 External ICD9 #
+12 ; TXFACTRS Treatment Factors (TxF)
+13 ;
+14 NEW CT,DXIEN,DXN,DXREC,DXV,ICD9,ICDR,ORFMDAT,TXFACTRS
+15 SET (CT,DXN)=0
+16 IF '$GET(^OR(100,ORIEN,0))
SET Y=-1
+17 IF '$DATA(^OR(100,ORIEN,5.1,1,0))
SET Y=0
+18 IF '$TEST
Begin DoDot:1
+19 ; Get order date for CSV/CTD/HIPAA usage
+20 SET ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
+21 ; Go through all Dx's for an order
+22 FOR
SET DXN=$ORDER(^OR(100,ORIEN,5.1,DXN))
IF DXN'?1N.N
QUIT
Begin DoDot:2
+23 ; Get diagnosis record and IEN
+24 SET DXREC=$GET(^OR(100,ORIEN,5.1,DXN,0))
SET DXIEN=$PIECE(DXREC,U)
+25 SET ICDR=$$ICDDX^ICDCODE($GET(DXIEN),ORFMDAT)
+26 SET DXV=$PIECE(ICDR,U,4)
SET ICD9=$PIECE(ICDR,U,2)
+27 ; Convert internal to external Treatment Factors
+28 SET TXFACTRS=$$TFGBLGUI(^OR(100,ORIEN,5.2))
+29 SET CT=CT+1
SET Y(CT)=DXN_U_$GET(DXIEN)_U_ICD9_U_DXV_U_TXFACTRS
End DoDot:2
End DoDot:1
SET Y=CT
+30 QUIT
+31 ;
SCLST(Y,DFN,ORLST) ; RPC for compiling appropriate TxF's
+1 ; RPC titled ORWDBA1 SCLST
+2 ;
+3 ; Y = Returned value
+4 ; DFN = Patient IEN
+5 ; ORLST = List of orders
+6 ;
+7 ; call for BA/TF
+8 NEW GMRCPROS,ORD,ORI,ORPKG
+9 DO CPLSTBA(.Y,DFN,.ORLST)
+10 QUIT
+11 ;
CPLSTBA(TEST,PTIFN,ORIFNS) ; set-up SC/TFs for BA
+1 ;
+2 ; TEST = Returned value
+3 ; PTIFN = Patient IEN
+4 ; ORIFNS = List of orders
+5 ;
+6 SET ORI=""
+7 ;
+8 ; define array of packages for which BA data collected (SC/CIs)
+9 ; GMRC = Consult/Request Tracking (#128) - Prosthetics
+10 ; LR = Lab Services (#26) - Lab
+11 ; PSO = Outpt Pharmacy (#112) - Outpt Pharmacy (orig. Co-Pay)
+12 ; RA = Radiology/Nuclear Medicine (#31) - Radiology
+13 ;
+14 SET ORPKG(+$ORDER(^DIC(9.4,"C","PSO",0)))=1
+15 ; See ISWITCH^ORWDBA7 for insurance/Ed switch, i.e., $$CIDC^IBBAPI
+16 ; Also check provider switch via 'OR BILLING AWARENESS BY USER'
+17 IF $$BASTAT&$$CIDC^IBBAPI(DFN)&$$GET^XPAR(DUZ_";VA(200,","OR BILLING AWARENESS BY USER",1,"Q")
FOR I=1:1
SET ORPKG=$PIECE("GMRC;LR;RA",";",I)
IF ORPKG=""
QUIT
Begin DoDot:1
+18 ; ^DIC(9.4) is package file
SET ORPKG(+$ORDER(^DIC(9.4,"C",ORPKG,0)))=1
End DoDot:1
+19 ;
+20 ; get Treatment Factors (TxF) for patient
+21 DO SCPRE(.DR,DFN)
+22 ;
+23 ; set TxF's if order is for a package for which BA data is collected
+24 FOR
SET ORI=$ORDER(ORLST(ORI))
IF 'ORI
QUIT
SET ORD=+ORLST(ORI)
Begin DoDot:1
+25 IF $GET(^OR(100,ORD,0))=""
QUIT
+26 IF $PIECE($GET(^OR(100,ORD,0)),U,14)=""
QUIT
+27 IF $DATA(TEST(ORD))!'$DATA(ORPKG($PIECE($GET(^OR(100,ORD,0)),U,14)))
QUIT
+28 ;canceled order (2) & ? (3)
IF $EXTRACT($PIECE(ORIFNS(ORI),";",2))>1
QUIT
+29 SET TEST(ORD)=ORLST(ORI)_DR
End DoDot:1
+30 QUIT
+31 ;
SCPRE(DR,DFN) ; Dialog validation, to ask BA questions
+1 ;
+2 ; DR = return value
+3 ; DFN = input patient IEN
+4 ;
+5 IF $GET(DFN)=""
QUIT
+6 NEW CPNODE,CT,I,ORX,ORSDCARY,TF,X
+7 KILL ORSDCARY
+8 SET (CPNODE,DR,ORX,TF)=""
SET CT=0
SET X="T"
+9 ; Call API to acquire Treatment Factors in force
+10 ;DBIA 406
DO NOW^%DTC
DO CL^SDCO21(DFN,%,"",.ORSDCARY)
+11 ; Retrved array order: AO,IR,SC,EC,MST,HNC,CV,SHD e.g., ORSDCARY(3) for SC
+12 ; Convert to ^OR/CPRS GUI order: SC,MST,AO,IR,EC,HNC,CV,SHD
+13 FOR I=3,5,1,2,4,6,7,8
SET TF=0
SET CT=CT+1
IF $DATA(ORSDCARY(I))
SET TF=1
SET $PIECE(CPNODE,U,CT)=TF
+14 ;
+15 SET X=$SELECT($PIECE(CPNODE,U)=1:"SC",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+16 SET X=$SELECT($PIECE(CPNODE,U,2)=1:"MST",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+17 SET X=$SELECT($PIECE(CPNODE,U,3)=1:"AO",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+18 SET X=$SELECT($PIECE(CPNODE,U,4)=1:"IR",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+19 SET X=$SELECT($PIECE(CPNODE,U,5)=1:"EC",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+20 SET X=$SELECT($PIECE(CPNODE,U,6)=1:"HNC",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+21 SET X=$SELECT($PIECE(CPNODE,U,7)=1:"CV",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+22 SET X=$SELECT($PIECE(CPNODE,U,8)=1:"SHD",1:"")
SET DR=$SELECT($LENGTH(X):DR_U_X,1:DR)
+23 ;
+24 ; TxF's for patient (TxF's include SC,AO,IR,EC,MST,HNC,CV,SHD) where
+25 ; SC = Service Connected
+26 ; AO = Agent Orange
+27 ; IR = Ionizing Radiation
+28 ; EC = Environmental Contaminants
+29 ; MST = Military Sexual Trauma
+30 ; HNC = Head and Neck Cancer
+31 ; CV = Combat Veteran
+32 ; SHD = Shipboard Disability
+33 FOR I="SC","AO","IR","EC","MST","HNC","CV","SHD"
Begin DoDot:1
+34 IF $DATA(ORX(I))
SET DR=DR_U_I_$SELECT($LENGTH(ORX(I)):";"_ORX(I),1:"")
End DoDot:1
+35 QUIT
+36 ;
ORPKGTYP(Y,ORLST) ; Build BA supported packages array
+1 ; GMRC=Prosthetics, LR=Lab, PSO=Pharmacy, RA=Radiology
+2 NEW OIREC,OIV,OIVN
+3 ;
+4 FOR I=1:1
SET ORPKG=$PIECE("GMRC;LR;PSO;RA",";",I)
IF ORPKG=""
QUIT
Begin DoDot:1
+5 ; ^DIC(9.4) is package file
SET ORPKG(+$ORDER(^DIC(9.4,"C",ORPKG,0)))=ORPKG
End DoDot:1
+6 ;
+7 SET GMRCPROS=+$ORDER(^DIC(9.4,"C","GMRC",0))
+8 ; see if order is for a package which BA supports
+9 DO ORPKG1(.Y,.ORLST)
+10 QUIT
+11 ;
ORPKG1(TEST,ORIFNS) ; Order for package BA supports? TEST(ORI)=1 is YES
+1 SET U="^"
SET ORI=""
+2 FOR I=1:1:5
SET OIV(I)=$PIECE("PROSTHETICS REQUEST^EYEGLASS REQUEST^CONTACT LENS REQUEST^HOME OXYGEN REQUEST^AMPUTEE/PROSTHETICS CLINIC",U,I)
+3 FOR
SET ORI=$ORDER(ORIFNS(ORI))
IF 'ORI
QUIT
SET ORD=+ORIFNS(ORI)
SET TEST(ORI)=0
Begin DoDot:1
+4 ;document/note not an order
IF ORD=0
QUIT
+5 ;I ORD="CONSULT_DX" S TEST(ORI)=1 Q ;consult dx prev entered
+6 ;invalid order #
IF '$DATA(^OR(100,ORD,0))
QUIT
+7 ;invalid order # or entry
IF $PIECE(^OR(100,ORD,0),U,14)'?1N.N
QUIT
+8 ;canceled order (2) & ? (3)
IF $EXTRACT($PIECE(ORIFNS(ORI),";",2))>1
QUIT
+9 ;
IF $DATA(^OR(100,ORD,5.1,1,0))
SET TEST(ORI)=1
QUIT
+10 ;pkg not supported
IF '$DATA(ORPKG($PIECE(^OR(100,ORD,0),U,14)))
QUIT
+11 ; IPt OPt (ask BA questions?)
+12 ; Pros Y Y GMRC
+13 ; Rad Y Y RA
+14 ; Lab N Y LR
+15 ; Phrm Y Y PSO
+16 ; Pt Class = 'I' or 'O' in ^OR
+17 IF $PIECE(^OR(100,ORD,0),U,12)="I"&(ORPKG($PIECE(^OR(100,ORD,0),U,14))="LR")
QUIT
+18 ;check for Pros consult order
IF $PIECE(^OR(100,ORD,0),U,14)=GMRCPROS
Begin DoDot:2
+19 SET OIREC=$GET(^ORD(101.43,$GET(^OR(100,ORD,4.5,1,1)),0))
SET OIVN=""
+20 FOR
SET OIVN=$ORDER(OIV(OIVN))
IF OIVN=""
QUIT
IF OIV(OIVN)=$EXTRACT($PIECE(OIREC,U),1,$LENGTH(OIV(OIVN)))
SET TEST(ORI)=1
QUIT
End DoDot:2
QUIT
+21 ;order is for a supported pkg (also note Pros ck above)
SET TEST(ORI)=1
End DoDot:1
+22 QUIT
+23 ;
BASTATUS(Y) ;RPC to retrieve the status of the Billing Awareness software
+1 ; Y = Returned Value (1=BA usable, 0=BA not-usable)
+2 ; Check for installation of CIDC ancillary build
+3 SET Y=$DATA(^XPD(9.7,"B","PX CLINICAL INDICATOR DATA CAPTURE 1.0"))
+4 IF 'Y
QUIT
+5 ; Check if system parameter switch set
+6 SET Y=$$CHKPS1^ORWDBA5
+7 QUIT
+8 ;
BASTAT() ; Internal version of BASTATUS
+1 ; Returns 0 if disabled or 1 if enabled
+2 QUIT $$CHKPS1^ORWDBA5
+3 ;
RCVORCI(Y,DIAG) ;Receive order related Clinical Indicators & Diagnoses from GUI
+1 ; Store data in ^OR(100,ODN,5.1) & ^OR(100,0DN,5.2)
+2 ;
+3 NEW DXIEN,ODN,ORIEN,SCI,OCDXCT,OCT
+4 SET ODN=""
SET OCDXCT=0
SET Y=""
+5 FOR
SET ODN=$ORDER(DIAG(ODN))
IF ODN=""
QUIT
Begin DoDot:1
+6 ;Order IEN
SET ORIEN=$PIECE(DIAG(ODN),";",1)
+7 IF ORIEN'?1N.N
SET Y=0
QUIT
+8 ;Clear currently stored diagnosis for rewrite
KILL ^OR(100,ORIEN,5.1)
+9 ; Data from Delphi format: ORIEN;11CNNNCNN^exDx1^exDx2^exDx3^exDx4
+10 ; Convert 8 Tx Factors
+11 SET SCI=$$TFGUIGBL($REVERSE($EXTRACT($REVERSE($PIECE(DIAG(ODN),U)),1,8)))
+12 ;Store TFs (SC,MST,AO,IR,EC,HNC,CV,SHD)
SET ^OR(100,ORIEN,5.2)=SCI
+13 ; Get order date for CSV/CTD/HIPAA
+14 SET ORFMDAT=$$ORFMDAT^ORWDBA3(ORIEN)
+15 ; Go through the diagnoses entered
+16 FOR OCT=2:1
IF $PIECE(DIAG(ODN),U,OCT)=""
QUIT
Begin DoDot:2
+17 ;Dx IEN
SET DXIEN=$PIECE($$ICDDX^ICDCODE($PIECE(DIAG(ODN),U,OCT),ORFMDAT),U,1)
+18 ;No or invalid code passed in
IF DXIEN=-1!(DXIEN="")
QUIT
+19 SET OCDXCT=OCDXCT+1
+20 ;Set 5.1 zero node
SET ^OR(100,ORIEN,5.1,0)="^100.051PA^"_OCDXCT_U_OCDXCT
+21 ;Store a diagnosis for order
SET ^OR(100,ORIEN,5.1,OCDXCT,0)=DXIEN
+22 ;Index diagnosis for order
SET ^OR(100,ORIEN,5.1,"B",DXIEN,OCDXCT)=""
End DoDot:2
End DoDot:1
+23 IF Y=""
SET Y=1
+24 QUIT
+25 ;
TFSTGS ; Set Treatment Factor strings sequence order
+1 ; TFGBL is order of TxFs in ^OR(100,ORIEN,5) & ^OR(100,ORIEN,5.2)
+2 ; TFGUI is order of TxFs to/from GUI
+3 ; TFTBL is order of TxFs for table SD008 (used in ZCL segment)
+4 ; NOTE: change examples in TFGUIGBL and TFGBLGUI if order changed
+5 SET TFGBL="SC^MST^AO^IR^EC^HNC^CV^SHD"
+6 SET TFGUI="SC^AO^IR^EC^MST^HNC^CV^SHD"
+7 SET TFTBL="AO^IR^SC^EC^MST^HNC^CV^SHD"
+8 QUIT
+9 ;
TFGUIGBL(GUI) ;Convert Treatment Factors from GUI to Global order & format
+1 ;
+2 ; Input: GUI in CNU?NCU: C=checked, N=not checked, U=unchecked
+3 ; Output: GBL in 1^^^0^?^1^0^ (global) format (reordered for storage)
+4 ;
+5 NEW GBL,J,NTF,TF,TFGBL,TFGUI,TFTBL
+6 ;NTF=# of Treatment Factors (TxF)
SET GBL=""
SET NTF=8
+7 ;I $L(GUI)'=NTF Q -1 ;invalid # of TxF
+8 ; Get Treatment Factor sequence order strings
+9 DO TFSTGS
+10 ; Convert from GBL to GUI format and sequence
+11 FOR J=1:1:NTF
SET TF=$EXTRACT(GUI,J)
Begin DoDot:1
+12 SET TF($PIECE(TFGUI,U,J))=$SELECT(TF="C":1,TF="U":0,TF="?":"?",1:"")
End DoDot:1
+13 FOR J=1:1:NTF
SET GBL=GBL_U_TF($PIECE(TFGBL,U,J))
+14 QUIT $PIECE(GBL,U,2,NTF+1)
+15 ;
TFGBLGUI(GBL) ;Convert Treatment Factors from Global to GUI order & format
+1 ;
+2 ; Input: GBL in 1^0^1^1^^0^?^ (global) format
+3 ; Output: GUI in CCCNUU? (GUI) format (also reordered)
+4 ;
+5 NEW GUI,J,NTF,TF,TFGBL,TFGUI,TFTBL
+6 ;NCI=# of TxF
SET GUI=""
SET NTF=8
+7 ; Get Treatment Factor sequence order strings
+8 DO TFSTGS
+9 ; Convert from GUI to GBL format and sequence
+10 FOR J=1:1:NTF
SET TF=$PIECE(GBL,U,J)
Begin DoDot:1
+11 SET TF($PIECE(TFGBL,U,J))=$SELECT(TF=1:"C",TF=0:"U",TF="?":"?",1:"N")
End DoDot:1
+12 FOR J=1:1:NTF
SET GUI=GUI_TF($PIECE(TFGUI,U,J))
+13 QUIT GUI
+14 ;
PRVKEY(X) ;Check for active & provider key - to be deleted in CPRS v26
+1 NEW PTD
+2 IF '+$GET(X)
QUIT 0
+3 IF $GET(^VA(200,X,0))=""
QUIT 0
+4 SET PTD=+$PIECE(^VA(200,X,0),"^",11)
+5 IF $$DT^XLFDT'<PTD
IF PTD>0
QUIT 0
+6 IF $DATA(^XUSEC("PROVIDER",X))
QUIT 1
+7 QUIT 0
+8 ;
ORESKEY(X) ;Does 'X' hold ORES key, returns: 1=true, 0=false
+1 IF '+$GET(X)
QUIT 0
+2 IF $DATA(^XUSEC("ORES",X))
QUIT 1
+3 QUIT 0
