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

ASUUTIL.m

Go to the documentation of this file. 
  1. ASUUTIL ; IHS/ITSC/LMH - VARIOUS UTILITY SUBROUTINES USED BY SAMS REPORTS ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;Y2K/OK AEF/2970311
  1.  ;This routine contains various utilities used by the SAMS reports
  1.  ;
  1.  ;
  1. WRITE16(X)         ;EP
  1.  ;----- WRITES DATA COLUMNS FOR REPORTS 16,17,18
  1.  ;
  1.  ;      X        =  data to be printed, passed by calling routine
  1.  ;      ASUPC    =  piece of X to print
  1.  ;      ASUCOL   =  column to print data in
  1.  ;
  1.  N ASUCOL,ASUPC,I,J
  1.  S ASUPC=1
  1.  F J="CU MO","Y-T-D" D
  1.  . W ?13,J
  1.  . S ASUCOL=4
  1.  . F I=1:1:7 S ASUCOL=ASUCOL+16 W ?ASUCOL,$S('+$P(X,U,ASUPC):"",1:$J($P(X,U,ASUPC),12,2)) S ASUPC=ASUPC+1
  1.  . W !
  1.  Q
  1.  ;
  1. HDR16(ASUDT,ASUTYP,ASUPAGE,ASUHDR,ASUOUT)        ;EP
  1.  ;----- WRITES REPORT HEADERS FOR REPORTS 16,17,18
  1.  ;
  1.  ;      ASUDT   =  report date or month
  1.  ;      ASUTYP  =  report type, "I"=individual, "M"=monthly
  1.  ;      ASUPAGE =  report page number
  1.  ;      ASUHDR  =  array containing report header segments
  1.  ;      ASUOUT  =  '^' to escape controller
  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 ASUHDR(1)," FOR ",$S(ASUTYP="M":"MONTH ",ASUTYP="I":"EXTRACT DATE ",1:"")
  1.  S Y=ASUDT X ^DD("DD") W Y
  1.  W ?116,"PAGE ",$J(ASUPAGE,6)
  1.  I $G(ASUHDR(2))]"" W !,$G(ASUHDR(2))
  1.  I $G(ASUHDR(3))]"" W !,$G(ASUHDR(3))
  1.  W !!,ASUHDR(4),?23,"PURCHASED",?36,"UNREQ/EXCESS",?55,"DONATIONS",?75,"STORE",?87,"PURCHASED",?100,"UNREQ/EXCESS",?119,"DONATIONS"
  1.  W !,ASUHDR(5),?24,"RECEIPTS",?36,"RECEIVED FOR",?52,"RECEIVED FOR",?76,"ROOM",?88,"RECEIPTS",?100,"RECEIVED FOR",?116,"RECEIVED FOR"
  1.  W !,ASUHDR(6),?27,"STOCK",?43,"STOCK",?59,"STOCK",?74,"ISSUES",?84,"DIRECT ISSUE",?100,"DIRECT ISSUE",?116,"DIRECT ISSUE"
  1.  W !
  1.  Q
  1.  ;
  1. SELXTRCT ;EP -- SELECT INDIVIDUAL EXTRACT DATE OR EXTRACT MONTH FOR REPORTS
  1.  ;
  1.  ;      Returns  ASUTYP  =  type of report where:
  1.  ;                          I = individual extract
  1.  ;                          M = monthly
  1.  ;               ASUDT   =  extract date or month
  1.  ;
  1.  N DIR,X,Y
  1.  S DIR(0)="S^M:ALL EXTRACTS FOR A MONTH;I:ONE INDIVIDUAL EXTRACT DATE"
  1.  D ^DIR
  1.  S ASUTYP=Y
  1.  I ASUTYP="I" D INDIV
  1.  I ASUTYP="M" D MONTH
  1.  Q
  1. MONTH ;----- SELECT MONTH FOR REPORT
  1.  ;
  1.  ;      Returns  ASUDT  =  extract month picked by user
  1.  ;
  1.  ;               ASU1   =  internal entry number of extract date in
  1.  ;                         ASULOG EXTRACT file
  1.  ;
  1.  N ASU1,DIC,X,Y
  1.  K ASUDT
  1.  S DIC="^ASUML(",DIC(0)="AEMQ",DIC("A")="Select MONTH: "
  1.  D ^DIC
  1.  Q:+Y'>0
  1.  S ASUDT=$P(^ASUML(+Y,0),U)
  1.  Q
  1. DAYS(ASUDT)        ;EP
  1.  ;----- GETS ALL EXTRACT DATES BELONGING TO THE CHOSEN MONTH
  1.  ;
  1.  ;      Returns ASUDT("DXTRACT") = array containing extract dates
  1.  ;              ASUDT("MXTRACT") = extract month
  1.  ;
  1.  ;      ASUDT  =  the month entry in the ASULOG EXTRACT file
  1.  ;      ASU0   =  internal entry number of month in ASULOG EXTRACT file
  1.  ;      ASU1   =  internal entry of extract date in ASULOG EXTRACT file
  1.  ;      ASU2   =  extract date
  1.  ;
  1.  N ASU0,ASU1,ASU2
  1.  S ASUDT("MXTRACT")=ASUDT
  1.  S ASU0=$O(^ASUML("B",ASUDT,0))
  1.  S ASU1=0 F  S ASU1=$O(^ASUML(+ASU0,1,ASU1)) Q:'ASU1  D
  1.  . S ASU2=$P(^ASUML(+ASU0,1,ASU1,0),U)
  1.  . S ASUDT("DXTRACT",ASU2)=""
  1.  Q
  1. INDIV ;----- SELECT ONE INDIVIDUAL EXTRACT/CLOSEOUT DATE FOR REPORTS
  1.  ;
  1.  ;      Returns ASUDT = extract date for report
  1.  ;
  1.  ;      ASUX    =  array used to store extract dates for display
  1.  ;      ASU1    =  file number for example:
  1.  ;                 2 = ASUTUL RECEIPTS
  1.  ;                 3 = ASUTUL ISSUES
  1.  ;                 7 = ASUTUL DIRECT ISSUES
  1.  ;      ASU2    =  transaction date in the 'AX' crossreference
  1.  ;      ASUDT   =  date picked by user
  1.  ;      ASUOUT  =  '^' escape controller
  1.  ;
  1.  N ASU1,ASU2,ASUOUT,ASUX,DIR,%DT,X,Y
  1.  K ASUDT
  1.  F ASU1=1:1:7 D AX(ASU1)
  1.  S %DT="AEPX",%DT("A")="Select EXTRACT DATE: "
  1.  S ASUOUT=0 F  D  Q:ASUOUT
  1.  . D ^%DT
  1.  . I Y'>0 S ASUOUT=1 Q
  1.  . S ASUDT=Y
  1.  . I $D(ASUX(ASUDT)) S ASUOUT=1 Q
  1.  . K ASUDT
  1.  . W *7," ??"
  1.  . S DIR(0)="Y",DIR("A")=" Do you want the entire EXTRACT DATE list",DIR("B")="YES"
  1.  . D ^DIR
  1.  . I Y D LIST
  1.  Q
  1.  ;
  1. AX(ASU1) ;EP -- BUILDS LIST OF EXTRACT DATES
  1.  ;
  1.  ;      Returns ASUX array containing extract dates
  1.  ;
  1.  ;      ASU1  =  file to get dates from, where for example:
  1.  ;               2 = ASUTUL RECEIPTS
  1.  ;               3 = ASUTUL ISSUES
  1.  ;               7 = ASUTUL DIRECT ISSUES
  1.  ;      ASU2  =  extract date in 'AX' crossreference
  1.  ;
  1.  N ASU2
  1.  S ASU2=0 F  S ASU2=$O(^ASUH("AX",ASU2)) Q:'ASU2  D
  1.  . S:'$D(ASUX(ASU2)) ASUX(ASU2)=$$EXTDATE^ASUUTIL1(ASU2)
  1.  Q
  1.  ;
  1. LIST ;EP -- LIST EXTRACT DATES
  1.  ;
  1.  ;      Lists extract dates found in 'AX' crossreference of SAMS
  1.  ;      transaction files - the list is built in AX^ASUUTIL
  1.  ;
  1.  ;      ASU1    =  extract date, member of ASUX( array
  1.  ;      ASUOUT  =  '^' escape controller
  1.  ;      ASUX    =  array containing extract dates - from AX^ASUUTIL
  1.  ;
  1.  N ASU1,ASUOUT
  1.  S $Y=0
  1.  S ASUOUT=0 W !,"Choose from:"
  1.  S ASU1=0 F  S ASU1=$O(ASUX(ASU1)) Q:'ASU1  D  Q:ASUOUT
  1.  . I $Y>(IOSL-2) D OUT(.ASUOUT) Q:ASUOUT
  1.  . W !?3,ASUX(ASU1)
  1.  Q
  1.  ;
  1. OUT(ASUOUT)        ;EP
  1.  ;----- ISSUES "Enter RETURN to continue or '^' to exit:" PROMPT
  1.  ;
  1.  ;      Returns ASUOUT = '^' escape controller where:
  1.  ;                       0 = continue
  1.  ;                       1 = quit
  1.  ;
  1.  ;
  1.  N DIR,DX,DY,Y
  1.  D HOME^%ZIS
  1.  S DIR(0)="E" D ^DIR I 'Y S ASUOUT=1 Q
  1.  W *13,$J("",50),*13
  1.  S DY=$Y-2,DX=0,$Y=0 X IOXY
  1.  Q
  1.  ;
  1. TC16 ;EP -- SETS UP TRANSACTION CODE ARRAY USED BY REPORTS 16,17,18
  1.  ;
  1.  ;      Returns:
  1.  ;      ASU("TC")  =  array containing allowable transaction codes
  1.  ;                    the value of each member of this array
  1.  ;                    corresponds to the report column where each type
  1.  ;                    of transaction is totaled
  1.  ;
  1.  N I
  1.  K ASU("TC")
  1.  S (ASU("TC",22),ASU("TC","2K"))=1
  1.  F I=24,"2M",26,"2O" S ASU("TC",I)=2
  1.  S (ASU("TC",25),ASU("TC","2N"))=3
  1.  F I=32,33,"3K","3L" S ASU("TC",I)=4
  1.  S (ASU("TC","02"),ASU("TC","0K"))=5
  1.  F I="04","0M","06","0O" S ASU("TC",I)=6
  1.  S (ASU("TC","05"),ASU("TC","0N"))=7
  1.  Q
  1.  ;
  1. DT(ASUDT,ASUTYP)   ;EP
  1.  ;----- SETS UP DATE ARRAYS
  1.  ;
  1.  ;      Returns ASUDT("DXTRACT") = extract date array
  1.  ;              ASUDT("MXTRACT") = extract month
  1.  ;              ASU("DT","FY")   = fiscal year
  1.  ;
  1.  ;      ASUDT   =  extract date or month
  1.  ;      ASUTYP  =  report type, "I"=individual extract, "M"=monthly
  1.  ;      ASU1    =  file to get dates from where for example:
  1.  ;                 2 = ASUTUL RECEIPTS
  1.  ;                 3 = ASUTUL ISSUES
  1.  ;                 7 = ASUTUL DIRECT ISSUES
  1.  N ASU1
  1.  I ASUTYP="I" D
  1.  . F ASU1=1:1:7 D AX(ASU1)
  1.  . I $D(ASUX(ASUDT)) S ASUDT("DXTRACT",ASUDT)=""
  1.  I ASUTYP="M" D DAYS(.ASUDT)
  1.  S ASU("DT","FY")=+$$FY^ASUUTIL1(ASUDT)
  1.  Q
  1.  ;
  1. DATA16(ASU2)  ;EP
  1.  ;----- GETS TRANSACTION DATA USED BY SAMS REPORTS
  1.  ;
  1.  ;      Returns ASUD( array containing transaction data
  1.  ;
  1.  ;      ASUDATA  =  temporary data storage
  1.  ;      ASU0     =  transaction type  where:
  1.  ;                  2 = RECEIPTS
  1.  ;                  3 = ISSUES
  1.  ;                  7 = DIRECT ISSUES
  1.  ;      ASU2     =  internal file entry number
  1.  ;      ASUD     =  array where transaction data is stored
  1.  ;
  1.  N ASUDATA
  1.  K ASUD
  1.  S ASUDATA=$G(^ASUH(ASU2,0))
  1.  S ASUD("STATUS")=$P(ASUDATA,U,10)
  1.  S ASUD("AREA")=$P(ASUDATA,U,2)
  1.  I ASUD("AREA") S ASUD("AREA")=ASUD("AREA")_" "_$P($G(^ASUL(1,ASUD("AREA"),0)),U)
  1.  S:'+ASUD("AREA") ASUD("AREA")="UNK"
  1.  S ASUD("STA")=$P(ASUDATA,U,3)
  1.  I ASUD("STA") S ASUD("STA")=$P($G(^ASUL(2,ASUD("STA"),1)),U)_" "_$P($G(^ASUL(2,ASUD("STA"),0)),U)
  1.  S:'+ASUD("STA") ASUD("STA")="UNK"
  1.  S ASUD("SST")=$P(ASUDATA,U,13)
  1.  I ASUD("SST") S ASUD("SST")=$P($G(^ASUL(18,ASUD("SST"),1)),U)_" "_$P($G(^ASUL(18,ASUD("SST"),0)),U)
  1.  S:'+ASUD("SST") ASUD("SST")="UNK"
  1.  S ASUD("ACC")=$P(ASUDATA,U,4)
  1.  I ASUD("ACC") S ASUD("ACC")=$P($G(^ASUL(9,ASUD("ACC"),0)),U,3)
  1.  S:ASUD("ACC")']"" ASUD("ACC")="UNK"
  1.  S ASUD("ACCNAM")=$O(^ASUL(9,"D",ASUD("ACC"),0))
  1.  I ASUD("ACCNAM") S ASUD("ACCNAM")=$P($G(^ASUL(9,ASUD("ACCNAM"),0)),U)
  1.  I ASUD("ACCNAM")="" S ASUD("ACCNAM")="UNK"
  1.  S ASUD("USR")=$P(ASUDATA,U,14)
  1.  I ASUD("USR") S ASUD("USR")=+$P($G(^ASUL(19,ASUD("USR"),1)),U)
  1.  S:ASUD("USR")']"" ASUD("USR")="UNK"
  1.  S ASUD("SSA")=$P(ASUDATA,U,11)
  1.  S:ASUD("SSA") ASUD("SSA")=$P($G(^ASUL(17,ASUD("SSA"),1)),U)
  1.  S:ASUD("SSA")']"" ASUD("SSA")="UNK"
  1.  S ASUD("SRC")=$P(ASUDATA,U,12)
  1.  I ASUD("SRC") D
  1.  . S ASUD("SRC")=$G(^ASUL(5,ASUD("SRC"),0))
  1.  . I ASUD("SRC")]"" S ASUD("SRC")=$P(ASUD("SRC"),U,2)_" - "_$P(ASUD("SRC"),U)
  1.  I ASUD("SRC")']"" S ASUD("SRC")="UNK"
  1.  S ASUD("DOBJPTR")=$P(ASUDATA,U,17)
  1.  S ASUD("IDXPTR")=$P(ASUDATA,U,5)
  1.  S ASUDATA=$G(^ASUH(ASU2,1))
  1.  S ASUD("TRANS")=$P(ASUDATA,U)
  1.  S ASUD("VAL")=$P(ASUDATA,U,7)
  1.  I "0K^0M^0N^0O^1K^1M^1N^1O^2K^2M^2N^2O^2P^3J^3K^3L^3M^3O^3P^"[ASUD("TRANS")_U S ASUD("VAL")=0-ASUD("VAL")
  1.  S ASUD("VOUCH")=$P(ASUDATA,U,8)
  1.  S:ASUD("VOUCH")']"" ASUD("VOUCH")="UNK"
  1.  S ASUD("CAN")=$P(ASUDATA,U,15)
  1.  S:ASUD("CAN")']"" ASUD("CAN")="UNK"
  1.  S ASUD("OBJ")=$P(ASUDATA,U,17)
  1.  S:ASUD("OBJ")="" ASUD("OBJ")="UNK"
  1.  Q
  1.  ;
  1. QUE(ZTRTN,ZTSAVE,ZTDESC)     ;EP
  1.  ;----- QUEUEING CODE
  1.  ;
  1.  N %ZIS,IO,POP,ZTIO,ZTSK
  1.  S %ZIS="QM" D ^%ZIS Q:POP  ; JDH added M to %ZIS to ask for RM
  1.  I $D(IO("Q")) K IO("Q") S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD I $G(ZTSK) W !,"Task #",$G(ZTSK)," queued"
  1.  E  D @ZTRTN
  1.  Q