IBARXCRC ;ALB/CLT-CERNER RXCOPAY RECEIVE HL7 DFT-P03 MESSAGE; 30 Jan 2021
;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
;
; Receives from Cerner the IBARXC-RECV - DFT-P03 message with cerner transaction,
; parse and save transaction
; OR
; Receives from Cerner the IBARXC-RECV - DFT-P03 message with Cerner backbilling notice,
; parse and update bill
;
EN ;PRIMARY ENTRY POINT
N DFN,TRANS,BDATE,POST,STAT,DESC,TCHRG,BILLED,UNBILLED,PATLOC,ACT,IENS,RXNUM,ACTTYPE,GOOD
N IBD,ICN,PIEN,OBIL,BBIL,PARENT,UNITS,TRANSDT,MSG,HDR,SEG,XXX,DESC1,DESC2,DESC3,DLEN
;
S XXX=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR) ;HLMSGIEN = IEN #778 passed from HL
S XXX="" F S XXX=$$NEXTSEG^HLOPRS(.MSG,.SEG) Q:$G(SEG("SEGMENT TYPE"))="" D @SEG(0) ;("SEGMENT TYPE")
Q
;
PID ;PARSE THE PID SEGMENT
S ICN=$G(SEG(3,1,1,1))
S DFN=$$DFN^IBARXMU(ICN)
;Possibly need an error path if no match for ICN
Q
EVN ;NO SUBROUTINE
Q
;
QRD ;PARSE QRD SEGMENT
Q
;
FT1 ;PARSE THE FT1 SEGMENT
S ACT=SEG(6,1,1,1)
D:ACT="T"
. S TRANS=$G(SEG(2,1,1,1)) ;TRANSACTION ID
. S TRANS=$E($P(TRANS,"-",1),1,3)_"-"_$P(TRANS,"-",2)
. S BDATE=$G(SEG(4,1,1,1)) ;trans date
. S TRANSDT=$$HL7TFM^XLFDT(BDATE)
. S STAT=SEG(7,1,1,1) ;trans type
. S DESC=$G(SEG(10,1,1,1)) D ;Brief description
. . ;Truncate the middle value and not the rxnum or units
. . S DESC1=$P(DESC,"-",1),DESC2=$P(DESC,"-",2),DESC3=$P(DESC,"-",$L(DESC,"-")) ;Desc may have more than 3 pieces
. . S DLEN=(20-2-($L(DESC1_DESC3)))
. . S DESC=DESC1_"-"_$E(DESC2,1,DLEN)_"-"_DESC3
. . Q
. S RXNUM=$G(SEG(11,1,1,1)) ;prescription number
. S TCHRG=+$G(SEG(12,1,1,1),0) ;total charge
. S BILLED=+$G(SEG(13,1,1,1),0) ;billed amount
. S UNBILLED=+$G(SEG(14,1,1,1),0) ;unbilled amount
. S UNITS=$G(SEG(15,1,1,1)) ;Units
. S PARENT=$G(SEG(17,1,1,1)) ;Parent Transaction
. I PARENT["CRNR" S PARENT=$TR(PARENT,"CRNR","")
. I $G(PARENT)="" S PARENT=TRANS
. S PATLOC=SEG(18,1,1,1) ;patient location
. S GOOD=0 D ;Do not file transactions with zero values
. . S:BILLED'=0 GOOD=1
. . S:UNBILLED'=0 GOOD=1
. . S:TCHRG'=0 GOOD=1
. Q:'GOOD
. D SAVE
. Q
;Check if Back billing
D:ACT="B"
. S BILLED=$G(SEG(13,1,1,1)) ;Billing Change Amount
. Q:BILLED=0 ;Do not file transaction with zero value
. S PARENT=$G(SEG(17,1,1,1)) ;Parent Transaction
. D BILL^IBARXMB(PARENT,BILLED) ;Backbilling utility
Q
;
SAVE ;SAVE THE MESSAGE DATA
S IBD=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$G(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
S IBD=IBD_"^"_+TCHRG_"^"_$E(DESC,1,20)_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED_"^"_$P(PATLOC,"^",1)
S IENS=$$ADD^IBARXMN(DFN,IBD)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXCRC 2688 printed Dec 13, 2024@02:07:01 Page 2
IBARXCRC ;ALB/CLT-CERNER RXCOPAY RECEIVE HL7 DFT-P03 MESSAGE; 30 Jan 2021
+1 ;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
+2 ;
+3 ; Receives from Cerner the IBARXC-RECV - DFT-P03 message with cerner transaction,
+4 ; parse and save transaction
+5 ; OR
+6 ; Receives from Cerner the IBARXC-RECV - DFT-P03 message with Cerner backbilling notice,
+7 ; parse and update bill
+8 ;
EN ;PRIMARY ENTRY POINT
+1 NEW DFN,TRANS,BDATE,POST,STAT,DESC,TCHRG,BILLED,UNBILLED,PATLOC,ACT,IENS,RXNUM,ACTTYPE,GOOD
+2 NEW IBD,ICN,PIEN,OBIL,BBIL,PARENT,UNITS,TRANSDT,MSG,HDR,SEG,XXX,DESC1,DESC2,DESC3,DLEN
+3 ;
+4 ;HLMSGIEN = IEN #778 passed from HL
SET XXX=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR)
+5 ;("SEGMENT TYPE")
SET XXX=""
FOR
SET XXX=$$NEXTSEG^HLOPRS(.MSG,.SEG)
if $GET(SEG("SEGMENT TYPE"))=""
QUIT
DO @SEG(0)
+6 QUIT
+7 ;
PID ;PARSE THE PID SEGMENT
+1 SET ICN=$GET(SEG(3,1,1,1))
+2 SET DFN=$$DFN^IBARXMU(ICN)
+3 ;Possibly need an error path if no match for ICN
+4 QUIT
EVN ;NO SUBROUTINE
+1 QUIT
+2 ;
QRD ;PARSE QRD SEGMENT
+1 QUIT
+2 ;
FT1 ;PARSE THE FT1 SEGMENT
+1 SET ACT=SEG(6,1,1,1)
+2 if ACT="T"
Begin DoDot:1
+3 ;TRANSACTION ID
SET TRANS=$GET(SEG(2,1,1,1))
+4 SET TRANS=$EXTRACT($PIECE(TRANS,"-",1),1,3)_"-"_$PIECE(TRANS,"-",2)
+5 ;trans date
SET BDATE=$GET(SEG(4,1,1,1))
+6 SET TRANSDT=$$HL7TFM^XLFDT(BDATE)
+7 ;trans type
SET STAT=SEG(7,1,1,1)
+8 ;Brief description
SET DESC=$GET(SEG(10,1,1,1))
Begin DoDot:2
+9 ;Truncate the middle value and not the rxnum or units
+10 ;Desc may have more than 3 pieces
SET DESC1=$PIECE(DESC,"-",1)
SET DESC2=$PIECE(DESC,"-",2)
SET DESC3=$PIECE(DESC,"-",$LENGTH(DESC,"-"))
+11 SET DLEN=(20-2-($LENGTH(DESC1_DESC3)))
+12 SET DESC=DESC1_"-"_$EXTRACT(DESC2,1,DLEN)_"-"_DESC3
+13 QUIT
End DoDot:2
+14 ;prescription number
SET RXNUM=$GET(SEG(11,1,1,1))
+15 ;total charge
SET TCHRG=+$GET(SEG(12,1,1,1),0)
+16 ;billed amount
SET BILLED=+$GET(SEG(13,1,1,1),0)
+17 ;unbilled amount
SET UNBILLED=+$GET(SEG(14,1,1,1),0)
+18 ;Units
SET UNITS=$GET(SEG(15,1,1,1))
+19 ;Parent Transaction
SET PARENT=$GET(SEG(17,1,1,1))
+20 IF PARENT["CRNR"
SET PARENT=$TRANSLATE(PARENT,"CRNR","")
+21 IF $GET(PARENT)=""
SET PARENT=TRANS
+22 ;patient location
SET PATLOC=SEG(18,1,1,1)
+23 ;Do not file transactions with zero values
SET GOOD=0
Begin DoDot:2
+24 if BILLED'=0
SET GOOD=1
+25 if UNBILLED'=0
SET GOOD=1
+26 if TCHRG'=0
SET GOOD=1
End DoDot:2
+27 if 'GOOD
QUIT
+28 DO SAVE
+29 QUIT
End DoDot:1
+30 ;Check if Back billing
+31 if ACT="B"
Begin DoDot:1
+32 ;Billing Change Amount
SET BILLED=$GET(SEG(13,1,1,1))
+33 ;Do not file transaction with zero value
if BILLED=0
QUIT
+34 ;Parent Transaction
SET PARENT=$GET(SEG(17,1,1,1))
+35 ;Backbilling utility
DO BILL^IBARXMB(PARENT,BILLED)
End DoDot:1
+36 QUIT
+37 ;
SAVE ;SAVE THE MESSAGE DATA
+1 SET IBD=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$GET(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
+2 SET IBD=IBD_"^"_+TCHRG_"^"_$EXTRACT(DESC,1,20)_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED_"^"_$PIECE(PATLOC,"^",1)
+3 SET IENS=$$ADD^IBARXMN(DFN,IBD)
+4 QUIT
+5 ;
