ENWOLD ;(WIRMFO)/DH-Delete Old Incomplete PM Work Orders ;12/1/1999
;;7.0;ENGINEERING;**35,64**;Aug 17,1993
;
; Check for old incomplete PM work orders
; If count>500 user may schedule automatic deletion
;
; Sets global node if appropriate
; User prompted for cut-off date and execution time
; Cut-off date may not be more recent than T-365
EN ;
I $P($G(^ENG(6920,0)),U,4)'>300 G EXIT ;Why bother?
N DA,SHOP,COUNT,LINE
D HOME^%ZIS
S Y=$$FMADD^XLFDT(DT,-365) S %DT(0)=-Y X ^DD("DD") S %DT("B")=Y
W !!,"NOTE: Creation Dates more recent than "_%DT("B")_" will not be",!," accepted.",!,*7
S %DT="AEP" S %DT("A")="Delete Incomplete PM Work Orders created prior to: "
D ^%DT I X=U!($D(DTOUT)) G EXIT
G:Y'>0 EN ;Shouldn't happen
S ENSTART=+Y ;Inverse start date (counting backwards)
X ^DD("DD") S ENSTART("E")=Y
S DA=$O(^ENG(6920,9999999999),-1),COUNT("TOT")=0,ENX=1
W !,"Counting."
F S DA=DA-50 Q:DA'>0 S X=$P($G(^ENG(6920,DA,0)),U,2) I X]"",X<ENSTART Q
F Q:$P($G(^ENG(6920,DA+1,0)),U,2)>(ENSTART-1) S DA=DA+1
S ENDA("START")=DA ;Starting point for 'AINC' x-ref, inverse chronology
S SHOP=0 F S SHOP=$O(^ENG(6920,"AINC",SHOP)) Q:'SHOP D
. S ENDA=9999999999-ENDA("START"),COUNT(SHOP)=0
. F S ENDA=$O(^ENG(6920,"AINC",SHOP,ENDA)) Q:'ENDA D
.. S DA=9999999999-ENDA
.. I $E($P($G(^ENG(6920,DA,0)),U),1,3)="PM-" S COUNT("TOT")=COUNT("TOT")+1,COUNT(SHOP)=COUNT(SHOP)+1
.. I '(DA#100) W "." S ENX=ENX+1 I ENX>IOM W !
I COUNT("TOT")>500 D G EXIT
. S Y=ENSTART X ^DD("DD")
. W @IOF,"There are about "_COUNT("TOT")_" incomplete PM work orders on your system that were"
. W !,"created prior to "_ENSTART("E")_". The following is a breakout by shop:"
. K X S $P(X,"-",79)="-" W !,X S LINE=4
. S SHOP=0 F S SHOP=$O(COUNT(SHOP)) Q:'SHOP D:COUNT(SHOP)>0
.. S ENSHOP(SHOP)=COUNT(SHOP)
.. I $D(^DIC(6922,SHOP,0)) W !,$P(^(0),U),?30,COUNT(SHOP) S LINE=LINE+1
.. I (IOSL-LINE)'>2 R !,"Press <RETURN> to continue...",X:DTIME S LINE=2
. K DIR S DIR(0)="Y",DIR("A")="Would you like to schedule a task to delete these work orders",DIR("B")="YES"
. D ^DIR K DIR Q:$D(DIRUT)!('Y)
. S ZTRTN="DEQUE^ENWOLD",ZTDESC="Delete old incomplete PM work orders"
. S ZTSAVE("EN*")="",ZTIO="" D ^%ZTLOAD K ZTSK
W !!,"Fewer than 500 existing incomplete PM work orders were created prior to ",!,ENSTART("E")_". No need to continue."
R !!,"Press <RETURN> to continue...",X:DTIME
EXIT K %DT,ENDA,ENSTART,ENSHOP,ENX
Q
;
DEQUE N EN,SHOP,DA,DIK,COUNT S COUNT=0
S DIK="^ENG(6920,",SHOP=0
F S SHOP=$O(ENSHOP(SHOP)) Q:'SHOP D
. S ENDA=9999999999-ENDA("START")
. F S ENDA=$O(^ENG(6920,"AINC",SHOP,ENDA)) Q:'ENDA D
.. S DA=9999999999-ENDA
.. I $E($P($G(^ENG(6920,DA,0)),U),1,3)="PM-" S COUNT=COUNT+1 D ^DIK
MSG ;
S XMY(DUZ)="",XMDUZ=.5,XMSUB="Deletion of Old Incomplete PM Work Orders"
S EN(1)=COUNT_" old incomplete PM work orders were just deleted."
S XMTEXT="EN("
D ^XMD
K XMY,XMDUZ,XMTEXT,XMSUB,ENDA,ENSTART,ENSHOP
I $D(ZTQUEUED) S ZTREQ="@"
Q
;ENWOLD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWOLD 3052 printed Oct 16, 2024@17:57:05 Page 2
ENWOLD ;(WIRMFO)/DH-Delete Old Incomplete PM Work Orders ;12/1/1999
+1 ;;7.0;ENGINEERING;**35,64**;Aug 17,1993
+2 ;
+3 ; Check for old incomplete PM work orders
+4 ; If count>500 user may schedule automatic deletion
+5 ;
+6 ; Sets global node if appropriate
+7 ; User prompted for cut-off date and execution time
+8 ; Cut-off date may not be more recent than T-365
EN ;
+1 ;Why bother?
IF $PIECE($GET(^ENG(6920,0)),U,4)'>300
GOTO EXIT
+2 NEW DA,SHOP,COUNT,LINE
+3 DO HOME^%ZIS
+4 SET Y=$$FMADD^XLFDT(DT,-365)
SET %DT(0)=-Y
XECUTE ^DD("DD")
SET %DT("B")=Y
+5 WRITE !!,"NOTE: Creation Dates more recent than "_%DT("B")_" will not be",!," accepted.",!,*7
+6 SET %DT="AEP"
SET %DT("A")="Delete Incomplete PM Work Orders created prior to: "
+7 DO ^%DT
IF X=U!($DATA(DTOUT))
GOTO EXIT
+8 ;Shouldn't happen
if Y'>0
GOTO EN
+9 ;Inverse start date (counting backwards)
SET ENSTART=+Y
+10 XECUTE ^DD("DD")
SET ENSTART("E")=Y
+11 SET DA=$ORDER(^ENG(6920,9999999999),-1)
SET COUNT("TOT")=0
SET ENX=1
+12 WRITE !,"Counting."
+13 FOR
SET DA=DA-50
if DA'>0
QUIT
SET X=$PIECE($GET(^ENG(6920,DA,0)),U,2)
IF X]""
IF X<ENSTART
QUIT
+14 FOR
if $PIECE($GET(^ENG(6920,DA+1,0)),U,2)>(ENSTART-1)
QUIT
SET DA=DA+1
+15 ;Starting point for 'AINC' x-ref, inverse chronology
SET ENDA("START")=DA
+16 SET SHOP=0
FOR
SET SHOP=$ORDER(^ENG(6920,"AINC",SHOP))
if 'SHOP
QUIT
Begin DoDot:1
+17 SET ENDA=9999999999-ENDA("START")
SET COUNT(SHOP)=0
+18 FOR
SET ENDA=$ORDER(^ENG(6920,"AINC",SHOP,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+19 SET DA=9999999999-ENDA
+20 IF $EXTRACT($PIECE($GET(^ENG(6920,DA,0)),U),1,3)="PM-"
SET COUNT("TOT")=COUNT("TOT")+1
SET COUNT(SHOP)=COUNT(SHOP)+1
+21 IF '(DA#100)
WRITE "."
SET ENX=ENX+1
IF ENX>IOM
WRITE !
End DoDot:2
End DoDot:1
+22 IF COUNT("TOT")>500
Begin DoDot:1
+23 SET Y=ENSTART
XECUTE ^DD("DD")
+24 WRITE @IOF,"There are about "_COUNT("TOT")_" incomplete PM work orders on your system that were"
+25 WRITE !,"created prior to "_ENSTART("E")_". The following is a breakout by shop:"
+26 KILL X
SET $PIECE(X,"-",79)="-"
WRITE !,X
SET LINE=4
+27 SET SHOP=0
FOR
SET SHOP=$ORDER(COUNT(SHOP))
if 'SHOP
QUIT
if COUNT(SHOP)>0
Begin DoDot:2
+28 SET ENSHOP(SHOP)=COUNT(SHOP)
+29 IF $DATA(^DIC(6922,SHOP,0))
WRITE !,$PIECE(^(0),U),?30,COUNT(SHOP)
SET LINE=LINE+1
+30 IF (IOSL-LINE)'>2
READ !,"Press <RETURN> to continue...",X:DTIME
SET LINE=2
End DoDot:2
+31 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Would you like to schedule a task to delete these work orders"
SET DIR("B")="YES"
+32 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
QUIT
+33 SET ZTRTN="DEQUE^ENWOLD"
SET ZTDESC="Delete old incomplete PM work orders"
+34 SET ZTSAVE("EN*")=""
SET ZTIO=""
DO ^%ZTLOAD
KILL ZTSK
End DoDot:1
GOTO EXIT
+35 WRITE !!,"Fewer than 500 existing incomplete PM work orders were created prior to ",!,ENSTART("E")_". No need to continue."
+36 READ !!,"Press <RETURN> to continue...",X:DTIME
EXIT KILL %DT,ENDA,ENSTART,ENSHOP,ENX
+1 QUIT
+2 ;
DEQUE NEW EN,SHOP,DA,DIK,COUNT
SET COUNT=0
+1 SET DIK="^ENG(6920,"
SET SHOP=0
+2 FOR
SET SHOP=$ORDER(ENSHOP(SHOP))
if 'SHOP
QUIT
Begin DoDot:1
+3 SET ENDA=9999999999-ENDA("START")
+4 FOR
SET ENDA=$ORDER(^ENG(6920,"AINC",SHOP,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+5 SET DA=9999999999-ENDA
+6 IF $EXTRACT($PIECE($GET(^ENG(6920,DA,0)),U),1,3)="PM-"
SET COUNT=COUNT+1
DO ^DIK
End DoDot:2
End DoDot:1
MSG ;
+1 SET XMY(DUZ)=""
SET XMDUZ=.5
SET XMSUB="Deletion of Old Incomplete PM Work Orders"
+2 SET EN(1)=COUNT_" old incomplete PM work orders were just deleted."
+3 SET XMTEXT="EN("
+4 DO ^XMD
+5 KILL XMY,XMDUZ,XMTEXT,XMSUB,ENDA,ENSTART,ENSHOP
+6 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;ENWOLD
