| 1 | IBAMTC2 ;ALB/CJM - INTEGRATED BILLING, CLEANUP OF UNCLOSED EVENTS, UNPASSED CHARGES ; 04-APRIL-1992
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**132,176**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MAIN ;
|
|---|
| 6 | N IBAGE,IBFREQ,IBCHG,DFN,IBN,IBND,IBSL,IBDISC,DIE,DR,DA,IBQUIT,IBPASS,IBOLD,IBDATE,IBDUZ S IBDUZ=$G(DUZ)
|
|---|
| 7 | D NOW^%DTC S IBDATE=X
|
|---|
| 8 | S IBAGE=44,IBFREQ=15 ; age of unpassed charges to report, frequency
|
|---|
| 9 | ; loop through all incomplete entries in file 350
|
|---|
| 10 | N IBFLLTC
|
|---|
| 11 | S IBN="" F S IBN=$O(^IB("AC",1,IBN)) Q:'IBN S IBND=$G(^IB(IBN,0)) D
|
|---|
| 12 | .Q:($P(IBND,"^",5)'=1)!($P(IBND,"^",16)']"")
|
|---|
| 13 | .I $P(IBND,"^",16)=IBN S IBFLLTC="" D Q:IBFLLTC="L"
|
|---|
| 14 | ..;
|
|---|
| 15 | ..N IBDISC,IBSL,VAIN,VAINDT,IBLDT D DISC Q:+IBDISC=0
|
|---|
| 16 | ..S DFN=$P(IBND,"^",2),VAINDT=IBDISC D INP^VADPT S IBFLLTC=$P($$TREATSP^IBAECU2($P($G(^DIC(45.7,+VAIN(3),0)),U,2)),"^",1)
|
|---|
| 17 | ..S IBLDT=$$LASTMJ^IBAECU() I IBLDT>0,$E(IBDISC,1,5)<$E(IBLDT,1,5),IBFLLTC="L" D CLOSE
|
|---|
| 18 | .I $P(IBND,"^",16)=IBN D
|
|---|
| 19 | ..D EVENT
|
|---|
| 20 | .E D CHARGE
|
|---|
| 21 | Q
|
|---|
| 22 | EVENT ; closes events if the patient was discharged
|
|---|
| 23 | S (IBPASS,IBQUIT)=0
|
|---|
| 24 | D DISC I IBDISC D CLOSE D:'IBQUIT FNDCHGS,PASS:IBCHG,BULLET1^IBAMTC3
|
|---|
| 25 | Q
|
|---|
| 26 | DISC ; gets the discharge date
|
|---|
| 27 | S IBDISC="",IBSL=$P(IBND,"^",4)
|
|---|
| 28 | I $P(IBSL,":")=405 S IBDISC=$P(IBSL,":",2) S:IBDISC]"" IBDISC=$P($G(^DGPM(IBDISC,0)),"^",17)
|
|---|
| 29 | S:IBDISC IBDISC=($P($G(^DGPM(IBDISC,0)),"^")\1)
|
|---|
| 30 | Q
|
|---|
| 31 | CLOSE ;
|
|---|
| 32 | S IBQUIT=1
|
|---|
| 33 | L +^IB(IBN):3 I $T D
|
|---|
| 34 | .S IBQUIT=0
|
|---|
| 35 | .S DIE="^IB(",DA=IBN,DR=".05////2"
|
|---|
| 36 | .D ^DIE L -^IB(IBN)
|
|---|
| 37 | Q
|
|---|
| 38 | FNDCHGS ;
|
|---|
| 39 | N I S IBCHG="" F I=1:1 S IBCHG=$O(^IB("ACT",IBN,IBCHG)) Q:'IBCHG S IBCHG(I)=IBCHG
|
|---|
| 40 | S IBCHG=(I-1)
|
|---|
| 41 | Q
|
|---|
| 42 | PASS ; pass the charges if they appear correct, complete, and can be locked
|
|---|
| 43 | S IBPASS=0
|
|---|
| 44 | N IBI,IBNOS,IBADMIT S DFN=$P(IBND,"^",2),IBADMIT=($P(IBND,"^",17)\1)
|
|---|
| 45 | Q:+$$MVT^DGPMOBS($P(IBSL,":",2))
|
|---|
| 46 | I IBDISC=$P(IBND,"^",17) Q:$P(IBND,"^",18)'=IBDISC
|
|---|
| 47 | E S X1=$P(IBND,"^",18),X2=1 D C^%DTC Q:X'=IBDISC
|
|---|
| 48 | S IBPASS=1 F IBI=1:1:IBCHG L +^IB(IBCHG(IBI)):1 S IBPASS=$T Q:'IBPASS I ($P($G(^IB(IBCHG(IBI),0)),"^",15)>IBDISC)!($P($G(^IB(IBCHG(IBI),0)),"^",14)<IBADMIT) S IBPASS=0 Q
|
|---|
| 49 | I IBPASS N IBN F IBI=1:1:IBCHG S IBNOS=IBCHG(IBI),IBY=1 D FILER^IBAUTL5 D:IBY<1 ^IBAERR1
|
|---|
| 50 | F IBI=1:1:IBCHG L -^IB(IBCHG(IBI))
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | CHARGE ; if the charge is old send a bulletin
|
|---|
| 54 | N IBWHEN S IBWHEN=$P($G(^IB(IBN,1)),"^",2)
|
|---|
| 55 | S X2=IBWHEN,X1=IBDATE D ^%DTC
|
|---|
| 56 | S IBOLD=(+$FN(X,"T")) I IBOLD>IBAGE,X#IBFREQ=0 D BULLET2^IBAMTC3
|
|---|
| 57 | Q
|
|---|
