ACRFFDH2.m

ACRFFDH2 ;IHS/OIRM/DSD/AEF - PRINT FUNDS DISTRIBUTION ACCOUNTS HIERARCHICAL STRUCTURE FOR SELECTED APPROPRIATIONS [ 10/27/2004   4:18 PM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001

 ;;SPECIAL DIAGNOSTIC REPORTS

 ;

 ;

 ;This routine loops through the FMS Department, FMS Sub-Allowance, FMS

 ;Allowance and FMS Appropriation file for individual appropriations and

 ;produces a report showing the hierarchical structure of the accounts

 ;

EN ;EP -- MAIN ENTRY POINT TO PRINT ONE OR MORE INDIVIDUAL APPROPRIATIONS

 ;

 N APP,X,Y,ZTDESC,ZTRTN,ZTSAVE

 D ^XBKVAR,HOME^%ZIS

 D SELECT

 I '$D(APP) W !,"No appropriations were selected" Q

 S ZTSAVE("APP(")=""

 D PRINT

 Q

SELECT ;----- SELECT WHICH APPROPRIATION(S) TO PRINT

 ;

 N DIC,OUT,X,Y

 S D="C"

 S DIC(0)="AEMNQ"

 S DIC="^ACRAPP("

 S DIC("A")="Select APPROPRIATION: "

 F  D  Q:$G(OUT)

 . D ^DIC

 . I $D(DTOUT)!($D(DUOUT))!(Y'>0) S OUT=1 Q

 . S APP(+Y)=Y

 . I $D(APP) S DIC("A")="Select Another APPROPRIATION: "

 Q

PRINT ;----- PRINT THE REPORT

 ;

 D QUE^ACRFUTL("DQ^ACRFFDH2",.ZTSAVE,"FUNDS DISTRIBUTION REPORT") ;ACR*2.1*13.02 IM13574

 Q

DQ ;----- QUEUED JOB STARTS HERE

 ;

 N ALLOW,APPROP,DATA,DEPT,OUT,PAGE,SUBALLOW,X,Y

 K ^TMP("ACRFFDH",$J)

 D DEPT^ACRFFDH,SUB^ACRFFDH,ALLOW^ACRFFDH,APP^ACRFFDH

 S APP=0 F  S APP=$O(APP(APP)) Q:'APP  D ONE^ACRFFDH1(APP) Q:$G(OUT)

 D QUIT

 Q

QUIT ;----- CLEAN UP, CLOSE DEVICE, QUIT JOB

 ;

 K ZTSAVE

 K ^TMP("ACRFFDH",$J)

 D ^%ZISC

 Q

ACRFFDH2  ;IHS/OIRM/DSD/AEF - PRINT FUNDS DISTRIBUTION ACCOUNTS HIERARCHICAL STRUCTURE FOR SELECTED APPROPRIATIONS [ 10/27/2004   4:18 PM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001

 +2       ;;SPECIAL DIAGNOSTIC REPORTS

 +3       ;

 +4       ;

 +5       ;This routine loops through the FMS Department, FMS Sub-Allowance, FMS

 +6       ;Allowance and FMS Appropriation file for individual appropriations and

 +7       ;produces a report showing the hierarchical structure of the accounts

 +8       ;

EN        ;EP -- MAIN ENTRY POINT TO PRINT ONE OR MORE INDIVIDUAL APPROPRIATIONS

 +1       ;

 +2        NEW APP,X,Y,ZTDESC,ZTRTN,ZTSAVE

 +3        DO ^XBKVAR

           DO HOME^%ZIS

 +4        DO SELECT

 +5        IF '$DATA(APP)

               WRITE !,"No appropriations were selected"

               QUIT 

 +6        SET ZTSAVE("APP(")=""

 +7        DO PRINT

 +8        QUIT 

SELECT    ;----- SELECT WHICH APPROPRIATION(S) TO PRINT

 +1       ;

 +2        NEW DIC,OUT,X,Y

 +3        SET D="C"

 +4        SET DIC(0)="AEMNQ"

 +5        SET DIC="^ACRAPP("

 +6        SET DIC("A")="Select APPROPRIATION: "

 +7        FOR 

               Begin DoDot:1

 +8                DO ^DIC

 +9                IF $DATA(DTOUT)!($DATA(DUOUT))!(Y'>0)

                       SET OUT=1

                       QUIT 

 +10               SET APP(+Y)=Y

 +11               IF $DATA(APP)

                       SET DIC("A")="Select Another APPROPRIATION: "

               End DoDot:1

               IF $GET(OUT)

                   QUIT 

 +12       QUIT 

PRINT     ;----- PRINT THE REPORT

 +1       ;

 +2       ;ACR*2.1*13.02 IM13574

           DO QUE^ACRFUTL("DQ^ACRFFDH2",.ZTSAVE,"FUNDS DISTRIBUTION REPORT")

 +3        QUIT 

DQ        ;----- QUEUED JOB STARTS HERE

 +1       ;

 +2        NEW ALLOW,APPROP,DATA,DEPT,OUT,PAGE,SUBALLOW,X,Y

 +3        KILL ^TMP("ACRFFDH",$JOB)

 +4        DO DEPT^ACRFFDH

           DO SUB^ACRFFDH

           DO ALLOW^ACRFFDH

           DO APP^ACRFFDH

 +5        SET APP=0

           FOR 

               SET APP=$ORDER(APP(APP))

               IF 'APP

                   QUIT 

               DO ONE^ACRFFDH1(APP)

               IF $GET(OUT)

                   QUIT 

 +6        DO QUIT

 +7        QUIT 

QUIT      ;----- CLEAN UP, CLOSE DEVICE, QUIT JOB

 +1       ;

 +2        KILL ZTSAVE

 +3        KILL ^TMP("ACRFFDH",$JOB)

 +4        DO ^%ZISC

 +5        QUIT