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

ASURM18P.m

Go to the documentation of this file. 
  1. ASURM18P ; IHS/ITSC/LMH - REPORT 18 IHS MONTHLY SUB-SUB-ACTIVITY ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK AEF/2970311
  1.  ;This routine produces report #18, IHS Monthly Sub-Sub_Activity
  1.  ;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:'$G(ASUDT)
  1.  W !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
  1.  S (ZTSAVE("ASUDT"),ZTSAVE("ASUTYP"))=""
  1.  D QUE^ASUUTIL("DQ^ASURM18P",.ZTSAVE,"SAMS RPT #18 - IHS 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. 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 ;----- GETS THE DATA TO BE PRINTED
  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.  ;      ASU0            = transaction type where:
  1.  ;                        2 = RECEIPTS
  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
  1.  K ^XTMP("ASUR","R18")
  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.  ;
  1. SET ;----- SETS DATA INTO ^XTMP("ASUR","R18") GLOBAL
  1.  ;
  1.  ;      Sorts and totals the transaction data and sets it into the
  1.  ;      ^XTMP("ASUR","R18") global
  1.  ;
  1.  ;      ASU      = array where date and transaction code data is stored
  1.  ;      ASUD     = array where transaction data is stored
  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 totals (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","R18",2,"IHS",ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R18",2,"IHS",ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R18",1,"IHS",0),U,ASUPC)=$P($G(^XTMP("ASUR","R18",1,"IHS",0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R18",1,"IHS",ASUD("SSA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R18",1,"IHS",ASUD("SSA"),0)),U,ASUPC)+ASUD("VAL")
  1.  . S $P(^XTMP("ASUR","R18",1,"IHS",ASUD("SSA"),ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R18",1,"IHS",ASUD("SSA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
  1.  Q
  1.  ;
  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","R18")) W !!,"NO DATA FOR REPORT 18" Q
  1.  ;
  1.  S ASUHDR(1)="REPORT #18 IHS MONTHLY SUB-SUB-ACTIVITY REPORT"
  1.  S ASUHDR(4)="SUB   G L"
  1.  S ASUHDR(5)="SUB   ACC"
  1.  S ASUHDR(6)="ACT  CODE"
  1.  D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  ;
  1.  D LOOPS
  1.  Q
  1. LOOPS ;----- LOOPS THROUGH ^XTMP("ASUR","R18") GLOBAL AND PRINTS THE
  1.  ;      REPORT
  1.  ;
  1. 1 ;----- LOOP THROUGH SUB-SUB ACTIVITY SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(1)="" F  S ASUL(1)=$O(^XTMP("ASUR","R18",1,"IHS",ASUL(1)))  Q:ASUL(1)']""  D  Q:ASUOUT
  1.  . Q:ASUL(1)=0
  1.  . D 2 Q:ASUOUT
  1.  Q:ASUOUT
  1.  D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
  1.  S ASUD("ACC")="" F  S ASUD("ACC")=$O(^XTMP("ASUR","R18",2,"IHS",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","R18",2,"IHS",ASUD("ACC"),0)
  1.  . D WRITE16^ASUUTIL(ASUDATA)
  1.  Q:ASUOUT
  1.  I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
  1.  W !,"IHS TOTAL"
  1.  S ASUDATA=^XTMP("ASUR","R18",1,"IHS",0)
  1.  D WRITE16^ASUUTIL(ASUDATA)
  1.  Q
  1. 2 ;----- LOOP THROUGH GENERAL LEDGER ACCOUNT SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","R18",1,"IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . Q:ASUL(2)=0
  1.  . S ASUDATA=^XTMP("ASUR","R18",1,"IHS",ASUL(1),ASUL(2),0)
  1.  . I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
  1.  . W !?1,$S(ASUL(1)="UNK":"",1:$P(ASUL(1)," ")),?8,$S(ASUL(2)="UNK":"",1:$P(ASUL(2),".",2))
  1.  . D WRITE16^ASUUTIL(ASUDATA)
  1.  Q
  1.  ;
  1. QUIT ;----- CLEAN UP VARIABLE, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","R18")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q