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