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

IBTUBOA.m

Go to the documentation of this file.
  1. IBTUBOA ;ALB/RB - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;01-JAN-01
  1. ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,192,155,276,516,608**;21-MAR-94;Build 90
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. % ; - Entry point from Taskman.
  1. ;
  1. ; IB*2.0*516 - Added ability to sort by Division, so added IBDIV as a
  1. ; subscript to most of the IBUNB entries.
  1. ;
  1. ;ARRAY VARIABLES:
  1. ; IBAVG("BILLS-I")=number of inpatient institutional claims
  1. ; IBAVG("BILLS-P")=number of inpatient professional claims
  1. ; IBAVG("EPISD-I")=number of inpt. episodes for institutional claims
  1. ; IBAVG("EPISD-P")=number of inpt. episodes for professional claims
  1. ; IBAVG("$AMNT-I")=inpatient institutional amount billed
  1. ; IBAVG("$AMNT-P")=inpatient professional amount billed
  1. ;
  1. ; IBUNB("UNBILTL")=total unbilled amount
  1. ; IBUNB("UNBILTL-MRA")=total MRA req amount
  1. ;
  1. ; IBUNB(IBDIV,"ENCNTRS")=number of outpatient encounters missing claims
  1. ; IBUNB(IBDIV,"EPISM-I")=number of inpatient episodes missing inst. claims
  1. ; IBUNB(IBDIV,"EPISM-I-MRA")=number of MRA req inpat institutional claims
  1. ; IBUNB(IBDIV,"EPISM-P")=number of inpatient episodes missing prof. claims
  1. ; IBUNB(IBDIV,"EPISM-P-MRA")=number of MRA req inpat professional claims
  1. ; IBUNB(IBDIV,"EPISM-A")=number of inpatient admissions missing claims
  1. ; (any type: Prof,Inst or both)
  1. ; IBUNB(IBDIV,"EPISM-A-MRA")=number inpt MRA req admissions missing claims
  1. ; (any type: Prof,Inst or both)
  1. ; IBUNB(IBDIV,"CPTMS-I")=number of CPT codes missing institutional claims
  1. ; IBUNB(IBDIV,"CPTMS-I-MRA")=number of MRA req CPT codes missing inst claims
  1. ; IBUNB(IBDIV,"CPTMS-P")=number of CPT codes missing professional claims
  1. ; IBUNB(IBDIV,"CPTMS-P-MRA")=number of MRA req CPT codes missing prof claims
  1. ; IBUNB(IBDIV,"PRESCRP")=number of unbilled prescriptions
  1. ; IBUNB(IBDIV,"PRESCRP-MRA")=number of MRA req prescriptions
  1. ; IBUNB(IBDIV,"UNBILIP")=unbilled inpatient amount
  1. ; IBUNB(IBDIV,"UNBILIP-MRA")=MRA req inpatient amount
  1. ; IBUNB(IBDIV,"UNBILOP")=unbilled outpatient amount
  1. ; IBUNB(IBDIV,"UNBILOP-MRA")=MRA req outpatient amount
  1. ; IBUNB(IBDIV,"UNBILRX")=unbilled prescription amount
  1. ; IBUNB(IBDIV,"UNBILRX-MRA")=MRA req prescription amount
  1. ;
  1. ;ARRAY VARIABLES FOR DM EXTRACT:
  1. ; IB(1)=Number of inpatient episodes missing institutional claims
  1. ; IB(2)=Amount of inpatient episodes missing institutional claims
  1. ; IB(3)=Number of inpatient episodes missing professional claims
  1. ; IB(4)=Amount of inpatient episodes missing professional claims
  1. ; IB(5)=Number of all inpatient episodes missing claims
  1. ; IB(6)=Amount of all inpatient episodes missing claims
  1. ; IB(7)=Number of unbilled outpatient encounters prior to 9/1/99
  1. ; IB(8)=Amount of unbilled outpatient encounters prior to 9/1/99
  1. ; IB(9)=Number of procedures without an institutional charge
  1. ; IB(10)=Amount of procedures without an institutional charge
  1. ; IB(11)=Number of procedures without a professional charge
  1. ; IB(12)=Amount of procedures without a professional charge
  1. ; IB(13)=Number of all procedures without a charge
  1. ; IB(14)=Number of encounters associated with all procedures without
  1. ; a charge
  1. ; IB(15)=Number of all encounters missing claims
  1. ; IB(16)=Amount of all encounters missing claims
  1. ; IB(17)=Number of unbilled prescriptions and refills
  1. ; IB(18)=Amount of unbilled prescriptions and refills
  1. ; IB(19)=Amount of all unbilled episodes of care
  1. ;
  1. N IB,IBAMTI,IBAMTP,IBIAV,IBIA,IBNODE,IBOE,IBPA,IBQUERY,IBRX,IBSAV,IBT
  1. N IBAMTIM,IBAMTPM,IBTYP,IBX,IBY,DFN,DGPM,I,J
  1. ;
  1. K ^TMP($J,"IBTUB-INPT"),^TMP($J,"IBTUB-OPT"),^TMP($J,"IBTUB-RX")
  1. K ^TMP($J,"IBTUB-INPT_MRA"),^TMP($J,"IBTUB-OPT_MRA"),^TMP($J,"IBTUB-RX_MRA")
  1. ;
  1. ; - Initialize DM extract variables, if necessary.
  1. I $G(IBXTRACT) D E^IBJDE(37,1) F IBX=1:1:19 S IB(IBX)=0
  1. ;
  1. ; - Initialize Unbilled Amounts variables.
  1. S (IBUNB("ENCNTRS"),IBUNB("PRESCRP"),IBUNB("PRESCRP-MRA"))=0
  1. F IBX="IP","OP","RX","TL" S IBUNB("UNBIL"_IBX)=0,IBUNB("UNBIL"_IBX_"-MRA")=0
  1. F IBX="I","P" S (IBUNB("EPISM-"_IBX),IBUNB("EPISM-"_IBX_"-MRA"),IBUNB("CPTMS-"_IBX),IBUNB("CPTMS-"_IBX_"-MRA"))=0
  1. S (IBUNB("EPISM-A"),IBUNB("EPISM-A-MRA"))=0
  1. ;
  1. ; - Retrieve the Rate Type code for Reimbursable Insurance
  1. S IBRT=$S($O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)):$O(^(0)),1:8)
  1. ;
  1. ; - If Compile/Store - Checks if the Average Bill Amounts exists for
  1. ; IBTIMON. If it does not, calls IBTUBAV to calculate/updated it.
  1. I $G(IBCOMP) D
  1. . I $P($G(^IBE(356.19,IBTIMON,1)),"^",14)'="" Q
  1. . ;
  1. . ; - DQ^IBTUBAV will kill the variables IBTIMON and IBCOMP - That's why
  1. . ; they are being set again after this call.
  1. . S IBSAV=IBTIMON D DQ^IBTUBAV S IBTIMON=IBSAV,IBCOMP=1
  1. . Q
  1. ;
  1. PROC ; - Loops through all the entries in the Claims Tracking file for the
  1. ; period selected and calculate the Unbilled Amounts
  1. N NVELIG ;JRA;IB*2.0*608 Flag set to 1 if patient has non-veteran eligibility
  1. S IBDT=IBBDT-.1
  1. ;
  1. F S IBDT=$O(^IBT(356,"D",IBDT)) Q:'IBDT!(IBDT>IBEDT) D
  1. . S IBX=0 F S IBX=$O(^IBT(356,"D",IBDT,IBX)) Q:'IBX D
  1. . . S IBNODE=$G(^IBT(356,IBX,0)) Q:IBNODE=""
  1. . . I $P(IBNODE,U,12) Q ; Tort-Feasor,Workman's Comp,No-fault Auto Acc.
  1. . . I $P(IBNODE,U,19) Q ; Reason not billable assigned.
  1. . . I '$P(IBNODE,U,20) Q ; Inactive.
  1. . . S DFN=+$P(IBNODE,U,2)
  1. . . ;Non-veteran eligibility includes CHAMPVA & TRICARE which is non-MCCF so do not screen out
  1. . . ;I '$$PTCHK^IBTUBOU(DFN,IBNODE) Q ; Has a non-veteran eligibility. ;JRA;IB*2.0*608 ';'
  1. . . S NVELIG='$$PTCHK^IBTUBOU(DFN,IBNODE) ;JRA;IB*2.0*608
  1. . . I '$$INSURED^IBCNS1(DFN,IBDT) Q ; Not insured during care.
  1. . . ;JRA;IB*2.0*608 No Inpatient for Non-MCCF
  1. . . ;I $P(IBNODE,U,5),IBSEL[1,$$COV^IBTUBOU(DFN,IBDT,1) D Q ;Inpatient ;JRA;IB*2.0*608 ';'
  1. . . I 'NVELIG,$G(IBMCCF)'="N",$P(IBNODE,U,5),IBSEL[1,$$COV^IBTUBOU(DFN,IBDT,1) D Q ;Inpatient ;JRA;IB*2.0*608
  1. . . . S DGPM=+$P(IBNODE,U,5) D INPT^IBTUBO2(DGPM)
  1. . . I $P(IBNODE,U,4),IBSEL[2,$$COV^IBTUBOU(DFN,IBDT,2) D Q ;Outpatient
  1. . . . S IBOE=+$P(IBNODE,U,4) I $$NCCL^IBTUBOU(IBOE) Q ; Non-Count Clinic
  1. . . . ;JRA;IB*2.0*608 Check if Eligibility of Encounter, Appointment Type & Rate Type meet MCCF/Non-MCCF Criteria
  1. . . . I $G(IBMCCF)]"",(IBMCCF'="B") N OK S OK=1 D Q:'OK ;JRA;IB*2.0*608
  1. . . . . N CLAIM S CLAIM=+$P(IBNODE,U,11)
  1. . . . . ;If looking only for MCCF and there is a non-veteran eligibility, this entry is Non-MCCF so don't process
  1. . . . . I IBMCCF="M",'$$PTCHK^IBTUBOU(DFN,IBNODE) S OK=0 Q ;Copied condition from above & modified
  1. . . . . I IBOE S OK=$$MCCFCKX^IBTUBOU(409.68,IBOE,.13,"ELIG") ;Check Eligibilty of Encounter
  1. . . . . I IBOE,((OK'=1&(IBMCCF="N"))!(IBMCCF="M"&(OK))) S OK=$$MCCFCKX^IBTUBOU(409.68,IBOE,.1,"ATYP") ;Check Appointment Type
  1. . . . . I CLAIM,((OK'=1&(IBMCCF="N"))!(IBMCCF="M"&(OK))) S OK=$$MCCFCKX^IBTUBOU(399,CLAIM,.07,"RTYP") ;Check Rate Type
  1. . . . D OPT^IBTUBO1(IBOE,.IBQUERY)
  1. . . Q:($G(IBMCCF)="N"!(NVELIG)) ;JRA;IB*2.0*608 Quit if Non-MCCF since only want Outpatient or quit if patient has non-veteran eligibility
  1. . . I $P(IBNODE,U,8),IBSEL[3,$$COV^IBTUBOU(DFN,IBDT,3) D Q ;Prescription
  1. . . . N IBIFN,IBCSTAT S IBIFN=+$P(IBNODE,U,11)
  1. . . . I IBIFN S IBCSTAT=$$GET1^DIQ(399,IBIFN_",",.13,"I") Q:$S(IBCSTAT=0:1,IBCSTAT=1:0,IBCSTAT=2:1,IBCSTAT=3:1,IBCSTAT=4:1,IBCSTAT=5:1,IBCSTAT=7:0,1:1) ;already billed (modified in T9)
  1. . . . S IBRX=+$P(IBNODE,U,8) D RX^IBTUBO2(IBRX)
  1. . . ;
  1. . . ; - Check CT entry event type to get unbilled amounts, if necessary.
  1. . . S IBTYP=$P($G(^IBE(356.6,+$P(IBNODE,U,18),0)),U,8)
  1. . . I IBTYP=1,IBSEL[1,$$COV^IBTUBOU(DFN,IBDT,1) D
  1. . . . D INPT^IBTUBO2(+$O(^DGPM("APTT1",DFN,IBDT,0)))
  1. . . I IBTYP=2,IBSEL[2,$$COV^IBTUBOU(DFN,IBDT,2) D
  1. . . . D OPT^IBTUBO1("",.IBQUERY)
  1. ;
  1. I $G(IBXTRACT) D XTRACT^IBTUBOU ; Load extract file, if necessary.
  1. ;
  1. ; MRD;IB*2.0*516 - Moved code that was here into the new
  1. ; procedure TOTAL, and tally most of the values up by Division.
  1. ;
  1. D TOTAL
  1. ;
  1. ; - If Compile/Store - update Unbilled Amounts data on file #356.19
  1. I $G(IBCOMP) D LD^IBTUBOU(3,IBTIMON)
  1. ;
  1. PRT ; - Print report(s).
  1. I $G(IBQUERY) D CLOSE^IBSDU(.IBQUERY)
  1. D REPORT^IBTUBO3
  1. ;
  1. END K ^TMP($J,"IBTUB-INPT"),^TMP($J,"IBTUB-OPT"),^TMP($J,"IBTUB-RX")
  1. K IBDT,IBRT,IBUNB
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC K IBTEMON,IBXTRACT,D,D0,DA,DIC,DIE
  1. Q
  1. ;
  1. TOTAL ; Determine grand total amounts.
  1. ;
  1. ; - Calculate the Amount Inpatient INST. & PROF. Unbilled Amounts,
  1. ; based on average amounts of Billed Amounts
  1. ;
  1. S IBIAV=$$INPAVG^IBTUBOU(IBTIMON)
  1. ;
  1. S IBAMTI=$P(IBIAV,"^")*$G(IBUNB("EPISM-I")) ; Inst
  1. S IBAMTIM=$P(IBIAV,"^")*$G(IBUNB("EPISM-I-MRA")) ; Inst
  1. S IBAMTP=$P(IBIAV,"^",2)*$G(IBUNB("EPISM-P")) ; Prof
  1. S IBAMTPM=$P(IBIAV,"^",2)*$G(IBUNB("EPISM-P-MRA")) ; Prof
  1. ;
  1. S IBUNB("UNBILIP")=IBAMTI+IBAMTP
  1. S IBUNB("UNBILIP-MRA")=IBAMTIM+IBAMTPM
  1. ;
  1. ;S IBUNB("UNBILTL")=IBUNB("UNBILIP")
  1. ;S IBUNB("UNBILTL-MRA")=IBUNB("UNBILIP-MRA")
  1. ;
  1. ; - Calculate Unbilled Amounts Totals by Division
  1. ;
  1. S IBDIV=0
  1. F S IBDIV=$O(IBUNB(IBDIV)) Q:'IBDIV D
  1. . ;
  1. . S IBAMTI=$P(IBIAV,"^")*$G(IBUNB(IBDIV,"EPISM-I")) ; Inst
  1. . S IBAMTIM=$P(IBIAV,"^")*$G(IBUNB(IBDIV,"EPISM-I-MRA")) ; Inst
  1. . S IBAMTP=$P(IBIAV,"^",2)*$G(IBUNB(IBDIV,"EPISM-P")) ; Prof
  1. . S IBAMTPM=$P(IBIAV,"^",2)*$G(IBUNB(IBDIV,"EPISM-P-MRA")) ; Prof
  1. . ;
  1. . S IBUNB(IBDIV,"UNBILIP")=IBAMTI+IBAMTP
  1. . S IBUNB(IBDIV,"UNBILIP-MRA")=IBAMTIM+IBAMTPM
  1. . ;
  1. . S IBUNB("UNBILTL")=$G(IBUNB("UNBILTL"))+$G(IBUNB(IBDIV,"UNBILIP"))+$G(IBUNB(IBDIV,"UNBILOP"))+$G(IBUNB(IBDIV,"UNBILRX"))
  1. . S IBUNB("UNBILTL-MRA")=$G(IBUNB("UNBILTL-MRA"))+$G(IBUNB(IBDIV,"UNBILIP-MRA"))+$G(IBUNB(IBDIV,"UNBILOP-MRA"))+$G(IBUNB(IBDIV,"UNBILRX-MRA"))
  1. . ;
  1. . Q
  1. ;
  1. Q
  1. ;