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

ASURM15P.m

Go to the documentation of this file. 
  1. ASURM15P ; IHS/ITSC/LMH - REPORT 15 MONTHLY COST REPORT ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK AEF/2970311
  1.  ;This routine produces report #15, Monthly Cost Report
  1.  ;
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT (USER INTERACTIVE)
  1.  ;
  1.  N ASUDT,ASUTYP
  1.  D ^XBKVAR,HOME^%ZIS
  1.  D SELXTRCT^ASUUTIL G QUIT:'$D(ASUDT)
  1.  W !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
  1.  S ZTSAVE("ASUDT")="",ZTSAVE("ASUTYP")=""
  1.  D QUE^ASUUTIL("DQ^ASURM15P",.ZTSAVE,"SAMS RPT #15 - MONTHLY COST REPORT")
  1.  D QUIT
  1.  Q
  1. EN1(ASUDT,ASUTYP)  ;EP
  1.  ;----- ENTRY POINT CALLED BY ^ASURMSTD (NON-USER INTERACTIVE)
  1.  ;
  1. DQ ;EP -- QUEUED JOB STARTS HERE
  1.  ;
  1.  ;      ASUDT  =  report extract date or month
  1.  ;      ASUTYP =  type of report, I=individual extract, M=monthly
  1.  ;
  1.  N ASU,ASUD
  1.  D ^XBKVAR
  1.  D GET,PRT,QUIT
  1.  Q
  1. GET ;EP ; GATHER DATA
  1.  ;
  1.  ;      Main loop through ASUTRN ISSUE and ASUTRN DIRECT ISSUE files
  1.  ;
  1.  ;      ASU("DT","BEG") = beginning date of fiscal year 
  1.  ;      ASU("DT","END") = ending date of fiscal year
  1.  ;      ASU("DT","FY")  = fiscal year
  1.  ;      ASU("TC")       = array containing allowable transaction codes
  1.  ;      ASU0            = transaction type where:
  1.  ;                        3 = ISSUE
  1.  ;                        7 = DIRECT ISSUE
  1.  ;      ASU1            = extracted date in 'AX' crossreference
  1.  ;      ASU2            = internal file entry number
  1.  ;      ASUD("TRANS")   = transaction type
  1.  ;      ASUD("STATUS")  = transaction status
  1.  ;
  1.  N ASU0,ASU1,ASU2,ASUI
  1.  K ^XTMP("ASUR","R15")
  1.  D DT^ASUUTIL(.ASUDT,ASUTYP)
  1.  Q:'$D(ASUDT("DXTRACT"))
  1.  S (ASU("DT","BEG"),ASU("DT","END"))=$E(ASU("DT","FY"),1,3)
  1.  S ASU("DT","BEG")=(ASU("DT","BEG")-1)_"0999"
  1.  S ASU("DT","END")=ASU("DT","END")_"0999"
  1.  F ASUI=32,33,"3K","3L" S ASU("TC",ASUI)=""
  1.  S ASU1=ASU("DT","BEG")
  1.  F  S ASU1=$O(^ASUH("AX",ASU1)) Q:'ASU1  Q:ASU1>ASU("DT","END")  D
  1.  . S ASU2=0 F  S ASU2=$O(^ASUH("AX",ASU1,ASU2)) Q:'ASU2  D
  1.  . . S ASUD("TRANS")=$P($G(^ASUH(ASU2,1)),U),ASU0=$E(ASUD("TRANS")) S:ASU0=0 ASU0=7
  1.  . . I ASU0'=3&(ASU0'=7) Q
  1.  . . I ASU0=3 Q:'$D(ASU("TC",ASUD("TRANS")))
  1.  . . D DATA16^ASUUTIL(ASU2)
  1.  . . Q:ASUD("STATUS")=""
  1.  . . Q:"UX"'[ASUD("STATUS")
  1.  . . D SET
  1.  Q
  1. SET ;----- SETS DATA INTO ^XTMP("ASUR","R15") GLOBAL
  1.  ;
  1.  ;      Sorts and totals the transaction data and sets it into the
  1.  ;      ^XTMP("ASUR","R15") global
  1.  ;
  1.  ;      ASU      = array containing dates and transaction codes
  1.  ;      ASUD     = array containing transaction data
  1.  ;      ASU0     = transaction type where:
  1.  ;                 3 = ISSUE
  1.  ;                 7 = DIRECT ISSUE
  1.  ;      ASU1     = transaction date
  1.  ;      ASUPC    = piece designation in ^TMP global where totals are put
  1.  ;                 corresponding to report columns where:
  1.  ;                 1 = current month stock issue total
  1.  ;                 2 = fiscal year stock issue total
  1.  ;                 3 = direct issue current month stock issue total
  1.  ;                 4 = direct issue fiscal year direct issue total
  1.  ;                 5 = fuel oil current month total
  1.  ;                 6 = fuel oil fiscal year total
  1.  ;      ASUPCM   = month piece (1, 3, or 5)
  1.  ;      ASUPCY   = fiscal year piece (2, 4, or 6)
  1.  ;      ASUOOT  = root of ^XTMP("ASUR","R15") global for data
  1.  ;      ASUGLOB  = the ^XTMP("ASUR","R15") where data is stored
  1.  ;      ASUX     = ^TMP global subscript
  1.  ;      ASU("DXTRACT") = array containing extract dates
  1.  ;      ASU("OBJ")     = transaction object class code
  1.  ;      ASU("VAL")     = transaction amount
  1.  ;
  1.  N ASUGLOB,ASUPC,ASUPCM,ASUPCY,ASUOOT,ASUX
  1.  I $D(ASUDT("DXTRACT",ASU1)) D
  1.  . I ASU0=3 S ASUPCM=1,ASUPCY=2
  1.  . I ASU0=7,ASUD("OBJ")'="268H" S ASUPCM=3,ASUPCY=4
  1.  . I ASU0=7,ASUD("OBJ")="268H" S ASUPCM=5,ASUPCY=6
  1.  I '$D(ASUDT("DXTRACT",ASU1)) D
  1.  . I ASU0=3 S ASUPCM=0,ASUPCY=2
  1.  . I ASU0=7,ASUD("OBJ")'="268H" S ASUPCM=0,ASUPCY=4
  1.  . I ASU0=7,ASUD("OBJ")="268H" S ASUPCM=0,ASUPCY=6
  1.  F ASUPC=ASUPCM,ASUPCY D
  1.  . S ASUOOT="^TMP(""ASUR"","_$J_",""R15"","
  1.  . F ASUX="AREA","STA","SST","USR","CAN","ACC" D
  1.  . . S ASUOOT=ASUOOT_"ASUD("_""""_ASUX_""""_"),"
  1.  . . S ASUGLOB=ASUOOT_"0)"
  1.  . . S $P(@ASUGLOB,U,ASUPC)=$P($G(@ASUGLOB),U,ASUPC)+ASUD("VAL")
  1.  . I ASU0=7,ASUD("OBJ")'="248H",ASUPC'=ASUPCY D
  1.  . . S ASUOOT=ASUOOT_"ASUD("_""""_"OBJ"_""""_"),"
  1.  . . S ASUGLOB=ASUOOT_"0)"
  1.  . . S $P(@ASUGLOB,U,ASUPC)=$P($G(@ASUGLOB),U,ASUPC)+ASUD("VAL")
  1.  Q
  1. PRT ;----- PRINTS THE DATA
  1.  ;
  1.  ;      ASUL(         =  loop counter array
  1.  ;      ASUPAGE       =  report page number
  1.  ;      ASUTOT("ACC") =  array where GL account totals are stored
  1.  ;      ASUOUT        =  '^' to continue controller
  1.  ;      ASUDATA       =  temporary data storage
  1.  ;
  1.  N ASUL,ASUPAGE,ASUOUT,ASUTOT
  1.  S ASUOUT=0
  1.  I '$D(^XTMP("ASUR","R15")) W !!,"NO DATA FOR REPORT 15" Q
  1.  D LOOPS
  1.  Q
  1. LOOPS ;----- Loops 1-7 loop through the ^XTMP("ASUR","R15") global and
  1.  ;      print the report
  1.  ;
  1. 1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(1)="" F  S ASUL(1)=$O(^XTMP("ASUR","R15",ASUL(1))) Q:ASUL(1)']""  D  Q:ASUOUT
  1.  . Q:ASUL(1)=0
  1.  . D 2 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !!,"AREA ",ASUL(1)," TOTALS"
  1.  . D WRITE(ASUDATA)
  1.  Q
  1. 2 ;----- LOOP THROUGH THE STATION SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . Q:ASUL(2)=0
  1.  . D HDR
  1.  . D 3 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !,"STATION ",ASUL(2)," TOTALS"
  1.  . D WRITE(ASUDATA)
  1.  Q
  1. 3 ;----- LOOP THROUGH THE SUB-STATION SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(3)="" F  S ASUL(3)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']""  D  Q:ASUOUT
  1.  . Q:ASUL(3)=0
  1.  . I $G(ASUPAGE)>1 D HDR
  1.  . D 4 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !,"SUB-STATION ",ASUL(3)," TOTALS"
  1.  . D WRITE(ASUDATA)
  1.  . W !
  1.  Q
  1. 4 ;----- LOOP THROUGH THE USER SUBSCRIPT
  1.  ;
  1.  N ASUDATA,ASUI
  1.  S ASUL(4)="" F  S ASUL(4)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4))) Q:ASUL(4)']""  D  Q:ASUOUT
  1.  . Q:ASUL(4)=0
  1.  . D 5 Q:ASUOUT
  1.  . S ASUI="" F  S ASUI=$O(ASUTOT("ACC",ASUL(3),ASUL(4),ASUI)) Q:ASUI']""  D  Q:ASUOUT
  1.  . . S ASUDATA=ASUTOT("ACC",ASUL(3),ASUL(4),ASUI)
  1.  . . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . . W !?25,ASUI,?31,"TOTAL"
  1.  . . D WRITE(ASUDATA)
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !?8,"USER CODE TOTALS"
  1.  . D WRITE(ASUDATA)
  1.  . W !
  1.  Q
  1. 5 ;----- LOOP THROUGH THE CAN SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(5)="" F  S ASUL(5)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5))) Q:ASUL(5)']""  D  Q:ASUOUT
  1.  . Q:ASUL(5)=0
  1.  . D 6 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !?17,"CAN TOTALS"
  1.  . D WRITE(ASUDATA)
  1.  . W !
  1.  Q
  1. 6 ;----- LOOP THROUGH THE GL ACCOUNT SUBSCRIPT
  1.  ;
  1.  N ASUDATA,ASUI
  1.  S ASUL(6)="" F  S ASUL(6)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),ASUL(6))) Q:ASUL(6)']""  D  Q:ASUOUT
  1.  . Q:ASUL(6)=0
  1.  . D 7 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),ASUL(6),0)
  1.  . F ASUI=1:1:6 D
  1.  . . S $P(ASUTOT("ACC",ASUL(3),ASUL(4),ASUL(6)),U,ASUI)=$P($G(ASUTOT("ACC",ASUL(3),ASUL(4),ASUL(6))),U,ASUI)+$P(ASUDATA,U,ASUI)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !?2,$E(ASUL(3),1,2),?8,ASUL(4),?17,ASUL(5),?25,ASUL(6),?31,"TOTAL"
  1.  . D WRITE(ASUDATA)
  1.  Q
  1. 7 ;----- LOOP THROUGH THE SUBOBJECT SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(7)="" F  S ASUL(7)=$O(^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),ASUL(6),ASUL(7))) Q:ASUL(7)']""  D  Q:ASUOUT
  1.  . Q:ASUL(7)=0
  1.  . S ASUDATA=^XTMP("ASUR","R15",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),ASUL(6),ASUL(7),0)
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . W !?2,$E(ASUL(3),1,2),?8,ASUL(4),?17,ASUL(5),?25,ASUL(6),?38,$J($P(ASUDATA,U),10,2),?66,$S(ASUL(7)="268H":"",1:$E(ASUL(7),3,4))
  1.  . W ?70,$J($P(ASUDATA,U,3),10,2),?84,$J($P(ASUDATA,U,4),10,2),?104,$J($P(ASUDATA,U,5),10,2),?118,$J($P(ASUDATA,U,6),10,2)
  1.  Q
  1. WRITE(X) ;----- WRITES TOTALS
  1.  ;
  1.  W ?38,$J($P(X,U),10,2),?52,$J($P(X,U,2),10,2),?70,$J($P(X,U,3),10,2),?84,$J($P(X,U,4),10,2),?104,$J($P(X,U,5),10,2),?118,$J($P(X,U,6),10,2)
  1.  Q
  1. HDR ;----- WRITES REPORT HEADER
  1.  ;
  1.  N %,DIR,X,Y
  1.  I $E(IOST)="C",$G(ASUPAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S ASUOUT=1 Q
  1.  S ASUPAGE=$G(ASUPAGE)+1
  1.  W @IOF
  1.  W "REPORT #15 MONTHLY COST REPORT FOR ",$S(ASUTYP="M":"MONTH ",ASUTYP="I":"EXTRACT DATE ",1:"")
  1.  S Y=ASUDT X ^DD("DD") W Y
  1.  W ?116,"PAGE  ",$J(ASUPAGE,6)
  1.  W !,"AREA ",$G(ASUL(1)),!,"STAT ",$G(ASUL(2))
  1.  W !!,"SUB",?18,"COMMON",?27,"G L",?33,"STOCK ISSUES-OBJECT CLASS 26",?65,"DIRECT ISSUES-OBJECT CLASS 26",?101,"FUEL OIL OBJ-SUBOBJ 26.8H"
  1.  W !,"STAT",?8,"USER",?14,"ACCOUNTING",?26,"ACCT",?34,"CURRENT MONTH",?54,"YEAR-TO-",?66,"CURRENT MONTH",?87,"YEAR-TO-",?100,"CURRENT MONTH",?121,"YEAR-TO-"
  1.  W !,"CODE",?8,"CODE",?18,"NUMBER",?27,"NO.",?32,"SUBOBJ",?43,"VALUE",?52,"DATE VALUE",?64,"SUBOBJ",?75,"VALUE",?85,"DATE VALUE",?97,"SUBOBJ",?109,"VALUE",?119,"DATE VALUE"
  1.  W !
  1.  Q
  1. QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","R15")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q