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

ACRFDTP5.m

Go to the documentation of this file.
ACRFDTP5 ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF LOOKUP AND DISPLAY ROUTINES;  [ 11/01/2001   9:44 AM ]
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
 ;;CONTINUATION OF ACRFDTP TO LOOKUP AND DISPLAY FINANCIAL DATA
DISP2 ;EP;TO DISPLAY FINANCIAL DATA
 S ACR10=$S(ACRGREF'["LOCB"&(ACRJ#20'=0)&(ACRJ<20):(ACRJ#20)\2+(ACRJ#2),1:10)
 S ACRI=$O(ACR(0))
 F ACRI=ACRI:1 Q:'$D(ACR(ACRI))!$D(ACRPSE)  D DISP21
 Q
DISP21 D DISP211:ACRGREF'["OBL"
 D DISP212:ACRGREF["OBL"
 X ACRFDX(5)
 D:$D(ACRCSIS) ^ACRFCSI
 K ACR(ACRI)
 K:ACRGREF'["LOCB"!$D(ACRFDIS) ACR(ACRI+ACR10)
 I ACRI#10=0 D PAUSE Q:'$D(ACRCONT)
 Q
DISP211 I $D(ACR(ACRI)) D
 .S ACR=ACR(ACRI)
 .S ACRFD(1)=$P(ACR,U)
 .S ACRFD11=$P(ACR,U,2)
 .S ACRFD21=$P(ACR,U,3)
 .S ACRFD31=$P(ACR,U,4)
 .S ACRFDX1=$P(ACR,U,5)
 .S ACRFY1=$P(ACR,U,6)
 I $D(ACR(ACRI)),ACRGREF["LOCB" D
 .S ACRFDX=$P(ACR,U,5)
 .S ACRFD2=$P(ACR,U,3)
 .S ACRFD1=$P(ACR,U,2)
 .S ACRFD3=$P(ACR,U,7)
 .S ACRFY=$P(ACR,U,8)
 I ACRGREF'["LOCB",$D(ACR(ACRI+ACR10)) D
 .S ACR=ACR(ACRI+ACR10)
 .S ACRFD(2)=$P(ACR,U)
 .S ACRFD12=$P(ACR,U,2)
 .S ACRFD22=$P(ACR,U,3)
 .S ACRFD32=$P(ACR,U,4)
 .S ACRFDX2=$P(ACR,U,5)
 .S ACRFY2=$P(ACR,U,6)
 I ACRGREF'["LOCB",'$D(ACR(ACRI+1)),'$D(ACR(ACRI+ACR10)) S ACRPSE=""
 Q
DISP212 I $D(ACR(ACRI)) D
 .S ACR=ACR(ACRI)
 .S ACRFD(1)=$P(ACR,U)
 .S ACRFD21=$S($P(ACR,U,2)]"":$P(ACR,U,2),1:$P(ACR,U,3))
 .S ACRID1=$E($P(ACR,U,4),1,15)
 .S ACRDISA1=$P(ACR,U,5)
 .S ACRPRR1=$P(ACR,U,7)
 .S ACRFY1=$P(ACR,U,8)
 .S:$D(ACRPRT) ACRPRTX($P(ACR,U))=""
 I $D(ACR(ACRI+ACR10)) D
 .S ACR=ACR(ACRI+ACR10)
 .S ACRFD(2)=$P(ACR,U)
 .S ACRFD22=$S($P(ACR,U,2)]"":$P(ACR,U,2),1:$P(ACR,U,3))
 .S ACRID2=$E($P(ACR,U,4),1,15)
 .S ACRDISA2=$P(ACR,U,5)
 .S ACRPRR2=$P(ACR,U,7)
 .S ACRFY2=$P(ACR,U,8)
 .S:$D(ACRPRT) ACRPRTX($P(ACR,U))=""
 I '$D(ACR(ACRI+1)),'$D(ACR(ACRI+ACR10)) S ACRPSE=""
 Q
PAUSE K ACRPSE,ACRCONT
 I $D(ACRCSIS),$E(IOST,1,2)="P-" S ACRCONT="" W ! Q
 S DIR(0)="YO"
 S DIR("B")="YES"
 S DIR("A")="          List more "_ACRTYPS_"S"
 W !
 D DIR^ACRFDIC
 I Y=1 D  I 1
 .S ACRCONT=""
 .S ACRI=ACRI+ACR10
 .W !
 E  S ACRPSE=""
 Q
TOT ;EP;CALCULATE TOTAL AMOUNT DISTRIBUTED
 N ACR,ACRG
 S ACRG=$S(ACRGREF["ACRAPP":"^ACRALW",ACRGREF["ACRALW":"^ACRALC",1:"^ACRLOCB")
 S (ACR,ACRFTOT)=0
 F  S ACR=$O(@ACRG@("M",ACRFD,ACR)) Q:'ACR  D
 .I $P(@ACRG@(ACR,0),U,8)="D" S ACRFTOT=ACRFTOT-$G(@ACRG@(ACR,0))
 .I $P(@ACRG@(ACR,0),U,8)'="D" S ACRFTOT=ACRFTOT+$G(@ACRG@(ACR,0))
 Q
AMEND ;EP;FOR AMENDING A REQUEST
 N ACRAMEND,ACRAMT
 S ACRAMEND=0
 F  S ACRAMEND=$O(@ACRGREF@("ORIG",ACRFD,ACRAMEND)) Q:'ACRAMEND  D
 .I $P($G(@ACRGREF@(ACRAMEND,0)),U,22),$P(^(0),U,22)>DT Q
 .S ACRAMT=$S($P($G(@ACRGREF@(ACRAMEND,0)),U,8)'="D":1,1:-1)
 .I $G(ACRENTRY)'["OBL" S:ACRFD'=ACRAMEND ACRFDX=ACRFDX+(ACRAMT*$P(@ACRGREF@(ACRAMEND,0),U))
 .I $G(ACRENTRY)["OBL" S ACRFDX=ACRFDX+(ACRAMT*$P(@ACRGREF@(ACRAMEND,0),U))
 Q