ACRFFDS ;IHS/DSD/THL,AEF - FUNDS DISTRIBUTION SUMMARIES; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
Q
LOCATION ;EP;TO SUMMARIZE SUB ALLOWANCES BY LOCATION
D LEXIT
D L1
LEXIT K ^TMP("ACRGLOC",$J),ACR,ACRFY,ACRLOC,ACRQUIT,ACROUT,ACRSSN,ACRSSA,ACRLCOD,ACRJ,ACRRTN,ACRT1,ACRT2,ACRT3,ACRT4,ACRY,ACRZDA,ACR1,ACR2,ACRDC,ACRFUNDS
Q
L1 D SLOC
Q:$D(ACRQUIT)
S (ACRRTN,ZTRTN)="PLOC^ACRFFDS"
S ZTDESC="SUB-ALLOWANCE DISTRIBUTION SUMMARY"
D ^ACRFZIS
Q
SLOC ;SELECT LOCATIONS
;
S DIR(0)="NO^1000:9999"
S DIR("A")="Fiscal Year"
S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
W !
D DIR^ACRFDIC
Q:Y'?4N
S ACRFY=Y
S DIR(0)="SO^1:Summarize by LOCATION;2:Summarize by SUB-SUB-ACTIVITY"
S DIR("A")="Which summary"
W !
D DIR^ACRFDIC
Q:Y<1
S ACRFUNDS=$S(Y=1:1,1:2)
I ACRFUNDS=1 D I 1
.S DIR(0)="SO^1:ALL Locations;2:Selected Locations"
.S DIR("A")="ALL or Selected Locations"
.S DIR("B")="All Locations"
I ACRFUNDS=2 D
.S DIR(0)="SO^1:ALL Sub-Sub-Activities;2:Selected Sub-Sub-Activities"
.S DIR("A")="Which one"
.S DIR("B")="ALL Sub-Sub-Activities"
W !
D DIR^ACRFDIC
Q:'Y
I Y=1 S ACRLOC="ALL" Q
S ACRJ=0
S ACRLOC=""
F D SL1 Q:$D(ACRQUIT)!$D(ACROUT)
Q:$G(ACRLOC)=""
K ACRQUIT
Q
SL1 ;SELECT SPECIFIC LOCATIONS
I ACRFUNDS=1 D I 1
.S DIC="^AUTTLCOD("
.S DIC(0)="AEMQZ"
.S DIC("A")="Which LOCATION: "
.S:ACRJ>1 DIC("A")="Next Location: "
I ACRFUNDS=2 D I 1
.S DIC="^AUTTSSA("
.S DIC(0)="AEMQZ"
.S DIC("A")="Which Sub-Sub-Activity: "
.S:ACRJ>1 DIC("A")="Next Sub-Sub-Activity: "
W !
D DIC^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ACRJ=ACRJ+1
S ACRLOC=ACRLOC_+Y_","
Q
Q
GLOC ;GATHER DATA INTO TEMP GLOBAL
N ACR ;,X
S ACR=0
I ACRLOC'="ALL" D Q
.F ACRJ=1:1 S ACR=$P(ACRLOC,",",ACRJ) Q:ACR="" D GL1
S ACRZDA=0
F S ACRZDA=$O(^ACRALC("FY",ACRFY,ACRZDA)) Q:'ACRZDA D
.S X=$G(^ACRALC(ACRZDA,"DT"))
.I $P(X,U,11),$P(X,U,8),$P(^ACRALC(ACRZDA,0),U,8)="O" D ID
Q
GL1 S ACRXREF=$S(ACRFUNDS=1:"LCODE",1:"SS")
S ACRZDA=0
F S ACRZDA=$O(^ACRALC(ACRXREF,ACR,ACRZDA)) Q:'ACRZDA D
.S X=$G(^ACRALC(ACRZDA,"DT"))
.I $P(X,U)=ACRFY,$P(X,U,8),$P(^ACRALC(ACRZDA,0),U,8)="O" D ID
Q
ID ;CALCULATE INCREASES AND DECREASES
S ACRSSN=$P($G(^AUTTSSA(+$P(X,U,8),0)),U,3)
S ACRSSA=$P($G(^AUTTSSA(+$P(X,U,8),0)),U,4)
S ACRLCOD=$P($G(^AUTTLCOD(+$P(X,U,11),0)),U)
Q:ACRSSA=""!(ACRSSN="")!(ACRLCOD="")
I ACRFUNDS=1 S ACR1=ACRLCOD,ACR2=ACRSSN
I ACRFUNDS=2 S ACR1=ACRSSN,ACR2=ACRLCOD
S ^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)=+^ACRALC(ACRZDA,0),X=^(ACRZDA)
S ^TMP("ACRGLOC",$J,ACR1)=ACRSSA
S ^TMP("ACRGLOC",$J,ACR1,ACR2)=ACRSSA
S ACRX=0
F S ACRX=$O(^ACRALC("ORIG",ACRZDA,ACRX)) Q:'ACRX D
.S Y=^ACRALC(ACRX,0)
.S Z=$P(^ACRALC(ACRX,"DT"),U,3)
.S $P(X,U,$S(Z="R":2,1:3))=$P(X,U,$S(Z="R":2,1:3))+($S($P(Y,U,9)="I":1,1:-1)*+Y)
S ^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)=X
Q
PLOC ;EP;TO PRINT SUB-ALLOWANCE DISTRIBUTION SUMMARY
D PL1
D LEXIT
Q
PL1 D GLOC
Q:'$D(^TMP("ACRGLOC",$J))
S ACR1=""
F S ACR1=$O(^TMP("ACRGLOC",$J,ACR1)) Q:ACR1=""!$D(ACRQUIT) D
.D LHEAD
.S (ACRT1,ACRT2,ACRT3,ACRT4)=0
.S ACR2=""
.F S ACR2=$O(^TMP("ACRGLOC",$J,ACR1,ACR2)) Q:ACR2=""!$D(ACRQUIT) D
..S ACR3=^TMP("ACRGLOC",$J,ACR1,ACR2)
..S ACRZDA=""
..F S ACRZDA=$O(^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)) Q:'ACRZDA!$D(ACRQUIT) S X=^(ACRZDA) D
...S ACRT1=ACRT1+$P(X,U)
...S ACRT2=ACRT2+$P(X,U,2)
...S ACRT3=ACRT3+$P(X,U)+$P(X,U,2)
...S ACRT4=ACRT4+$P(X,U,4)
...I ACRFUNDS=2 S ACR3=$P($G(^AUTTLCOD(+$O(^AUTTLCOD("B",ACR2,0)),0)),U,2)
...W !,$E(ACR3,1,15),?15,"|",$J($FN($P(X,U),"P,"),13),?29,"|",$J($FN($P(X,U,2),"P,"),11),?41,"|",$J($FN($P(X,U)+$P(X,U,2),"P,"),13),?55,"|",$J($FN($P(X,U,3),"P,"),10),?66,"|",$J($FN($P(X,U)+$P(X,U,2)+$P(X,U,3),"P,"),13)
...I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D LHEAD
.D LTAIL
Q
LHEAD ;HEADER
W @IOF
S ACRDC=$G(ACRDC)+1
W !,"DISTRIBUTION OF FUNDS SUMAMRY"
W !,"-----------------------------"
W !,"FISCAL YEAR: ",ACRFY,?55,"PAGE: ",ACRDC
W !,"REPORT DATE: "
S Y=DT
X ^DD("DD")
W Y
I ACRFUNDS=1 W !,"LOCATION...: ",ACR1,?$X+3,$P($G(^AUTTLCOD(+$O(^AUTTLCOD("B",ACR1,0)),0)),U,2)
I ACRFUNDS=2 W !,"SUB-SUB-ACT: ",ACR1,?$X+3,^TMP("ACRGLOC",$J,ACR1)
W $$DASH^ACRFMENU
W !?15,"|",?25,"RECURRING",?41,"| TOTAL",?55,"| NON-",?66,"|"
W !,$S(ACRFUNDS=1:"ACTIVITY",1:"LOCATION")
W ?15,"| BASE",?29,"| INC/DEC",?41,"| RECURRING",?55,"| RECURRING",?66,"| TOTAL"
W !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
Q
LTAIL ;
W !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
W !?15,"|",$J($FN(ACRT1,"P,"),13),?29,"|",$J($FN(ACRT2,"P,"),11),?41,"|",$J($FN(ACRT3,"P,"),13),?55,"|",$J($FN(ACRT4,"P,"),10),?66,"|",$J($FN(ACRT3+ACRT4,"P,"),13)
D PAUSE^ACRFWARN
Q
ACRFFDS ;IHS/DSD/THL,AEF - FUNDS DISTRIBUTION SUMMARIES; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 QUIT
LOCATION ;EP;TO SUMMARIZE SUB ALLOWANCES BY LOCATION
+1 DO LEXIT
+2 DO L1
LEXIT KILL ^TMP("ACRGLOC",$JOB),ACR,ACRFY,ACRLOC,ACRQUIT,ACROUT,ACRSSN,ACRSSA,ACRLCOD,ACRJ,ACRRTN,ACRT1,ACRT2,ACRT3,ACRT4,ACRY,ACRZDA,ACR1,ACR2,ACRDC,ACRFUNDS
+1 QUIT
L1 DO SLOC
+1 IF $DATA(ACRQUIT)
QUIT
+2 SET (ACRRTN,ZTRTN)="PLOC^ACRFFDS"
+3 SET ZTDESC="SUB-ALLOWANCE DISTRIBUTION SUMMARY"
+4 DO ^ACRFZIS
+5 QUIT
SLOC ;SELECT LOCATIONS
+1 ;
+2 SET DIR(0)="NO^1000:9999"
+3 SET DIR("A")="Fiscal Year"
+4 SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF Y'?4N
QUIT
+8 SET ACRFY=Y
+9 SET DIR(0)="SO^1:Summarize by LOCATION;2:Summarize by SUB-SUB-ACTIVITY"
+10 SET DIR("A")="Which summary"
+11 WRITE !
+12 DO DIR^ACRFDIC
+13 IF Y<1
QUIT
+14 SET ACRFUNDS=$SELECT(Y=1:1,1:2)
+15 IF ACRFUNDS=1
Begin DoDot:1
+16 SET DIR(0)="SO^1:ALL Locations;2:Selected Locations"
+17 SET DIR("A")="ALL or Selected Locations"
+18 SET DIR("B")="All Locations"
End DoDot:1
IF 1
+19 IF ACRFUNDS=2
Begin DoDot:1
+20 SET DIR(0)="SO^1:ALL Sub-Sub-Activities;2:Selected Sub-Sub-Activities"
+21 SET DIR("A")="Which one"
+22 SET DIR("B")="ALL Sub-Sub-Activities"
End DoDot:1
+23 WRITE !
+24 DO DIR^ACRFDIC
+25 IF 'Y
QUIT
+26 IF Y=1
SET ACRLOC="ALL"
QUIT
+27 SET ACRJ=0
+28 SET ACRLOC=""
+29 FOR
DO SL1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+30 IF $GET(ACRLOC)=""
QUIT
+31 KILL ACRQUIT
+32 QUIT
SL1 ;SELECT SPECIFIC LOCATIONS
+1 IF ACRFUNDS=1
Begin DoDot:1
+2 SET DIC="^AUTTLCOD("
+3 SET DIC(0)="AEMQZ"
+4 SET DIC("A")="Which LOCATION: "
+5 IF ACRJ>1
SET DIC("A")="Next Location: "
End DoDot:1
IF 1
+6 IF ACRFUNDS=2
Begin DoDot:1
+7 SET DIC="^AUTTSSA("
+8 SET DIC(0)="AEMQZ"
+9 SET DIC("A")="Which Sub-Sub-Activity: "
+10 IF ACRJ>1
SET DIC("A")="Next Sub-Sub-Activity: "
End DoDot:1
IF 1
+11 WRITE !
+12 DO DIC^ACRFDIC
+13 IF Y<1
SET ACRQUIT=""
QUIT
+14 SET ACRJ=ACRJ+1
+15 SET ACRLOC=ACRLOC_+Y_","
+16 QUIT
+17 QUIT
GLOC ;GATHER DATA INTO TEMP GLOBAL
+1 ;,X
NEW ACR
+2 SET ACR=0
+3 IF ACRLOC'="ALL"
Begin DoDot:1
+4 FOR ACRJ=1:1
SET ACR=$PIECE(ACRLOC,",",ACRJ)
IF ACR=""
QUIT
DO GL1
End DoDot:1
QUIT
+5 SET ACRZDA=0
+6 FOR
SET ACRZDA=$ORDER(^ACRALC("FY",ACRFY,ACRZDA))
IF 'ACRZDA
QUIT
Begin DoDot:1
+7 SET X=$GET(^ACRALC(ACRZDA,"DT"))
+8 IF $PIECE(X,U,11)
IF $PIECE(X,U,8)
IF $PIECE(^ACRALC(ACRZDA,0),U,8)="O"
DO ID
End DoDot:1
+9 QUIT
GL1 SET ACRXREF=$SELECT(ACRFUNDS=1:"LCODE",1:"SS")
+1 SET ACRZDA=0
+2 FOR
SET ACRZDA=$ORDER(^ACRALC(ACRXREF,ACR,ACRZDA))
IF 'ACRZDA
QUIT
Begin DoDot:1
+3 SET X=$GET(^ACRALC(ACRZDA,"DT"))
+4 IF $PIECE(X,U)=ACRFY
IF $PIECE(X,U,8)
IF $PIECE(^ACRALC(ACRZDA,0),U,8)="O"
DO ID
End DoDot:1
+5 QUIT
ID ;CALCULATE INCREASES AND DECREASES
+1 SET ACRSSN=$PIECE($GET(^AUTTSSA(+$PIECE(X,U,8),0)),U,3)
+2 SET ACRSSA=$PIECE($GET(^AUTTSSA(+$PIECE(X,U,8),0)),U,4)
+3 SET ACRLCOD=$PIECE($GET(^AUTTLCOD(+$PIECE(X,U,11),0)),U)
+4 IF ACRSSA=""!(ACRSSN="")!(ACRLCOD="")
QUIT
+5 IF ACRFUNDS=1
SET ACR1=ACRLCOD
SET ACR2=ACRSSN
+6 IF ACRFUNDS=2
SET ACR1=ACRSSN
SET ACR2=ACRLCOD
+7 SET ^TMP("ACRGLOC",$JOB,ACR1,ACR2,ACRZDA)=+^ACRALC(ACRZDA,0)
SET X=^(ACRZDA)
+8 SET ^TMP("ACRGLOC",$JOB,ACR1)=ACRSSA
+9 SET ^TMP("ACRGLOC",$JOB,ACR1,ACR2)=ACRSSA
+10 SET ACRX=0
+11 FOR
SET ACRX=$ORDER(^ACRALC("ORIG",ACRZDA,ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+12 SET Y=^ACRALC(ACRX,0)
+13 SET Z=$PIECE(^ACRALC(ACRX,"DT"),U,3)
+14 SET $PIECE(X,U,$SELECT(Z="R":2,1:3))=$PIECE(X,U,$SELECT(Z="R":2,1:3))+($SELECT($PIECE(Y,U,9)="I":1,1:-1)*+Y)
End DoDot:1
+15 SET ^TMP("ACRGLOC",$JOB,ACR1,ACR2,ACRZDA)=X
+16 QUIT
PLOC ;EP;TO PRINT SUB-ALLOWANCE DISTRIBUTION SUMMARY
+1 DO PL1
+2 DO LEXIT
+3 QUIT
PL1 DO GLOC
+1 IF '$DATA(^TMP("ACRGLOC",$JOB))
QUIT
+2 SET ACR1=""
+3 FOR
SET ACR1=$ORDER(^TMP("ACRGLOC",$JOB,ACR1))
IF ACR1=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 DO LHEAD
+5 SET (ACRT1,ACRT2,ACRT3,ACRT4)=0
+6 SET ACR2=""
+7 FOR
SET ACR2=$ORDER(^TMP("ACRGLOC",$JOB,ACR1,ACR2))
IF ACR2=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+8 SET ACR3=^TMP("ACRGLOC",$JOB,ACR1,ACR2)
+9 SET ACRZDA=""
+10 FOR
SET ACRZDA=$ORDER(^TMP("ACRGLOC",$JOB,ACR1,ACR2,ACRZDA))
IF 'ACRZDA!$DATA(ACRQUIT)
QUIT
SET X=^(ACRZDA)
Begin DoDot:3
+11 SET ACRT1=ACRT1+$PIECE(X,U)
+12 SET ACRT2=ACRT2+$PIECE(X,U,2)
+13 SET ACRT3=ACRT3+$PIECE(X,U)+$PIECE(X,U,2)
+14 SET ACRT4=ACRT4+$PIECE(X,U,4)
+15 IF ACRFUNDS=2
SET ACR3=$PIECE($GET(^AUTTLCOD(+$ORDER(^AUTTLCOD("B",ACR2,0)),0)),U,2)
+16 WRITE !,$EXTRACT(ACR3,1,15),?15,"|",$JUSTIFY($FNUMBER($PIECE(X,U),"P,"),13),?29,"|",$JUSTIFY($FNUMBER(...
... $PIECE(X,U,2),"P,"),11),?41,"|",$JUSTIFY($FNUMBER($PIECE(X,U)+$PIECE(X,U,2),"P,"),13),?55,"|",$JUSTIFY($FNUMBER($PIECE(X,U,3),"P,"),10),?66,"|",$JUSTIFY($FNUMBER($PIECE(X,U)+$PIECE(X,U,2)+$PIECE(X,U,3),"P,"),13)
+17 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO LHEAD
End DoDot:3
End DoDot:2
+18 DO LTAIL
End DoDot:1
+19 QUIT
LHEAD ;HEADER
+1 WRITE @IOF
+2 SET ACRDC=$GET(ACRDC)+1
+3 WRITE !,"DISTRIBUTION OF FUNDS SUMAMRY"
+4 WRITE !,"-----------------------------"
+5 WRITE !,"FISCAL YEAR: ",ACRFY,?55,"PAGE: ",ACRDC
+6 WRITE !,"REPORT DATE: "
+7 SET Y=DT
+8 XECUTE ^DD("DD")
+9 WRITE Y
+10 IF ACRFUNDS=1
WRITE !,"LOCATION...: ",ACR1,?$X+3,$PIECE($GET(^AUTTLCOD(+$ORDER(^AUTTLCOD("B",ACR1,0)),0)),U,2)
+11 IF ACRFUNDS=2
WRITE !,"SUB-SUB-ACT: ",ACR1,?$X+3,^TMP("ACRGLOC",$JOB,ACR1)
+12 WRITE $$DASH^ACRFMENU
+13 WRITE !?15,"|",?25,"RECURRING",?41,"| TOTAL",?55,"| NON-",?66,"|"
+14 WRITE !,$SELECT(ACRFUNDS=1:"ACTIVITY",1:"LOCATION")
+15 WRITE ?15,"| BASE",?29,"| INC/DEC",?41,"| RECURRING",?55,"| RECURRING",?66,"| TOTAL"
+16 WRITE !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
+17 QUIT
LTAIL ;
+1 WRITE !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
+2 WRITE !?15,"|",$JUSTIFY($FNUMBER(ACRT1,"P,"),13),?29,"|",$JUSTIFY($FNUMBER(ACRT2,"P,"),11),?41,"|",$JUSTIFY($FNUMBER(ACRT3,"P,"),13),?55,"|",$JUSTIFY($FNUMBER(ACRT4,"P,"),10),?66,"|",$JUSTIFY($FNUMBER(ACRT3+ACRT4,"P,"),13)
+3 DO PAUSE^ACRFWARN
+4 QUIT
