| [613] | 1 | FBNHRC ;AISC/CMR-RATE CHANGE DURING AN AUTHORIZATION ;10APR93
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S DIC="^FBAAA(",DIC(0)="AEQMZ",DIC("A")="Select Fee Basis Patient: " D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT))!(Y<0) END S DFN=+Y,FBNAME=Y(0,0)
|
|---|
| 5 | S FBPROG="I $P(^(0),""^"",3)=7" D GETAUTH^FBAAUTL1 G END:'$G(FB7078)
|
|---|
| 6 | S FBCNT=0 D SORT I FBCNT'>0 W !!,*7,"No rate information on file for this authorization." G END
|
|---|
| 7 | ASK W !! S DIR(0)="DA^"_FBSTART_":"_FBEND_":EX",DIR("A")="Enter effective date of rate change: ",DIR("?")="Date must fall within authorization dates" D ^DIR K DIR
|
|---|
| 8 | G END:$D(DIRUT)!('Y) S FBEDT=+Y
|
|---|
| 9 | ;Get rate that will be affected by change
|
|---|
| 10 | S FBN=0 F S FBN=$O(^FBAA(161.23,"AC",FB7078,FBN)) Q:'FBN Q:(FBEDT'>$P($G(^FBAA(161.23,+FBN,0)),"^",2))&($P($G(^FBAA(161.23,+FBN,0)),"^")'>FBEDT)
|
|---|
| 11 | I FBN S FBRATE=1,FBCNUM=$P(^FBAA(161.23,FBN,0),"^",6),FBVIEN=FBVEN,FBREDT=$P(^(0),"^",2),FBRBDT=$P(^(0),"^") W !! D DISPLAY^FBAAVD1 G END:'$G(FBRATE) I FBRATE'=$P(^FBAA(161.23,FBN,0),"^",5) S (DIC,DIE)="^FBAA(161.23,",DA=FBN D
|
|---|
| 12 | .I FBRBDT=FBEDT S DR=".05////^S X=FBRATE" D ^DIE
|
|---|
| 13 | .I FBRBDT'=FBEDT S DR=".02////^S X="_$$CDTC^FBUCUTL(FBEDT,-1) D ^DIE K DIE,DA,DD,DO S DIC(0)="L",DLAYGO=161.23,X=FBEDT,DIC("DR")=".02////^S X=FBREDT;.03////^S X=FB7078;.04////^S X=DFN;.05////^S X=FBRATE;.06////^S X=FBCNUM" D FILE^DICN
|
|---|
| 14 | K DIE,DIC,DR,DA,DLAYGO
|
|---|
| 15 | D SORT
|
|---|
| 16 | W !! S DIR(0)="Y",DIR("A")="Do you want to change other rates associated with this Authorization",DIR("B")="No" D ^DIR K DIR G:Y ASK
|
|---|
| 17 | END K FBNAME,DFN,FB7078,FBAABDT,FBAAEDT,FBAAOUT,FBASSOC,FBAUT,FBPOV,FBPROG,FBPSA,FBPT,FBTT,FBTYPE,FBVEN,FTP,CNT,FBAR,FBCFD,FBCNT,FBCNUM,FBCTD,FBEDT,FBEND,FBN,FBN1,FBRATE,FBRBDT,FBREDT,FBSTART,FBVIEN,FBX,X,Y,Z,FBAR1
|
|---|
| 18 | Q
|
|---|
| 19 | SORT D HED
|
|---|
| 20 | S FBN=0 F S FBN=$O(^FBAA(161.23,"AC",FB7078,FBN)) Q:'FBN S FBN1=^FBAA(161.23,FBN,0),FBCNUM=$P(FBN1,"^",6),FBCFD=$P(FBN1,"^"),FBCTD=$P(FBN1,"^",2),FBRATE=$P(FBN1,"^",5) I FBCFD'>FBAAEDT S FBAR(FBCFD)=FBCTD_"^"_FBCNUM_"^"_FBRATE
|
|---|
| 21 | S (FBCFD,FBAAOUT)=0 F S FBCFD=$O(FBAR(FBCFD)) Q:'FBCFD!(FBAAOUT) S FBCNT=FBCNT+1,FBAR1=FBAR(FBCFD) D DISPLAY
|
|---|
| 22 | I FBCNT'>0 Q
|
|---|
| 23 | S FBEND=+FBAR1,FBSTART=$O(FBAR(0))
|
|---|
| 24 | Q
|
|---|
| 25 | DISPLAY ;Write out rates affected by contract
|
|---|
| 26 | I $Y+5>IOSL S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|---|
| 27 | I $Y+5>IOSL D HED
|
|---|
| 28 | W !!?5,$$DATX^FBAAUTL(FBCFD),?25,$$DATX^FBAAUTL(+FBAR1),?40,"$ ",$J($FN($P(FBAR1,"^",3),",",2),8),?55,$P(FBAR1,"^",2)
|
|---|
| 29 | Q
|
|---|
| 30 | HED W @IOF,!,?20,"CURRENT RATE INFORMATION FOR ",$$NAME^FBCHREQ2(DFN)
|
|---|
| 31 | W !!!?5,"FROM DATE",?25,"TO DATE",?40,"RATE",?55,"CONTRACT #",! F I=1:1:79 W "_"
|
|---|
| 32 | Q
|
|---|
