33 lines
2.5 KiB
Mathematica
33 lines
2.5 KiB
Mathematica
FBNHRC ;AISC/CMR-RATE CHANGE DURING AN AUTHORIZATION ;10APR93
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
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)
|
|
S FBPROG="I $P(^(0),""^"",3)=7" D GETAUTH^FBAAUTL1 G END:'$G(FB7078)
|
|
S FBCNT=0 D SORT I FBCNT'>0 W !!,*7,"No rate information on file for this authorization." G END
|
|
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
|
|
G END:$D(DIRUT)!('Y) S FBEDT=+Y
|
|
;Get rate that will be affected by change
|
|
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)
|
|
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
|
|
.I FBRBDT=FBEDT S DR=".05////^S X=FBRATE" D ^DIE
|
|
.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
|
|
K DIE,DIC,DR,DA,DLAYGO
|
|
D SORT
|
|
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
|
|
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
|
|
Q
|
|
SORT D HED
|
|
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
|
|
S (FBCFD,FBAAOUT)=0 F S FBCFD=$O(FBAR(FBCFD)) Q:'FBCFD!(FBAAOUT) S FBCNT=FBCNT+1,FBAR1=FBAR(FBCFD) D DISPLAY
|
|
I FBCNT'>0 Q
|
|
S FBEND=+FBAR1,FBSTART=$O(FBAR(0))
|
|
Q
|
|
DISPLAY ;Write out rates affected by contract
|
|
I $Y+5>IOSL S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|
I $Y+5>IOSL D HED
|
|
W !!?5,$$DATX^FBAAUTL(FBCFD),?25,$$DATX^FBAAUTL(+FBAR1),?40,"$ ",$J($FN($P(FBAR1,"^",3),",",2),8),?55,$P(FBAR1,"^",2)
|
|
Q
|
|
HED W @IOF,!,?20,"CURRENT RATE INFORMATION FOR ",$$NAME^FBCHREQ2(DFN)
|
|
W !!!?5,"FROM DATE",?25,"TO DATE",?40,"RATE",?55,"CONTRACT #",! F I=1:1:79 W "_"
|
|
Q
|