Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAMTS2

IBAMTS2.m

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