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