IBECECX1 ;BSL/DVA - BILLING EXTRACTION AND FILING UTILITIES FOR IN PATIENT ACCUMULATOR INTERFACE ; 16 May 2022 8:47 AM
;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49
;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 IBERROR,IBECDT,IBECLDT S IBERROR=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 S IBERROR="0^NO RECORDS FOUND" Q
. S IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I") I 'IBECLDT S IBECLDT=$$CLSDT(-IBECDT)
. I IBECLDT,(IBECLDT<IBECADM) D Q ;Quit if billing clock closed at time of admission
.. D NOCLOCK
. 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
. 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 IBCKNUM=1 ;Number of billing clocks sent (FT1)
. S IBICNUM=1 ;Number of billing clocks sent (FT2)
Q
;
INPT(DFN) ;Gather inpatient data
; Retrieve most recent Admission and Discharge dates from the PTF file
I $G(IBNGHTSK) S IBADMIT=DT-1,IBDISCH="" Q
S (IBADMIT,IBDISCH)=""
Q:'$D(^DGPT("AAD",DFN)) ;quit if nothing found
S IBADMIT="9999999.9999",IBADMIT=$O(^DGPT("AAD",DFN,IBADMIT),-1),IBADM1=IBADMIT,IBIEN=$O(^DGPT("AAD",DFN,IBADMIT,0)),IBDISCH=$P($G(^DGPT(IBIEN,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
Q
;
CCINPT(DFN,IBADMIT) ;Gather inpatient data for CC billing
; Retrieve most recent Admission and Discharge dates from the PTF file
S IBDISCH=""
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 IBIEN=$O(^DGPT("AAD",DFN,IBADMIT,0)),IBDISCH=$P($G(^DGPT(IBIEN,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
Q
;
NOCLOCK ;Set variables if no clock found
S (IBIEN,IBADM,IEN,IBCLNDT,IB901,IB902,IB903,IB904,IBCLDAY,IBCKNUM,IBICNUM,IBSTAT)="" S:$G(IBCLDT)="" IBCLDT=""
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) S:IBECLDT>DT IBECLDT="" Q IBECLDT
I 'IBLEAP S IBECLDT=$$FMADD^XLFDT(IBECDT,364) S:IBECLDT>DT IBECLDT="" Q IBECLDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECECX1 3906 printed Apr 09, 2024@21:18:44 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**;21-MAR-94;Build 49
+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 IBERROR,IBECDT,IBECLDT
SET IBERROR=0
+2 ;Event Facility
SET IBEVFAC=+$$SITE^VASITE
+3 SET IBECADM=IBADMIT_.9999
+4 ;bjr - No billing clock data found, set all values NULL (for now)
IF 'DFN
DO NOCLOCK
QUIT
+5 ; IBIEN = IEN of billing clock
+6 ;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
+7 IF 'IBECDT
DO NOCLOCK
QUIT
+8 ;Get billing clock IEN
SET IBIEN=$ORDER(^IBE(351,"AIVDT",DFN,IBECDT,";"),-1)
+9 IF IBIEN<1
SET IBERROR="0^NO RECORDS FOUND"
QUIT
+10 SET IBECLDT=$$GET1^DIQ(351,IBIEN_",",.1,"I")
IF 'IBECLDT
SET IBECLDT=$$CLSDT(-IBECDT)
+11 ;Quit if billing clock closed at time of admission
IF IBECLDT
IF (IBECLDT<IBECADM)
Begin DoDot:2
+12 DO NOCLOCK
End DoDot:2
QUIT
+13 ;Don't return canceled clock
IF $PIECE(^IBE(351,IBIEN,0),U,4)=3
DO NOCLOCK
QUIT
+14 ;Billing clock begin date
SET IBCLDT=$PIECE(^IBE(351,IBIEN,0),U,3)
+15 ;Status
SET IBSTAT=$PIECE(^IBE(351,IBIEN,0),U,4)
+16 ;1st QTR Billing
SET IB901=$PIECE(^IBE(351,IBIEN,0),U,5)
+17 ;2nd QTR Billing
SET IB902=$PIECE(^IBE(351,IBIEN,0),U,6)
+18 ;3rd QTR Billing
SET IB903=$PIECE(^IBE(351,IBIEN,0),U,7)
+19 ;4th QTR Billing
SET IB904=$PIECE(^IBE(351,IBIEN,0),U,8)
+20 ;Number of Inpatient days
SET IBCLDAY=$PIECE(^IBE(351,IBIEN,0),U,9)
+21 ;End date of 365 day clock
SET IBCLNDT=+$PIECE(^IBE(351,IBIEN,0),U,10)
+22 ;Number of billing clocks sent (FT1)
SET IBCKNUM=1
+23 ;Number of billing clocks sent (FT2)
SET IBICNUM=1
End DoDot:1
if 'IBECDT
QUIT
if $GET(IBCLDT)
QUIT
+24 QUIT
+25 ;
INPT(DFN) ;Gather inpatient data
+1 ; Retrieve most recent Admission and Discharge dates from the PTF file
+2 IF $GET(IBNGHTSK)
SET IBADMIT=DT-1
SET IBDISCH=""
QUIT
+3 SET (IBADMIT,IBDISCH)=""
+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 IBIEN=$ORDER(^DGPT("AAD",DFN,IBADMIT,0))
SET IBDISCH=$PIECE($GET(^DGPT(IBIEN,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 QUIT
+9 ;
CCINPT(DFN,IBADMIT) ;Gather inpatient data for CC billing
+1 ; Retrieve most recent Admission and Discharge dates from the PTF file
+2 SET IBDISCH=""
+3 ;quit if nothing found
if '$DATA(^DGPT("AAD",DFN))
QUIT
+4 SET IBADMIT=IBADMIT_".9999"
SET IBADMIT=$ORDER(^DGPT("AAD",DFN,IBADMIT),-1)
SET IBADM1=IBADMIT
IF IBADMIT
SET IBIEN=$ORDER(^DGPT("AAD",DFN,IBADMIT,0))
SET IBDISCH=$PIECE($GET(^DGPT(IBIEN,70)),U)
+5 ;convert admission date to HL7
SET IBOADMIT=$$FMTHL7^XLFDT(IBADMIT)
SET IBADMIT=$$FMTHL7^XLFDT($PIECE(IBADMIT,"."))
+6 ;Get discharge dates (HL7 format), no times needed
IF IBDISCH'=""
SET IBODISCH=$$FMTHL7^XLFDT(IBDISCH)
SET IBDISCH=$$FMTHL7^XLFDT($PIECE(IBDISCH,"."))
+7 QUIT
+8 ;
NOCLOCK ;Set variables if no clock found
+1 SET (IBIEN,IBADM,IEN,IBCLNDT,IB901,IB902,IB903,IB904,IBCLDAY,IBCKNUM,IBICNUM,IBSTAT)=""
if $GET(IBCLDT)=""
SET IBCLDT=""
+2 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)
if IBECLDT>DT
SET IBECLDT=""
QUIT IBECLDT
+6 IF 'IBLEAP
SET IBECLDT=$$FMADD^XLFDT(IBECDT,364)
if IBECLDT>DT
SET IBECLDT=""
QUIT IBECLDT
+7 QUIT
