43 lines
2.5 KiB
Mathematica
43 lines
2.5 KiB
Mathematica
FBNHPC1 ;AISC/CMR-POST COMMITMENTS TO 1358 cont. ;9/20/94
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
CHECK S ^XTMP("FBPOST",FBIFN)=""
|
|
Q:$E(FBPAYDT,1,5)<$E(FBABD,1,5)
|
|
S FBTRDYS=0 K FBELSE
|
|
S FBERR="" D GETRAT^FBNHEP2 Q:FBERR D CHECK^FBNHEP2 Q:FBERR
|
|
S FBIFN=FBHIFN
|
|
D
|
|
.I $E(FBABD,1,5)<$E(FBPAYDT,1,5)&($E(FBDD,1,5)>$E(FBPAYDT,1,5)) S FBTRDYS=FBDAYS D CALC Q
|
|
.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
|
|
.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
|
|
.I FBABD=FBDD S FBTRDYS=1 D CALC Q
|
|
.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
|
|
Q:$D(FBELSE)
|
|
;ifcap calls for posting
|
|
I 'FBNHCC,$D(^PRC(424,"E",+$P(FBZ,"^",3)_";"_+FBIFN_";"_$P(FBOBN,"-",2)_";"_FBMM)) Q
|
|
S FBSEQ="" I 'FBNHCC S X=FBOBN,PRCS("TYPE")="FB" D EN1^PRCSUT31 Q:Y="" S FBSEQ=Y
|
|
S DFN=$P(FBZ,"^",3),FBNAME=$$NAME^FBCHREQ2(DFN),FBSSN=$$SSN^FBAAUTL(DFN),FBVEN=$P(FBZ,"^",2)
|
|
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
|
|
I 'FBNHCC G:+Y=0 ERR^FBNHPC
|
|
S FBTOTAL=FBTOTAL+FBTRDYS,FBTOT=FBTOT+FBDEFP,FBCNT=FBCNT+1
|
|
S ^TMP($J,"FBNHPC",FBNAME,FBCNT)=FBSSN_"^"_FBTRDYS_"^"_FBDEFP_"^"_$G(FBSEQ)_"^"_+FBVEN
|
|
Q
|
|
;
|
|
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
|
|
.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)
|
|
.I $Y+3>IOSL,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR S:'Y FBOUT=1 Q:FBOUT
|
|
.I ($Y+3)>IOSL W @IOF D HED
|
|
.W !,FBSEQ,?7,$E(FBNAME,1,20),?30,FBSSN,?44,$E($$VNAME^FBNHEXP(FBVEN),1,20),?66,FBTRDYS,?70,$J($FN(FBDEFP,",",2),10)
|
|
Q
|
|
;
|
|
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",!
|
|
S I="",$P(I,"-",59)="-" W ?10,I K I W !
|
|
I FBNHCC W ?5,"Estimated Funds for: ",$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+FBMM)," ",FBYY,!!
|
|
I 'FBNHCC W ?5,"Postings for Obligation Number: ",$P(FBOBN,"-",2),!!,"Ref #"
|
|
W ?7,"Veteran",?30,"SSN",?44,"Vendor",?65,"Days",?74,"Total",!,Q,!
|
|
Q
|
|
;
|
|
CALC S FBENDFLG=$S(FBDD'>FBENDDT:1,1:""),FBENDDT=$S(FBDD>FBENDDT:FBENDDT,1:FBDD),FBAABDT=FBABD D CALC^FBNHEP2
|
|
S FBENDDT=FBPAYEDT K FB
|
|
Q
|