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

ASUCOMTH.m

Go to the documentation of this file. 
  1. ASUCOMTH ; IHS/ITSC/LMH -MONTHLY CLOSEOUT ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine controls a monthly closeout run.
  1.  D CLS^ASUUHDG
  1.  W !?15,"S.A.M.S Monthly Closeout Process Running",!!
  1.  S ASUP("TYP")=1
  1.  S DIR(0)="Y",DIR("A")="Are you sure this is the Last Processing for the Month" D ^DIR
  1.  K DIR
  1.  G:$D(DTOUT)!(X="N") KILL G:$D(DUOUT) KILL
  1.  I Y D
  1.  .D SETCTRL^ASUCOSTS
  1.  E  D
  1.  .W *13,!,"If a monthly closeout isn't needed, select either a daily or a yearly closeout"
  1.  .S DIR(0)="E" D ^DIR K DIR
  1.  .S DUOUT=1
  1.  G:$D(DTOUT) KILL G:$D(DUOUT) KILL
  1.  I ($D(ASUK("DT"))#10)'=1 D DATE^ASUUDATE
  1.  D ^ASUCORUN I 'ASUP("OK") K ASUP Q
  1.  D SETRUN^ASUUDATE
  1.  G:ASUP("RE*") UPDT
  1.  D SETMO^ASUUDATE(ASUP("NXMO")) G:ASUP("ERR")>0 ERR
  1. UPDT ;
  1.  D DT^DILF("E",ASUP("MOYR"),.X)
  1.  W !,"Monthly closeout will be made for Month and FISCAL year ",!?30,X(0)
  1.  K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Is that correct" D ^DIR
  1.  I 'Y G KILL
  1.  I 'ASUP("RE*") S ASUP("LSMO")=ASUP("MOYR") D SETLM^ASUCOSTS
  1.  S $P(^ASUSITE(1,1),U,8)=$P($G(^ASUSITE(1,3)),U,8)
  1.  S ASUP("RE*")=+$G(ASUP("RE*"))
  1.  S ASUK("PTR")="SRPT"
  1.  I ASUP("AST")>0 D
  1.  .S %ZIS("A")="Select Standard Reports Printer (132 Characters/line) "
  1.  .D S^ASUUZIS
  1.  E  D
  1.  .S IOP=ASUK("SRPT","IOP"),%ZIS("IOPAR")=$G(ASUK("SRPT","IOPAR"))
  1.  .D S^ASUUZIS
  1.  G:$D(DTOUT) END G:$D(DUOUT) END
  1.  I POP W " for Standard Reports" G END
  1.  S ASUP("CKP")=$G(ASUP("CKP"))
  1.  S (ASUP("STP"),ASUP("SRP"))="N"
  1.  D SETTY^ASUCOSTS
  1.  I ASUK("SRPT","Q")=1 D
  1.  .W !!,"Since you have queued these reports, make sure that proper forms are mounted"
  1.  .W !,"Mount Standard Computer Paper on Printer ",ASUK("SRPT","ION")
  1.  .S XBRP="^ASURMSTD"
  1.  .S XBRC="^ASUCOMOR"
  1.  .S XBRX="^ASUCOKIL"
  1.  .S XBIOP=ASUK("IRPT","IOP")
  1.  .S ASUK("PTR")="IRPT"
  1.  .D Q^ASUUZIS
  1.  E  D
  1.  .S ASUP("CKP")=7
  1.  .D ^ASUCOMOR ;Monthly closeout update and report extract
  1.  .D ^ASURMSTD ;Monthly Standard Reports print
  1.  .I $G(ASUP("HLT"))=1 D ^ASUCOKIL Q  ;Quit run if error has occured
  1.  .S ASUP("CKP")=0 D SETSTAT^ASUCOSTS ;Set Status to run sucessfully completed
  1.  D STAT^ASUCOKIL ;Kill all normal variables
  1. END ;
  1.  K ASUP,ASUF,DTOUT,DUOUT
  1. KILL ;
  1.  K DUOUT,ASUP
  1.  Q
  1. ERR ;
  1.  W !!?25,"**** ERROR ****",*7,!
  1.  W !,"The Run Control table ASUTBL SITE indicates that month ",ASUP("MO")," should"
  1.  W !,"be the month for the monthly closeout, but the current date of ",ASUK("DT")," is",!,"not consistent."
  1.  I ASUP("ERR")=2 D
  1.  .W "It appears that the current month has already been",!,"closed out and it is too early for next month's run."
  1.  I ASUP("ERR")=1 D
  1.  .W "It appears that the you are attempting to closeout the",!,"current month before the earliest closeout date allowed."
  1.  W !!,"The computer program is unable to determine correct Month to closeout."
  1.  W *7,!!?10,"***** Notify your Supervisor to correct the problem *****",*7,!!
  1.  K DIR S DIR(0)="E" D ^DIR
  1.  Q