ACRFHM ;IHS/DSD/THL,AEF - QUERY ARMS/DHR FOR AMOUNTS SPENT; [ 10/27/2004 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
;;
EN D EXIT
D EN1
EXIT K ACRQUIT,ACROUT,ACR1,ACR2,ACRALL,ACR,ACRX,ACROCG,ACROBJDA,ACROBJ,ACROCC
K ^TMP("ACRHM",$J)
Q
EN1 ;
D FY
Q:$D(ACRQUIT)!$D(ACROUT)
D LOCSSA
Q:$D(ACRQUIT)!$D(ACROUT)
D OBJCODE
Q:$D(ACRQUIT)!$D(ACROUT)
D SSALOC
Q:$D(ACRQUIT)!$D(ACROUT)
D ZIS
Q
FY ;DETERMINE FISCAL YEAR
S DIR(0)="N^1000:9999"
S DIR("A")="In 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
I Y'?4N S ACRQUIT="" Q
Q
LOCSSA ;REPORT BY LOCATION OR SUB-SUB-ACTIVITY
S DIR(0)="SOA^1:Location;2:Sub-Sub-Activity"
S DIR("A",1)="How much did we spend by"
S DIR("A")="1 - Location Code or 2 - Sub-sub-Activity: "
S DIR("B")=1
W !
D DIR^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ACR1=$S(Y=1:"LOCATION",1:"SUB-SUB-ACTIVITY")
S ACR2=$S(Y=2:"LOCATION",1:"SUB-SUB-ACTIVITY")
D ALL
I ACRALL="ALL" Q
D SPECIFIC
Q
OBJCODE ;REPORT FOR ALL OR SELECTED OBJECT CODES
W !!,"Do you want the report"
D OC^ACRFSOF
Q
SSALOC ;WITHIN LOCATION OR SUB-SUB-ACTIVITY SHOULD REPORT BE SORTED BY THE
;OTHER
S DIR(0)="YOA"
S DIR("A",1)="Within "_ACR1_" do you want"
S DIR("A")="the report sorted by "_(ACR2)_": "
S DIR("B")="Yes"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I Y=0 S ACRALL="NONE" Q
N ACR1X,ACR2X
S ACR1X=ACR1
S ACR2X=ACR2
S ACR1=ACR2X
S ACR2=ACR1X
D ALL
I ACRALL="ALL" D BACK Q
D SPECIFIC
Q
BACK ; SWITCH CONTROL VARIABLES BACK TO THEIR ORIGINAL VALUES
S ACR1=ACR1X
S ACR2=ACR2X
Q
ZIS ;SELECT PRINTER
S (ZTRTN,ACRRTN)="PRINT^ACRFHM"
S ZTDESC="ARMS-DHR INQUIRY"
D ^ACRFZIS
Q
PRINT ;EP;TO PRINT THE ARMS-DHR INQUIRY REPORT
Q
ALL ;
S DIR(0)="SOA^1:ALL "_ACR1_";2:SELECTED "_ACR1
S DIR("A",1)="Do you want the report for"
S DIR("A")="1 - ALL "_ACR1_" or 2 - SELECTED "_ACR1_": "
S DIR("B")=1
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I Y=1 S ACRALL="ALL" Q
E S ACRALL="SPECIFIC"
Q
SPECIFIC ;SELECT THE ENTITIES FOR THE REPORT
I $E(ACR1)="L" D LOCATION Q
D SSA
Q
LOCATION ;SELECT SPECIFIC LOCATIONS
F D L1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
L1 S DIC="^AUTTLCOD("
S DIC(0)="AEMQZ"
S DIC("A")="Which LOCATION: "
I $O(^TMP("ACRHM",$J,"LOCATION",0)) S DIC("A")="Next LOCATION: "
W !
D DIC^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ^TMP("ACRHM",$J,"LOCATION",+Y)=""
Q
SSA ;SELECT SPECIFIC SUB-SUB-ACTIVITIES
F D S1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
S1 S DIC="^AUTTSSA("
S DIC(0)="AEMQZ"
S DIC("A")="Which SUB-SUB-ACTIVITY: "
S:$O(^TMP("ACRHM",$J,"SUB-SUB-ACTIVITY",0)) DIC("A")="Next SUB-SUB-ACTIVITY: "
W !
D DIC^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ^TMP("ACRHM",$J,"SUB-SUB-ACTIVITY",+Y)=""
Q
IMPORT ;EP;TO IMPORT HAS DATA
S %FN=$$ARMSDIR^ACRFSYS(1) ; ACR*2.1*13.06 IM14144
S ACROP="R"
D HOST^ACRFZIS
Q:$D(ACRQUIT)
D ^%ZISC
Q
ACRFHM ;IHS/DSD/THL,AEF - QUERY ARMS/DHR FOR AMOUNTS SPENT; [ 10/27/2004 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
+2 ;;
EN DO EXIT
+1 DO EN1
EXIT KILL ACRQUIT,ACROUT,ACR1,ACR2,ACRALL,ACR,ACRX,ACROCG,ACROBJDA,ACROBJ,ACROCC
+1 KILL ^TMP("ACRHM",$JOB)
+2 QUIT
EN1 ;
+1 DO FY
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 DO LOCSSA
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 DO OBJCODE
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+7 DO SSALOC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 DO ZIS
+10 QUIT
FY ;DETERMINE FISCAL YEAR
+1 SET DIR(0)="N^1000:9999"
+2 SET DIR("A")="In Fiscal Year "
+3 SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'?4N
SET ACRQUIT=""
QUIT
+7 QUIT
LOCSSA ;REPORT BY LOCATION OR SUB-SUB-ACTIVITY
+1 SET DIR(0)="SOA^1:Location;2:Sub-Sub-Activity"
+2 SET DIR("A",1)="How much did we spend by"
+3 SET DIR("A")="1 - Location Code or 2 - Sub-sub-Activity: "
+4 SET DIR("B")=1
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF Y<1
SET ACRQUIT=""
QUIT
+8 SET ACR1=$SELECT(Y=1:"LOCATION",1:"SUB-SUB-ACTIVITY")
+9 SET ACR2=$SELECT(Y=2:"LOCATION",1:"SUB-SUB-ACTIVITY")
+10 DO ALL
+11 IF ACRALL="ALL"
QUIT
+12 DO SPECIFIC
+13 QUIT
OBJCODE ;REPORT FOR ALL OR SELECTED OBJECT CODES
+1 WRITE !!,"Do you want the report"
+2 DO OC^ACRFSOF
+3 QUIT
SSALOC ;WITHIN LOCATION OR SUB-SUB-ACTIVITY SHOULD REPORT BE SORTED BY THE
+1 ;OTHER
+2 SET DIR(0)="YOA"
+3 SET DIR("A",1)="Within "_ACR1_" do you want"
+4 SET DIR("A")="the report sorted by "_(ACR2)_": "
+5 SET DIR("B")="Yes"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 IF Y=0
SET ACRALL="NONE"
QUIT
+10 NEW ACR1X,ACR2X
+11 SET ACR1X=ACR1
+12 SET ACR2X=ACR2
+13 SET ACR1=ACR2X
+14 SET ACR2=ACR1X
+15 DO ALL
+16 IF ACRALL="ALL"
DO BACK
QUIT
+17 DO SPECIFIC
+18 QUIT
BACK ; SWITCH CONTROL VARIABLES BACK TO THEIR ORIGINAL VALUES
+1 SET ACR1=ACR1X
+2 SET ACR2=ACR2X
+3 QUIT
ZIS ;SELECT PRINTER
+1 SET (ZTRTN,ACRRTN)="PRINT^ACRFHM"
+2 SET ZTDESC="ARMS-DHR INQUIRY"
+3 DO ^ACRFZIS
+4 QUIT
PRINT ;EP;TO PRINT THE ARMS-DHR INQUIRY REPORT
+1 QUIT
ALL ;
+1 SET DIR(0)="SOA^1:ALL "_ACR1_";2:SELECTED "_ACR1
+2 SET DIR("A",1)="Do you want the report for"
+3 SET DIR("A")="1 - ALL "_ACR1_" or 2 - SELECTED "_ACR1_": "
+4 SET DIR("B")=1
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF Y=1
SET ACRALL="ALL"
QUIT
+9 IF '$TEST
SET ACRALL="SPECIFIC"
+10 QUIT
SPECIFIC ;SELECT THE ENTITIES FOR THE REPORT
+1 IF $EXTRACT(ACR1)="L"
DO LOCATION
QUIT
+2 DO SSA
+3 QUIT
LOCATION ;SELECT SPECIFIC LOCATIONS
+1 FOR
DO L1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
L1 SET DIC="^AUTTLCOD("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Which LOCATION: "
+3 IF $ORDER(^TMP("ACRHM",$JOB,"LOCATION",0))
SET DIC("A")="Next LOCATION: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF Y<1
SET ACRQUIT=""
QUIT
+7 SET ^TMP("ACRHM",$JOB,"LOCATION",+Y)=""
+8 QUIT
SSA ;SELECT SPECIFIC SUB-SUB-ACTIVITIES
+1 FOR
DO S1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
S1 SET DIC="^AUTTSSA("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Which SUB-SUB-ACTIVITY: "
+3 IF $ORDER(^TMP("ACRHM",$JOB,"SUB-SUB-ACTIVITY",0))
SET DIC("A")="Next SUB-SUB-ACTIVITY: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF Y<1
SET ACRQUIT=""
QUIT
+7 SET ^TMP("ACRHM",$JOB,"SUB-SUB-ACTIVITY",+Y)=""
+8 QUIT
IMPORT ;EP;TO IMPORT HAS DATA
+1 ; ACR*2.1*13.06 IM14144
SET %FN=$$ARMSDIR^ACRFSYS(1)
+2 SET ACROP="R"
+3 DO HOST^ACRFZIS
+4 IF $DATA(ACRQUIT)
QUIT
+5 DO ^%ZISC
+6 QUIT
