- ENEQPMS4 ;(WASH ISC)/DH-Delete PMI Work Orders ;1/11/2001
- ;;7.0;ENGINEERING;**35,48,51,68**;Aug 17, 1993
- LSTH1 W !!,"All worklists are sorted by shop, and within shop they may be sorted again by",!,"RESPONSIBLE TECHNICIAN. You must now choose how this list should be sorted"
- W !,"further. You have the following choices:"
- W !,?10,"'E' for Equipment Entry #"
- W !,?10,"'P' for PM #"
- W !,?10,"'I' for Local Identifier"
- W !,?10,"'L' for Location"
- W !,?10,"'C' for Equipment Category"
- W !,?10,"'S' for Owning Service",!
- Q
- ;
- DEL ; delete PM worklist
- W !!,"Which do you wish to delete?",!,?7,"1. Individual work order(s), or",!,?7,"2. An entire PM 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
- S DIC="^ENG(6920,",DIC(0)="AEQM",DIC("A")="Please enter first work order to be deleted ",DIC("S")="I $E($P(^(0),U,1),1,3)=""PM-""" D ^DIC K DIC("S") G:Y'>0 OUT S DA=+Y,ENPMWO=$P(^ENG(6920,DA,0),U,1)
- W !,ENPMWO," Are you sure" S %=1 D YN^DICN G:%'=1 DEL1 S DIK="^ENG(6920," D:$E(^ENG(6920,DA,0),1,3)="PM-" ^DIK
- DEL10 S ENPMWO(1)=$O(^ENG(6920,"B",ENPMWO)) G:$P(ENPMWO(1),"-",2)'=$P(ENPMWO,"-",2) OUT
- DEL11 W !!,"Next work order: ",ENPMWO(1),"// " R X:DTIME G:X="^" OUT I X?1.3N S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X),X=$P(ENPMWO,"-",1,2)_"-"_X
- I X="" S X=ENPMWO(1)
- I $E(X,1,3)'="PM-" D DELH0 G DEL11
- S ENPMWO=X,DIC(0)="X",DIC("S")="I $E($P(^(0),U,1),1,3)=""PM-""" D ^DIC K DIC("S") S DA=+Y I Y'>0 W "??",*7 D DELH0 G DEL11
- W !,ENPMWO," Are you sure" S %=1 D YN^DICN G:%'=1 DEL10 S DIK="^ENG(6920," D:$E(^ENG(6920,DA,0),1,3)="PM-" ^DIK
- G DEL10
- ;
- DEL2 ; delete an entire work list
- S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC Q:Y'>0 S ENSHKEY=+Y,ENSHABR=$P(^DIC(6922,ENSHKEY,0),U,2),ENSHOP=$P(^(0),U,1)
- S Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="Select Month: ",%DT("B")=Y,%DT="AEFMX" D ^%DT G:Y'>0 OUT S ENPMDT=$E(Y,2,5),ENPMMN=+$E(Y,4,5),ENPMYR=1700+$E(Y,1,3)
- DEL20 R !,"MONTHLY or WEEKLY PM list: MONTHLY// ",X:DTIME G:X="^" OUT S ENPM=$S(X="":"M",$E(X)="M":"M",$E(X)="W":"W",1:"") G:ENPM="M" DEL22 I ENPM']"" D RCOH1^ENEQPMR2 G DEL20
- DEL21 R !,"Which week? ",X:DTIME G:X="^" OUT I X'?1N D DELH2 G DEL21
- I X<1!(X>5) D DELH2 G DEL21
- S ENPMWK=X,ENPM=ENPM_ENPMWK
- DEL22 W @IOF,!!
- W "This option will delete the entire "_$S(ENPM="M":"MONTHLY",ENPM["W":"WEEKLY",1:"")_" PM List of the "_ENSHOP,!,"Shop for "_$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,ENPMMN)
- W ", "_ENPMYR_$S(ENPM["W":" (Week "_ENPMWK_")",1:"")_"."
- W !!,"Just a moment, please..."
- S I=0,ENPMWO("P")="PM-"_ENSHABR_ENPMDT_ENPM_"-",ENPMWO=ENPMWO("P") F I=0:1 S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) Q:ENPMWO']""!($P(ENPMWO,"-",2)'=$P(ENPMWO("P"),"-",2))
- W !!,"There are ",I," PM work orders on this list. 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 ENLOCK=ENPMWO("P") L +^ENG("PMLIST",ENPMWO("P")):1 I '$T W !!,"Sorry, another user is processing worklist. Please try again later.",*7 K ENLOCK G OUT
- S ZTRTN="DELDQ^ENEQPMS4",ZTSAVE("EN*")="",ZTDESC="Delete PMI List",ZTIO="" D ^%ZTLOAD K ZTSK D HOME^%ZIS G OUT
- DELDQ L +^ENG("PMLIST",ENLOCK):1
- I $T S ENPMWO=ENPMWO("P"),DIK="^ENG(6920," F I=0:0 S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) Q:ENPMWO']""!($P(ENPMWO,"-",2)'=$P(ENPMWO("P"),"-",2)) S DA=$O(^ENG(6920,"B",ENPMWO,0)) I DA]"",$D(^ENG(6920,DA,0)),$E(^(0),1,3)="PM-" D ^DIK
- OUT I $D(ENLOCK) L -^ENG("PMLIST",ENLOCK) K ENLOCK
- K ENPMWO,ENINN,ENWON,ENPM,ENPMDT,ENPMMN,ENPMWK,ENSHKEY,ENSHOP,ENSHABR,I,DIC,DIK,DA,ENPMYR
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- MSG R !,"Press <RETURN> to continue...",X:DTIME Q
- DELH0 W !,"Entry must be an existing PM work order, beginning with 'PM-', or the",!,"sequential (numeric) portion thereof. Enter '^' to exit." Q
- DELH1 W !,"Enter '1' to delete individual PM work orders or '2' to delete a specific",!,"worklist (MONTHLY or WEEKLY) for an entire shop."
- W !,"Deletion of PM work orders which have been closed out does NOT remove them",!,"from the equipment history."
- G DEL
- DELH2 W !,"Please enter an integer from 1 to 5."
- Q
- ;ENEQPMS4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMS4 4287 printed Mar 13, 2025@20:57:36 Page 2
- ENEQPMS4 ;(WASH ISC)/DH-Delete PMI Work Orders ;1/11/2001
- +1 ;;7.0;ENGINEERING;**35,48,51,68**;Aug 17, 1993
- LSTH1 WRITE !!,"All worklists are sorted by shop, and within shop they may be sorted again by",!,"RESPONSIBLE TECHNICIAN. You must now choose how this list should be sorted"
- +1 WRITE !,"further. You have the following choices:"
- +2 WRITE !,?10,"'E' for Equipment Entry #"
- +3 WRITE !,?10,"'P' for PM #"
- +4 WRITE !,?10,"'I' for Local Identifier"
- +5 WRITE !,?10,"'L' for Location"
- +6 WRITE !,?10,"'C' for Equipment Category"
- +7 WRITE !,?10,"'S' for Owning Service",!
- +8 QUIT
- +9 ;
- DEL ; delete PM worklist
- +1 WRITE !!,"Which do you wish to delete?",!,?7,"1. Individual work order(s), or",!,?7,"2. An entire PM 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 SET DIC="^ENG(6920,"
- SET DIC(0)="AEQM"
- SET DIC("A")="Please enter first work order to be deleted "
- SET DIC("S")="I $E($P(^(0),U,1),1,3)=""PM-"""
- DO ^DIC
- KILL DIC("S")
- if Y'>0
- GOTO OUT
- SET DA=+Y
- SET ENPMWO=$PIECE(^ENG(6920,DA,0),U,1)
- +2 WRITE !,ENPMWO," Are you sure"
- SET %=1
- DO YN^DICN
- if %'=1
- GOTO DEL1
- SET DIK="^ENG(6920,"
- if $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
- DO ^DIK
- DEL10 SET ENPMWO(1)=$ORDER(^ENG(6920,"B",ENPMWO))
- if $PIECE(ENPMWO(1),"-",2)'=$PIECE(ENPMWO,"-",2)
- GOTO OUT
- DEL11 WRITE !!,"Next work order: ",ENPMWO(1),"// "
- READ X:DTIME
- if X="^"
- GOTO OUT
- IF X?1.3N
- SET X=$SELECT($LENGTH(X)=1:"00"_X,$LENGTH(X)=2:"0"_X,1:X)
- SET X=$PIECE(ENPMWO,"-",1,2)_"-"_X
- +1 IF X=""
- SET X=ENPMWO(1)
- +2 IF $EXTRACT(X,1,3)'="PM-"
- DO DELH0
- GOTO DEL11
- +3 SET ENPMWO=X
- SET DIC(0)="X"
- SET DIC("S")="I $E($P(^(0),U,1),1,3)=""PM-"""
- DO ^DIC
- KILL DIC("S")
- SET DA=+Y
- IF Y'>0
- WRITE "??",*7
- DO DELH0
- GOTO DEL11
- +4 WRITE !,ENPMWO," Are you sure"
- SET %=1
- DO YN^DICN
- if %'=1
- GOTO DEL10
- SET DIK="^ENG(6920,"
- if $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
- DO ^DIK
- +5 GOTO DEL10
- +6 ;
- DEL2 ; delete an entire work list
- +1 SET DIC="^DIC(6922,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- if Y'>0
- QUIT
- SET ENSHKEY=+Y
- SET ENSHABR=$PIECE(^DIC(6922,ENSHKEY,0),U,2)
- SET ENSHOP=$PIECE(^(0),U,1)
- +2 SET Y=$EXTRACT(DT,1,5)_"00"
- XECUTE ^DD("DD")
- SET %DT("A")="Select Month: "
- SET %DT("B")=Y
- SET %DT="AEFMX"
- DO ^%DT
- if Y'>0
- GOTO OUT
- SET ENPMDT=$EXTRACT(Y,2,5)
- SET ENPMMN=+$EXTRACT(Y,4,5)
- SET ENPMYR=1700+$EXTRACT(Y,1,3)
- DEL20 READ !,"MONTHLY or WEEKLY PM list: MONTHLY// ",X:DTIME
- if X="^"
- GOTO OUT
- SET ENPM=$SELECT(X="":"M",$EXTRACT(X)="M":"M",$EXTRACT(X)="W":"W",1:"")
- if ENPM="M"
- GOTO DEL22
- IF ENPM']""
- DO RCOH1^ENEQPMR2
- GOTO DEL20
- DEL21 READ !,"Which week? ",X:DTIME
- if X="^"
- GOTO OUT
- IF X'?1N
- DO DELH2
- GOTO DEL21
- +1 IF X<1!(X>5)
- DO DELH2
- GOTO DEL21
- +2 SET ENPMWK=X
- SET ENPM=ENPM_ENPMWK
- DEL22 WRITE @IOF,!!
- +1 WRITE "This option will delete the entire "_$SELECT(ENPM="M":"MONTHLY",ENPM["W":"WEEKLY",1:"")_" PM List of the "_ENSHOP,!,"Shop for "_$PIECE("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,ENPMMN)
- +2 WRITE ", "_ENPMYR_$SELECT(ENPM["W":" (Week "_ENPMWK_")",1:"")_"."
- +3 WRITE !!,"Just a moment, please..."
- +4 SET I=0
- SET ENPMWO("P")="PM-"_ENSHABR_ENPMDT_ENPM_"-"
- SET ENPMWO=ENPMWO("P")
- FOR I=0:1
- SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
- if ENPMWO']""!($PIECE(ENPMWO,"-",2)'=$PIECE(ENPMWO("P"),"-",2))
- QUIT
- +5 WRITE !!,"There are ",I," PM work orders on this list. Deletion of these work orders will",!,"not affect equipment histories. Are you sure you want to proceed"
- SET %=1
- DO YN^DICN
- +6 IF %'=1
- WRITE !,"Nothing deleted.",*7
- DO MSG
- GOTO OUT
- +7 SET ENLOCK=ENPMWO("P")
- LOCK +^ENG("PMLIST",ENPMWO("P")):1
- IF '$TEST
- WRITE !!,"Sorry, another user is processing worklist. Please try again later.",*7
- KILL ENLOCK
- GOTO OUT
- +8 SET ZTRTN="DELDQ^ENEQPMS4"
- SET ZTSAVE("EN*")=""
- SET ZTDESC="Delete PMI List"
- SET ZTIO=""
- DO ^%ZTLOAD
- KILL ZTSK
- DO HOME^%ZIS
- GOTO OUT
- DELDQ LOCK +^ENG("PMLIST",ENLOCK):1
- +1 IF $TEST
- SET ENPMWO=ENPMWO("P")
- SET DIK="^ENG(6920,"
- FOR I=0:0
- SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
- if ENPMWO']""!($PIECE(ENPMWO,"-",2)'=$PIECE(ENPMWO("P"),"-",2))
- QUIT
- SET DA=$ORDER(^ENG(6920,"B",ENPMWO,0))
- IF DA]""
- IF $DATA(^ENG(6920,DA,0))
- IF $EXTRACT(^(0),1,3)="PM-"
- DO ^DIK
- OUT IF $DATA(ENLOCK)
- LOCK -^ENG("PMLIST",ENLOCK)
- KILL ENLOCK
- +1 KILL ENPMWO,ENINN,ENWON,ENPM,ENPMDT,ENPMMN,ENPMWK,ENSHKEY,ENSHOP,ENSHABR,I,DIC,DIK,DA,ENPMYR
- +2 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- MSG READ !,"Press <RETURN> to continue...",X:DTIME
- QUIT
- DELH0 WRITE !,"Entry must be an existing PM work order, beginning with 'PM-', or the",!,"sequential (numeric) portion thereof. Enter '^' to exit."
- QUIT
- DELH1 WRITE !,"Enter '1' to delete individual PM work orders or '2' to delete a specific",!,"worklist (MONTHLY or WEEKLY) for an entire shop."
- +1 WRITE !,"Deletion of PM work orders which have been closed out does NOT remove them",!,"from the equipment history."
- +2 GOTO DEL
- DELH2 WRITE !,"Please enter an integer from 1 to 5."
- +1 QUIT
- +2 ;ENEQPMS4
