| 1 | IBTUBOU ;ALB/RB - UNBILLED AMOUNTS (UTILITIES) ;03 Aug 2004 7:21 AM
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**123,159,155**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DT1 ; - Select date range (returns variables IBBDT and IBEDT).
|
|---|
| 6 | N DT0,DT1,DTOUT,DUOUT,Y
|
|---|
| 7 | S DT0=$O(^IBT(356,"D",""))\1,DT1=""
|
|---|
| 8 | I DT0 S DT1=$$DAT3^IBOUTL(DT0),DIR("B")=DT1
|
|---|
| 9 | S DIR(0)="DA^"_DT0_":"_DT_":AEX",DIR("A")="Start with DATE: "
|
|---|
| 10 | S DIR("?",1)="If you enter a start date here, the report will look for"
|
|---|
| 11 | S DIR("?",2)="events ON or AFTER this date. Press <CR> if you want to"
|
|---|
| 12 | S DIR("?",3)="skip this prompt and have the report look thru ALL events"
|
|---|
| 13 | S DIR("?",4)="or enter '^' to exit.",DIR("?",5)=""
|
|---|
| 14 | S DIR("?",6)="NOTE: The earliest date that can be entered is "_DT1_","
|
|---|
| 15 | S DIR("?",7)=" which is the date of the first event on file, and"
|
|---|
| 16 | S DIR("?")=" it is NOT possible to enter a future date."
|
|---|
| 17 | D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBBDT="^" G DT1Q
|
|---|
| 18 | S IBBDT=Y,DT1=$$DAT3^IBOUTL(IBBDT)
|
|---|
| 19 | ;
|
|---|
| 20 | S DIR("B")=$$DAT3^IBOUTL(DT)
|
|---|
| 21 | S DIR(0)="DA^"_IBBDT_":"_DT_":AEX",DIR("A")=" Go to DATE: "
|
|---|
| 22 | S DIR("?",1)="If you enter a end date here, the report will look for"
|
|---|
| 23 | S DIR("?",2)="events from "_DT1_" to this date. Press <CR> to have"
|
|---|
| 24 | S DIR("?",3)="the report look at all events from "_DT1_" to today,"
|
|---|
| 25 | S DIR("?",4)="or enter '^' to exit."
|
|---|
| 26 | S DIR("?",5)=""
|
|---|
| 27 | S DIR("?",6)="NOTE: This date MUST NOT be earlier than "_DT1_" neither"
|
|---|
| 28 | S DIR("?")=" later than today."
|
|---|
| 29 | D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBBDT="^" G DT1Q
|
|---|
| 30 | S IBEDT=Y+.9
|
|---|
| 31 | ;
|
|---|
| 32 | DT1Q Q
|
|---|
| 33 | ;
|
|---|
| 34 | DT2(STR) ; - Select re-compile date (returns variable IBTIMON).
|
|---|
| 35 | ; Input: STR - String that describe the type of data that will be
|
|---|
| 36 | ; re-compiled: "Unbilled Amounts", "Average Bill Amounts", etc...
|
|---|
| 37 | ;
|
|---|
| 38 | N DIRUT,DT0,DT1,DT2,Y
|
|---|
| 39 | ; - AUG 1993 is the first month on file with Unbilled Amounts data
|
|---|
| 40 | S DT0=2930800,DT1=$$DAT2^IBOUTL(DT0)
|
|---|
| 41 | S DT2=$$M1^IBJDE(DT,1),DIR("B")=$$DAT2^IBOUTL(DT2)
|
|---|
| 42 | S DIR(0)="DA^"_$E(DT0,1,5)_"00:"_DT2_":AE^K:$E(Y,6,7)'=""00"" X"
|
|---|
| 43 | S DIR("A")="Re-compile "_$G(STR)_" through MONTH/YEAR: "
|
|---|
| 44 | S DIR("?",1)="Enter a past month/year (ex. Oct 2000).",DIR("?",2)=""
|
|---|
| 45 | S DIR("?",3)="NOTE: The earliest month/year that can be entered is "_DT1_", and"
|
|---|
| 46 | S DIR("?")=" it is NOT possible to enter the current or a future month/year."
|
|---|
| 47 | D ^DIR K DIR I $D(DIRUT) S IBTIMON="^" G DT2Q
|
|---|
| 48 | I $E(Y,6,7)'="00"!($E(Y,4,7)="0000") W " ??" G DT2
|
|---|
| 49 | S IBTIMON=Y
|
|---|
| 50 | ;
|
|---|
| 51 | DT2Q Q
|
|---|
| 52 | ;
|
|---|
| 53 | YR2(D) ; - Return a date two years from date D.
|
|---|
| 54 | N X,X1,X2 S X="" G:'$G(D) YR2Q S X1=D,X2=-730 D C^%DTC
|
|---|
| 55 | ;
|
|---|
| 56 | YR2Q Q X
|
|---|
| 57 | ;
|
|---|
| 58 | COV(P,E,T) ; - Check if patient has insurance coverage.
|
|---|
| 59 | ; Input: P=patient IEN, E=event date,
|
|---|
| 60 | ; T=1-inpatient/2-outpatient/3-pharmacy
|
|---|
| 61 | ; Output: Y=1-patient has coverage/0-no coverage or unknown
|
|---|
| 62 | N X,XY,Y S Y=0 G:'$G(P)!('$G(E))!('$G(T)) COVQ
|
|---|
| 63 | S X=$S(T=1:"INPATIENT",T=2:"OUTPATIENT",1:"PHARMACY")
|
|---|
| 64 | S Y=$$PTCOV^IBCNSU3(P,E,X,.XY)
|
|---|
| 65 | ;
|
|---|
| 66 | COVQ Q Y
|
|---|
| 67 | ;
|
|---|
| 68 | PTCHK(DFN,IBNODE) ; - See if patient has a non-veteran eligibility.
|
|---|
| 69 | ; Input: DFN=patient IEN
|
|---|
| 70 | ; IBNODE=zero node to CT entry
|
|---|
| 71 | ; Output: IBFLAG=0-nonbillable, 1-billable
|
|---|
| 72 | N IBFLAG S IBFLAG=0 G:'$G(DFN) PTCKQ
|
|---|
| 73 | I $D(^DPT(+DFN,.312)),$G(^("VET"))="Y" S IBFLAG=1
|
|---|
| 74 | I $P(IBNODE,U,4),$P($G(^DIC(8,+$$SCE^IBSDU(+$P(IBNODE,U,4),13),0)),U,5)="N" S IBFLAG=0
|
|---|
| 75 | ;
|
|---|
| 76 | PTCKQ Q IBFLAG
|
|---|
| 77 | ;
|
|---|
| 78 | NCCL(ENC) ; - Check if Encounter is NON-COUNT CLINIC
|
|---|
| 79 | ; Input: ENC = Pointer to the ENCOUNTER file (#409.69)
|
|---|
| 80 | ; Output: NCCL= 1 - NON-COUNT CLINIC / 0 - NO NON-COUNT CLINIC
|
|---|
| 81 | N NCCL,HLOC
|
|---|
| 82 | S NCCL=0,HLOC=$$SCE^IBSDU(+ENC,4)
|
|---|
| 83 | I HLOC,$P($G(^SC(+HLOC,0)),"^",17)="Y" S NCCL=1
|
|---|
| 84 | ;
|
|---|
| 85 | Q NCCL
|
|---|
| 86 | ;
|
|---|
| 87 | HOSP(ADM) ; Is the patient still hospitalized (not discharged)?
|
|---|
| 88 | ; Input: ADM = Pointer to the PATIENT MOVEMENT file (#405)
|
|---|
| 89 | ;Output: HOSP = 1 - Hospitalized / 0 - Discharged
|
|---|
| 90 | ;
|
|---|
| 91 | N HOSP,X
|
|---|
| 92 | S HOSP=1,X=$G(^DGPM(+ADM,0)) I $P(X,"^",17) S HOSP=0
|
|---|
| 93 | ;
|
|---|
| 94 | Q HOSP
|
|---|
| 95 | ;
|
|---|
| 96 | CKBIL(X,Y) ; - Return valid claim data.
|
|---|
| 97 | ; Input: X=IEN from file #399, Y=0-outpatient, 1-inpatient
|
|---|
| 98 | ; Output: Z=rate^status^auth date^1-inst claim/2-prof claim^
|
|---|
| 99 | ; event date (if Y=1), or null^req MRA date
|
|---|
| 100 | N X1,X2,Y1,Z S Z="" G:'$G(X) CKBLQ S:'$G(Y) Y=0
|
|---|
| 101 | S X1=$G(^DGCR(399,X,0)) G:X1="" CKBLQ
|
|---|
| 102 | I $G(DFN),$P(X1,U,2)'=DFN G CKBLQ ; Invalid patient IEN.
|
|---|
| 103 | I '$G(IBRX),'Y,'$$NOTRX(X) G CKBLQ ; Bill has RX rev codes.
|
|---|
| 104 | I $P(X1,U,5)<3,'Y G CKBLQ ; Not inpatient bill.
|
|---|
| 105 | I $P(X1,U,5)>2,Y G CKBLQ ; Not outpatient bill.
|
|---|
| 106 | I $P(X1,U,11)'="i" G CKBLQ ; Not an insurance bill.
|
|---|
| 107 | S X2=$P($G(^DGCR(399,X,"S")),U,10)
|
|---|
| 108 | I 'X2 G:$P(X1,U,13)'=2 CKBLQ ; No authorization date, not MRA req
|
|---|
| 109 | I $P(X1,U,13)<2!($P(X1,U,13)>5) G CKBLQ ; Status not auth, prin, trans.
|
|---|
| 110 | S Z=$P(X1,U,7)_U_$P(X1,U,13)_U_X2,Y1=$P($P(X1,U,3),".")
|
|---|
| 111 | S:$P(X1,U,13)=2 $P(Z,U,6)=$P($G(^DGCR(399,X,"S")),U,7)
|
|---|
| 112 | I $P(X1,U,27)=1!($P(X1,U,19)=3)!(Y1<2990901) S $P(Z,U,4)=1 G CKBL1
|
|---|
| 113 | I $P(X1,U,27)=2!($P(X1,U,19)=2) S $P(Z,U,4)=2
|
|---|
| 114 | I '$P(Z,U,4) S Z="" G CKBLQ ; Not institutional or professional bill.
|
|---|
| 115 | CKBL1 I Y S $P(Z,U,5)=Y1
|
|---|
| 116 | ;
|
|---|
| 117 | CKBLQ Q Z
|
|---|
| 118 | ;
|
|---|
| 119 | CKENC(IBOE,IBOE0,IBQUIT) ; - Check outpatient encounters.
|
|---|
| 120 | N IBCK,IBZ,IBPB,IBZERR
|
|---|
| 121 | I $G(IBOE0)="" D GETGEN^SDOE(IBOE,"IBZ","IBZERR") S IBOE0=$G(IBZ(0))
|
|---|
| 122 | F IBZ=9,13,14 S IBCK(IBZ)=""
|
|---|
| 123 | I '$$BILLCK^IBAMTEDU(IBOE,IBOE0) S IBQUIT=1 ; Not billable.
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | SCAN(DFN,IBDT,IBQUERY) ; - Look at all visits for a day.
|
|---|
| 127 | N IBNDT,IBVAL,IBFILTER,IBCBK
|
|---|
| 128 | S IBVAL("DFN")=DFN,IBVAL("BDT")=IBDT,IBVAL("EDT")=IBDT,IBFILTER=""
|
|---|
| 129 | S IBCBK="I $P(Y0,U,8)=3,Y0>IBDT S:'IBNDT IBNDT=+Y0 D:IBNDT=+Y0 CKENC^IBTUBOU(Y,Y0,.IBQUIT) S:$S('$G(IBQUIT):1,1:Y0>IBNDT) SDSTOP=1"
|
|---|
| 130 | S IBNDT=0 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,0,.IBQUERY)
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | SC(PTF) ; - If patient is SC, are movements for SC care.
|
|---|
| 134 | ; Input: PTF=PTF record
|
|---|
| 135 | ; Output: IBM=1-all movements PTF, 0-one or more not flagged as SC
|
|---|
| 136 | N M,IBM S IBM=1,M=0 G:$G(^DGPT(+$G(PTF),0))="" SCQ
|
|---|
| 137 | F S M=$O(^DGPT(PTF,"M",M)) Q:'M D Q:'IBM
|
|---|
| 138 | .I $P($G(^DGPT(PTF,"M",M,0)),U,18)'=1 S IBM=0
|
|---|
| 139 | ;
|
|---|
| 140 | SCQ Q IBM
|
|---|
| 141 | ;
|
|---|
| 142 | LD(L,M) ; - Load average/unbilled totals into file #356.19
|
|---|
| 143 | ; Input: L=1-average (mon), 2-average (12m), 3-unbilled
|
|---|
| 144 | ; M=file #356.19 IEN
|
|---|
| 145 | I '$G(L)!('$G(M)) G LDQ
|
|---|
| 146 | S DA=M,DIE="^IBE(356.19,"
|
|---|
| 147 | S DR=$S(L=3:"[IBT UNBILLED AMOUNTS]",L=2:"[IBT AVERAGE BILL AMOUNTS (12M)]",1:"[IBT AVERAGE BILL AMOUNTS (MON)]")
|
|---|
| 148 | D ^DIE K DA,DIE,DR
|
|---|
| 149 | ;
|
|---|
| 150 | LDQ Q
|
|---|
| 151 | ;
|
|---|
| 152 | XTRACT ; - Calculate remaining extract totals and load into file #351.71
|
|---|
| 153 | ; - Set IB with the average and total amounts and call E^IBJDE
|
|---|
| 154 | N X,AVGS
|
|---|
| 155 | S AVGS=$$INPAVG(IBTIMON)
|
|---|
| 156 | S IB(2)=$J(IB(1)*$P(AVGS,"^"),0,2)
|
|---|
| 157 | S IB(4)=$J(IB(3)*$P(AVGS,"^",2),0,2)
|
|---|
| 158 | S IB(6)=$J(IB(2)+IB(4),0,2)
|
|---|
| 159 | S IB(13)=IB(9)+IB(11),IB(15)=IB(7)+IB(14)
|
|---|
| 160 | F X=8,10,12,18 S IB(X)=$J(IB(X),0,2)
|
|---|
| 161 | S IB(16)=$J(IB(8)+IB(10)+IB(12),0,2)
|
|---|
| 162 | S IB(19)=$J(IB(6)+IB(16)+IB(18),0,2)
|
|---|
| 163 | D E^IBJDE(37,0)
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | INPAVG(IBYRMO) ; - Calculate the Average Inpatient INST. & PROF. Billed Amounts
|
|---|
| 167 | ; Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
|
|---|
| 168 | ; Output: Avg.Inpt.Inst.Bill Amount ^ Avg.Inpt.Prof. Bill Amount
|
|---|
| 169 | ;
|
|---|
| 170 | N AVGI,AVGP,ND I '$G(IBYRMO) Q ""
|
|---|
| 171 | F Q:$P($G(^IBE(356.19,IBYRMO,1)),"^",14)'=""!'IBYRMO D
|
|---|
| 172 | . S IBYRMO=$O(^IBE(356.19,IBYRMO),-1)
|
|---|
| 173 | S (AVGI,AVGP)=0 I 'IBYRMO Q ""
|
|---|
| 174 | S ND=$G(^IBE(356.19,IBYRMO,1))
|
|---|
| 175 | I $P(ND,"^",9) S AVGI=$J($P(ND,"^",8)/$P(ND,"^",9),0,2)
|
|---|
| 176 | I $P(ND,"^",12) S AVGP=$J($P(ND,"^",11)/$P(ND,"^",12),0,2)
|
|---|
| 177 | Q (AVGI_"^"_AVGP)
|
|---|
| 178 | ;
|
|---|
| 179 | NOTRX(BILL) ; - Determine if bill contains outpatient visit (use this check
|
|---|
| 180 | ; to make sure not just rx bill returns one if contains a revenue
|
|---|
| 181 | ; code for outpatient visit or a zero if no outpatient visit code
|
|---|
| 182 | ; on bill).
|
|---|
| 183 | N IBRX,RC,X
|
|---|
| 184 | S (IBRX,RC)=0 G:'$O(^DGCR(399,BILL,"OP",0)) NOTRXQ
|
|---|
| 185 | F S RC=$O(^DGCR(399,BILL,"RC",RC)) Q:'RC I $P($G(^DGCR(399.1,+$P($G(^DGCR(399,BILL,"RC",RC,0)),U,5),0)),U)'="PRESCRIPTION" S IBRX=1 Q
|
|---|
| 186 | ;
|
|---|
| 187 | NOTRXQ Q IBRX
|
|---|
