ASUCODAY ; IHS/ITSC/LMH -DAILY CLOSEOUT ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine controls a daily Closeout.
S ASUP("HLT")=0
D CLS^ASUUHDG
W !?15,"Daily Closeout Procedure Running",!
D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
S ASUP("TYP")=0
D SETCTRL^ASUCOSTS
D ^ASUCORUN Q:'ASUP("OK") D SETRUN^ASUUDATE
I ASUP("RE*") I ASUP("IVR")="Y",ASUP("CKI")=0 S ASUP("RE*")=2
G:ASUP("RE*") UPDT
I $E(ASUP("LSMO"),1,2)="09",ASUP("LSTY")=1 D Q
.W *7,!?27,"**** ERROR ****",!
.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."
.W *7,!,"Run a 'yearly closeout' or contact your Supervisor to resolve this problem"
.N DIR S DIR(0)="E" D ^DIR S ASUP("HLT")=1
I $E(ASUP("LSMO"),1,2)'=ASUK("DT","MO") D
.S ASUP("MO")=ASUP("NXMO")_$S(ASUP("NXMO")="09":ASUK("DT","PFY"),1:ASUK("DT","CFY"))
.I ASUP("MOL")<ASUK("DT","DA"),ASUP("MO")=ASUK("DT","MO") D Q
..W *7,!!?30,"**ERROR**",!!!
..W *7,"You have choosen a 'daily closeout' and you have not run a 'monthly closeout'"
..W !,"for the month of ",ASUP("MO")," and it is past the cutoff date for that month!!",!
..W *7,!!?22,"Daily closeout will not be Allowed",!!,*7 S ASUP("HLT")=1
..N DIR S DIR(0)="E",DIR("A")="Run a 'monthly closeout' or contact your Supervisor to resolve this problem" D ^DIR
.S X=ASUK("DT","MO")_ASUK("DT","DA") I X>ASUP("MOW") D
..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
..K ASUP("MO")
..I $D(DTOUT)!($D(DUOUT)) S ASUP("HLT")=1 Q
..S:'Y ASUP("HLT")=1
I ASUP("HLT") K ASUP Q
I $E(ASUP("LSDT"),1,2)=ASUK("DT","FM")
UPDT ;
I ASUP("A13") D
.I ASUP("A13")=2 D
..D P0^ASURD13P,MENU^ASURD13P
.E D
..S DIR(0)="Y",DIR("A")="Do you want a Requirements Analysis report (13) included with standard reports" D ^DIR
..K DIR
..Q:$D(DTOUT) Q:$D(DUOUT)
..I Y D P0^ASURD13P,MENU^ASURD13P
G:$D(DTOUT) END G:$D(DUOUT) END G:$G(ASUP("HLT"))=1 END
S ASUP("RE*")=+$G(ASUP("RE*"))
S ASUK("PTR")="SRPT"
I ASUP("AST")>0 D
.S %ZIS("A")="Select Standard Reports Printer (132 Characters/line) "
.D S^ASUUZIS
E D
.S IOP=ASUK("SRPT","IOP"),%ZIS("IOPAR")=$G(ASUK("SRPT","IOPAR"))
.D S^ASUUZIS
G:$D(DTOUT) END G:$D(DUOUT) END
I POP W " for Standard Reports" G END
S ASUK("PTR")="IRPT"
I ASUP("AIV")>0 D
.S %ZIS("A")="Select Invoice Reports Printer (80 Characters/line) "
.K XBRC S XBRP="^ASURDPRT"
.D S^ASUUZIS
E D
.S IOP=ASUK("IRPT","IOP"),%ZIS("IOPAR")=$G(ASUK("IRPT","IOPAR"))
.K XBRC S XBRP="^ASURDPRT"
.D S^ASUUZIS
G:$D(DTOUT) END G:$D(DUOUT) END
I POP W " for Invoice Reports" G END
S ASUP("CKP")=$G(ASUP("CKP"))
S (ASUP("STP"),ASUP("IVS"),ASUP("SRP"))="N"
D SETTY^ASUCOSTS
I ASUK("SRPT","Q")=1 D
.W !!,"Since you have queued these reports, make sure that proper forms are mounted"
.W !,"Mount 8 1/2 X 11 Paper on Printer ",ASUK("IRPT","ION")
.W !,"Mount Standard Computer Paper on Printer ",ASUK("SRPT","ION")
.S XBRP="^ASURDPRT"
.S XBRC="^ASUCOUTP"
.S XBRX="^ASUCOKIL"
.S XBIOP=ASUK("IRPT","IOP")
.S ASUK("PTR")="IRPT"
.D Q^ASUUZIS
E D
.D:ASUP("CKP")<6 ^ASUCOUTP Q:$G(ASUS("HLT")) Q:ASUP("CKP")'=6
.D:ASUP("CKP")=6 IV^ASURDPRT ;Print Invoice Reports
.I $G(ASUP("HLT"))=1 D ^ASUCOKIL Q ;Quit run if error has occured
.D:ASUP("CKP")>6 ST^ASURDPRT ;Print Standard Reports
.I $G(ASUP("HLT"))=1 D ^ASUCOKIL Q ;Quit run if error has occured
.S ASUP("CKP")=0 D SETSTAT^ASUCOSTS ;Set Status to run sucessfully completed
D STAT^ASUCOKIL ;Kill all normal variables
END ;
K ASUP,ASUF,DTOUT,DUOUT
Q
ASUCODAY ; IHS/ITSC/LMH -DAILY CLOSEOUT ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine controls a daily Closeout.
+3 SET ASUP("HLT")=0
+4 DO CLS^ASUUHDG
+5 WRITE !?15,"Daily Closeout Procedure Running",!
+6 IF '$DATA(ASUK("DT","FM"))
DO DATE^ASUUDATE
+7 SET ASUP("TYP")=0
+8 DO SETCTRL^ASUCOSTS
+9 DO ^ASUCORUN
IF 'ASUP("OK")
QUIT
DO SETRUN^ASUUDATE
+10 IF ASUP("RE*")
IF ASUP("IVR")="Y"
IF ASUP("CKI")=0
SET ASUP("RE*")=2
+11 IF ASUP("RE*")
GOTO UPDT
+12 IF $EXTRACT(ASUP("LSMO"),1,2)="09"
IF ASUP("LSTY")=1
Begin DoDot:1
+13 WRITE *7,!?27,"**** ERROR ****",!
+14 WRITE *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."
+15 WRITE *7,!,"Run a 'yearly closeout' or contact your Supervisor to resolve this problem"
+16 NEW DIR
SET DIR(0)="E"
DO ^DIR
SET ASUP("HLT")=1
End DoDot:1
QUIT
+17 IF $EXTRACT(ASUP("LSMO"),1,2)'=ASUK("DT","MO")
Begin DoDot:1
+18 SET ASUP("MO")=ASUP("NXMO")_$SELECT(ASUP("NXMO")="09":ASUK("DT","PFY"),1:ASUK("DT","CFY"))
+19 IF ASUP("MOL")<ASUK("DT","DA")
IF ASUP("MO")=ASUK("DT","MO")
Begin DoDot:2
+20 WRITE *7,!!?30,"**ERROR**",!!!
+21 WRITE *7,"You have choosen a 'daily closeout' and you have not run a 'monthly closeout'"
+22 WRITE !,"for the month of ",ASUP("MO")," and it is past the cutoff date for that month!!",!
+23 WRITE *7,!!?22,"Daily closeout will not be Allowed",!!,*7
SET ASUP("HLT")=1
+24 NEW DIR
SET DIR(0)="E"
SET DIR("A")="Run a 'monthly closeout' or contact your Supervisor to resolve this problem"
DO ^DIR
End DoDot:2
QUIT
+25 SET X=ASUK("DT","MO")_ASUK("DT","DA")
IF X>ASUP("MOW")
Begin DoDot:2
+26 WRITE *7,!!?30,"**WARNING**",!!,"You have choosen a 'daily closeout' and you have not run a 'monthly closeout' for the month of ",ASUK("DT","RUNMY")
NEW DIR
SET DIR(0)="E"
DO ^DIR
+27 KILL ASUP("MO")
+28 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ASUP("HLT")=1
QUIT
+29 IF 'Y
SET ASUP("HLT")=1
End DoDot:2
End DoDot:1
+30 IF ASUP("HLT")
KILL ASUP
QUIT
+31 IF $EXTRACT(ASUP("LSDT"),1,2)=ASUK("DT","FM")
UPDT ;
+1 IF ASUP("A13")
Begin DoDot:1
+2 IF ASUP("A13")=2
Begin DoDot:2
+3 DO P0^ASURD13P
DO MENU^ASURD13P
End DoDot:2
+4 IF '$TEST
Begin DoDot:2
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want a Requirements Analysis report (13) included with standard reports"
DO ^DIR
+6 KILL DIR
+7 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+8 IF Y
DO P0^ASURD13P
DO MENU^ASURD13P
End DoDot:2
End DoDot:1
+9 IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO END
IF $GET(ASUP("HLT"))=1
GOTO END
+10 SET ASUP("RE*")=+$GET(ASUP("RE*"))
+11 SET ASUK("PTR")="SRPT"
+12 IF ASUP("AST")>0
Begin DoDot:1
+13 SET %ZIS("A")="Select Standard Reports Printer (132 Characters/line) "
+14 DO S^ASUUZIS
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET IOP=ASUK("SRPT","IOP")
SET %ZIS("IOPAR")=$GET(ASUK("SRPT","IOPAR"))
+17 DO S^ASUUZIS
End DoDot:1
+18 IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO END
+19 IF POP
WRITE " for Standard Reports"
GOTO END
+20 SET ASUK("PTR")="IRPT"
+21 IF ASUP("AIV")>0
Begin DoDot:1
+22 SET %ZIS("A")="Select Invoice Reports Printer (80 Characters/line) "
+23 KILL XBRC
SET XBRP="^ASURDPRT"
+24 DO S^ASUUZIS
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 SET IOP=ASUK("IRPT","IOP")
SET %ZIS("IOPAR")=$GET(ASUK("IRPT","IOPAR"))
+27 KILL XBRC
SET XBRP="^ASURDPRT"
+28 DO S^ASUUZIS
End DoDot:1
+29 IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO END
+30 IF POP
WRITE " for Invoice Reports"
GOTO END
+31 SET ASUP("CKP")=$GET(ASUP("CKP"))
+32 SET (ASUP("STP"),ASUP("IVS"),ASUP("SRP"))="N"
+33 DO SETTY^ASUCOSTS
+34 IF ASUK("SRPT","Q")=1
Begin DoDot:1
+35 WRITE !!,"Since you have queued these reports, make sure that proper forms are mounted"
+36 WRITE !,"Mount 8 1/2 X 11 Paper on Printer ",ASUK("IRPT","ION")
+37 WRITE !,"Mount Standard Computer Paper on Printer ",ASUK("SRPT","ION")
+38 SET XBRP="^ASURDPRT"
+39 SET XBRC="^ASUCOUTP"
+40 SET XBRX="^ASUCOKIL"
+41 SET XBIOP=ASUK("IRPT","IOP")
+42 SET ASUK("PTR")="IRPT"
+43 DO Q^ASUUZIS
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 IF ASUP("CKP")<6
DO ^ASUCOUTP
IF $GET(ASUS("HLT"))
QUIT
IF ASUP("CKP")'=6
QUIT
+46 ;Print Invoice Reports
IF ASUP("CKP")=6
DO IV^ASURDPRT
+47 ;Quit run if error has occured
IF $GET(ASUP("HLT"))=1
DO ^ASUCOKIL
QUIT
+48 ;Print Standard Reports
IF ASUP("CKP")>6
DO ST^ASURDPRT
+49 ;Quit run if error has occured
IF $GET(ASUP("HLT"))=1
DO ^ASUCOKIL
QUIT
+50 ;Set Status to run sucessfully completed
SET ASUP("CKP")=0
DO SETSTAT^ASUCOSTS
End DoDot:1
+51 ;Kill all normal variables
DO STAT^ASUCOKIL
END ;
+1 KILL ASUP,ASUF,DTOUT,DUOUT
+2 QUIT
