ASUUDATE ; IHS/ITSC/LMH -DATE UTILITY FUNCTIONS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility which stores various versions of the Date
;and time data into local 'Constant' variables ASUK("DT") which are
;used by SAMS routines rather than the DT variable. In this way, a
;date may be set before an update is run to be used as the 'As Of' date
;for the update. Normally, however the current computer date contained
;in variable DT is used to set up the ASUK("DT") array.
DAYTIM ;EP; -SET DATE AND TIME
D DATE
D TIME
I $D(ASUT) S ASUT(ASUT,"TRKY")=ASUK("DT","FM")_"."_ASUK("TIME","F")_"."_DUZ
Q
DATE ;EP; -SET ASUK("DT")
N X
I ($D(ASUK("DT"))#10)=0 D
.D NOW^%DTC S Y=% X ^DD("DD")
.D SETDT(X)
Q
SETDT(X) ;EP ;
S ASUK("DT","FM")=X,ASUK("DT")=$P(Y,"@"),ASUK("DT","TIME")=Y
S ASUK("DT","MOFM")=$E(ASUK("DT","FM"),1,5)_"00"
S ASUK("DT","ENXYR")=$E(X,1,3)+1_"1231"
S ASUK("DT","YEAR")=$P(ASUK("DT"),",",2),ASUK("DT","YMD")=$E(X,2,7)
S ASUK("DT","YR")=$E(X,2,3),ASUK("DT","MO")=$E(X,4,5),ASUK("DT","DA")=$E(X,6,7)
S ASUK("DT","CFYEDT")=$E(X,1,3)
S ASUK("DT","MONTH")=$P(ASUK("DT")," ")
S ASUK("DT","YRMO")=$E(X,2,5)
S ASUK("DT","FYMO")=ASUK("DT","YRMO")
S ASUK("DT","FYM#")=$E(ASUK("DT","FYMO"),3,4)+3 S:ASUK("DT","FYM#")>12 ASUK("DT","FYM#")=ASUK("DT","FYM#")-12
S ASUK("DT","CFY")=ASUK("DT","YR")
I +ASUK("DT","MO")>9 D
.S ASUK("DT","CFYEDT")=ASUK("DT","CFYEDT")+1
.S ASUK("DT","CFY")=$E(ASUK("DT","CFYEDT"),2,3)
.S ASUK("DT","FYMO")=ASUK("DT","CFY")_ASUK("DT","MO")
S ASUK("DT","PFYBDT")=ASUK("DT","CFYEDT")-1
S ASUK("DT","PFY")=$E(ASUK("DT","PFYBDT"),2,3)
S ASUK("DT","CFYEDT")=ASUK("DT","CFYEDT")_"1231"
S ASUK("DT","PFYBDT")=ASUK("DT","PFYBDT")_"0131"
S X1=ASUK("DT","FM"),X2=$E(ASUK("DT","FM"),1,3)_"0101" D ^%DTC
S ASUK("DT","JUL")=X+1
Q:'$D(%H)
S ASUK("DT","H")=$P(%H,","),ASUK("TIME","H")=$P(%H,",",2)
S ASUK("TIME")=$P(Y,"@",2)
Q
ASKDATE ;EP -ASK FOR A DATE AND SET ASUK("DT") ARRAY
N %DT S %DT="AS" D ^%DT S X=Y
X ^DD("DD")
D SETDT(X),TIME
Q
TIME ;EP; -SET ASUK("TIME")
N X
S %H=$H D YX^%DTC
S ASUK("TIME")=$P(Y,"@",2),ASUK("TIME","H")=$P(%H,",",2)
S ASUK("TIME","F")=$P(ASUK("TIME"),":")_$P(ASUK("TIME"),":",2)_$P(ASUK("TIME"),":",3)
I ($D(ASUK("DT"))#10) D
.S ASUK("DT","TIME")=ASUK("DT")_"@"_ASUK("TIME")
E D
.S ASUK("DT","TIME")=Y
Q
GETRUN ;EP ; -GET RUN FISCAL YEAR AND MONTH
I ($D(ASUK("DT"))#10)'=1 D DATE
S DIR(0)="D" D ^DIR K DIR
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUK("DT","RUN")=ASUK("DT","FM")
S ASUK("DT","RUNMY")=$E(Y,4,5)_$E(Y,2,3)
S ASUK("DT","RUNMO")=ASUK("DT","MO")
S ASUK("DT","RUNYR")=ASUK("DT","CFY")
I $E(ASUK("DT","RUNMO"))=0&($E(ASUK("DT","RUNMO"),2,2))>0 D
.S ASUK("DT","RUNMO")=$E(ASUK("DT","RUNMO"),2,2)
Q
SETMO(X) ;EP ; -SET MONTHLY RUN PARAMETERS
S ASUP("MO")=X
S ASUP("YR")=$S(X="09"&(ASUK("DT","MO")'="09"):ASUK("DT","PFY"),1:ASUK("DT","CFY"))
S ASUP("MOYR")=ASUP("MO")_ASUP("YR")
S ASUP("ERR")=0
I ASUK("DT","MO")="01",ASUP("MO")="12",ASUK("DT","DA")'>ASUP("MOL") Q
I ASUK("DT","MO")=ASUP("MO") Q
I +ASUP("MO")=$S(ASUK("DT","MO")="01":12,1:ASUK("DT","MO")-1),ASUK("DT","DA")<ASUP("MOL") Q
I ASUP("MO")>ASUK("DT","MO") S ASUP("ERR")=3 Q
S ASUP("ERR")=2 Q
Q
SETRUN ;EP ; -SET RUN DATE EQUAL DATE
I ($D(ASUK("DT"))#10)'=1 D DATE
S ASUK("DT","RUN")=ASUK("DT","FM")
;WAR 5/18/99 REM'd next line & added $E of ASUP("LSMO")
;I +$E(ASUK("DT","RUN"),4,5)>+ASUP("LSMO"),ASUP("MOL")<ASUP("MOE"),ASUK("DT","DA")<ASUP("MOL") D
I +$E(ASUK("DT","RUN"),4,5)>+$E(ASUP("LSMO"),1,2),ASUP("MOL")<ASUP("MOE"),ASUK("DT","DA")<ASUP("MOL") D
.S X=ASUK("DT","MO")-1 S:X<10 X="0"_X
.S ASUK("DT","RUNMO")=X
.S:ASUK("DT","RUNMO")="00" ASUK("DT","RUNMO")=12
.S ASUK("DT","RUNYR")=ASUK("DT","CFY")
.S:ASUK("DT","RUNMO")="09" ASUK("DT","RUNYR")=ASUK("DT","PFY")
E D
.S ASUK("DT","RUNMO")=ASUK("DT","MO")
.S ASUK("DT","RUNYR")=ASUK("DT","CFY")
S ASUK("DT","RUNMY")=ASUK("DT","RUNMO")_ASUK("DT","RUNYR")
S ASUK("DT","RUNLS")=$P(^ASUSITE(1,0),U,14),ASUK("DT","RUNNM")=$E(ASUK("DT","RUNLS"),1,2)+1
S:ASUK("DT","RUNNM")=13 ASUK("DT","RUNNM")=1
I +ASUK("DT","RUNNM")=+ASUK("DT","RUNMO") D
.W " (MMYY)=",ASUK("DT","RUNMY")
E D
.I ASUP("TYP")=2,ASUK("DT","RUNMO")[9 D
..W !,"Processing Yearly Closeout"
.E D
..W !,"The computer date indicates that this run should be part of month ",ASUK("DT","RUNMO"),","
..W !,"but the Run Control table ASUTBL SITE indicates the most recent Monthly",!,"run was for ",ASUK("DT","RUNLS"),", therefore "
..I $E(ASUK("DT","RUNLS"),1,2)=ASUK("DT","RUNMO") D
...W "a monthly run has already sucessfully completed",!,"for month ",ASUK("DT","RUNMO"),"."
..E D
...I $E(ASUK("DT","RUNLS"),1,2)<ASUK("DT","RUNMO") D
....W "a month or more has passed without sucessful",!,"completion of monthly run(s)."
...E D
....W "the most recent monthly run was for a month after the",!,"current computer date."
..W !!,"The computer program is unable to determine correct run Month",*7,*7,!!,"***** Notify your Supervisor to take corrective action *****",*7,*7,!!,*7,*7
..K DIR S DIR(0)="E" D ^DIR
..S DUOUT=1
Q
SETQTR ;EP ;INPUT- DT AND ASUP("MO") OUTPUT- ASUP("QTR") IN YRQT FORMAT
I ($D(ASUK("DT"))#10)'=1 D DATE
I '$D(ASUP("MO")) S DIR("A")="Enter Month & Fiscal Year for Quarterly Reports (MMFY)" D ASK^ASUCORUN
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUV("YR")=$S($L(ASUP("YR"))=4:ASUP("YR"),ASUP("YR")<60:20_ASUP("YR"),1:19_ASUP("YR"))
S ASUP("QTR")=ASUV("YR")_$S(ASUP("MO")<4:"02",ASUP("MO")<7:"03",ASUP("MO")>9:"01",1:"04")
K ASUV("YR")
Q
ASUUDATE ; IHS/ITSC/LMH -DATE UTILITY FUNCTIONS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility which stores various versions of the Date
+3 ;and time data into local 'Constant' variables ASUK("DT") which are
+4 ;used by SAMS routines rather than the DT variable. In this way, a
+5 ;date may be set before an update is run to be used as the 'As Of' date
+6 ;for the update. Normally, however the current computer date contained
+7 ;in variable DT is used to set up the ASUK("DT") array.
DAYTIM ;EP; -SET DATE AND TIME
+1 DO DATE
+2 DO TIME
+3 IF $DATA(ASUT)
SET ASUT(ASUT,"TRKY")=ASUK("DT","FM")_"."_ASUK("TIME","F")_"."_DUZ
+4 QUIT
DATE ;EP; -SET ASUK("DT")
+1 NEW X
+2 IF ($DATA(ASUK("DT"))#10)=0
Begin DoDot:1
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+4 DO SETDT(X)
End DoDot:1
+5 QUIT
SETDT(X) ;EP ;
+1 SET ASUK("DT","FM")=X
SET ASUK("DT")=$PIECE(Y,"@")
SET ASUK("DT","TIME")=Y
+2 SET ASUK("DT","MOFM")=$EXTRACT(ASUK("DT","FM"),1,5)_"00"
+3 SET ASUK("DT","ENXYR")=$EXTRACT(X,1,3)+1_"1231"
+4 SET ASUK("DT","YEAR")=$PIECE(ASUK("DT"),",",2)
SET ASUK("DT","YMD")=$EXTRACT(X,2,7)
+5 SET ASUK("DT","YR")=$EXTRACT(X,2,3)
SET ASUK("DT","MO")=$EXTRACT(X,4,5)
SET ASUK("DT","DA")=$EXTRACT(X,6,7)
+6 SET ASUK("DT","CFYEDT")=$EXTRACT(X,1,3)
+7 SET ASUK("DT","MONTH")=$PIECE(ASUK("DT")," ")
+8 SET ASUK("DT","YRMO")=$EXTRACT(X,2,5)
+9 SET ASUK("DT","FYMO")=ASUK("DT","YRMO")
+10 SET ASUK("DT","FYM#")=$EXTRACT(ASUK("DT","FYMO"),3,4)+3
IF ASUK("DT","FYM#")>12
SET ASUK("DT","FYM#")=ASUK("DT","FYM#")-12
+11 SET ASUK("DT","CFY")=ASUK("DT","YR")
+12 IF +ASUK("DT","MO")>9
Begin DoDot:1
+13 SET ASUK("DT","CFYEDT")=ASUK("DT","CFYEDT")+1
+14 SET ASUK("DT","CFY")=$EXTRACT(ASUK("DT","CFYEDT"),2,3)
+15 SET ASUK("DT","FYMO")=ASUK("DT","CFY")_ASUK("DT","MO")
End DoDot:1
+16 SET ASUK("DT","PFYBDT")=ASUK("DT","CFYEDT")-1
+17 SET ASUK("DT","PFY")=$EXTRACT(ASUK("DT","PFYBDT"),2,3)
+18 SET ASUK("DT","CFYEDT")=ASUK("DT","CFYEDT")_"1231"
+19 SET ASUK("DT","PFYBDT")=ASUK("DT","PFYBDT")_"0131"
+20 SET X1=ASUK("DT","FM")
SET X2=$EXTRACT(ASUK("DT","FM"),1,3)_"0101"
DO ^%DTC
+21 SET ASUK("DT","JUL")=X+1
+22 IF '$DATA(%H)
QUIT
+23 SET ASUK("DT","H")=$PIECE(%H,",")
SET ASUK("TIME","H")=$PIECE(%H,",",2)
+24 SET ASUK("TIME")=$PIECE(Y,"@",2)
+25 QUIT
ASKDATE ;EP -ASK FOR A DATE AND SET ASUK("DT") ARRAY
+1 NEW %DT
SET %DT="AS"
DO ^%DT
SET X=Y
+2 XECUTE ^DD("DD")
+3 DO SETDT(X)
DO TIME
+4 QUIT
TIME ;EP; -SET ASUK("TIME")
+1 NEW X
+2 SET %H=$HOROLOG
DO YX^%DTC
+3 SET ASUK("TIME")=$PIECE(Y,"@",2)
SET ASUK("TIME","H")=$PIECE(%H,",",2)
+4 SET ASUK("TIME","F")=$PIECE(ASUK("TIME"),":")_$PIECE(ASUK("TIME"),":",2)_$PIECE(ASUK("TIME"),":",3)
+5 IF ($DATA(ASUK("DT"))#10)
Begin DoDot:1
+6 SET ASUK("DT","TIME")=ASUK("DT")_"@"_ASUK("TIME")
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET ASUK("DT","TIME")=Y
End DoDot:1
+9 QUIT
GETRUN ;EP ; -GET RUN FISCAL YEAR AND MONTH
+1 IF ($DATA(ASUK("DT"))#10)'=1
DO DATE
+2 SET DIR(0)="D"
DO ^DIR
KILL DIR
+3 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+4 SET ASUK("DT","RUN")=ASUK("DT","FM")
+5 SET ASUK("DT","RUNMY")=$EXTRACT(Y,4,5)_$EXTRACT(Y,2,3)
+6 SET ASUK("DT","RUNMO")=ASUK("DT","MO")
+7 SET ASUK("DT","RUNYR")=ASUK("DT","CFY")
+8 IF $EXTRACT(ASUK("DT","RUNMO"))=0&($EXTRACT(ASUK("DT","RUNMO"),2,2))>0
Begin DoDot:1
+9 SET ASUK("DT","RUNMO")=$EXTRACT(ASUK("DT","RUNMO"),2,2)
End DoDot:1
+10 QUIT
SETMO(X) ;EP ; -SET MONTHLY RUN PARAMETERS
+1 SET ASUP("MO")=X
+2 SET ASUP("YR")=$SELECT(X="09"&(ASUK("DT","MO")'="09"):ASUK("DT","PFY"),1:ASUK("DT","CFY"))
+3 SET ASUP("MOYR")=ASUP("MO")_ASUP("YR")
+4 SET ASUP("ERR")=0
+5 IF ASUK("DT","MO")="01"
IF ASUP("MO")="12"
IF ASUK("DT","DA")'>ASUP("MOL")
QUIT
+6 IF ASUK("DT","MO")=ASUP("MO")
QUIT
+7 IF +ASUP("MO")=$SELECT(ASUK("DT","MO")="01":12,1:ASUK("DT","MO")-1)
IF ASUK("DT","DA")<ASUP("MOL")
QUIT
+8 IF ASUP("MO")>ASUK("DT","MO")
SET ASUP("ERR")=3
QUIT
+9 SET ASUP("ERR")=2
QUIT
+10 QUIT
SETRUN ;EP ; -SET RUN DATE EQUAL DATE
+1 IF ($DATA(ASUK("DT"))#10)'=1
DO DATE
+2 SET ASUK("DT","RUN")=ASUK("DT","FM")
+3 ;WAR 5/18/99 REM'd next line & added $E of ASUP("LSMO")
+4 ;I +$E(ASUK("DT","RUN"),4,5)>+ASUP("LSMO"),ASUP("MOL")<ASUP("MOE"),ASUK("DT","DA")<ASUP("MOL") D
+5 IF +$EXTRACT(ASUK("DT","RUN"),4,5)>+$EXTRACT(ASUP("LSMO"),1,2)
IF ASUP("MOL")<ASUP("MOE")
IF ASUK("DT","DA")<ASUP("MOL")
Begin DoDot:1
+6 SET X=ASUK("DT","MO")-1
IF X<10
SET X="0"_X
+7 SET ASUK("DT","RUNMO")=X
+8 IF ASUK("DT","RUNMO")="00"
SET ASUK("DT","RUNMO")=12
+9 SET ASUK("DT","RUNYR")=ASUK("DT","CFY")
+10 IF ASUK("DT","RUNMO")="09"
SET ASUK("DT","RUNYR")=ASUK("DT","PFY")
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ASUK("DT","RUNMO")=ASUK("DT","MO")
+13 SET ASUK("DT","RUNYR")=ASUK("DT","CFY")
End DoDot:1
+14 SET ASUK("DT","RUNMY")=ASUK("DT","RUNMO")_ASUK("DT","RUNYR")
+15 SET ASUK("DT","RUNLS")=$PIECE(^ASUSITE(1,0),U,14)
SET ASUK("DT","RUNNM")=$EXTRACT(ASUK("DT","RUNLS"),1,2)+1
+16 IF ASUK("DT","RUNNM")=13
SET ASUK("DT","RUNNM")=1
+17 IF +ASUK("DT","RUNNM")=+ASUK("DT","RUNMO")
Begin DoDot:1
+18 WRITE " (MMYY)=",ASUK("DT","RUNMY")
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 IF ASUP("TYP")=2
IF ASUK("DT","RUNMO")[9
Begin DoDot:2
+21 WRITE !,"Processing Yearly Closeout"
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 WRITE !,"The computer date indicates that this run should be part of month ",ASUK("DT","RUNMO"),","
+24 WRITE !,"but the Run Control table ASUTBL SITE indicates the most recent Monthly",!,"run was for ",ASUK("DT","RUNLS"),", therefore "
+25 IF $EXTRACT(ASUK("DT","RUNLS"),1,2)=ASUK("DT","RUNMO")
Begin DoDot:3
+26 WRITE "a monthly run has already sucessfully completed",!,"for month ",ASUK("DT","RUNMO"),"."
End DoDot:3
+27 IF '$TEST
Begin DoDot:3
+28 IF $EXTRACT(ASUK("DT","RUNLS"),1,2)<ASUK("DT","RUNMO")
Begin DoDot:4
+29 WRITE "a month or more has passed without sucessful",!,"completion of monthly run(s)."
End DoDot:4
+30 IF '$TEST
Begin DoDot:4
+31 WRITE "the most recent monthly run was for a month after the",!,"current computer date."
End DoDot:4
End DoDot:3
+32 WRITE !!,"The computer program is unable to determine correct run Month",*7,*7,!!,"***** Notify your Supervisor to take corrective action *****",*7,*7,!!,*7,*7
+33 KILL DIR
SET DIR(0)="E"
DO ^DIR
+34 SET DUOUT=1
End DoDot:2
End DoDot:1
+35 QUIT
SETQTR ;EP ;INPUT- DT AND ASUP("MO") OUTPUT- ASUP("QTR") IN YRQT FORMAT
+1 IF ($DATA(ASUK("DT"))#10)'=1
DO DATE
+2 IF '$DATA(ASUP("MO"))
SET DIR("A")="Enter Month & Fiscal Year for Quarterly Reports (MMFY)"
DO ASK^ASUCORUN
+3 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+4 SET ASUV("YR")=$SELECT($LENGTH(ASUP("YR"))=4:ASUP("YR"),ASUP("YR")<60:20_ASUP("YR"),1:19_ASUP("YR"))
+5 SET ASUP("QTR")=ASUV("YR")_$SELECT(ASUP("MO")<4:"02",ASUP("MO")<7:"03",ASUP("MO")>9:"01",1:"04")
+6 KILL ASUV("YR")
+7 QUIT
