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

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1IBECEA34 ;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 ;
5NOEVT ; 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
14NOEVTQ Q
15 ;
16 ;
17ADSEL(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
28ADSELQ Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL)
29 ;
30DISEL ; 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 ;
36ASKAD ; 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
42ASKADQ K IBDIS
43 Q
44 ;
45 ;
46ADEV ; 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 ;
55MED ; 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
62MEDQ Q
63 ;
64HMED ; 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
Note: See TracBrowser for help on using the repository browser.