IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
UPD ; Perform encounter update actions.
;
; - was check out deleted?
I IBAST'=2,IBBST=2 S IBCRES=$S(IBAST=8:5,1:1)
;
; - see if checked out appt classifications were changed
I IBAST=2,IBBST=2 D CLSF^IBAMTS1(1,.IBCLSF) S IBACT=$$CLUPD() G:'IBACT UPDQ D I IBACT'=1 G UPDQ
.I IBACT=1 S IBCRES=2 Q
.I IBACT=2 N IBCLSF D NEW^IBAMTS1
;
; - cancel charge if there is a cancellation reason, and the billed
; - charge was for the appointment that is no longer billable
I '$G(IBCRES) G UPDQ
I '$$LINK(IBOE,$S(IBEVT:IBEVT,1:IBEV0),IBBILLED) G UPDQ
D CANC G:IBY<0 UPDQ
;
; - look for other billable visits if Category C
I '$$BIL^DGMTUB(DFN,IBDT) G UPDQ
S IBBILLED=0,IBD=IBDAT-.1
F S IBD=$O(^SCE("ADFN",DFN,IBD)) Q:'IBD!($P(IBD,".")'=IBDAT) D Q:IBBILLED
.S IBOEN=0 F S IBOEN=$O(^SCE("ADFN",DFN,IBD,IBOEN)) Q:'IBOEN D Q:IBBILLED
..;
..Q:IBOEN=IBOE ; skip encounter that was just cancelled
..S IBEVT=$G(^SCE(IBOEN,0)) Q:'IBEVT ; no zeroth node
..Q:$P(IBEVT,"^",12)'=2 ; not checked out
..I $P(IBEVT,"^",10)=1 S IBBILLED=1 Q ; C&P exam -- stop looking
..Q:$P(IBEVT,"^",6) ; skip child events
..;
..; - perform batch edit
..S IBORG=+$P(IBEVT,"^",8),IBAPTY=+$P(IBEVT,"^",10)
..I IBORG=3 S IBDISP=+$P($G(^DPT(DFN,"DIS",+$P(IBEVT,"^",9),0)),"^",7) Q:'IBDISP
..Q:'$$CHKS^IBAMTS1
..;
..; - check classifications
..S IBCLSF=$$ENCL(IBOEN)
..I +IBCLSF!($P(IBCLSF,"^",2))!($P(IBCLSF,"^",4)) Q ; care was related to ao/ir/ec
..S IBSL="409.68:"_IBOEN ; set softlink
..;
..; - ready to bill another encounter
..D BLD^IBAMTS1 S IBBILLED=1
;
;
UPDQ K IBCLSF,IBACT,IBC,IBOEN,IBEVT
Q
;
CRES ; List of cancellation reasons
;;CHECK OUT DELETED
;;CLASSIFICATION CHANGED
;;MT OP APPT NO-SHOW
;;MT OP APPT CANCELLED
;;RECD INPATIENT CARE
;
LINK(IBOE,IBEVT,IBN) ; Was the billed charge for the current appointment?
; Input: IBOE -- Pointer to outpatient encounter in file #409.68
; IBEVT -- Zeroth node of encounter in file #409.68
; IBN -- Pointer to charge in file #350
; Output: 0 -- Charge was not for current appointment
; 1 -- Charge was for current appointment
I '$G(IBOE)!'$G(IBEVT)!'$G(IBN) G LINKQ
N IBSL,Y S IBSL=$P($G(^IB(IBN,0)),"^",4)
I +IBSL=44 S Y=$P(IBSL,";",1,2)=("44:"_$P(IBEVT,"^",4)_";S:"_+IBEVT) G LINKQ
I +IBSL=409.68 S Y=IBSL=("409.68:"_IBOE)
LINKQ Q +$G(Y)
;
CLUPD() ; Examine changes in the classification.
; Output: 0 -- no changes
; 1 -- changes require charges to be cancelled
; 2 -- changes require appt to be billed
; 3 -- [ec] cancel charge, create deferred charge
; 4 -- [ec] pass deferred charge, disposition case
N I,Y S Y=0
I IBCLSF("BEFORE")=IBCLSF("AFTER") G CLUPDQ
F I=1,2,4 I '$P(IBCLSF("BEFORE"),"^",I),$P(IBCLSF("AFTER"),"^",I) S Y=$S(I=4:3,1:1) G CLUPDQ
F I=1,2,4 I $P(IBCLSF("BEFORE"),"^",I),'$P(IBCLSF("AFTER"),"^",I) S Y=$S(I=4:4,1:2) Q
CLUPDQ Q Y
;
CANC ; Determine cancellation reason and cancel charge
; Input variables: IBCRES -- Code for reason to be determined
; IBBILLED -- Charge to be cancelled
S IBCRES=$P($T(CRES+IBCRES),";;",2),IBCRES=+$O(^IBE(350.3,"B",IBCRES,0))
D CANCH^IBECEAU4(IBBILLED,IBCRES)
Q
;
ENCL(IBOE) ; Return classification results for an encounter.
; Input: IBOE -- Pointer to outpatient encounter in file #409.68
; Output: ao^ir^sc^ec, where, for each piece,
; 1 - care was related to condition, and
; 0 (or null) - care not related to condition
N CL,CLD,X,Y S Y=""
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,"^",+CLD)=+$P(CLD,"^",3)
Q Y
IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
UPD ; Perform encounter update actions.
+1 ;
+2 ; - was check out deleted?
+3 IF IBAST'=2
IF IBBST=2
SET IBCRES=$SELECT(IBAST=8:5,1:1)
+4 ;
+5 ; - see if checked out appt classifications were changed
+6 IF IBAST=2
IF IBBST=2
DO CLSF^IBAMTS1(1,.IBCLSF)
SET IBACT=$$CLUPD()
IF 'IBACT
GOTO UPDQ
Begin DoDot:1
+7 IF IBACT=1
SET IBCRES=2
QUIT
+8 IF IBACT=2
NEW IBCLSF
DO NEW^IBAMTS1
End DoDot:1
IF IBACT'=1
GOTO UPDQ
+9 ;
+10 ; - cancel charge if there is a cancellation reason, and the billed
+11 ; - charge was for the appointment that is no longer billable
+12 IF '$GET(IBCRES)
GOTO UPDQ
+13 IF '$$LINK(IBOE,$SELECT(IBEVT:IBEVT,1:IBEV0),IBBILLED)
GOTO UPDQ
+14 DO CANC
IF IBY<0
GOTO UPDQ
+15 ;
+16 ; - look for other billable visits if Category C
+17 IF '$$BIL^DGMTUB(DFN,IBDT)
GOTO UPDQ
+18 SET IBBILLED=0
SET IBD=IBDAT-.1
+19 FOR
SET IBD=$ORDER(^SCE("ADFN",DFN,IBD))
IF 'IBD!($PIECE(IBD,".")'=IBDAT)
QUIT
Begin DoDot:1
+20 SET IBOEN=0
FOR
SET IBOEN=$ORDER(^SCE("ADFN",DFN,IBD,IBOEN))
IF 'IBOEN
QUIT
Begin DoDot:2
+21 ;
+22 ; skip encounter that was just cancelled
IF IBOEN=IBOE
QUIT
+23 ; no zeroth node
SET IBEVT=$GET(^SCE(IBOEN,0))
IF 'IBEVT
QUIT
+24 ; not checked out
IF $PIECE(IBEVT,"^",12)'=2
QUIT
+25 ; C&P exam -- stop looking
IF $PIECE(IBEVT,"^",10)=1
SET IBBILLED=1
QUIT
+26 ; skip child events
IF $PIECE(IBEVT,"^",6)
QUIT
+27 ;
+28 ; - perform batch edit
+29 SET IBORG=+$PIECE(IBEVT,"^",8)
SET IBAPTY=+$PIECE(IBEVT,"^",10)
+30 IF IBORG=3
SET IBDISP=+$PIECE($GET(^DPT(DFN,"DIS",+$PIECE(IBEVT,"^",9),0)),"^",7)
IF 'IBDISP
QUIT
+31 IF '$$CHKS^IBAMTS1
QUIT
+32 ;
+33 ; - check classifications
+34 SET IBCLSF=$$ENCL(IBOEN)
+35 ; care was related to ao/ir/ec
IF +IBCLSF!($PIECE(IBCLSF,"^",2))!($PIECE(IBCLSF,"^",4))
QUIT
+36 ; set softlink
SET IBSL="409.68:"_IBOEN
+37 ;
+38 ; - ready to bill another encounter
+39 DO BLD^IBAMTS1
SET IBBILLED=1
End DoDot:2
IF IBBILLED
QUIT
End DoDot:1
IF IBBILLED
QUIT
+40 ;
+41 ;
UPDQ KILL IBCLSF,IBACT,IBC,IBOEN,IBEVT
+1 QUIT
+2 ;
CRES ; List of cancellation reasons
+1 ;;CHECK OUT DELETED
+2 ;;CLASSIFICATION CHANGED
+3 ;;MT OP APPT NO-SHOW
+4 ;;MT OP APPT CANCELLED
+5 ;;RECD INPATIENT CARE
+6 ;
LINK(IBOE,IBEVT,IBN) ; Was the billed charge for the current appointment?
+1 ; Input: IBOE -- Pointer to outpatient encounter in file #409.68
+2 ; IBEVT -- Zeroth node of encounter in file #409.68
+3 ; IBN -- Pointer to charge in file #350
+4 ; Output: 0 -- Charge was not for current appointment
+5 ; 1 -- Charge was for current appointment
+6 IF '$GET(IBOE)!'$GET(IBEVT)!'$GET(IBN)
GOTO LINKQ
+7 NEW IBSL,Y
SET IBSL=$PIECE($GET(^IB(IBN,0)),"^",4)
+8 IF +IBSL=44
SET Y=$PIECE(IBSL,";",1,2)=("44:"_$PIECE(IBEVT,"^",4)_";S:"_+IBEVT)
GOTO LINKQ
+9 IF +IBSL=409.68
SET Y=IBSL=("409.68:"_IBOE)
LINKQ QUIT +$GET(Y)
+1 ;
CLUPD() ; Examine changes in the classification.
+1 ; Output: 0 -- no changes
+2 ; 1 -- changes require charges to be cancelled
+3 ; 2 -- changes require appt to be billed
+4 ; 3 -- [ec] cancel charge, create deferred charge
+5 ; 4 -- [ec] pass deferred charge, disposition case
+6 NEW I,Y
SET Y=0
+7 IF IBCLSF("BEFORE")=IBCLSF("AFTER")
GOTO CLUPDQ
+8 FOR I=1,2,4
IF '$PIECE(IBCLSF("BEFORE"),"^",I)
IF $PIECE(IBCLSF("AFTER"),"^",I)
SET Y=$SELECT(I=4:3,1:1)
GOTO CLUPDQ
+9 FOR I=1,2,4
IF $PIECE(IBCLSF("BEFORE"),"^",I)
IF '$PIECE(IBCLSF("AFTER"),"^",I)
SET Y=$SELECT(I=4:4,1:2)
QUIT
CLUPDQ QUIT Y
+1 ;
CANC ; Determine cancellation reason and cancel charge
+1 ; Input variables: IBCRES -- Code for reason to be determined
+2 ; IBBILLED -- Charge to be cancelled
+3 SET IBCRES=$PIECE($TEXT(CRES+IBCRES),";;",2)
SET IBCRES=+$ORDER(^IBE(350.3,"B",IBCRES,0))
+4 DO CANCH^IBECEAU4(IBBILLED,IBCRES)
+5 QUIT
+6 ;
ENCL(IBOE) ; Return classification results for an encounter.
+1 ; Input: IBOE -- Pointer to outpatient encounter in file #409.68
+2 ; Output: ao^ir^sc^ec, where, for each piece,
+3 ; 1 - care was related to condition, and
+4 ; 0 (or null) - care not related to condition
+5 NEW CL,CLD,X,Y
SET Y=""
+6 SET CL=0
FOR
SET CL=$ORDER(^SDD(409.42,"OE",+$GET(IBOE),CL))
IF 'CL
QUIT
SET CLD=$GET(^SDD(409.42,CL,0))
IF CLD
SET $PIECE(Y,"^",+CLD)=+$PIECE(CLD,"^",3)
+7 QUIT Y
