IBECECX1 ;BSL/DVA - BILLING EXTRACTION AND FILING UTILITIES FOR IN PATIENT ACCUMULATOR INTERFACE ; 16 May 2022 8:47 AM
;;2.0;INTEGRATED BILLING;**704,769**;21-MAR-94;Build 42
;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^DGPT("AAD",^DGPT( in ICR #418
;
Q ;No direct routine calls
;
EN(DFN) ;Retrieve existing Billing clock if present for this patient
N IBECDT,IBECLDT,IBECFDT,IBECSTP
S IBERR=0
;S IBEVFAC=+$$SITE^VASITE ;Event Facility
S IBECADM=IBADMIT_.9999
I 'DFN D NOCLOCK Q ;bjr - No billing clock data found, set all values NULL (for now)
; IBIEN = IEN of billing clock
S IBECDT=-IBECADM F S IBECDT=$O(^IBE(351,"AIVDT",DFN,IBECDT)) D Q:'IBECDT Q:$G(IBCLDT) ;Get billing clock that was active at date/time of admission
. I 'IBECDT D NOCLOCK Q
. S IBIEN=$O(^IBE(351,"AIVDT",DFN,IBECDT,";"),-1) ;Get billing clock IEN
. I IBIEN<1 D NOCLOCK Q
. S IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I") I 'IBECLDT S IBECLDT=$$FMADD^XLFDT(-IBECDT,364) ;IB*2*769 - Clock end clock start +364
. ;S IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I") I 'IBECLDT S IBECLDT=$$CLSDT(-IBECDT)
. I IBECLDT,(IBECLDT<IBECADM) D NOCLOCK Q ;Quit if billing clock closed at time of admission
. I $P(^IBE(351,IBIEN,0),U,4)=3 D NOCLOCK Q ;Don't return canceled clock
. S IBCLDT=$P(^IBE(351,IBIEN,0),U,3) ;Billing clock begin date
. K IBERROR ;Clear IBERROR flag if good clock found
. S IBSTAT=$P(^IBE(351,IBIEN,0),U,4) ;Status
. S IB901=$P(^IBE(351,IBIEN,0),U,5) ;1st QTR Billing
. S IB902=$P(^IBE(351,IBIEN,0),U,6) ;2nd QTR Billing
. S IB903=$P(^IBE(351,IBIEN,0),U,7) ;3rd QTR Billing
. S IB904=$P(^IBE(351,IBIEN,0),U,8) ;4th QTR Billing
. S IBCLDAY=$P(^IBE(351,IBIEN,0),U,9) ;Number of Inpatient days
. S IBCLNDT=+$P(^IBE(351,IBIEN,0),U,10) ;End date of 365 day clock
. S IBCLNDT=$S(IBCLNDT:IBCLNDT,1:$$FMADD^XLFDT(IBCLDT,364)) ;Calc Billing Clock end date when null
. S IBCKNUM=1 ;Number of billing clocks sent (FT1)
. S IBICNUM=1 ;Number of billing clocks sent (FT2)
. S IBSTN=$P($$GET1^DIQ(351,IBIEN_",",17)," ") ;Station Number
. S IBVRSN=+$P($$GET1^DIQ(351,IBIEN_",",17)," ",2) ;Billing Clock version number
;Look for future clocks within 1 year if no past clocks found - IB*2.0*769
I IBCLDT="" S IBECFDT=-($$FMADD^XLFDT(IBADMIT,364))_.9999,IBECSTP=-IBADMIT D
. F S IBECFDT=$O(^IBE(351,"AIVDT",DFN,IBECFDT)) D Q:'IBECFDT Q:$G(IBCLDT) Q:IBECFDT>IBECSTP ;Get billing clock that was active at date/time of admission
.. I 'IBECFDT Q
.. S IBIEN=$O(^IBE(351,"AIVDT",DFN,IBECFDT,";"),-1) ;Get billing clock IEN
.. I IBIEN<1 D NOCLOCK Q
.. S IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I") I 'IBECLDT S IBECLDT=$$FMADD^XLFDT(-IBECFDT,364)
.. I IBECLDT,(IBECLDT<IBECADM) D NOCLOCK Q ;Quit if billing clock closed at time of admission
.. I IBECLDT,(IBECLDT<DT) D NOCLOCK D Q ;Quit if future clock is closed
... S IBERROR="Billing Clock found at site #"_(DUZ(2))_" but manual review is needed"
.. I $P(^IBE(351,IBIEN,0),U,4)=3 Q ;Don't return canceled clock
.. S IBCLDT=$P(^IBE(351,IBIEN,0),U,3) ;Billing clock begin date
.. K IBERROR ;Clear IBERROR flag if good clock found
.. S IBSTAT=$P(^IBE(351,IBIEN,0),U,4) ;Status
.. S IB901=$P(^IBE(351,IBIEN,0),U,5) ;1st QTR Billing
.. S IB902=$P(^IBE(351,IBIEN,0),U,6) ;2nd QTR Billing
.. S IB903=$P(^IBE(351,IBIEN,0),U,7) ;3rd QTR Billing
.. S IB904=$P(^IBE(351,IBIEN,0),U,8) ;4th QTR Billing
.. S IBCLDAY=$P(^IBE(351,IBIEN,0),U,9) ;Number of Inpatient days
.. S IBCLNDT=+$P(^IBE(351,IBIEN,0),U,10) ;End date of 365 day clock
.. S IBCLNDT=$S(IBCLNDT:IBCLNDT,1:$$FMADD^XLFDT(IBCLDT,364)) ;Calc Billing Clock end date when null
.. S IBCKNUM=1 ;Number of billing clocks sent (FT1)
.. S IBICNUM=1 ;Number of billing clocks sent (FT2)
.. S IBSTN=$P($$GET1^DIQ(351,IBIEN_",",17)," ") ;Station Number
.. S IBVRSN=+$P($$GET1^DIQ(351,IBIEN_",",17)," ",2) ;Billing Clock version number
Q
;
INPT(DFN) ;Gather inpatient data
; Retrieve most recent Admission and Discharge dates from the PTF file
N IBIEN1
S (IBADMIT,IBDISCH)="",IBSTATION=$P($$SITE^VASITE,U,3)
Q:'$D(^DGPT("AAD",DFN)) ;quit if nothing found
S IBADMIT="9999999.9999",IBADMIT=$O(^DGPT("AAD",DFN,IBADMIT),-1),IBADM1=IBADMIT,IBIEN1=$O(^DGPT("AAD",DFN,IBADMIT,0)),IBDISCH=$P($G(^DGPT(IBIEN1,70)),U)
S IBOADMIT=$$FMTHL7^XLFDT(IBADMIT),IBADMIT=$$FMTHL7^XLFDT($P(IBADMIT,".")) ;convert admission date to HL7
I IBDISCH'="" S IBODISCH=$$FMTHL7^XLFDT(IBDISCH),IBDISCH=$$FMTHL7^XLFDT($P(IBDISCH,".")) ;Get discharge dates (HL7 format), no times needed
I $G(IBNGHTSK) S IBADMIT=$$FMTHL7^XLFDT(DT-1),IBDISCH=""
Q
;
CCINPT(DFN,IBADMIT) ;Gather inpatient data for CC billing
; Retrieve most recent Admission and Discharge dates from the PTF file
N IBIEN1
S IBDISCH="",IBSTATION=$P($$SITE^VASITE,U,3)
Q:'$D(^DGPT("AAD",DFN)) ;quit if nothing found
S IBADMIT=IBADMIT_".9999",IBADMIT=$O(^DGPT("AAD",DFN,IBADMIT),-1),IBADM1=IBADMIT I IBADMIT S IBIEN1=$O(^DGPT("AAD",DFN,IBADMIT,0)),IBDISCH=$P($G(^DGPT(IBIEN1,70)),U)
I IBADMIT,$G(IBFR)>IBADMIT S IBADMIT=IBFR ;If bill date is greater than admit date, use bill date for query
I IBADMIT S IBOADMIT=$$FMTHL7^XLFDT(IBADMIT),IBADMIT=$$FMTHL7^XLFDT($P(IBADMIT,".")) ;convert admission date to HL7
I IBDISCH,IBFR>IBDISCH S IBDISCH=IBFR ;If bill date is greater than discharge date, use bill date for query
I IBDISCH'="" S IBODISCH=$$FMTHL7^XLFDT(IBDISCH),IBDISCH=$$FMTHL7^XLFDT($P(IBDISCH,".")) ;Get discharge dates (HL7 format), no times needed
Q
;
NOCLOCK ;Set variables if no clock found
S (IBIEN,IEN,IBCLNDT,IB901,IB902,IB903,IB904,IBCLDAY,IBCKNUM,IBICNUM,IBSTAT,IBSTN,IBVRSN)="" S:$G(IBCLDT)="" IBCLDT=""
S IBERROR="NO MEANS TEST BILLING CLOCK FOUND"
Q
CLSDT(IBECDT) ;Calculate billing clock closed date taking into acct leap year
N IBYEAR,IBMTHDAY,IBLEAP,IBECLDT
S IBYEAR=$E(IBECDT,1,3),IBMTHDAY=$E(IBECDT,4,7)
I IBMTHDAY<=229 S IBLEAP=$$LEAP^XLFDT3(IBYEAR)
I IBMTHDAY>229 S IBLEAP=$$LEAP^XLFDT3(IBYEAR+1)
I IBLEAP S IBECLDT=$$FMADD^XLFDT(IBECDT,365) Q IBECLDT
I 'IBLEAP S IBECLDT=$$FMADD^XLFDT(IBECDT,364) Q IBECLDT
Q IBECLDT
VRSNCHK(IB351IEN) ;Verify Version matches incoming versions
N IBECVSN
;Quit if nothing to compare in IBVARRY
Q:'$D(IBVARRY) 0
;CHECK VERSION ARRAY, SHOULD BE ONLY ONE SUBSCRIPT SO $O AND REVERSE $O SHOULD RETURN THE SAME RESULTS
I $O(IBVARRY(""))'=$O(IBVARRY(";"),-1) Q 1
;GET CURRENT CLOCK VERSION - IF BLANK, FILE IT (FIRST CLOCK?) AND COMPARE REMAINING DSP DATA
S IBECVSN=$$GET1^DIQ(351,IB351IEN_",",17) I IBECVSN="" D Q 0
.L +^IBE(351,IB351IEN):$G(DILOCKTM,5) Q:'$T
.S DIE="^IBE(351,",DA=IB351IEN,DR="17///"_$O(IBVARRY("")) D ^DIE
.L -^IBE(351,IB351IEN)
;version stored does not match the version in query indicating clock out of sync (version stored could be from Query Results)
I $O(IBVARRY(""))'=IBECVSN Q 1
Q 0
GETIEN(DFN,IBADM1) ;Get Means Test Billing clock (#351) file ien
N IBECX,IBIEN,IBDA,IBDAS,IBCLDT,IBFUTCL
S IBIEN=0
S IBECX=-$P(IBADM1,".")_.9999 F S IBECX=$O(^IBE(351,"AIVDT",DFN,IBECX)) Q:'IBECX D Q:$G(IBIEN)
.I IBECX S IBDA=";" F S IBDA=$O(^IBE(351,"AIVDT",DFN,IBECX,IBDA),-1) Q:'IBDA Q:$G(IBIEN) S IBDAS=IBDA_"," I $$GET1^DIQ(351,IBDAS,.04,"I")'=3 D Q
..S IBCLDT=($$FMADD^XLFDT(-IBECX,364)) ;
..S IBIEN=IBDA
..I IBADM1>=IBCLDT S IBIEN=0
I IBIEN Q IBIEN
;Search for future clock that this could fall under
S IBFUTCL=$$FMADD^XLFDT(IBADM1,364) I IBFUTCL<DT Q 0
S IBECX=-$P(IBFUTCL,".")_.9999 F S IBECX=$O(^IBE(351,"AIVDT",DFN,IBECX)) Q:'IBECX D Q:$G(IBIEN)
.I IBECX S IBDA=";" F S IBDA=$O(^IBE(351,"AIVDT",DFN,IBECX,IBDA),-1) Q:'IBDA S IBDAS=IBDA_"," I $$GET1^DIQ(351,IBDAS,.04,"I")'=3 D Q
..S IBCLDT=($$FMADD^XLFDT(-IBECX,364))
..S IBIEN=IBDA
..I IBADM1>=IBCLDT S IBIEN=0
Q IBIEN
;
WRAP(IBCOL1,IBCOL2,IBTEXT) ;Wrap text in IBTEXT variable
; Input Parameters Description:
; IBCOL1: Left Column to start
; IBCOL2: Cols to wrap in
; IBTEXT: Text to wrap
;
N IBTEXTO,IBX
S IBX=0
F Q:'$L(IBTEXT) D
.F IBTEXTO=IBCOL2:-1:0 I $E(IBTEXT,IBTEXTO)=" " S IBX=IBX+1,IBTEXT(IBX)="" Q
.S:IBTEXTO<1 IBTEXTO=IBCOL2
.S IBTEXT(IBX)=IBTEXT(IBX)_$E(IBTEXT,1,IBTEXTO)
.S IBTEXT=$E(IBTEXT,IBTEXTO+1,$L(IBTEXT))
Q
ERR1(IBERRMSG) ;Handle error responses for network and software failure issues
;
N XMY,XMSUB,IBL,IB3513D,IBTEXT,IBX,XMDUZ,XMTEXT
;IB*2*769 VDIF call to MVI prior to query to ensure patient has Treating Facilities - VDIF will not return any errors for this
;I IBERRMSG["MVI returned no treating facilities for this patient" D UDCL Q ;no error message necessary - just update the query sent field
;MAIL MESSAGE GENERATION CODE ON HOLD FOR FUTURE REQUIREMENTS
K ^TMP($J,"IBCPYAC")
S XMSUB="COPAY PATIENT ACCUMULATOR ISSUE"
S XMY("G.IB PATIENT ACCUMULATOR")=""
S IBL=0
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="ERROR RECEIVED BY VDIF DURING COPAY ACCUMULATOR EVENT:"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBTEXT=IBERRMSG D WRAP(0,80,.IBTEXT)
S IBX=0 F S IBX=$O(IBTEXT(IBX)) Q:'IBX D
.S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=IBTEXT(IBX)
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="As a result, the billing clock will not be synced up enterprise wide."
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="Resolution will require an IT ticket to fix the issue(s)"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="and manual update of billing clocks."
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="Only one IT ticket needs to be created for an episode of care,"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="as a Mailman message will be sent daily while the error persists,"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="and the veteran remains in an inpatient setting."
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="When creating a ticket, please include the following:"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
I $D(IBID) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="HLO MESSAGE ID: "_IBID
I $D(IBERRS) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="STATION WITH ERROR RESPONSE: "_IBERRS
I $D(IB351IEN) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK (#351) IEN: "_IB351IEN
I $D(DFN) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="PATIENT DFN: "_DFN
I $D(IBICLDTS) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="CLOCK START DATE: "_IBICLDTS
I $D(IBCLDAU) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="CLOCK VERSION: "_IBCLDAU
I $D(IB3513) D ;MEANS TEST BILLING CLOCK VERIFY DATA
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK VERIFY (351.3) - RECORD IEN "_+$O(IB3513(0))
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="STATION #"_" "_"CLOCK VERSION"
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="----------------------------------"
. S IB3513D=0
. F S IB3513D=$O(IB3513(IB3513D)) Q:'IB3513D S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=$P(IB3513D,"^",2)_" "_$P(IB3513D,"^",3)
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="For full Query Response details, review the logs from the MEANS TEST"
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="BILLING CLOCK VERIFY (351.3) file."
S XMDUZ=DUZ,XMTEXT="^TMP($J,""IBCPYAC"","
D ^XMD
Q
;
ERR2(IBERRMSG) ;Handle error responses for Clock Discrepancy issues
;
N XMY,XMSUB,IBL,IB3513D,IBTEXT,IBX,XMDUZ,XMTEXT
;IB*2*769 VDIF call to MVI prior to query to ensure patient has Treating Facilities - VDIF will not return any errors for this
;MAIL MESSAGE GENERATION CODE ON HOLD FOR FUTURE REQUIREMENTS
K ^TMP($J,"IBCPYAC")
S XMSUB="COPAY PATIENT ACCUMULATOR ISSUE"
S XMY("G.IB PATIENT ACCUMULATOR")=""
S IBL=0
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="BILLING CLOCK DISCREPANCY FOUND BETWEEN VA FACILITIES:"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBTEXT=IBERRMSG D WRAP(0,80,.IBTEXT)
S IBX=0 F S IBX=$O(IBTEXT(IBX)) Q:'IBX D
.S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=IBTEXT(IBX)
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="As a result, the billing clock will not be synced up enterprise wide."
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="Resolution will require researching encounters at the sites listed below"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="to determine the correct clock values and manually update billing clocks."
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="Billing clock and error details and other sites with clocks:"
S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
I $D(IBID) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="HLO MESSAGE ID: "_IBID
I $D(IBERRS) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="STATION WITH ERROR RESPONSE: "_IBERRS
I $D(IB351IEN) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK (#351) IEN: "_IB351IEN
I $D(DFN) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="PATIENT DFN: "_DFN
I $D(IBICLDTS) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="CLOCK START DATE: "_IBICLDTS
I $D(IBCLDAU) S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="CLOCK VERSION: "_IBCLDAU
I $D(IB3513) D ;MEANS TEST BILLING CLOCK VERIFY DATA
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK VERIFY (351.3) - RECORD IEN "_+$O(IB3513(0))
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="STATION #"_" "_"CLOCK VERSION"
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="----------------------------------"
. S IB3513D=0
. F S IB3513D=$O(IB3513(IB3513D)) Q:'IB3513D S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=$P(IB3513D,"^",2)_" "_$P(IB3513D,"^",3)
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)=""
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="For full Query Response details, review the logs from the MEANS TEST"
. S IBL=IBL+1,^TMP($J,"IBCPYAC",IBL)="BILLING CLOCK VERIFY (351.3) file."
S XMDUZ=DUZ,XMTEXT="^TMP($J,""IBCPYAC"","
D ^XMD
Q
;
UDCL ;Update original billing clock so nightly querys are not sent for patients without TFL's
Q:'$G(IB351IEN)
S $P(^IBE(351,IB351IEN,1),"^",5)=1 ;Update QUERY SENT
Q
;
EDTCLCK(DFN,IBADMIT,IBCURIEN) ;Called from Billing Clock Maintenance option
N IBTRYTIL,IBECDT,IBECLDT,IBECIEN,IBECSTDT,IBECENDT,IBECDT1,ICN,IBECADM,IBSADMIT,IBSDISCH,IBQRYDT,IBREFNUM,IBMES,HDR,IBINST,IBSTATION
I '$$ICN^IBARXMU(DFN) S IBFLAG1=1 Q ;Do not run query if patient does not have an ICN
S IBTFL=$$TFL^IBARXMU(DFN,.IBTFL,2) I 'IBTFL S IBFLAG1=1 Q ;Quit if patient has no other TFL's
;send clock start date ad admit date when editing billing clock
;D CCINPT(DFN,IBADMIT)
S IBDISCH="",IBSTATION=$P($$SITE^VASITE,U,3),IBADM1=IBADMIT
D MTEQRY^IBECECQ1(DFN,IBADM1) ;Run Query
N IBMSG,HDR,SEG,XXX,DFN,IBVARRY,IBECERR,IBECNIEN,IBID,IBICLDTS,IBDISCH
W !,"Running Billing Clock Query, please wait."
;Wait clock for up to 2 minutes until DSR returned from billing clock query
S IBFLAG1=0 S IBTRYTIL=$$FMADD^XLFDT($$NOW^XLFDT,,,2) F Q:$$NOW^XLFDT>IBTRYTIL Q:IBFLAG1 D
.H 2 W "." Q:IBFLAG1 S HLMSGIEN=MSG("IEN"),IBMES=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.HDR) S HLMSGIEN=$G(IBMSG("ACK BY IEN")) I HLMSGIEN D
..S IBERR=0,IBERRMSG=""
..S XXX=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.HDR)
..F Q:'$$NEXTSEG^HLOPRS(.IBMSG,.SEG) S IBSEGT=$G(SEG("SEGMENT TYPE")) Q:IBSEGT="" D
...I IBSEGT="MSA" D MSA1^IBECECQ1
...I IBSEGT="QRD" D QRDDI^IBECECQ1
...I IBSEGT="DSP" S:$$GET^HLOPRS(.SEG,5,1)["Billing Clock found at site #" IBERRMSG=$$GET^HLOPRS(.SEG,5,1) S IBCNT=$$GET^HLOPRS(.SEG,1,1) I IBCNT>1 D
....S IBSTATION=$$GET^HLOPRS(.SEG,9,1) ;Station Number
....I IBSTATION'="" D FIND^DIC(4,,.01,"MX",IBSTATION,,"D",,,"IBLIST","IBERR") D
.....S IBINST=IBLIST("DILIST",1,1),IBECARY(IBINST)="" ;Institution array for error messaging
..;I IBERRMSG["MVI returned no treating facilities for this patient" S IBERRMSG=""
..;I IBERRMSG["NO MEANS TEST BILLING CLOCK FOUND" S IBERRMSG=""
..;I IBERRMSG["No Member found" S IBERRMSG="" ;IB*2.0*769 Clear error message for HBM no Member response
..H 4 I IBERRMSG'="" S IBFLAG1=1 Q
..S IBECERR=0 ;IBECERR - FLAG TO DETERMINE IF VERSIONING OUT OF SYNC
..I IBERRMSG="" S IBECDA=$S(+IB351IEN:IB351IEN,1:$G(IBECNIEN)) I IBECDA S IBECERR=$$GET1^DIQ(351,IBECDA,18) I IBECERR="YES" D ;DSR returned with query results - now validate the results based on clock version
...S IBERRMSG="Query results contain inconsistent versioning - indicating MEANS TEST BILLING CLOCKs may be out of sync."
..S IBFLAG1=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECECX1 17038 printed Sep 23, 2025@19:57:56 Page 2
IBECECX1 ;BSL/DVA - BILLING EXTRACTION AND FILING UTILITIES FOR IN PATIENT ACCUMULATOR INTERFACE ; 16 May 2022 8:47 AM
+1 ;;2.0;INTEGRATED BILLING;**704,769**;21-MAR-94;Build 42
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^DGPT("AAD",^DGPT( in ICR #418
+5 ;
+6 ;No direct routine calls
QUIT
+7 ;
EN(DFN) ;Retrieve existing Billing clock if present for this patient
+1 NEW IBECDT,IBECLDT,IBECFDT,IBECSTP
+2 SET IBERR=0
+3 ;S IBEVFAC=+$$SITE^VASITE ;Event Facility
+4 SET IBECADM=IBADMIT_.9999
+5 ;bjr - No billing clock data found, set all values NULL (for now)
IF 'DFN
DO NOCLOCK
QUIT
+6 ; IBIEN = IEN of billing clock
+7 ;Get billing clock that was active at date/time of admission
SET IBECDT=-IBECADM
FOR
SET IBECDT=$ORDER(^IBE(351,"AIVDT",DFN,IBECDT))
Begin DoDot:1
+8 IF 'IBECDT
DO NOCLOCK
QUIT
+9 ;Get billing clock IEN
SET IBIEN=$ORDER(^IBE(351,"AIVDT",DFN,IBECDT,";"),-1)
+10 IF IBIEN<1
DO NOCLOCK
QUIT
+11 ;IB*2*769 - Clock end clock start +364
SET IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I")
IF 'IBECLDT
SET IBECLDT=$$FMADD^XLFDT(-IBECDT,364)
+12 ;S IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I") I 'IBECLDT S IBECLDT=$$CLSDT(-IBECDT)
+13 ;Quit if billing clock closed at time of admission
IF IBECLDT
IF (IBECLDT<IBECADM)
DO NOCLOCK
QUIT
+14 ;Don't return canceled clock
IF $PIECE(^IBE(351,IBIEN,0),U,4)=3
DO NOCLOCK
QUIT
+15 ;Billing clock begin date
SET IBCLDT=$PIECE(^IBE(351,IBIEN,0),U,3)
+16 ;Clear IBERROR flag if good clock found
KILL IBERROR
+17 ;Status
SET IBSTAT=$PIECE(^IBE(351,IBIEN,0),U,4)
+18 ;1st QTR Billing
SET IB901=$PIECE(^IBE(351,IBIEN,0),U,5)
+19 ;2nd QTR Billing
SET IB902=$PIECE(^IBE(351,IBIEN,0),U,6)
+20 ;3rd QTR Billing
SET IB903=$PIECE(^IBE(351,IBIEN,0),U,7)
+21 ;4th QTR Billing
SET IB904=$PIECE(^IBE(351,IBIEN,0),U,8)
+22 ;Number of Inpatient days
SET IBCLDAY=$PIECE(^IBE(351,IBIEN,0),U,9)
+23 ;End date of 365 day clock
SET IBCLNDT=+$PIECE(^IBE(351,IBIEN,0),U,10)
+24 ;Calc Billing Clock end date when null
SET IBCLNDT=$SELECT(IBCLNDT:IBCLNDT,1:$$FMADD^XLFDT(IBCLDT,364))
+25 ;Number of billing clocks sent (FT1)
SET IBCKNUM=1
+26 ;Number of billing clocks sent (FT2)
SET IBICNUM=1
+27 ;Station Number
SET IBSTN=$PIECE($$GET1^DIQ(351,IBIEN_",",17)," ")
+28 ;Billing Clock version number
SET IBVRSN=+$PIECE($$GET1^DIQ(351,IBIEN_",",17)," ",2)
End DoDot:1
if 'IBECDT
QUIT
if $GET(IBCLDT)
QUIT
+29 ;Look for future clocks within 1 year if no past clocks found - IB*2.0*769
+30 IF IBCLDT=""
SET IBECFDT=-($$FMADD^XLFDT(IBADMIT,364))_.9999
SET IBECSTP=-IBADMIT
Begin DoDot:1
+31 ;Get billing clock that was active at date/time of admission
FOR
SET IBECFDT=$ORDER(^IBE(351,"AIVDT",DFN,IBECFDT))
Begin DoDot:2
+32 IF 'IBECFDT
QUIT
+33 ;Get billing clock IEN
SET IBIEN=$ORDER(^IBE(351,"AIVDT",DFN,IBECFDT,";"),-1)
+34 IF IBIEN<1
DO NOCLOCK
QUIT
+35 SET IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I")
IF 'IBECLDT
SET IBECLDT=$$FMADD^XLFDT(-IBECFDT,364)
+36 ;Quit if billing clock closed at time of admission
IF IBECLDT
IF (IBECLDT<IBECADM)
DO NOCLOCK
QUIT
+37 ;Quit if future clock is closed
IF IBECLDT
IF (IBECLDT<DT)
DO NOCLOCK
Begin DoDot:3
+38 SET IBERROR="Billing Clock found at site #"_(DUZ(2))_" but manual review is needed"
End DoDot:3
QUIT
+39 ;Don't return canceled clock
IF $PIECE(^IBE(351,IBIEN,0),U,4)=3
QUIT
+40 ;Billing clock begin date
SET IBCLDT=$PIECE(^IBE(351,IBIEN,0),U,3)
+41 ;Clear IBERROR flag if good clock found
KILL IBERROR
+42 ;Status
SET IBSTAT=$PIECE(^IBE(351,IBIEN,0),U,4)
+43 ;1st QTR Billing
SET IB901=$PIECE(^IBE(351,IBIEN,0),U,5)
+44 ;2nd QTR Billing
SET IB902=$PIECE(^IBE(351,IBIEN,0),U,6)
+45 ;3rd QTR Billing
SET IB903=$PIECE(^IBE(351,IBIEN,0),U,7)
+46 ;4th QTR Billing
SET IB904=$PIECE(^IBE(351,IBIEN,0),U,8)
+47 ;Number of Inpatient days
SET IBCLDAY=$PIECE(^IBE(351,IBIEN,0),U,9)
+48 ;End date of 365 day clock
SET IBCLNDT=+$PIECE(^IBE(351,IBIEN,0),U,10)
+49 ;Calc Billing Clock end date when null
SET IBCLNDT=$SELECT(IBCLNDT:IBCLNDT,1:$$FMADD^XLFDT(IBCLDT,364))
+50 ;Number of billing clocks sent (FT1)
SET IBCKNUM=1
+51 ;Number of billing clocks sent (FT2)
SET IBICNUM=1
+52 ;Station Number
SET IBSTN=$PIECE($$GET1^DIQ(351,IBIEN_",",17)," ")
+53 ;Billing Clock version number
SET IBVRSN=+$PIECE($$GET1^DIQ(351,IBIEN_",",17)," ",2)
End DoDot:2
if 'IBECFDT
QUIT
if $GET(IBCLDT)
QUIT
if IBECFDT>IBECSTP
QUIT
End DoDot:1
+54 QUIT
+55 ;
INPT(DFN) ;Gather inpatient data
+1 ; Retrieve most recent Admission and Discharge dates from the PTF file
+2 NEW IBIEN1
+3 SET (IBADMIT,IBDISCH)=""
SET IBSTATION=$PIECE($$SITE^VASITE,U,3)
+4 ;quit if nothing found
if '$DATA(^DGPT("AAD",DFN))
QUIT
+5 SET IBADMIT="9999999.9999"
SET IBADMIT=$ORDER(^DGPT("AAD",DFN,IBADMIT),-1)
SET IBADM1=IBADMIT
SET IBIEN1=$ORDER(^DGPT("AAD",DFN,IBADMIT,0))
SET IBDISCH=$PIECE($GET(^DGPT(IBIEN1,70)),U)
+6 ;convert admission date to HL7
SET IBOADMIT=$$FMTHL7^XLFDT(IBADMIT)
SET IBADMIT=$$FMTHL7^XLFDT($PIECE(IBADMIT,"."))
+7 ;Get discharge dates (HL7 format), no times needed
IF IBDISCH'=""
SET IBODISCH=$$FMTHL7^XLFDT(IBDISCH)
SET IBDISCH=$$FMTHL7^XLFDT($PIECE(IBDISCH,"."))
+8 IF $GET(IBNGHTSK)
SET IBADMIT=$$FMTHL7^XLFDT(DT-1)
SET IBDISCH=""
+9 QUIT
+10 ;
CCINPT(DFN,IBADMIT) ;Gather inpatient data for CC billing
+1 ; Retrieve most recent Admission and Discharge dates from the PTF file
+2 NEW IBIEN1
+3 SET IBDISCH=""
SET IBSTATION=$PIECE($$SITE^VASITE,U,3)
+4 ;quit if nothing found
if '$DATA(^DGPT("AAD",DFN))
QUIT
+5 SET IBADMIT=IBADMIT_".9999"
SET IBADMIT=$ORDER(^DGPT("AAD",DFN,IBADMIT),-1)
SET IBADM1=IBADMIT
IF IBADMIT
SET IBIEN1=$ORDER(^DGPT("AAD",DFN,IBADMIT,0))
SET IBDISCH=$PIECE($GET(^DGPT(IBIEN1,70)),U)
+6 ;If bill date is greater than admit date, use bill date for query
IF IBADMIT
IF $GET(IBFR)>IBADMIT
SET IBADMIT=IBFR
+7 ;convert admission date to HL7
IF IBADMIT
SET IBOADMIT=$$FMTHL7^XLFDT(IBADMIT)
SET IBADMIT=$$FMTHL7^XLFDT($PIECE(IBADMIT,"."))
+8 ;If bill date is greater than discharge date, use bill date for query
IF IBDISCH
IF IBFR>IBDISCH
SET IBDISCH=IBFR
+9 ;Get discharge dates (HL7 format), no times needed
IF IBDISCH'=""
SET IBODISCH=$$FMTHL7^XLFDT(IBDISCH)
SET IBDISCH=$$FMTHL7^XLFDT($PIECE(IBDISCH,"."))
+10 QUIT
+11 ;
NOCLOCK ;Set variables if no clock found
+1 SET (IBIEN,IEN,IBCLNDT,IB901,IB902,IB903,IB904,IBCLDAY,IBCKNUM,IBICNUM,IBSTAT,IBSTN,IBVRSN)=""
if $GET(IBCLDT)=""
SET IBCLDT=""
+2 SET IBERROR="NO MEANS TEST BILLING CLOCK FOUND"
+3 QUIT
CLSDT(IBECDT) ;Calculate billing clock closed date taking into acct leap year
+1 NEW IBYEAR,IBMTHDAY,IBLEAP,IBECLDT
+2 SET IBYEAR=$EXTRACT(IBECDT,1,3)
SET IBMTHDAY=$EXTRACT(IBECDT,4,7)
+3 IF IBMTHDAY<=229
SET IBLEAP=$$LEAP^XLFDT3(IBYEAR)
+4 IF IBMTHDAY>229
SET IBLEAP=$$LEAP^XLFDT3(IBYEAR+1)
+5 IF IBLEAP
SET IBECLDT=$$FMADD^XLFDT(IBECDT,365)
QUIT IBECLDT
+6 IF 'IBLEAP
SET IBECLDT=$$FMADD^XLFDT(IBECDT,364)
QUIT IBECLDT
+7 QUIT IBECLDT
VRSNCHK(IB351IEN) ;Verify Version matches incoming versions
+1 NEW IBECVSN
+2 ;Quit if nothing to compare in IBVARRY
+3 if '$DATA(IBVARRY)
QUIT 0
+4 ;CHECK VERSION ARRAY, SHOULD BE ONLY ONE SUBSCRIPT SO $O AND REVERSE $O SHOULD RETURN THE SAME RESULTS
+5 IF $ORDER(IBVARRY(""))'=$ORDER(IBVARRY(";"),-1)
QUIT 1
+6 ;GET CURRENT CLOCK VERSION - IF BLANK, FILE IT (FIRST CLOCK?) AND COMPARE REMAINING DSP DATA
+7 SET IBECVSN=$$GET1^DIQ(351,IB351IEN_",",17)
IF IBECVSN=""
Begin DoDot:1
+8 LOCK +^IBE(351,IB351IEN):$GET(DILOCKTM,5)
if '$TEST
QUIT
+9 SET DIE="^IBE(351,"
SET DA=IB351IEN
SET DR="17///"_$ORDER(IBVARRY(""))
DO ^DIE
+10 LOCK -^IBE(351,IB351IEN)
End DoDot:1
QUIT 0
+11 ;version stored does not match the version in query indicating clock out of sync (version stored could be from Query Results)
+12 IF $ORDER(IBVARRY(""))'=IBECVSN
QUIT 1
+13 QUIT 0
GETIEN(DFN,IBADM1) ;Get Means Test Billing clock (#351) file ien
+1 NEW IBECX,IBIEN,IBDA,IBDAS,IBCLDT,IBFUTCL
+2 SET IBIEN=0
+3 SET IBECX=-$PIECE(IBADM1,".")_.9999
FOR
SET IBECX=$ORDER(^IBE(351,"AIVDT",DFN,IBECX))
if 'IBECX
QUIT
Begin DoDot:1
+4 IF IBECX
SET IBDA=";"
FOR
SET IBDA=$ORDER(^IBE(351,"AIVDT",DFN,IBECX,IBDA),-1)
if 'IBDA
QUIT
if $GET(IBIEN)
QUIT
SET IBDAS=IBDA_","
IF $$GET1^DIQ(351,IBDAS,.04,"I")'=3
Begin DoDot:2
+5 ;
SET IBCLDT=($$FMADD^XLFDT(-IBECX,364))
+6 SET IBIEN=IBDA
+7 IF IBADM1>=IBCLDT
SET IBIEN=0
End DoDot:2
QUIT
End DoDot:1
if $GET(IBIEN)
QUIT
+8 IF IBIEN
QUIT IBIEN
+9 ;Search for future clock that this could fall under
+10 SET IBFUTCL=$$FMADD^XLFDT(IBADM1,364)
IF IBFUTCL<DT
QUIT 0
+11 SET IBECX=-$PIECE(IBFUTCL,".")_.9999
FOR
SET IBECX=$ORDER(^IBE(351,"AIVDT",DFN,IBECX))
if 'IBECX
QUIT
Begin DoDot:1
+12 IF IBECX
SET IBDA=";"
FOR
SET IBDA=$ORDER(^IBE(351,"AIVDT",DFN,IBECX,IBDA),-1)
if 'IBDA
QUIT
SET IBDAS=IBDA_","
IF $$GET1^DIQ(351,IBDAS,.04,"I")'=3
Begin DoDot:2
+13 SET IBCLDT=($$FMADD^XLFDT(-IBECX,364))
+14 SET IBIEN=IBDA
+15 IF IBADM1>=IBCLDT
SET IBIEN=0
End DoDot:2
QUIT
End DoDot:1
if $GET(IBIEN)
QUIT
+16 QUIT IBIEN
+17 ;
WRAP(IBCOL1,IBCOL2,IBTEXT) ;Wrap text in IBTEXT variable
+1 ; Input Parameters Description:
+2 ; IBCOL1: Left Column to start
+3 ; IBCOL2: Cols to wrap in
+4 ; IBTEXT: Text to wrap
+5 ;
+6 NEW IBTEXTO,IBX
+7 SET IBX=0
+8 FOR
if '$LENGTH(IBTEXT)
QUIT
Begin DoDot:1
+9 FOR IBTEXTO=IBCOL2:-1:0
IF $EXTRACT(IBTEXT,IBTEXTO)=" "
SET IBX=IBX+1
SET IBTEXT(IBX)=""
QUIT
+10 if IBTEXTO<1
SET IBTEXTO=IBCOL2
+11 SET IBTEXT(IBX)=IBTEXT(IBX)_$EXTRACT(IBTEXT,1,IBTEXTO)
+12 SET IBTEXT=$EXTRACT(IBTEXT,IBTEXTO+1,$LENGTH(IBTEXT))
End DoDot:1
+13 QUIT
ERR1(IBERRMSG) ;Handle error responses for network and software failure issues
+1 ;
+2 NEW XMY,XMSUB,IBL,IB3513D,IBTEXT,IBX,XMDUZ,XMTEXT
+3 ;IB*2*769 VDIF call to MVI prior to query to ensure patient has Treating Facilities - VDIF will not return any errors for this
+4 ;I IBERRMSG["MVI returned no treating facilities for this patient" D UDCL Q ;no error message necessary - just update the query sent field
+5 ;MAIL MESSAGE GENERATION CODE ON HOLD FOR FUTURE REQUIREMENTS
+6 KILL ^TMP($JOB,"IBCPYAC")
+7 SET XMSUB="COPAY PATIENT ACCUMULATOR ISSUE"
+8 SET XMY("G.IB PATIENT ACCUMULATOR")=""
+9 SET IBL=0
+10 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="ERROR RECEIVED BY VDIF DURING COPAY ACCUMULATOR EVENT:"
+11 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+12 SET IBTEXT=IBERRMSG
DO WRAP(0,80,.IBTEXT)
+13 SET IBX=0
FOR
SET IBX=$ORDER(IBTEXT(IBX))
if 'IBX
QUIT
Begin DoDot:1
+14 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=IBTEXT(IBX)
End DoDot:1
+15 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+16 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="As a result, the billing clock will not be synced up enterprise wide."
+17 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="Resolution will require an IT ticket to fix the issue(s)"
+18 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="and manual update of billing clocks."
+19 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+20 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="Only one IT ticket needs to be created for an episode of care,"
+21 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="as a Mailman message will be sent daily while the error persists,"
+22 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="and the veteran remains in an inpatient setting."
+23 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+24 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="When creating a ticket, please include the following:"
+25 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+26 IF $DATA(IBID)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="HLO MESSAGE ID: "_IBID
+27 IF $DATA(IBERRS)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="STATION WITH ERROR RESPONSE: "_IBERRS
+28 IF $DATA(IB351IEN)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK (#351) IEN: "_IB351IEN
+29 IF $DATA(DFN)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="PATIENT DFN: "_DFN
+30 IF $DATA(IBICLDTS)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="CLOCK START DATE: "_IBICLDTS
+31 IF $DATA(IBCLDAU)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="CLOCK VERSION: "_IBCLDAU
+32 ;MEANS TEST BILLING CLOCK VERIFY DATA
IF $DATA(IB3513)
Begin DoDot:1
+33 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK VERIFY (351.3) - RECORD IEN "_+$ORDER(IB3513(0))
+34 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+35 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+36 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="STATION #"_" "_"CLOCK VERSION"
+37 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="----------------------------------"
+38 SET IB3513D=0
+39 FOR
SET IB3513D=$ORDER(IB3513(IB3513D))
if 'IB3513D
QUIT
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=$PIECE(IB3513D,"^",2)_" "_$PIECE(IB3513D,"^",3)
+40 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+41 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="For full Query Response details, review the logs from the MEANS TEST"
+42 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="BILLING CLOCK VERIFY (351.3) file."
End DoDot:1
+43 SET XMDUZ=DUZ
SET XMTEXT="^TMP($J,""IBCPYAC"","
+44 DO ^XMD
+45 QUIT
+46 ;
ERR2(IBERRMSG) ;Handle error responses for Clock Discrepancy issues
+1 ;
+2 NEW XMY,XMSUB,IBL,IB3513D,IBTEXT,IBX,XMDUZ,XMTEXT
+3 ;IB*2*769 VDIF call to MVI prior to query to ensure patient has Treating Facilities - VDIF will not return any errors for this
+4 ;MAIL MESSAGE GENERATION CODE ON HOLD FOR FUTURE REQUIREMENTS
+5 KILL ^TMP($JOB,"IBCPYAC")
+6 SET XMSUB="COPAY PATIENT ACCUMULATOR ISSUE"
+7 SET XMY("G.IB PATIENT ACCUMULATOR")=""
+8 SET IBL=0
+9 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="BILLING CLOCK DISCREPANCY FOUND BETWEEN VA FACILITIES:"
+10 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+11 SET IBTEXT=IBERRMSG
DO WRAP(0,80,.IBTEXT)
+12 SET IBX=0
FOR
SET IBX=$ORDER(IBTEXT(IBX))
if 'IBX
QUIT
Begin DoDot:1
+13 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=IBTEXT(IBX)
End DoDot:1
+14 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+15 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="As a result, the billing clock will not be synced up enterprise wide."
+16 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="Resolution will require researching encounters at the sites listed below"
+17 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="to determine the correct clock values and manually update billing clocks."
+18 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+19 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="Billing clock and error details and other sites with clocks:"
+20 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+21 IF $DATA(IBID)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="HLO MESSAGE ID: "_IBID
+22 IF $DATA(IBERRS)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="STATION WITH ERROR RESPONSE: "_IBERRS
+23 IF $DATA(IB351IEN)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK (#351) IEN: "_IB351IEN
+24 IF $DATA(DFN)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="PATIENT DFN: "_DFN
+25 IF $DATA(IBICLDTS)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="CLOCK START DATE: "_IBICLDTS
+26 IF $DATA(IBCLDAU)
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="CLOCK VERSION: "_IBCLDAU
+27 ;MEANS TEST BILLING CLOCK VERIFY DATA
IF $DATA(IB3513)
Begin DoDot:1
+28 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="MEANS TEST BILLING CLOCK VERIFY (351.3) - RECORD IEN "_+$ORDER(IB3513(0))
+29 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+30 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+31 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="STATION #"_" "_"CLOCK VERSION"
+32 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="----------------------------------"
+33 SET IB3513D=0
+34 FOR
SET IB3513D=$ORDER(IB3513(IB3513D))
if 'IB3513D
QUIT
SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=$PIECE(IB3513D,"^",2)_" "_$PIECE(IB3513D,"^",3)
+35 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)=""
+36 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="For full Query Response details, review the logs from the MEANS TEST"
+37 SET IBL=IBL+1
SET ^TMP($JOB,"IBCPYAC",IBL)="BILLING CLOCK VERIFY (351.3) file."
End DoDot:1
+38 SET XMDUZ=DUZ
SET XMTEXT="^TMP($J,""IBCPYAC"","
+39 DO ^XMD
+40 QUIT
+41 ;
UDCL ;Update original billing clock so nightly querys are not sent for patients without TFL's
+1 if '$GET(IB351IEN)
QUIT
+2 ;Update QUERY SENT
SET $PIECE(^IBE(351,IB351IEN,1),"^",5)=1
+3 QUIT
+4 ;
EDTCLCK(DFN,IBADMIT,IBCURIEN) ;Called from Billing Clock Maintenance option
+1 NEW IBTRYTIL,IBECDT,IBECLDT,IBECIEN,IBECSTDT,IBECENDT,IBECDT1,ICN,IBECADM,IBSADMIT,IBSDISCH,IBQRYDT,IBREFNUM,IBMES,HDR,IBINST,IBSTATION
+2 ;Do not run query if patient does not have an ICN
IF '$$ICN^IBARXMU(DFN)
SET IBFLAG1=1
QUIT
+3 ;Quit if patient has no other TFL's
SET IBTFL=$$TFL^IBARXMU(DFN,.IBTFL,2)
IF 'IBTFL
SET IBFLAG1=1
QUIT
+4 ;send clock start date ad admit date when editing billing clock
+5 ;D CCINPT(DFN,IBADMIT)
+6 SET IBDISCH=""
SET IBSTATION=$PIECE($$SITE^VASITE,U,3)
SET IBADM1=IBADMIT
+7 ;Run Query
DO MTEQRY^IBECECQ1(DFN,IBADM1)
+8 NEW IBMSG,HDR,SEG,XXX,DFN,IBVARRY,IBECERR,IBECNIEN,IBID,IBICLDTS,IBDISCH
+9 WRITE !,"Running Billing Clock Query, please wait."
+10 ;Wait clock for up to 2 minutes until DSR returned from billing clock query
+11 SET IBFLAG1=0
SET IBTRYTIL=$$FMADD^XLFDT($$NOW^XLFDT,,,2)
FOR
if $$NOW^XLFDT>IBTRYTIL
QUIT
if IBFLAG1
QUIT
Begin DoDot:1
+12 HANG 2
WRITE "."
if IBFLAG1
QUIT
SET HLMSGIEN=MSG("IEN")
SET IBMES=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.HDR)
SET HLMSGIEN=$GET(IBMSG("ACK BY IEN"))
IF HLMSGIEN
Begin DoDot:2
+13 SET IBERR=0
SET IBERRMSG=""
+14 SET XXX=$$STARTMSG^HLOPRS(.IBMSG,HLMSGIEN,.HDR)
+15 FOR
if '$$NEXTSEG^HLOPRS(.IBMSG,.SEG)
QUIT
SET IBSEGT=$GET(SEG("SEGMENT TYPE"))
if IBSEGT=""
QUIT
Begin DoDot:3
+16 IF IBSEGT="MSA"
DO MSA1^IBECECQ1
+17 IF IBSEGT="QRD"
DO QRDDI^IBECECQ1
+18 IF IBSEGT="DSP"
if $$GET^HLOPRS(.SEG,5,1)["Billing Clock found at site #"
SET IBERRMSG=$$GET^HLOPRS(.SEG,5,1)
SET IBCNT=$$GET^HLOPRS(.SEG,1,1)
IF IBCNT>1
Begin DoDot:4
+19 ;Station Number
SET IBSTATION=$$GET^HLOPRS(.SEG,9,1)
+20 IF IBSTATION'=""
DO FIND^DIC(4,,.01,"MX",IBSTATION,,"D",,,"IBLIST","IBERR")
Begin DoDot:5
+21 ;Institution array for error messaging
SET IBINST=IBLIST("DILIST",1,1)
SET IBECARY(IBINST)=""
End DoDot:5
End DoDot:4
End DoDot:3
+22 ;I IBERRMSG["MVI returned no treating facilities for this patient" S IBERRMSG=""
+23 ;I IBERRMSG["NO MEANS TEST BILLING CLOCK FOUND" S IBERRMSG=""
+24 ;I IBERRMSG["No Member found" S IBERRMSG="" ;IB*2.0*769 Clear error message for HBM no Member response
+25 HANG 4
IF IBERRMSG'=""
SET IBFLAG1=1
QUIT
+26 ;IBECERR - FLAG TO DETERMINE IF VERSIONING OUT OF SYNC
SET IBECERR=0
+27 ;DSR returned with query results - now validate the results based on clock version
IF IBERRMSG=""
SET IBECDA=$SELECT(+IB351IEN:IB351IEN,1:$GET(IBECNIEN))
IF IBECDA
SET IBECERR=$$GET1^DIQ(351,IBECDA,18)
IF IBECERR="YES"
Begin DoDot:3
+28 SET IBERRMSG="Query results contain inconsistent versioning - indicating MEANS TEST BILLING CLOCKs may be out of sync."
End DoDot:3
+29 SET IBFLAG1=1
End DoDot:2
End DoDot:1
+30 QUIT
