IBECEA31 ;ALB/CPM - Cancel/Edit/Add... Handle Events ; 02-APR-93
;;2.0;INTEGRATED BILLING;**27,57,52,176,188,715**;21-MAR-94;Build 25
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EVF(DFN,IBFR,IBTO,IBNH) ; Find the matching event for a copay or per diem.
; Input: DFN -- Pointer to the patient in file #2
; IBFR -- Charge 'Bill From' date
; IBTO -- Charge 'Bill To' date
; IBNH -- 2 - Fee, 1 - NHCU charge, 0 - Hospital charge
; 3 - LTC
; Output: >1 -- ien of event ^ admission date ^ discharge date
; 0 -- an event is not found
; -1 -- an event is found, but can't be billed
I '$G(DFN)!'$G(IBFR)!'$G(IBTO) Q 0
S IBNH=$G(IBNH),IBNH=$S((IBNH=0&(IBXA=7)):"TRICARE INPT",IBNH=2:"FEE",IBNH=3:"LTC A",IBNH:"NHCU",1:"HOSPITAL") ; IB*2.0*715
N DIS,EVD,IBN,Y S EVD="",(IBN,Y)=0
F S EVD=$O(^IB("AFDT",DFN,EVD)) Q:'EVD I -EVD'>IBFR F S IBN=$O(^IB("AFDT",DFN,EVD,IBN)) Q:'IBN S IBND=$G(^IB(IBN,0)) I $P(IBND,"^",8)[IBNH,$P(IBND,"^",8)'["FEE OPT",$P(IBND,"^",8)'["FEE LTC OPT" D EVS G EVFQ
EVFQ Q Y
;
EVS ; Set the output variable Y for the most recent (applicable) event.
S DIS=$$DIS($P(IBND,"^",4))
S Y=$S(IBXA=3&(IBTO>DIS):-1,(IBXA=2!(IBXA=1)!($G(IBNH)="TRICARE INPT"))&(IBTO'<DIS):-1,1:IBN)_"^"_-EVD_"^"_DIS ; IB*2.0*715
Q
;
DIS(X) ; Find the discharge date for an admission.
; Input: X -- Softlink from an entry in #350
; Output: Discharge date (if discharged), or 9999999 (still admitted)
N DIS
I +X=405 S DIS=+$G(^DGPM(+$P($G(^DGPM(+$P(X,":",2),0)),"^",17),0))
I +X=45 S DIS=+$G(^DGPT(+$P(X,":",2),70))
Q $S(DIS:DIS\1,1:9999999)
;
ADSEL(DFN) ; Select an admission to use to build an event.
; Input: DFN -- Pointer to the patient in file #2
; Output: >1 -- ien of pt movement (in file #405) to link event
; 0 -- no admissions for the patient, or
; -1 -- user decided to quit.
I '$D(^DGPM("ATID1",+$G(DFN))) Q 0
N ARR,DG,IBD,IBQ,J,SEL,X S IBQ=0,IBD=""
F J=1:1 S IBD=$O(^DGPM("ATID1",DFN,IBD)) Q:'IBD S DG=+$O(^(IBD,0)) I $D(^DGPM(DG,0)) W:J=1 !!," Please select one of the following admissions:" S ARR(J)=DG_"^"_(+^(0)\1)_"^"_+$P(^(0),"^",17) W !?3,J D DISEL,ASKAD:'(J#5) G:IBQ!($D(SEL)) ADSELQ
I '$D(ARR) G ADSELQ
I '((J-1)#5) W !!?3,"End of list.",!
S J=J-1 D ASKAD
ADSELQ Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL)
;
DISEL ; Display admission data.
N DGPM S DGPM=$G(^DGPM(DG,0))
W ?7,$$DAT2^IBOUTL(+DGPM),?28,"to: ",$E($P($G(^DIC(42,+$P(DGPM,"^",6),0)),"^"),1,18)
I $P(DGPM,"^",17) W ?52,"(Discharged: ",$$DAT2^IBOUTL(+$G(^DGPM(+$P(DGPM,"^",17),0))\1),")"
Q
;
ASKAD ; Prompt the user to select an admission.
W !," Select 1-",J," or type '^' to quit: " R X:DTIME S:'$T!(X["^") IBQ=1 I IBQ!(X="") G ASKADQ
I '$D(ARR(+X)) W !!?3,*7,"Enter a NUMBER from 1-",J,".",! G ASKAD
I IBXA=6!(IBXA=7) S SEL=ARR(+X) G ASKADQ
S IBDIS=+$G(^DGPM(+$P(ARR(+X),"^",3),0))\1 S:'IBDIS IBDIS=DT
I IBFR'<$P(ARR(+X),"^",2),IBTO'>IBDIS S SEL=ARR(+X) G ASKADQ
W !!?3,*7,"The bill dates fall outside the admissions dates!",! G ASKAD
ASKADQ K IBDIS
Q
;
ADEV ; Add a new event entry in file #350.
W !!,"I have to build the event record first... "
N DIE,DR,DA,IBLAST
D EVADD^IBAUTL3 K IBN,IBEVDT Q:IBY<0 W "done."
S IBLAST=$S(IBXA=2:IBTO,IBFR=IBTO:IBTO,1:$$FMADD^XLFDT(IBTO,-1))
W !,"Updating the Date Last Calculated to ",$$DAT1^IBOUTL(IBLAST),"... "
S DIE="^IB(",DA=IBEVDA,DR=".18////"_IBLAST D ^DIE W "done."
I $P(IBDG,"^",3) W !,"Since the patient has been discharged, let me 'close' the IB event... " S DIE="^IB(",DA=IBEVDA,DR=".05////2" D ^DIE W "done."
Q
;
NOEV ; No event in Integrated Billing - ask user to select an admission
W !! I IBEVDA<0 D UNAB W !,"Tried to link the charge to an admission on ",$$DAT1^IBOUTL($P(IBEVDA,"^",2)),", but the Bill To date",!,"(",$$DAT1^IBOUTL(IBTO),") exceeds the discharge date of ",$$DAT1^IBOUTL($P(IBEVDA,"^",3)),"."
D:'IBEVDA UNAB
I IBNH=2 D NOEVT^IBECEA34 Q
W !,"You may link this charge to one of the patient's admissions..."
S IBDG=$$ADSEL(DFN)
I 'IBDG W !!,"This patient has no admissions -- this charge cannot be added." S IBY=-1 Q
I IBDG=-1 W !!,"No admission selected -- transaction cannot be completed." S IBY=-1 Q
W !!,"I will need to build an event record in Integrated Billing for this charge."
;
; - check for special inpatient billing case
I IBXA'=9 D SPEC^IBECEA32(1,$O(^IBE(351.2,"AC",+IBDG,0)))
;
; - build softlink and set event date
S IBSL="405:"_+IBDG,IBEVDT=$P(IBDG,"^",2)
Q
;
UNAB W "Unable to link this charge to an event in Integrated Billing!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA31 4746 printed Dec 13, 2024@02:21:17 Page 2
IBECEA31 ;ALB/CPM - Cancel/Edit/Add... Handle Events ; 02-APR-93
+1 ;;2.0;INTEGRATED BILLING;**27,57,52,176,188,715**;21-MAR-94;Build 25
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EVF(DFN,IBFR,IBTO,IBNH) ; Find the matching event for a copay or per diem.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; IBFR -- Charge 'Bill From' date
+3 ; IBTO -- Charge 'Bill To' date
+4 ; IBNH -- 2 - Fee, 1 - NHCU charge, 0 - Hospital charge
+5 ; 3 - LTC
+6 ; Output: >1 -- ien of event ^ admission date ^ discharge date
+7 ; 0 -- an event is not found
+8 ; -1 -- an event is found, but can't be billed
+9 IF '$GET(DFN)!'$GET(IBFR)!'$GET(IBTO)
QUIT 0
+10 ; IB*2.0*715
SET IBNH=$GET(IBNH)
SET IBNH=$SELECT((IBNH=0&(IBXA=7)):"TRICARE INPT",IBNH=2:"FEE",IBNH=3:"LTC A",IBNH:"NHCU",1:"HOSPITAL")
+11 NEW DIS,EVD,IBN,Y
SET EVD=""
SET (IBN,Y)=0
+12 FOR
SET EVD=$ORDER(^IB("AFDT",DFN,EVD))
if 'EVD
QUIT
IF -EVD'>IBFR
FOR
SET IBN=$ORDER(^IB("AFDT",DFN,EVD,IBN))
if 'IBN
QUIT
SET IBND=$GET(^IB(IBN,0))
IF $PIECE(IBND,"^",8)[IBNH
IF $PIECE(IBND,"^",8)'["FEE OPT"
IF $PIECE(IBND,"^",8)'["FEE LTC OPT"
DO EVS
GOTO EVFQ
EVFQ QUIT Y
+1 ;
EVS ; Set the output variable Y for the most recent (applicable) event.
+1 SET DIS=$$DIS($PIECE(IBND,"^",4))
+2 ; IB*2.0*715
SET Y=$SELECT(IBXA=3&(IBTO>DIS):-1,(IBXA=2!(IBXA=1)!($GET(IBNH)="TRICARE INPT"))&(IBTO'<DIS):-1,1:IBN)_"^"_-EVD_"^"_DIS
+3 QUIT
+4 ;
DIS(X) ; Find the discharge date for an admission.
+1 ; Input: X -- Softlink from an entry in #350
+2 ; Output: Discharge date (if discharged), or 9999999 (still admitted)
+3 NEW DIS
+4 IF +X=405
SET DIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$PIECE(X,":",2),0)),"^",17),0))
+5 IF +X=45
SET DIS=+$GET(^DGPT(+$PIECE(X,":",2),70))
+6 QUIT $SELECT(DIS:DIS\1,1:9999999)
+7 ;
ADSEL(DFN) ; Select an admission to use to build an event.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: >1 -- ien of pt movement (in file #405) to link event
+3 ; 0 -- no admissions for the patient, or
+4 ; -1 -- user decided to quit.
+5 IF '$DATA(^DGPM("ATID1",+$GET(DFN)))
QUIT 0
+6 NEW ARR,DG,IBD,IBQ,J,SEL,X
SET IBQ=0
SET IBD=""
+7 FOR J=1:1
SET IBD=$ORDER(^DGPM("ATID1",DFN,IBD))
if 'IBD
QUIT
SET DG=+$ORDER(^(IBD,0))
IF $DATA(^DGPM(DG,0))
if J=1
WRITE !!," Please select one of the following admissions:"
SET ARR(J)=DG_"^"_(+^(0)\1)_"^"_+$PIECE(^(0),"^",17)
WRITE !?3,J
DO DISEL
if '(J#5)
DO ASKAD
if IBQ!($DATA(SEL))
GOTO ADSELQ
+8 IF '$DATA(ARR)
GOTO ADSELQ
+9 IF '((J-1)#5)
WRITE !!?3,"End of list.",!
+10 SET J=J-1
DO ASKAD
ADSELQ QUIT $SELECT('$DATA(ARR):0,IBQ!'$DATA(SEL):-1,1:SEL)
+1 ;
DISEL ; Display admission data.
+1 NEW DGPM
SET DGPM=$GET(^DGPM(DG,0))
+2 WRITE ?7,$$DAT2^IBOUTL(+DGPM),?28,"to: ",$EXTRACT($PIECE($GET(^DIC(42,+$PIECE(DGPM,"^",6),0)),"^"),1,18)
+3 IF $PIECE(DGPM,"^",17)
WRITE ?52,"(Discharged: ",$$DAT2^IBOUTL(+$GET(^DGPM(+$PIECE(DGPM,"^",17),0))\1),")"
+4 QUIT
+5 ;
ASKAD ; Prompt the user to select an admission.
+1 WRITE !," Select 1-",J," or type '^' to quit: "
READ X:DTIME
if '$TEST!(X["^")
SET IBQ=1
IF IBQ!(X="")
GOTO ASKADQ
+2 IF '$DATA(ARR(+X))
WRITE !!?3,*7,"Enter a NUMBER from 1-",J,".",!
GOTO ASKAD
+3 IF IBXA=6!(IBXA=7)
SET SEL=ARR(+X)
GOTO ASKADQ
+4 SET IBDIS=+$GET(^DGPM(+$PIECE(ARR(+X),"^",3),0))\1
if 'IBDIS
SET IBDIS=DT
+5 IF IBFR'<$PIECE(ARR(+X),"^",2)
IF IBTO'>IBDIS
SET SEL=ARR(+X)
GOTO ASKADQ
+6 WRITE !!?3,*7,"The bill dates fall outside the admissions dates!",!
GOTO ASKAD
ASKADQ KILL IBDIS
+1 QUIT
+2 ;
ADEV ; Add a new event entry in file #350.
+1 WRITE !!,"I have to build the event record first... "
+2 NEW DIE,DR,DA,IBLAST
+3 DO EVADD^IBAUTL3
KILL IBN,IBEVDT
if IBY<0
QUIT
WRITE "done."
+4 SET IBLAST=$SELECT(IBXA=2:IBTO,IBFR=IBTO:IBTO,1:$$FMADD^XLFDT(IBTO,-1))
+5 WRITE !,"Updating the Date Last Calculated to ",$$DAT1^IBOUTL(IBLAST),"... "
+6 SET DIE="^IB("
SET DA=IBEVDA
SET DR=".18////"_IBLAST
DO ^DIE
WRITE "done."
+7 IF $PIECE(IBDG,"^",3)
WRITE !,"Since the patient has been discharged, let me 'close' the IB event... "
SET DIE="^IB("
SET DA=IBEVDA
SET DR=".05////2"
DO ^DIE
WRITE "done."
+8 QUIT
+9 ;
NOEV ; No event in Integrated Billing - ask user to select an admission
+1 WRITE !!
IF IBEVDA<0
DO UNAB
WRITE !,"Tried to link the charge to an admission on ",$$DAT1^IBOUTL($PIECE(IBEVDA,"^",2)),", but the Bill To date",!,"(",$$DAT1^IBOUTL(IBTO),") exceeds the discharge date of ",$$DAT1^IBOUTL($PIECE(IBEVDA,"^",3)),"."
+2 if 'IBEVDA
DO UNAB
+3 IF IBNH=2
DO NOEVT^IBECEA34
QUIT
+4 WRITE !,"You may link this charge to one of the patient's admissions..."
+5 SET IBDG=$$ADSEL(DFN)
+6 IF 'IBDG
WRITE !!,"This patient has no admissions -- this charge cannot be added."
SET IBY=-1
QUIT
+7 IF IBDG=-1
WRITE !!,"No admission selected -- transaction cannot be completed."
SET IBY=-1
QUIT
+8 WRITE !!,"I will need to build an event record in Integrated Billing for this charge."
+9 ;
+10 ; - check for special inpatient billing case
+11 IF IBXA'=9
DO SPEC^IBECEA32(1,$ORDER(^IBE(351.2,"AC",+IBDG,0)))
+12 ;
+13 ; - build softlink and set event date
+14 SET IBSL="405:"_+IBDG
SET IBEVDT=$PIECE(IBDG,"^",2)
+15 QUIT
+16 ;
UNAB WRITE "Unable to link this charge to an event in Integrated Billing!"
+1 QUIT
