- 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 Mar 13, 2025@21:00:57 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
