- 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 Feb 18, 2025@23:48:03 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
