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
ACRFEOY ;IHS/OIRM/DSD/THL,AEF - CALCULATE % OF YR REMAINING; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO CALCULATE % OF YR REMAINING
EN DO EOY
EXIT ;
+1 QUIT
EOY ;EP;
+1 DO NOW^%DTC
+2 SET X1=$EXTRACT(X,1,3)_"0930"
+3 IF $EXTRACT($PIECE(X,"."),4,5)>9
SET X1=X1+10000
+4 SET X2=X
+5 DO ^%DTC
+6 SET ACRYRM=(X/365)*100
+7 IF ACRYRM["."
SET ACRYRM=$SELECT($EXTRACT($PIECE(ACRYRM,".",2))>4:$PIECE(ACRYRM,"."),1:($PIECE(ACRYRM,".")+1))
+8 IF ACRYRM>100
SET ACRYRM=100
+9 QUIT
EOQ SET ACREOQ="1231^0331^0630^0930"
+1 DO NOW^%DTC
+2 SET X2=X
+3 SET ACRFY=$SELECT(ACRFDNQ=1:ACRFDNFY-1,1:ACRFDNFY)
+4 SET X=$PIECE(ACREOQ,U,ACRFDNQ)_ACRFY
SET %DT=""
DO ^%DT
SET X1=Y
+5 IF X2>X1
SET X2=X1
+6 DO ^%DTC
+7 SET ACRQRM=(X/91.25)*100
+8 IF ACRQRM["."
SET ACRQRM=$SELECT($EXTRACT($PIECE(ACRQRM,".",2))>4:$PIECE(ACRQRM,"."),1:($PIECE(ACRQRM,".")+1))
+9 IF ACRQRM>100
SET ACRQRM=100
+10 QUIT