- IBARXCHL ;ALB/CLT- CERNER RXCOPAY BUILD THE DFT-P03 MESSAGE ; 08 Mar 2021
- ;;2.0;INTEGRATED BILLING;**676,717,726**;21-MAR-94;Build 1
- ;
- ; Send to Cerner the IBARXC-SEND - DFT^P03 message with a transaction
- ;
- EN(DFN,FT1IEN) ;MAIN ROUTINE ENTRY POINT
- N PARMS,MSG,HDR,SEG,FIELD,VALUE,WHOTO,ERROR,%,%P1,XXX,X
- N ICN,NAME,NODE0,SETID,TRANSID,STAT,RXNUM,UNITS,TCHRG,DESC,BILLED,UNBILLED,PARENT,SITENM
- ;
- D MSH,SEND
- G END
- ;
- MSH ;ENTER MSG PARAMETERS AND START THR MSG BUILD
- 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)
- ;
- EVN ;BUILD THE EVN SEGMENT
- D SET^HLOAPI(.SEG,"EVN",0)
- D SET^HLOAPI(.SEG,"P03",1)
- D NOW^%DTC S %P1=% S VALUE=$$FMTHL7^XLFDT(%P1)
- D SET^HLOAPI(.SEG,VALUE,2)
- S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- ;
- PID ;ADD PID SEGMENT
- D SET^HLOAPI(.SEG,"PID",0)
- D SET^HLOAPI(.SEG,"1",1)
- S ICN=$$ICN^IBARXMU(DFN) ;set ICN
- D SET^HLOAPI(.SEG,ICN,3)
- S NAME=$P(^DPT(DFN,0),U,1) ;set patient name
- D SET^HLOAPI(.SEG,$P(NAME,",",1),5)
- D SET^HLOAPI(.SEG,$P(NAME,",",2),5,2)
- S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- ;
- FT1 ;INPUT FT1 DATA FOR ONE RX COPAY
- S NODE0=$G(^IBAM(354.71,FT1IEN,0))
- Q:NODE0=""
- ;Null Unbilled issue
- I $P(NODE0,"^",12)="" S NODE0=$$NULLFIX^IBARXCSH(FT1IEN,NODE0)
- D SET^HLOAPI(.SEG,"FT1",0)
- S SEG="FT1",SETID=1
- D SET^HLOAPI(.SEG,SETID,1)
- S TRANSID=$P(NODE0,"^",1)
- D SET^HLOAPI(.SEG,TRANSID,2)
- S %P1=$P(NODE0,"^",3) S %P1=$$FMTHL7^XLFDT(%P1)
- D SET^HLOAPI(.SEG,%P1,4)
- D SET^HLOAPI(.SEG,"T",6)
- S STAT=$P(NODE0,"^",5)
- S STAT=$S(STAT="Y":"X",STAT="P":"C",STAT="X":"X",1:"C")
- D SET^HLOAPI(.SEG,STAT,7)
- S RXNUM=$P(NODE0,"^",6)
- S UNITS=$P(NODE0,"^",7)
- S TCHRG=$P(NODE0,"^",8)
- S DESC=$P(NODE0,"^",9)
- S DESC=$$BDESC(DESC)
- S BILLED=$P(NODE0,"^",11)
- S UNBILLED=$P(NODE0,"^",12)
- D SET^HLOAPI(.SEG,DESC,10)
- D SET^HLOAPI(.SEG,RXNUM,11)
- D SET^HLOAPI(.SEG,TCHRG,12)
- D SET^HLOAPI(.SEG,BILLED,13)
- D SET^HLOAPI(.SEG,UNBILLED,14)
- D SET^HLOAPI(.SEG,UNITS,15)
- ;DETERMINE IF THERE IS A PARENT ID
- S PARENT=$P(NODE0,"^",10)
- I PARENT="" S PARENT=FT1IEN
- S PARENT=$$GET1^DIQ(354.71,PARENT_",",.01,"E")
- D SET^HLOAPI(.SEG,PARENT,17)
- S SITENM=$$FAC^IBARXMU($P(NODE0,"^",13))
- D SET^HLOAPI(.SEG,$P(SITENM,"^",2),18)
- D SET^HLOAPI(.SEG,$P(SITENM,"^",1),18,2)
- S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- Q
- ;
- BDESC(BDESC) ;format Brief Description
- ; Brief Description to 'Rx # - Drug Name - Units' maximum of 20 characters, remove delimeter characters
- ; Input: Brief Description from Transaction (#354.71)
- ; Output: BDN - characters '|-^~\&' replaced by ' ' in Drug Name, Drug Name shortened to less than 20 characters
- N BDP,BD1,BD2,BD3,BD2E,BDL,BDN
- ;
- I $G(BDESC)="" Q ""
- ;
- S BDP=$L(BDESC,"-")
- S BD1=$P(BDESC,"-",1)
- S BD2=$P(BDESC,"-",2,(BDP-1))
- S BD3=$P(BDESC,"-",BDP)
- ;
- S BD2E=$TR(BD2,"|-^~\&"," ") ; extract characters from drug name
- S BDL=20-$L(BD1_"--"_BD3) ; number of characters available for drug name
- ;
- S BDN=BD1_"-"_$E(BD2E,1,BDL)_"-"_BD3 ; max length of 20 characters by shortening drug name
- ;
- Q BDN
- ;
- SEND ;SEND MESSAGE AND QUIT
- S WHOTO("RECEIVING APPLICATION")="IBARXC-RECV"
- S WHOTO("STATION NUMBER")="200CRNR"
- S WHOTO("MIDDLEWARE LINK NAME")="IBARXCVDF"
- S PARMS("SENDING APPLICATION")="IBARXC-SEND"
- S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
- Q
- END ;CLEAN UP AND QUIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXCHL 3648 printed Feb 18, 2025@23:33:23 Page 2
- IBARXCHL ;ALB/CLT- CERNER RXCOPAY BUILD THE DFT-P03 MESSAGE ; 08 Mar 2021
- +1 ;;2.0;INTEGRATED BILLING;**676,717,726**;21-MAR-94;Build 1
- +2 ;
- +3 ; Send to Cerner the IBARXC-SEND - DFT^P03 message with a transaction
- +4 ;
- EN(DFN,FT1IEN) ;MAIN ROUTINE ENTRY POINT
- +1 NEW PARMS,MSG,HDR,SEG,FIELD,VALUE,WHOTO,ERROR,%,%P1,XXX,X
- +2 NEW ICN,NAME,NODE0,SETID,TRANSID,STAT,RXNUM,UNITS,TCHRG,DESC,BILLED,UNBILLED,PARENT,SITENM
- +3 ;
- +4 DO MSH
- DO SEND
- +5 GOTO END
- +6 ;
- MSH ;ENTER MSG PARAMETERS AND START THR MSG BUILD
- +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 ;
- EVN ;BUILD THE EVN SEGMENT
- +1 DO SET^HLOAPI(.SEG,"EVN",0)
- +2 DO SET^HLOAPI(.SEG,"P03",1)
- +3 DO NOW^%DTC
- SET %P1=%
- SET VALUE=$$FMTHL7^XLFDT(%P1)
- +4 DO SET^HLOAPI(.SEG,VALUE,2)
- +5 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- +6 ;
- PID ;ADD PID SEGMENT
- +1 DO SET^HLOAPI(.SEG,"PID",0)
- +2 DO SET^HLOAPI(.SEG,"1",1)
- +3 ;set ICN
- SET ICN=$$ICN^IBARXMU(DFN)
- +4 DO SET^HLOAPI(.SEG,ICN,3)
- +5 ;set patient name
- SET NAME=$PIECE(^DPT(DFN,0),U,1)
- +6 DO SET^HLOAPI(.SEG,$PIECE(NAME,",",1),5)
- +7 DO SET^HLOAPI(.SEG,$PIECE(NAME,",",2),5,2)
- +8 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- +9 ;
- FT1 ;INPUT FT1 DATA FOR ONE RX COPAY
- +1 SET NODE0=$GET(^IBAM(354.71,FT1IEN,0))
- +2 if NODE0=""
- QUIT
- +3 ;Null Unbilled issue
- +4 IF $PIECE(NODE0,"^",12)=""
- SET NODE0=$$NULLFIX^IBARXCSH(FT1IEN,NODE0)
- +5 DO SET^HLOAPI(.SEG,"FT1",0)
- +6 SET SEG="FT1"
- SET SETID=1
- +7 DO SET^HLOAPI(.SEG,SETID,1)
- +8 SET TRANSID=$PIECE(NODE0,"^",1)
- +9 DO SET^HLOAPI(.SEG,TRANSID,2)
- +10 SET %P1=$PIECE(NODE0,"^",3)
- SET %P1=$$FMTHL7^XLFDT(%P1)
- +11 DO SET^HLOAPI(.SEG,%P1,4)
- +12 DO SET^HLOAPI(.SEG,"T",6)
- +13 SET STAT=$PIECE(NODE0,"^",5)
- +14 SET STAT=$SELECT(STAT="Y":"X",STAT="P":"C",STAT="X":"X",1:"C")
- +15 DO SET^HLOAPI(.SEG,STAT,7)
- +16 SET RXNUM=$PIECE(NODE0,"^",6)
- +17 SET UNITS=$PIECE(NODE0,"^",7)
- +18 SET TCHRG=$PIECE(NODE0,"^",8)
- +19 SET DESC=$PIECE(NODE0,"^",9)
- +20 SET DESC=$$BDESC(DESC)
- +21 SET BILLED=$PIECE(NODE0,"^",11)
- +22 SET UNBILLED=$PIECE(NODE0,"^",12)
- +23 DO SET^HLOAPI(.SEG,DESC,10)
- +24 DO SET^HLOAPI(.SEG,RXNUM,11)
- +25 DO SET^HLOAPI(.SEG,TCHRG,12)
- +26 DO SET^HLOAPI(.SEG,BILLED,13)
- +27 DO SET^HLOAPI(.SEG,UNBILLED,14)
- +28 DO SET^HLOAPI(.SEG,UNITS,15)
- +29 ;DETERMINE IF THERE IS A PARENT ID
- +30 SET PARENT=$PIECE(NODE0,"^",10)
- +31 IF PARENT=""
- SET PARENT=FT1IEN
- +32 SET PARENT=$$GET1^DIQ(354.71,PARENT_",",.01,"E")
- +33 DO SET^HLOAPI(.SEG,PARENT,17)
- +34 SET SITENM=$$FAC^IBARXMU($PIECE(NODE0,"^",13))
- +35 DO SET^HLOAPI(.SEG,$PIECE(SITENM,"^",2),18)
- +36 DO SET^HLOAPI(.SEG,$PIECE(SITENM,"^",1),18,2)
- +37 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
- +38 QUIT
- +39 ;
- BDESC(BDESC) ;format Brief Description
- +1 ; Brief Description to 'Rx # - Drug Name - Units' maximum of 20 characters, remove delimeter characters
- +2 ; Input: Brief Description from Transaction (#354.71)
- +3 ; Output: BDN - characters '|-^~\&' replaced by ' ' in Drug Name, Drug Name shortened to less than 20 characters
- +4 NEW BDP,BD1,BD2,BD3,BD2E,BDL,BDN
- +5 ;
- +6 IF $GET(BDESC)=""
- QUIT ""
- +7 ;
- +8 SET BDP=$LENGTH(BDESC,"-")
- +9 SET BD1=$PIECE(BDESC,"-",1)
- +10 SET BD2=$PIECE(BDESC,"-",2,(BDP-1))
- +11 SET BD3=$PIECE(BDESC,"-",BDP)
- +12 ;
- +13 ; extract characters from drug name
- SET BD2E=$TRANSLATE(BD2,"|-^~\&"," ")
- +14 ; number of characters available for drug name
- SET BDL=20-$LENGTH(BD1_"--"_BD3)
- +15 ;
- +16 ; max length of 20 characters by shortening drug name
- SET BDN=BD1_"-"_$EXTRACT(BD2E,1,BDL)_"-"_BD3
- +17 ;
- +18 QUIT BDN
- +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 SET PARMS("SENDING APPLICATION")="IBARXC-SEND"
- +5 SET XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
- +6 QUIT
- END ;CLEAN UP AND QUIT
- +1 QUIT
