ORWDBA7 ;SLC/GSS Billing Awareness (CIDC-Clinical Indicators Data Capture) ;12/04/12 11:13
;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,215,243,361**;Dec 17, 1997;Build 39
;
; External References:
; $$CIDC^IBBAPI ICR #4419
; $$ICDDATA^ICDXCODE ICR #5699
; $$UPDOR^LRBEBA4 ICR #4775
; $$EN^PSOHLNE3 ICR #4666
; $$CPRSUPD^RABWORD1 ICR #4771
; $$REPEAT^XLFSTR ICR #10104
;
BDOEDIT ; Backdoor entered orders edit in CPRS - entry point
; Data Flow> Ancillary creates a back door order which is incomplete
; and thus edited in CPRS GUI. The ancillary needs to know
; what Dx and TF's are edited thus this tag calls three
; ancillary APIs, passing the Dx and TF data to them.
;
; Variable Description
; ANCILARY Acronym of ancillary/package relative to order
; DXN Diagnosis sequence number in ^OR file
; MSG Error message
; ORDX Array of diagnoses (1-n) with value from ICD file (#80)
; ORIFN Order internal reference number (defined in ORCSEND)
; ORITEM Package reference or ^OR(100,ORIFN,4)
; ORSCEI String of Treatment Factors in table SD008 order/format
; PTIEN Patient IEN
; TAGROU Tag^Routine of ancillary routine to store edited data
; TFO Treatment Factors in ^OR (GBL) order
;
; If CIDC master switch set, then no back door orders to store
I $$BASTAT^ORWDBA1=0 Q ;CIDC (nee BA) not used
; If ORIFN not defined (God only knows why) then log error and quit
I '$D(ORIFN) S MSG="ORIFN not defined" D VAR,EN^ORERR(MSG,"",.VAR) Q
;
N ANCILARY,DXN,MSG,ORDX,ORITEM,ORSCEI,PTIEN,RT,SUCCESS,TAGROU,TFO,VAR
;
S DXN=0,(RT,SUCCESS)="",PTIEN=+$P($G(^OR(100,ORIFN,0)),U,2)
; Package (ancillary) reference data
S ORITEM=$G(^OR(100,ORIFN,4))
; Create an array (ORDX) of diagnoses
F S DXN=$O(^OR(100,ORIFN,5.1,DXN)) Q:'DXN D
. S ORDX(DXN)=$G(^OR(100,ORIFN,5.1,DXN,0))
; Treatment Factors - converted and reformatted
S ORSCEI=$$TFGBLTBL($G(^OR(100,ORIFN,5.2)))
; Get the acronym of the package generating this order
S ANCILARY=$P($G(^DIC(9.4,$P($G(^OR(100,ORIFN,0)),U,14),0)),U,2)
; Send data to the appropriate ancillary API based on package
D OUTPUT
; If ancillary routine or tag w/in the routine doesn't exist check
I 'RT D
. S MSG="NON-EXISTANT ROUTINE/TAG FOR "_ANCILARY
. D VAR,EN^ORERR(MSG,"",.VAR)
; If we don't get back a thumbs-up from the ancillary re: the order data
I 'SUCCESS,RT D
. S MSG="ANCILLARY API RETURNED ERROR FOR CPRS EDITED BACK DOOR DATA"
. D VAR,EN^ORERR(MSG,"",.VAR)
Q
;
OUTPUT ; Call ancillary's API to store data after checking for it's existence
;
; Laboratory
I ANCILARY?1"LR".U D Q
. S RT=$$CKROUTAG("UPDOR^LRBEBA4") Q:'RT
. S SUCCESS=$$UPDOR^LRBEBA4(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI) ;IA 4775
;
; Pharmacy
I ANCILARY?1"PS".U D Q
. S RT=$$CKROUTAG("EN^PSOHLNE3") Q:'RT
. S SUCCESS=$$EN^PSOHLNE3(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI) ;IA 4666
;
; Radiolgy
I ANCILARY?1"RA".U D Q
. S RT=$$CKROUTAG("CPRSUPD^RABWORD1") Q:'RT
. S SUCCESS=$$CPRSUPD^RABWORD1(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI) ;IA 4771
Q
;
CKROUTAG(TAGROU) ;Check if valid tag and routine
; Temporary check until all the ancillaries have their API's built
Q $L($T(@TAGROU))
;
TFGBLTBL(GBL) ;Convert Tx Factors from Global to TBL (HL7) order & format
; Note: this does not set Tx Factors in ZCL segment format but rather
; AO^IR^SC^EC^MST^HNC^CV^SHD ('^' delimited string) format
;
; Input: GBL in 1^1^0^0^^^0^ (global) format
; Output: TBL in 0^0^1^^1^^0^ (TBL) format (also reordered)
;
N J,NTF,TBL,TF,TFGBL,TFGUI,TFTBL
S TBL="",NTF=8 ;NCI=# of TxF
; Get Treatment Factor sequence order strings
D TFSTGS^ORWDBA1
; Convert from GBL to TBL format and sequence
F J=1:1:NTF S TF=$P(GBL,U,J) D
. ;OK..just in case there is a '?' we'll return a null for a '?'
. S TF($P(TFGBL,U,J))=$S(TF=1:1,TF=0:0,TF="?":"",1:"")
F J=1:1:NTF S TBL=TBL_U_TF($P(TFTBL,U,J))
; Remove the first '^' and pass TBL formatted TF's
Q $E(TBL,2,99)
;
VAR ;Create VAR array for tracking error in ^ORYX("ORERR",err#)
S VAR("DFN")=PTIEN
S VAR("ORITEM")=ORITEM
S VAR("ORIFN")=ORIFN
M VAR("ORDX")=ORDX
S VAR("ORSCEI")=ORSCEI
Q
;
ISWITCH(Y,DFN) ;Return 0 if don't ask (no ins) or 1 to ask CIDC quest (yes ins)
S Y=$$CIDC^IBBAPI(DFN)
Q
;
GETIEN9(Y,ICD9) ;Return IEN for an ICD9 code (RPC: ORWDBA7 GETIEN9)
S Y=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ICD9,DT)
Q
;
CONDTLD ;Consult Detailed Display Compile for CIDC/BA (called by GMRCSLM2)
; Input: ORIFN and GMRCCT defined in GMRCSLM2
; Output: CIDCARY = array of CIDC display lines for GMRCSLM2 display
N BGNRCCT,DXIEN,DXOF,DXV,EYE,ICD9,ICDR,LINE,OCT,ORFMDAT,TF,CIDCARY
S BGNRCCT=GMRCCT,OCT=0
; Get the date of the order for CSV/CTD usage
S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
; $O through diagnoses for an order
F S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N D
. S DXOF=" "
. ; DXIEN=Dx IEN
. S DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
. ; Get Dx record for date ORFMDAT
. S ICDR=$$ICDDATA^ICDXCODE("DIAGNOSIS",DXIEN,ORFMDAT)
. ; Get Dx verbiage and ICD code
. S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
. I OCT=1 D
.. S CIDCARY(GMRCCT,0)=" ",GMRCCT=GMRCCT+1 ;blank line
.. S CIDCARY(GMRCCT,0)="Clinical Indicators",GMRCCT=GMRCCT+1
.. S DXOF="Diagnosis of: "
. S LINE=DXOF_ICD9_" - "_DXV
. S CIDCARY(GMRCCT,0)=LINE,GMRCCT=GMRCCT+1
I OCT'="" D ;if there are diagnoses then show Treatment Factors
. S LINE="For conditions related to: "
. F EYE=1:1:8 S TF=$P(^OR(100,ORIFN,5.2),U,EYE) I TF D
.. S CIDCARY(GMRCCT,0)=LINE_$$SC^ORQ21(EYE)
.. S X=$$REPEAT^XLFSTR(" ",30),GMRCCT=GMRCCT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDBA7 5780 printed Dec 13, 2024@02:35:24 Page 2
ORWDBA7 ;SLC/GSS Billing Awareness (CIDC-Clinical Indicators Data Capture) ;12/04/12 11:13
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,215,243,361**;Dec 17, 1997;Build 39
+2 ;
+3 ; External References:
+4 ; $$CIDC^IBBAPI ICR #4419
+5 ; $$ICDDATA^ICDXCODE ICR #5699
+6 ; $$UPDOR^LRBEBA4 ICR #4775
+7 ; $$EN^PSOHLNE3 ICR #4666
+8 ; $$CPRSUPD^RABWORD1 ICR #4771
+9 ; $$REPEAT^XLFSTR ICR #10104
+10 ;
BDOEDIT ; Backdoor entered orders edit in CPRS - entry point
+1 ; Data Flow> Ancillary creates a back door order which is incomplete
+2 ; and thus edited in CPRS GUI. The ancillary needs to know
+3 ; what Dx and TF's are edited thus this tag calls three
+4 ; ancillary APIs, passing the Dx and TF data to them.
+5 ;
+6 ; Variable Description
+7 ; ANCILARY Acronym of ancillary/package relative to order
+8 ; DXN Diagnosis sequence number in ^OR file
+9 ; MSG Error message
+10 ; ORDX Array of diagnoses (1-n) with value from ICD file (#80)
+11 ; ORIFN Order internal reference number (defined in ORCSEND)
+12 ; ORITEM Package reference or ^OR(100,ORIFN,4)
+13 ; ORSCEI String of Treatment Factors in table SD008 order/format
+14 ; PTIEN Patient IEN
+15 ; TAGROU Tag^Routine of ancillary routine to store edited data
+16 ; TFO Treatment Factors in ^OR (GBL) order
+17 ;
+18 ; If CIDC master switch set, then no back door orders to store
+19 ;CIDC (nee BA) not used
IF $$BASTAT^ORWDBA1=0
QUIT
+20 ; If ORIFN not defined (God only knows why) then log error and quit
+21 IF '$DATA(ORIFN)
SET MSG="ORIFN not defined"
DO VAR
DO EN^ORERR(MSG,"",.VAR)
QUIT
+22 ;
+23 NEW ANCILARY,DXN,MSG,ORDX,ORITEM,ORSCEI,PTIEN,RT,SUCCESS,TAGROU,TFO,VAR
+24 ;
+25 SET DXN=0
SET (RT,SUCCESS)=""
SET PTIEN=+$PIECE($GET(^OR(100,ORIFN,0)),U,2)
+26 ; Package (ancillary) reference data
+27 SET ORITEM=$GET(^OR(100,ORIFN,4))
+28 ; Create an array (ORDX) of diagnoses
+29 FOR
SET DXN=$ORDER(^OR(100,ORIFN,5.1,DXN))
if 'DXN
QUIT
Begin DoDot:1
+30 SET ORDX(DXN)=$GET(^OR(100,ORIFN,5.1,DXN,0))
End DoDot:1
+31 ; Treatment Factors - converted and reformatted
+32 SET ORSCEI=$$TFGBLTBL($GET(^OR(100,ORIFN,5.2)))
+33 ; Get the acronym of the package generating this order
+34 SET ANCILARY=$PIECE($GET(^DIC(9.4,$PIECE($GET(^OR(100,ORIFN,0)),U,14),0)),U,2)
+35 ; Send data to the appropriate ancillary API based on package
+36 DO OUTPUT
+37 ; If ancillary routine or tag w/in the routine doesn't exist check
+38 IF 'RT
Begin DoDot:1
+39 SET MSG="NON-EXISTANT ROUTINE/TAG FOR "_ANCILARY
+40 DO VAR
DO EN^ORERR(MSG,"",.VAR)
End DoDot:1
+41 ; If we don't get back a thumbs-up from the ancillary re: the order data
+42 IF 'SUCCESS
IF RT
Begin DoDot:1
+43 SET MSG="ANCILLARY API RETURNED ERROR FOR CPRS EDITED BACK DOOR DATA"
+44 DO VAR
DO EN^ORERR(MSG,"",.VAR)
End DoDot:1
+45 QUIT
+46 ;
OUTPUT ; Call ancillary's API to store data after checking for it's existence
+1 ;
+2 ; Laboratory
+3 IF ANCILARY?1"LR".U
Begin DoDot:1
+4 SET RT=$$CKROUTAG("UPDOR^LRBEBA4")
if 'RT
QUIT
+5 ;IA 4775
SET SUCCESS=$$UPDOR^LRBEBA4(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)
End DoDot:1
QUIT
+6 ;
+7 ; Pharmacy
+8 IF ANCILARY?1"PS".U
Begin DoDot:1
+9 SET RT=$$CKROUTAG("EN^PSOHLNE3")
if 'RT
QUIT
+10 ;IA 4666
SET SUCCESS=$$EN^PSOHLNE3(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)
End DoDot:1
QUIT
+11 ;
+12 ; Radiolgy
+13 IF ANCILARY?1"RA".U
Begin DoDot:1
+14 SET RT=$$CKROUTAG("CPRSUPD^RABWORD1")
if 'RT
QUIT
+15 ;IA 4771
SET SUCCESS=$$CPRSUPD^RABWORD1(PTIEN,ORITEM,ORIFN,.ORDX,ORSCEI)
End DoDot:1
QUIT
+16 QUIT
+17 ;
CKROUTAG(TAGROU) ;Check if valid tag and routine
+1 ; Temporary check until all the ancillaries have their API's built
+2 QUIT $LENGTH($TEXT(@TAGROU))
+3 ;
TFGBLTBL(GBL) ;Convert Tx Factors from Global to TBL (HL7) order & format
+1 ; Note: this does not set Tx Factors in ZCL segment format but rather
+2 ; AO^IR^SC^EC^MST^HNC^CV^SHD ('^' delimited string) format
+3 ;
+4 ; Input: GBL in 1^1^0^0^^^0^ (global) format
+5 ; Output: TBL in 0^0^1^^1^^0^ (TBL) format (also reordered)
+6 ;
+7 NEW J,NTF,TBL,TF,TFGBL,TFGUI,TFTBL
+8 ;NCI=# of TxF
SET TBL=""
SET NTF=8
+9 ; Get Treatment Factor sequence order strings
+10 DO TFSTGS^ORWDBA1
+11 ; Convert from GBL to TBL format and sequence
+12 FOR J=1:1:NTF
SET TF=$PIECE(GBL,U,J)
Begin DoDot:1
+13 ;OK..just in case there is a '?' we'll return a null for a '?'
+14 SET TF($PIECE(TFGBL,U,J))=$SELECT(TF=1:1,TF=0:0,TF="?":"",1:"")
End DoDot:1
+15 FOR J=1:1:NTF
SET TBL=TBL_U_TF($PIECE(TFTBL,U,J))
+16 ; Remove the first '^' and pass TBL formatted TF's
+17 QUIT $EXTRACT(TBL,2,99)
+18 ;
VAR ;Create VAR array for tracking error in ^ORYX("ORERR",err#)
+1 SET VAR("DFN")=PTIEN
+2 SET VAR("ORITEM")=ORITEM
+3 SET VAR("ORIFN")=ORIFN
+4 MERGE VAR("ORDX")=ORDX
+5 SET VAR("ORSCEI")=ORSCEI
+6 QUIT
+7 ;
ISWITCH(Y,DFN) ;Return 0 if don't ask (no ins) or 1 to ask CIDC quest (yes ins)
+1 SET Y=$$CIDC^IBBAPI(DFN)
+2 QUIT
+3 ;
GETIEN9(Y,ICD9) ;Return IEN for an ICD9 code (RPC: ORWDBA7 GETIEN9)
+1 SET Y=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ICD9,DT)
+2 QUIT
+3 ;
CONDTLD ;Consult Detailed Display Compile for CIDC/BA (called by GMRCSLM2)
+1 ; Input: ORIFN and GMRCCT defined in GMRCSLM2
+2 ; Output: CIDCARY = array of CIDC display lines for GMRCSLM2 display
+3 NEW BGNRCCT,DXIEN,DXOF,DXV,EYE,ICD9,ICDR,LINE,OCT,ORFMDAT,TF,CIDCARY
+4 SET BGNRCCT=GMRCCT
SET OCT=0
+5 ; Get the date of the order for CSV/CTD usage
+6 SET ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
+7 ; $O through diagnoses for an order
+8 FOR
SET OCT=$ORDER(^OR(100,ORIFN,5.1,OCT))
if OCT'?1N.N
QUIT
Begin DoDot:1
+9 SET DXOF=" "
+10 ; DXIEN=Dx IEN
+11 SET DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
+12 ; Get Dx record for date ORFMDAT
+13 SET ICDR=$$ICDDATA^ICDXCODE("DIAGNOSIS",DXIEN,ORFMDAT)
+14 ; Get Dx verbiage and ICD code
+15 SET DXV=$PIECE(ICDR,U,4)
SET ICD9=$PIECE(ICDR,U,2)
+16 IF OCT=1
Begin DoDot:2
+17 ;blank line
SET CIDCARY(GMRCCT,0)=" "
SET GMRCCT=GMRCCT+1
+18 SET CIDCARY(GMRCCT,0)="Clinical Indicators"
SET GMRCCT=GMRCCT+1
+19 SET DXOF="Diagnosis of: "
End DoDot:2
+20 SET LINE=DXOF_ICD9_" - "_DXV
+21 SET CIDCARY(GMRCCT,0)=LINE
SET GMRCCT=GMRCCT+1
End DoDot:1
+22 ;if there are diagnoses then show Treatment Factors
IF OCT'=""
Begin DoDot:1
+23 SET LINE="For conditions related to: "
+24 FOR EYE=1:1:8
SET TF=$PIECE(^OR(100,ORIFN,5.2),U,EYE)
IF TF
Begin DoDot:2
+25 SET CIDCARY(GMRCCT,0)=LINE_$$SC^ORQ21(EYE)
+26 SET X=$$REPEAT^XLFSTR(" ",30)
SET GMRCCT=GMRCCT+1
End DoDot:2
End DoDot:1
+27 QUIT
