1 | IBECEA34 ;ALB/CPM - Cancel/Edit/Add... Fee Support ; 12-FEB-96
|
---|
2 | ;;Version 2.0 ; INTEGRATED BILLING ;**57**; 21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | NOEVT ; No event in Integrated Billing - ask user to select a fee ptf
|
---|
6 | W !,"You may link this charge to one of the patient's Fee PTF entries..."
|
---|
7 | S IBDG=$$ADSEL(DFN)
|
---|
8 | I 'IBDG W !!,"This patient has no Fee PTF entries -- this charge cannot be added." S IBY=-1 G NOEVTQ
|
---|
9 | I IBDG=-1 W !!,"No Fee PTF entry selected -- transaction cannot be completed." S IBY=-1 G NOEVTQ
|
---|
10 | W !!,"I will need to build an event record in Integrated Billing for this charge."
|
---|
11 | ;
|
---|
12 | ; - build softlink and set event date
|
---|
13 | S IBSL="45:"_+IBDG,IBEVDT=$P(IBDG,"^",2),IBFEEV=1
|
---|
14 | NOEVTQ Q
|
---|
15 | ;
|
---|
16 | ;
|
---|
17 | ADSEL(DFN) ; Select a Fee PTF as an admission to use to build an event.
|
---|
18 | ; Input: DFN -- Pointer to the patient in file #2
|
---|
19 | ; Output: >1 -- ien of ptf entry (in file #45) to link event
|
---|
20 | ; 0 -- no feee ptf entries for the patient, or
|
---|
21 | ; -1 -- user decided to quit.
|
---|
22 | I '$D(^DGPT("AFEE",+$G(DFN))) Q 0
|
---|
23 | N ARR,PTF,IBD,IBQ,J,SEL,X S IBQ=0,IBD=""
|
---|
24 | F J=1:1 S IBD=$O(^DGPT("AFEE",DFN,IBD)) Q:'IBD S PTF=+$O(^(IBD,0)) I $D(^DGPT(PTF,0)) W:J=1 !!," Please select one of the following admissions:" S ARR(J)=PTF_"^"_(IBD\1) W !?3,J D DISEL,ASKAD:'(J#5) G:IBQ!($D(SEL)) ADSELQ
|
---|
25 | I '$D(ARR) G ADSELQ
|
---|
26 | I '((J-1)#5) W !!?3,"End of list.",!
|
---|
27 | S J=J-1 D ASKAD
|
---|
28 | ADSELQ Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL)
|
---|
29 | ;
|
---|
30 | DISEL ; Display admission data.
|
---|
31 | N DGPT S DGPT=$G(^DGPT(PTF,0))
|
---|
32 | W ?7,$$DAT2^IBOUTL($P(DGPT,"^",2))
|
---|
33 | I $G(^DGPT(PTF,70)) W ?32,"(Discharged: ",$$DAT2^IBOUTL(+^(70)),")"
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | ASKAD ; Prompt the user to select an admission.
|
---|
37 | W !," Select 1-",J," or type '^' to quit: " R X:DTIME S:'$T!(X["^") IBQ=1 I IBQ!(X="") G ASKADQ
|
---|
38 | I '$D(ARR(+X)) W !!?3,*7,"Enter a NUMBER from 1-",J,".",! G ASKAD
|
---|
39 | S IBDIS=+$G(^DGPT(+ARR(+X),70))\1 S:'IBDIS IBDIS=DT
|
---|
40 | I IBFR'<$P(ARR(+X),"^",2),IBTO'>IBDIS S SEL=ARR(+X) G ASKADQ
|
---|
41 | W !!?3,*7,"The bill dates fall outside the admissions dates!",! G ASKAD
|
---|
42 | ASKADQ K IBDIS
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | ;
|
---|
46 | ADEV ; Add a new event entry for the Fee PTF in file #350.
|
---|
47 | W !!,"Building the Fee PTF event record... "
|
---|
48 | N DIE,DR,DA
|
---|
49 | D EVADD^IBAUTL3 K IBN,IBEVDT Q:IBY<0 W "done."
|
---|
50 | S DIE="^IB(",DA=IBEVDA,DR=".05////2" D ^DIE
|
---|
51 | S $P(^IB(IBEVDA,0),"^",8)="FEE ADMISSION"
|
---|
52 | Q
|
---|
53 | ;
|
---|
54 | ;
|
---|
55 | MED ; Is the Fee Charge for a CNH or Contract Hospital Admission?
|
---|
56 | R !," Is this a C(N)H or Contract (H)ospital Admission? CNH// ",X:DTIME
|
---|
57 | I '$T!(X["^") S IBY=-1 G MEDQ
|
---|
58 | S:X="" X="N" S X=$E(X)
|
---|
59 | I "NHnh"'[X D HMED G MED
|
---|
60 | W $S("nN"[X:" CNH",1:" CONTRACT HOSPITAL")
|
---|
61 | S IBADJMED=1 I "Hh"[X S IBADJMED=2,IBMED=IBMED/2
|
---|
62 | MEDQ Q
|
---|
63 | ;
|
---|
64 | HMED ; Help for the 'C(N)H or Contract (H)ospital' prompt
|
---|
65 | W !!?6,"Enter: '<CR>' - If the charge is for a CNH Admission"
|
---|
66 | W !?14,"'H' - If the charge is for a Contract Hospital Admission"
|
---|
67 | W !?14,"'^' - To quit this option",!
|
---|
68 | Q
|
---|