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 Apr 09, 2024@21:05:28 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
