[613] | 1 | IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,91,117,132,153,156,167,247,339**;21-MAR-94;Build 2
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | UPD ; Perform encounter update actions.
|
---|
| 6 | N IBCBK,IBFILTER,IBVAL
|
---|
| 7 | ;
|
---|
| 8 | ; - was check out deleted?
|
---|
| 9 | I IBAST'=2,IBBST=2 S IBCRES=$S(IBAST=8:5,1:1)
|
---|
| 10 | ;
|
---|
| 11 | ; - see if checked out appt classifications were changed
|
---|
| 12 | I IBAST=2,IBBST=2 D CLSF^IBAMTS1(1,.IBCLSF) S IBACT=$$CLUPD() G:'IBACT UPDQ D I IBACT'=1 G UPDQ
|
---|
| 13 | .I IBACT=1 S IBCRES=2 Q
|
---|
| 14 | .I IBACT=2 N IBCLSF D NEW^IBAMTS1
|
---|
| 15 | ;
|
---|
| 16 | ; - cancel charge if there is a cancellation reason, and the billed
|
---|
| 17 | ; - charge was for the appointment that is no longer billable
|
---|
| 18 | I '$G(IBCRES) G UPDQ
|
---|
| 19 | I '$$LINK(IBOE,$S(IBEVT:IBEVT,1:IBEV0),IBBILLED) G UPDQ
|
---|
| 20 | D CANC G:IBY<0 UPDQ
|
---|
| 21 | ;
|
---|
| 22 | ; - look for other billable visits if Means Test billable
|
---|
| 23 | I '$$BIL^DGMTUB(DFN,IBDT) G UPDQ
|
---|
| 24 | S IBBILLED=0
|
---|
| 25 | ;
|
---|
| 26 | S IBVAL("DFN")=DFN,IBVAL("BDT")=IBDAT-.1,IBVAL("EDT")=IBDAT_.99
|
---|
| 27 | S IBFILTER=""
|
---|
| 28 | ; Skip encounter just cancelled,
|
---|
| 29 | ; consider only parent encounters, appts checked out
|
---|
| 30 | S IBCBK="I Y'=IBOE,'$P(Y0,U,6),$P(Y0,U,12)=2 D BEDIT^IBAMTS2(Y,Y0) S:IBBILLED SDSTOP=1"
|
---|
| 31 | D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
|
---|
| 32 | ;
|
---|
| 33 | UPDQ K IBCLSF,IBACT,IBC,IBOEN,IBEVT
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | BEDIT(IBOEN,IBEVT) ; - perform batch edit
|
---|
| 37 | I $P(IBEVT,U,10)=1 S UNBILLED=1 Q ; C&P exam -- stop looking
|
---|
| 38 | S IBORG=+$P(IBEVT,U,8),IBAPTY=+$P(IBEVT,U,10)
|
---|
| 39 | I IBORG=3 S IBDISP=+$$DISND^IBSDU(IBOEN,IBEVT,7) Q:'IBDISP
|
---|
| 40 | Q:'$$CHKS^IBAMTS1
|
---|
| 41 | ;
|
---|
| 42 | ; - check classifications
|
---|
| 43 | S IBCLSF=$$ENCL(IBOEN)
|
---|
| 44 | I IBCLSF[1 Q ; care was related to ao/ir/swa/sc/mst/hnc/cv/shad
|
---|
| 45 | S IBSL="409.68:"_IBOEN ; set softlink
|
---|
| 46 | ;
|
---|
| 47 | ; - ready to bill another encounter
|
---|
| 48 | D BLD^IBAMTS1 S IBBILLED=1
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | CRES ; List of cancellation reasons
|
---|
| 52 | ;;CHECK OUT DELETED
|
---|
| 53 | ;;CLASSIFICATION CHANGED
|
---|
| 54 | ;;MT OP APPT NO-SHOW
|
---|
| 55 | ;;MT OP APPT CANCELLED
|
---|
| 56 | ;;RECD INPATIENT CARE
|
---|
| 57 | ;;BILLED AT HIGHER TIER RATE
|
---|
| 58 | ;
|
---|
| 59 | LINK(IBOE,IBEVT,IBN) ; Was the billed charge for the current appointment?
|
---|
| 60 | ; Input: IBOE -- Pointer to outpatient encounter in file #409.68
|
---|
| 61 | ; IBEVT -- Zeroth node of encounter in file #409.68
|
---|
| 62 | ; IBN -- Pointer to charge in file #350
|
---|
| 63 | ; Output: 0 -- Charge was not for current appointment
|
---|
| 64 | ; 1 -- Charge was for current appointment
|
---|
| 65 | N IBSL,Y
|
---|
| 66 | I '$G(IBOE)!'$G(IBEVT)!'$G(IBN) G LINKQ
|
---|
| 67 | S IBSL=$P($G(^IB(IBN,0)),"^",4)
|
---|
| 68 | I +IBSL=44 S Y=$P(IBSL,";",1,2)=("44:"_$P(IBEVT,"^",4)_";S:"_+IBEVT) G LINKQ
|
---|
| 69 | I +IBSL=409.68 S Y=IBSL=("409.68:"_IBOE)
|
---|
| 70 | LINKQ Q +$G(Y)
|
---|
| 71 | ;
|
---|
| 72 | CLUPD() ; Examine changes in the classification.
|
---|
| 73 | ; Output: 0 -- no changes
|
---|
| 74 | ; 1 -- changes require charges to be cancelled
|
---|
| 75 | ; 2 -- changes require appt to be billed
|
---|
| 76 | ; 3 -- [ec/swa] cancel charge, create deferred charge
|
---|
| 77 | ; 4 -- [ec/swa] pass deferred charge, disposition case
|
---|
| 78 | N I,Y S Y=0
|
---|
| 79 | I IBCLSF("BEFORE")=IBCLSF("AFTER") G CLUPDQ
|
---|
| 80 | F I=1,2,3,4,5,6,7,8 I '$P(IBCLSF("BEFORE"),U,I),$P(IBCLSF("AFTER"),U,I) S Y=$S(I=4:3,1:1) G CLUPDQ
|
---|
| 81 | F I=1,2,3,4,5,6,7,8 I $P(IBCLSF("BEFORE"),U,I),'$P(IBCLSF("AFTER"),U,I) S Y=$S(I=4:4,1:2) Q
|
---|
| 82 | CLUPDQ Q Y
|
---|
| 83 | ;
|
---|
| 84 | CANC ; Determine cancellation reason and cancel charge
|
---|
| 85 | ; Input variables: IBCRES -- Code for reason to be determined
|
---|
| 86 | ; IBBILLED -- Charge to be cancelled
|
---|
| 87 | S IBCRES=$P($T(CRES+IBCRES),";;",2),IBCRES=+$O(^IBE(350.3,"B",IBCRES,0))
|
---|
| 88 | D CANCH^IBECEAU4(IBBILLED,IBCRES)
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | ENCL(IBOE) ; Return classification results for an encounter.
|
---|
| 92 | ; Input: IBOE -- Pointer to outpatient encounter in file #409.68
|
---|
| 93 | ; Output: ao^ir^sc^swa^mst^hnc^cv^shad, where, for each piece,
|
---|
| 94 | ; 1 - care was related to condition, and
|
---|
| 95 | ; 0 (or null) - care not related to condition
|
---|
| 96 | N CL,CLD,X,Y S Y=""
|
---|
| 97 | S CL=0 F S CL=$O(^SDD(409.42,"OE",+$G(IBOE),CL)) Q:'CL S CLD=$G(^SDD(409.42,CL,0)) I CLD S $P(Y,U,+CLD)=+$P(CLD,U,3)
|
---|
| 98 | Q Y
|
---|