| [613] | 1 | FBNHRAT1 ;AISC/CMR-ENTER RATES CONT. ;3/10/1999
|
|---|
| 2 | ;;3.5;FEE BASIS;**17**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | VENDAT ;set up rate if contract exists
|
|---|
| 5 | N FBRATE,FBCFDT,FBCTDT,FBI,FBCNUM,FBNRFDT,FBNRTDT
|
|---|
| 6 | S FBCFDT=0
|
|---|
| 7 | I '$O(^FBAA(161.21,"AC",FBVIEN,0)) D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
|
|---|
| 8 | VENDAT1 K FBRET
|
|---|
| 9 | S FBCFDT=$O(^FBAA(161.21,"AC",FBVIEN,FBCFDT))
|
|---|
| 10 | I FBCFDT']"" D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
|
|---|
| 11 | S FBI=$O(^FBAA(161.21,"AC",FBVIEN,FBCFDT,0)) I FBI]"" S FBCTDT=$P(^FBAA(161.21,FBI,0),"^",3),FBCNUM=$P(^FBAA(161.21,FBI,0),"^")
|
|---|
| 12 | I FBNFDT=FBCFDT!(FBNFDT>FBCFDT) D G:$G(FBRET) VENDAT1 Q
|
|---|
| 13 | .I FBNFDT>FBCTDT S FBRET=1 Q
|
|---|
| 14 | .I FBNTDT=FBCTDT D SET(FBNFDT,FBNTDT,I) Q
|
|---|
| 15 | .I FBNTDT<FBCTDT D SET(FBNFDT,FBNTDT,I) Q
|
|---|
| 16 | .I FBNTDT>FBCTDT D SET(FBNFDT,FBCTDT,I) S FBNFDT=$$CDTC^FBUCUTL(FBCTDT,1),FBRET=1 Q
|
|---|
| 17 | I FBNFDT<FBCFDT D G:$G(FBRET) VENDAT1 Q
|
|---|
| 18 | .I FBNTDT<FBCFDT D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
|
|---|
| 19 | .I FBNTDT'>FBCTDT D:$G(FBDDT) CKSET(FBNFDT,$$CDTC^FBUCUTL(FBCFDT,-1)) S FBNFDT=FBCFDT D SET(FBNFDT,FBNTDT,I) Q
|
|---|
| 20 | .I FBNTDT>FBCTDT D:$G(FBDDT) CKSET(FBNFDT,$$CDTC^FBUCUTL(FBCFDT,-1)) S FBNFDT=FBCFDT D SET(FBNFDT,FBCTDT,I) S FBNFDT=$$CDTC^FBUCUTL(FBCTDT,1),FBRET=1 Q
|
|---|
| 21 | Q
|
|---|
| 22 | SET(FBFR,FBTO,FBDFN) ;set up rate array for pt
|
|---|
| 23 | ;FBFR and FBTO are from and to dates to establish rates for
|
|---|
| 24 | ;FBDFN=DFN for pt.
|
|---|
| 25 | ;output FBFND=1 to indicate that a gap was found to create a rate for
|
|---|
| 26 | S FBFND=1
|
|---|
| 27 | W !!,*7,"Patient: ",$$NAME^FBCHREQ2(FBDFN),?40,"SSN: ",$$SSN^FBAAUTL(FBDFN)
|
|---|
| 28 | W !,?5,"Rate must be entered for the following period: ",$$DATX^FBAAUTL(FBFR)," - ",$$DATX^FBAAUTL(FBTO)
|
|---|
| 29 | S FBRATE=1 D DISPLAY^FBAAVD1 K FBX I '$G(FBRATE) D:$G(FBDDT) CKSET(FBFR,FBTO) Q
|
|---|
| 30 | K DD,DO S DIC="^FBAA(161.23,",DIC(0)="L",X=FBFR,DIC("DR")=".02////^S X=FBTO;.03////^S X=FB7078;.04////^S X=FBDFN;.05////^S X=FBRATE;.06////^S X=FBCNUM",DLAYGO=161.23 D FILE^DICN K DLAYGO,DIC,X
|
|---|
| 31 | Q
|
|---|
| 32 | CKSET(FRDT,TODT) ;sets FBUNR array for timeframe unable to establish rate for.
|
|---|
| 33 | ;FBUNR array is only set if variable FBDDT is passed to subroutine
|
|---|
| 34 | ;and the attempt to create a rate (call to VENDAT) was unsuccessful.
|
|---|
| 35 | ;FBUNR array, if defined, is returned to calling program.
|
|---|
| 36 | ;FRDT=from date TODT=to date of unsuccessful rate setup
|
|---|
| 37 | S FBUNR(FRDT,TODT)=""
|
|---|
| 38 | Q
|
|---|
