IBARXCRD ;ALB/CLT-CERNER RXCOPAY RECEIVE DSR MESSAGE ; 14 May 2021 1:31 PM
;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
;
; Receives from Cerner the IBARXC-QRYRESP - DSR^Q03
; processes Cerner seeding data, parse and save transactions
;
EN(ICN) ;PRIMARY ENTRY POINT
;
N MSG,HDR,SEG,XXX,DFN
S DFN=$$DFN^IBARXMU(ICN)
S XXX=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR)
S XXX="" F S XXX=$$NEXTSEG^HLOPRS(.MSG,.SEG) Q:$G(SEG("SEGMENT TYPE"))="" D @SEG(0) ;("SEGMENT TYPE")
G END
Q
;
MSA ;PARSE MSA SEGMENT
Q
QRD ;PARSE QRD SEGMENT
Q
QRF ;PARSE QRF SEGMENT
Q
DSP ;PARSE THE DSP SEGMENT
N TRANSX,TRANS,X,TRANSDT,STAT,DESC,DESC1,DESC2,DESC3,DLEN,RXNUM
N PATLOC,PARENT,I,TCHRG,BILLED,UNBILLED,UNITS,IBD,IENS,ACTTYPE,GOOD
N CHECK,IBD1,IBX,IEN
;
S I=1 F S I=$O(SEG(3,1,I)) Q:I="" D
. S TRANSX=$G(SEG(3,1,2,1)) ;TRANSACTION ID
. S TRANS=$E($P(TRANSX,"-",1),1,3)_"-"_$P(TRANSX,"-",2)
. S X=$G(SEG(3,1,4,1))
. S TRANSDT="3"_$E(X,3,4)_$E(X,5,8)
. S STAT=$G(SEG(3,1,7,1)) ;trans type
. S DESC=$G(SEG(3,1,10,1)) ;Brief description
. I $D(DESC) D
. . ;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
. S RXNUM=$G(SEG(3,1,11,1)) ;prescription number
. S TCHRG=+$G(SEG(3,1,12,1)) ;total charge
. S BILLED=+$G(SEG(3,1,13,1)) ;billed amount
. S UNBILLED=+$G(SEG(3,1,14,1)) ;unbilled amount
. 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
. S UNITS=$G(SEG(3,1,15,1)) ;Units
. S PARENT=$G(SEG(3,1,17,1)) ;Parent Transaction
. I PARENT["CRNR" S PARENT=$TR(PARENT,"CRNR","") ;Remove CRNR from Cerner
. I $G(PARENT)="" S PARENT=TRANS
. S PATLOC=$G(SEG(3,1,18,1)) ;patient location
. S CHECK=0,CHECK=$$DBLCHK(CHECK)
. D:'CHECK SAVE
. Q
Q
;
SAVE ;SAVE THE MESSAGE DATA TO 354.71
S IBD=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$G(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
S IBD=IBD_"^"_+TCHRG_"^"_DESC_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED_"^"_$P(PATLOC,"^",1)
S IENS=$$ADD^IBARXMN(DFN,IBD)
Q
;
END ;KILL LOCAL VARIABLES AND QUIT
Q
;
ESEND ;Error response something was not passed in or didn't match
;This is a recieving utility. We need to change to return a message with the error
;Build MSH from existing MSH
Q
;
DBLCHK(CHECK) ;CHECK FOR A DUPLICATE ENTRY
S CHECK=0
I '$D(^IBAM(354.71,"B",TRANS)) Q CHECK
S IEN=0,IEN=$O(^IBAM(354.71,"B",TRANS,IEN))
S IBX=$P(^IBAM(354.71,IEN,0),"^",1,8)_"^"_$P(^IBAM(354.71,$P(^IBAM(354.71,IEN,0),"^",10),0),"^",1)_"^"_$P(^IBAM(354.71,IEN,0),"^",11,12)
S IBD1=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$G(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
S IBD1=IBD1_"^"_+TCHRG_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED
S CHECK=$S(IBX=IBD1:1,1:0)
Q CHECK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXCRD 2978 printed Dec 13, 2024@02:07:02 Page 2
IBARXCRD ;ALB/CLT-CERNER RXCOPAY RECEIVE DSR MESSAGE ; 14 May 2021 1:31 PM
+1 ;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
+2 ;
+3 ; Receives from Cerner the IBARXC-QRYRESP - DSR^Q03
+4 ; processes Cerner seeding data, parse and save transactions
+5 ;
EN(ICN) ;PRIMARY ENTRY POINT
+1 ;
+2 NEW MSG,HDR,SEG,XXX,DFN
+3 SET DFN=$$DFN^IBARXMU(ICN)
+4 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 GOTO END
+7 QUIT
+8 ;
MSA ;PARSE MSA SEGMENT
+1 QUIT
QRD ;PARSE QRD SEGMENT
+1 QUIT
QRF ;PARSE QRF SEGMENT
+1 QUIT
DSP ;PARSE THE DSP SEGMENT
+1 NEW TRANSX,TRANS,X,TRANSDT,STAT,DESC,DESC1,DESC2,DESC3,DLEN,RXNUM
+2 NEW PATLOC,PARENT,I,TCHRG,BILLED,UNBILLED,UNITS,IBD,IENS,ACTTYPE,GOOD
+3 NEW CHECK,IBD1,IBX,IEN
+4 ;
+5 SET I=1
FOR
SET I=$ORDER(SEG(3,1,I))
if I=""
QUIT
Begin DoDot:1
+6 ;TRANSACTION ID
SET TRANSX=$GET(SEG(3,1,2,1))
+7 SET TRANS=$EXTRACT($PIECE(TRANSX,"-",1),1,3)_"-"_$PIECE(TRANSX,"-",2)
+8 SET X=$GET(SEG(3,1,4,1))
+9 SET TRANSDT="3"_$EXTRACT(X,3,4)_$EXTRACT(X,5,8)
+10 ;trans type
SET STAT=$GET(SEG(3,1,7,1))
+11 ;Brief description
SET DESC=$GET(SEG(3,1,10,1))
+12 IF $DATA(DESC)
Begin DoDot:2
+13 ;Truncate the middle value and not the rxnum or units
+14 ;DESC may have more than 3 pieces
SET DESC1=$PIECE(DESC,"-",1)
SET DESC2=$PIECE(DESC,"-",2)
SET DESC3=$PIECE(DESC,"-",$LENGTH(DESC,"-"))
+15 SET DLEN=(20-2-($LENGTH(DESC1_DESC3)))
+16 SET DESC=DESC1_"-"_$EXTRACT(DESC2,1,DLEN)_"-"_DESC3
End DoDot:2
+17 ;prescription number
SET RXNUM=$GET(SEG(3,1,11,1))
+18 ;total charge
SET TCHRG=+$GET(SEG(3,1,12,1))
+19 ;billed amount
SET BILLED=+$GET(SEG(3,1,13,1))
+20 ;unbilled amount
SET UNBILLED=+$GET(SEG(3,1,14,1))
+21 ;Do not file transactions with zero values
SET GOOD=0
Begin DoDot:2
+22 if BILLED'=0
SET GOOD=1
+23 if UNBILLED'=0
SET GOOD=1
+24 if TCHRG'=0
SET GOOD=1
End DoDot:2
+25 if 'GOOD
QUIT
+26 ;Units
SET UNITS=$GET(SEG(3,1,15,1))
+27 ;Parent Transaction
SET PARENT=$GET(SEG(3,1,17,1))
+28 ;Remove CRNR from Cerner
IF PARENT["CRNR"
SET PARENT=$TRANSLATE(PARENT,"CRNR","")
+29 IF $GET(PARENT)=""
SET PARENT=TRANS
+30 ;patient location
SET PATLOC=$GET(SEG(3,1,18,1))
+31 SET CHECK=0
SET CHECK=$$DBLCHK(CHECK)
+32 if 'CHECK
DO SAVE
+33 QUIT
End DoDot:1
+34 QUIT
+35 ;
SAVE ;SAVE THE MESSAGE DATA TO 354.71
+1 SET IBD=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$GET(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
+2 SET IBD=IBD_"^"_+TCHRG_"^"_DESC_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED_"^"_$PIECE(PATLOC,"^",1)
+3 SET IENS=$$ADD^IBARXMN(DFN,IBD)
+4 QUIT
+5 ;
END ;KILL LOCAL VARIABLES AND QUIT
+1 QUIT
+2 ;
ESEND ;Error response something was not passed in or didn't match
+1 ;This is a recieving utility. We need to change to return a message with the error
+2 ;Build MSH from existing MSH
+3 QUIT
+4 ;
DBLCHK(CHECK) ;CHECK FOR A DUPLICATE ENTRY
+1 SET CHECK=0
+2 IF '$DATA(^IBAM(354.71,"B",TRANS))
QUIT CHECK
+3 SET IEN=0
SET IEN=$ORDER(^IBAM(354.71,"B",TRANS,IEN))
+4 SET IBX=$PIECE(^IBAM(354.71,IEN,0),"^",1,8)_"^"_$PIECE(^IBAM(354.71,$PIECE(^IBAM(354.71,IEN,0),"^",10),0),"^",1)_"^"_$PIECE(^IBAM(354.71,IEN,0),"^",11,12)
+5 SET IBD1=TRANS_"^"_DFN_"^"_TRANSDT_"^"_$GET(ACTTYPE)_"^"_STAT_"^"_RXNUM_"^"_UNITS
+6 SET IBD1=IBD1_"^"_+TCHRG_"^"_PARENT_"^"_+BILLED_"^"_+UNBILLED
+7 SET CHECK=$SELECT(IBX=IBD1:1,1:0)
+8 QUIT CHECK
