- 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 Feb 18, 2025@23:25:35 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
