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

ASUCODAY.m

Go to the documentation of this file.
  1. ASUCODAY ; IHS/ITSC/LMH -DAILY CLOSEOUT ;
  1. ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. ;This routine controls a daily Closeout.
  1. S ASUP("HLT")=0
  1. D CLS^ASUUHDG
  1. W !?15,"Daily Closeout Procedure Running",!
  1. D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
  1. S ASUP("TYP")=0
  1. D SETCTRL^ASUCOSTS
  1. D ^ASUCORUN Q:'ASUP("OK") D SETRUN^ASUUDATE
  1. I ASUP("RE*") I ASUP("IVR")="Y",ASUP("CKI")=0 S ASUP("RE*")=2
  1. G:ASUP("RE*") UPDT
  1. I $E(ASUP("LSMO"),1,2)="09",ASUP("LSTY")=1 D Q
  1. .W *7,!?27,"**** ERROR ****",!
  1. .W *7,!,"You have chosen a 'daily closeout' but the most recent run was for September",!,"'monthly closeout'. You should run a 'yearly closeout' before additional daily closeouts."
  1. .W *7,!,"Run a 'yearly closeout' or contact your Supervisor to resolve this problem"
  1. .N DIR S DIR(0)="E" D ^DIR S ASUP("HLT")=1
  1. I $E(ASUP("LSMO"),1,2)'=ASUK("DT","MO") D
  1. .S ASUP("MO")=ASUP("NXMO")_$S(ASUP("NXMO")="09":ASUK("DT","PFY"),1:ASUK("DT","CFY"))
  1. .I ASUP("MOL")<ASUK("DT","DA"),ASUP("MO")=ASUK("DT","MO") D Q
  1. ..W *7,!!?30,"**ERROR**",!!!
  1. ..W *7,"You have choosen a 'daily closeout' and you have not run a 'monthly closeout'"
  1. ..W !,"for the month of ",ASUP("MO")," and it is past the cutoff date for that month!!",!
  1. ..W *7,!!?22,"Daily closeout will not be Allowed",!!,*7 S ASUP("HLT")=1
  1. ..N DIR S DIR(0)="E",DIR("A")="Run a 'monthly closeout' or contact your Supervisor to resolve this problem" D ^DIR
  1. .S X=ASUK("DT","MO")_ASUK("DT","DA") I X>ASUP("MOW") D
  1. ..W *7,!!?30,"**WARNING**",!!,"You have choosen a 'daily closeout' and you have not run a 'monthly closeout' for the month of ",ASUK("DT","RUNMY") N DIR S DIR(0)="E" D ^DIR
  1. ..K ASUP("MO")
  1. ..I $D(DTOUT)!($D(DUOUT)) S ASUP("HLT")=1 Q
  1. ..S:'Y ASUP("HLT")=1
  1. I ASUP("HLT") K ASUP Q
  1. I $E(ASUP("LSDT"),1,2)=ASUK("DT","FM")
  1. UPDT ;
  1. I ASUP("A13") D
  1. .I ASUP("A13")=2 D
  1. ..D P0^ASURD13P,MENU^ASURD13P
  1. .E D
  1. ..S DIR(0)="Y",DIR("A")="Do you want a Requirements Analysis report (13) included with standard reports" D ^DIR
  1. ..K DIR
  1. ..Q:$D(DTOUT) Q:$D(DUOUT)
  1. ..I Y D P0^ASURD13P,MENU^ASURD13P
  1. G:$D(DTOUT) END G:$D(DUOUT) END G:$G(ASUP("HLT"))=1 END
  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 ASUK("PTR")="IRPT"
  1. I ASUP("AIV")>0 D
  1. .S %ZIS("A")="Select Invoice Reports Printer (80 Characters/line) "
  1. .K XBRC S XBRP="^ASURDPRT"
  1. .D S^ASUUZIS
  1. E D
  1. .S IOP=ASUK("IRPT","IOP"),%ZIS("IOPAR")=$G(ASUK("IRPT","IOPAR"))
  1. .K XBRC S XBRP="^ASURDPRT"
  1. .D S^ASUUZIS
  1. G:$D(DTOUT) END G:$D(DUOUT) END
  1. I POP W " for Invoice Reports" G END
  1. S ASUP("CKP")=$G(ASUP("CKP"))
  1. S (ASUP("STP"),ASUP("IVS"),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 8 1/2 X 11 Paper on Printer ",ASUK("IRPT","ION")
  1. .W !,"Mount Standard Computer Paper on Printer ",ASUK("SRPT","ION")
  1. .S XBRP="^ASURDPRT"
  1. .S XBRC="^ASUCOUTP"
  1. .S XBRX="^ASUCOKIL"
  1. .S XBIOP=ASUK("IRPT","IOP")
  1. .S ASUK("PTR")="IRPT"
  1. .D Q^ASUUZIS
  1. E D
  1. .D:ASUP("CKP")<6 ^ASUCOUTP Q:$G(ASUS("HLT")) Q:ASUP("CKP")'=6
  1. .D:ASUP("CKP")=6 IV^ASURDPRT ;Print Invoice Reports
  1. .I $G(ASUP("HLT"))=1 D ^ASUCOKIL Q ;Quit run if error has occured
  1. .D:ASUP("CKP")>6 ST^ASURDPRT ;Print Standard Reports
  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. Q