ACRFSOF1.m

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