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

IBARXCRC.m

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