- 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 Feb 18, 2025@23:33:26 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 ;