ASUCODAY.m

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