Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFFDH1

ACRFFDH1.m

Go to the documentation of this file.
  1. ACRFFDH1 ;IHS/OIRM/DSD/AEF - continuation of ACRFFDH [ 10/27/2004 4:18 PM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
  1. ;;SPECIAL DIAGNOSTIC REPORTS
  1. ;
  1. ;
  1. EN ;EP -- MAIN ENTRY POINT
  1. ;
  1. N ALLOW,APPROP,DATA,DEPT,OUT,PAGE,SUBALLOW,X,Y
  1. D PRT
  1. Q
  1. PRT ;----- PRINT THE REPORT
  1. D P
  1. Q
  1. P ;----- LOOP THROUGH APPROPRIATION SUBSCRIPT
  1. ;
  1. S APPROP=0 F S APPROP=$O(^TMP("ACRFFDH",$J,1,APPROP)) Q:'APPROP D ONE(APPROP) Q:$G(OUT)
  1. Q
  1. ONE(X) ;EP -- PRINT STRUCTURE OF ONE APPROPRIATION
  1. ;
  1. ; X = APPROPRIATION IEN
  1. ;
  1. D P^ACRFFDH(X)
  1. D HDR
  1. Q:$G(OUT)
  1. W !,"APPROPRIATION:",?16,"("_APPROP("D","IEN")_") ",?25,APPROP("D","NAME")
  1. D WRITE(APPROP("D","FY"),APPROP("D","CREATE FY"),APPROP("D","AMOUNT"))
  1. D A(APPROP("D","IEN"))
  1. Q
  1. A(X) ;----- LOOP THROUGH ALLOWANCE SUBSCRIPT
  1. ;
  1. ; X = APPROPRIATION IEN
  1. ;
  1. S APPROP=X
  1. S ALLOW=0 F S ALLOW=$O(^TMP("ACRFFDH",$J,1,APPROP,2,ALLOW)) Q:'ALLOW D Q:$G(OUT)
  1. . D A^ACRFFDH(ALLOW)
  1. . I $Y>(IOSL-5) D HDR Q:$G(OUT)
  1. . W !," ALLOWANCE:",?16,"("_ALLOW("D","IEN")_") ",?25,ALLOW("D","NAME")
  1. . D WRITE(ALLOW("D","FY"),ALLOW("D","CREATE FY"),ALLOW("D","AMOUNT"))
  1. . D S(ALLOW("D","IEN"))
  1. Q
  1. S(X) ;----- LOOP THROUGH SUB ALLOWANCE SUBSCRIPT
  1. ;
  1. ; X = ALLOWANCE IEN
  1. ;
  1. S ALLOW=X
  1. S SUBALLOW=0 F S SUBALLOW=$O(^TMP("ACRFFDH",$J,1,APPROP,2,ALLOW,3,SUBALLOW)) Q:'SUBALLOW D Q:$G(OUT)
  1. . D S^ACRFFDH(SUBALLOW)
  1. . I $Y>(IOSL-5) D HDR Q:$G(OUT)
  1. . W !," SUBALLOW:",?16,"("_SUBALLOW("D","IEN")_") ",?25,SUBALLOW("D","NAME")
  1. . D WRITE(SUBALLOW("D","FY"),SUBALLOW("D","CREATE FY"),SUBALLOW("D","AMOUNT"))
  1. . D D(SUBALLOW("D","IEN"))
  1. Q
  1. D(X) ;----- LOOP THROUGH DEPARTMENT SUBSCRIPT
  1. ;
  1. ; X = SUB-ALLOWANCE IEN
  1. ;
  1. S SUBALLOW=X
  1. S DEPT=0 F S DEPT=$O(^TMP("ACRFFDH",$J,1,APPROP,2,ALLOW,3,SUBALLOW,4,DEPT)) Q:'DEPT D Q:$G(OUT)
  1. . D D^ACRFFDH(DEPT)
  1. . I $Y>(IOSL-5) D HDR Q:$G(OUT)
  1. . W !," DEPT:",?16,"("_DEPT("D","IEN")_") ",?25,DEPT("D","NAME")
  1. . D WRITE(DEPT("D","FY"),DEPT("D","CREATE FY"),DEPT("D","AMOUNT"))
  1. Q
  1. WRITE(FY,NFY,AMT) ;
  1. ;----- WRITES DATA
  1. ;
  1. W ?58,FY
  1. W ?63,$S(NFY=1:"Y",NFY=2:"N",1:"")
  1. W ?67,$J(AMT,12,2)
  1. Q
  1. HDR ;----- WRITES HEADER
  1. ;
  1. N DIR
  1. I $E(IOST)="C",$G(PAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S OUT=1 Q
  1. S PAGE=$G(PAGE)+1
  1. W @IOF
  1. W !,"DISTRIBUTION OF FUNDS HIERARCHICAL STRUCTURE"
  1. W ?49,$$NOW
  1. W " PAGE ",PAGE
  1. W !,"APPROPRIATION: "_APPROP("D","NAME")
  1. W !!,?58,"FY",?62,"NXT",?73,"AMOUNT"
  1. W !
  1. Q
  1. NOW() ;EP -- RETURNS CURRENT DATE/TIME
  1. ;
  1. N %,%H,%I,X
  1. D NOW^%DTC
  1. S Y=DT
  1. X ^DD("DD")
  1. Q Y_" "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)
  1. ;
  1. QUE(ZTRTN,ZTSAVE,ZTDESC) ;EP;
  1. Q ;ACR*2.1*13.02 IM13574
  1. ;----- QUEUEING CODE
  1. ;
  1. N %ZIS,IO,POP,ZTIO,ZTSK
  1. S %ZIS="Q" D ^%ZIS Q:POP
  1. I $D(IO("Q")) K IO("Q") S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD I $G(ZTSK) W !,"Task #",$G(ZTSK)," queued"
  1. E D @ZTRTN
  1. Q