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