- ORWDBA1 ; SLC OIFO/DKK/GSS - Order Dialogs Billing Awareness ;12/04/12 09:39
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,195,229,215,243,361**;Dec 17, 1997;Build 39
- ;
- ; 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=$$ICDDATA^ICDXCODE("DIAGNOSIS",$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($$ICDDATA^ICDXCODE("DIAGNOSIS",$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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDBA1 9926 printed Feb 19, 2025@00:01:46 Page 2
- 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
- +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=$$ICDDATA^ICDXCODE("DIAGNOSIS",$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($$ICDDATA^ICDXCODE("DIAGNOSIS",$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