IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
;;2.0;INTEGRATED BILLING;**52,91,117,132,153,156,167,247,339**;21-MAR-94;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
UPD ; Perform encounter update actions.
N IBCBK,IBFILTER,IBVAL
;
; - 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 Means Test billable
I '$$BIL^DGMTUB(DFN,IBDT) G UPDQ
S IBBILLED=0
;
S IBVAL("DFN")=DFN,IBVAL("BDT")=IBDAT-.1,IBVAL("EDT")=IBDAT_.99
S IBFILTER=""
; Skip encounter just cancelled,
; consider only parent encounters, appts checked out
S IBCBK="I Y'=IBOE,'$P(Y0,U,6),$P(Y0,U,12)=2 D BEDIT^IBAMTS2(Y,Y0) S:IBBILLED SDSTOP=1"
D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
;
UPDQ K IBCLSF,IBACT,IBC,IBOEN,IBEVT
Q
;
BEDIT(IBOEN,IBEVT) ; - perform batch edit
I $P(IBEVT,U,10)=1 S UNBILLED=1 Q ; C&P exam -- stop looking
S IBORG=+$P(IBEVT,U,8),IBAPTY=+$P(IBEVT,U,10)
I IBORG=3 S IBDISP=+$$DISND^IBSDU(IBOEN,IBEVT,7) Q:'IBDISP
Q:'$$CHKS^IBAMTS1
;
; - check classifications
S IBCLSF=$$ENCL(IBOEN)
I IBCLSF[1 Q ; care was related to ao/ir/swa/sc/mst/hnc/cv/shad
S IBSL="409.68:"_IBOEN ; set softlink
;
; - ready to bill another encounter
D BLD^IBAMTS1 S IBBILLED=1
Q
;
CRES ; List of cancellation reasons
;;CHECK OUT DELETED
;;CLASSIFICATION CHANGED
;;MT OP APPT NO-SHOW
;;MT OP APPT CANCELLED
;;RECD INPATIENT CARE
;;BILLED AT HIGHER TIER RATE
;
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
N IBSL,Y
I '$G(IBOE)!'$G(IBEVT)!'$G(IBN) G LINKQ
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/swa] cancel charge, create deferred charge
; 4 -- [ec/swa] pass deferred charge, disposition case
N I,Y S Y=0
I IBCLSF("BEFORE")=IBCLSF("AFTER") G CLUPDQ
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
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
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^swa^mst^hnc^cv^shad, 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,U,+CLD)=+$P(CLD,U,3)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTS2 4046 printed Apr 09, 2024@21:31:39 Page 2
IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**52,91,117,132,153,156,167,247,339**;21-MAR-94;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
UPD ; Perform encounter update actions.
+1 NEW IBCBK,IBFILTER,IBVAL
+2 ;
+3 ; - was check out deleted?
+4 IF IBAST'=2
IF IBBST=2
SET IBCRES=$SELECT(IBAST=8:5,1:1)
+5 ;
+6 ; - see if checked out appt classifications were changed
+7 IF IBAST=2
IF IBBST=2
DO CLSF^IBAMTS1(1,.IBCLSF)
SET IBACT=$$CLUPD()
if 'IBACT
GOTO UPDQ
Begin DoDot:1
+8 IF IBACT=1
SET IBCRES=2
QUIT
+9 IF IBACT=2
NEW IBCLSF
DO NEW^IBAMTS1
End DoDot:1
IF IBACT'=1
GOTO UPDQ
+10 ;
+11 ; - cancel charge if there is a cancellation reason, and the billed
+12 ; - charge was for the appointment that is no longer billable
+13 IF '$GET(IBCRES)
GOTO UPDQ
+14 IF '$$LINK(IBOE,$SELECT(IBEVT:IBEVT,1:IBEV0),IBBILLED)
GOTO UPDQ
+15 DO CANC
if IBY<0
GOTO UPDQ
+16 ;
+17 ; - look for other billable visits if Means Test billable
+18 IF '$$BIL^DGMTUB(DFN,IBDT)
GOTO UPDQ
+19 SET IBBILLED=0
+20 ;
+21 SET IBVAL("DFN")=DFN
SET IBVAL("BDT")=IBDAT-.1
SET IBVAL("EDT")=IBDAT_.99
+22 SET IBFILTER=""
+23 ; Skip encounter just cancelled,
+24 ; consider only parent encounters, appts checked out
+25 SET IBCBK="I Y'=IBOE,'$P(Y0,U,6),$P(Y0,U,12)=2 D BEDIT^IBAMTS2(Y,Y0) S:IBBILLED SDSTOP=1"
+26 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
KILL ^TMP("DIERR",$JOB)
+27 ;
UPDQ KILL IBCLSF,IBACT,IBC,IBOEN,IBEVT
+1 QUIT
+2 ;
BEDIT(IBOEN,IBEVT) ; - perform batch edit
+1 ; C&P exam -- stop looking
IF $PIECE(IBEVT,U,10)=1
SET UNBILLED=1
QUIT
+2 SET IBORG=+$PIECE(IBEVT,U,8)
SET IBAPTY=+$PIECE(IBEVT,U,10)
+3 IF IBORG=3
SET IBDISP=+$$DISND^IBSDU(IBOEN,IBEVT,7)
if 'IBDISP
QUIT
+4 if '$$CHKS^IBAMTS1
QUIT
+5 ;
+6 ; - check classifications
+7 SET IBCLSF=$$ENCL(IBOEN)
+8 ; care was related to ao/ir/swa/sc/mst/hnc/cv/shad
IF IBCLSF[1
QUIT
+9 ; set softlink
SET IBSL="409.68:"_IBOEN
+10 ;
+11 ; - ready to bill another encounter
+12 DO BLD^IBAMTS1
SET IBBILLED=1
+13 QUIT
+14 ;
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 ;;BILLED AT HIGHER TIER RATE
+7 ;
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 NEW IBSL,Y
+7 IF '$GET(IBOE)!'$GET(IBEVT)!'$GET(IBN)
GOTO LINKQ
+8 SET IBSL=$PIECE($GET(^IB(IBN,0)),"^",4)
+9 IF +IBSL=44
SET Y=$PIECE(IBSL,";",1,2)=("44:"_$PIECE(IBEVT,"^",4)_";S:"_+IBEVT)
GOTO LINKQ
+10 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/swa] cancel charge, create deferred charge
+5 ; 4 -- [ec/swa] 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,3,4,5,6,7,8
IF '$PIECE(IBCLSF("BEFORE"),U,I)
IF $PIECE(IBCLSF("AFTER"),U,I)
SET Y=$SELECT(I=4:3,1:1)
GOTO CLUPDQ
+9 FOR I=1,2,3,4,5,6,7,8
IF $PIECE(IBCLSF("BEFORE"),U,I)
IF '$PIECE(IBCLSF("AFTER"),U,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^swa^mst^hnc^cv^shad, 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,U,+CLD)=+$PIECE(CLD,U,3)
+7 QUIT Y
