- 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
