| 1 | FBNHEP ;AISC/GRR-ENTER NURSING HOME PAYMENT ;18DEC00
|
|---|
| 2 | ;;3.5;FEE BASIS;**25**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I '$D(^FBAA(161.7,"AB","O",DUZ)) G NOBAT^FBNHEP2
|
|---|
| 5 | S FBOUT=1 F I=0:0 S I=$O(^FBAA(161.7,"AB","O",DUZ,I)) Q:I'>0 I $D(^FBAA(161.7,I,0)),$P(^(0),"^",3)="B9",$P(^(0),"^",15)="" S FBOUT=0 Q
|
|---|
| 6 | G:FBOUT NOBAT^FBNHEP2
|
|---|
| 7 | D GETBAT^FBNHEP2 G Q:FBOUT!('$D(FBBAT)) W !
|
|---|
| 8 | ;
|
|---|
| 9 | RD S FBAAPTC="V",FBER=0,%DT="AEPMX",%DT("A")="Payments for which Month/Year: " D ^%DT G:X="^"!(X="") Q
|
|---|
| 10 | S FBPAYDT=$E(+Y,1,5)_"00",FBMM=$E(+Y,4,5),FBYY=$E(+Y,2,3),X=+Y S FBDAYS=$$DAYS^FBNHEP1(X),(FBENDDT,FBPAYEDT)=$E(+Y,1,5)_FBDAYS
|
|---|
| 11 | ;
|
|---|
| 12 | GETVET K FB,FB7078,FBAABDT,FBAAEDT,FBASSOC,FBAT,FBAUT,FBBEG,FBDEFP,FBEND,FBHI,FBPDT,FBPOV,FBPREV,FBPROG,FBPRTR,FBPSA,FBPT,FBRIFN,FBTRDYS,FBTT,FBTYPE,FBVEN,FBZ,FTP,IFN,FBAAID,FBAAVID
|
|---|
| 13 | S FBENDDT=$E(+FBENDDT,1,5)_$$DAYS^FBNHEP1(FBENDDT) D GETVET^FBAAUTL1 G:DFN']"" Q S FBPROG="I $P(^(0),U,3)=7,($P(^(0),U,9)'[""FB583"")" D GETAUTH^FBAAUTL1 G GETVET:FTP']"",GETVET:$D(DIRUT) K FBAAOUT
|
|---|
| 14 | I $E(FBPAYDT,1,5)<$E(FBAABDT,1,5)!($E(FBPAYDT,1,5)>$E(FBAAEDT,1,5)) W !!,*7,"Payment Period is NOT within the veterans authorized dates!" G GETVET
|
|---|
| 15 | ;
|
|---|
| 16 | GETVEN S FBERR=0,IFN=$G(FBVEN) D:'IFN GETVEN^FBAAUTL1 G:IFN'>0 Q S FBENDFLG=$S(FBAAEDT'>FBENDDT:1,1:""),FBENDDT=$S(FBENDDT>FBAAEDT:FBAAEDT,1:FBENDDT)
|
|---|
| 17 | I $P($G(^FBAAV(+IFN,"ADEL")),U)="Y" W !!,*7,"Vendor is flagged for Austin deletion!",! G Q
|
|---|
| 18 | K FB D CKRAT^FBNHEP2 G:FBERR GETVET
|
|---|
| 19 | I $D(^FBAAI("AA",IFN,DFN,$E(FBPAYDT,1,5))) S FBINA=$O(^FBAAI("AA",IFN,DFN,$E(FBPAYDT,1,5),0)) W !!,*7,"Invoice (# ",FBINA,") already exists for treatment provided in the",!,"month and year selected.",! G CHKAHD
|
|---|
| 20 | ;
|
|---|
| 21 | LETSGO D GETACT G:FBERR GETVET
|
|---|
| 22 | D:$D(FBNOAC) CALC^FBNHEP2 G:FBERR GETVET
|
|---|
| 23 | ;
|
|---|
| 24 | ADDMOR I '$D(FBNOAC) D DAYS^FBNHEP2,CALC1^FBNHEP2
|
|---|
| 25 | I FBTRDYS>0 W !!!,"Amount based on ",FBTRDYS," days of care."
|
|---|
| 26 | W !!," Total Amount calculated is: $",$J(FBDEFP,7,2),!
|
|---|
| 27 | ;
|
|---|
| 28 | RD3 S DIR(0)="Y",DIR("A")="Want to Continue with Payment Entry",DIR("B")="YES" D ^DIR K DIR G ^FBNHEP1:Y,GETVET
|
|---|
| 29 | ;
|
|---|
| 30 | GETACT D HED^FBNHDEC S (FBTRDYS,FBTRDYS(2))=0,FBPRTR="",FBNAC=$O(^FBAACNH("AG",DFN,FBVEN,$S(FBAABDT>(FBPAYDT+1):FBAABDT,1:FBPAYDT))) G:FBNAC'>0!($P(FBNAC,".")>FBENDDT) NOAC
|
|---|
| 31 | ;
|
|---|
| 32 | S FBRIFN=$O(^FBAACNH("AG",DFN,FBVEN,FBNAC,0)),Z=$G(^FBAACNH(FBRIFN,0)) Q:Z=""
|
|---|
| 33 | I '$D(FBPNAC),$P(Z,"^",3)="T"&($P(Z,"^",7)<4) D
|
|---|
| 34 | .S FBHZ=Z D GETPRV S Z=FBPRTR Q:Z="" D DISPAC S Z=FBHZ,FBPNAC=FBPAYDT+1 D
|
|---|
| 35 | ..S FBTRDYS=FBTRDYS+(($P(FBNAC,".")-FBPNAC)),FBTRDYS=$S(FBTRDYS>0:FBTRDYS,((FBAABDT<FBAAEDT)&(+$E(FBAAEDT,6,7)=1)):0,1:1)
|
|---|
| 36 | S FBPNAC=FBNAC,FBCOUNT=$S($P(Z,"^",3)="A":1,$P(Z,"^",3)="T":$S($P(Z,"^",7)>3:1,1:0),1:0) S FBLTT=$P(Z,"^",3) D:FBLTT'="D" DISPAC G:$P(Z,"^",3)'="D" CONT
|
|---|
| 37 | S FBHZ=Z D GETPRV S Z=FBPRTR G:FBPRTR="" GETVET D DISPAC S Z=FBHZ D DISPAC I $P(FBPRTR,"^",3)="T"&($P(FBPRTR,"^",7)<4) G SKIPC
|
|---|
| 38 | S FBTRDYS=FBTRDYS+($P(FBNAC,".",1)-FBPAYDT)-1,FBTRDYS=$S(FBTRDYS>0:FBTRDYS,((FBAABDT<FBAAEDT)&(+$E(FBAAEDT,6,7)=1)):0,1:1)
|
|---|
| 39 | ;
|
|---|
| 40 | SKIPC S FBCOUNT=0
|
|---|
| 41 | ;
|
|---|
| 42 | CONT F I=0:0 S FBNAC=$O(^FBAACNH("AG",DFN,FBVEN,FBNAC)) Q:FBNAC'>0!($P(FBNAC,".")>FBENDDT) S FBRIFN=$O(^FBAACNH("AG",DFN,FBVEN,FBNAC,0)) I $D(^FBAACNH(FBRIFN,0)) S Z=^(0),FBLTT=$P(Z,"^",3) D MORE
|
|---|
| 43 | I FBCOUNT S FBTRDYS=FBTRDYS+(FBENDDT-$P(FBPNAC,".",1))+$S(FBLTT="D":0,FBLTT="T":$S($P(Z,"^",7)<4:0,1:1),1:1),FBTRDYS=$S(FBTRDYS>0:FBTRDYS,((FBAABDT<FBAAEDT)&(+$E(FBAAEDT,6,7)=1)):0,1:1)
|
|---|
| 44 | G ENDACT
|
|---|
| 45 | ;
|
|---|
| 46 | MORE D DISPAC S FBTRDYS=FBTRDYS+($P(FBNAC,".",1)-$P(FBPNAC,".",1)+$S(FBLTT="D":0,FBLTT="T":$S($P(Z,"^",7)<4:0,1:1),1:1)),FBTRDYS=$S(FBTRDYS>0:FBTRDYS,((FBAABDT<FBAAEDT)&(+$E(FBAAEDT,6,7)=1)):0,1:1)
|
|---|
| 47 | AHEAD S FBPNAC=FBNAC,FBLTT=$P(Z,"^",3),FBCOUNT=$S(FBLTT="A":1,FBLTT="T":$S($P(Z,"^",7)>3:1,1:0),1:0)
|
|---|
| 48 | Q
|
|---|
| 49 | ENDACT K FBCOUNT,FBNAC,FBPNAC,FBLTT Q
|
|---|
| 50 | ;
|
|---|
| 51 | GETPRV S FBPRTR="",FBPREV=$O(^FBAACNH("AF",DFN,(9999999-FBPAYDT))) G:FBPREV'>0 PROB^FBNHEP1 S (FBPIFN,FBRIFN)=$O(^(FBPREV,0)),FBPRTR=$G(^FBAACNH(FBPIFN,0))
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | NOAC D GETPRV G:FBPRTR="" ENDACT S Z=FBPRTR,FBNOAC=1
|
|---|
| 55 | W !!,"No movements during payment period. Last transaction prior was:",! D DISPAC
|
|---|
| 56 | I $P(Z,"^",3)="D" W !,*7,"Veteran not provided care during Payment Period!" G ENDACT
|
|---|
| 57 | I $P(Z,"^",3)="T"&($P(Z,"^",7)<4) W !,*7,"Veteran has not been in Nursing Home during Payment Period" G ENDACT
|
|---|
| 58 | S FBTRDYS=$E(FBENDDT,6,7)-$G(FBENDFLG) G ENDACT
|
|---|
| 59 | ;
|
|---|
| 60 | DISPAC S Y=$P(Z,"^"),FBTYPE=$P(Z,"^",3) D PDATE^FBAAUTL,ADD^FBNHDEC:FBTYPE="A",TRAN^FBNHDEC:FBTYPE="T",DIS^FBNHDEC:FBTYPE="D"
|
|---|
| 61 | S FBZ(FBRIFN)=$P($P(Z,"^"),".")_"^"_$S($P(Z,U,3)="A":1,$P(Z,U,3)="T":$S($P(Z,U,7)>3:1,1:0),1:0)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | Q K %DT,FBAAAD,FBAT,FBBDT,FBIFN,FBPDT,FBTDAYS,FBPAYEDT,PSA,DIRUT,DUOUT,DTOUT,FBNOAC,FB,FBZ,FBZZ,FBDEFP,FBBEG,FBEND,FBHI,FBX1,FBAMTP,FBNHAC,DFN,FB583,FBENDFLG
|
|---|
| 65 | G Q^FBNHEP2
|
|---|
| 66 | ;
|
|---|
| 67 | CHKAHD S DIR(0)="Y",DIR("A")="Do you want to continue entering this payment",DIR("B")="No" D ^DIR K DIR G GETVET:Y=0,GETVET:$D(DIRUT),LETSGO
|
|---|
| 68 | Q
|
|---|
