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