ASUCOYER ; IHS/ITSC/LMH -YEARLY CLOSEOUT ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine controls a Yearly closeout (first day of new FY) update
;run
S ASUV("RPQ")="",ASUP("TYP")=2
D CLS^ASUUHDG,^ASUCOSTS
W !?20,"Yearly Closeout Process Running",!
D SETCTRL^ASUCOSTS
D ^ASUCORUN Q:'ASUP("OK") G:ASUP("RE*") UPDT
D SETRUN^ASUUDATE
I ASUP("LSTY")=1,$E(ASUP("LSMO"),2)=9 D
.D CKOK
E D G:ASUP("HLT") KILL
.I ASUP("LSTY")=1 D Q
..W *7,!?25,"**** ERROR ****",!
..;beginnig Y2K fix
..;S Y=2_$E(ASUP("LSMO"),3,4)_$E(ASUP("LSMO"),1,2) X ^DD("DD")
..D START^ASUUY2K(ASUP("LSMO"),1,U,"N") X ^DD("DD") ;Y2000
..;end Y2K fix block
..W !,"The last monthly closeout was for the month of ",Y
..S DIR(0)="E",DIR("A")="Yearly runs must be done after the September monthly closeout" D ^DIR
..S ASUP("HLT")=1
.I ASUP("LSTY")=1,$E(ASUP("LSMO"),2)=8 D Q
..W *7,!!?25,"**** ERROR ****",!!
..W !,"The month of September is not closed out (Monthly closeout not completed)",!
..W !,"A monthly closeout must be completed for September."
..S DIR(0)="E",DIR("A")="After it has been completed, redo the yearly closeout" D ^DIR
..K DIR S ASUP("HLT")=1
.I ASUP("LSTY")'=1,$E(ASUP("LSMO"),2)=9 D Q:ASUP("HLT")
..W *7,!!?25,"**** WARNING ****",!!
..W !,"September has been closed out, but last update was not the monthly closeout.",!,"If you close out the fiscal year, data processed since the September closeout",!,"may be lost in some of your reports and files.",!
..S DIR(0)="Y",DIR("A")="Are you sure you want to close out the fiscal year" D ^DIR
..K DIR
..Q:$D(DTOUT) Q:$D(DUOUT)
..I Y D
...D CKOK
..E S ASUP("HLT")=1
.I ASUP("TYP")=2 D
..W *7,!!?25,"**** ERROR ****",!!
..W !,"The last update was a yearly closeout which has successfully completed",!!
..K DIR S DIR(0)="E",DIR("A")="**** Contact your supervisor if you wish to re-run it ****" D ^DIR
.E D
..W *7,!!?25,"**** ERROR ****",!!
..W !,"The last update was other than a monthly closeout, and the last monthly was not",!,"for either September or August.",!!
..K DIR S DIR(0)="E",DIR("A")="**** Contact your supervisor to resolve the problem ****" D ^DIR
.S ASUP("HLT")=1
G:$D(DTOUT) KILL
G UPDT
UPDT ;
I 'ASUP("RE*") S ASUP("LSYR")=ASUP("MOYR") D SETLM^ASUCOSTS
;D YEARCLR^ASUMCUPD
S ASUP("RE*")=+$G(ASUP("RE*"))
S ASUP("CKP")=$G(ASUP("CKP"))
S (ASUP("STP"),ASUP("IVS"),ASUP("SRP"))="N"
D SETTY^ASUCOSTS
S ASUP("CKP")=7
D CLYR^ASUMKBPS
I ASUP("CKY")'=5 S ASUP("HLT")=1
;D ^ASUCOHKP Q:ASUP("HLT")
;S ASUP("CKP")=5 D SETSTAT^ASUCOSTS
S ASUP("CKY")=0,ASUP("CKP")=0 D SETSTAT^ASUCOSTS
G:$G(ASUP("HLT"))=1 KILL
D STAT^ASUCOKIL
Q
KILL ;
D SETSTAT^ASUCOSTS
D ^ASUCOKIL
K ASUP("LST"),ASUF
Q:ASUP("HLT")
S ASUP("CKY")=0 D SETSY^ASUCOSTS S ASUP("CKP")=2 D SETSP^ASUCOSTS
S ASUP("CKP")=0 D SETSTAT^ASUCOSTS ;Set Status to run sucessfully completed
D ^ASUCOKIL,STAT^ASUCOKIL ;Kill all normal variables
K ASUP Q
END ;
K ASUP,ASUF,DTOUT,DUOUT
Q
CKOK ;
S ASUP("MOYR")=10_ASUK("DT","CFY")
I ASUP("MOYR")=ASUP("LSYR") D
.W !,"The yearly closeout for ",ASUP("MOYR")," has already successfully completed"
.K DIR S DIR(0)="E",DIR("A")="**** Contact your supervisor if you wish to re-run it ****" D ^DIR
.S ASUP("HLT")=1
E D
.D DT^DILF("E",1000_ASUK("DT","CFY"),.X)
.W !,"Year end closeout run will be first processing of 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 S ASUP("HLT")=1,DUOUT=1
Q
ASUCOYER ; IHS/ITSC/LMH -YEARLY CLOSEOUT ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine controls a Yearly closeout (first day of new FY) update
+3 ;run
+4 SET ASUV("RPQ")=""
SET ASUP("TYP")=2
+5 DO CLS^ASUUHDG
DO ^ASUCOSTS
+6 WRITE !?20,"Yearly Closeout Process Running",!
+7 DO SETCTRL^ASUCOSTS
+8 DO ^ASUCORUN
IF 'ASUP("OK")
QUIT
IF ASUP("RE*")
GOTO UPDT
+9 DO SETRUN^ASUUDATE
+10 IF ASUP("LSTY")=1
IF $EXTRACT(ASUP("LSMO"),2)=9
Begin DoDot:1
+11 DO CKOK
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 IF ASUP("LSTY")=1
Begin DoDot:2
+14 WRITE *7,!?25,"**** ERROR ****",!
+15 ;beginnig Y2K fix
+16 ;S Y=2_$E(ASUP("LSMO"),3,4)_$E(ASUP("LSMO"),1,2) X ^DD("DD")
+17 ;Y2000
DO START^ASUUY2K(ASUP("LSMO"),1,U,"N")
XECUTE ^DD("DD")
+18 ;end Y2K fix block
+19 WRITE !,"The last monthly closeout was for the month of ",Y
+20 SET DIR(0)="E"
SET DIR("A")="Yearly runs must be done after the September monthly closeout"
DO ^DIR
+21 SET ASUP("HLT")=1
End DoDot:2
QUIT
+22 IF ASUP("LSTY")=1
IF $EXTRACT(ASUP("LSMO"),2)=8
Begin DoDot:2
+23 WRITE *7,!!?25,"**** ERROR ****",!!
+24 WRITE !,"The month of September is not closed out (Monthly closeout not completed)",!
+25 WRITE !,"A monthly closeout must be completed for September."
+26 SET DIR(0)="E"
SET DIR("A")="After it has been completed, redo the yearly closeout"
DO ^DIR
+27 KILL DIR
SET ASUP("HLT")=1
End DoDot:2
QUIT
+28 IF ASUP("LSTY")'=1
IF $EXTRACT(ASUP("LSMO"),2)=9
Begin DoDot:2
+29 WRITE *7,!!?25,"**** WARNING ****",!!
+30 WRITE !,"September has been closed out, but last update was not the monthly closeout.",!,"If you close out the fiscal year, data processed since the September closeout",!,"may be lost in some of your reports and files.",!
+31 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to close out the fiscal year"
DO ^DIR
+32 KILL DIR
+33 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+34 IF Y
Begin DoDot:3
+35 DO CKOK
End DoDot:3
+36 IF '$TEST
SET ASUP("HLT")=1
End DoDot:2
IF ASUP("HLT")
QUIT
+37 IF ASUP("TYP")=2
Begin DoDot:2
+38 WRITE *7,!!?25,"**** ERROR ****",!!
+39 WRITE !,"The last update was a yearly closeout which has successfully completed",!!
+40 KILL DIR
SET DIR(0)="E"
SET DIR("A")="**** Contact your supervisor if you wish to re-run it ****"
DO ^DIR
End DoDot:2
+41 IF '$TEST
Begin DoDot:2
+42 WRITE *7,!!?25,"**** ERROR ****",!!
+43 WRITE !,"The last update was other than a monthly closeout, and the last monthly was not",!,"for either September or August.",!!
+44 KILL DIR
SET DIR(0)="E"
SET DIR("A")="**** Contact your supervisor to resolve the problem ****"
DO ^DIR
End DoDot:2
+45 SET ASUP("HLT")=1
End DoDot:1
IF ASUP("HLT")
GOTO KILL
+46 IF $DATA(DTOUT)
GOTO KILL
+47 GOTO UPDT
UPDT ;
+1 IF 'ASUP("RE*")
SET ASUP("LSYR")=ASUP("MOYR")
DO SETLM^ASUCOSTS
+2 ;D YEARCLR^ASUMCUPD
+3 SET ASUP("RE*")=+$GET(ASUP("RE*"))
+4 SET ASUP("CKP")=$GET(ASUP("CKP"))
+5 SET (ASUP("STP"),ASUP("IVS"),ASUP("SRP"))="N"
+6 DO SETTY^ASUCOSTS
+7 SET ASUP("CKP")=7
+8 DO CLYR^ASUMKBPS
+9 IF ASUP("CKY")'=5
SET ASUP("HLT")=1
+10 ;D ^ASUCOHKP Q:ASUP("HLT")
+11 ;S ASUP("CKP")=5 D SETSTAT^ASUCOSTS
+12 SET ASUP("CKY")=0
SET ASUP("CKP")=0
DO SETSTAT^ASUCOSTS
+13 IF $GET(ASUP("HLT"))=1
GOTO KILL
+14 DO STAT^ASUCOKIL
+15 QUIT
KILL ;
+1 DO SETSTAT^ASUCOSTS
+2 DO ^ASUCOKIL
+3 KILL ASUP("LST"),ASUF
+4 IF ASUP("HLT")
QUIT
+5 SET ASUP("CKY")=0
DO SETSY^ASUCOSTS
SET ASUP("CKP")=2
DO SETSP^ASUCOSTS
+6 ;Set Status to run sucessfully completed
SET ASUP("CKP")=0
DO SETSTAT^ASUCOSTS
+7 ;Kill all normal variables
DO ^ASUCOKIL
DO STAT^ASUCOKIL
+8 KILL ASUP
QUIT
END ;
+1 KILL ASUP,ASUF,DTOUT,DUOUT
+2 QUIT
CKOK ;
+1 SET ASUP("MOYR")=10_ASUK("DT","CFY")
+2 IF ASUP("MOYR")=ASUP("LSYR")
Begin DoDot:1
+3 WRITE !,"The yearly closeout for ",ASUP("MOYR")," has already successfully completed"
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="**** Contact your supervisor if you wish to re-run it ****"
DO ^DIR
+5 SET ASUP("HLT")=1
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO DT^DILF("E",1000_ASUK("DT","CFY"),.X)
+8 WRITE !,"Year end closeout run will be first processing of Month and FISCAL year ",!?30,X(0)
+9 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Is that correct"
DO ^DIR
+10 IF 'Y
SET ASUP("HLT")=1
SET DUOUT=1
End DoDot:1
+11 QUIT
