| [613] | 1 | FBNHRAT ;AISC/CMR-POST NEW RATES FOR VETERAN ;4/14/93
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S FBRATE=1 K ^TMP($J,"FB")
|
|---|
| 5 | VENDOR ;select CNH vendor from the fee vendor file (161.2)
|
|---|
| 6 | 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
|
|---|
| 7 | ;
|
|---|
| 8 | VETDISP ;get patients in the selected nursing home
|
|---|
| 9 | S I=0
|
|---|
| 10 | 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
|
|---|
| 11 | I '$G(FBFND) W !!,"There are presently no patients that need rates updated for this vendor."
|
|---|
| 12 | 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
|
|---|
| 13 | K FBRET
|
|---|
| 14 | Q
|
|---|
| 15 | DRIV(I,J,FB,FBDDT) ;identify incomplete rate data for a given authorization
|
|---|
| 16 | ;INPUT I = DFN
|
|---|
| 17 | ; J = ien of active admission from movement file (162.3)
|
|---|
| 18 | ; FB = passing of 0 node of mvmnt(162.3)
|
|---|
| 19 | ; FBDDT (optional) = date of discharge
|
|---|
| 20 | ;output FBFND = if 1 means at least 1 pt. had a rate created
|
|---|
| 21 | ; FBUNR (only set if FBDDT passed) = array containing timeframes
|
|---|
| 22 | ; unable to establish rates for
|
|---|
| 23 | N FBVIEN,FBAUTHN,FBAUTH,FBAFDT,FBATDT,FB7078,FBNFDT,FBNTDT,FBIEN,FBRFDT,FBRTDT,FBRT,FBCHFDT,FBCHTDT
|
|---|
| 24 | 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)
|
|---|
| 25 | I $G(FBDDT) S FBAFDT=$S($$DTC^FBUCUTL(DT,FBAFDT)>730:$$CDTC^FBUCUTL(DT,-730),1:FBAFDT) Q:FBAFDT>FBDDT
|
|---|
| 26 | ;checks rate file, if no rates exist it will create one
|
|---|
| 27 | I '$D(^FBAA(161.23,"AC",FB7078)) S FBNFDT=FBAFDT,FBNTDT=$S($G(FBDDT):FBDDT,1:FBATDT) D VENDAT^FBNHRAT1 Q
|
|---|
| 28 | ;set up array of existing rates
|
|---|
| 29 | 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)
|
|---|
| 30 | ;FBCHFDT and FBCHTDT are check dates (initially = to auth fr & to dates, they are incremented based on existing rates throughout the check)
|
|---|
| 31 | S FBCHFDT=FBAFDT,FBCHTDT=$S($G(FBDDT):FBDDT,1:FBATDT),FBRFDT=0 D GETRAT,CKFRDT
|
|---|
| 32 | Q
|
|---|
| 33 | GETRAT ;gets next rate from rate array
|
|---|
| 34 | S FBRFDT=+$O(FBRT(FBRFDT)) Q:'FBRFDT S FBRTDT=$P(FBRT(FBRFDT),"^",2) Q
|
|---|
| 35 | CKFRDT ;comparison of from dates
|
|---|
| 36 | Q:FBCHFDT>FBCHTDT
|
|---|
| 37 | I FBCHFDT=FBRFDT G CKTODT
|
|---|
| 38 | 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
|
|---|
| 39 | I FBCHFDT>FBRFDT Q:FBCHFDT>FBCHTDT I 'FBRFDT S FBNFDT=FBCHFDT,FBNTDT=FBCHTDT D VENDAT^FBNHRAT1 K FBNFDT,FBNTDT Q
|
|---|
| 40 | I FBCHFDT>FBRFDT G CKTODT
|
|---|
| 41 | Q
|
|---|
| 42 | CKTODT ;comparison of to dates
|
|---|
| 43 | Q:FBCHTDT=FBRTDT!(FBCHTDT<FBRTDT)
|
|---|
| 44 | I FBCHFDT'>FBRTDT S FBCHFDT=$$CDTC^FBUCUTL(FBRTDT,1)
|
|---|
| 45 | D GETRAT G CKFRDT
|
|---|
