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

ASURMDBH.m

Go to the documentation of this file. 
  1. ASURMDBH ; IHS/ITSC/LMH - MANAGEMENT SUPPLY DATABOOK REPORT H ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK/AEF/2970429
  1.  ;This routine produces the Management Supply Databook Report H
  1.  ;Receiving Documents and Line Items Received
  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^ASURMDBH",.ZTSAVE,"SAMS DATABOOK REPORT H")
  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, M=monthly
  1.  ;
  1.  D ^XBKVAR
  1.  D:'$D(^XTMP("ASUR","RDBH")) GET
  1.  D PRT,QUIT
  1.  Q
  1. GET ;EP ; GATHER DATA
  1.  ;
  1.  ;      Builds ^XTMP("ASUR","RDBH") global to sort and total
  1.  ;      documents and line items
  1.  ;
  1.  D SORT,COUNT
  1.  Q
  1. SORT ;----- SORTS THE DATA    
  1.  ;
  1.  ;      Sets sorted data into ^XTMP("ASUR","RDBH","A") global
  1.  ;
  1.  ;      ASU     = array containing beginning, ending fiscal dates
  1.  ;      ASU0    = transaction type
  1.  ;      ASU1    = extracted date in 'AX' crossreference
  1.  ;      ASU2    = internal file entry number
  1.  ;      ASUD    = array containing transaction data
  1.  ;      ASUPC   = piece in ^TMP global to store the count in
  1.  ;
  1.  N ASU,ASU0,ASU1,ASU2,ASUD,ASUPC
  1.  K ^XTMP("ASUR","RDBH")
  1.  D FPP^ASUUTIL1(ASUDT)
  1.  I ASUTYP="M" S ASUDT=$$LDOM^ASUUTIL1(ASUDT)
  1.  S ASU1=ASU("DT","BEG2")-1
  1.  F  S ASU1=$O(^ASUH("AX",ASU1)) Q:'ASU1  Q:ASU1>ASUDT  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.  . . D DATA16^ASUUTIL(ASU2)
  1.  . . S ASUPC=0
  1.  . . I ASU1'<ASU("DT","BEG")&(ASU1'>ASU("DT","END")) S ASUPC=2
  1.  . . I ASU1'<ASU("DT","BEG1")&(ASU1'>ASU("DT","END1")) S ASUPC=6
  1.  . . I ASU1'<ASU("DT","BEG2")&(ASU1'>ASU("DT","END2")) S ASUPC=10
  1.  . . I ASUPC,ASU0=7 S ASUPC=ASUPC+2
  1.  . . D SET1
  1.  Q
  1. SET1 ;----- SORTS DATA IN ^TMP GLOBAL
  1.  ;
  1.  S ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC,ASU2,0)=""
  1.  S ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC-1,ASUD("VOUCH"),0)=""
  1.  Q
  1. COUNT ;----- COUNTS THE LINE ITEMS AND DOCUMENTS
  1.  ;
  1.  ;      Sets counts into ^XTMP("ASUR","RDBH","B") global
  1.  ;
  1.  N ASUL
  1.  S ASUL(1)="" F  S ASUL(1)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1))) Q:ASUL(1)']""  D
  1.  . S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D
  1.  . . S ASUL(3)="" F  S ASUL(3)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']""  D
  1.  . . . S ASUL(4)="" F  S ASUL(4)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4))) Q:ASUL(4)']""  D
  1.  . . . . S ASUL(5)="" F  S ASUL(5)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5))) Q:ASUL(5)']""  D
  1.  . . . . . D SET2
  1.  Q
  1. SET2 ;----- SETS COUNTS IN ^TMP GLOBAL
  1.  ;
  1.  S $P(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0),U,ASUL(4))=$P($G(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)),U,ASUL(4))+1
  1.  S $P(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0),U,ASUL(4))=$P($G(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)),U,ASUL(4))+1
  1.  Q
  1. PRT ;----- PRINTS THE DATA
  1.  ;
  1.  ;      ASUDATA = temporary data storage
  1.  ;      ASUL    = array used for loop counters
  1.  ;      ASUOUT  = '^' to escape controller
  1.  ;      ASUPAGE = report page number
  1.  ;
  1.  N ASUL,ASUOUT,ASUPAGE
  1.  I '$D(^XTMP("ASUR","RDBH","B")) W !!,"NO DATA FOR DATABOOK REPORT H" Q
  1.  S ASUOUT=0
  1.  D LOOPS
  1.  Q
  1. LOOPS ;----- LOOPS THROUGH THE ^XTMP("ASUR","RDBH","B") 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","RDBH","B","IHS",ASUL(1))) Q:ASUL(1)']""  D 2 Q:ASUOUT
  1.  Q
  1. 2 ;----- LOOP THROUGH THE ACCOUNT SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . D HDR(ASUL(1),ASUL(2)) Q:ASUOUT
  1.  . D 3 Q:ASUOUT
  1.  . I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2))
  1.  . Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)
  1.  . W !!,"TOTAL"
  1.  . D WRITE(ASUDATA)
  1.  Q
  1. 3 ;----- LOOP THROUGH THE STATION SUBSCRIPT
  1.  ;
  1.  N ASUDATA
  1.  S ASUL(3)="" F  S ASUL(3)=$O(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']""  D  Q:ASUOUT
  1.  . Q:ASUL(3)=0
  1.  . I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2))
  1.  . Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)
  1.  . W !!,ASUL(3)
  1.  . D WRITE(ASUDATA)
  1.  Q
  1. WRITE(X) ;----- WRITES DATA
  1.  ;
  1.  I $P(X,U)'="" W ?23,$J($P(X,U),5)
  1.  I $P(X,U,2)'="" W ?29,$J($P(X,U,2),5)
  1.  I +$P(X,U)'=0 W ?36,$J(($P(X,U,2)/$P(X,U)),4,1)
  1.  I $P(X,U,3)'="" W ?41,$J($P(X,U,3),5)
  1.  I $P(X,U,4)'="" W ?47,$J($P(X,U,4),5)
  1.  I +$P(X,U,3)'=0 W ?54,$J(($P(X,U,4)/$P(X,U,3)),4,1)
  1.  I $P(X,U,5)'="" W ?60,$J($P(X,U,5),5)
  1.  I $P(X,U,6)'="" W ?66,$J($P(X,U,6),5)
  1.  I +$P(X,U,5)'=0 W ?73,$J(($P(X,U,6)/$P(X,U,5)),4,1)
  1.  I $P(X,U,7)'="" W ?78,$J($P(X,U,7),5)
  1.  I $P(X,U,8)'="" W ?84,$J($P(X,U,8),5)
  1.  I +$P(X,U,7)'=0 W ?91,$J(($P(X,U,8)/$P(X,U,7)),4,1)
  1.  I $P(X,U,9)'="" W ?97,$J($P(X,U,9),5)
  1.  I $P(X,U,10)'="" W ?103,$J($P(X,U,10),5)
  1.  I +$P(X,U,9)'=0 W ?110,$J(($P(X,U,10)/$P(X,U,9)),4,1)
  1.  I $P(X,U,11)'="" W ?115,$J($P(X,U,11),5)
  1.  I $P(X,U,12)'="" W ?121,$J($P(X,U,12),5)
  1.  I +$P(X,U,11)'=0 W ?128,$J(($P(X,U,12)/$P(X,U,11)),4,1)
  1.  Q
  1. HDR(X1,X2)         ;
  1.  ;----- WRITES HEADER
  1.  ;
  1.  ;      X1  =  area
  1.  ;      X2  =  account
  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 "MANAGEMENT SUPPLY DATA BOOK for "
  1.  S Y=ASUDT X ^DD("DD") W $P(Y," ")," ",$P(Y,",",2)
  1.  W ?116,"PAGE ",$J(ASUPAGE,6)
  1.  W !,"AREA ",X1
  1.  W !!,"H. RECEIVING DOCUMENTS and LINE ITEMS RECEIVED"
  1.  W !?3,"Category: ",X2
  1.  W !!,?31,"CURRENT FISCAL YEAR",?68,"PREVIOUS FISCAL YEAR",?104,"PREV-PREV FISCAL YEAR"
  1.  W !,?25,"Stores Stock",?43,"Direct Issue",?62,"Stores Stock",?80,"Direct Issue",?99,"Stores Stock",?117,"Direct Issue"
  1.  W !,"STATION",?23,"# DOC",?30,"# LI",?37,"AVG",?41,"# DOC",?48,"# LI",?55,"AVG",?60,"# DOC",?67,"# LI",?74,"AVG",?78,"# DOC",?85,"# LI",?92,"AVG",?97,"# DOC",?104,"# LI",?111,"AVG",?115,"# DOC",?122,"# LI",?129,"AVG"
  1.  Q
  1. QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","RDBH")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q