IBARXCBK ;ALB/CLT-CERNER COPAY BACKBILLING ; 02 Mar 2021
;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
;
;Send to cerner the IBARXC-SEND - DFT^PO3 message with a backbilling notice
;
EN(IBA,IBBIL) ;ENTRY POINT - PASS IN TRANS FILE IEN, AMOUNT TO BE BACKBILLED
;
N PARMS,MSG,HDR,SEG,FIELD,VALUE,WHOTO,ERROR,XXX,ICN,NAME,RXNUM,FACID,NODE0,X,DFN
N OBIL,PARENT,CBIL,PTRAN
;
MSH ;
N PARMS K ^TMP("DFT")
S PARMS("COUNTRY")="USA"
S PARMS("EVENT")="P03"
S PARMS("MESSAGE TYPE")="DFT"
S PARMS("SENDING APPLICATION")="IBARXC-SEND"
S PARMS("RECEIVING APPLICATION")="IBARXC-RECV"
S PARMS("VERSION")="2.3"
S PARMS("MESSAGE STRUCTURE")="DFT_P03"
S MSG="^TMP("_"DFT"
S X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
S NODE0=$G(^IBAM(354.71,+IBA,0))
Q:NODE0=""
S DFN=$P(NODE0,"^",2)
EVN ;
S VALUE="EVN",FIELD=0 D SET^HLOAPI(.SEG,VALUE,FIELD)
S VALUE="P03",FIELD=1 D SET^HLOAPI(.SEG,VALUE,FIELD)
D NOW^%DTC S %P1=% S VALUE=$$FMTHL7^XLFDT(%P1),FIELD=2
D SET^HLOAPI(.SEG,VALUE,FIELD)
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
;
PID ;ADD PID SEGMENT
;Set PID field
S VALUE="PID",FIELD=0
D SET^HLOAPI(.SEG,VALUE,FIELD)
D SET^HLOAPI(.SEG,1,1)
;Set ICN field
S ICN=$$ICN^IBARXMU(DFN)
S VALUE=ICN,FIELD=3
D SET^HLOAPI(.SEG,VALUE,FIELD)
;Set Name
S NAME=$$GET1^DIQ(2,DFN_",",.01)
S VALUE=$P(NAME,",",1),FIELD=5 D SET^HLOAPI(.SEG,VALUE,FIELD,1)
S VALUE=$P(NAME,",",2),FIELD=5 D SET^HLOAPI(.SEG,VALUE,FIELD,2)
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
;
FT1 ;INPT FT1 DATA FOR ONE CANCELLED RX COPAY
S VALUE="FT1",FIELD=0 D SET^HLOAPI(.SEG,VALUE,FIELD)
D SET^HLOAPI(.SEG,1,1)
D SET^HLOAPI(.SEG,"B",6)
S RXNUM=$P(NODE0,"^",6)
D SET^HLOAPI(.SEG,RXNUM,11)
S PARENT=$P(NODE0,"^",10) ;Get parent ID
;S OBIL=$$NET^IBARXMC(PARENT) ;Get the Old Billing amount
;S CBIL=(IBBIL-OBIL) ;Send the change amount not total
D SET^HLOAPI(.SEG,IBBIL,13)
S FACID=$$FAC^IBARXMU($P(NODE0,"^",13))
D SET^HLOAPI(.SEG,$P(FACID,"^",2),18,1)
D SET^HLOAPI(.SEG,$P(FACID,"^",1),18,2)
;INCLUDE PARENT TRANSACTION ID, ADD "CRNR" TO SITE ID
S PTRAN=$P(NODE0,"^",10)
S PTRAN=$$GET1^DIQ(354.71,PTRAN_",",.01,"E")
S $P(PTRAN,"-")=($P(PTRAN,"-")_"CRNR")
D SET^HLOAPI(.SEG,PTRAN,17)
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
;
SEND ;SEND MESSAGE AND QUIT
S WHOTO("RECEIVING APPLICATION")="IBARXC-RECV"
S WHOTO("STATION NUMBER")="200CRNR"
S WHOTO("MIDDLEWARE LINK NAME")="IBARXCVDF"
;S WHOTO("FACILITY LINK NAME")="IBARXCVDF"
;S WHOTO("RECEIVING FACILITY",1)="200CRNR"
S PARMS("SENDING APPLICATION")="IBARXC-SEND"
S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXCBK 2639 printed Sep 23, 2025@19:43:10 Page 2
IBARXCBK ;ALB/CLT-CERNER COPAY BACKBILLING ; 02 Mar 2021
+1 ;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
+2 ;
+3 ;Send to cerner the IBARXC-SEND - DFT^PO3 message with a backbilling notice
+4 ;
EN(IBA,IBBIL) ;ENTRY POINT - PASS IN TRANS FILE IEN, AMOUNT TO BE BACKBILLED
+1 ;
+2 NEW PARMS,MSG,HDR,SEG,FIELD,VALUE,WHOTO,ERROR,XXX,ICN,NAME,RXNUM,FACID,NODE0,X,DFN
+3 NEW OBIL,PARENT,CBIL,PTRAN
+4 ;
MSH ;
+1 NEW PARMS
KILL ^TMP("DFT")
+2 SET PARMS("COUNTRY")="USA"
+3 SET PARMS("EVENT")="P03"
+4 SET PARMS("MESSAGE TYPE")="DFT"
+5 SET PARMS("SENDING APPLICATION")="IBARXC-SEND"
+6 SET PARMS("RECEIVING APPLICATION")="IBARXC-RECV"
+7 SET PARMS("VERSION")="2.3"
+8 SET PARMS("MESSAGE STRUCTURE")="DFT_P03"
+9 SET MSG="^TMP("_"DFT"
+10 SET X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
+11 SET NODE0=$GET(^IBAM(354.71,+IBA,0))
+12 if NODE0=""
QUIT
+13 SET DFN=$PIECE(NODE0,"^",2)
EVN ;
+1 SET VALUE="EVN"
SET FIELD=0
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+2 SET VALUE="P03"
SET FIELD=1
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+3 DO NOW^%DTC
SET %P1=%
SET VALUE=$$FMTHL7^XLFDT(%P1)
SET FIELD=2
+4 DO SET^HLOAPI(.SEG,VALUE,FIELD)
+5 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+6 ;
PID ;ADD PID SEGMENT
+1 ;Set PID field
+2 SET VALUE="PID"
SET FIELD=0
+3 DO SET^HLOAPI(.SEG,VALUE,FIELD)
+4 DO SET^HLOAPI(.SEG,1,1)
+5 ;Set ICN field
+6 SET ICN=$$ICN^IBARXMU(DFN)
+7 SET VALUE=ICN
SET FIELD=3
+8 DO SET^HLOAPI(.SEG,VALUE,FIELD)
+9 ;Set Name
+10 SET NAME=$$GET1^DIQ(2,DFN_",",.01)
+11 SET VALUE=$PIECE(NAME,",",1)
SET FIELD=5
DO SET^HLOAPI(.SEG,VALUE,FIELD,1)
+12 SET VALUE=$PIECE(NAME,",",2)
SET FIELD=5
DO SET^HLOAPI(.SEG,VALUE,FIELD,2)
+13 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+14 ;
FT1 ;INPT FT1 DATA FOR ONE CANCELLED RX COPAY
+1 SET VALUE="FT1"
SET FIELD=0
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+2 DO SET^HLOAPI(.SEG,1,1)
+3 DO SET^HLOAPI(.SEG,"B",6)
+4 SET RXNUM=$PIECE(NODE0,"^",6)
+5 DO SET^HLOAPI(.SEG,RXNUM,11)
+6 ;Get parent ID
SET PARENT=$PIECE(NODE0,"^",10)
+7 ;S OBIL=$$NET^IBARXMC(PARENT) ;Get the Old Billing amount
+8 ;S CBIL=(IBBIL-OBIL) ;Send the change amount not total
+9 DO SET^HLOAPI(.SEG,IBBIL,13)
+10 SET FACID=$$FAC^IBARXMU($PIECE(NODE0,"^",13))
+11 DO SET^HLOAPI(.SEG,$PIECE(FACID,"^",2),18,1)
+12 DO SET^HLOAPI(.SEG,$PIECE(FACID,"^",1),18,2)
+13 ;INCLUDE PARENT TRANSACTION ID, ADD "CRNR" TO SITE ID
+14 SET PTRAN=$PIECE(NODE0,"^",10)
+15 SET PTRAN=$$GET1^DIQ(354.71,PTRAN_",",.01,"E")
+16 SET $PIECE(PTRAN,"-")=($PIECE(PTRAN,"-")_"CRNR")
+17 DO SET^HLOAPI(.SEG,PTRAN,17)
+18 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+19 ;
SEND ;SEND MESSAGE AND QUIT
+1 SET WHOTO("RECEIVING APPLICATION")="IBARXC-RECV"
+2 SET WHOTO("STATION NUMBER")="200CRNR"
+3 SET WHOTO("MIDDLEWARE LINK NAME")="IBARXCVDF"
+4 ;S WHOTO("FACILITY LINK NAME")="IBARXCVDF"
+5 ;S WHOTO("RECEIVING FACILITY",1)="200CRNR"
+6 SET PARMS("SENDING APPLICATION")="IBARXC-SEND"
+7 SET XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
+8 QUIT
+9 ;
