| 1 | FBAACO0 ;AISC/GRR-DISPLAY PATIENT ADDRESS DATA AND EDIT ;7/13/2003
|
|---|
| 2 | ;;3.5;FEE BASIS;**4,38,52,57,61,75,70**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S FBMST=$S(FBTT=1:"Y",1:""),FBTTYPE="A",FBFDC=""
|
|---|
| 5 | N FBEDPTAD S (FBEDPTAD(1),FBEDPTAD(2))=0
|
|---|
| 6 | W @IOF,"Patient: ",$P(^DPT(DFN,0),"^") S (Y(0),HY(0))=$G(^DPT(DFN,.11)) I Y(0)="" W !,*7,"No Address information for this patient!" G EDIT
|
|---|
| 7 | S VAPA("P")="" D ADD^VADPT
|
|---|
| 8 | S FBEDPTAD(1)=$$ISCCADR()
|
|---|
| 9 | S FBEDPTAD(2)="N"
|
|---|
| 10 | I $$CCADR(2)
|
|---|
| 11 | W !!,"Patient's Permanent address:"
|
|---|
| 12 | F Z=1:1:3 I VAPA(Z)]"" W !?2,"Address Line ",Z,":",?18,VAPA(Z)
|
|---|
| 13 | W !?2,"City:",?18,VAPA(4),!?2,"State:",?18,$P(VAPA(5),U,2)
|
|---|
| 14 | W !?2,"Zip:",?18,$S(+$G(VAPA(11)):$P(VAPA(11),U,2),1:VAPA(6)),!?2,"County",?18,$P(VAPA(7),U,2)
|
|---|
| 15 | K VAPA,VAERR
|
|---|
| 16 | RD W ! S DIR("A")="Want to edit Permanent Address data",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR S:Y&('$D(DIRUT)) FBEDPTAD(2)="Y" G EDIT
|
|---|
| 17 | Q
|
|---|
| 18 | EDIT I $G(FBEDPTAD(2))'="N" W !! S HY(0)=$G(^DPT(DFN,.11)) D EN^DGREGAED(DFN)
|
|---|
| 19 | I $$EDTCCADR()=0 I FBTT'=1 I FBEDPTAD(2)="N" Q
|
|---|
| 20 | MRA I FBTT=1!($G(^DPT(DFN,.11))'=$G(HY(0))) S FBD1=FTP D ENT^FBAAAUT K FBD1
|
|---|
| 21 | Q
|
|---|
| 22 | FEE ;calculates amount paid based on fee schedule
|
|---|
| 23 | N FB1725
|
|---|
| 24 | ; set FB1725 flag = true if payment for a 38 U.S.C. 1725 claim
|
|---|
| 25 | S FB1725=$S($G(FB583):+$P($G(^FB583(+FB583,0)),U,28),1:0)
|
|---|
| 26 | S FBFY=FY-1
|
|---|
| 27 | S (FBFSAMT,FBFSUSD)="",FBAMTPD=$S($G(FBAMTPD)>0:FBAMTPD,1:"")
|
|---|
| 28 | ; if amount not passed then use fee schedule
|
|---|
| 29 | I '$G(FBAMTPD) D
|
|---|
| 30 | . N FBX
|
|---|
| 31 | . S FBX=$$GET^FBAAFS($$CPT^FBAAUTL4(FBAACP),$$MODL^FBAAUTL4("FBMODA","E"),FBAADT,$G(FBZIP),$$FAC^FBAAFS($G(FBHCFA(30))),$G(FBTIME))
|
|---|
| 32 | . ;
|
|---|
| 33 | . I '$G(FBAAMM1) D
|
|---|
| 34 | . . S FBFSAMT=$P(FBX,U),FBFSUSD=$P(FBX,U,2)
|
|---|
| 35 | . E W !?2,"Payment is for a contracted service so fee schedule does not apply."
|
|---|
| 36 | . ;
|
|---|
| 37 | . I $P($G(FBX),U)]"" D
|
|---|
| 38 | . . W !?2,$S($G(FBAAMM1):"However, f",1:"F")
|
|---|
| 39 | . . W "ee schedule amount is $",$P(FBX,U)," from the "
|
|---|
| 40 | . . W:$P(FBX,U,3)]"" $P(FBX,U,3)," " ; year if returned
|
|---|
| 41 | . . W:$P(FBX,U,2)]"" $$EXTERNAL^DILFD(162.03,45,"",$P(FBX,U,2))
|
|---|
| 42 | . E W !?2,"Unable to determine a FEE schedule amount."
|
|---|
| 43 | . ;
|
|---|
| 44 | . I FB1725 D
|
|---|
| 45 | . . W !!?2,"**Payment is for emergency treatment under 38 U.S.C. 1725."
|
|---|
| 46 | . . I FBFSAMT D
|
|---|
| 47 | . . . S FBFSAMT=$J(FBFSAMT*.7,0,2)
|
|---|
| 48 | . . . W !?2," Therefore, fee schedule amount reduced to $",FBFSAMT," (70%)."
|
|---|
| 49 | . ;
|
|---|
| 50 | . I $G(FBUNITS)>1 D
|
|---|
| 51 | . . W !!?2,"Units Paid = ",FBUNITS
|
|---|
| 52 | . . Q:FBFSAMT'>0
|
|---|
| 53 | . . N FBFSUNIT
|
|---|
| 54 | . . ; determine if fee schedule can be multipled by units
|
|---|
| 55 | . . S FBFSUNIT=$S(FBFSUSD="R":1,FBFSUSD="F"&(FBAADT>3040930):1,1:0)
|
|---|
| 56 | . . I FBFSUNIT D
|
|---|
| 57 | . . . S FBFSAMT=$J(FBFSAMT*FBUNITS,0,2)
|
|---|
| 58 | . . . W !?2," Therefore, fee schedule amount increased to $",FBFSAMT
|
|---|
| 59 | . . E D
|
|---|
| 60 | . . . W !?2," Fee schedule not complied on per unit basis so amount not adjusted for units."
|
|---|
| 61 | . ;
|
|---|
| 62 | . I '$G(FBAAMM1) D
|
|---|
| 63 | . . ; set default amount paid to lesser of amt claimed (J) or fee sched.
|
|---|
| 64 | . . S FBAMTPD=$S(FBFSAMT>J:J,FBFSAMT>0:FBFSAMT,1:"")
|
|---|
| 65 | . ;
|
|---|
| 66 | . W !
|
|---|
| 67 | ;
|
|---|
| 68 | AMTPD W !,"AMOUNT PAID: "_$S(FBAMTPD]"":FBAMTPD_"//",1:"") R X:DTIME S:X="" X=FBAMTPD G KILL:$E(X)="^",HELP1:$E(X)="?" S:X["$" X=$P(X,"$",2) I +X'=X&(X'?.N.1".".2N)!(+X>+J)!(+X<0) G HELPPD
|
|---|
| 69 | I FBAMTPD]"",X>FBAMTPD&('$D(^XUSEC("FBAASUPERVISOR",DUZ))) D G AMTPD
|
|---|
| 70 | .W !!,*7,"You must be a holder of the 'FBAASUPERVISOR' key to",!,"exceed the Fee Schedule. Entering an up-arrow ('^') will",!,"delete the payment or you can accept the default.",!
|
|---|
| 71 | S FBAMTPD=X Q
|
|---|
| 72 | KILL W !!,*7,"Entering an '^' will delete this payment!" R !,?5,"Do you want to delete? No//",X:DTIME S:X="" X="N" D VALCK^FBAAUTL1 G KILL:'VAL,AMTPD:"Nn"[$E(X)
|
|---|
| 73 | S DIK="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1," D WAIT^DICD,^DIK W !,?3,"<DELETED>" K DA,J,K,DIC,DIK,FBAACP,FBAADT,FBX S Y=0,FBDL=1 Q
|
|---|
| 74 | HELP1 W !!,"Enter a dollar amount that does not exceed the amount claimed.",!,"Entering an '^' will delete the payment.",!
|
|---|
| 75 | I FBAMTPD>0 W !,"Only the holder of the 'FBAASUPERVISOR' key may exceed the",!,"Fee Schedule.",!
|
|---|
| 76 | G AMTPD
|
|---|
| 77 | HELPPD W !!,*7,"Enter a dollar amount that does not exceed the amount claimed.",! G AMTPD
|
|---|
| 78 | Q
|
|---|
| 79 | ;print Confidential Communication address
|
|---|
| 80 | ;ADD^VADPT must be invoked before this call
|
|---|
| 81 | ;FBDFN -patient's DFN
|
|---|
| 82 | ;FBSTPOS - position to start print
|
|---|
| 83 | ;returns 0 if there is no active CC address
|
|---|
| 84 | ;returns 1 if active
|
|---|
| 85 | CCADR(FBSTPOS) ;
|
|---|
| 86 | N FBACT
|
|---|
| 87 | S FBACT=0
|
|---|
| 88 | I '$D(VAPA(12)) Q 0 ;if D ADD^VADPT was not invoked before
|
|---|
| 89 | I 'VAERR D
|
|---|
| 90 | . S FBACT=$$ACTIVECC()
|
|---|
| 91 | . Q:'FBACT
|
|---|
| 92 | . W !!,"Confidential Communication address until: "_$P($G(VAPA(21)),U,2)
|
|---|
| 93 | . I $G(VAPA(13))]"" W !?FBSTPOS,"Line 1: ",$G(VAPA(13))
|
|---|
| 94 | . I $G(VAPA(14))]"" W " Line 2: ",$G(VAPA(14))
|
|---|
| 95 | . I $G(VAPA(15))]"" W !?FBSTPOS,"Line 3: ",$G(VAPA(15))
|
|---|
| 96 | . W !?FBSTPOS,"City:",?9,$S($G(VAPA(16))]"":$G(VAPA(16)),1:" ")
|
|---|
| 97 | . W ?40,"State:",?47,$S($P($G(VAPA(17)),U,2)]"":$P($G(VAPA(17)),U,2),1:" ")
|
|---|
| 98 | . W !?FBSTPOS,"Zip:",?9,$P($G(VAPA(18)),U,2)
|
|---|
| 99 | . W ?20,"County:",?28,$P($G(VAPA(19)),U,2)
|
|---|
| 100 | Q $G(FBACT)
|
|---|
| 101 | ;
|
|---|
| 102 | ;is called after ADD^VADPT to verify whether confidential address is
|
|---|
| 103 | ;active or not to encapsulate the logic related to status of CC address
|
|---|
| 104 | ;input: VAPA
|
|---|
| 105 | ACTIVECC() ;
|
|---|
| 106 | Q (+$G(VAPA(12))=1)&($P($G(VAPA(22,3)),"^",3)="Y")
|
|---|
| 107 | ;
|
|---|
| 108 | ;edit confidential address
|
|---|
| 109 | ;returns 1 if CC address has been edited
|
|---|
| 110 | ;otherwise - 0
|
|---|
| 111 | EDTCCADR() ;
|
|---|
| 112 | Q:'$G(DFN) 0
|
|---|
| 113 | I FBEDPTAD(1)=0 D
|
|---|
| 114 | . N VAPA S VAPA("P")="" D ADD^VADPT S FBEDPTAD(1)=$$ISCCADR()
|
|---|
| 115 | I FBEDPTAD(1)'="N" D
|
|---|
| 116 | . W:FBEDPTAD(1)'="B" !!,"WARNING: The Confidential address is NOT active for the Billing Category."
|
|---|
| 117 | . S DIR("A")="Want to edit Confidential Address data"
|
|---|
| 118 | E S DIR("A")="Want to add Confidential Address data"
|
|---|
| 119 | W ! S DIR("B")="No",DIR(0)="Y"
|
|---|
| 120 | D ^DIR K DIR
|
|---|
| 121 | Q:($D(DIRUT)) 0
|
|---|
| 122 | ;Registration API
|
|---|
| 123 | I Y D QUES^DGRPU1(+DFN,"ADD4") Q 1
|
|---|
| 124 | Q 0
|
|---|
| 125 | ;
|
|---|
| 126 | ;returns "B" if patient has any (active or inactive) CC address and billing category
|
|---|
| 127 | ;returns "Y" if patient has any (active or inactive) CC address with another category
|
|---|
| 128 | ;otherwise returns "N"
|
|---|
| 129 | ISCCADR() ;
|
|---|
| 130 | Q:($P($G(VAPA(22,3)),"^",3)="Y") "B"
|
|---|
| 131 | Q:'$O(VAPA(22,0)) "N"
|
|---|
| 132 | Q "Y"
|
|---|
| 133 | ;
|
|---|
| 134 | ;FBAACO0
|
|---|
