Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBECECQ1

IBECECQ1.m

Go to the documentation of this file. 
  1. IBECECQ1 ;BSL/DVA-BILLING - SEND/RECEIVE QRY & DSR HL7 messages FOR PATIENT ACCUMULATOR INTERFACE ; 01 Jun 2022  7:17 AM
  1.  ;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference to $$STARTMSG^HLOPRS,$$NEXTSEG^HLOPRS,$$GET^HLOPRS,$$MSGID^HLOPRS in ICR #4718
  1.  ; Reference to $$ADDSEG^HLOAPI,$$NEWMSG^HLOAPI,SET^HLOAPI in ICR #4722
  1.  ; Reference to $$SENDONE^HLOAPI1 in ICR #4717
  1.  ;
  1.  ; -4200Build and send seeding of Vista data to DAS SPOE IBECEAC-QRY DSR^Q03 
  1.  ; Receive seeding query of Vista data from DAS SPOE IBECEAC-QRY DSR^Q03 
  1.  ;
  1.  ; Sample message
  1.  ;MSH|^~\&||695^HL7.IVMVEE.FO-ALBANY.DOMAIN.EXT:5127^DNS|IBECECQ-QRYRESP|200DAS^:^DNS|20211001094308-0500||QRY^RO2^QRY_RO2|695 1469|T^|2.3|||AL|NE|USA
  1.  ;QRD|20211008123254-0500|1|1||||1|DRI^DODMORE MESSAGE|1008713999V404928
  1.  ;QRF|IBECEAC-QRY|20161106|20161107
  1.  ;
  1.  Q   ;No direct routine calls
  1.  ;
  1. ADM ;Called from IB MEANS TEST BILLING protocol
  1.  Q:$P($G(DGPMA),"^",2)'=1
  1.  D EN(DFN)
  1.  Q
  1.  ;
  1. EDTCLCK(DFN,IBADMIT) ;Called from Billing CLock Maintenance option
  1.  N IBTRYTIL,IBECDT,IBECLDT,IBECIEN,IBECSTDT,IBECENDT,IBNOW
  1.  Q:'$$ICN^IBARXMU(DFN)  ;Do not run query of patient does not have an ICN
  1.  D MTEQRY(DFN,IBADMIT)  ;Run Query
  1.  W !,"Running Billing Clock Query, please wait."
  1.  S IBFLAG1=0 S IBTRYTIL=$$FMADD^XLFDT($$NOW^XLFDT,,,1),IBNOW=$$NOW^XLFDT F  Q:$$NOW^XLFDT>IBTRYTIL  Q:IBFLAG1  D
  1.  .H 2 W "." S IBECDT1=-(IBADMIT_.9999) F  S IBECDT1=$O(^IBE(351,"AIVDT",DFN,IBECDT1)) Q:'IBECDT1  S IBECIEN=$O(^IBE(351,"AIVDT",DFN,IBECDT1,";"),-1) Q:'IBECIEN  D
  1.  ..S IBECLDT=$$GET1^DIQ(351,IBECIEN_",",.04,"I") Q:IBECLDT=3  D
  1.  ...S IBECSTDT=$$GET1^DIQ(351,IBECIEN_",",.03,"I"),IBECENDT=$$GET1^DIQ(351,IBECIEN_",",.1,"I"),IBECENDT=$S(IBECENDT:IBECENDT,IBECLDT=2:($$CLSDT^IBECECX1(IBECSTDT)),1:DT) D
  1.  ....I (IBECENDT>=IBADMIT),$$GET1^DIQ(351,IBECIEN_",",14,"I")>IBNOW,$P(^IBE(351,IBECIEN,1),U,5) S IBFLAG1=1,IBECDA=IBECIEN Q
  1.  Q
  1.  ;
  1. MTEQRY(DFN,IBADMIT) ;Query for Billing CLock Maintenance option
  1.  N IBICN,IBDISCH
  1.  S IBICN=$$ICN^IBARXMU(DFN)
  1.  I +IBICN<1 S SERROR="NO PATIENT ICN FOUND",SERR=1 Q  ;quit if unable to find ICN
  1.  S IBDISCH=$$CLSDT^IBECECX1(IBADMIT)
  1.  I IBDISCH S IBDISCH=$$FMTHL7^XLFDT($P(IBDISCH,"."))
  1.  S IBADMIT=$$FMTHL7^XLFDT($P(IBADMIT,"."))
  1.  S IBOADMIT=IBADMIT
  1.  I IBDISCH S IBODISCH=IBDISCH
  1.  S:$G(SERR)="" SERR=0
  1.  D MSH,QRD,QRF,SENDQRY
  1.  Q
  1.  ;
  1. CCBILL(DFN,IBADMIT) ;OUTGOING QRY Called from CC Inpatient Bill
  1.  ;
  1.  N X,PARMS,SEG,MSG,VALUE,FIELD,QRYNUM,SERROR,SERR,NAME,ERROR,XXX,WHOTO,IBACBCLK,IBADM,IBDISC,IBDISCH,IBIEN,IBICN,IBQIEN,IBC0,IBODISCH,IBOADMIN
  1.  ;
  1.  ;S IBC0=^IBE(351,IBCLDA,0)    
  1.  ;HL7 to FM - $$HL7TFM^XLFDT(DT)   
  1.  ;FM TO HL7 - $$FMTHL7^XLFDT(DT)
  1.  ; Retrieve Admission and Discharge dates from the PTF file
  1.  ;
  1.  D CCINPT^IBECECX1(DFN,.IBADMIT)                       ;Get admit/discharge data
  1.  S IBICN=$$ICN^IBARXMU(DFN)
  1.  I +IBICN<1 S SERROR="NO PATIENT ICN FOUND",SERR=1 Q  ;quit if unable to find ICN
  1.  S:$G(SERR)="" SERR=0
  1.  D MSH,QRD,QRF,SENDQRY
  1.  Q
  1.  ;-------------------------------------------------OUTGOING QRY ----------------------------------------
  1. EN(DFN) ;OUTGOING QRY  ENTRY POINT
  1.  ; IBQIEN - Query Request Message IEN (#778) that initiated this response                                   CALLED FROM CLADD^IBAUTL3
  1.  N X,PARMS,SEG,MSG,VALUE,FIELD,QRYNUM,SERROR,SERR,NAME,ERROR,XXX,WHOTO,IBACBCLK,IBADM,IBDISC,IBADMIT,IBDISCH,IBIEN,IBICN,IBQIEN,IBC0,IBODISCH,IBOADMIN
  1.  ;
  1.  ;S IBC0=^IBE(351,IBCLDA,0)    
  1.  ;HL7 to FM - $$HL7TFM^XLFDT(DT)   
  1.  ;FM TO HL7 - $$FMTHL7^XLFDT(DT)
  1.  ; Retrieve Admission and Discharge dates from the PTF file
  1.  ;
  1.  D INPT^IBECECX1(DFN)                 ;Get admit/discharge data
  1.  S IBICN=$$ICN^IBARXMU(DFN)
  1.  I +IBICN<1 S SERROR="NO PATIENT ICN FOUND",SERR=1 Q  ;quit if unable to find ICN
  1.  S:$G(SERR)="" SERR=0
  1.  D MSH,QRD,QRF,SENDQRY
  1.  Q
  1.  ;
  1. MSH ;  Build MSH Segment
  1.  N PARMS K ^TMP("DSR")
  1.  S PARMS("COUNTRY")="USA"
  1.  S PARMS("MESSAGE TYPE")="QRY"
  1.  S PARMS("EVENT")="R02"
  1.  S PARMS("VERSION")="2.3"
  1.  S PARMS("MESSAGE STRUCTURE")="QRY_R02"
  1.  S MSG="^TMP("_"QRY"
  1.  S X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
  1. MSA ;Build MSA Segment  (OPTIONAL)
  1.  S VALUE="MSA",FIELD=0 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S VALUE="AL",FIELD=1 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  ;S VALUE=QRYNUM,FIELD=2 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1.  Q
  1.  ;
  1. QRD ;Build QRD segment
  1.  S VALUE="QRD",FIELD=0 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S %P1=$$NOW^XLFDT() S %P1=$$FMTHL7^XLFDT(%P1)
  1.  S VALUE=%P1,FIELD=1 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S VALUE=1,FIELD=2 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S VALUE=1,FIELD=3 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  ;S VALUE=QRYNUM,FIELD=4 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S VALUE=1,FIELD=7 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S NAME=$$GET1^DIQ(2,DFN_",",.01)
  1.  S VALUE=$P($G(NAME),",",1),FIELD=8 D SET^HLOAPI(.SEG,VALUE,FIELD,1)
  1.  S VALUE=$P($G(NAME),",",2),FIELD=8 D SET^HLOAPI(.SEG,VALUE,FIELD,2)
  1.  S VALUE=IBICN,FIELD=9 D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S FIELD=11 I $G(IBOADMIT) S VALUE=IBOADMIT D SET^HLOAPI(.SEG,VALUE,FIELD) ; ADMIT DATE
  1.  S FIELD=12 I $G(IBODISCH) S VALUE=IBODISCH D SET^HLOAPI(.SEG,VALUE,FIELD) ; Discharge date
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1.  Q
  1.  ;
  1. QRF ;Build QRF segment
  1.  S FIELD=0,VALUE="QRF" D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S FIELD=1,VALUE="IBECEAC-QRY" D SET^HLOAPI(.SEG,VALUE,FIELD)
  1.  S FIELD=2 I $G(IBADMIT) S VALUE=IBADMIT D SET^HLOAPI(.SEG,VALUE,FIELD) ; ADMIT DATE
  1.  S FIELD=3 I $G(IBDISCH) S VALUE=IBDISCH D SET^HLOAPI(.SEG,VALUE,FIELD) ; Discharge date
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1.  Q
  1. SENDQRY ;
  1.  S PARMS("SENDING APPLICATION")="IBECEAC-QRY"
  1.  S WHOTO("RECEIVING APPLICATION")="IBECEAC-RECV"
  1.  S WHOTO("STATION NUMBER")="200DAS"
  1.  S WHOTO("MIDDLEWARE LINK NAME")="IBECEC-QRY"            ;File #870 entry
  1.  S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
  1.  Q
  1.  ;
  1.  ;--------------------------------------------------INCOMING QRY  --------------------------
  1. QRYIN ; receives incoming HL7 QRY^R02 and returns a DSR
  1.  N ICN,IBECADM,IBSADMIT,IBSDISCH
  1.  S ERR=0,IBSTAT=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.IBHDR)
  1.  S IBIEN=HLMSGIEN
  1.  I 'IBSTAT  S HLERR="Unable to start parse of message" Q
  1.  I "QRY"'[IBHDR("MESSAGE TYPE") Q
  1.  ;
  1.  ; extract some incoming message data from Cerner message IBARXC-QRY - QRY^R02 
  1.  F  Q:'$$NEXTSEG^HLOPRS(.IBMSG,.SEG)  S IBSEGT=$G(SEG("SEGMENT TYPE")) Q:IBSEGT=""  D
  1.  . I IBSEGT="QRD" D QRDQI
  1.  . I IBSEGT="QRF" D QRFQI
  1.  Q:'ICN
  1.  D DSROUT(ICN,IBIEN,IBECADM)
  1.  K IBCLNDT
  1.  Q
  1.  ;
  1. QRDQI ; INCOMING QRD SEGMENT
  1.  S ICN=$$GET^HLOPRS(.SEG,9,1,1,1)
  1.  S IBSADMIT=$$GET^HLOPRS(.SEG,11,1,1,1)
  1.  S IBSDISCH=$$GET^HLOPRS(.SEG,12,1,1,1)
  1.  Q
  1.  ;
  1. QRFQI ; INCOMING QRF SEGMENT
  1.  S IBECADM=$$GET^HLOPRS(.SEG,2,1,1,1)
  1.  S IBECADM=$$HL7TFM^XLFDT(IBECADM)
  1.  Q
  1.  ;
  1.  ;--------------------------------------------------INCOMING DSR --------------------------
  1. DSRIN ;MAIN ENTRY POINT - incoming DSR message
  1.  ;
  1.  N IBMSG,HDR,SEG,XXX,DFN,IBAGG
  1.  S IBERR=0,IBAGG=1
  1.  S XXX=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.HDR)
  1.  F  Q:'$$NEXTSEG^HLOPRS(.IBMSG,.SEG)  S IBSEGT=$G(SEG("SEGMENT TYPE")) Q:IBSEGT=""  D
  1.  . I IBSEGT="MSA" D MSA1
  1.  . I IBSEGT="QRD" D QRDDI
  1.  . I IBSEGT="DSP" D DSPDI
  1.  . I IBSEGT="ERR" D ERR1($$GET^HLOPRS(.SEG,6,1))
  1.  Q
  1.  ;
  1. MSA1 ;PULL 351 REFERENCE NUMBER
  1.  S IBCLDA=IBMSG("HDR","MESSAGE CONTROL ID")
  1.  S IB778=$P($$GET^HLOPRS(.SEG,2,1,1)," ",2)
  1.  Q
  1.  ;
  1. QRDDI  ;INCOMING QRD SEGMENT
  1.  ;N IBQRYDT
  1.  S IBQRYDT=$$GET^HLOPRS(.SEG,1,1,1)       ;QUERY DATE/TIME
  1.  S IBICN=$$GET^HLOPRS(.SEG,9,1,1,1)         ;Pt ICN
  1.  S DFN=$$DFN^IBARXMU(IBICN)
  1.  S IBADMIT=$$GET^HLOPRS(.SEG,11,1,1,1)
  1.  S IBDISCH=$$GET^HLOPRS(.SEG,12,1,1,1)
  1.  Q
  1. DSPDI   ;INCOMING DSP SEGMENT
  1.  N IBSETID,IBCLDT,IB901,IB902,IB903,IB904,IBICLDAY,IBICLDT,IBSETID1,IBCLDT1,IB9011,IB9021,IB9031,IB9041,IBCLDAY1,IBICKDT,IBACTC,IBCKNUM,IBICNUM
  1.  N IBCNT,IBDA,IBCNDT,IBQRYS,IBCBDT,IBDA1,IBICLNDT,IBERRMSG,IBODISCH,IBOADMIN,IBQRY,IBCRTST
  1.  S IBERRMSG=$$GET^HLOPRS(.SEG,5,1)    ;Result Messages/Errors
  1.  I IBERRMSG'="" D ERR1(IBERRMSG) Q
  1.  S IBCNT=$$GET^HLOPRS(.SEG,1,1)
  1.  S IBISETID=$$GET^HLOPRS(.SEG,3,1)     ;FT1 Response - bjr
  1.  S IBICLDT=$$GET^HLOPRS(.SEG,3,2)      ;Billing Clock start date - bjr
  1.  S IBICLDT=$$HL7TFM^XLFDT(IBICLDT)        ;convert HL7 date TO FM - bjr
  1.  S IBI901=$$GET^HLOPRS(.SEG,3,3)       ;1st QRT charges - bjr
  1.  S IBI902=$$GET^HLOPRS(.SEG,3,4)       ;2nd QRT charges - bjr
  1.  S IBI903=$$GET^HLOPRS(.SEG,3,5)       ;3rd QRT charges - bjr
  1.  S IBI904=$$GET^HLOPRS(.SEG,3,6)       ;4th QRT charges - bjr
  1.  S IBICLDAY=$$GET^HLOPRS(.SEG,3,7)     ;Inpatient days - bjr
  1.  S IBICLNDT=$$GET^HLOPRS(.SEG,3,8)     ;Billing clock end date - bjr
  1.  S IBICLNDT=$$HL7TFM^XLFDT(IBICLNDT)      ;HL7 TO FM - bjr
  1.  S IBICKDT=IBICLNDT
  1.  ;RRA currently nothing passed in the 4th field - leaving for integration with Cerner
  1.  S IBSETID1=$$GET^HLOPRS(.SEG,4,1)      ;FT2 set id (IF PRESENT)
  1.  S IBCLDT1=$$GET^HLOPRS(.SEG,4,2)     ;Billing Clock start date
  1.  S IBCLDT1=$$HL7TFM^XLFDT(IBCLDT1)      ;convert HL7 date TO FM
  1.  S IB9011=$$GET^HLOPRS(.SEG,4,3)      ;1st QRT charges
  1.  S IB9021=$$GET^HLOPRS(.SEG,4,4)      ;2nd QRT charges
  1.  S IB9031=$$GET^HLOPRS(.SEG,4,5)      ;3rd QRT charges
  1.  S IB9041=$$GET^HLOPRS(.SEG,4,6)      ;4th QRT charges
  1.  S IBCLDAY1=$$GET^HLOPRS(.SEG,4,7)    ;Inpatient days
  1.  ;S IBICKDT=$$GET^HLOPRS(.SEG,4,8)    ;Billing clock end date
  1.  ;S IBICKDT=$$HL7TFM^XLFDT(IBICKDT)    ;convert HL7 date TO FM
  1.  S IBISTAT=$$GET^HLOPRS(.SEG,6,1)    ;Clock Status
  1.  S IBCKNUM=$$GET^HLOPRS(.SEG,7,1)   ;Number of billing clocks sent (FT1)
  1.  S IBICNUM=$$GET^HLOPRS(.SEG,8,1)   ;Number of admit encounters sent (FT2) - bjr
  1.  S IBISITE=$$GET^HLOPRS(.SEG,9,1)   ;Site - bjr
  1.  I 'IBISTAT  D UDCL  Q  ;Quit if no status sent which indicates no clocks from other sites
  1.  S IBDA=";"  F  S IBDA=$O(^IBE(351,"AIVDT",DFN,-IBICLDT,IBDA),-1) Q:'IBDA  Q:$G(IBCBDT)  D
  1.  .S IBCBDT=$$GET1^DIQ(351,IBDA_",",.03,"I")
  1.  .S IBQRYS=$$GET1^DIQ(351,IBDA_",",16,"I")
  1.  .S IBCRTST=$$GET1^DIQ(351,IBDA_",",.04,"I")
  1.  .S IBDA1=IBDA
  1.  I $G(IBQRYS),IBCRTST'=3 Q
  1.  Q:(IBICLDT<1)
  1.  I $G(IBCBDT)=IBICLDT,IBCNT=1 D UPDATE^IBECECU1(IBDA1)  Q  ;Update record if current Billing Clock Start Date matches incoming Billing Clock Start Date
  1.  I IBCNT=1 D NEWREC^IBECECU1  ;IBCNT=1 MEANS THE DSR SEGMENT IS AGGREGATED DATA AND SHOULD BE STORED IN 351
  1.  I IBCNT>1 D EN^IBECECU2(IBICLDT,DFN) ;IBCNT>1 MEANS IT IS INDIVIDUAL SITE DATA USED FOR AGGREGATION AND NEEDS TO BE STORED IN 351.3
  1.  S IBADMIT=$$FMADD^XLFDT(IBICLNDT,1)
  1.  I ($$FMTHL7^XLFDT(IBICLNDT))<IBDISCH,IBCNT=1 D  ;
  1.  .S IBQRY=$O(^IBE(351,"AIVDT",DFN,-IBADMIT,";"),-1) I IBQRY,$P(^IBE(351,IBQRY,1),U,5) Q
  1.  .S IBADMIT=$$FMADD^XLFDT(IBICLNDT,1),IBDISCH=$$FMADD^XLFDT(IBADMIT,365),IBADMIT=$$FMTHL7^XLFDT(IBADMIT),IBOADMIT=IBADMIT
  1.  .S IBDISCH=$S(IBDISCH<DT:IBDISCH,1:"") I IBDISCH S IBDISCH=$$FMTHL7^XLFDT(IBDISCH),IBODISCH=IBDISCH
  1.  .K SEG,ERROR
  1.  .D MSH,QRD,QRF,SENDQRY
  1.  Q
  1.  ;
  1.  ;-------------------------------------------------- OUTGOING DSR --- ---------------------------
  1. DSROUT(ICN,IBIEN,IBADMIT) ;MAIN ENTRY POINT - Outgoing DSR message
  1.  ; IBIEN - Query Request Message IEN (#778) that initiated this response 
  1.  ; ------ Sample message ----
  1.  ;MSH|^~\&|IBECEAC-SEND|695^HL7.IVMVEE.FO-ALBANY.DOMAIN.EXT:5127^DNS|IBECEAC-RECV|200DAS^:^DNS"|20211029135630-0500||DSR^Q03^DSR_Q03|695 1480|T^|2.3|||AL|NE|USA|3211029.135631^20211029145631.228^
  1.  ;MSA|AL|0"
  1.  ;QRD|20211102091619|1|1|0|||1|DRI^DODMORE MESSAGE|1008713999V404928"
  1.  ;DSP|1||FT1^20201101^345^0^0^0^15^-1|||1|1|1"
  1.  N PARMS,SEG,MSG,VALUE,FIELD,QRYNUM,SERROR,SERR,NAME,ERROR,XXX,WHOTO
  1.  N IBSETID,IBCLDT,IB901,IB902,IB903,IB904,IBCLDAY,IBSETID1,IBCLDT1,IB9011,IB9021,IB9031,IB9041,IBCLDAY1,IBCLNDT1,IBACTC,IBCKNUM,IBICNUM
  1.  S DFN=$$DFN^IBARXMU(ICN)
  1.  I +DFN<1 S SERROR="NO PATIENT FOUND WITH SUBMITTED ICN",SERR=1
  1.  S QRYNUM=$$MSGID^HLOPRS(IBIEN)  ; Message Control ID of initiating Query 
  1.  S:$G(SERR)="" SERR=0
  1.  D EN^IBECECX1(DFN),INPT^IBECECX1(DFN)
  1. MSHO   ;  Outgoing MSH
  1.  N PARMS K ^TMP("DSR")
  1.  S PARMS("COUNTRY")="USA"
  1.  S PARMS("MESSAGE TYPE")="DSR"
  1.  S PARMS("EVENT")="Q03"
  1.  S PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
  1.  S PARMS("VERSION")="2.3"
  1.  S PARMS("MESSAGE STRUCTURE")="DSR_Q03"
  1.  S MSG="^TMP("_"DSR"
  1.  S X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
  1. MSAO   ;Outgoing MSA
  1.  D SET^HLOAPI(.SEG,"MSA",0)
  1.  D SET^HLOAPI(.SEG,"AL",1)
  1.  D SET^HLOAPI(.SEG,QRYNUM,2)
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1. QRDO   ;Outgoing QRD
  1.  D SET^HLOAPI(.SEG,"QRD",0)
  1.  S %P1=$$NOW^XLFDT() S %P1=$$FMTHL7^XLFDT(%P1)
  1.  D SET^HLOAPI(.SEG,+%P1,1)
  1.  D SET^HLOAPI(.SEG,1,2)
  1.  D SET^HLOAPI(.SEG,1,3)
  1.  D SET^HLOAPI(.SEG,+QRYNUM,4)
  1.  D SET^HLOAPI(.SEG,1,7)
  1.  S NAME=$$GET1^DIQ(2,DFN_",",.01)
  1.  D SET^HLOAPI(.SEG,$P($G(NAME),",",1),8,1)
  1.  D SET^HLOAPI(.SEG,$P($G(NAME),",",2),8,2)
  1.  D SET^HLOAPI(.SEG,ICN,9)
  1.  I $G(IBSADMIT) D SET^HLOAPI(.SEG,IBSADMIT,11)
  1.  I $G(IBSDISCH) D SET^HLOAPI(.SEG,IBSDISCH,12)
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1.  ;
  1. DSPO   ;Outgoing DSP
  1.  D SET^HLOAPI(.SEG,"DSP",0)
  1.  D SET^HLOAPI(.SEG,1,1)
  1.  D SET^HLOAPI(.SEG,"FT1",3,1)                     ;FT1 Response
  1.  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)
  1.  D SET^HLOAPI(.SEG,+IB901,3,3)                    ;1st QRT charges
  1.  D SET^HLOAPI(.SEG,+IB902,3,4)                    ;2nd QRT charges
  1.  D SET^HLOAPI(.SEG,+IB903,3,5)                    ;3rd QRT charges
  1.  D SET^HLOAPI(.SEG,+IB904,3,6)                    ;4th QRT charges
  1.  D SET^HLOAPI(.SEG,+IBCLDAY,3,7)                  ;Inpatient days
  1.  I $G(IBCLNDT) S IBCLNDT=$$FMTHL7^XLFDT(IBCLNDT) D SET^HLOAPI(.SEG,+IBCLNDT,3,8) ;Billing Clock end date (HL7 format)
  1.  ;D SET^HLOAPI(.SEG,+IBSETID1,4)                  ;FT2 set id (IF PRESENT)
  1.  ;D SET^HLOAPI(.SEG,2,4)               ;FT2 set id (IF PRESENT)
  1.  ;D SET^HLOAPI(.SEG,+IBADMIT,4,1)      ;Admit Date (Already HL7 format)
  1.  ;D SET^HLOAPI(.SEG,+IBDISCH,4,2)      ;Discharge Date (Already HL7 format)
  1.  ;D SET^HLOAPI(.SEG,+IBCLDAY,4,3)      ;Inpatient Days
  1.  ;
  1.  D SET^HLOAPI(.SEG,+IBSTAT,6)          ;Active clock sent
  1.  D SET^HLOAPI(.SEG,+IBCKNUM,7)         ;Number of billing clocks sent (FT1)
  1.  D SET^HLOAPI(.SEG,+IBICNUM,8)         ;Number of admit encounters sent (FT2)
  1.  S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
  1.  ;
  1. SENDDSR ;
  1.  S PARMS("SENDING APPLICATION")="IBECEAC-QRYRESP"
  1.  S WHOTO("RECEIVING APPLICATION")="IBECEAC-RCV"
  1.  S WHOTO("STATION NUMBER")="200DAS"
  1.  S WHOTO("MIDDLEWARE LINK NAME")="IBECEC-DSR"            ;File #870 entry
  1.  S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
  1.  Q
  1.  ;
  1. ERR1(IBERRMSG) ;HANDLE ERROR RESPONSES
  1.  ;
  1.  ;XMY,XMSUB,IBL
  1.  I IBERRMSG["MVI returned no treating facilities for this patient" D UDCL ;no error message necessary - just update the query sent field
  1.  ;MAIL MESSAGE GENERATION CODE ON HOLD FOR FUTURE REQUIREMENTS
  1.  ;K ^TMP($J,"IBCPYAC")
  1.  ;S XMSUB="COPAY PATIENT ACCUMULATOR ISSUE"
  1.  ;S XMY("G.IB PATIENT ACCUMULATOR")=""
  1.  ;S IBL=0
  1.  ;S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="ERROR RECEIVED BY DAS DURING QUERY ATTEMPT:"
  1.  ;S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
  1.  ;S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=IBERRMSG
  1.  ;S XMDUZ=DUZ,XMTEXT="^TMP($J,""IBCPYAC"","
  1.  ;D ^XMD
  1.  Q
  1. UDCL ;Update original billing clock so nightly querys are not sent for patients without TFL's
  1.  N IBSTAT,IBCLK,IBDA,IBMSG,IBHDR,SEG,IBSEGT,IBDFN,IBECDAT
  1.  S IBSTAT=$$STARTMSG^HLOPRS(.IBMSG,IB778,.IBHDR)
  1.  F  Q:'$$NEXTSEG^HLOPRS(.IBMSG,.SEG)  S IBSEGT=$G(SEG("SEGMENT TYPE")) Q:IBSEGT=""  D
  1.  . I IBSEGT="QRD" D QRDQI   ;pull the ICN out of the initiating QRY message so we can update the Billing Clock
  1.  Q:'ICN
  1.  S IBDFN=$$DFN^IBARXMU(ICN)
  1.  S IBDA=";" S IBDA=$O(^IBE(351,"ACT",IBDFN,IBDA),-1)  ;locate the most recent active Billing Clock for update
  1.  I 'IBDA S IBECDAT=$O(^IBE(351,"AIVDT",IBDFN,-9999999)) Q:'IBECDAT  S IBDA=$O(^IBE(351,"AIVDT",IBDFN,IBECDAT,";"),-1) Q:$$GET1^DIQ(351,IBDA,.04)  ;Use newest date entry when no status set
  1.  Q:'IBDA
  1.  S $P(^IBE(351,IBDA,1),"^",5)=1  ;Update QUERY SENT
  1.  Q