| 1 | IBECEA31 ;ALB/CPM-Cancel/Edit/Add... Handle Events ; 02-APR-93 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**27,57,52,176,188**;21-MAR-94 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | EVF(DFN,IBFR,IBTO,IBNH) ; Find the matching event for a copay or per diem. | 
|---|
| 6 | ;  Input:    DFN   --   Pointer to the patient in file #2 | 
|---|
| 7 | ;           IBFR   --   Charge 'Bill From' date | 
|---|
| 8 | ;           IBTO   --   Charge 'Bill To' date | 
|---|
| 9 | ;           IBNH   --   2 - Fee, 1 - NHCU charge, 0 - Hospital charge | 
|---|
| 10 | ;                       3 - LTC | 
|---|
| 11 | ;  Output:    >1   --   ien of event ^ admission date ^ discharge date | 
|---|
| 12 | ;              0   --   an event is not found | 
|---|
| 13 | ;             -1   --   an event is found, but can't be billed | 
|---|
| 14 | I '$G(DFN)!'$G(IBFR)!'$G(IBTO) Q 0 | 
|---|
| 15 | S IBNH=$G(IBNH),IBNH=$S(IBNH=2:"FEE",IBNH=3:"LTC A",IBNH:"NHCU",1:"HOSPITAL") | 
|---|
| 16 | N DIS,EVD,IBN,Y S EVD="",(IBN,Y)=0 | 
|---|
| 17 | 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 | 
|---|
| 18 | EVFQ Q Y | 
|---|
| 19 | ; | 
|---|
| 20 | EVS ; Set the output variable Y for the most recent (applicable) event. | 
|---|
| 21 | S DIS=$$DIS($P(IBND,"^",4)) | 
|---|
| 22 | S Y=$S(IBXA=3&(IBTO>DIS):-1,(IBXA=2!(IBXA=1))&(IBTO'<DIS):-1,1:IBN)_"^"_-EVD_"^"_DIS | 
|---|
| 23 | Q | 
|---|
| 24 | ; | 
|---|
| 25 | DIS(X) ; Find the discharge date for an admission. | 
|---|
| 26 | ;  Input:   X  --  Softlink from an entry in #350 | 
|---|
| 27 | ;  Output:  Discharge date (if discharged), or 9999999 (still admitted) | 
|---|
| 28 | N DIS | 
|---|
| 29 | I +X=405 S DIS=+$G(^DGPM(+$P($G(^DGPM(+$P(X,":",2),0)),"^",17),0)) | 
|---|
| 30 | I +X=45 S DIS=+$G(^DGPT(+$P(X,":",2),70)) | 
|---|
| 31 | Q $S(DIS:DIS\1,1:9999999) | 
|---|
| 32 | ; | 
|---|
| 33 | ADSEL(DFN) ; Select an admission to use to build an event. | 
|---|
| 34 | ;  Input:  DFN  --  Pointer to the patient in file #2 | 
|---|
| 35 | ;  Output:    >1   --   ien of pt movement (in file #405) to link event | 
|---|
| 36 | ;              0   --   no admissions for the patient, or | 
|---|
| 37 | ;             -1   --   user decided to quit. | 
|---|
| 38 | I '$D(^DGPM("ATID1",+$G(DFN))) Q 0 | 
|---|
| 39 | N ARR,DG,IBD,IBQ,J,SEL,X S IBQ=0,IBD="" | 
|---|
| 40 | 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 | 
|---|
| 41 | I '$D(ARR) G ADSELQ | 
|---|
| 42 | I '((J-1)#5) W !!?3,"End of list.",! | 
|---|
| 43 | S J=J-1 D ASKAD | 
|---|
| 44 | ADSELQ Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL) | 
|---|
| 45 | ; | 
|---|
| 46 | DISEL ; Display admission data. | 
|---|
| 47 | N DGPM S DGPM=$G(^DGPM(DG,0)) | 
|---|
| 48 | W ?7,$$DAT2^IBOUTL(+DGPM),?28,"to:  ",$E($P($G(^DIC(42,+$P(DGPM,"^",6),0)),"^"),1,18) | 
|---|
| 49 | I $P(DGPM,"^",17) W ?52,"(Discharged: ",$$DAT2^IBOUTL(+$G(^DGPM(+$P(DGPM,"^",17),0))\1),")" | 
|---|
| 50 | Q | 
|---|
| 51 | ; | 
|---|
| 52 | ASKAD ; Prompt the user to select an admission. | 
|---|
| 53 | W !," Select 1-",J," or type '^' to quit: " R X:DTIME S:'$T!(X["^") IBQ=1 I IBQ!(X="") G ASKADQ | 
|---|
| 54 | I '$D(ARR(+X)) W !!?3,*7,"Enter a NUMBER from 1-",J,".",! G ASKAD | 
|---|
| 55 | I IBXA=6!(IBXA=7) S SEL=ARR(+X) G ASKADQ | 
|---|
| 56 | S IBDIS=+$G(^DGPM(+$P(ARR(+X),"^",3),0))\1 S:'IBDIS IBDIS=DT | 
|---|
| 57 | I IBFR'<$P(ARR(+X),"^",2),IBTO'>IBDIS S SEL=ARR(+X) G ASKADQ | 
|---|
| 58 | W !!?3,*7,"The bill dates fall outside the admissions dates!",! G ASKAD | 
|---|
| 59 | ASKADQ K IBDIS | 
|---|
| 60 | Q | 
|---|
| 61 | ; | 
|---|
| 62 | ADEV ; Add a new event entry in file #350. | 
|---|
| 63 | W !!,"I have to build the event record first...  " | 
|---|
| 64 | N DIE,DR,DA,IBLAST | 
|---|
| 65 | D EVADD^IBAUTL3 K IBN,IBEVDT Q:IBY<0  W "done." | 
|---|
| 66 | S IBLAST=$S(IBXA=2:IBTO,IBFR=IBTO:IBTO,1:$$FMADD^XLFDT(IBTO,-1)) | 
|---|
| 67 | W !,"Updating the Date Last Calculated to ",$$DAT1^IBOUTL(IBLAST),"...  " | 
|---|
| 68 | S DIE="^IB(",DA=IBEVDA,DR=".18////"_IBLAST D ^DIE W "done." | 
|---|
| 69 | 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." | 
|---|
| 70 | Q | 
|---|
| 71 | ; | 
|---|
| 72 | NOEV ; No event in Integrated Billing - ask user to select an admission | 
|---|
| 73 | 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)),"." | 
|---|
| 74 | D:'IBEVDA UNAB | 
|---|
| 75 | I IBNH=2 D NOEVT^IBECEA34 Q | 
|---|
| 76 | W !,"You may link this charge to one of the patient's admissions..." | 
|---|
| 77 | S IBDG=$$ADSEL(DFN) | 
|---|
| 78 | I 'IBDG W !!,"This patient has no admissions -- this charge cannot be added." S IBY=-1 Q | 
|---|
| 79 | I IBDG=-1 W !!,"No admission selected -- transaction cannot be completed." S IBY=-1 Q | 
|---|
| 80 | W !!,"I will need to build an event record in Integrated Billing for this charge." | 
|---|
| 81 | ; | 
|---|
| 82 | ; - check for special inpatient billing case | 
|---|
| 83 | I IBXA'=9 D SPEC^IBECEA32(1,$O(^IBE(351.2,"AC",+IBDG,0))) | 
|---|
| 84 | ; | 
|---|
| 85 | ; - build softlink and set event date | 
|---|
| 86 | S IBSL="405:"_+IBDG,IBEVDT=$P(IBDG,"^",2) | 
|---|
| 87 | Q | 
|---|
| 88 | ; | 
|---|
| 89 | UNAB W "Unable to link this charge to an event in Integrated Billing!" | 
|---|
| 90 | Q | 
|---|