source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECEA31.m@ 1036

Last change on this file since 1036 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1IBECEA31 ;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 ;
5EVF(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
18EVFQ Q Y
19 ;
20EVS ; 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 ;
25DIS(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 ;
33ADSEL(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
44ADSELQ Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL)
45 ;
46DISEL ; 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 ;
52ASKAD ; 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
59ASKADQ K IBDIS
60 Q
61 ;
62ADEV ; 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 ;
72NOEV ; 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 ;
89UNAB W "Unable to link this charge to an event in Integrated Billing!"
90 Q
Note: See TracBrowser for help on using the repository browser.