- FBNHRAT ;AISC/CMR - POST NEW RATES FOR VETERAN ;9/19/2014
- ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- S FBRATE=1 K ^TMP($J,"FB")
- VENDOR ;select CNH vendor from the fee vendor file (161.2)
- S DIC="^FBAAV(",DIC(0)="AEQM",DIC("A")="Select CNH Vendor:",DIC("S")="I $P(^(0),U,9)=5" D ^DIC K DIC G Q:X=""!(X="^")!(Y<0) S FBVIEN=+Y
- ;
- VETDISP ;get patients in the selected nursing home
- S I=0
- F S I=$O(^FBAACNH("AD",I)) Q:'I S J=0 F S J=+$O(^FBAACNH("AD",I,J)) Q:'J I $P($G(^FBAACNH(J,0)),U,9)=FBVIEN S FB(0)=$G(^(0)) D DRIV(I,J,.FB) K FBNFDT,FBNTDT
- I '$G(FBFND) W !!,"There are presently no patients that need rates updated for this vendor."
- Q K DIC,X,Y,FBVIEN,I,J,FB,FBTYP,FBNFDT,FBNTDT,FBAUTHN,FBAUTH,FBAFDT,FBATDT,FB7078,FBRT1,FBNFDT,FBNTDT,FBRTDT,FBIEN,FBRFDT,FBCFDT,FBI,FBCTDT,FBCNUM,FBRATE,FBFND,FBX,FBNRTDT,FBNRFDT,DUOUT,DTOUT,DIRUT,DR,DIE,FBCHFDT,FBCHTDT,FBRT,FBZ
- K FBRET
- Q
- DRIV(I,J,FB,FBDDT) ;identify incomplete rate data for a given authorization
- ;INPUT I = DFN
- ; J = ien of active admission from movement file (162.3)
- ; FB = passing of 0 node of mvmnt(162.3)
- ; FBDDT (optional) = date of discharge
- ;output FBFND = if 1 means at least 1 pt. had a rate created
- ; FBUNR (only set if FBDDT passed) = array containing timeframes
- ; unable to establish rates for
- N FBVIEN,FBAUTHN,FBAUTH,FBAFDT,FBATDT,FB7078,FBNFDT,FBNTDT,FBIEN,FBRFDT,FBRTDT,FBRT,FBCHFDT,FBCHTDT
- ; FBNHARUP flag (N, 1, or 11)
- ; when value is true (1 or 11) rates can be changed within
- ; SET^FBNHRAT1 because calling option can edit 'authorization'
- ; SET^FBNHRAT1 changes the value from 1 to 11 if a rate is added
- N FBNHARUP
- S FBNHARUP=1
- S FBVIEN=+$P(FB(0),U,9),FBAUTHN=$P(^FBAACNH(J,0),"^",10),FBAUTH=$G(^FBAAA(I,1,FBAUTHN,0)),FBAFDT=+FBAUTH,FBATDT=$P(FBAUTH,"^",2),FB7078=+$P(FBAUTH,"^",9)
- I $G(FBDDT) S FBAFDT=$S($$DTC^FBUCUTL(DT,FBAFDT)>730:$$CDTC^FBUCUTL(DT,-730),1:FBAFDT) Q:FBAFDT>FBDDT
- ;checks rate file, if no rates exist it will create one
- I '$D(^FBAA(161.23,"AC",FB7078)) S FBNFDT=FBAFDT,FBNTDT=$S($G(FBDDT):FBDDT,1:FBATDT) D VENDAT^FBNHRAT1 D:FBNHARUP=11 Q
- . N FBX
- . S FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Add CNH rate(s).")
- . I 'FBX W !,"Error adding record in User Audit. Please contact IRM."
- ;set up array of existing rates
- K FBRT S FBIEN=0 F S FBIEN=$O(^FBAA(161.23,"AC",FB7078,FBIEN)) Q:'$G(FBIEN) S FB(1)=$G(^FBAA(161.23,FBIEN,0)),FBRFDT=+FB(1),FBRT(FBRFDT)=FB(1) K FB(1)
- ;FBCHFDT and FBCHTDT are check dates (initially = to auth fr & to dates, they are incremented based on existing rates throughout the check)
- S FBCHFDT=FBAFDT,FBCHTDT=$S($G(FBDDT):FBDDT,1:FBATDT),FBRFDT=0 D GETRAT,CKFRDT
- I FBNHARUP=11 D
- . N FBX
- . S FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Add CNH rate(s).")
- . I 'FBX W !,"Error adding record in User Audit. Please contact IRM."
- Q
- GETRAT ;gets next rate from rate array
- S FBRFDT=+$O(FBRT(FBRFDT)) Q:'FBRFDT S FBRTDT=$P(FBRT(FBRFDT),"^",2) Q
- CKFRDT ;comparison of from dates
- Q:FBCHFDT>FBCHTDT
- I FBCHFDT=FBRFDT G CKTODT
- I FBCHFDT<FBRFDT S FBNFDT=FBCHFDT,FBNTDT=$S($$CDTC^FBUCUTL(FBRFDT,-1)>FBCHTDT:FBCHTDT,1:$$CDTC^FBUCUTL(FBRFDT,-1)) D VENDAT^FBNHRAT1 S FBCHFDT=$$CDTC^FBUCUTL(FBNTDT,1) K FBNFDT,FBNTDT G CKFRDT
- I FBCHFDT>FBRFDT Q:FBCHFDT>FBCHTDT I 'FBRFDT S FBNFDT=FBCHFDT,FBNTDT=FBCHTDT D VENDAT^FBNHRAT1 K FBNFDT,FBNTDT Q
- I FBCHFDT>FBRFDT G CKTODT
- Q
- CKTODT ;comparison of to dates
- Q:FBCHTDT=FBRTDT!(FBCHTDT<FBRTDT)
- I FBCHFDT'>FBRTDT S FBCHFDT=$$CDTC^FBUCUTL(FBRTDT,1)
- D GETRAT G CKFRDT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHRAT 3616 printed Mar 13, 2025@21:04:03 Page 2
- FBNHRAT ;AISC/CMR - POST NEW RATES FOR VETERAN ;9/19/2014
- +1 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 SET FBRATE=1
- KILL ^TMP($JOB,"FB")
- VENDOR ;select CNH vendor from the fee vendor file (161.2)
- +1 SET DIC="^FBAAV("
- SET DIC(0)="AEQM"
- SET DIC("A")="Select CNH Vendor:"
- SET DIC("S")="I $P(^(0),U,9)=5"
- DO ^DIC
- KILL DIC
- if X=""!(X="^")!(Y<0)
- GOTO Q
- SET FBVIEN=+Y
- +2 ;
- VETDISP ;get patients in the selected nursing home
- +1 SET I=0
- +2 FOR
- SET I=$ORDER(^FBAACNH("AD",I))
- if 'I
- QUIT
- SET J=0
- FOR
- SET J=+$ORDER(^FBAACNH("AD",I,J))
- if 'J
- QUIT
- IF $PIECE($GET(^FBAACNH(J,0)),U,9)=FBVIEN
- SET FB(0)=$GET(^(0))
- DO DRIV(I,J,.FB)
- KILL FBNFDT,FBNTDT
- +3 IF '$GET(FBFND)
- WRITE !!,"There are presently no patients that need rates updated for this vendor."
- Q KILL DIC,X,Y,FBVIEN,I,J,FB,FBTYP,FBNFDT,FBNTDT,FBAUTHN,FBAUTH,FBAFDT,FBATDT,FB7078,FBRT1,FBNFDT,FBNTDT,FBRTDT,FBIEN,FBRFDT,FBCFDT,FBI,FBCTDT,FBCNUM,FBRATE,FBFND,FBX,FBNRTDT,FBNRFDT,DUOUT,DTOUT,DIRUT,DR,DIE,FBCHFDT,FBCHTDT,FBRT,FBZ
- +1 KILL FBRET
- +2 QUIT
- DRIV(I,J,FB,FBDDT) ;identify incomplete rate data for a given authorization
- +1 ;INPUT I = DFN
- +2 ; J = ien of active admission from movement file (162.3)
- +3 ; FB = passing of 0 node of mvmnt(162.3)
- +4 ; FBDDT (optional) = date of discharge
- +5 ;output FBFND = if 1 means at least 1 pt. had a rate created
- +6 ; FBUNR (only set if FBDDT passed) = array containing timeframes
- +7 ; unable to establish rates for
- +8 NEW FBVIEN,FBAUTHN,FBAUTH,FBAFDT,FBATDT,FB7078,FBNFDT,FBNTDT,FBIEN,FBRFDT,FBRTDT,FBRT,FBCHFDT,FBCHTDT
- +9 ; FBNHARUP flag (N, 1, or 11)
- +10 ; when value is true (1 or 11) rates can be changed within
- +11 ; SET^FBNHRAT1 because calling option can edit 'authorization'
- +12 ; SET^FBNHRAT1 changes the value from 1 to 11 if a rate is added
- +13 NEW FBNHARUP
- +14 SET FBNHARUP=1
- +15 SET FBVIEN=+$PIECE(FB(0),U,9)
- SET FBAUTHN=$PIECE(^FBAACNH(J,0),"^",10)
- SET FBAUTH=$GET(^FBAAA(I,1,FBAUTHN,0))
- SET FBAFDT=+FBAUTH
- SET FBATDT=$PIECE(FBAUTH,"^",2)
- SET FB7078=+$PIECE(FBAUTH,"^",9)
- +16 IF $GET(FBDDT)
- SET FBAFDT=$SELECT($$DTC^FBUCUTL(DT,FBAFDT)>730:$$CDTC^FBUCUTL(DT,-730),1:FBAFDT)
- if FBAFDT>FBDDT
- QUIT
- +17 ;checks rate file, if no rates exist it will create one
- +18 IF '$DATA(^FBAA(161.23,"AC",FB7078))
- SET FBNFDT=FBAFDT
- SET FBNTDT=$SELECT($GET(FBDDT):FBDDT,1:FBATDT)
- DO VENDAT^FBNHRAT1
- if FBNHARUP=11
- Begin DoDot:1
- +19 NEW FBX
- +20 SET FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Add CNH rate(s).")
- +21 IF 'FBX
- WRITE !,"Error adding record in User Audit. Please contact IRM."
- End DoDot:1
- QUIT
- +22 ;set up array of existing rates
- +23 KILL FBRT
- SET FBIEN=0
- FOR
- SET FBIEN=$ORDER(^FBAA(161.23,"AC",FB7078,FBIEN))
- if '$GET(FBIEN)
- QUIT
- SET FB(1)=$GET(^FBAA(161.23,FBIEN,0))
- SET FBRFDT=+FB(1)
- SET FBRT(FBRFDT)=FB(1)
- KILL FB(1)
- +24 ;FBCHFDT and FBCHTDT are check dates (initially = to auth fr & to dates, they are incremented based on existing rates throughout the check)
- +25 SET FBCHFDT=FBAFDT
- SET FBCHTDT=$SELECT($GET(FBDDT):FBDDT,1:FBATDT)
- SET FBRFDT=0
- DO GETRAT
- DO CKFRDT
- +26 IF FBNHARUP=11
- Begin DoDot:1
- +27 NEW FBX
- +28 SET FBX=$$ADDUA^FBUTL9(162.4,FB7078_",","Add CNH rate(s).")
- +29 IF 'FBX
- WRITE !,"Error adding record in User Audit. Please contact IRM."
- End DoDot:1
- +30 QUIT
- GETRAT ;gets next rate from rate array
- +1 SET FBRFDT=+$ORDER(FBRT(FBRFDT))
- if 'FBRFDT
- QUIT
- SET FBRTDT=$PIECE(FBRT(FBRFDT),"^",2)
- QUIT
- CKFRDT ;comparison of from dates
- +1 if FBCHFDT>FBCHTDT
- QUIT
- +2 IF FBCHFDT=FBRFDT
- GOTO CKTODT
- +3 IF FBCHFDT<FBRFDT
- SET FBNFDT=FBCHFDT
- SET FBNTDT=$SELECT($$CDTC^FBUCUTL(FBRFDT,-1)>FBCHTDT:FBCHTDT,1:$$CDTC^FBUCUTL(FBRFDT,-1))
- DO VENDAT^FBNHRAT1
- SET FBCHFDT=$$CDTC^FBUCUTL(FBNTDT,1)
- KILL FBNFDT,FBNTDT
- GOTO CKFRDT
- +4 IF FBCHFDT>FBRFDT
- if FBCHFDT>FBCHTDT
- QUIT
- IF 'FBRFDT
- SET FBNFDT=FBCHFDT
- SET FBNTDT=FBCHTDT
- DO VENDAT^FBNHRAT1
- KILL FBNFDT,FBNTDT
- QUIT
- +5 IF FBCHFDT>FBRFDT
- GOTO CKTODT
- +6 QUIT
- CKTODT ;comparison of to dates
- +1 if FBCHTDT=FBRTDT!(FBCHTDT<FBRTDT)
- QUIT
- +2 IF FBCHFDT'>FBRTDT
- SET FBCHFDT=$$CDTC^FBUCUTL(FBRTDT,1)
- +3 DO GETRAT
- GOTO CKFRDT
