source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTUBOA.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1IBTUBOA ;ALB/RB - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;01-JAN-01
2 ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,192,155,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; - Entry point from Taskman.
6 ;ARRAY VARIABLES:
7 ; IBAVG("BILLS-I")=number of inpatient institutional claims
8 ; IBAVG("BILLS-P")=number of inpatient professional claims
9 ; IBAVG("EPISD-I")=number of inpt. episodes for institutional claims
10 ; IBAVG("EPISD-P")=number of inpt. episodes for professional claims
11 ; IBAVG("$AMNT-I")=inpatient institutional amount billed
12 ; IBAVG("$AMNT-P")=inpatient professional amount billed
13 ; IBUNB("EPISM-I")=number of inpatient episodes missing inst. claims
14 ; IBUNB("EPISM-P")=number of inpatient episodes missing prof. claims
15 ; IBUNB("EPISM-I-MRA")=number of MRA req inpat institutional claims
16 ; IBUNB("EPISM-P-MRA")=number of MRA req inpat professional claims
17 ; IBUNB("EPISM-A")=number of inpatient admissions missing claims
18 ; (any type: Prof,Inst or both)
19 ; IBUNB("EPISM-A-MRA")=number inpt MRA req admissions missing claims
20 ; (any type: Prof,Inst or both)
21 ; IBUNB("ENCNTRS")=number of outpatient encounters missing claims
22 ; IBUNB("CPTMS-I")=number of CPT codes missing institutional claims
23 ; IBUNB("CPTMS-I-MRA")=number of MRA req CPT codes missing inst claims
24 ; IBUNB("CPTMS-P")=number of CPT codes missing professional claims
25 ; IBUNB("CPTMS-P-MRA")=number of MRA req CPT codes missing prof claims
26 ; IBUNB("PRESCRP")=number of unbilled prescriptions
27 ; IBUNB("PRESCRP-MRA")=number of MRA req prescriptions
28 ; IBUNB("UNBILIP")=unbilled inpatient amount
29 ; IBUNB("UNBILIP-MRA")=MRA req inpatient amount
30 ; IBUNB("UNBILOP")=unbilled outpatient amount
31 ; IBUNB("UNBILOP-MRA")=MRA req outpatient amount
32 ; IBUNB("UNBILRX")=unbilled prescription amount
33 ; IBUNB("UNBILRX-MRA")=MRA req prescription amount
34 ; IBUNB("UNBILTL")=total unbilled amount
35 ; IBUNB("UNBILTL-MRA")=total MRA req amount
36 ;
37 ;ARRAY VARIABLES FOR DM EXTRACT:
38 ; IB(1)=Number of inpatient episodes missing institutional claims
39 ; IB(2)=Amount of inpatient episodes missing institutional claims
40 ; IB(3)=Number of inpatient episodes missing professional claims
41 ; IB(4)=Amount of inpatient episodes missing professional claims
42 ; IB(5)=Number of all inpatient episodes missing claims
43 ; IB(6)=Amount of all inpatient episodes missing claims
44 ; IB(7)=Number of unbilled outpatient encounters prior to 9/1/99
45 ; IB(8)=Amount of unbilled outpatient encounters prior to 9/1/99
46 ; IB(9)=Number of procedures without an institutional charge
47 ; IB(10)=Amount of procedures without an institutional charge
48 ; IB(11)=Number of procedures without a professional charge
49 ; IB(12)=Amount of procedures without a professional charge
50 ; IB(13)=Number of all procedures without a charge
51 ; IB(14)=Number of encounters associated with all procedures without
52 ; a charge
53 ; IB(15)=Number of all encounters missing claims
54 ; IB(16)=Amount of all encounters missing claims
55 ; IB(17)=Number of unbilled prescriptions and refills
56 ; IB(18)=Amount of unbilled prescriptions and refills
57 ; IB(19)=Amount of all unbilled episodes of care
58 ;
59 N IB,IBAMTI,IBAMTP,IBIAV,IBIA,IBNODE,IBOE,IBPA,IBQUERY,IBRX,IBSAV,IBT
60 N IBAMTIM,IBAMTPM,IBTYP,IBX,IBY,DFN,DGPM,I,J
61 ;
62 K ^TMP($J,"IBTUB-INPT"),^TMP($J,"IBTUB-OPT"),^TMP($J,"IBTUB-RX")
63 K ^TMP($J,"IBTUB-INPT_MRA"),^TMP($J,"IBTUB-OPT_MRA"),^TMP($J,"IBTUB-RX_MRA")
64 ;
65 ; - Initialize DM extract variables, if necessary.
66 I $G(IBXTRACT) D E^IBJDE(37,1) F IBX=1:1:19 S IB(IBX)=0
67 ;
68 ; - Initialize Unbilled Amounts variables.
69 S (IBUNB("ENCNTRS"),IBUNB("PRESCRP"),IBUNB("PRESCRP-MRA"))=0
70 F IBX="IP","OP","RX" S IBUNB("UNBIL"_IBX)=0,IBUNB("UNBIL"_IBX_"-MRA")=0
71 F IBX="I","P" S (IBUNB("EPISM-"_IBX),IBUNB("EPISM-"_IBX_"-MRA"),IBUNB("CPTMS-"_IBX),IBUNB("CPTMS-"_IBX_"-MRA"))=0
72 S (IBUNB("EPISM-A"),IBUNB("EPISM-A-MRA"))=0
73 ;
74 ; - Retrieve the Rate Type code for Reimbursable Insurance
75 S IBRT=$S($O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)):$O(^(0)),1:8)
76 ;
77 ; - If Compile/Store - Checks if the Average Bill Amounts exists for
78 ; IBTIMON. If it does not, calls IBTUBAV to calculate/updated it.
79 I $G(IBCOMP) D
80 . I $P($G(^IBE(356.19,IBTIMON,1)),"^",14)'="" Q
81 . ;
82 . ; - DQ^IBTUBAV will kill the variables IBTIMON and IBCOMP - That's why
83 . ; they are being set again after this call.
84 . S IBSAV=IBTIMON D DQ^IBTUBAV S IBTIMON=IBSAV,IBCOMP=1
85 ;
86PROC ; - Loops through all the entries in the Claims Tracking file for the
87 ; period selected and calculate the Unbilled Amounts
88 S IBDT=IBBDT-.1
89 ;
90 F S IBDT=$O(^IBT(356,"D",IBDT)) Q:'IBDT!(IBDT>IBEDT) D
91 . S IBX=0 F S IBX=$O(^IBT(356,"D",IBDT,IBX)) Q:'IBX D
92 . . S IBNODE=$G(^IBT(356,IBX,0)) Q:IBNODE=""
93 . . I $P(IBNODE,U,12) Q ; Tort-Feasor,Workman's Comp,No-fault Auto Acc.
94 . . I $P(IBNODE,U,19) Q ; Reason not billable assigned.
95 . . I '$P(IBNODE,U,20) Q ; Inactive.
96 . . S DFN=+$P(IBNODE,U,2)
97 . . I '$$PTCHK^IBTUBOU(DFN,IBNODE) Q ; Has a non-veteran eligibility.
98 . . I '$$INSURED^IBCNS1(DFN,IBDT) Q ; Not insured during care.
99 . . I $P(IBNODE,U,5),IBSEL[1,$$COV^IBTUBOU(DFN,IBDT,1) D Q ;Inpatient
100 . . . S DGPM=+$P(IBNODE,U,5) D INPT^IBTUBO2(DGPM)
101 . . I $P(IBNODE,U,4),IBSEL[2,$$COV^IBTUBOU(DFN,IBDT,2) D Q ;Outpatient
102 . . . S IBOE=+$P(IBNODE,U,4) I $$NCCL^IBTUBOU(IBOE) Q ; Non-Count Clinic
103 . . . D OPT^IBTUBO1(IBOE,.IBQUERY)
104 . . I $P(IBNODE,U,8),IBSEL[3,$$COV^IBTUBOU(DFN,IBDT,3) D Q ;Prescription
105 . . . N IBIFN,IBCSTAT S IBIFN=+$P(IBNODE,U,11)
106 . . . 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)
107 . . . S IBRX=+$P(IBNODE,U,8) D RX^IBTUBO2(IBRX)
108 . . ;
109 . . ; - Check CT entry event type to get unbilled amounts, if necessary.
110 . . S IBTYP=$P($G(^IBE(356.6,+$P(IBNODE,U,18),0)),U,8)
111 . . I IBTYP=1,IBSEL[1,$$COV^IBTUBOU(DFN,IBDT,1) D
112 . . . D INPT^IBTUBO2(+$O(^DGPM("APTT1",DFN,IBDT,0)))
113 . . I IBTYP=2,IBSEL[2,$$COV^IBTUBOU(DFN,IBDT,2) D
114 . . . D OPT^IBTUBO1("",.IBQUERY)
115 ;
116 I $G(IBXTRACT) D XTRACT^IBTUBOU ; Load extract file, if necessary.
117 ;
118 ; - Calculate the Amount Inpatient INST. & PROF. Unbilled Amounts,
119 ; based on average amounts of Billed Amounts
120 S IBIAV=$$INPAVG^IBTUBOU(IBTIMON)
121 S IBAMTI=$P(IBIAV,"^")*IBUNB("EPISM-I") ; Inst
122 S IBAMTIM=$P(IBIAV,"^")*IBUNB("EPISM-I-MRA") ; Inst
123 S IBAMTP=$P(IBIAV,"^",2)*IBUNB("EPISM-P") ; Prof
124 S IBAMTPM=$P(IBIAV,"^",2)*IBUNB("EPISM-P-MRA") ; Prof
125 ;
126 ; - Calculate Unbilled Amounts Totals
127 S IBUNB("UNBILIP")=$J(IBAMTI+IBAMTP,0,2)
128 S IBUNB("UNBILIP-MRA")=$J(IBAMTIM+IBAMTPM,0,2)
129 S IBUNB("UNBILOP")=$J(IBUNB("UNBILOP"),0,2)
130 S IBUNB("UNBILOP-MRA")=$J(IBUNB("UNBILOP-MRA"),0,2)
131 S IBUNB("UNBILRX")=$J(IBUNB("UNBILRX"),0,2)
132 S IBUNB("UNBILRX-MRA")=$J(IBUNB("UNBILRX-MRA"),0,2)
133 S IBUNB("UNBILTL")=$J(IBUNB("UNBILIP")+IBUNB("UNBILOP")+IBUNB("UNBILRX"),0,2)
134 S IBUNB("UNBILTL-MRA")=$J(IBUNB("UNBILIP-MRA")+IBUNB("UNBILOP-MRA")+IBUNB("UNBILRX-MRA"),0,2)
135 ;
136 ; - If Compile/Store - update Unbilled Amounts data on file #356.19
137 I $G(IBCOMP) D LD^IBTUBOU(3,IBTIMON)
138 ;
139PRT ; - Print report(s).
140 I $G(IBQUERY) D CLOSE^IBSDU(.IBQUERY)
141 D REPORT^IBTUBO3
142 ;
143END K ^TMP($J,"IBTUB-INPT"),^TMP($J,"IBTUB-OPT"),^TMP($J,"IBTUB-RX")
144 K IBDT,IBRT,IBUNB
145 I $D(ZTQUEUED) S ZTREQ="@" Q
146 D ^%ZISC K IBTEMON,IBXTRACT,D,D0,DA,DIC,DIE
147 Q
Note: See TracBrowser for help on using the repository browser.