ACRFHM.m

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