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

ASURMDBL.m

Go to the documentation of this file. 
  1. ASURMDBL ; IHS/ITSC/LMH - MANAGEMENT SUPPLY DATA BOOK REPORT L ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK/AEF/2970423
  1.  ;This routine produces the Management Supply Databook Report L
  1.  ;Receipt Values by Major Sources of Supply
  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^ASURMDBL",.ZTSAVE,"SAMS DATABOOK REPORT L")
  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","RDBL")) GET
  1.  D PRT,QUIT
  1.  Q
  1. GET ;EP ; GATHER DATA
  1.  ;
  1.  ;      Builds ^XTMP("ASUR","RDBL") global to sort and store
  1.  ;      transaction totals
  1.  ;
  1.  ;      ASU      = array containing beginning, ending fiscal dates
  1.  ;      ASU0     = file to get data from
  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 put the count in
  1.  ;
  1.  N ASU,ASU0,ASU1,ASU2,ASUD,ASUPC
  1.  K ^XTMP("ASUR","RDBL")
  1.  D FPP^ASUUTIL1(ASUDT)
  1.  I ASUTYP="M" S ASUDT=$$LDOM^ASUUTIL1(ASUDT)
  1.  F ASU0=2,7 D
  1.  . S ASU1=ASU("DT","BEG2")-1
  1.  . F  S ASU1=$O(^ASUTH(ASU0,"AX",ASU1)) Q:'ASU1  Q:ASU1>ASUDT  D
  1.  . . S ASU2=0 F  S ASU2=$O(^ASUTH(ASU0,"AX",ASU1,ASU2)) Q:'ASU2  D
  1.  . . . D DATA16^ASUUTIL(ASU0,ASU2)
  1.  . . . S ASUPC=0
  1.  . . . I ASU1'<ASU("DT","BEG")&(ASU1'>ASU("DT","END")) S ASUPC=1
  1.  . . . I ASU1'<ASU("DT","BEG1")&(ASU1'>ASU("DT","END1")) S ASUPC=3
  1.  . . . I ASU1'<ASU("DT","BEG2")&(ASU1'>ASU("DT","END2")) S ASUPC=5
  1.  . . . I ASUPC,ASU0=2 S ASUPC=ASUPC+1
  1.  . . . D SET
  1.  Q
  1. SET ;----- SETS TOTALS IN ^TMP GLOBAL
  1.  ;
  1.  I '$D(^XTMP("ASUR","RDBL","SRC",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0)) D SRC(ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"))
  1.  S $P(^XTMP("ASUR","RDBL","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","RDBL","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0)),U,ASUPC)+ASUD("VAL")
  1.  S $P(^XTMP("ASUR","RDBL","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUD("SRC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","RDBL","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUD("SRC"),0)),U,ASUPC)+ASUD("VAL")
  1.  Q
  1. SRC(X1,X2,X3)      ;
  1.  ;----- SETS UP SOURCE CODE ARRAY BY AREA, STATION
  1.  ;
  1.  ;      X1  =  area passed by calling routine
  1.  ;      X2  =  account passed by calling routine
  1.  ;      X3  =  station passed by calling routine
  1.  ;      X4  =  source code
  1.  ;
  1.  N X4
  1.  S X4=0 F  S X4=$O(^ASUL(5,X4)) Q:'X4  D
  1.  . S ^XTMP("ASUR","RDBL","SRC",X1,X2,X3,0)=""
  1.  . S ^XTMP("ASUR","RDBL","IHS",X1,X2,X3,$P(^ASUL(5,X4,0),U),0)=""
  1.  Q
  1. PRT ;----- PRINTS THE DATA
  1.  ;
  1.  ;      ASUDATA  =  temporary data storage
  1.  ;      ASUDATA2 =  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","RDBL")) W !!,"NO DATA FOR DATABOOK REPORT L" Q
  1.  S ASUOUT=0
  1.  D LOOPS
  1.  Q
  1.  ;
  1. LOOPS ;----- LOOPS THROUGH THE ^XTMP("ASUR","RDBK") GLOBAL AND PRINTS
  1.  ;      THE REPORT
  1.  ;
  1. 1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
  1.  ;
  1.  N ASUDATA,ASUDATA2
  1.  S ASUL(1)="" F  S ASUL(1)=$O(^XTMP("ASUR","RDBL","IHS",ASUL(1))) Q:ASUL(1)']""  D  Q:ASUOUT
  1.  . D 2 Q:ASUOUT
  1.  Q
  1. 2 ;----- LOOP THROUGH THE ACCOUNT SUBSCRIPT
  1.  ;
  1.  S ASUL(2)="" F  S ASUL(2)=$O(^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . Q:ASUL(2)=0
  1.  . D 3 Q:ASUOUT
  1.  Q
  1. 3 ;----- LOOP THROUGH THE STATION SUBSCRIPT
  1.  ;
  1.  N ASUDATA,ASUDATA2
  1.  S ASUL(3)="" F  S ASUL(3)=$O(^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']""  D  Q:ASUOUT
  1.  . D HDR(ASUL(1),ASUL(2),ASUL(3)) Q:ASUOUT
  1.  . D 4 Q:ASUOUT
  1.  . I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2),ASUL(3)) Q:ASUOUT
  1.  . W !!,"TOTAL RECEIPTS"
  1.  . S (ASUDATA,ASUDATA2)=^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2),ASUL(3),0)
  1.  . D WRITE(ASUDATA,ASUDATA2)
  1.  Q
  1. 4 ;----- LOOP THROUGH THE SOURCE CODE SUBSCRIPT
  1.  ;
  1.  N ASUDATA,ASUDATA2
  1.  S ASUDATA2=^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2),ASUL(3),0)
  1.  S ASUL(4)="" F  S ASUL(4)=$O(^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4))) Q:ASUL(4)']""  D  Q:ASUOUT
  1.  . Q:ASUL(4)=0
  1.  . S ASUDATA=^XTMP("ASUR","RDBL","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4),0)
  1.  . I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2),ASUL(3)) Q:ASUOUT
  1.  . W !!,ASUL(4)
  1.  . D WRITE(ASUDATA,ASUDATA2)
  1.  Q
  1. WRITE(X1,X2)       ;
  1.  ;----- WRITES DATA
  1.  ;
  1.  N ASUX
  1.  W !?5,$J($P(X1,U),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U)+$P(X1,U,2),$P(X1,U))
  1.  W ?14,$J(ASUX,4,1)
  1.  W ?19,$J($P(X1,U,2),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U)+$P(X1,U,2),$P(X1,U,2))
  1.  W ?28,$J(ASUX,4,1)
  1.  W ?33,$J($P(X1,U)+$P(X1,U,2),8,2)
  1.  S ASUX=$$PRCNT($P(X2,U)+$P(X2,U,2),$P(X1,U)+$P(X1,U,2))
  1.  W ?42,$J(ASUX,4,1)
  1.  W ?48,$J($P(X1,U,3),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U,3)+$P(X1,U,4),$P(X1,U,3))
  1.  W ?57,$J(ASUX,4,1)
  1.  W ?62,$J($P(X1,U,4),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U,3)+$P(X1,U,4),$P(X1,U,4))
  1.  W ?71,$J(ASUX,4,1)
  1.  W ?76,$J($P(X1,U,3)+$P(X1,U,4),8,2)
  1.  S ASUX=$$PRCNT($P(X2,U,3)+$P(X2,U,4),$P(X1,U,3)+$P(X1,U,4))
  1.  W ?85,$J(ASUX,4,1)
  1.  W ?91,$J($P(X1,U,5),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U,5)+$P(X1,U,6),$P(X1,U,5))
  1.  W ?100,$J(ASUX,4,1)
  1.  W ?105,$J($P(X1,U,6),8,2)
  1.  S ASUX=$$PRCNT($P(X1,U,5)+$P(X1,U,6),$P(X1,U,6))
  1.  W ?114,$J(ASUX,4,1)
  1.  W ?119,$J($P(X1,U,5)+$P(X1,U,6),8,2)
  1.  S ASUX=$$PRCNT($P(X2,U,5)+$P(X2,U,6),$P(X1,U,5)+$P(X1,U,6))
  1.  W ?128,$J(ASUX,4,1)
  1.  Q
  1. HDR(X1,X2,X3)      ;
  1.  ;----- WRITES REPORT HEADER
  1.  ;
  1.  ;      X1 = area
  1.  ;      X2 = account
  1.  ;      X3 = station
  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 !!,"L. RECEIPT VALUES BY MAJOR SOURCES OF SUPPLY"
  1.  W !?3,"Category: ",X2
  1.  W !!,"LOCATION: ",X3
  1.  W !!?16,"CURRENT FISCAL YEAR",?58,"PREVIOUS FISCAL YEAR",?98,"PREVIOUS-PREV FISCAL YEAR"
  1.  W !?7,"DIRECT",?17,"%",?22,"STOCK",?31,"%",?36,"TOTAL",?45,"%",?50,"DIRECT",?60,"%",?65,"STOCK",?74,"%",?79,"TOTAL",?88,"%",?93,"DIRECT",?103,"%",?108,"STOCK",?117,"%",?122,"TOTAL",?131,"%"
  1.  W !?7,"ISSUES",?15,"DIR RECEIPTS",?29,"STK RECEIPTS",?43,"TOT",?50,"ISSUES",?58,"DIR RECEIPTS",?72,"STK RECEIPTS",?86,"TOT",?93,"ISSUES",?101,"DIR RECEIPTS",?115,"STK RECEIPTS",?129,"TOT"
  1.  Q
  1. PRCNT(X,Y)         ;
  1.  ;----- CALCULATES PERCENT
  1.  ;
  1.  I +X=0 Q ""
  1.  Q (Y/X)*100
  1.  ;
  1. QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","RDBL")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q