ASU0PURG ; IHS/ITSC/LMH -DELETE TRANS - RANGE OF DATES ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is invoked by the yearly closeout update (at entry point
;EN2) to purge all history transaction record older than 3 years.
;Although it may also be invoked from the top, no Kernel option is
;provided to do this since it could easly be mis-used - for example all
;transactions except for the current year could be accidently
;deleted if a range of 'First allowed date' to 'Last allowed date' were
;selected.
D DATE^ASUUDATE,TIME^ASUUDATE
S:'$D(DTIME) DTIME=$$DTIME^XUP(DUZ)
D CLS^ASUUHDG
W !!,"Warning -if you continue, You will be asked for a range of 'PROCESS DATES' and",!,"Transactions of all types which were PROCESSED BETWEEN THOSE DATES will be DELETED!!"
K DIR
S DIR("A")="Are you SURE you wish to CONTINUE",DIR(0)=Y,DIR("B")="N"
D ^DIR K DIR
I 'Y Q
W !!,"Beginning date may not be before three years ago",!
S %DT="APE",%DT("A")="Enter Beginning Date : ",%DT(0)=ASUK("DT","FM")-30000 D ^%DT
Q:Y<0 S ASUU("BEGIN")=$P(Y,".") D DD^%DT S ASUU("1ST")=Y K Y
W !!,"Ending date may not be after one year ago",!
S %DT("A")="Enter Ending Date : ",%DT(0)=(ASUK("DT","FM")-10000)*-1 D ^%DT
Q:Y<0 S ASUU("END")=$P(Y,".") D DD^%DT S ASUU("LAST")=Y K Y,%DT
DOIT ;
S ASUU("AC")="AC",(ASUC("DEL"),ASUC("KEPT"))=0
S DIK="^ASUH("
S ASUU("NXDT")=DIK_"ASUU(""AC""),ASUU(""DT"")"
S ASUU("NXTRN")=ASUU("NXDT")_",DA)"
S ASUU("NXDT")=ASUU("NXDT")_")"
X "S ASUU(""E#"")=$P("_DIK_"0),U)"
S ASUU("DT")=0,(ASUA("DELT",ASUU("E#")),ASUA("KEPT",ASUU("E#")))=0
S ASURX="W !,""Now Processing History Transaction File""" D ^ASUUPLOG
F ASUC("TR")=1:1 S ASUU("DT")=$O(@ASUU("NXDT")) Q:ASUU("DT")'?1N.N D
.I ASUU("DT")=""!(ASUU("DT")<ASUU("BEGIN"))!(ASUU("DT")>ASUU("END")) D
..I '$D(ASUA("PROC",ASUU("DT"))) S ASUA("PROC",ASUU("DT"))="",ASUC("KEPT")=ASUC("KEPT")+1
..S ASUA("KEPT",ASUU("E#"))=ASUA("KEPT",ASUU("E#"))+1
.E D
..S DA=0
..F ASUC("TR")=1:1 S DA=$O(@ASUU("NXTRN")) Q:DA="" D ^DIK
..S ASUA("DELT",ASUU("E#"))=ASUA("DELT",ASUU("E#"))+ASUC("TR")
S ASUC("DEL")=ASUC("DEL")+ASUA("DELT",ASUU("E#"))
S ASUU(2)=1 K ^XTMP("ASUR","R02")
S ^XTMP("ASUR","R02",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
S ASURX="W !,""Statistics for Transaction Purge for the Date Range"",!,""Beginning "_ASUU("1ST")_" Ending "_ASUU("LAST")_""",!!" D LOG
S ASUU(1)=""
F ASUC("TR")=1:1 S ASUU(1)=$O(ASUA("DELT",ASUU(1))) Q:ASUU(1)="" D
.S ASURX="W !,"""_ASUU(1)_" Records deleted "",?55,"_ASUA("DELT",ASUU(1)) D LOG
S ASURX="W !,""Total records Deleted "",?55,"_ASUC("DEL")_",!" D LOG
S ASUU(1)=""
F ASUC("TR")=1:1 S ASUU(1)=$O(ASUA("KEPT",ASUU(1))) Q:ASUU(1)="" D
.S ASURX="W !,"""_ASUU(1)_" Days Processed Kept "",?55,"_ASUA("KEPT",ASUU(1)) D LOG
S ASURX="W !,""Total Processed Days Kept"",?55,"_ASUC("KEPT") D LOG
K ASUU,ASUC("TR"),ASUC,ASULA
I $G(ASUP("TYP"))="" D
.S DIR(0)="E" D ^DIR
Q
EN2 ;EP; FROM YEARLY UPDATE
I '$D(ASUK("DT","FM")) D DATE^ASUUDATE,TIME^ASUUDATE
S ASUU("BEGIN")=1,ASUU("1ST")="FIRST DATE",ASUU("END")=$E(ASUK("DT","FM"),1,3)-3_1001,Y=ASUU("END") D DD^%DT S ASUU("LAST")=Y
G DOIT
LOG ;
S ^XTMP("ASUR","R02",ASUU(2))=ASURX,ASUU(2)=ASUU(2)+1
I $G(ASUP("TYP"))="" X ASURX
Q
ASU0PURG ; IHS/ITSC/LMH -DELETE TRANS - RANGE OF DATES ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is invoked by the yearly closeout update (at entry point
+3 ;EN2) to purge all history transaction record older than 3 years.
+4 ;Although it may also be invoked from the top, no Kernel option is
+5 ;provided to do this since it could easly be mis-used - for example all
+6 ;transactions except for the current year could be accidently
+7 ;deleted if a range of 'First allowed date' to 'Last allowed date' were
+8 ;selected.
+9 DO DATE^ASUUDATE
DO TIME^ASUUDATE
+10 IF '$DATA(DTIME)
SET DTIME=$$DTIME^XUP(DUZ)
+11 DO CLS^ASUUHDG
+12 WRITE !!,"Warning -if you continue, You will be asked for a range of 'PROCESS DATES' and",!,"Transactions of all types which were PROCESSED BETWEEN THOSE DATES will be DELETED!!"
+13 KILL DIR
+14 SET DIR("A")="Are you SURE you wish to CONTINUE"
SET DIR(0)=Y
SET DIR("B")="N"
+15 DO ^DIR
KILL DIR
+16 IF 'Y
QUIT
+17 WRITE !!,"Beginning date may not be before three years ago",!
+18 SET %DT="APE"
SET %DT("A")="Enter Beginning Date : "
SET %DT(0)=ASUK("DT","FM")-30000
DO ^%DT
+19 IF Y<0
QUIT
SET ASUU("BEGIN")=$PIECE(Y,".")
DO DD^%DT
SET ASUU("1ST")=Y
KILL Y
+20 WRITE !!,"Ending date may not be after one year ago",!
+21 SET %DT("A")="Enter Ending Date : "
SET %DT(0)=(ASUK("DT","FM")-10000)*-1
DO ^%DT
+22 IF Y<0
QUIT
SET ASUU("END")=$PIECE(Y,".")
DO DD^%DT
SET ASUU("LAST")=Y
KILL Y,%DT
DOIT ;
+1 SET ASUU("AC")="AC"
SET (ASUC("DEL"),ASUC("KEPT"))=0
+2 SET DIK="^ASUH("
+3 SET ASUU("NXDT")=DIK_"ASUU(""AC""),ASUU(""DT"")"
+4 SET ASUU("NXTRN")=ASUU("NXDT")_",DA)"
+5 SET ASUU("NXDT")=ASUU("NXDT")_")"
+6 XECUTE "S ASUU(""E#"")=$P("_DIK_"0),U)"
+7 SET ASUU("DT")=0
SET (ASUA("DELT",ASUU("E#")),ASUA("KEPT",ASUU("E#")))=0
+8 SET ASURX="W !,""Now Processing History Transaction File"""
DO ^ASUUPLOG
+9 FOR ASUC("TR")=1:1
SET ASUU("DT")=$ORDER(@ASUU("NXDT"))
IF ASUU("DT")'?1N.N
QUIT
Begin DoDot:1
+10 IF ASUU("DT")=""!(ASUU("DT")<ASUU("BEGIN"))!(ASUU("DT")>ASUU("END"))
Begin DoDot:2
+11 IF '$DATA(ASUA("PROC",ASUU("DT")))
SET ASUA("PROC",ASUU("DT"))=""
SET ASUC("KEPT")=ASUC("KEPT")+1
+12 SET ASUA("KEPT",ASUU("E#"))=ASUA("KEPT",ASUU("E#"))+1
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 SET DA=0
+15 FOR ASUC("TR")=1:1
SET DA=$ORDER(@ASUU("NXTRN"))
IF DA=""
QUIT
DO ^DIK
+16 SET ASUA("DELT",ASUU("E#"))=ASUA("DELT",ASUU("E#"))+ASUC("TR")
End DoDot:2
End DoDot:1
+17 SET ASUC("DEL")=ASUC("DEL")+ASUA("DELT",ASUU("E#"))
+18 SET ASUU(2)=1
KILL ^XTMP("ASUR","R02")
+19 SET ^XTMP("ASUR","R02",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+20 SET ASURX="W !,""Statistics for Transaction Purge for the Date Range"",!,""Beginning "_ASUU("1ST")_" Ending "_ASUU("LAST")_""",!!"
DO LOG
+21 SET ASUU(1)=""
+22 FOR ASUC("TR")=1:1
SET ASUU(1)=$ORDER(ASUA("DELT",ASUU(1)))
IF ASUU(1)=""
QUIT
Begin DoDot:1
+23 SET ASURX="W !,"""_ASUU(1)_" Records deleted "",?55,"_ASUA("DELT",ASUU(1))
DO LOG
End DoDot:1
+24 SET ASURX="W !,""Total records Deleted "",?55,"_ASUC("DEL")_",!"
DO LOG
+25 SET ASUU(1)=""
+26 FOR ASUC("TR")=1:1
SET ASUU(1)=$ORDER(ASUA("KEPT",ASUU(1)))
IF ASUU(1)=""
QUIT
Begin DoDot:1
+27 SET ASURX="W !,"""_ASUU(1)_" Days Processed Kept "",?55,"_ASUA("KEPT",ASUU(1))
DO LOG
End DoDot:1
+28 SET ASURX="W !,""Total Processed Days Kept"",?55,"_ASUC("KEPT")
DO LOG
+29 KILL ASUU,ASUC("TR"),ASUC,ASULA
+30 IF $GET(ASUP("TYP"))=""
Begin DoDot:1
+31 SET DIR(0)="E"
DO ^DIR
End DoDot:1
+32 QUIT
EN2 ;EP; FROM YEARLY UPDATE
+1 IF '$DATA(ASUK("DT","FM"))
DO DATE^ASUUDATE
DO TIME^ASUUDATE
+2 SET ASUU("BEGIN")=1
SET ASUU("1ST")="FIRST DATE"
SET ASUU("END")=$EXTRACT(ASUK("DT","FM"),1,3)-3_1001
SET Y=ASUU("END")
DO DD^%DT
SET ASUU("LAST")=Y
+3 GOTO DOIT
LOG ;
+1 SET ^XTMP("ASUR","R02",ASUU(2))=ASURX
SET ASUU(2)=ASUU(2)+1
+2 IF $GET(ASUP("TYP"))=""
XECUTE ASURX
+3 QUIT
