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
ACRFDTP5 ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF LOOKUP AND DISPLAY ROUTINES; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFDTP TO LOOKUP AND DISPLAY FINANCIAL DATA
DISP2 ;EP;TO DISPLAY FINANCIAL DATA
+1 SET ACR10=$SELECT(ACRGREF'["LOCB"&(ACRJ#20'=0)&(ACRJ<20):(ACRJ#20)\2+(ACRJ#2),1:10)
+2 SET ACRI=$ORDER(ACR(0))
+3 FOR ACRI=ACRI:1
IF '$DATA(ACR(ACRI))!$DATA(ACRPSE)
QUIT
DO DISP21
+4 QUIT
DISP21 IF ACRGREF'["OBL"
DO DISP211
+1 IF ACRGREF["OBL"
DO DISP212
+2 XECUTE ACRFDX(5)
+3 IF $DATA(ACRCSIS)
DO ^ACRFCSI
+4 KILL ACR(ACRI)
+5 IF ACRGREF'["LOCB"!$DATA(ACRFDIS)
KILL ACR(ACRI+ACR10)
+6 IF ACRI#10=0
DO PAUSE
IF '$DATA(ACRCONT)
QUIT
+7 QUIT
DISP211 IF $DATA(ACR(ACRI))
Begin DoDot:1
+1 SET ACR=ACR(ACRI)
+2 SET ACRFD(1)=$PIECE(ACR,U)
+3 SET ACRFD11=$PIECE(ACR,U,2)
+4 SET ACRFD21=$PIECE(ACR,U,3)
+5 SET ACRFD31=$PIECE(ACR,U,4)
+6 SET ACRFDX1=$PIECE(ACR,U,5)
+7 SET ACRFY1=$PIECE(ACR,U,6)
End DoDot:1
+8 IF $DATA(ACR(ACRI))
IF ACRGREF["LOCB"
Begin DoDot:1
+9 SET ACRFDX=$PIECE(ACR,U,5)
+10 SET ACRFD2=$PIECE(ACR,U,3)
+11 SET ACRFD1=$PIECE(ACR,U,2)
+12 SET ACRFD3=$PIECE(ACR,U,7)
+13 SET ACRFY=$PIECE(ACR,U,8)
End DoDot:1
+14 IF ACRGREF'["LOCB"
IF $DATA(ACR(ACRI+ACR10))
Begin DoDot:1
+15 SET ACR=ACR(ACRI+ACR10)
+16 SET ACRFD(2)=$PIECE(ACR,U)
+17 SET ACRFD12=$PIECE(ACR,U,2)
+18 SET ACRFD22=$PIECE(ACR,U,3)
+19 SET ACRFD32=$PIECE(ACR,U,4)
+20 SET ACRFDX2=$PIECE(ACR,U,5)
+21 SET ACRFY2=$PIECE(ACR,U,6)
End DoDot:1
+22 IF ACRGREF'["LOCB"
IF '$DATA(ACR(ACRI+1))
IF '$DATA(ACR(ACRI+ACR10))
SET ACRPSE=""
+23 QUIT
DISP212 IF $DATA(ACR(ACRI))
Begin DoDot:1
+1 SET ACR=ACR(ACRI)
+2 SET ACRFD(1)=$PIECE(ACR,U)
+3 SET ACRFD21=$SELECT($PIECE(ACR,U,2)]"":$PIECE(ACR,U,2),1:$PIECE(ACR,U,3))
+4 SET ACRID1=$EXTRACT($PIECE(ACR,U,4),1,15)
+5 SET ACRDISA1=$PIECE(ACR,U,5)
+6 SET ACRPRR1=$PIECE(ACR,U,7)
+7 SET ACRFY1=$PIECE(ACR,U,8)
+8 IF $DATA(ACRPRT)
SET ACRPRTX($PIECE(ACR,U))=""
End DoDot:1
+9 IF $DATA(ACR(ACRI+ACR10))
Begin DoDot:1
+10 SET ACR=ACR(ACRI+ACR10)
+11 SET ACRFD(2)=$PIECE(ACR,U)
+12 SET ACRFD22=$SELECT($PIECE(ACR,U,2)]"":$PIECE(ACR,U,2),1:$PIECE(ACR,U,3))
+13 SET ACRID2=$EXTRACT($PIECE(ACR,U,4),1,15)
+14 SET ACRDISA2=$PIECE(ACR,U,5)
+15 SET ACRPRR2=$PIECE(ACR,U,7)
+16 SET ACRFY2=$PIECE(ACR,U,8)
+17 IF $DATA(ACRPRT)
SET ACRPRTX($PIECE(ACR,U))=""
End DoDot:1
+18 IF '$DATA(ACR(ACRI+1))
IF '$DATA(ACR(ACRI+ACR10))
SET ACRPSE=""
+19 QUIT
PAUSE KILL ACRPSE,ACRCONT
+1 IF $DATA(ACRCSIS)
IF $EXTRACT(IOST,1,2)="P-"
SET ACRCONT=""
WRITE !
QUIT
+2 SET DIR(0)="YO"
+3 SET DIR("B")="YES"
+4 SET DIR("A")=" List more "_ACRTYPS_"S"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF Y=1
Begin DoDot:1
+8 SET ACRCONT=""
+9 SET ACRI=ACRI+ACR10
+10 WRITE !
End DoDot:1
IF 1
+11 IF '$TEST
SET ACRPSE=""
+12 QUIT
TOT ;EP;CALCULATE TOTAL AMOUNT DISTRIBUTED
+1 NEW ACR,ACRG
+2 SET ACRG=$SELECT(ACRGREF["ACRAPP":"^ACRALW",ACRGREF["ACRALW":"^ACRALC",1:"^ACRLOCB")
+3 SET (ACR,ACRFTOT)=0
+4 FOR
SET ACR=$ORDER(@ACRG@("M",ACRFD,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+5 IF $PIECE(@ACRG@(ACR,0),U,8)="D"
SET ACRFTOT=ACRFTOT-$GET(@ACRG@(ACR,0))
+6 IF $PIECE(@ACRG@(ACR,0),U,8)'="D"
SET ACRFTOT=ACRFTOT+$GET(@ACRG@(ACR,0))
End DoDot:1
+7 QUIT
AMEND ;EP;FOR AMENDING A REQUEST
+1 NEW ACRAMEND,ACRAMT
+2 SET ACRAMEND=0
+3 FOR
SET ACRAMEND=$ORDER(@ACRGREF@("ORIG",ACRFD,ACRAMEND))
IF 'ACRAMEND
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(@ACRGREF@(ACRAMEND,0)),U,22)
IF $PIECE(^(0),U,22)>DT
QUIT
+5 SET ACRAMT=$SELECT($PIECE($GET(@ACRGREF@(ACRAMEND,0)),U,8)'="D":1,1:-1)
+6 IF $GET(ACRENTRY)'["OBL"
IF ACRFD'=ACRAMEND
SET ACRFDX=ACRFDX+(ACRAMT*$PIECE(@ACRGREF@(ACRAMEND,0),U))
+7 IF $GET(ACRENTRY)["OBL"
SET ACRFDX=ACRFDX+(ACRAMT*$PIECE(@ACRGREF@(ACRAMEND,0),U))
End DoDot:1
+8 QUIT
