IBAMTS2 ;ALB/CPM - PROCESS UPDATED OUTPATIENT ENCOUNTERS ; 25-AUG-93
;;2.0;INTEGRATED BILLING;**52,91,117,132,153,156,167,247,339,795**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
UPD ; Perform encounter update actions.
N IBBIL,IBCBK,IBFILTER,IBVAL ; IB*2.0*795
;
; - was check out deleted?
I IBAST'=2,IBBST=2 S IBCRES=$S(IBAST=8:5,1:1)
;
I IBAST=2,IBBST=2 D ; IB*2.0*795
.S IBACT=$S($$GETSA^IBAMTS1(IBOE)[1:1,1:2) ; 1 - charge needs to be cancelled, 2 - appt needs to be billed
.S IBBIL=0 ; is there a billed charge for this OE?
.I $$LINK(IBOE,$S(IBEVT:IBEVT,1:IBEV0),IBBILLED),"^BILLED^HOLD - RATE^HOLD - REVIEW^INCOMPLETE^ON HOLD^"[(U_$$GET1^DIQ(350,IBBILLED,.05)_U) S IBBIL=1
.I IBACT=1,IBBIL S IBCRES=2 Q ; there's a charge to be cancelled
.I IBACT=2,'IBBIL N IBCLSF D NEW^IBAMTS1
.Q
;
; - 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=$$GETSA^IBAMTS1(IBOEN) I IBCLSF[1 Q ; care was related to ao/ir/swa/sc/mst/hnc/cv/shad IB*2.0*795
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)
;
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 3720 printed Mar 25, 2026@15:31:28 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,795**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
UPD ; Perform encounter update actions.
+1 ; IB*2.0*795
NEW IBBIL,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 ; IB*2.0*795
IF IBAST=2
IF IBBST=2
Begin DoDot:1
+7 ; 1 - charge needs to be cancelled, 2 - appt needs to be billed
SET IBACT=$SELECT($$GETSA^IBAMTS1(IBOE)[1:1,1:2)
+8 ; is there a billed charge for this OE?
SET IBBIL=0
+9 IF $$LINK(IBOE,$SELECT(IBEVT:IBEVT,1:IBEV0),IBBILLED)
IF "^BILLED^HOLD - RATE^HOLD - REVIEW^INCOMPLETE^ON HOLD^"[(U_$$GET1^DIQ(350,IBBILLED,.05)_U)
SET IBBIL=1
+10 ; there's a charge to be cancelled
IF IBACT=1
IF IBBIL
SET IBCRES=2
QUIT
+11 IF IBACT=2
IF 'IBBIL
NEW IBCLSF
DO NEW^IBAMTS1
+12 QUIT
End DoDot:1
+13 ;
+14 ; - cancel charge if there is a cancellation reason, and the billed
+15 ; - charge was for the appointment that is no longer billable
+16 IF '$GET(IBCRES)
GOTO UPDQ
+17 IF '$$LINK(IBOE,$SELECT(IBEVT:IBEVT,1:IBEV0),IBBILLED)
GOTO UPDQ
+18 DO CANC
if IBY<0
GOTO UPDQ
+19 ;
+20 ; - look for other billable visits if Means Test billable
+21 IF '$$BIL^DGMTUB(DFN,IBDT)
GOTO UPDQ
+22 SET IBBILLED=0
+23 ;
+24 SET IBVAL("DFN")=DFN
SET IBVAL("BDT")=IBDAT-.1
SET IBVAL("EDT")=IBDAT_.99
+25 SET IBFILTER=""
+26 ; Skip encounter just cancelled,
+27 ; consider only parent encounters, appts checked out
+28 SET IBCBK="I Y'=IBOE,'$P(Y0,U,6),$P(Y0,U,12)=2 D BEDIT^IBAMTS2(Y,Y0) S:IBBILLED SDSTOP=1"
+29 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
KILL ^TMP("DIERR",$JOB)
+30 ;
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 ; care was related to ao/ir/swa/sc/mst/hnc/cv/shad IB*2.0*795
SET IBCLSF=$$GETSA^IBAMTS1(IBOEN)
IF IBCLSF[1
QUIT
+8 ; set softlink
SET IBSL="409.68:"_IBOEN
+9 ;
+10 ; - ready to bill another encounter
+11 DO BLD^IBAMTS1
SET IBBILLED=1
+12 QUIT
+13 ;
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 ;
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
