| [613] | 1 | IBCU3 ;ALB/AAS - BILLING UTILITY ROUTINE (CONTINUED) ; 4/4/03 8:49am
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,80,91,106,51,137,211,245,348**;21-MAR-94;Build 5
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRU3
|
|---|
| 6 | SC(DFN) ; returns 1 if service connection indicated, 0 otherwise (based on VAEL(3))
|
|---|
| 7 | N X,VAEL,VAERR S X=0
|
|---|
| 8 | I +$G(DFN) D ELIG^VADPT S X=+$G(VAEL(3))
|
|---|
| 9 | Q X
|
|---|
| 10 | ;
|
|---|
| 11 | APPT(DATE,DFN,DISP) ;Check date to see if patient has any visit data
|
|---|
| 12 | ;input: DATE - required, date to check for appointments
|
|---|
| 13 | ; DFN - required, patient to check for appointments on date
|
|---|
| 14 | ; DISP - if true then error message will be printed before exit, if any
|
|---|
| 15 | ;returns: 1 - if appt visit found
|
|---|
| 16 | ; 2 - if unscheduled add/edit clinic stop entry found
|
|---|
| 17 | ; 3 - if only disposition found
|
|---|
| 18 | ; "0^error message" if no valid visit data/disposition found
|
|---|
| 19 | ;
|
|---|
| 20 | N Y,X,X1,X2 S DATE=$P(DATE,".",1),Y="0^* Patient has no Visits for this date..."
|
|---|
| 21 | I 'DATE!'$D(^DPT(DFN,0)) S Y="0^Unable to check for appointments on this date!" G APPTE
|
|---|
| 22 | N IBVAL,IBCBK,IBVTYP
|
|---|
| 23 | S IBVAL("DFN")=DFN,IBVAL("BDT")=DATE,IBVAL("EDT")=DATE+.9
|
|---|
| 24 | S IBCBK="I '$P(Y0,U,6) S IBVTYP=+$P(Y0,U,8) I $S(IBVTYP=2:1,IBVTYP=1:$$APPTCT^IBEFUNC(Y0),IBVTYP=3:$$DISCT^IBEFUNC(Y,Y0),1:0) S IBVTYP(IBVTYP)="""" S:$D(IBVTYP(1)) SDSTOP=1"
|
|---|
| 25 | D SCAN^IBSDU("PATIENT/DATE",.IBVAL,"",IBCBK,1) K ^TMP("DIERR",$J)
|
|---|
| 26 | S IBVTYP=$O(IBVTYP(0))
|
|---|
| 27 | S:IBVTYP Y=IBVTYP
|
|---|
| 28 | ;
|
|---|
| 29 | APPTE I +$G(DISP),'Y W !,?10,*7,$P(Y,U,2)
|
|---|
| 30 | Q Y
|
|---|
| 31 | ;
|
|---|
| 32 | BDT(DFN,DATE) ; returns primary bill defined for an event date, "" if none
|
|---|
| 33 | N X,Y S X="" I '$O(^DGCR(399,"C",+$G(DFN),0))!'$G(DATE) G BDTE
|
|---|
| 34 | S Y="",DATE=9999999-DATE F S Y=$O(^DGCR(399,"APDT",+DFN,Y)) Q:'Y D
|
|---|
| 35 | . I $O(^DGCR(399,"APDT",+DFN,Y,0))=DATE,'$P($G(^DGCR(399,Y,"S")),U,16) S X=$P($G(^DGCR(399,Y,0)),U,17) Q
|
|---|
| 36 | BDTE Q X
|
|---|
| 37 | ;
|
|---|
| 38 | BILLED(PTF) ;returns bill "IFN^^rate group" if PTF record is already associated with an uncancelled final bill
|
|---|
| 39 | ;returns "bill IFN ^ bill date (stm to) ^ bill rate group" if inpatients interim with no final bill, 0 otherwise
|
|---|
| 40 | N IFN,Y,X S Y=0 I '$D(^DGCR(399,"APTF",+$G(PTF))) G BILLEDQ
|
|---|
| 41 | S IFN=0 F S IFN=$O(^DGCR(399,"APTF",PTF,IFN)) Q:'IFN D I +Y,'$P(Y,U,2) Q
|
|---|
| 42 | . S X=$G(^DGCR(399,IFN,0)) I $P(X,U,13)=7 Q ; bill cancelled
|
|---|
| 43 | . S Y=IFN_"^^"_$P(X,U,7) I $P(X,U,6)=2!($P(X,U,6)=3) S Y=IFN_"^"_$P($G(^DGCR(399,IFN,"U")),U,2)_"^"_$P(X,U,7)
|
|---|
| 44 | BILLEDQ Q Y
|
|---|
| 45 | ;
|
|---|
| 46 | FTN(FT) ;returns name of the form type passed in, "" if not defined
|
|---|
| 47 | N X S X=$P($G(^IBE(353,+$G(FT),0)),U,1)
|
|---|
| 48 | Q X
|
|---|
| 49 | ;
|
|---|
| 50 | FT(IFN,IBRESET) ;return the correct form type for a bill (trigger code in 399 to set .19)
|
|---|
| 51 | ; if IBRESET is not a positive value ('IBRESET), returns the bills current form type (if defined)
|
|---|
| 52 | ; if IBRESET is a positive value (+IBRESET), interpret form type according to following rules (for triggers):
|
|---|
| 53 | ; first use ins co default (36,.14), then bill is inst (UB) or prof (1500) (399,.27),
|
|---|
| 54 | ; then current (399,.19), then UB
|
|---|
| 55 | N X,Y,FTC,FTN,FTI,FTT,INS S X="",IFN=+$G(IFN),Y=$G(^DGCR(399,IFN,0))
|
|---|
| 56 | S FTC=$P(Y,U,19) I FTC=1 S FTC=3
|
|---|
| 57 | I '$G(IBRESET),+FTC S X=FTC G FTQ
|
|---|
| 58 | S FTT=$S($P(Y,U,27)=1:3,$P(Y,U,27)=2:2,1:"")
|
|---|
| 59 | S INS=+$G(^DGCR(399,IFN,"MP"))
|
|---|
| 60 | I 'INS,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IFN)) S INS=+$$CURR^IBCEF2(IFN)
|
|---|
| 61 | S FTI=$P($G(^DIC(36,+INS,0)),U,14)
|
|---|
| 62 | S X=$S(+FTI:FTI,+FTT:FTT,+FTC:FTC,1:3)
|
|---|
| 63 | FTQ Q X
|
|---|
| 64 | ;
|
|---|
| 65 | FNT(FTN) ;returns the ifn of the form type name passed in, must be exact match, 0 if none found
|
|---|
| 66 | N X,Y S X=0 I $G(FTN)'="" S X=$O(^IBE(353,"B",FTN,0))
|
|---|
| 67 | Q X
|
|---|
| 68 | ;
|
|---|
| 69 | BILLDEV(IFN,PRT) ;returns the default device for a bill's form type, if PRT is passed as true then returns the AR follow up device, otherwise the billing device
|
|---|
| 70 | N X,Y S X=0 I $D(^DGCR(399,+$G(IFN),0)) S PRT=$S(+$G(PRT):3,1:2),Y=$$FT(IFN),X=$P($G(^IBE(353,+Y,0)),U,PRT)
|
|---|
| 71 | Q X
|
|---|
| 72 | ;
|
|---|
| 73 | RXDUP(RX,DATE,IFN,DISP,DFN,RTG) ;returns bill ifn if rx # exists on another bill
|
|---|
| 74 | ;input: rx # - required, rx # to check for
|
|---|
| 75 | ; date - required, date of refill
|
|---|
| 76 | ;ifn, dfn, rtg are optional - if not passed then not used to specify rx
|
|---|
| 77 | ;(if ifn not passed then returns true if on any bill same or dfn and rtgetc.)
|
|---|
| 78 | ;if ifn passed the dfn and rtg do not need to be
|
|---|
| 79 | N X,LN,RIFN,BIFN,RLN,BLN S (RIFN,X)=0,DATE=$G(DATE),RX=$G(RX),IFN=$G(IFN) I RX=""!('DATE) G RXDUPE
|
|---|
| 80 | S LN=$G(^DGCR(399,+IFN,0)),DFN=$S(+$G(DFN):DFN,1:+$P(LN,U,2)),RTG=$S(+$G(RTG):RTG,1:+$P(LN,U,7))
|
|---|
| 81 | F S RIFN=$O(^IBA(362.4,"B",RX,RIFN)) Q:'RIFN S RLN=$G(^IBA(362.4,+RIFN,0)) I +DATE=+$P(RLN,U,3) D Q:+X
|
|---|
| 82 | . S BIFN=+$P(RLN,U,2),BLN=$G(^DGCR(399,BIFN,0)) Q:(BLN="")!(BIFN=+$G(IFN))
|
|---|
| 83 | . I $P(BLN,U,13)=7 Q ; bill cancelled
|
|---|
| 84 | . I +DFN,$P(BLN,U,2)'=DFN Q ; different patient
|
|---|
| 85 | . I +RTG,+RTG'=$P(BLN,U,7) Q ; different rate group
|
|---|
| 86 | . S X=BIFN_"^A "_$P($G(^DGCR(399.3,+$P(BLN,U,7),0)),U,1)_" bill ("_$P(BLN,U,1)_") exists for Rx # "_RX_" and refill date "_$$DAT1^IBOUTL(DATE)_"."
|
|---|
| 87 | RXDUPE I +$G(DISP),+X W !,?10,$P(X,U,2)
|
|---|
| 88 | Q X
|
|---|
| 89 | ;
|
|---|
| 90 | BCOB(IBIFN,IBCOB) ; returns an array of all bills related COB to the bill passed in
|
|---|
| 91 | ; includes prior bills defined on this bill then checks the Primary, Secondary and Tertiary Bills and adds
|
|---|
| 92 | ; all the prior bills defined on them
|
|---|
| 93 | ; ARR(BILL SEQUENCE (1,2,3), INSURANCE CO, BILL #)=""
|
|---|
| 94 | ;
|
|---|
| 95 | N IBM1,IBI,IBIFN1,IBM,IBM11,IBSEQ,IBSEQN,IBJ K IBCOB
|
|---|
| 96 | S IBM1=$G(^DGCR(399,IBIFN,"M1"))
|
|---|
| 97 | F IBI=IBIFN,+$P(IBM1,U,5),+$P(IBM1,U,6),+$P(IBM1,U,7) I +IBI S IBIFN1=+IBI D
|
|---|
| 98 | . ;
|
|---|
| 99 | . S IBM=$G(^DGCR(399,IBIFN1,"M")),IBM11=$G(^DGCR(399,IBIFN1,"M1")) I IBIFN=IBIFN1,'$P(IBM,U,2),'$P(IBM,U,3) Q
|
|---|
| 100 | . S IBSEQ=$P($G(^DGCR(399,IBIFN1,0)),U,21),IBSEQN=$S(IBSEQ="P":1,IBSEQ="S":2,IBSEQ="T":3,1:"") Q:'IBSEQN
|
|---|
| 101 | . ;
|
|---|
| 102 | . F IBJ=1:1:3 I +$P(IBM,U,IBJ) S IBCOB(IBJ,+$P(IBM,U,IBJ),+$P(IBM11,U,(IBJ+4)))=""
|
|---|
| 103 | . I +$P(IBM,U,IBSEQN) S IBCOB(IBSEQN,$P(IBM,U,IBSEQN),+IBIFN1)=""
|
|---|
| 104 | ;
|
|---|
| 105 | S IBI=0 F S IBI=$O(IBCOB(IBI)) Q:'IBI S IBJ=0 F S IBJ=$O(IBCOB(IBI,IBJ)) Q:'IBJ I +$O(IBCOB(IBI,IBJ,0)) K IBCOB(IBI,IBJ,0)
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
| 108 | BINS(IBIFN) ; return list of billable insurance carriers on a bill (COB)
|
|---|
| 109 | ; output: sequence:carrier:policy ^ sequence:carrier:policy ^ sequence:carrier:policy
|
|---|
| 110 | N IBM0,IBI,IBS,IBC,IBP,IBX S IBI=0,IBX="",IBM0=$G(^DGCR(399,+$G(IBIFN),"M"))
|
|---|
| 111 | F IBS="P","S","T" S IBI=IBI+1,IBC=+$P(IBM0,U,IBI) I +IBC D
|
|---|
| 112 | . S IBP=+$P(IBM0,U,(11+IBI)) I $P($G(^DIC(36,+IBC,0)),U,2)'="N" S IBX=IBX_IBS_":"_IBC_":"_IBP_U
|
|---|
| 113 | Q IBX
|
|---|
| 114 | ;
|
|---|
| 115 | BOTHER(IBIFN,IBDT) ; return Bedsection of Type of Care if date is Other Type of care, based on "OT" multiple
|
|---|
| 116 | ; Other care is not inpatient or outpatient, SNF and Sub-Acute became distinct with RC v2.0
|
|---|
| 117 | ; as with all other bedsection movements, the last date is not included since that is the date they left
|
|---|
| 118 | N IBX,IBY,IBFND S IBFND=0,IBDT=$G(IBDT)\1
|
|---|
| 119 | I +$G(IBIFN),+IBDT S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"OT",IBX)) Q:'IBX D
|
|---|
| 120 | . S IBY=$G(^DGCR(399,IBIFN,"OT",IBX,0)) Q:'IBY
|
|---|
| 121 | . I IBDT'<$P(IBY,U,2),IBDT<$P(IBY,U,3) S IBFND=+IBY
|
|---|
| 122 | Q IBFND
|
|---|
