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

ASURM16P.m

Go to the documentation of this file. 
  1. ASURM16P ; IHS/ITSC/LMH - REPORT 16 STATION MONTHLY SUB-SUB-ACTIVITY ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK AEF/2970311
  1.  ;This routine produces report #16, Station Monthly Sub-Sub-Activity
  1.  ;Report
  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:'$G(ASUDT)
  1.  W !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
  1.  S (ZTSAVE("ASUDT"),ZTSAVE("ASUTYP"))=""
  1.  D QUE^ASUUTIL("DQ^ASURM16P",.ZTSAVE,"SAMS RPT #16 - STATION MONTHLY SUB-SUB-ACTIVITY REPORT")
  1.  D QUIT
  1.  Q
  1. EN1(ASUDT,ASUTYP)  ;EP
  1.  ;----- ENTRY POINT CALLED BY ^ASURMSTD (NON-USER INTERACTIVE)
  1.  ;
  1.  ;
  1. DQ ;EP -- QUEUED JOB STARTS HERE
  1.  ;
  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.  ;
  1. GET ;EP -- GETS THE DATA     
  1.  ;
  1.  ;      Main loop through ASUTRN ISSUE, ASUTRN DIRECT ISSUE, and
  1.  ;      ASUTRN RECEIPTS 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.  ;      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
  1.  K ^XTMP("ASUR","R16")
  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.  D TC16^ASUUTIL
  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'=2&(ASU0'=3)&(ASU0'=7) Q
  1.  . . D DATA16^ASUUTIL(ASU2)
  1.  . . Q:'$D(ASU("TC",ASUD("TRANS")))
  1.  . . Q:ASUD("STATUS")=""
  1.  . . Q:"UX"'[ASUD("STATUS")
  1.  . . D SET
  1.  Q
  1. SET ;----- SETS DATA INTO ^XTMP("ASUR","R16") GLOBAL
  1.  ;
  1.  ;      Sorts and totals the transaction data and sets it into the
  1.  ;      ^XTMP("ASUR","R16") global
  1.  ;
  1.  ;      ASU      = array containing dates and transaction codes
  1.  ;      ASUD     = array containing transaction date
  1.  ;      ASU0     = transaction type where:
  1.  ;                 2 = RECEIPTS
  1.  ;                 3 = ISSUES
  1.  ;                 7 = DIRECT ISSUES
  1.  ;      ASU1     = transaction date
  1.  ;      ASUPC    = piece designation in ^TMP global where totals are
  1.  ;                 stored, the piece corresponds to the column on the
  1.  ;                 report
  1.  ;      ASUPCM   = piece in ^TMP global to put monthly totals (1-7)
  1.  ;      ASUPCY   = piece in ^TMP global to put yearly todays (8-14)
  1.  ;      ASUDT("DXTRACT") = array containing extract dates
  1.  ;      ASUD("VAL")      = transaction amount
  1.  ;
  1.  N ASUPC,ASUPCM,ASUPCY
  1.  S ASUPCY=ASU("TC",ASUD("TRANS"))+7
  1.  S ASUPCM=0 S:$D(ASUDT("DXTRACT",ASU1)) ASUPCM=ASU("TC",ASUD("TRANS"))
  1.  F ASUPC=ASUPCM,ASUPCY D
  1.  . S $P(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
  1.  Q
  1. PRT ;----- PRINT THE DATA
  1.  ;
  1.  ;      ASUL         =  loop counter array
  1.  ;      ASUPAGE      =  report page number
  1.  ;      ASUOUT       =  '^' to escape controller
  1.  ;      ASUDATA      =  temporary data storage
  1.  ;      ASUD("ACC")  =  general ledger account number
  1.  ;      ASUHDR       =  array containing report header segments
  1.  ;
  1.  N ASUL,ASUPAGE,ASUOUT,ASUHDR
  1.  S ASUOUT=0
  1.  I '$D(^XTMP("ASUR","R16")) W !!,"NO DATA FOR REPORT 16" Q
  1.  ;
  1.  S ASUHDR(1)="REPORT #16 STATION MONTHLY SUB-SUB-ACTIVITY REPORT"
  1.  S ASUHDR(2)="AREA "_ASUD("AREA")
  1.  S ASUHDR(3)="STAT "_ASUD("STA")
  1.  S ASUHDR(4)="SUB  SUB  A"
  1.  S ASUHDR(5)="STA  SUB  C"
  1.  S ASUHDR(6)="CDE  ACT  C"
  1.  ;
  1.  D LOOPS
  1.  Q
  1. LOOPS ;----- LOOPS THROUGH ^XTMP("ASUR","R16") GLOBAL AND PRINTS
  1.  ;      THE REPORT
  1.  ;
  1. 1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
  1.  ;
  1.  S ASUL(1)="" F  S ASUL(1)=$O(^XTMP("ASUR","R16",1,ASUL(1))) Q:ASUL(1)']""  D  Q:ASUOUT
  1.  . Q:ASUL(1)=0
  1.  . I $G(ASUPAGE)>1 D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  . D 2 Q:ASUOUT
  1.  Q
  1. 2 ;----- LOOP THROUGH THE STATION SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . Q:ASUL(2)=0
  1.  . I $G(ASUPAGE)>1 D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  . D 3 Q:ASUOUT
  1.  . D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  . S ASUD("ACC")="" F  S ASUD("ACC")=$O(^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC"))) Q:ASUD("ACC")']""  D  Q:ASUOUT
  1.  . . I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
  1.  . . W !,"ALL ACCT ",$P(ASUD("ACC"),".",2)
  1.  . . S ASUDATA=^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC"),0)
  1.  . . D WRITE16^ASUUTIL(ASUDATA)
  1.  . I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
  1.  . W !,"STA TOTAL"
  1.  . S ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),0)
  1.  . D WRITE16^ASUUTIL(ASUDATA)
  1.  Q
  1. 3 ;----- LOOP THROUGH THE SUB-STATION SUBSCRIPT
  1.  ;
  1.  S ASUL(3)="" F  S ASUL(3)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']""  D  Q:ASUOUT
  1.  . Q:ASUL(3)=0
  1.  . D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  . D 4 Q:ASUOUT
  1.  Q
  1. 4 ;----- LOOP THROUGH THE SUB-SUB-ACTIVITY SUBSCRIPT
  1.  ;
  1.  S ASUL(4)="" F  S ASUL(4)=$O(^XTMP("ASUR","R16",1,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.  Q
  1. 5 ;----- LOOP THROUGH THE GENERAL LEDGER ACCOUNT SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(5)="" F  S ASUL(5)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5))) Q:ASUL(5)']""  D  Q:ASUOUT
  1.  . Q:ASUL(5)=0
  1.  . S ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),0)
  1.  . I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  . W !?1,$S(ASUL(3)="UNK":"",1:$P(ASUL(3)," ")),?6,$S(ASUL(4)="UNK":"",1:ASUL(4)),?10,$P(ASUL(5),".",2)
  1.  . D WRITE16^ASUUTIL(ASUDATA)
  1.  Q
  1. QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","R16")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q