- IBECEA31 ;ALB/CPM - Cancel/Edit/Add... Handle Events ; 02-APR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;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 -- 1 - NHCU charge, 0 - Hospital charge
- ; 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=$S($G(IBNH):"NHCU",1:"HOSPITAL")
- 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 D EVS G EVFQ
- EVFQ Q Y
- ;
- EVS ; Set the output variable Y for the most recent (applicable) event.
- S DIS=$$DIS(IBND)
- S Y=$S(IBXA=3&(IBTO>DIS):-1,IBXA=2&(IBTO'<DIS):-1,1:IBN)_"^"_-EVD_"^"_DIS
- Q
- ;
- DIS(X) ; Find the discharge date for an admission.
- ; Input: X -- Zeroth node of an entry in #350
- ; Output: Discharge date (if discharged), or 9999999 (still admitted)
- N DIS
- S DIS=+$G(^DGPM(+$P($G(^DGPM(+$P($P($G(X),"^",4),":",2),0)),"^",17),0))
- 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
- 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
- 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
- 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
- IBECEA31 ;ALB/CPM - Cancel/Edit/Add... Handle Events ; 02-APR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +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 -- 1 - NHCU charge, 0 - Hospital charge
- +5 ; Output: >1 -- ien of event ^ admission date ^ discharge date
- +6 ; 0 -- an event is not found
- +7 ; -1 -- an event is found, but can't be billed
- +8 IF '$GET(DFN)!'$GET(IBFR)!'$GET(IBTO)
- QUIT 0
- +9 SET IBNH=$SELECT($GET(IBNH):"NHCU",1:"HOSPITAL")
- +10 NEW DIS,EVD,IBN,Y
- SET EVD=""
- SET (IBN,Y)=0
- +11 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
- DO EVS
- GOTO EVFQ
- EVFQ QUIT Y
- +1 ;
- EVS ; Set the output variable Y for the most recent (applicable) event.
- +1 SET DIS=$$DIS(IBND)
- +2 SET Y=$SELECT(IBXA=3&(IBTO>DIS):-1,IBXA=2&(IBTO'<DIS):-1,1:IBN)_"^"_-EVD_"^"_DIS
- +3 QUIT
- +4 ;
- DIS(X) ; Find the discharge date for an admission.
- +1 ; Input: X -- Zeroth node of an entry in #350
- +2 ; Output: Discharge date (if discharged), or 9999999 (still admitted)
- +3 NEW DIS
- +4 SET DIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$PIECE($PIECE($GET(X),"^",4),":",2),0)),"^",17),0))
- +5 QUIT $SELECT(DIS:DIS\1,1:9999999)
- +6 ;
- 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 SET IBDIS=+$GET(^DGPM(+$PIECE(ARR(+X),"^",3),0))\1
- IF 'IBDIS
- SET IBDIS=DT
- +4 IF IBFR'<$PIECE(ARR(+X),"^",2)
- IF IBTO'>IBDIS
- SET SEL=ARR(+X)
- GOTO ASKADQ
- +5 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 WRITE !,"You may link this charge to one of the patient's admissions..."
- +4 SET IBDG=$$ADSEL(DFN)
- +5 IF 'IBDG
- WRITE !!,"This patient has no admissions -- this charge cannot be added."
- SET IBY=-1
- QUIT
- +6 IF IBDG=-1
- WRITE !!,"No admission selected -- transaction cannot be completed."
- SET IBY=-1
- QUIT
- +7 WRITE !!,"I will need to build an event record in Integrated Billing for this charge."
- +8 ;
- +9 ; - check for special inpatient billing case
- +10 DO SPEC^IBECEA32(1,$ORDER(^IBE(351.2,"AC",+IBDG,0)))
- +11 ;
- +12 ; - build softlink and set event date
- +13 SET IBSL="405:"_+IBDG
- SET IBEVDT=$PIECE(IBDG,"^",2)
- +14 QUIT
- +15 ;
- UNAB WRITE "Unable to link this charge to an event in Integrated Billing!"
- +1 QUIT