| 1 | FBNHPC1 ;AISC/CMR-POST COMMITMENTS TO 1358 cont. ;9/20/94
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | CHECK S ^XTMP("FBPOST",FBIFN)=""
|
|---|
| 5 | Q:$E(FBPAYDT,1,5)<$E(FBABD,1,5)
|
|---|
| 6 | S FBTRDYS=0 K FBELSE
|
|---|
| 7 | S FBERR="" D GETRAT^FBNHEP2 Q:FBERR D CHECK^FBNHEP2 Q:FBERR
|
|---|
| 8 | S FBIFN=FBHIFN
|
|---|
| 9 | D
|
|---|
| 10 | .I $E(FBABD,1,5)<$E(FBPAYDT,1,5)&($E(FBDD,1,5)>$E(FBPAYDT,1,5)) S FBTRDYS=FBDAYS D CALC Q
|
|---|
| 11 | .I $E(FBABD,1,5)<$E(FBPAYDT,1,5)&($E(FBDD,1,5)'>$E(FBPAYDT,1,5)) S FBTRDYS=$E(FBDD,6,7)-1,FBTRDYS=$S(FBTRDYS>0:FBTRDYS,1:0) S:FBTRDYS'>0 FBELSE=1 D CALC Q
|
|---|
| 12 | .I $E(FBABD,1,5)=$E(FBPAYDT,1,5)&($E(FBDD,1,5)>$E(FBPAYDT,1,5)) S FBTRDYS=(FBDAYS-$E(FBABD,6,7))+1 D CALC Q
|
|---|
| 13 | .I FBABD=FBDD S FBTRDYS=1 D CALC Q
|
|---|
| 14 | .I $E(FBABD,1,5)=$E(FBPAYDT,1,5)&($E(FBDD,1,5)'>$E(FBPAYDT,1,5)) S FBTRDYS=FBDD-FBABD,FBTRDYS=$S(FBTRDYS>0:FBTRDYS,1:0) S:FBTRDYS'>0 FBELSE=1 D CALC Q
|
|---|
| 15 | Q:$D(FBELSE)
|
|---|
| 16 | ;ifcap calls for posting
|
|---|
| 17 | I 'FBNHCC,$D(^PRC(424,"E",+$P(FBZ,"^",3)_";"_+FBIFN_";"_$P(FBOBN,"-",2)_";"_FBMM)) Q
|
|---|
| 18 | S FBSEQ="" I 'FBNHCC S X=FBOBN,PRCS("TYPE")="FB" D EN1^PRCSUT31 Q:Y="" S FBSEQ=Y
|
|---|
| 19 | S DFN=$P(FBZ,"^",3),FBNAME=$$NAME^FBCHREQ2(DFN),FBSSN=$$SSN^FBAAUTL(DFN),FBVEN=$P(FBZ,"^",2)
|
|---|
| 20 | S PRCS("TYPE")="FB" I 'FBNHCC D NOW^%DTC S FBPOSDT=%,X=FBOBN_"^"_FBPOSDT_"^"_FBDEFP_"^^"_FBSEQ_"^"_FBNAME_" ("_FBSSN_")"_"^"_+DFN_";"_+FBIFN_";"_$P(FBOBN,"-",2)_";"_FBMM D EN2^PRCS58
|
|---|
| 21 | I 'FBNHCC G:+Y=0 ERR^FBNHPC
|
|---|
| 22 | S FBTOTAL=FBTOTAL+FBTRDYS,FBTOT=FBTOT+FBDEFP,FBCNT=FBCNT+1
|
|---|
| 23 | S ^TMP($J,"FBNHPC",FBNAME,FBCNT)=FBSSN_"^"_FBTRDYS_"^"_FBDEFP_"^"_$G(FBSEQ)_"^"_+FBVEN
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PRT S FBNAME="" F S FBNAME=$O(^TMP($J,"FBNHPC",FBNAME)) Q:FBNAME']""!($G(FBOUT)) F FBCNT=0:0 S FBCNT=$O(^TMP($J,"FBNHPC",FBNAME,FBCNT)) Q:'FBCNT!($G(FBOUT)) D
|
|---|
| 27 | .S Y(0)=$G(^TMP($J,"FBNHPC",FBNAME,FBCNT)),FBSSN=$P(Y(0),"^"),FBTRDYS=$P(Y(0),"^",2),FBDEFP=$P(Y(0),"^",3),FBSEQ=$P(Y(0),"^",4),FBVEN=$P(Y(0),"^",5)
|
|---|
| 28 | .I $Y+3>IOSL,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR S:'Y FBOUT=1 Q:FBOUT
|
|---|
| 29 | .I ($Y+3)>IOSL W @IOF D HED
|
|---|
| 30 | .W !,FBSEQ,?7,$E(FBNAME,1,20),?30,FBSSN,?44,$E($$VNAME^FBNHEXP(FBVEN),1,20),?66,FBTRDYS,?70,$J($FN(FBDEFP,",",2),10)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | HED W !?11,"C O M M U N I T Y N U R S I N G H O M E R E P O R T",!
|
|---|
| 34 | S I="",$P(I,"-",59)="-" W ?10,I K I W !
|
|---|
| 35 | I FBNHCC W ?5,"Estimated Funds for: ",$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+FBMM)," ",FBYY,!!
|
|---|
| 36 | I 'FBNHCC W ?5,"Postings for Obligation Number: ",$P(FBOBN,"-",2),!!,"Ref #"
|
|---|
| 37 | W ?7,"Veteran",?30,"SSN",?44,"Vendor",?65,"Days",?74,"Total",!,Q,!
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | CALC S FBENDFLG=$S(FBDD'>FBENDDT:1,1:""),FBENDDT=$S(FBDD>FBENDDT:FBENDDT,1:FBDD),FBAABDT=FBABD D CALC^FBNHEP2
|
|---|
| 41 | S FBENDDT=FBPAYEDT K FB
|
|---|
| 42 | Q
|
|---|
