| [613] | 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 | 
|---|