Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDBA1

ORWDBA1.m

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