ACRFSOF1 ;IHS/OIRM/DSD/THL,AEF - STATUS OF FUNDS REPORT; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;CONTINUATION OF ACRFSOF
DISPLAY ;EP;TO DISPLAY SOF
I "^CAN^AREA^LCOD^"'[(U_ACRSOFT_U) D
.S ACRDEPT=$S(ACRSOFT="G":$P(^ACRALC(ACRZDA,0),U,12),ACRSOFT="F":$P(^ACRLOCB(ACRZDA,0),U,5),ACRSOFT="H":$P(^ACRALW(ACRZDA,0),U,12))
.S ACRDT=$S(ACRSOFT="G":^ACRALC(ACRZDA,"DT"),ACRSOFT="F":^ACRLOCB(ACRZDA,"DT"),ACRSOFT="H":^ACRALW(ACRZDA,"DT"))
.S ACRFY=$P(ACRDT,U)
.S ACRALWDA=$P(ACRDT,U,5)
.S ACRSSADA=$P(ACRDT,U,8)
.S ACRSSA=$P(^AUTTSSA(ACRSSADA,0),U,2)_" ("_$P(^(0),U)_")"
Q
H1 ;EP;
Q:$D(ACRQUIT)!$D(ACROUT)
I $E(IOST,1,2)="C-" W @IOF
W !?14,"STATUS OF FUNDS SUMMARY"
S Y=DT
X ^DD("DD")
W ?50,"DATE: ",Y
I ACRSOFT="CAN"!$D(ACRCANDA) D
.S:ACRSOFT="CAN" ACRCANDA=ACRZDA
.W !!,"Report for CAN: ",$P(^AUTTCAN(ACRCANDA,0),U)
I ACRSOFT="AREA"!$D(ACRADA) D
.S:ACRSOFT="AREA" ACRADA=ACRZDA
.W !!,"Report for AREA: ",$P(^AUTTAREA(+^ACRSYS(ACRADA,0),0),U)
I ACRSOFT="LCOD"!$D(ACRLCDA) D
.S:ACRSOFT="LCOD" ACRLCDA=ACRZDA
.W !!,"Report for LOCATION: ",$P(^AUTTLCOD(ACRLCDA,0),U)
I "^CAN^AREA^LCOD^"'[(U_ACRSOFT_U) D
.W !?14,"-----------------------"
.W !,"SUB-SUB ACT..: ",ACRSSA
.W ?60,"ALLOWANCE: ",$P(^AUTTALLW(ACRALWDA,0),U)
.W:ACRSOFT="F" !,"DEPARTMENT...: "
.W:ACRSOFT="G" !,"SUB-ALLOWANCE: "
.W:ACRSOFT="H" !,"ALLOWANCE....: "
.W $E($S(ACRSOFT="F":$P(^AUTTPRG(ACRDEPT,0),U),1:ACRDEPT),1,25)
.W " (ACCT ID "_ACRZDA_")"
.W ?60,"FY.......: ",ACRFY
H11 W $$DASH^ACRFMENU
Q
H2 D H3
W !,"OBJECT"
W ?27,"OBLIGATIONS"
W ?46,"PENDING"
W !,"CLASS"
W ?29,"TO DATE"
W ?44,"OBLIGATIONS"
H3 W !,"------"
W ?25,"---------------"
W ?42,"---------------"
W ?59,"---------------"
Q
CAN ;EP;TO SELECT CAN FOR SOF
S DIC="^AUTTCAN("
S DIC(0)="AEMQ"
S DIC("A")="Which CAN NO.: "
W !
D DIC^ACRFDIC
K DIC
I +Y<1 S ACRQUIT="" Q
S ACRZDA=+Y
D FY
Q
C1 ;EP;
S DIR(0)="YO"
S DIR("A")="Print report for a specific CAN"
S DIR("B")="NO"
K ACRCANDA
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I ACRY=1 D Q:$D(ACRQUIT)!$D(ACROUT)
.S ACRZZDA=ACRZDA
.D CAN
.Q:$D(ACRQUIT)!$D(ACROUT)
.S ACRCANDA=ACRZDA,ACRZDA=ACRZZDA
.K ACRZZDA
Q
SS1 ;EP;
D DISPLAY
D H1
S ACR=""
D:'$D(ACRDTAIL) SS3
I '$D(ACRSUBO) S ACRGREF="^TMP(""ACRSOF"",$J)"
E S ACRGREF="^TMP(""ACRSOF"",$J,""SUB"")"
F S ACR=$O(@ACRGREF@(ACR)) Q:ACR=""!$D(ACRQUIT)!$D(ACROUT) D
.I $D(ACRDTAIL) D SS2
.Q:$D(ACRQUIT)!$D(ACROUT)
.S:'$D(ACRSUBO) ACR0=^TMP("ACRSOF",$J,ACR)
.S:$D(ACRSUBO) ACR0=^TMP("ACRSOF",$J,"SUB",ACR)
.F ACRI=1:1:4,25 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
.I $D(ACRDTAIL),'$D(ACRDTL1) D
..W $$DASH^ACRFMENU
..Q
.I '$D(ACRDTL1) D
..W:'$D(ACRDTAIL) !,"OBJECT CODE: ",ACR
..W:$D(ACRDTAIL) !
..W ?30," TOTALS"
..W ?40,$J(ACR25,8)
..W ?50,$J($FN(ACR1,"P,",2),15)
..W ?64,$J($FN(ACR2,"P,",2),15)
..W:ION<81 !?65
..W:ION>80 ?80
..W $J($FN($S(ACR4>ACR3:ACR4,1:ACR3),"P,",2),15)
.S ACRREQ=ACRREQ+ACR1
.S ACROBL=ACROBL+ACR2
.S ACRSPT=ACRSPT+$S(ACR4>ACR3:ACR4,1:ACR3)
.S ACRTOT=ACRTOT+ACR25
.I $Y>(IOSL-5) D
..D PAUSE^ACRFWARN
..W @IOF
..D H1
Q:$D(ACRQUIT)!$D(ACROUT)
W $$DASH^ACRFMENU
W ?30," TOTALS: ",ACR
W ?40,$J(ACRTOT,8)
W ?50,$J($FN(ACRREQ,"P,",2),15)
W ?64,$J($FN(ACROBL,"P,",2),15)
W:ION<81 !?65
W:ION>80 ?80
W $J($FN(ACRSPT,"P,",2),15)
I $G(ACRBUD) D
.W !,"TOTAL ALLOWANCE: ",$J($FN(ACRBUD,"P,",2),15)
.W ?37,"REMAINING:"
.W ?50,$J($FN(ACRBUD-ACRREQ,"P,",2),15)
.W ?64,$J($FN(ACRBUD-ACROBL,"P,",2),15)
I $G(ACRBUD) D
.W:ION<81 !?65
.W:ION>80 ?80
.W $J($FN(ACRBUD-ACRSPT,"P,",2),15)
Q
SS2 S ACRX=""
D SS3
F S ACRX=$O(^TMP("ACRSOF",$J,ACR,ACRX)) Q:ACRX=""!$D(ACRQUIT)!$D(ACROUT) S ACR0=^(ACRX) D
.F ACRI=1:1:6,11,21,22 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
.W !,$E(ACR1,4,7),$E(ACR1,2,3)
.W ?7,ACR2
.W ?22,ACR3
.W ?50,$J($FN(ACR5,"P,",2),15)
.W ?64,$J($FN(ACR6,"P,",2),15)
.I ION>80 W ?80,$J($FN($S(ACR21>ACR22:ACR21,1:ACR22),"P,",2),15)
.I ACR11]""!($P(ACR0,U,10)]"")!(ION<81) W !
.I ACR11]"" W $E(ACR11,4,7),$E(ACR11,2,3)
.I $P(ACR0,U,10)]"" W ?7,$P(ACR0,U,10)
.;I ACR4 W ?22,$E($P(^VA(200,ACR4,0),U),1,10) ;ACR*2.1*19.02 IM16848
.I ACR4 W ?22,$E($$NAME2^ACRFUTL1(ACR4),1,10) ;ACR*2.1*19.02 IM16848
.I ION<81 W ?65,$J($FN($S(ACR21>ACR22:ACR21,1:ACR22),"P,",2),15)
.I $Y>(IOSL-5) D
..D PAUSE^ACRFWARN
..W @IOF
..I '$D(ACRQUIT) D
...D H1
...D SS3
Q
SS3 I $D(ACRDTAIL) D
.I '$D(ACRDTL1) D I 1
..W !
..W "OBJECT CODE: ",ACR
.W !,$S($E(ACR,1,2)'=21:"DATE",1:"BEGIN")
.W ?7,"DOCUMENT NO."
.W:$E(ACR,1,2)'=21 ?22,"IDENTIFIER/INITIATOR"
.W:$E(ACR,1,2)=21 ?22,"PURPOSE OF TRAVEL"
.W ?53,"REQUESTED",?68,"OBLIGATED"
I '$D(ACRDTAIL) D
.W !?40,"NUMBER OF",?53,"REQUESTED",?68,"OBLIGATED"
I ION>80 D
.W ?40,"DOCUMENTS",?84,"SPENT"
I ION<81 D
.W !
.W:'$D(ACRDTAIL) ?40,"DOCUMENTS"
.W ?68,"SPENT"
W $$DASH^ACRFMENU
Q
SS5 ;EP;TO REPORT BY SUB-OBJECT CODE
D DISPLAY
D H1
S ACR=""
D SS3
F S ACR=$O(^TMP("ACRSOF",$J,"SUB",ACR)) Q:ACR=""!$D(ACRQUIT)!$D(ACROUT) D
.S ACR0=^TMP("ACRSOF",$J,"SUB",ACR)
.F ACRI=1:1:4,25 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
.I $D(ACRDTAIL),'$D(ACRDTL1) D
..W $$DASH^ACRFMENU
..Q
.I '$D(ACRDTL1) D
..W:'$D(ACRDTAIL) !,"OBJECT CODE: ",ACR
..W:$D(ACRDTAIL) !
..W ?30," TOTALS"
..W ?40,$J(ACR25,8)
..W ?50,$J($FN(ACR1,"P,",2),15)
..W ?64,$J($FN(ACR2,"P,",2),15)
..W:ION<81 !?65
..W:ION>80 ?80
..W $J($FN($S(ACR4>ACR3:ACR4,1:ACR3),"P,",2),15)
.S ACRREQ=ACRREQ+ACR1
.S ACROBL=ACROBL+ACR2
.S ACRSPT=ACRSPT+$S(ACR4>ACR3:ACR4,1:ACR3)
.S ACRTOT=ACRTOT+ACR25
.I $Y>(IOSL-5) D
..D PAUSE^ACRFWARN
..W @IOF
..D H1
Q:$D(ACRQUIT)!$D(ACROUT)
W $$DASH^ACRFMENU
W !?40,"TOTALS: ",ACR
W ?30," TOTALS: ",ACR
W ?40,$J(ACRTOT,8)
W ?50,$J($FN(ACRREQ,"P,",2),15)
W ?64,$J($FN(ACROBL,"P,",2),15)
W:ION<81 !?65
W:ION>80 ?80
W $J($FN(ACRSPT,"P,",2),15)
I $G(ACRBUD) D
.W !,"TOTAL ALLOWANCE: ",$J($FN(ACRBUD,"P,",2),15)
.W ?37,"REMAINING:"
.W ?50,$J($FN(ACRBUD-ACRREQ,"P,",2),15)
.W ?64,$J($FN(ACRBUD-ACROBL,"P,",2),15)
I $G(ACRBUD) D
.W:ION<81 !?65
.W:ION>80 ?80
.W $J($FN(ACRBUD-ACRSPT,"P,",2),15)
Q
FY ;EP - SELECT FISCAL YEAR
S DIR(0)="NOA^1000:9999"
S DIR("A")="Fiscal Year..: "
S DIR("B")=$S(+$E(DT,4,5)>9:DT\10000+1,1:DT\10000)+1700
W !
D DIR^ACRFDIC
I 'Y S ACRQUIT="" Q
S ACRFY=Y
Q
LCOD ;EP;TO SELECT LOCATION CODE
S DIC="^AUTTLCOD("
S DIC(0)="AEMQZ"
S DIC("A")="Location Code: "
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S (ACRLCDA,ACRZDA)=+Y
Q
ACRFSOF1 ;IHS/OIRM/DSD/THL,AEF - STATUS OF FUNDS REPORT; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSOF
DISPLAY ;EP;TO DISPLAY SOF
+1 IF "^CAN^AREA^LCOD^"'[(U_ACRSOFT_U)
Begin DoDot:1
+2 SET ACRDEPT=$SELECT(ACRSOFT="G":$PIECE(^ACRALC(ACRZDA,0),U,12),ACRSOFT="F":$PIECE(^ACRLOCB(ACRZDA,0),U,5),ACRSOFT="H":$PIECE(^ACRALW(ACRZDA,0),U,12))
+3 SET ACRDT=$SELECT(ACRSOFT="G":^ACRALC(ACRZDA,"DT"),ACRSOFT="F":^ACRLOCB(ACRZDA,"DT"),ACRSOFT="H":^ACRALW(ACRZDA,"DT"))
+4 SET ACRFY=$PIECE(ACRDT,U)
+5 SET ACRALWDA=$PIECE(ACRDT,U,5)
+6 SET ACRSSADA=$PIECE(ACRDT,U,8)
+7 SET ACRSSA=$PIECE(^AUTTSSA(ACRSSADA,0),U,2)_" ("_$PIECE(^(0),U)_")"
End DoDot:1
+8 QUIT
H1 ;EP;
+1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 WRITE !?14,"STATUS OF FUNDS SUMMARY"
+4 SET Y=DT
+5 XECUTE ^DD("DD")
+6 WRITE ?50,"DATE: ",Y
+7 IF ACRSOFT="CAN"!$DATA(ACRCANDA)
Begin DoDot:1
+8 IF ACRSOFT="CAN"
SET ACRCANDA=ACRZDA
+9 WRITE !!,"Report for CAN: ",$PIECE(^AUTTCAN(ACRCANDA,0),U)
End DoDot:1
+10 IF ACRSOFT="AREA"!$DATA(ACRADA)
Begin DoDot:1
+11 IF ACRSOFT="AREA"
SET ACRADA=ACRZDA
+12 WRITE !!,"Report for AREA: ",$PIECE(^AUTTAREA(+^ACRSYS(ACRADA,0),0),U)
End DoDot:1
+13 IF ACRSOFT="LCOD"!$DATA(ACRLCDA)
Begin DoDot:1
+14 IF ACRSOFT="LCOD"
SET ACRLCDA=ACRZDA
+15 WRITE !!,"Report for LOCATION: ",$PIECE(^AUTTLCOD(ACRLCDA,0),U)
End DoDot:1
+16 IF "^CAN^AREA^LCOD^"'[(U_ACRSOFT_U)
Begin DoDot:1
+17 WRITE !?14,"-----------------------"
+18 WRITE !,"SUB-SUB ACT..: ",ACRSSA
+19 WRITE ?60,"ALLOWANCE: ",$PIECE(^AUTTALLW(ACRALWDA,0),U)
+20 IF ACRSOFT="F"
WRITE !,"DEPARTMENT...: "
+21 IF ACRSOFT="G"
WRITE !,"SUB-ALLOWANCE: "
+22 IF ACRSOFT="H"
WRITE !,"ALLOWANCE....: "
+23 WRITE $EXTRACT($SELECT(ACRSOFT="F":$PIECE(^AUTTPRG(ACRDEPT,0),U),1:ACRDEPT),1,25)
+24 WRITE " (ACCT ID "_ACRZDA_")"
+25 WRITE ?60,"FY.......: ",ACRFY
End DoDot:1
H11 WRITE $$DASH^ACRFMENU
+1 QUIT
H2 DO H3
+1 WRITE !,"OBJECT"
+2 WRITE ?27,"OBLIGATIONS"
+3 WRITE ?46,"PENDING"
+4 WRITE !,"CLASS"
+5 WRITE ?29,"TO DATE"
+6 WRITE ?44,"OBLIGATIONS"
H3 WRITE !,"------"
+1 WRITE ?25,"---------------"
+2 WRITE ?42,"---------------"
+3 WRITE ?59,"---------------"
+4 QUIT
CAN ;EP;TO SELECT CAN FOR SOF
+1 SET DIC="^AUTTCAN("
+2 SET DIC(0)="AEMQ"
+3 SET DIC("A")="Which CAN NO.: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 KILL DIC
+7 IF +Y<1
SET ACRQUIT=""
QUIT
+8 SET ACRZDA=+Y
+9 DO FY
+10 QUIT
C1 ;EP;
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Print report for a specific CAN"
+3 SET DIR("B")="NO"
+4 KILL ACRCANDA
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF ACRY=1
Begin DoDot:1
+9 SET ACRZZDA=ACRZDA
+10 DO CAN
+11 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 SET ACRCANDA=ACRZDA
SET ACRZDA=ACRZZDA
+13 KILL ACRZZDA
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+14 QUIT
SS1 ;EP;
+1 DO DISPLAY
+2 DO H1
+3 SET ACR=""
+4 IF '$DATA(ACRDTAIL)
DO SS3
+5 IF '$DATA(ACRSUBO)
SET ACRGREF="^TMP(""ACRSOF"",$J)"
+6 IF '$TEST
SET ACRGREF="^TMP(""ACRSOF"",$J,""SUB"")"
+7 FOR
SET ACR=$ORDER(@ACRGREF@(ACR))
IF ACR=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+8 IF $DATA(ACRDTAIL)
DO SS2
+9 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 IF '$DATA(ACRSUBO)
SET ACR0=^TMP("ACRSOF",$JOB,ACR)
+11 IF $DATA(ACRSUBO)
SET ACR0=^TMP("ACRSOF",$JOB,"SUB",ACR)
+12 FOR ACRI=1:1:4,25
SET @("ACR"_ACRI)=$PIECE(ACR0,U,ACRI)
+13 IF $DATA(ACRDTAIL)
IF '$DATA(ACRDTL1)
Begin DoDot:2
+14 WRITE $$DASH^ACRFMENU
+15 QUIT
End DoDot:2
+16 IF '$DATA(ACRDTL1)
Begin DoDot:2
+17 IF '$DATA(ACRDTAIL)
WRITE !,"OBJECT CODE: ",ACR
+18 IF $DATA(ACRDTAIL)
WRITE !
+19 WRITE ?30," TOTALS"
+20 WRITE ?40,$JUSTIFY(ACR25,8)
+21 WRITE ?50,$JUSTIFY($FNUMBER(ACR1,"P,",2),15)
+22 WRITE ?64,$JUSTIFY($FNUMBER(ACR2,"P,",2),15)
+23 IF ION<81
WRITE !?65
+24 IF ION>80
WRITE ?80
+25 WRITE $JUSTIFY($FNUMBER($SELECT(ACR4>ACR3:ACR4,1:ACR3),"P,",2),15)
End DoDot:2
+26 SET ACRREQ=ACRREQ+ACR1
+27 SET ACROBL=ACROBL+ACR2
+28 SET ACRSPT=ACRSPT+$SELECT(ACR4>ACR3:ACR4,1:ACR3)
+29 SET ACRTOT=ACRTOT+ACR25
+30 IF $Y>(IOSL-5)
Begin DoDot:2
+31 DO PAUSE^ACRFWARN
+32 WRITE @IOF
+33 DO H1
End DoDot:2
End DoDot:1
+34 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+35 WRITE $$DASH^ACRFMENU
+36 WRITE ?30," TOTALS: ",ACR
+37 WRITE ?40,$JUSTIFY(ACRTOT,8)
+38 WRITE ?50,$JUSTIFY($FNUMBER(ACRREQ,"P,",2),15)
+39 WRITE ?64,$JUSTIFY($FNUMBER(ACROBL,"P,",2),15)
+40 IF ION<81
WRITE !?65
+41 IF ION>80
WRITE ?80
+42 WRITE $JUSTIFY($FNUMBER(ACRSPT,"P,",2),15)
+43 IF $GET(ACRBUD)
Begin DoDot:1
+44 WRITE !,"TOTAL ALLOWANCE: ",$JUSTIFY($FNUMBER(ACRBUD,"P,",2),15)
+45 WRITE ?37,"REMAINING:"
+46 WRITE ?50,$JUSTIFY($FNUMBER(ACRBUD-ACRREQ,"P,",2),15)
+47 WRITE ?64,$JUSTIFY($FNUMBER(ACRBUD-ACROBL,"P,",2),15)
End DoDot:1
+48 IF $GET(ACRBUD)
Begin DoDot:1
+49 IF ION<81
WRITE !?65
+50 IF ION>80
WRITE ?80
+51 WRITE $JUSTIFY($FNUMBER(ACRBUD-ACRSPT,"P,",2),15)
End DoDot:1
+52 QUIT
SS2 SET ACRX=""
+1 DO SS3
+2 FOR
SET ACRX=$ORDER(^TMP("ACRSOF",$JOB,ACR,ACRX))
IF ACRX=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
SET ACR0=^(ACRX)
Begin DoDot:1
+3 FOR ACRI=1:1:6,11,21,22
SET @("ACR"_ACRI)=$PIECE(ACR0,U,ACRI)
+4 WRITE !,$EXTRACT(ACR1,4,7),$EXTRACT(ACR1,2,3)
+5 WRITE ?7,ACR2
+6 WRITE ?22,ACR3
+7 WRITE ?50,$JUSTIFY($FNUMBER(ACR5,"P,",2),15)
+8 WRITE ?64,$JUSTIFY($FNUMBER(ACR6,"P,",2),15)
+9 IF ION>80
WRITE ?80,$JUSTIFY($FNUMBER($SELECT(ACR21>ACR22:ACR21,1:ACR22),"P,",2),15)
+10 IF ACR11]""!($PIECE(ACR0,U,10)]"")!(ION<81)
WRITE !
+11 IF ACR11]""
WRITE $EXTRACT(ACR11,4,7),$EXTRACT(ACR11,2,3)
+12 IF $PIECE(ACR0,U,10)]""
WRITE ?7,$PIECE(ACR0,U,10)
+13 ;I ACR4 W ?22,$E($P(^VA(200,ACR4,0),U),1,10) ;ACR*2.1*19.02 IM16848
+14 ;ACR*2.1*19.02 IM16848
IF ACR4
WRITE ?22,$EXTRACT($$NAME2^ACRFUTL1(ACR4),1,10)
+15 IF ION<81
WRITE ?65,$JUSTIFY($FNUMBER($SELECT(ACR21>ACR22:ACR21,1:ACR22),"P,",2),15)
+16 IF $Y>(IOSL-5)
Begin DoDot:2
+17 DO PAUSE^ACRFWARN
+18 WRITE @IOF
+19 IF '$DATA(ACRQUIT)
Begin DoDot:3
+20 DO H1
+21 DO SS3
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
SS3 IF $DATA(ACRDTAIL)
Begin DoDot:1
+1 IF '$DATA(ACRDTL1)
Begin DoDot:2
+2 WRITE !
+3 WRITE "OBJECT CODE: ",ACR
End DoDot:2
IF 1
+4 WRITE !,$SELECT($EXTRACT(ACR,1,2)'=21:"DATE",1:"BEGIN")
+5 WRITE ?7,"DOCUMENT NO."
+6 IF $EXTRACT(ACR,1,2)'=21
WRITE ?22,"IDENTIFIER/INITIATOR"
+7 IF $EXTRACT(ACR,1,2)=21
WRITE ?22,"PURPOSE OF TRAVEL"
+8 WRITE ?53,"REQUESTED",?68,"OBLIGATED"
End DoDot:1
+9 IF '$DATA(ACRDTAIL)
Begin DoDot:1
+10 WRITE !?40,"NUMBER OF",?53,"REQUESTED",?68,"OBLIGATED"
End DoDot:1
+11 IF ION>80
Begin DoDot:1
+12 WRITE ?40,"DOCUMENTS",?84,"SPENT"
End DoDot:1
+13 IF ION<81
Begin DoDot:1
+14 WRITE !
+15 IF '$DATA(ACRDTAIL)
WRITE ?40,"DOCUMENTS"
+16 WRITE ?68,"SPENT"
End DoDot:1
+17 WRITE $$DASH^ACRFMENU
+18 QUIT
SS5 ;EP;TO REPORT BY SUB-OBJECT CODE
+1 DO DISPLAY
+2 DO H1
+3 SET ACR=""
+4 DO SS3
+5 FOR
SET ACR=$ORDER(^TMP("ACRSOF",$JOB,"SUB",ACR))
IF ACR=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+6 SET ACR0=^TMP("ACRSOF",$JOB,"SUB",ACR)
+7 FOR ACRI=1:1:4,25
SET @("ACR"_ACRI)=$PIECE(ACR0,U,ACRI)
+8 IF $DATA(ACRDTAIL)
IF '$DATA(ACRDTL1)
Begin DoDot:2
+9 WRITE $$DASH^ACRFMENU
+10 QUIT
End DoDot:2
+11 IF '$DATA(ACRDTL1)
Begin DoDot:2
+12 IF '$DATA(ACRDTAIL)
WRITE !,"OBJECT CODE: ",ACR
+13 IF $DATA(ACRDTAIL)
WRITE !
+14 WRITE ?30," TOTALS"
+15 WRITE ?40,$JUSTIFY(ACR25,8)
+16 WRITE ?50,$JUSTIFY($FNUMBER(ACR1,"P,",2),15)
+17 WRITE ?64,$JUSTIFY($FNUMBER(ACR2,"P,",2),15)
+18 IF ION<81
WRITE !?65
+19 IF ION>80
WRITE ?80
+20 WRITE $JUSTIFY($FNUMBER($SELECT(ACR4>ACR3:ACR4,1:ACR3),"P,",2),15)
End DoDot:2
+21 SET ACRREQ=ACRREQ+ACR1
+22 SET ACROBL=ACROBL+ACR2
+23 SET ACRSPT=ACRSPT+$SELECT(ACR4>ACR3:ACR4,1:ACR3)
+24 SET ACRTOT=ACRTOT+ACR25
+25 IF $Y>(IOSL-5)
Begin DoDot:2
+26 DO PAUSE^ACRFWARN
+27 WRITE @IOF
+28 DO H1
End DoDot:2
End DoDot:1
+29 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+30 WRITE $$DASH^ACRFMENU
+31 WRITE !?40,"TOTALS: ",ACR
+32 WRITE ?30," TOTALS: ",ACR
+33 WRITE ?40,$JUSTIFY(ACRTOT,8)
+34 WRITE ?50,$JUSTIFY($FNUMBER(ACRREQ,"P,",2),15)
+35 WRITE ?64,$JUSTIFY($FNUMBER(ACROBL,"P,",2),15)
+36 IF ION<81
WRITE !?65
+37 IF ION>80
WRITE ?80
+38 WRITE $JUSTIFY($FNUMBER(ACRSPT,"P,",2),15)
+39 IF $GET(ACRBUD)
Begin DoDot:1
+40 WRITE !,"TOTAL ALLOWANCE: ",$JUSTIFY($FNUMBER(ACRBUD,"P,",2),15)
+41 WRITE ?37,"REMAINING:"
+42 WRITE ?50,$JUSTIFY($FNUMBER(ACRBUD-ACRREQ,"P,",2),15)
+43 WRITE ?64,$JUSTIFY($FNUMBER(ACRBUD-ACROBL,"P,",2),15)
End DoDot:1
+44 IF $GET(ACRBUD)
Begin DoDot:1
+45 IF ION<81
WRITE !?65
+46 IF ION>80
WRITE ?80
+47 WRITE $JUSTIFY($FNUMBER(ACRBUD-ACRSPT,"P,",2),15)
End DoDot:1
+48 QUIT
FY ;EP - SELECT FISCAL YEAR
+1 SET DIR(0)="NOA^1000:9999"
+2 SET DIR("A")="Fiscal Year..: "
+3 SET DIR("B")=$SELECT(+$EXTRACT(DT,4,5)>9:DT\10000+1,1:DT\10000)+1700
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF 'Y
SET ACRQUIT=""
QUIT
+7 SET ACRFY=Y
+8 QUIT
LCOD ;EP;TO SELECT LOCATION CODE
+1 SET DIC="^AUTTLCOD("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Location Code: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET (ACRLCDA,ACRZDA)=+Y
+8 QUIT
