IBTUBOU ;ALB/RB - UNBILLED AMOUNTS (UTILITIES) ;03 Aug 2004 7:21 AM
;;2.0;INTEGRATED BILLING;**123,159,155,608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
;
DT1 ; - Select date range (returns variables IBBDT and IBEDT).
N DT0,DT1,DTOUT,DUOUT,Y
S DT0=$O(^IBT(356,"D",""))\1,DT1=""
I DT0 S DT1=$$DAT3^IBOUTL(DT0),DIR("B")=DT1
S DIR(0)="DA^"_DT0_":"_DT_":AEX",DIR("A")="Start with DATE: "
S DIR("?",1)="If you enter a start date here, the report will look for"
S DIR("?",2)="events ON or AFTER this date. Press <CR> if you want to"
S DIR("?",3)="skip this prompt and have the report look thru ALL events"
S DIR("?",4)="or enter '^' to exit.",DIR("?",5)=""
S DIR("?",6)="NOTE: The earliest date that can be entered is "_DT1_","
S DIR("?",7)=" which is the date of the first event on file, and"
S DIR("?")=" it is NOT possible to enter a future date."
D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBBDT="^" G DT1Q
S IBBDT=Y,DT1=$$DAT3^IBOUTL(IBBDT)
;
S DIR("B")=$$DAT3^IBOUTL(DT)
S DIR(0)="DA^"_IBBDT_":"_DT_":AEX",DIR("A")=" Go to DATE: "
S DIR("?",1)="If you enter a end date here, the report will look for"
S DIR("?",2)="events from "_DT1_" to this date. Press <CR> to have"
S DIR("?",3)="the report look at all events from "_DT1_" to today,"
S DIR("?",4)="or enter '^' to exit."
S DIR("?",5)=""
S DIR("?",6)="NOTE: This date MUST NOT be earlier than "_DT1_" neither"
S DIR("?")=" later than today."
D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBBDT="^" G DT1Q
S IBEDT=Y+.9
;
DT1Q Q
;
DT2(STR) ; - Select re-compile date (returns variable IBTIMON).
; Input: STR - String that describe the type of data that will be
; re-compiled: "Unbilled Amounts", "Average Bill Amounts", etc...
;
N DIRUT,DT0,DT1,DT2,Y
; - AUG 1993 is the first month on file with Unbilled Amounts data
S DT0=2930800,DT1=$$DAT2^IBOUTL(DT0)
S DT2=$$M1^IBJDE(DT,1),DIR("B")=$$DAT2^IBOUTL(DT2)
S DIR(0)="DA^"_$E(DT0,1,5)_"00:"_DT2_":AE^K:$E(Y,6,7)'=""00"" X"
S DIR("A")="Re-compile "_$G(STR)_" through MONTH/YEAR: "
S DIR("?",1)="Enter a past month/year (ex. Oct 2000).",DIR("?",2)=""
S DIR("?",3)="NOTE: The earliest month/year that can be entered is "_DT1_", and"
S DIR("?")=" it is NOT possible to enter the current or a future month/year."
D ^DIR K DIR I $D(DIRUT) S IBTIMON="^" G DT2Q
I $E(Y,6,7)'="00"!($E(Y,4,7)="0000") W " ??" G DT2
S IBTIMON=Y
;
DT2Q Q
;
YR2(D) ; - Return a date two years from date D.
N X,X1,X2 S X="" G:'$G(D) YR2Q S X1=D,X2=-730 D C^%DTC
;
YR2Q Q X
;
COV(P,E,T) ; - Check if patient has insurance coverage.
; Input: P=patient IEN, E=event date,
; T=1-inpatient/2-outpatient/3-pharmacy
; Output: Y=1-patient has coverage/0-no coverage or unknown
N X,XY,Y S Y=0 G:'$G(P)!('$G(E))!('$G(T)) COVQ
S X=$S(T=1:"INPATIENT",T=2:"OUTPATIENT",1:"PHARMACY")
S Y=$$PTCOV^IBCNSU3(P,E,X,.XY)
;
COVQ Q Y
;
PTCHK(DFN,IBNODE) ; - See if patient has a non-veteran eligibility.
; Input: DFN=patient IEN
; IBNODE=zero node to CT entry
; Output: IBFLAG=0-nonbillable, 1-billable
N IBFLAG S IBFLAG=0 G:'$G(DFN) PTCKQ
I $D(^DPT(+DFN,.312)),$G(^("VET"))="Y" S IBFLAG=1
I $P(IBNODE,U,4),$P($G(^DIC(8,+$$SCE^IBSDU(+$P(IBNODE,U,4),13),0)),U,5)="N" S IBFLAG=0
;
PTCKQ Q IBFLAG
;
NCCL(ENC) ; - Check if Encounter is NON-COUNT CLINIC
; Input: ENC = Pointer to the ENCOUNTER file (#409.69)
; Output: NCCL= 1 - NON-COUNT CLINIC / 0 - NO NON-COUNT CLINIC
N NCCL,HLOC
S NCCL=0,HLOC=$$SCE^IBSDU(+ENC,4)
I HLOC,$P($G(^SC(+HLOC,0)),"^",17)="Y" S NCCL=1
;
Q NCCL
;
HOSP(ADM) ; Is the patient still hospitalized (not discharged)?
; Input: ADM = Pointer to the PATIENT MOVEMENT file (#405)
;Output: HOSP = 1 - Hospitalized / 0 - Discharged
;
N HOSP,X
S HOSP=1,X=$G(^DGPM(+ADM,0)) I $P(X,"^",17) S HOSP=0
;
Q HOSP
;
CKBIL(X,Y) ; - Return valid claim data.
; Input: X=IEN from file #399, Y=0-outpatient, 1-inpatient
; Output: Z=rate^status^auth date^1-inst claim/2-prof claim^
; event date (if Y=1), or null^req MRA date
N X1,X2,Y1,Z S Z="" G:'$G(X) CKBLQ S:'$G(Y) Y=0
S X1=$G(^DGCR(399,X,0)) G:X1="" CKBLQ
I $G(DFN),$P(X1,U,2)'=DFN G CKBLQ ; Invalid patient IEN.
I '$G(IBRX),'Y,'$$NOTRX(X) G CKBLQ ; Bill has RX rev codes.
I $P(X1,U,5)<3,'Y G CKBLQ ; Not inpatient bill.
I $P(X1,U,5)>2,Y G CKBLQ ; Not outpatient bill.
I $P(X1,U,11)'="i" G CKBLQ ; Not an insurance bill.
S X2=$P($G(^DGCR(399,X,"S")),U,10)
I 'X2 G:$P(X1,U,13)'=2 CKBLQ ; No authorization date, not MRA req
I $P(X1,U,13)<2!($P(X1,U,13)>5) G CKBLQ ; Status not auth, prin, trans.
;JRA;IB*2.0*608 Check if claim should be excluded based on MCCF/non-MCCF
I $G(IBMCCF)]"",IBMCCF'="B",'$$MCCFCKX(399,X,.07,"RTYP") G CKBLQ ;JRA;IB*2.0*608
S Z=$P(X1,U,7)_U_$P(X1,U,13)_U_X2,Y1=$P($P(X1,U,3),".")
S:$P(X1,U,13)=2 $P(Z,U,6)=$P($G(^DGCR(399,X,"S")),U,7)
I $P(X1,U,27)=1!($P(X1,U,19)=3)!(Y1<2990901) S $P(Z,U,4)=1 G CKBL1
I $P(X1,U,27)=2!($P(X1,U,19)=2) S $P(Z,U,4)=2
I '$P(Z,U,4) S Z="" G CKBLQ ; Not institutional or professional bill.
CKBL1 I Y S $P(Z,U,5)=Y1
;
CKBLQ Q Z
;
CKENC(IBOE,IBOE0,IBQUIT) ; - Check outpatient encounters.
N IBCK,IBZ,IBPB,IBZERR
I $G(IBOE0)="" D GETGEN^SDOE(IBOE,"IBZ","IBZERR") S IBOE0=$G(IBZ(0))
F IBZ=9,13,14 S IBCK(IBZ)=""
I '$$BILLCK^IBAMTEDU(IBOE,IBOE0) S IBQUIT=1 ; Not billable.
Q
;
SCAN(DFN,IBDT,IBQUERY) ; - Look at all visits for a day.
N IBNDT,IBVAL,IBFILTER,IBCBK
S IBVAL("DFN")=DFN,IBVAL("BDT")=IBDT,IBVAL("EDT")=IBDT,IBFILTER=""
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"
S IBNDT=0 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,0,.IBQUERY)
Q
;
SC(PTF) ; - If patient is SC, are movements for SC care.
; Input: PTF=PTF record
; Output: IBM=1-all movements PTF, 0-one or more not flagged as SC
N M,IBM S IBM=1,M=0 G:$G(^DGPT(+$G(PTF),0))="" SCQ
F S M=$O(^DGPT(PTF,"M",M)) Q:'M D Q:'IBM
.I $P($G(^DGPT(PTF,"M",M,0)),U,18)'=1 S IBM=0
;
SCQ Q IBM
;
LD(L,M) ; - Load average/unbilled totals into file #356.19
; Input: L=1-average (mon), 2-average (12m), 3-unbilled
; M=file #356.19 IEN
I '$G(L)!('$G(M)) G LDQ
S DA=M,DIE="^IBE(356.19,"
S DR=$S(L=3:"[IBT UNBILLED AMOUNTS]",L=2:"[IBT AVERAGE BILL AMOUNTS (12M)]",1:"[IBT AVERAGE BILL AMOUNTS (MON)]")
D ^DIE K DA,DIE,DR
;
LDQ Q
;
XTRACT ; - Calculate remaining extract totals and load into file #351.71
; - Set IB with the average and total amounts and call E^IBJDE
N X,AVGS
S AVGS=$$INPAVG(IBTIMON)
S IB(2)=$J(IB(1)*$P(AVGS,"^"),0,2)
S IB(4)=$J(IB(3)*$P(AVGS,"^",2),0,2)
S IB(6)=$J(IB(2)+IB(4),0,2)
S IB(13)=IB(9)+IB(11),IB(15)=IB(7)+IB(14)
F X=8,10,12,18 S IB(X)=$J(IB(X),0,2)
S IB(16)=$J(IB(8)+IB(10)+IB(12),0,2)
S IB(19)=$J(IB(6)+IB(16)+IB(18),0,2)
D E^IBJDE(37,0)
Q
;
INPAVG(IBYRMO) ; - Calculate the Average Inpatient INST. & PROF. Billed Amounts
; Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
; Output: Avg.Inpt.Inst.Bill Amount ^ Avg.Inpt.Prof. Bill Amount
;
N AVGI,AVGP,ND I '$G(IBYRMO) Q ""
F Q:$P($G(^IBE(356.19,IBYRMO,1)),"^",14)'=""!'IBYRMO D
. S IBYRMO=$O(^IBE(356.19,IBYRMO),-1)
S (AVGI,AVGP)=0 I 'IBYRMO Q ""
S ND=$G(^IBE(356.19,IBYRMO,1))
I $P(ND,"^",9) S AVGI=$J($P(ND,"^",8)/$P(ND,"^",9),0,2)
I $P(ND,"^",12) S AVGP=$J($P(ND,"^",11)/$P(ND,"^",12),0,2)
Q (AVGI_"^"_AVGP)
;
NOTRX(BILL) ; - Determine if bill contains outpatient visit (use this check
; to make sure not just rx bill returns one if contains a revenue
; code for outpatient visit or a zero if no outpatient visit code
; on bill).
N IBRX,RC,X
S (IBRX,RC)=0 G:'$O(^DGCR(399,BILL,"OP",0)) NOTRXQ
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
;
NOTRXQ Q IBRX
;
MCCFCKX(FILE,IEN,FLD,ND) ;JRA;IB*2.0*608 Check if Eligibility of Encounter, Appointment Type, and Rate Type meet MCCF/non-MCCF criteria
;Input: FILE=
Q:('$G(FILE)!('$G(IEN)!('$G(FLD)!($G(ND)="")))) -1
N VAL
S VAL=$$GET1^DIQ(FILE,IEN_",",FLD,"I") Q:'VAL -1
I ((IBMCCF="N")&('$D(IBMCCF(ND,VAL))))!((IBMCCF="M")&($D(IBMCCF(ND,VAL)))) Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUBOU 8473 printed Dec 13, 2024@02:29:10 Page 2
IBTUBOU ;ALB/RB - UNBILLED AMOUNTS (UTILITIES) ;03 Aug 2004 7:21 AM
+1 ;;2.0;INTEGRATED BILLING;**123,159,155,608**;21-MAR-94;Build 90
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
DT1 ; - Select date range (returns variables IBBDT and IBEDT).
+1 NEW DT0,DT1,DTOUT,DUOUT,Y
+2 SET DT0=$ORDER(^IBT(356,"D",""))\1
SET DT1=""
+3 IF DT0
SET DT1=$$DAT3^IBOUTL(DT0)
SET DIR("B")=DT1
+4 SET DIR(0)="DA^"_DT0_":"_DT_":AEX"
SET DIR("A")="Start with DATE: "
+5 SET DIR("?",1)="If you enter a start date here, the report will look for"
+6 SET DIR("?",2)="events ON or AFTER this date. Press <CR> if you want to"
+7 SET DIR("?",3)="skip this prompt and have the report look thru ALL events"
+8 SET DIR("?",4)="or enter '^' to exit."
SET DIR("?",5)=""
+9 SET DIR("?",6)="NOTE: The earliest date that can be entered is "_DT1_","
+10 SET DIR("?",7)=" which is the date of the first event on file, and"
+11 SET DIR("?")=" it is NOT possible to enter a future date."
+12 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBBDT="^"
GOTO DT1Q
+13 SET IBBDT=Y
SET DT1=$$DAT3^IBOUTL(IBBDT)
+14 ;
+15 SET DIR("B")=$$DAT3^IBOUTL(DT)
+16 SET DIR(0)="DA^"_IBBDT_":"_DT_":AEX"
SET DIR("A")=" Go to DATE: "
+17 SET DIR("?",1)="If you enter a end date here, the report will look for"
+18 SET DIR("?",2)="events from "_DT1_" to this date. Press <CR> to have"
+19 SET DIR("?",3)="the report look at all events from "_DT1_" to today,"
+20 SET DIR("?",4)="or enter '^' to exit."
+21 SET DIR("?",5)=""
+22 SET DIR("?",6)="NOTE: This date MUST NOT be earlier than "_DT1_" neither"
+23 SET DIR("?")=" later than today."
+24 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBBDT="^"
GOTO DT1Q
+25 SET IBEDT=Y+.9
+26 ;
DT1Q QUIT
+1 ;
DT2(STR) ; - Select re-compile date (returns variable IBTIMON).
+1 ; Input: STR - String that describe the type of data that will be
+2 ; re-compiled: "Unbilled Amounts", "Average Bill Amounts", etc...
+3 ;
+4 NEW DIRUT,DT0,DT1,DT2,Y
+5 ; - AUG 1993 is the first month on file with Unbilled Amounts data
+6 SET DT0=2930800
SET DT1=$$DAT2^IBOUTL(DT0)
+7 SET DT2=$$M1^IBJDE(DT,1)
SET DIR("B")=$$DAT2^IBOUTL(DT2)
+8 SET DIR(0)="DA^"_$EXTRACT(DT0,1,5)_"00:"_DT2_":AE^K:$E(Y,6,7)'=""00"" X"
+9 SET DIR("A")="Re-compile "_$GET(STR)_" through MONTH/YEAR: "
+10 SET DIR("?",1)="Enter a past month/year (ex. Oct 2000)."
SET DIR("?",2)=""
+11 SET DIR("?",3)="NOTE: The earliest month/year that can be entered is "_DT1_", and"
+12 SET DIR("?")=" it is NOT possible to enter the current or a future month/year."
+13 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBTIMON="^"
GOTO DT2Q
+14 IF $EXTRACT(Y,6,7)'="00"!($EXTRACT(Y,4,7)="0000")
WRITE " ??"
GOTO DT2
+15 SET IBTIMON=Y
+16 ;
DT2Q QUIT
+1 ;
YR2(D) ; - Return a date two years from date D.
+1 NEW X,X1,X2
SET X=""
if '$GET(D)
GOTO YR2Q
SET X1=D
SET X2=-730
DO C^%DTC
+2 ;
YR2Q QUIT X
+1 ;
COV(P,E,T) ; - Check if patient has insurance coverage.
+1 ; Input: P=patient IEN, E=event date,
+2 ; T=1-inpatient/2-outpatient/3-pharmacy
+3 ; Output: Y=1-patient has coverage/0-no coverage or unknown
+4 NEW X,XY,Y
SET Y=0
if '$GET(P)!('$GET(E))!('$GET(T))
GOTO COVQ
+5 SET X=$SELECT(T=1:"INPATIENT",T=2:"OUTPATIENT",1:"PHARMACY")
+6 SET Y=$$PTCOV^IBCNSU3(P,E,X,.XY)
+7 ;
COVQ QUIT Y
+1 ;
PTCHK(DFN,IBNODE) ; - See if patient has a non-veteran eligibility.
+1 ; Input: DFN=patient IEN
+2 ; IBNODE=zero node to CT entry
+3 ; Output: IBFLAG=0-nonbillable, 1-billable
+4 NEW IBFLAG
SET IBFLAG=0
if '$GET(DFN)
GOTO PTCKQ
+5 IF $DATA(^DPT(+DFN,.312))
IF $GET(^("VET"))="Y"
SET IBFLAG=1
+6 IF $PIECE(IBNODE,U,4)
IF $PIECE($GET(^DIC(8,+$$SCE^IBSDU(+$PIECE(IBNODE,U,4),13),0)),U,5)="N"
SET IBFLAG=0
+7 ;
PTCKQ QUIT IBFLAG
+1 ;
NCCL(ENC) ; - Check if Encounter is NON-COUNT CLINIC
+1 ; Input: ENC = Pointer to the ENCOUNTER file (#409.69)
+2 ; Output: NCCL= 1 - NON-COUNT CLINIC / 0 - NO NON-COUNT CLINIC
+3 NEW NCCL,HLOC
+4 SET NCCL=0
SET HLOC=$$SCE^IBSDU(+ENC,4)
+5 IF HLOC
IF $PIECE($GET(^SC(+HLOC,0)),"^",17)="Y"
SET NCCL=1
+6 ;
+7 QUIT NCCL
+8 ;
HOSP(ADM) ; Is the patient still hospitalized (not discharged)?
+1 ; Input: ADM = Pointer to the PATIENT MOVEMENT file (#405)
+2 ;Output: HOSP = 1 - Hospitalized / 0 - Discharged
+3 ;
+4 NEW HOSP,X
+5 SET HOSP=1
SET X=$GET(^DGPM(+ADM,0))
IF $PIECE(X,"^",17)
SET HOSP=0
+6 ;
+7 QUIT HOSP
+8 ;
CKBIL(X,Y) ; - Return valid claim data.
+1 ; Input: X=IEN from file #399, Y=0-outpatient, 1-inpatient
+2 ; Output: Z=rate^status^auth date^1-inst claim/2-prof claim^
+3 ; event date (if Y=1), or null^req MRA date
+4 NEW X1,X2,Y1,Z
SET Z=""
if '$GET(X)
GOTO CKBLQ
if '$GET(Y)
SET Y=0
+5 SET X1=$GET(^DGCR(399,X,0))
if X1=""
GOTO CKBLQ
+6 ; Invalid patient IEN.
IF $GET(DFN)
IF $PIECE(X1,U,2)'=DFN
GOTO CKBLQ
+7 ; Bill has RX rev codes.
IF '$GET(IBRX)
IF 'Y
IF '$$NOTRX(X)
GOTO CKBLQ
+8 ; Not inpatient bill.
IF $PIECE(X1,U,5)<3
IF 'Y
GOTO CKBLQ
+9 ; Not outpatient bill.
IF $PIECE(X1,U,5)>2
IF Y
GOTO CKBLQ
+10 ; Not an insurance bill.
IF $PIECE(X1,U,11)'="i"
GOTO CKBLQ
+11 SET X2=$PIECE($GET(^DGCR(399,X,"S")),U,10)
+12 ; No authorization date, not MRA req
IF 'X2
if $PIECE(X1,U,13)'=2
GOTO CKBLQ
+13 ; Status not auth, prin, trans.
IF $PIECE(X1,U,13)<2!($PIECE(X1,U,13)>5)
GOTO CKBLQ
+14 ;JRA;IB*2.0*608 Check if claim should be excluded based on MCCF/non-MCCF
+15 ;JRA;IB*2.0*608
IF $GET(IBMCCF)]""
IF IBMCCF'="B"
IF '$$MCCFCKX(399,X,.07,"RTYP")
GOTO CKBLQ
+16 SET Z=$PIECE(X1,U,7)_U_$PIECE(X1,U,13)_U_X2
SET Y1=$PIECE($PIECE(X1,U,3),".")
+17 if $PIECE(X1,U,13)=2
SET $PIECE(Z,U,6)=$PIECE($GET(^DGCR(399,X,"S")),U,7)
+18 IF $PIECE(X1,U,27)=1!($PIECE(X1,U,19)=3)!(Y1<2990901)
SET $PIECE(Z,U,4)=1
GOTO CKBL1
+19 IF $PIECE(X1,U,27)=2!($PIECE(X1,U,19)=2)
SET $PIECE(Z,U,4)=2
+20 ; Not institutional or professional bill.
IF '$PIECE(Z,U,4)
SET Z=""
GOTO CKBLQ
CKBL1 IF Y
SET $PIECE(Z,U,5)=Y1
+1 ;
CKBLQ QUIT Z
+1 ;
CKENC(IBOE,IBOE0,IBQUIT) ; - Check outpatient encounters.
+1 NEW IBCK,IBZ,IBPB,IBZERR
+2 IF $GET(IBOE0)=""
DO GETGEN^SDOE(IBOE,"IBZ","IBZERR")
SET IBOE0=$GET(IBZ(0))
+3 FOR IBZ=9,13,14
SET IBCK(IBZ)=""
+4 ; Not billable.
IF '$$BILLCK^IBAMTEDU(IBOE,IBOE0)
SET IBQUIT=1
+5 QUIT
+6 ;
SCAN(DFN,IBDT,IBQUERY) ; - Look at all visits for a day.
+1 NEW IBNDT,IBVAL,IBFILTER,IBCBK
+2 SET IBVAL("DFN")=DFN
SET IBVAL("BDT")=IBDT
SET IBVAL("EDT")=IBDT
SET IBFILTER=""
+3 SET 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"
+4 SET IBNDT=0
DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,0,.IBQUERY)
+5 QUIT
+6 ;
SC(PTF) ; - If patient is SC, are movements for SC care.
+1 ; Input: PTF=PTF record
+2 ; Output: IBM=1-all movements PTF, 0-one or more not flagged as SC
+3 NEW M,IBM
SET IBM=1
SET M=0
if $GET(^DGPT(+$GET(PTF),0))=""
GOTO SCQ
+4 FOR
SET M=$ORDER(^DGPT(PTF,"M",M))
if 'M
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^DGPT(PTF,"M",M,0)),U,18)'=1
SET IBM=0
End DoDot:1
if 'IBM
QUIT
+6 ;
SCQ QUIT IBM
+1 ;
LD(L,M) ; - Load average/unbilled totals into file #356.19
+1 ; Input: L=1-average (mon), 2-average (12m), 3-unbilled
+2 ; M=file #356.19 IEN
+3 IF '$GET(L)!('$GET(M))
GOTO LDQ
+4 SET DA=M
SET DIE="^IBE(356.19,"
+5 SET DR=$SELECT(L=3:"[IBT UNBILLED AMOUNTS]",L=2:"[IBT AVERAGE BILL AMOUNTS (12M)]",1:"[IBT AVERAGE BILL AMOUNTS (MON)]")
+6 DO ^DIE
KILL DA,DIE,DR
+7 ;
LDQ QUIT
+1 ;
XTRACT ; - Calculate remaining extract totals and load into file #351.71
+1 ; - Set IB with the average and total amounts and call E^IBJDE
+2 NEW X,AVGS
+3 SET AVGS=$$INPAVG(IBTIMON)
+4 SET IB(2)=$JUSTIFY(IB(1)*$PIECE(AVGS,"^"),0,2)
+5 SET IB(4)=$JUSTIFY(IB(3)*$PIECE(AVGS,"^",2),0,2)
+6 SET IB(6)=$JUSTIFY(IB(2)+IB(4),0,2)
+7 SET IB(13)=IB(9)+IB(11)
SET IB(15)=IB(7)+IB(14)
+8 FOR X=8,10,12,18
SET IB(X)=$JUSTIFY(IB(X),0,2)
+9 SET IB(16)=$JUSTIFY(IB(8)+IB(10)+IB(12),0,2)
+10 SET IB(19)=$JUSTIFY(IB(6)+IB(16)+IB(18),0,2)
+11 DO E^IBJDE(37,0)
+12 QUIT
+13 ;
INPAVG(IBYRMO) ; - Calculate the Average Inpatient INST. & PROF. Billed Amounts
+1 ; Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
+2 ; Output: Avg.Inpt.Inst.Bill Amount ^ Avg.Inpt.Prof. Bill Amount
+3 ;
+4 NEW AVGI,AVGP,ND
IF '$GET(IBYRMO)
QUIT ""
+5 FOR
if $PIECE($GET(^IBE(356.19,IBYRMO,1)),"^",14)'=""!'IBYRMO
QUIT
Begin DoDot:1
+6 SET IBYRMO=$ORDER(^IBE(356.19,IBYRMO),-1)
End DoDot:1
+7 SET (AVGI,AVGP)=0
IF 'IBYRMO
QUIT ""
+8 SET ND=$GET(^IBE(356.19,IBYRMO,1))
+9 IF $PIECE(ND,"^",9)
SET AVGI=$JUSTIFY($PIECE(ND,"^",8)/$PIECE(ND,"^",9),0,2)
+10 IF $PIECE(ND,"^",12)
SET AVGP=$JUSTIFY($PIECE(ND,"^",11)/$PIECE(ND,"^",12),0,2)
+11 QUIT (AVGI_"^"_AVGP)
+12 ;
NOTRX(BILL) ; - Determine if bill contains outpatient visit (use this check
+1 ; to make sure not just rx bill returns one if contains a revenue
+2 ; code for outpatient visit or a zero if no outpatient visit code
+3 ; on bill).
+4 NEW IBRX,RC,X
+5 SET (IBRX,RC)=0
if '$ORDER(^DGCR(399,BILL,"OP",0))
GOTO NOTRXQ
+6 FOR
SET RC=$ORDER(^DGCR(399,BILL,"RC",RC))
if 'RC
QUIT
IF $PIECE($GET(^DGCR(399.1,+$PIECE($GET(^DGCR(399,BILL,"RC",RC,0)),U,5),0)),U)'="PRESCRIPTION"
SET IBRX=1
QUIT
+7 ;
NOTRXQ QUIT IBRX
+1 ;
MCCFCKX(FILE,IEN,FLD,ND) ;JRA;IB*2.0*608 Check if Eligibility of Encounter, Appointment Type, and Rate Type meet MCCF/non-MCCF criteria
+1 ;Input: FILE=
+2 if ('$GET(FILE)!('$GET(IEN)!('$GET(FLD)!($GET(ND)=""))))
QUIT -1
+3 NEW VAL
+4 SET VAL=$$GET1^DIQ(FILE,IEN_",",FLD,"I")
if 'VAL
QUIT -1
+5 IF ((IBMCCF="N")&('$DATA(IBMCCF(ND,VAL))))!((IBMCCF="M")&($DATA(IBMCCF(ND,VAL))))
QUIT 0
+6 QUIT 1
+7 ;
