- 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