Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFEOY

ACRFEOY.m

Go to the documentation of this file.
ACRFEOY ;IHS/OIRM/DSD/THL,AEF - CALCULATE % OF YR REMAINING; [ 11/01/2001   9:44 AM ]
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
 ;;ROUTINE TO CALCULATE % OF YR REMAINING
EN D EOY
EXIT ;
 Q
EOY ;EP;
 D NOW^%DTC
 S X1=$E(X,1,3)_"0930"
 S:$E($P(X,"."),4,5)>9 X1=X1+10000
 S X2=X
 D ^%DTC
 S ACRYRM=(X/365)*100
 S:ACRYRM["." ACRYRM=$S($E($P(ACRYRM,".",2))>4:$P(ACRYRM,"."),1:($P(ACRYRM,".")+1))
 S:ACRYRM>100 ACRYRM=100
 Q
EOQ S ACREOQ="1231^0331^0630^0930"
 D NOW^%DTC
 S X2=X
 S ACRFY=$S(ACRFDNQ=1:ACRFDNFY-1,1:ACRFDNFY)
 S X=$P(ACREOQ,U,ACRFDNQ)_ACRFY,%DT="" D ^%DT S X1=Y
 S:X2>X1 X2=X1
 D ^%DTC
 S ACRQRM=(X/91.25)*100
 S:ACRQRM["." ACRQRM=$S($E($P(ACRQRM,".",2))>4:$P(ACRQRM,"."),1:($P(ACRQRM,".")+1))
 S:ACRQRM>100 ACRQRM=100
 Q