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 Apr 09, 2024@21:05:21 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
