ACRFSOF ;IHS/OIRM/DSD/THL,AEF - STATUS OF FUNDS REPORT; [ 02/02/2005 10:23 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
;;ROUTINE TO PRINT THE STATUS OF FUNDS REPORT
EN F D SELECT Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR0,ACROBJ,ACROBJ0,ACRDTAIL,ACRDOC,ACRDOC0,ACRREQ2,ACRSOFT,ACRDTL1,ACRBOTH,ACRZZDA,ACRZDA,ACRBUD,ACRSUBO,ACRQUIT,ACROUT,ACRXX,ACRYY,ACROCG,ACR11,ACR21,ACR22,ACR25,ACRDOCDA,ACRDT,ACRFY,ACRGLB,ACRGREF
K ACRI,ACRLCDA,ACROBL,ACRPURP,ACRREF,ACRREQ,ACRSPT,ACRTO,ACRTOT,ACRX
F X="ACRSOF","ACRXX","ACRYY" K ^TMP(X,$J)
Q
SELECT D EXIT
D HOME^ACRFMENU
K ACRSOFT,ACRDTAIL,ACRDTL1
W @IOF
W !?10,"Status of Funds Report"
S DIR(0)="SO^1:Department Account;2:Common Accounting Number;3:Sub-Allowance;4:Allowance;5:Location Code;6:Area Office;7:Funds Distribution Summaries"
S DIR("A")="Which type of report"
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!("1234567"'[+Y) Q
I Y=7 D LOCATION^ACRFFDS Q
S ACRSOFT=$S(Y=1:"F",Y=2:"CAN",Y=3:"G",Y=4:"H",Y=5:"LCOD",Y=6:"AREA",1:"")
Q:ACRSOFT=""
D DETAIL
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
I ACRSOFT="CAN" D CAN^ACRFSOF1 Q:$D(ACRQUIT)!$D(ACROUT) G ZIS
I ACRSOFT="AREA" D Q:$D(ACRQUIT)!$D(ACROUT) G ZIS
.D AREA^ACRFTV
.Q:$D(ACRQUIT)!$D(ACROUT)
.S ACRZDA=ACRADA
.D FY^ACRFSOF1
I ACRSOFT="LCOD" D Q:$D(ACRQUIT)!$D(ACROUT) G ZIS
.D LCOD^ACRFSOF1
.Q:$D(ACRQUIT)!$D(ACROUT)
.S (ACRZDA,ACRLCDA)=+Y
.D FY^ACRFSOF1
S ACRENTR1=$S(ACRSOFT="F":"LOCBAMT",ACRSOFT="G":"ALCAMT",ACRSOFT="H":"ALLAMT")
S ACRENTRY=$S(ACRSOFT="F":"ALCAMT",ACRSOFT="G":"ALLAMT",ACRSOFT="H":"APPAMT")
K ACRZDA
D ENTRY^ACRFDTP
I '$D(ACRZDA) K ACRQUIT Q
I ACRSOFT'="CAN" D BUDGET
I ACRSOFT="F" D C1^ACRFSOF1 Q:$D(ACRQUIT)!$D(ACROUT)
ZIS S ACRGLB=$S(ACRSOFT="F":"^ACRLOCB",ACRSOFT="H":"^ACRALW",ACRSOFT="G":"^ACRALC",1:"")
S ACRRTN="SS^ACRFSOF"
S ZTDESC="STATUS OF FUNDS REPORT"
D ^ACRFZIS
K ACRQUIT
Q
DETAIL ;EP;
K ACRDTAIL,ACRBOTH,ACRDTL1,ACROCG
S DIR(0)="SO^1:Summary;2:Sub-Object Code Summary;3:Detailed Report;4:Summary and Detailed REport"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) Q
I ACRY=1 K ACRDTAIL Q
I ACRY=2 K ACRDTAIL S ACRSUBO="" D OCG Q
I ACRY=3 S ACRDTAIL="" W ! D OC Q
I Y=4 S ACRBOTH="" D OCG
Q
SS ;EP;TO PRINT STATUS OF FUNDS REPORT
I '$D(ACRDTAIL)!$D(ACRBOTH),$G(ACRGLB)]"" D P2^ACRFEA43
I $D(ACRBOTH) D Q
.K ACRDTAIL,ACRDTL1
.D SS0
.S ACRDTAIL=""
.D SS0
.S ACRDTL1=""
.D SS0
.K ACRDTL1,^TMP("ACRSOF",$J),^TMP("ACRXX",$J),^TMP("ACRYY",$J)
SS0 Q:$D(ACRQUIT)!$D(ACROUT)
U IO
K ^TMP("ACRSOF",$J),^TMP("ACRXX",$J),^TMP("ACRYY",$J)
S (ACR,ACR4,ACR9,ACR21,ACR25,ACRREQ,ACROBL,ACRSPT,ACRTOT)=0
F S ACR=$O(^ACRSS(ACRSOFT,ACRZDA,ACR)) Q:'ACR D
.S ACR0=$G(^ACRSS(ACR,0))
.S ACRDT=$G(^ACRSS(ACR,"DT"))
.S ACRDOCDA=$P(ACR0,U,2)
.Q:'ACRDOCDA
.Q:'$D(^ACRDOC(ACRDOCDA)) ;ACR*2.1*16.05 IM11519
.Q:'$P(ACR0,U,6)
.Q:'$D(^ACRLOCB($P(ACR0,U,6),"DT"))
.I ACRSOFT["CAN",$P(ACR0,U,5)'=ACRZDA Q
.I "^CAN^AREA^LCOD^"[(U_ACRSOFT_U),+^ACRLOCB($P(ACR0,U,6),"DT")'=ACRFY Q
.S ACROBJ0=$P(ACR0,U,4)
.Q:'$D(^AUTTOBJC(+ACROBJ0,0))
.S ACROBJ0=$P(^AUTTOBJC(ACROBJ0,0),U)
.S ACROBJ=$E(ACROBJ0,1,2)_"00"
.I $D(ACROCG)#2 Q:$E(ACROBJ,1,2)'=$E(ACROCG,1,2)
.I $D(ACROCG)#2,$E(ACROCG,3,4)'="00",$E(ACROBJ0,3,4)'=$E(ACROCG,3,4) Q
.I $D(ACROCG)#2,$E(ACROCG,3,4)'="00",$E(ACROBJ0,3,4)=$E(ACROCG,3,4) S ACROBJ=ACROCG
.S:$D(ACRDTL1) ACROBJ="ALL"
.I '$D(ACRSUBO) S:'$D(^TMP("ACRSOF",$J,ACROBJ)) ^TMP("ACRSOF",$J,ACROBJ)=""
.E S:'$D(^TMP("ACRSOF",$J,"SUB",ACROBJ0)) ^TMP("ACRSOF",$J,"SUB",ACROBJ0)=""
.F ACRI=4,9,21 S @("ACR"_ACRI)=$P(ACRDT,U,ACRI)
.N X
.I '$D(ACRSUBO) S X=^TMP("ACRSOF",$J,ACROBJ)
.E S X=^TMP("ACRSOF",$J,"SUB",ACROBJ0)
.S $P(X,U)=$P(X,U)+ACR4
.S $P(X,U,2)=$P(X,U,2)+ACR9
.I '$D(^TMP("ACRXX",$J,ACRDOCDA)) D
..S $P(X,U,25)=$P(X,U,25)+1
..S ^TMP("ACRXX",$J,ACRDOCDA)=""
.S $P(X,U,4)=$P(X,U,4)+ACR21
.I '$D(ACRSUBO) S ^TMP("ACRSOF",$J,ACROBJ)=X
.E S ^TMP("ACRSOF",$J,"SUB",ACROBJ0)=X
.I $D(ACRDTAIL) D
..S ACRDOC=$P(ACR0,U,3)
..Q:'ACRDOC
..S ACRPURP=$E($P($G(^ACROBL(ACRDOC,"JST")),U),1,28)
..S ACRTO=$G(^ACRDOC(ACRDOC,"TO"))
..S ACRREQ2=$G(^ACRDOC(ACRDOC,"REQ2"))
..S ACRDOC=^ACRDOC(ACRDOC,0)
..S ACRREF=$P(ACRDOC,U,13)
..S ACRREF=$P(^AUTTDOCR(ACRREF,0),U)
..I "^130^600^"[(U_ACRREF_U) D
...S $P(ACRDOC,U,14)=ACRPURP
...S $P(ACRDOC,U,3)=$P(ACRTO,U,14)
...S $P(ACRDOC,U,11)=$P(ACRTO,U,15)
..I "^103^349^326^210^"'[(U_ACRREF_U) D I 1
...S ACRDOC0=$P(ACRDOC,U)
...S ACRDOC2=""
..E D
...S ACRDOC2=$P(ACRDOC,U)
...S ACRDOC0=$S($L($P(ACRDOC,U,2))>3&($P(ACRDOC,U,2)'["PEND"):$P(ACRDOC,U,2),1:$P(ACRDOC,U))
..I '$D(^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)) D I 1
...S X=$P(ACRDOC,U,3)_U_ACRDOC0_U_$P(ACRDOC,U,14)_U_$P(ACRREQ2,U,8)
...S:ACRDOC0'=ACRDOC2 $P(X,U,10)=ACRDOC2
..E S X=^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)
..S $P(X,U,5)=$P(X,U,5)+ACR4
..S $P(X,U,6)=$P(X,U,6)+ACR9
..S $P(X,U,21)=$P(X,U,21)+ACR21
..I '$D(^TMP("ACRYY",$J,ACRDOCDA)) D
...S $P(X,U,25)=$P(X,U,25)+1
...S ^TMP("ACRYY",$J,ACRDOCDA)=""
..S $P(X,U,11)=$P(ACRTO,U,15)
..S ^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)=X
..K ACR4,ACR21,ACR9,ACRDOC2
I '$D(ACRQUIT),$D(^TMP("ACRSOF",$J)) D SS1^ACRFSOF1
I '$D(ACRQUIT),$E(IOST,1,2)="C-" D PAUSE^ACRFWARN
W @IOF
K ^TMP("ACRSOF",$J)
Q
OC ;EP;SORT BY OBJECT CLASS
S DIR(0)="YO"
S DIR("A")="By Object Code"
S DIR("B")="NO"
D DIR^ACRFDIC
Q:$D(ACROUT)!$D(ACRQUIT)
I Y=0 S ACRDTL1="" Q
OCG ;SELECT OBJECT CLASS GROUP
W !!?7,"If you want to print the report for one OBJECT CLASS group,"
W !?7,"select the group below. If no group is selected the report"
W !?7,"will include all OBJECT CLASS groups."
S DIR(0)="SO^1100:Personnel Costs;2100:Travel;2200:Transportation;2300:Rent;2400:Printing;2500:Services;2600:Supplies;3100:Equipment;3200:Land and Structures;4100:Grants"
S DIR("A")="Which OBJECT CLASS Group"
D DIR^ACRFDIC
I '+Y K ACRQUIT Q
S ACROCG=Y
S DIR(0)="YO"
S DIR("A",1)="Report for one specific"
S DIR("A")=$S(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Granst")_" Sub-Object Code ONLY"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I 'Y K ACRQUIT Q
S DIC="^AUTTOBJC("
S DIC(0)="AEMQZ"
S DIC("S")="I $E($P(^(0),U),1,2)=$E($G(ACROCG),1,2)"
S Y=ACROCG
S DIC("A")="Which "_$S(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Grants")_" Sub-Object Code: "
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACROCG=$P(^AUTTOBJC(+Y,0),U)
Q
BUDGET ;DETERMINE DOLLARS IN ACCOUNT
K ACRBUD
N ACRAMT,X,ACRX
S X=U_"ACR"_$P(ACRENTR1,"AMT")
S:X["ACRALL" X="^ACRALW"
S ACRBUD=+@X@(ACRZDA,0) S:X["ACRLOCB" ACRBUD=ACRBUD+$P(^(0),U,11)
S ACRX=0
F S ACRX=$O(@X@("ORIG",ACRZDA,ACRX)) Q:'ACRX S ACRAMT=$S($P(@X@(ACRX,0),U,8)'="D":1,1:-1),ACRBUD=ACRBUD+(+@X@(ACRX,0)*ACRAMT)
Q
ACRFSOF ;IHS/OIRM/DSD/THL,AEF - STATUS OF FUNDS REPORT; [ 02/02/2005 10:23 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
+2 ;;ROUTINE TO PRINT THE STATUS OF FUNDS REPORT
EN FOR
DO SELECT
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR0,ACROBJ,ACROBJ0,ACRDTAIL,ACRDOC,ACRDOC0,ACRREQ2,ACRSOFT,ACRDTL1,ACRBOTH,ACRZZDA,ACRZDA,ACRBUD,ACRSUBO,ACRQUIT,ACROUT,ACRXX,ACRYY,ACROCG,ACR11,ACR21,ACR22,ACR25,ACRDOCDA,ACRDT,ACRFY,ACRGLB,ACRGREF
+1 KILL ACRI,ACRLCDA,ACROBL,ACRPURP,ACRREF,ACRREQ,ACRSPT,ACRTO,ACRTOT,ACRX
+2 FOR X="ACRSOF","ACRXX","ACRYY"
KILL ^TMP(X,$JOB)
+3 QUIT
SELECT DO EXIT
+1 DO HOME^ACRFMENU
+2 KILL ACRSOFT,ACRDTAIL,ACRDTL1
+3 WRITE @IOF
+4 WRITE !?10,"Status of Funds Report"
+5 SET DIR(0)="SO^1:Department Account;2:Common Accounting Number;3:Sub-Allowance;4:Allowance;5:Location Code;6:Area Office;7:Funds Distribution Summaries"
+6 SET DIR("A")="Which type of report"
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)!("1234567"'[+Y)
QUIT
+9 IF Y=7
DO LOCATION^ACRFFDS
QUIT
+10 SET ACRSOFT=$SELECT(Y=1:"F",Y=2:"CAN",Y=3:"G",Y=4:"H",Y=5:"LCOD",Y=6:"AREA",1:"")
+11 IF ACRSOFT=""
QUIT
+12 DO DETAIL
+13 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+14 IF ACRSOFT="CAN"
DO CAN^ACRFSOF1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
GOTO ZIS
+15 IF ACRSOFT="AREA"
Begin DoDot:1
+16 DO AREA^ACRFTV
+17 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+18 SET ACRZDA=ACRADA
+19 DO FY^ACRFSOF1
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
GOTO ZIS
+20 IF ACRSOFT="LCOD"
Begin DoDot:1
+21 DO LCOD^ACRFSOF1
+22 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+23 SET (ACRZDA,ACRLCDA)=+Y
+24 DO FY^ACRFSOF1
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
GOTO ZIS
+25 SET ACRENTR1=$SELECT(ACRSOFT="F":"LOCBAMT",ACRSOFT="G":"ALCAMT",ACRSOFT="H":"ALLAMT")
+26 SET ACRENTRY=$SELECT(ACRSOFT="F":"ALCAMT",ACRSOFT="G":"ALLAMT",ACRSOFT="H":"APPAMT")
+27 KILL ACRZDA
+28 DO ENTRY^ACRFDTP
+29 IF '$DATA(ACRZDA)
KILL ACRQUIT
QUIT
+30 IF ACRSOFT'="CAN"
DO BUDGET
+31 IF ACRSOFT="F"
DO C1^ACRFSOF1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
ZIS SET ACRGLB=$SELECT(ACRSOFT="F":"^ACRLOCB",ACRSOFT="H":"^ACRALW",ACRSOFT="G":"^ACRALC",1:"")
+1 SET ACRRTN="SS^ACRFSOF"
+2 SET ZTDESC="STATUS OF FUNDS REPORT"
+3 DO ^ACRFZIS
+4 KILL ACRQUIT
+5 QUIT
DETAIL ;EP;
+1 KILL ACRDTAIL,ACRBOTH,ACRDTL1,ACROCG
+2 SET DIR(0)="SO^1:Summary;2:Sub-Object Code Summary;3:Detailed Report;4:Summary and Detailed REport"
+3 SET DIR("A")="Which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+7 IF ACRY=1
KILL ACRDTAIL
QUIT
+8 IF ACRY=2
KILL ACRDTAIL
SET ACRSUBO=""
DO OCG
QUIT
+9 IF ACRY=3
SET ACRDTAIL=""
WRITE !
DO OC
QUIT
+10 IF Y=4
SET ACRBOTH=""
DO OCG
+11 QUIT
SS ;EP;TO PRINT STATUS OF FUNDS REPORT
+1 IF '$DATA(ACRDTAIL)!$DATA(ACRBOTH)
IF $GET(ACRGLB)]""
DO P2^ACRFEA43
+2 IF $DATA(ACRBOTH)
Begin DoDot:1
+3 KILL ACRDTAIL,ACRDTL1
+4 DO SS0
+5 SET ACRDTAIL=""
+6 DO SS0
+7 SET ACRDTL1=""
+8 DO SS0
+9 KILL ACRDTL1,^TMP("ACRSOF",$JOB),^TMP("ACRXX",$JOB),^TMP("ACRYY",$JOB)
End DoDot:1
QUIT
SS0 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 USE IO
+2 KILL ^TMP("ACRSOF",$JOB),^TMP("ACRXX",$JOB),^TMP("ACRYY",$JOB)
+3 SET (ACR,ACR4,ACR9,ACR21,ACR25,ACRREQ,ACROBL,ACRSPT,ACRTOT)=0
+4 FOR
SET ACR=$ORDER(^ACRSS(ACRSOFT,ACRZDA,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+5 SET ACR0=$GET(^ACRSS(ACR,0))
+6 SET ACRDT=$GET(^ACRSS(ACR,"DT"))
+7 SET ACRDOCDA=$PIECE(ACR0,U,2)
+8 IF 'ACRDOCDA
QUIT
+9 ;ACR*2.1*16.05 IM11519
IF '$DATA(^ACRDOC(ACRDOCDA))
QUIT
+10 IF '$PIECE(ACR0,U,6)
QUIT
+11 IF '$DATA(^ACRLOCB($PIECE(ACR0,U,6),"DT"))
QUIT
+12 IF ACRSOFT["CAN"
IF $PIECE(ACR0,U,5)'=ACRZDA
QUIT
+13 IF "^CAN^AREA^LCOD^"[(U_ACRSOFT_U)
IF +^ACRLOCB($PIECE(ACR0,U,6),"DT")'=ACRFY
QUIT
+14 SET ACROBJ0=$PIECE(ACR0,U,4)
+15 IF '$DATA(^AUTTOBJC(+ACROBJ0,0))
QUIT
+16 SET ACROBJ0=$PIECE(^AUTTOBJC(ACROBJ0,0),U)
+17 SET ACROBJ=$EXTRACT(ACROBJ0,1,2)_"00"
+18 IF $DATA(ACROCG)#2
IF $EXTRACT(ACROBJ,1,2)'=$EXTRACT(ACROCG,1,2)
QUIT
+19 IF $DATA(ACROCG)#2
IF $EXTRACT(ACROCG,3,4)'="00"
IF $EXTRACT(ACROBJ0,3,4)'=$EXTRACT(ACROCG,3,4)
QUIT
+20 IF $DATA(ACROCG)#2
IF $EXTRACT(ACROCG,3,4)'="00"
IF $EXTRACT(ACROBJ0,3,4)=$EXTRACT(ACROCG,3,4)
SET ACROBJ=ACROCG
+21 IF $DATA(ACRDTL1)
SET ACROBJ="ALL"
+22 IF '$DATA(ACRSUBO)
IF '$DATA(^TMP("ACRSOF",$JOB,ACROBJ))
SET ^TMP("ACRSOF",$JOB,ACROBJ)=""
+23 IF '$TEST
IF '$DATA(^TMP("ACRSOF",$JOB,"SUB",ACROBJ0))
SET ^TMP("ACRSOF",$JOB,"SUB",ACROBJ0)=""
+24 FOR ACRI=4,9,21
SET @("ACR"_ACRI)=$PIECE(ACRDT,U,ACRI)
+25 NEW X
+26 IF '$DATA(ACRSUBO)
SET X=^TMP("ACRSOF",$JOB,ACROBJ)
+27 IF '$TEST
SET X=^TMP("ACRSOF",$JOB,"SUB",ACROBJ0)
+28 SET $PIECE(X,U)=$PIECE(X,U)+ACR4
+29 SET $PIECE(X,U,2)=$PIECE(X,U,2)+ACR9
+30 IF '$DATA(^TMP("ACRXX",$JOB,ACRDOCDA))
Begin DoDot:2
+31 SET $PIECE(X,U,25)=$PIECE(X,U,25)+1
+32 SET ^TMP("ACRXX",$JOB,ACRDOCDA)=""
End DoDot:2
+33 SET $PIECE(X,U,4)=$PIECE(X,U,4)+ACR21
+34 IF '$DATA(ACRSUBO)
SET ^TMP("ACRSOF",$JOB,ACROBJ)=X
+35 IF '$TEST
SET ^TMP("ACRSOF",$JOB,"SUB",ACROBJ0)=X
+36 IF $DATA(ACRDTAIL)
Begin DoDot:2
+37 SET ACRDOC=$PIECE(ACR0,U,3)
+38 IF 'ACRDOC
QUIT
+39 SET ACRPURP=$EXTRACT($PIECE($GET(^ACROBL(ACRDOC,"JST")),U),1,28)
+40 SET ACRTO=$GET(^ACRDOC(ACRDOC,"TO"))
+41 SET ACRREQ2=$GET(^ACRDOC(ACRDOC,"REQ2"))
+42 SET ACRDOC=^ACRDOC(ACRDOC,0)
+43 SET ACRREF=$PIECE(ACRDOC,U,13)
+44 SET ACRREF=$PIECE(^AUTTDOCR(ACRREF,0),U)
+45 IF "^130^600^"[(U_ACRREF_U)
Begin DoDot:3
+46 SET $PIECE(ACRDOC,U,14)=ACRPURP
+47 SET $PIECE(ACRDOC,U,3)=$PIECE(ACRTO,U,14)
+48 SET $PIECE(ACRDOC,U,11)=$PIECE(ACRTO,U,15)
End DoDot:3
+49 IF "^103^349^326^210^"'[(U_ACRREF_U)
Begin DoDot:3
+50 SET ACRDOC0=$PIECE(ACRDOC,U)
+51 SET ACRDOC2=""
End DoDot:3
IF 1
+52 IF '$TEST
Begin DoDot:3
+53 SET ACRDOC2=$PIECE(ACRDOC,U)
+54 SET ACRDOC0=$SELECT($LENGTH($PIECE(ACRDOC,U,2))>3&($PIECE(ACRDOC,U,2)'["PEND"):$PIECE(ACRDOC,U,2),1:$PIECE(ACRDOC,U))
End DoDot:3
+55 IF '$DATA(^TMP("ACRSOF",$JOB,ACROBJ,ACRDOC0))
Begin DoDot:3
+56 SET X=$PIECE(ACRDOC,U,3)_U_ACRDOC0_U_$PIECE(ACRDOC,U,14)_U_$PIECE(ACRREQ2,U,8)
+57 IF ACRDOC0'=ACRDOC2
SET $PIECE(X,U,10)=ACRDOC2
End DoDot:3
IF 1
+58 IF '$TEST
SET X=^TMP("ACRSOF",$JOB,ACROBJ,ACRDOC0)
+59 SET $PIECE(X,U,5)=$PIECE(X,U,5)+ACR4
+60 SET $PIECE(X,U,6)=$PIECE(X,U,6)+ACR9
+61 SET $PIECE(X,U,21)=$PIECE(X,U,21)+ACR21
+62 IF '$DATA(^TMP("ACRYY",$JOB,ACRDOCDA))
Begin DoDot:3
+63 SET $PIECE(X,U,25)=$PIECE(X,U,25)+1
+64 SET ^TMP("ACRYY",$JOB,ACRDOCDA)=""
End DoDot:3
+65 SET $PIECE(X,U,11)=$PIECE(ACRTO,U,15)
+66 SET ^TMP("ACRSOF",$JOB,ACROBJ,ACRDOC0)=X
+67 KILL ACR4,ACR21,ACR9,ACRDOC2
End DoDot:2
End DoDot:1
+68 IF '$DATA(ACRQUIT)
IF $DATA(^TMP("ACRSOF",$JOB))
DO SS1^ACRFSOF1
+69 IF '$DATA(ACRQUIT)
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ACRFWARN
+70 WRITE @IOF
+71 KILL ^TMP("ACRSOF",$JOB)
+72 QUIT
OC ;EP;SORT BY OBJECT CLASS
+1 SET DIR(0)="YO"
+2 SET DIR("A")="By Object Code"
+3 SET DIR("B")="NO"
+4 DO DIR^ACRFDIC
+5 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+6 IF Y=0
SET ACRDTL1=""
QUIT
OCG ;SELECT OBJECT CLASS GROUP
+1 WRITE !!?7,"If you want to print the report for one OBJECT CLASS group,"
+2 WRITE !?7,"select the group below. If no group is selected the report"
+3 WRITE !?7,"will include all OBJECT CLASS groups."
+4 SET DIR(0)="SO^1100:Personnel Costs;2100:Travel;2200:Transportation;2300:Rent;2400:Printing;2500:Services;2600:Supplies;3100:Equipment;3200:Land and Structures;4100:Grants"
+5 SET DIR("A")="Which OBJECT CLASS Group"
+6 DO DIR^ACRFDIC
+7 IF '+Y
KILL ACRQUIT
QUIT
+8 SET ACROCG=Y
+9 SET DIR(0)="YO"
+10 SET DIR("A",1)="Report for one specific"
+11 SET DIR("A")=$SELECT(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Granst")_" Sub-Object Code ONLY"
+12 SET DIR("B")="NO"
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 IF 'Y
KILL ACRQUIT
QUIT
+16 SET DIC="^AUTTOBJC("
+17 SET DIC(0)="AEMQZ"
+18 SET DIC("S")="I $E($P(^(0),U),1,2)=$E($G(ACROCG),1,2)"
+19 SET Y=ACROCG
+20 SET DIC("A")="Which "_$SELECT(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Grants")_" Sub-Object Code: "
+21 WRITE !
+22 DO DIC^ACRFDIC
+23 IF +Y<1
SET ACRQUIT=""
QUIT
+24 SET ACROCG=$PIECE(^AUTTOBJC(+Y,0),U)
+25 QUIT
BUDGET ;DETERMINE DOLLARS IN ACCOUNT
+1 KILL ACRBUD
+2 NEW ACRAMT,X,ACRX
+3 SET X=U_"ACR"_$PIECE(ACRENTR1,"AMT")
+4 IF X["ACRALL"
SET X="^ACRALW"
+5 SET ACRBUD=+@X@(ACRZDA,0)
IF X["ACRLOCB"
SET ACRBUD=ACRBUD+$PIECE(^(0),U,11)
+6 SET ACRX=0
+7 FOR
SET ACRX=$ORDER(@X@("ORIG",ACRZDA,ACRX))
IF 'ACRX
QUIT
SET ACRAMT=$SELECT($PIECE(@X@(ACRX,0),U,8)'="D":1,1:-1)
SET ACRBUD=ACRBUD+(+@X@(ACRX,0)*ACRAMT)
+8 QUIT
