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

ASURMDBC.m

Go to the documentation of this file. 
  1. ASURMDBC ; IHS/ITSC/LMH - MANAGEMENT SUPPLY DATA BOOK REPORT C ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK/AEF/2970328
  1.  ;This routine produces the Management Supply Data Book Report C
  1.  ;Inventory Adjustments, Line Items and Values
  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^ASURMDBC",.ZTSAVE,"SAMS MGMT SUPPLY DATABOOK REPORT C")
  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","RDBC")) GET
  1.  D PRT,QUIT
  1.  Q
  1. GET ;EP ; GATHER DATA
  1.  ;
  1.  ;      Builds ^XTMP("ASUR","RDBC") global to sort and store
  1.  ;      transaction counts
  1.  ;
  1.  ;      ASU      =  array containing beginning, ending fiscal dates
  1.  ;      ASU1     =  extracted date in 'AX' crossreference
  1.  ;      ASU2     =  internal file entry number
  1.  ;      ASUD     =  array containing transaction data
  1.  ;      ASUPC    =  which piece in ^TMP global to put the count in
  1.  ;
  1.  N ASU,ASU1,ASU2,ASUD,ASUPC
  1.  K ^XTMP("ASUR","RDBC")
  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(^ASUTH("AX",ASU1)) Q:'ASU1  Q:ASU1>ASUDT  D
  1.  . S ASU2=0 F  S ASU2=$O(^ASUTH("AX",ASU1,ASU2)) Q:'ASU2  D
  1.  . . S ASUD("TRANS")=$P($G(^ASUH(ASU2,1)),U),ASU0=$E(ASUD("TRANS"))
  1.  . . I "27372P3P"'[ASUD("TRANS") Q
  1.  . . D DATA16^ASUUTIL(ASU2)
  1.  . . S ASUPC=0
  1.  . . I ASU1'<ASU("DT","BEG")&(ASU1'>ASU("DT","END")) S ASUPC=0
  1.  . . I ASU1'<ASU("DT","BEG1")&(ASU1'>ASU("DT","END1")) S ASUPC=4
  1.  . . I ASU1'<ASU("DT","BEG2")&(ASU1'>ASU("DT","END2")) S ASUPC=8
  1.  . . I ASUD("TRANS")=27!(ASUD("TRANS")="2P") S ASUPC=ASUPC+1
  1.  . . I ASUD("TRANS")=37!(ASUD("TRANS")="3P") S ASUPC=ASUPC+3
  1.  . . D SET
  1.  Q
  1. SET ;----- SETS COUNTS AND TOTALS IN ^TMP GLOBAL
  1.  ;
  1.  S $P(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),0),U,ASUPC)=$P($G(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),0)),U,ASUPC)+1
  1.  S $P(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),0),U,ASUPC+1)=$P($G(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),0)),U,ASUPC+1)+ASUD("VAL")
  1.  S $P(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0)),U,ASUPC)+1
  1.  S $P(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0),U,ASUPC+1)=$P($G(^XTMP("ASUR","RDBC","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),0)),U,ASUPC+1)+ASUD("VAL")
  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","RDBC")) W !!,"NO DATA FOR DATABOOK REPORT C" Q
  1.  S ASUOUT=0
  1.  D LOOPS
  1.  Q
  1. LOOPS ;----- LOOPS THROUGH THE ^TMP("ASU",$J,"ASUDBC") 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","RDBC","IHS",ASUL(1))) Q:ASUL(1)']""  D  Q:ASUOUT
  1.  . Q:ASUL(1)=0
  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","RDBC","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']""  D  Q:ASUOUT
  1.  . Q:ASUL(2)=0
  1.  . D HDR Q:ASUOUT
  1.  . D 3 Q:ASUOUT
  1.  . I $Y>(IOSL-5) D HDR Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","RDBC","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","RDBC","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 Q:ASUOUT
  1.  . S ASUDATA=^XTMP("ASUR","RDBC","IHS",ASUL(1),ASUL(2),ASUL(3),0)
  1.  . W !,$E(ASUL(3),1,20)
  1.  . D WRITE(ASUDATA)
  1.  . W !
  1.  Q
  1. WRITE(X) ;----- WRITES THE DATA
  1.  ;
  1.  ;      ASUCOL  =  the column to write the data in
  1.  ;
  1.  N I,ASUCOL
  1.  S ASUCOL="24^30^42^48^61^67^79^85^98^104^116^122"
  1.  F I=1:2:11 D
  1.  . I $P(X,U,I)]"" W ?$P(ASUCOL,U,I),$J($P(X,U,I),4)
  1.  . I $P(X,U,I+1)]"" W ?$P(ASUCOL,U,I+1),$J($P(X,U,I+1),10,2)
  1.  Q
  1. HDR ;----- PRINTS 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 "MANAGEMENT SUPPLY DATA BOOK FOR "
  1.  S Y=ASUDT X ^DD("DD") W $P(Y," ")," ",$P(Y,",",2)
  1.  W !,"AREA ",ASUL(1)
  1.  W !!,"C. INVENTORY ADJUSTMENTS, LINE ITEMS and VALUES"
  1.  W !,"  Category: ",ASUL(2)
  1.  W !!?31,"CURRENT FISCAL YEAR",?68,"PREVIOUS FISCAL YEAR",?102,"PREVIOUS-PREV FISCAL YEAR"
  1.  W !?24,"DEBIT ADJUSTMNTS",?42,"CRED ADJUSTMENTS",?61,"DEBIT ADJUSTMNTS",?79,"CRED ADJUSTMENTS",?98,"DEBIT ADJUSTMNTS",?116,"CRED ADJUSTMENTS"
  1.  W !,"STATION",?24,"# LI",?35,"VALUE",?42,"# LI",?53,"VALUE",?61,"# LI",?72,"VALUE",?79,"# LI",?90,"VALUE",?98,"# LI",?108,"VALUE",?116,"# LI",?127,"VALUE"
  1.  W !
  1.  Q
  1. QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
  1.  ;
  1.  K ZTSAVE
  1.  K ^XTMP("ASUR","RDBC")
  1.  I $G(ASUK("PTRSEL"))]"" W @IOF Q
  1.  D ^%ZISC
  1.  Q