ENY2K4 ;(WASH ISC)/DH-Delete Y2K Work Orders ;6.16.98
;;7.0;ENGINEERING;**51**;Aug 17, 1993
;
DEL ; delete Y2K worklist
W !!,"Which do you wish to delete?",!,?7,"1. Individual work order(s), or",!,?7,"2. An entire Y2K work list."
R !,"Select 1 or 2: ",X:DTIME Q:X="^"!(X="") G:X["?" DELH1 I X?1N,X>0,X<3 G:X=1 DEL1 G DEL2
W "??",*7 G DEL
;
DEL1 ; delete individual work orders
N DIC,DIK,DA
S DIC="^ENG(6920,",DIC(0)="AEQM",DIC("A")="Enter first Y2K work order to be deleted: ",DIC("S")="I $E($P(^(0),U,1),1,3)=""Y2-""" D ^DIC K DIC("S") G:Y'>0 OUT1 S DA=+Y,ENY2WO=$P(^ENG(6920,DA,0),U)
W !,ENY2WO," Are you sure" S %=1 D YN^DICN G:%'=1 DEL1
S DIK="^ENG(6920,",EQDA=$P($G(^ENG(6920,DA,3)),U,8)
I EQDA?1.N,$D(^ENG(6914,EQDA,0)) S $P(^ENG(6914,EQDA,11),U,8)=""
D ^DIK K DIK
;
DEL10 S ENY2WO(1)=$O(^ENG(6920,"B",ENY2WO)) G:$P(ENY2WO(1),"-",2)'=$P(ENY2WO,"-",2) OUT1
;
DEL11 W !!,"Next work order: ",ENY2WO(1),"// " R X:DTIME G:X="^" OUT1 I X?1.3N S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X),X=$P(ENY2WO,"-",1,2)_"-"_X
I X="" S X=ENY2WO(1)
I $E(X,1,3)'="Y2-" D DELH0 G DEL11
S ENY2WO=X,DIC(0)="X",DIC("S")="I $E($P(^(0),U),1,3)=""Y2-""" D ^DIC K DIC("S") S DA=+Y I Y'>0 W "??",*7 D DELH0 G DEL11
W !,ENY2WO," Are you sure" S %=1 D YN^DICN G:%'=1 DEL10
S DIK="^ENG(6920,",EQDA=$P($G(^ENG(6920,DA,3)),U,8)
I EQDA?1.N,$D(^ENG(6914,EQDA,0)) S $P(^ENG(6914,EQDA,11),U,8)=""
D ^DIK K DIK
G DEL10
;
DEL2 ; delete an entire Y2K work list
L +^ENG("Y2KLIST"):1 I '$T W !!,"Another user is processing a Y2K worklist. Please try again later.",*7 Q
K ^TMP($J)
N SHOPS,COUNT,DIC,DIK,DA
S DIR(0)="Y",DIR("A")="Shall we delete Y2K worklists for ALL shops",DIR("B")="YES"
D ^DIR K DIR G:$D(DIRUT) OUT S:Y SHOPS="ALL"
I '$D(SHOPS) S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC G:Y'>0 OUT S ENSHKEY=+Y,ENSHABR=$P(^DIC(6922,ENSHKEY,0),U,2),ENSHOP=$P(^(0),U)
DEL22 W @IOF,!!
W "This option will delete the entire Y2K worklist of "_$S($G(SHOPS)="ALL":"ALL shops.",1:"the "_ENSHOP_" shop.")
W !!,"Just a moment, please..."
S ENY2K="Y2-",COUNT=0 F S ENY2K=$O(^ENG(6920,"B",ENY2K)) Q:$E(ENY2K,1,3)'="Y2-" S DA=$O(^(ENY2K,0)) D:DA
. I '$D(SHOPS),$P($G(^ENG(6920,DA,2)),U)'=ENSHKEY Q
. S COUNT=COUNT+1,^TMP($J,DA)=""
I 'COUNT W !!,"No Y2K work orders to delete." D MSG G OUT
W !!,"You have selected "_COUNT_" Y2K work orders. Deletion of these work orders",!,"will not affect equipment histories. Are you sure you want to proceed" S %=1 D YN^DICN
I %'=1 W !,"Nothing deleted.",*7 D MSG G OUT
S DA=0,DIK="^ENG(6920," F S DA=$O(^TMP($J,DA)) Q:'DA D
. S EQDA=$P($G(^ENG(6920,DA,3)),U,8) I EQDA?1.N,$D(^ENG(6914,EQDA,0)) S $P(^ENG(6914,EQDA,11),U,8)=""
. D ^DIK W:'(DA#10) "."
K DIK
;
OUT L -^ENG("Y2KLIST")
OUT1 ;
K ENY2,ENY2WO,ENINN,ENWON,ENSHKEY,ENSHOP,ENSHABR,EQDA
S:$D(ZTQUEUED) ZTREQ="@"
Q
MSG R !,"Press <RETURN> to continue...",X:DTIME Q
DELH0 W !,"Entry must be an existing work order, beginning with 'Y2-', or the",!,"sequential (numeric) portion thereof. Enter '^' to exit." Q
DELH1 W !,"Enter '1' to delete individual Y2K work orders or '2' to delete an entire",!,"Y2K worklist."
W !,"Deletion of Y2K work orders which have been closed out does NOT remove them",!,"from the equipment history."
G DEL
;
;ENY2K4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K4 3299 printed Dec 13, 2024@01:57:15 Page 2
ENY2K4 ;(WASH ISC)/DH-Delete Y2K Work Orders ;6.16.98
+1 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
+2 ;
DEL ; delete Y2K worklist
+1 WRITE !!,"Which do you wish to delete?",!,?7,"1. Individual work order(s), or",!,?7,"2. An entire Y2K work list."
+2 READ !,"Select 1 or 2: ",X:DTIME
if X="^"!(X="")
QUIT
if X["?"
GOTO DELH1
IF X?1N
IF X>0
IF X<3
if X=1
GOTO DEL1
GOTO DEL2
+3 WRITE "??",*7
GOTO DEL
+4 ;
DEL1 ; delete individual work orders
+1 NEW DIC,DIK,DA
+2 SET DIC="^ENG(6920,"
SET DIC(0)="AEQM"
SET DIC("A")="Enter first Y2K work order to be deleted: "
SET DIC("S")="I $E($P(^(0),U,1),1,3)=""Y2-"""
DO ^DIC
KILL DIC("S")
if Y'>0
GOTO OUT1
SET DA=+Y
SET ENY2WO=$PIECE(^ENG(6920,DA,0),U)
+3 WRITE !,ENY2WO," Are you sure"
SET %=1
DO YN^DICN
if %'=1
GOTO DEL1
+4 SET DIK="^ENG(6920,"
SET EQDA=$PIECE($GET(^ENG(6920,DA,3)),U,8)
+5 IF EQDA?1.N
IF $DATA(^ENG(6914,EQDA,0))
SET $PIECE(^ENG(6914,EQDA,11),U,8)=""
+6 DO ^DIK
KILL DIK
+7 ;
DEL10 SET ENY2WO(1)=$ORDER(^ENG(6920,"B",ENY2WO))
if $PIECE(ENY2WO(1),"-",2)'=$PIECE(ENY2WO,"-",2)
GOTO OUT1
+1 ;
DEL11 WRITE !!,"Next work order: ",ENY2WO(1),"// "
READ X:DTIME
if X="^"
GOTO OUT1
IF X?1.3N
SET X=$SELECT($LENGTH(X)=1:"00"_X,$LENGTH(X)=2:"0"_X,1:X)
SET X=$PIECE(ENY2WO,"-",1,2)_"-"_X
+1 IF X=""
SET X=ENY2WO(1)
+2 IF $EXTRACT(X,1,3)'="Y2-"
DO DELH0
GOTO DEL11
+3 SET ENY2WO=X
SET DIC(0)="X"
SET DIC("S")="I $E($P(^(0),U),1,3)=""Y2-"""
DO ^DIC
KILL DIC("S")
SET DA=+Y
IF Y'>0
WRITE "??",*7
DO DELH0
GOTO DEL11
+4 WRITE !,ENY2WO," Are you sure"
SET %=1
DO YN^DICN
if %'=1
GOTO DEL10
+5 SET DIK="^ENG(6920,"
SET EQDA=$PIECE($GET(^ENG(6920,DA,3)),U,8)
+6 IF EQDA?1.N
IF $DATA(^ENG(6914,EQDA,0))
SET $PIECE(^ENG(6914,EQDA,11),U,8)=""
+7 DO ^DIK
KILL DIK
+8 GOTO DEL10
+9 ;
DEL2 ; delete an entire Y2K work list
+1 LOCK +^ENG("Y2KLIST"):1
IF '$TEST
WRITE !!,"Another user is processing a Y2K worklist. Please try again later.",*7
QUIT
+2 KILL ^TMP($JOB)
+3 NEW SHOPS,COUNT,DIC,DIK,DA
+4 SET DIR(0)="Y"
SET DIR("A")="Shall we delete Y2K worklists for ALL shops"
SET DIR("B")="YES"
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO OUT
if Y
SET SHOPS="ALL"
+6 IF '$DATA(SHOPS)
SET DIC="^DIC(6922,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
GOTO OUT
SET ENSHKEY=+Y
SET ENSHABR=$PIECE(^DIC(6922,ENSHKEY,0),U,2)
SET ENSHOP=$PIECE(^(0),U)
DEL22 WRITE @IOF,!!
+1 WRITE "This option will delete the entire Y2K worklist of "_$SELECT($GET(SHOPS)="ALL":"ALL shops.",1:"the "_ENSHOP_" shop.")
+2 WRITE !!,"Just a moment, please..."
+3 SET ENY2K="Y2-"
SET COUNT=0
FOR
SET ENY2K=$ORDER(^ENG(6920,"B",ENY2K))
if $EXTRACT(ENY2K,1,3)'="Y2-"
QUIT
SET DA=$ORDER(^(ENY2K,0))
if DA
Begin DoDot:1
+4 IF '$DATA(SHOPS)
IF $PIECE($GET(^ENG(6920,DA,2)),U)'=ENSHKEY
QUIT
+5 SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
End DoDot:1
+6 IF 'COUNT
WRITE !!,"No Y2K work orders to delete."
DO MSG
GOTO OUT
+7 WRITE !!,"You have selected "_COUNT_" Y2K work orders. Deletion of these work orders",!,"will not affect equipment histories. Are you sure you want to proceed"
SET %=1
DO YN^DICN
+8 IF %'=1
WRITE !,"Nothing deleted.",*7
DO MSG
GOTO OUT
+9 SET DA=0
SET DIK="^ENG(6920,"
FOR
SET DA=$ORDER(^TMP($JOB,DA))
if 'DA
QUIT
Begin DoDot:1
+10 SET EQDA=$PIECE($GET(^ENG(6920,DA,3)),U,8)
IF EQDA?1.N
IF $DATA(^ENG(6914,EQDA,0))
SET $PIECE(^ENG(6914,EQDA,11),U,8)=""
+11 DO ^DIK
if '(DA#10)
WRITE "."
End DoDot:1
+12 KILL DIK
+13 ;
OUT LOCK -^ENG("Y2KLIST")
OUT1 ;
+1 KILL ENY2,ENY2WO,ENINN,ENWON,ENSHKEY,ENSHOP,ENSHABR,EQDA
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
MSG READ !,"Press <RETURN> to continue...",X:DTIME
QUIT
DELH0 WRITE !,"Entry must be an existing work order, beginning with 'Y2-', or the",!,"sequential (numeric) portion thereof. Enter '^' to exit."
QUIT
DELH1 WRITE !,"Enter '1' to delete individual Y2K work orders or '2' to delete an entire",!,"Y2K worklist."
+1 WRITE !,"Deletion of Y2K work orders which have been closed out does NOT remove them",!,"from the equipment history."
+2 GOTO DEL
+3 ;
+4 ;ENY2K4
