FBNHRAT1 ;AISC/CMR - ENTER RATES CONT. ;9/19/2014
;;3.5;FEE BASIS;**17,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
VENDAT ;set up rate if contract exists
N FBRATE,FBCFDT,FBCTDT,FBI,FBCNUM,FBNRFDT,FBNRTDT
S FBCFDT=0
I '$O(^FBAA(161.21,"AC",FBVIEN,0)) D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
VENDAT1 K FBRET
S FBCFDT=$O(^FBAA(161.21,"AC",FBVIEN,FBCFDT))
I FBCFDT']"" D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
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),"^")
I FBNFDT=FBCFDT!(FBNFDT>FBCFDT) D G:$G(FBRET) VENDAT1 Q
.I FBNFDT>FBCTDT S FBRET=1 Q
.I FBNTDT=FBCTDT D SET(FBNFDT,FBNTDT,I) Q
.I FBNTDT<FBCTDT D SET(FBNFDT,FBNTDT,I) Q
.I FBNTDT>FBCTDT D SET(FBNFDT,FBCTDT,I) S FBNFDT=$$CDTC^FBUCUTL(FBCTDT,1),FBRET=1 Q
I FBNFDT<FBCFDT D G:$G(FBRET) VENDAT1 Q
.I FBNTDT<FBCFDT D:$G(FBDDT) CKSET(FBNFDT,FBNTDT) Q
.I FBNTDT'>FBCTDT D:$G(FBDDT) CKSET(FBNFDT,$$CDTC^FBUCUTL(FBCFDT,-1)) S FBNFDT=FBCFDT D SET(FBNFDT,FBNTDT,I) Q
.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
Q
SET(FBFR,FBTO,FBDFN) ;set up rate array for pt
;FBFR and FBTO are from and to dates to establish rates for
;FBDFN=DFN for pt.
;FBNHARUP (optional)
; if = "N" the call is during payment and a rate cannot be added
; if = 1 rates are being monitored and a rate has not been added yet
; if = 11 rates are being monitored and a rate has been added
;output FBFND=1 to indicate that a gap was found to create a rate for
; FBNHARUP (optional) changed from 1 to 11 if rate added
S FBFND=1
W !!,*7,"Patient: ",$$NAME^FBCHREQ2(FBDFN),?40,"SSN: ",$$SSN^FBAAUTL(FBDFN)
W !,?5,"Rate must be entered for the following period: ",$$DATX^FBAAUTL(FBFR)," - ",$$DATX^FBAAUTL(FBTO)
I $G(FBNHARUP)'="N" S FBRATE=1 ; when not "N" allow rate to be added
D DISPLAY^FBAAVD1 K FBX I '$G(FBRATE) D:$G(FBDDT) CKSET(FBFR,FBTO) Q
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
I $G(FBNHARUP)=1 S FBNHARUP=11 ; let caller know a rate was added
Q
CKSET(FRDT,TODT) ;sets FBUNR array for timeframe unable to establish rate for.
;FBUNR array is only set if variable FBDDT is passed to subroutine
;and the attempt to create a rate (call to VENDAT) was unsuccessful.
;FBUNR array, if defined, is returned to calling program.
;FRDT=from date TODT=to date of unsuccessful rate setup
S FBUNR(FRDT,TODT)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHRAT1 2689 printed Apr 09, 2024@21:05:20 Page 2
FBNHRAT1 ;AISC/CMR - ENTER RATES CONT. ;9/19/2014
+1 ;;3.5;FEE BASIS;**17,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
VENDAT ;set up rate if contract exists
+1 NEW FBRATE,FBCFDT,FBCTDT,FBI,FBCNUM,FBNRFDT,FBNRTDT
+2 SET FBCFDT=0
+3 IF '$ORDER(^FBAA(161.21,"AC",FBVIEN,0))
if $GET(FBDDT)
DO CKSET(FBNFDT,FBNTDT)
QUIT
VENDAT1 KILL FBRET
+1 SET FBCFDT=$ORDER(^FBAA(161.21,"AC",FBVIEN,FBCFDT))
+2 IF FBCFDT']""
if $GET(FBDDT)
DO CKSET(FBNFDT,FBNTDT)
QUIT
+3 SET FBI=$ORDER(^FBAA(161.21,"AC",FBVIEN,FBCFDT,0))
IF FBI]""
SET FBCTDT=$PIECE(^FBAA(161.21,FBI,0),"^",3)
SET FBCNUM=$PIECE(^FBAA(161.21,FBI,0),"^")
+4 IF FBNFDT=FBCFDT!(FBNFDT>FBCFDT)
Begin DoDot:1
+5 IF FBNFDT>FBCTDT
SET FBRET=1
QUIT
+6 IF FBNTDT=FBCTDT
DO SET(FBNFDT,FBNTDT,I)
QUIT
+7 IF FBNTDT<FBCTDT
DO SET(FBNFDT,FBNTDT,I)
QUIT
+8 IF FBNTDT>FBCTDT
DO SET(FBNFDT,FBCTDT,I)
SET FBNFDT=$$CDTC^FBUCUTL(FBCTDT,1)
SET FBRET=1
QUIT
End DoDot:1
if $GET(FBRET)
GOTO VENDAT1
QUIT
+9 IF FBNFDT<FBCFDT
Begin DoDot:1
+10 IF FBNTDT<FBCFDT
if $GET(FBDDT)
DO CKSET(FBNFDT,FBNTDT)
QUIT
+11 IF FBNTDT'>FBCTDT
if $GET(FBDDT)
DO CKSET(FBNFDT,$$CDTC^FBUCUTL(FBCFDT,-1))
SET FBNFDT=FBCFDT
DO SET(FBNFDT,FBNTDT,I)
QUIT
+12 IF FBNTDT>FBCTDT
if $GET(FBDDT)
DO CKSET(FBNFDT,$$CDTC^FBUCUTL(FBCFDT,-1))
SET FBNFDT=FBCFDT
DO SET(FBNFDT,FBCTDT,I)
SET FBNFDT=$$CDTC^FBUCUTL(FBCTDT,1)
SET FBRET=1
QUIT
End DoDot:1
if $GET(FBRET)
GOTO VENDAT1
QUIT
+13 QUIT
SET(FBFR,FBTO,FBDFN) ;set up rate array for pt
+1 ;FBFR and FBTO are from and to dates to establish rates for
+2 ;FBDFN=DFN for pt.
+3 ;FBNHARUP (optional)
+4 ; if = "N" the call is during payment and a rate cannot be added
+5 ; if = 1 rates are being monitored and a rate has not been added yet
+6 ; if = 11 rates are being monitored and a rate has been added
+7 ;output FBFND=1 to indicate that a gap was found to create a rate for
+8 ; FBNHARUP (optional) changed from 1 to 11 if rate added
+9 SET FBFND=1
+10 WRITE !!,*7,"Patient: ",$$NAME^FBCHREQ2(FBDFN),?40,"SSN: ",$$SSN^FBAAUTL(FBDFN)
+11 WRITE !,?5,"Rate must be entered for the following period: ",$$DATX^FBAAUTL(FBFR)," - ",$$DATX^FBAAUTL(FBTO)
+12 ; when not "N" allow rate to be added
IF $GET(FBNHARUP)'="N"
SET FBRATE=1
+13 DO DISPLAY^FBAAVD1
KILL FBX
IF '$GET(FBRATE)
if $GET(FBDDT)
DO CKSET(FBFR,FBTO)
QUIT
+14 KILL DD,DO
SET DIC="^FBAA(161.23,"
SET DIC(0)="L"
SET X=FBFR
SET DIC("DR")=".02////^S X=FBTO;.03////^S X=FB7078;.04////^S X=FBDFN;.05////^S X=FBRATE;.06////^S X=FBCNUM"
SET DLAYGO=161.23
DO FILE^DICN
KILL DLAYGO,DIC,X
+15 ; let caller know a rate was added
IF $GET(FBNHARUP)=1
SET FBNHARUP=11
+16 QUIT
CKSET(FRDT,TODT) ;sets FBUNR array for timeframe unable to establish rate for.
+1 ;FBUNR array is only set if variable FBDDT is passed to subroutine
+2 ;and the attempt to create a rate (call to VENDAT) was unsuccessful.
+3 ;FBUNR array, if defined, is returned to calling program.
+4 ;FRDT=from date TODT=to date of unsuccessful rate setup
+5 SET FBUNR(FRDT,TODT)=""
+6 QUIT
