IBECECQ2 ;BJR/MNT-BILLING - SEND/RECEIVE QRY & DSR HL7 messages FOR PATIENT ACCUMULATOR INTERFACE CONT; 10/11/23 7:41am
;;2.0;INTEGRATED BILLING;**769**;21-MAR-94;Build 42
;Per VA Directive 6402, this routine should not be modified.
;
; Reference to $$MSGID^HLOPRS in ICR #4718
; Reference to $$SENDONE^HLOAPI1 in ICR #4717
;
; Build and send seeding of Vista data to VDIF IBECEAC-QRY DSR^Q03
;
;
Q ;No direct routine calls
;
;-------------------------------------------------- OUTGOING DSR --- ---------------------------
DSROUT(ICN,IBIEN,IBADMIT) ;MAIN ENTRY POINT - Outgoing DSR message
; IBIEN - Query Request Message IEN (#778) that initiated this response
; ------ Sample message ----
;MSH|^~\&|IBECEAC-QRYRESP|578^HL7.HINES.DOMAIN.EXT:5584^DNS|IBECEAC-RCV|200VDIF^:^DNS|20250513112305-0500||DSR^Q03^DSR_Q03|578 31288757|T^|2.3|||AL|NE|USA
;MSA|AA|200480917113347451221348653716194328765100753
;QRD|20250513102240-0500|1|1|||1|LNAME^FNAME|1014044571V360708|2116781428|20250215|20250218
;DSP|1||FT1^20250207^1676^0^0^0^3^20260206^578&0||||578
N PARMS,SEG,MSG,VALUE,FIELD,QRYNUM,IBERROR,IBERR,NAME,ERROR,XXX,WHOTO,IBDISCH,IBSTN,IBVRSN
N IBSETID,IBCLDT,IB901,IB902,IB903,IB904,IBCLDAY,IBSETID1,IBCLDT1,IB9011,IB9021,IB9031,IB9041,IBCLDAY1,IBCLNDT1,IBACTC,IBCKNUM,IBICNUM
S:$G(IBERR)="" IBERR=0
S DFN=$$DFN^IBARXMU(ICN)
I 'DFN S IBERROR="NO PATIENT FOUND WITH SUBMITTED ICN",IBERR=1
S QRYNUM=$$MSGID^HLOPRS(IBIEN) ; Message Control ID of initiating Query
I DFN D EN^IBECECX1(DFN),INPT^IBECECX1(DFN)
MSHO ; Outgoing MSH
N PARMS K ^TMP("DSR")
S PARMS("COUNTRY")="USA"
S PARMS("MESSAGE TYPE")="DSR"
S PARMS("EVENT")="Q03"
S PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
S PARMS("VERSION")="2.3"
S MSG="^TMP("_"DSR"
S PARMS("MESSAGE STRUCTURE")="DSR_Q03" ;IB*2.0*769 - Add per VDIF
S X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
MSAO ;Outgoing MSA
D SET^HLOAPI(.SEG,"MSA",0)
D SET^HLOAPI(.SEG,$S('$G(IBERR):"AA",1:"AE"),1)
D SET^HLOAPI(.SEG,QRYNUM,2)
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QRDO ;Outgoing QRD
D SET^HLOAPI(.SEG,"QRD",0)
D SET^HLOAPI(.SEG,IBQRYDT,1)
D SET^HLOAPI(.SEG,1,2)
D SET^HLOAPI(.SEG,1,3)
;D SET^HLOAPI(.SEG,+QRYNUM,4)
D SET^HLOAPI(.SEG,IB351IEN,4)
D SET^HLOAPI(.SEG,1,7)
S NAME=$$GET1^DIQ(2,DFN_",",.01)
D SET^HLOAPI(.SEG,$P($G(NAME),",",1),8,1)
D SET^HLOAPI(.SEG,$P($G(NAME),",",2),8,2)
D SET^HLOAPI(.SEG,ICN,9)
I $G(IBEDIPI)'="" D SET^HLOAPI(.SEG,IBEDIPI,10)
D SET^HLOAPI(.SEG,$S($G(IBSADMIT)>0:$P(IBSADMIT,"."),1:DT),11) ; Update to date w/o offset or "0000000"
I $G(IBSDISCH) D SET^HLOAPI(.SEG,$P(IBSDISCH,"."),12) ; Update to date w/o offset or "0000000"
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
I $D(IBERROR) G DSPOE ;Go to error field processing when error message exists
;
DSPO ;Outgoing DSP with no error message
D SET^HLOAPI(.SEG,"DSP",0)
D SET^HLOAPI(.SEG,1,1)
D SET^HLOAPI(.SEG,"FT1",3,1) ;FT1 Response
S IBCLDT=$$FMTHL7^XLFDT(+IBCLDT) D SET^HLOAPI(.SEG,$S(IBCLDT>0:IBCLDT,1:$$FMTHL7^XLFDT(DT)),3,2) ;Billing Clock start date (HL7 format)
D SET^HLOAPI(.SEG,+IB901,3,3) ;1st QRT charges
D SET^HLOAPI(.SEG,+IB902,3,4) ;2nd QRT charges
D SET^HLOAPI(.SEG,+IB903,3,5) ;3rd QRT charges
D SET^HLOAPI(.SEG,+IB904,3,6) ;4th QRT charges
D SET^HLOAPI(.SEG,+IBCLDAY,3,7) ;Inpatient days
I $G(IBCLNDT) S IBCLNDT=$$FMTHL7^XLFDT(IBCLNDT) D SET^HLOAPI(.SEG,+IBCLNDT,3,8) ;Billing Clock end date (HL7 format)
;I $G(IBSTN) D
S IBSTN=$S(+$G(IBSTN):IBSTN,1:$P(($$SITE^VASITE),U,1)) ;Get local station id if it doesn't exist
D SET^HLOAPI(.SEG,IBSTN,3,9,1) ;Station Number
D SET^HLOAPI(.SEG,+$G(IBVRSN),3,9,2) ;Version Number
;D SET^HLOAPI(.SEG,+IBSTAT,6) ;Active clock sent bjr -change if no active clock
;D SET^HLOAPI(.SEG,+IBCKNUM,7) ;Number of billing clocks sent (FT1)
;D SET^HLOAPI(.SEG,+IBICNUM,8) ;Number of admit encounters sent (FT2)
D SET^HLOAPI(.SEG,$P($$SITE^VASITE,U,3),9) ;Site sending DSP
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
G SENDDSR ;Send message
;
DSPOE ;Outgoing DSP with error message
D SET^HLOAPI(.SEG,"DSP",0)
D SET^HLOAPI(.SEG,1,1)
D SET^HLOAPI(.SEG,"FT1",3,1) ;FT1 Response
D SET^HLOAPI(.SEG,"00000000",3,2) ;Billing Clock start date (HL7 format)
D SET^HLOAPI(.SEG,0,3,3) ;1st QRT charges
D SET^HLOAPI(.SEG,0,3,4) ;2nd QRT charges
D SET^HLOAPI(.SEG,0,3,5) ;3rd QRT charges
D SET^HLOAPI(.SEG,0,3,6) ;4th QRT charges
D SET^HLOAPI(.SEG,0,3,7) ;Inpatient days
D SET^HLOAPI(.SEG,"00000000",3,8) ;Billing Clock end date (HL7 format)
D SET^HLOAPI(.SEG,IBERROR,5) ;Error message
;D SET^HLOAPI(.SEG,0,6) ;Active clock sent bjr -change if no active clock
;D SET^HLOAPI(.SEG,0,7) ;Number of billing clocks sent (FT1)
;D SET^HLOAPI(.SEG,0,8) ;Number of admit encounters sent (FT2)
S IBSTN=$S(+$G(IBSTN):IBSTN,1:$P(($$SITE^VASITE),U,1)) ;Get local station id if it doesn't exist
D SET^HLOAPI(.SEG,IBSTN,3,9,1) ;Station Number
D SET^HLOAPI(.SEG,+$G(IBVRSN),3,9,2) ;Version Number
D SET^HLOAPI(.SEG,$P($$SITE^VASITE,U),9) ;Site sending DSP
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
SENDDSR ;
S PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
S WHOTO("RECEIVING APPLICATION")="IBECEAC-RCV"
S WHOTO("STATION NUMBER")="200VDIF"
S WHOTO("MIDDLEWARE LINK NAME")="IBECEC-DSR" ;File #870 entry
S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECECQ2 5490 printed Sep 23, 2025@19:57:54 Page 2
IBECECQ2 ;BJR/MNT-BILLING - SEND/RECEIVE QRY & DSR HL7 messages FOR PATIENT ACCUMULATOR INTERFACE CONT; 10/11/23 7:41am
+1 ;;2.0;INTEGRATED BILLING;**769**;21-MAR-94;Build 42
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to $$MSGID^HLOPRS in ICR #4718
+5 ; Reference to $$SENDONE^HLOAPI1 in ICR #4717
+6 ;
+7 ; Build and send seeding of Vista data to VDIF IBECEAC-QRY DSR^Q03
+8 ;
+9 ;
+10 ;No direct routine calls
QUIT
+11 ;
+12 ;-------------------------------------------------- OUTGOING DSR --- ---------------------------
DSROUT(ICN,IBIEN,IBADMIT) ;MAIN ENTRY POINT - Outgoing DSR message
+1 ; IBIEN - Query Request Message IEN (#778) that initiated this response
+2 ; ------ Sample message ----
+3 ;MSH|^~\&|IBECEAC-QRYRESP|578^HL7.HINES.DOMAIN.EXT:5584^DNS|IBECEAC-RCV|200VDIF^:^DNS|20250513112305-0500||DSR^Q03^DSR_Q03|578 31288757|T^|2.3|||AL|NE|USA
+4 ;MSA|AA|200480917113347451221348653716194328765100753
+5 ;QRD|20250513102240-0500|1|1|||1|LNAME^FNAME|1014044571V360708|2116781428|20250215|20250218
+6 ;DSP|1||FT1^20250207^1676^0^0^0^3^20260206^578&0||||578
+7 NEW PARMS,SEG,MSG,VALUE,FIELD,QRYNUM,IBERROR,IBERR,NAME,ERROR,XXX,WHOTO,IBDISCH,IBSTN,IBVRSN
+8 NEW IBSETID,IBCLDT,IB901,IB902,IB903,IB904,IBCLDAY,IBSETID1,IBCLDT1,IB9011,IB9021,IB9031,IB9041,IBCLDAY1,IBCLNDT1,IBACTC,IBCKNUM,IBICNUM
+9 if $GET(IBERR)=""
SET IBERR=0
+10 SET DFN=$$DFN^IBARXMU(ICN)
+11 IF 'DFN
SET IBERROR="NO PATIENT FOUND WITH SUBMITTED ICN"
SET IBERR=1
+12 ; Message Control ID of initiating Query
SET QRYNUM=$$MSGID^HLOPRS(IBIEN)
+13 IF DFN
DO EN^IBECECX1(DFN)
DO INPT^IBECECX1(DFN)
MSHO ; Outgoing MSH
+1 NEW PARMS
KILL ^TMP("DSR")
+2 SET PARMS("COUNTRY")="USA"
+3 SET PARMS("MESSAGE TYPE")="DSR"
+4 SET PARMS("EVENT")="Q03"
+5 SET PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
+6 SET PARMS("VERSION")="2.3"
+7 SET MSG="^TMP("_"DSR"
+8 ;IB*2.0*769 - Add per VDIF
SET PARMS("MESSAGE STRUCTURE")="DSR_Q03"
+9 SET X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
MSAO ;Outgoing MSA
+1 DO SET^HLOAPI(.SEG,"MSA",0)
+2 DO SET^HLOAPI(.SEG,$SELECT('$GET(IBERR):"AA",1:"AE"),1)
+3 DO SET^HLOAPI(.SEG,QRYNUM,2)
+4 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QRDO ;Outgoing QRD
+1 DO SET^HLOAPI(.SEG,"QRD",0)
+2 DO SET^HLOAPI(.SEG,IBQRYDT,1)
+3 DO SET^HLOAPI(.SEG,1,2)
+4 DO SET^HLOAPI(.SEG,1,3)
+5 ;D SET^HLOAPI(.SEG,+QRYNUM,4)
+6 DO SET^HLOAPI(.SEG,IB351IEN,4)
+7 DO SET^HLOAPI(.SEG,1,7)
+8 SET NAME=$$GET1^DIQ(2,DFN_",",.01)
+9 DO SET^HLOAPI(.SEG,$PIECE($GET(NAME),",",1),8,1)
+10 DO SET^HLOAPI(.SEG,$PIECE($GET(NAME),",",2),8,2)
+11 DO SET^HLOAPI(.SEG,ICN,9)
+12 IF $GET(IBEDIPI)'=""
DO SET^HLOAPI(.SEG,IBEDIPI,10)
+13 ; Update to date w/o offset or "0000000"
DO SET^HLOAPI(.SEG,$SELECT($GET(IBSADMIT)>0:$PIECE(IBSADMIT,"."),1:DT),11)
+14 ; Update to date w/o offset or "0000000"
IF $GET(IBSDISCH)
DO SET^HLOAPI(.SEG,$PIECE(IBSDISCH,"."),12)
+15 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+16 ;Go to error field processing when error message exists
IF $DATA(IBERROR)
GOTO DSPOE
+17 ;
DSPO ;Outgoing DSP with no error message
+1 DO SET^HLOAPI(.SEG,"DSP",0)
+2 DO SET^HLOAPI(.SEG,1,1)
+3 ;FT1 Response
DO SET^HLOAPI(.SEG,"FT1",3,1)
+4 ;Billing Clock start date (HL7 format)
SET IBCLDT=$$FMTHL7^XLFDT(+IBCLDT)
DO SET^HLOAPI(.SEG,$SELECT(IBCLDT>0:IBCLDT,1:$$FMTHL7^XLFDT(DT)),3,2)
+5 ;1st QRT charges
DO SET^HLOAPI(.SEG,+IB901,3,3)
+6 ;2nd QRT charges
DO SET^HLOAPI(.SEG,+IB902,3,4)
+7 ;3rd QRT charges
DO SET^HLOAPI(.SEG,+IB903,3,5)
+8 ;4th QRT charges
DO SET^HLOAPI(.SEG,+IB904,3,6)
+9 ;Inpatient days
DO SET^HLOAPI(.SEG,+IBCLDAY,3,7)
+10 ;Billing Clock end date (HL7 format)
IF $GET(IBCLNDT)
SET IBCLNDT=$$FMTHL7^XLFDT(IBCLNDT)
DO SET^HLOAPI(.SEG,+IBCLNDT,3,8)
+11 ;I $G(IBSTN) D
+12 ;Get local station id if it doesn't exist
SET IBSTN=$SELECT(+$GET(IBSTN):IBSTN,1:$PIECE(($$SITE^VASITE),U,1))
+13 ;Station Number
DO SET^HLOAPI(.SEG,IBSTN,3,9,1)
+14 ;Version Number
DO SET^HLOAPI(.SEG,+$GET(IBVRSN),3,9,2)
+15 ;D SET^HLOAPI(.SEG,+IBSTAT,6) ;Active clock sent bjr -change if no active clock
+16 ;D SET^HLOAPI(.SEG,+IBCKNUM,7) ;Number of billing clocks sent (FT1)
+17 ;D SET^HLOAPI(.SEG,+IBICNUM,8) ;Number of admit encounters sent (FT2)
+18 ;Site sending DSP
DO SET^HLOAPI(.SEG,$PIECE($$SITE^VASITE,U,3),9)
+19 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+20 ;Send message
GOTO SENDDSR
+21 ;
DSPOE ;Outgoing DSP with error message
+1 DO SET^HLOAPI(.SEG,"DSP",0)
+2 DO SET^HLOAPI(.SEG,1,1)
+3 ;FT1 Response
DO SET^HLOAPI(.SEG,"FT1",3,1)
+4 ;Billing Clock start date (HL7 format)
DO SET^HLOAPI(.SEG,"00000000",3,2)
+5 ;1st QRT charges
DO SET^HLOAPI(.SEG,0,3,3)
+6 ;2nd QRT charges
DO SET^HLOAPI(.SEG,0,3,4)
+7 ;3rd QRT charges
DO SET^HLOAPI(.SEG,0,3,5)
+8 ;4th QRT charges
DO SET^HLOAPI(.SEG,0,3,6)
+9 ;Inpatient days
DO SET^HLOAPI(.SEG,0,3,7)
+10 ;Billing Clock end date (HL7 format)
DO SET^HLOAPI(.SEG,"00000000",3,8)
+11 ;Error message
DO SET^HLOAPI(.SEG,IBERROR,5)
+12 ;D SET^HLOAPI(.SEG,0,6) ;Active clock sent bjr -change if no active clock
+13 ;D SET^HLOAPI(.SEG,0,7) ;Number of billing clocks sent (FT1)
+14 ;D SET^HLOAPI(.SEG,0,8) ;Number of admit encounters sent (FT2)
+15 ;Get local station id if it doesn't exist
SET IBSTN=$SELECT(+$GET(IBSTN):IBSTN,1:$PIECE(($$SITE^VASITE),U,1))
+16 ;Station Number
DO SET^HLOAPI(.SEG,IBSTN,3,9,1)
+17 ;Version Number
DO SET^HLOAPI(.SEG,+$GET(IBVRSN),3,9,2)
+18 ;Site sending DSP
DO SET^HLOAPI(.SEG,$PIECE($$SITE^VASITE,U),9)
+19 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
SENDDSR ;
+1 SET PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
+2 SET WHOTO("RECEIVING APPLICATION")="IBECEAC-RCV"
+3 SET WHOTO("STATION NUMBER")="200VDIF"
+4 ;File #870 entry
SET WHOTO("MIDDLEWARE LINK NAME")="IBECEC-DSR"
+5 SET XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
+6 QUIT
+7 ;
