| 1 | FBNHAMI1 ;AISC/CMR-CALCULATE/VALIDATE AMIS 349 ;11/18/94
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEXT ;
|
|---|
| 5 | F FBDD=FBPAYDT:0 S FBDD=$O(^FB7078("AD",7,FBDD)) Q:FBDD'>0 F FBIFN=0:0 S FBIFN=$O(^FB7078("AD",7,FBDD,FBIFN)) Q:FBIFN'>0 S FBZ=$G(^FB7078(FBIFN,0)) I $P(FBZ,U,9)'="DC",($P(FBZ,U,4)'>FBENDDT) D
|
|---|
| 6 | .S DFN=+$P(FBZ,"^",3),IFN=+$P(FBZ,"^",2) D MORE I $G(FBCUR) S TOTDAYS=TOTDAYS+FBTRDYS D TMP(15) S FBTRDYS=0
|
|---|
| 7 | Q:'$G(FBCUR)
|
|---|
| 8 | S TOTDAYS=$FN(TOTDAYS,",",0) D ^FBNHPAMS G END^FBNHAMIS
|
|---|
| 9 | MORE K FB S FBNAC=$O(^FBAACNH("AG",DFN,IFN,FBPAYDT)) G:'FBNAC!($P(FBNAC,".")>FBENDDT) NOAC
|
|---|
| 10 | F FBNAC=FBPAYDT:0 S FBNAC=$O(^FBAACNH("AG",DFN,IFN,FBNAC)) Q:'FBNAC!(FBNAC>FBENDDT) F FBRIFN=0:0 S FBRIFN=$O(^FBAACNH("AG",DFN,IFN,FBNAC,FBRIFN)) Q:'FBRIFN S Z=$G(^FBAACNH(FBRIFN,0)),Z(0)=$P(Z,"^",3) D
|
|---|
| 11 | .N FBZZ S FBZZ=$S(Z(0)="A":+$P(Z,"^",10),1:+$P(^FBAACNH($P(Z,"^",5),0),"^",10)) Q:'$D(^FBAAA("AG",FBIFN_";FB7078(",DFN,FBZZ))
|
|---|
| 12 | .S FB(FBRIFN)=FBNAC\1_"^"_Z(0)_"^"_$S(Z(0)="A":9,Z(0)="D":0,1:$P(Z,"^",7))
|
|---|
| 13 | S I=0,FBPNAC=FBPAYDT+1,(FBPSW,FBSW)=""
|
|---|
| 14 | F S I=$O(FB(I)) Q:'I D:$P(FB(I),"^")'>FBENDDT
|
|---|
| 15 | .S FBNAC=$P(FB(I),"^"),FBSW=$P(FB(I),"^",3) I FBSW<4&(FBPSW="") D
|
|---|
| 16 | ..S FBPREV=$O(^FBAACNH("AF",+DFN,(9999999.9999-FBPAYDT))) Q:'FBPREV S FBPREV=$O(^(FBPREV,0)),Z=$G(^FBAACNH(+FBPREV,0)),Z(0)=$P(Z,"^",3),FBPSW=$S(Z(0)="A":9,Z(0)="D":0,1:$P(Z,"^",7))
|
|---|
| 17 | .S:FBSW<4&(FBPSW>3!(FBPSW="")) FBTRDYS=FBTRDYS+$S((FBNAC-FBPNAC)>0:(FBNAC-FBPNAC),((FBPSW>3)&(+$E(FBNAC,6,7)=1)&(FBNAC'=+$P(Z,"."))):0,1:1) S FBPNAC=FBNAC,FBPSW=FBSW
|
|---|
| 18 | I FBSW>3 S FBTRDYS=FBTRDYS+$S((FBENDDT\1-FBNAC)>0:(FBENDDT\1-FBNAC),FBENDDT\1=FBNAC:0,1:1),FBTRDYS=$S(FBTRDYS>0:(FBTRDYS+1),1:1) D
|
|---|
| 19 | .S FBR(1)=FBR(1)+1 D TMP(9)
|
|---|
| 20 | .I $P($G(^DPT(+DFN,0)),"^",2)="F" S FBFEM=FBFEM+1 D TMP(12)
|
|---|
| 21 | I FBSW<4 D
|
|---|
| 22 | .I $S(FBSW=1:1,FBSW=2:1,1:0) S FBR(2)=FBR(2)+1 D TMP(10)
|
|---|
| 23 | .I FBSW=3 S FBR(3)=FBR(3)+1 D TMP(11)
|
|---|
| 24 | I $D(FB) D ERR
|
|---|
| 25 | Q
|
|---|
| 26 | NOAC S FBPREV=$O(^FBAACNH("AF",DFN,(9999999.9999-FBPAYDT))) Q:'FBPREV S FBPIFN=$O(^(FBPREV,0)),Z=$G(^FBAACNH(FBPIFN,0)) Q:$P(Z,"^",3)="D" S Z(0)=$P(Z,"^",3)
|
|---|
| 27 | N FBZZ S FBZZ=$S(Z(0)="A":+$P(Z,"^",10),1:+$P(^FBAACNH($P(Z,"^",5),0),"^",10))
|
|---|
| 28 | Q:'$D(^FBAAA("AG",FBIFN_";FB7078(",DFN,FBZZ))
|
|---|
| 29 | D ERR
|
|---|
| 30 | I $P(Z,"^",3)="T"&($P(Z,"^",7)<4) S:$P(Z,"^",7)=3 FBR(3)=FBR(3)+1 D TMP(11) Q
|
|---|
| 31 | S FBTRDYS=FBDAYS,FBR(1)=FBR(1)+1 D TMP(9)
|
|---|
| 32 | I $P($G(^DPT(+DFN,0)),"^",2)="F" S FBFEM=FBFEM+1 D TMP(12)
|
|---|
| 33 | I $S($P(Z,"^",7)=1:1,$P(Z,"^",7)=2:1,1:0) S FBR(2)=FBR(2)+1 D TMP(10)
|
|---|
| 34 | Q
|
|---|
| 35 | TMP(X) ;set tmp
|
|---|
| 36 | Q:'X!('$G(FBCUR))!('$G(FBVAL))
|
|---|
| 37 | S ^TMP($J,"FBAMIS",X,FBIFN)=$S(X=15:FBTRDYS,1:"")
|
|---|
| 38 | Q
|
|---|
| 39 | ERR ;check if authorization to date has been exceeded
|
|---|
| 40 | Q:FBDD>FBENDDT
|
|---|
| 41 | N FBDATE,FBIEN,FBZM
|
|---|
| 42 | S FBER(DFN,FBDD)=$G(FBCUR)
|
|---|
| 43 | S FBDATE=$S($P(FBZ,U,4)>FBPAYDT:$P(FBZ,U,4),1:FBPAYDT)
|
|---|
| 44 | F S FBDATE=$O(^FBAACNH("AG",DFN,IFN,FBDATE)) Q:'FBDATE!(FBDATE>($E(FBDD,1,7)_.9999)) S FBIEN=0 F S FBIEN=$O(^FBAACNH("AG",DFN,IFN,FBDATE,FBIEN)) Q:'FBIEN S FBZM=$G(^FBAACNH(FBIEN,0)) D:$P(FBZM,"^",3)["D" K FBZM
|
|---|
| 45 | .S FBZZ=+$P(^FBAACNH($P(FBZM,"^",5),0),"^",10) I $D(^FBAAA("AG",FBIFN_";FB7078(",DFN,FBZZ)) K FBER(DFN,FBDD)
|
|---|
| 46 | Q
|
|---|
