ENEQPMR6 ;(WASH ISC)/DH-Rapid Deferral of PM Worklist ;1/11/2001
;;7.0;ENGINEERING;**24,35,48,68**;Aug 17, 1993
;
RD ; Affected PM work orders will be DEFERRED with a DATE COMPLETE
; of TODAY
;
K ENPMWO S Y=DT X ^DD("DD") S ENDATE=Y,Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="Select Month: ",%DT("B")=Y,%DT="AEPMX" D ^%DT G:Y'>0 EXIT S ENPMDT=$E(Y,2,5),ENPMMN=+$E(Y,4,5),ENPMYR=1700+$E(Y,1,3)
S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT S ENSHKEY=+Y,ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2)
RD1 R !,"MONTHLY or WEEKLY PM List: MONTHLY// ",X:DTIME G:X="^" EXIT S ENPM=$S(X="":"M",$E(X)="M":"M",$E(X)="W":"W",1:"") G:ENPM="M" RD2 I ENPM']"" D RDH1 G RD1
RD11 R !,"Which week? ",X:DTIME G:X="^" EXIT I X<1!(X>5) W !,"Enter a number, 1 to 5." G RD11
S ENPMWK=X,ENPM=ENPM_ENPMWK
;
RD2 S ENDEL="" I $D(^DIC(6910,1,0)) S ENDEL=$P(^(0),U,5)
I ENDEL']"" R !!,"Should PM work orders be deleted after close out? YES//",X:DTIME G:X="^" EXIT S:X=""!($E(X)="Y") ENDEL="Y" I ENDEL'="Y",$E(X)'="N" D COBH1^ENEQPMR4 G RD2
;
RD2T W !!,"This option will scan the "_$S(ENPM="M":"MONTHLY",ENPM["W":"WEEKLY",1:"")_" PM Worklist of the "_ENSHOP_" Shop",!,"for "_$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",ENPMMN)
W ", "_ENPMYR_$S(ENPM["W":" (Week "_ENPMWK_")",1:"")_"."
W !!,"It will automatically assign a PM Status of 'DEFERRED' and a close out date of",!,ENDATE," to each work order on the list."
W !!,"Default values for labor and material costs (if any) from the Equipment File",!,"will NOT be posted to the Equipment History during RAPID DEFERRAL."
W !!,"Are you sure you want to proceed " S %=2 D YN^DICN G:%=0 RD2T G:%'=1 EXIT
S (ENPMWO,ENPMWO("P"))="PM-"_ENSHABR_ENPMDT_ENPM_"-"
I $O(^ENG(6920,"B",ENPMWO))'[ENPMWO("P") W *7,!!,"Specified worklist doesn't seem to exist. Nothing to DEFER." D HOLD G EXIT
;
RD2P S ENFR="",ENTO="ZZ",ENTO("L")=20
W !!,"Would you like to specify starting and stopping points for",!,"Rapid Deferral" S %=2 D YN^DICN G:%<0 EXIT G:%=2 RD2PD I %=0 D RD2PH G RD2P
S J=$O(^ENG(6920,"B",ENPMWO("P"))) G:J'[ENPMWO("P") EXIT
W !!,"Please enter the starting work order (or the sequential portion thereof)",!,"(ex: '"_J_"' or just '"_+$P(J,"-",3)_"'):"
R X:DTIME G:'$T!($E(X)="^")!(X="") RD2P
S:X?1.2N X=$S(X?1N:"00"_X,1:"0"_X) I X?.N S X=ENPMWO("P")_X
S DIC="^ENG(6920,",DIC("S")="I $P(^(0),U)[ENPMWO(""P"")",DIC(0)="X" D ^DIC K DIC("S") G:Y'>0 RD2P S ENFR=$P(Y,U,2) W " ("_ENFR_")"
S ENFR(0)=$O(^ENG(6920,"B",ENFR),-1) S ENFR=$S(ENFR(0)[ENPMWO("P"):ENFR(0),1:ENPMWO("P")_"000")
W !!,"Now enter last work order to be deferred (or sequential portion thereof)"
S J=$O(^ENG(6920,"B",ENPMWO("P")_9999),-1)
W !,"(ex: '"_J_"' or just '"_+$P(J,"-",3)_"'): "
R X:DTIME G:'$T!(X="^")!(X="") RD2P
I X?1.N S:X?1.2N X=$S(X?1N:"00"_X,1:"0"_X) S X=ENPMWO("P")_X
S DIC("S")="I $P(^(0),U)[ENPMWO(""P""),(+$P($P(^(0),U),""-"",3)>+$P(ENFR,""-"",3))"
D ^DIC K DIC("S") G:Y'>0 RD2P S ENTO=$P(Y,U,2),ENTO("L")=$L(ENTO) W " ("_ENTO_")"
;
RD2PD L +^ENG("PMLIST",ENPMWO):1 I '$T W !!,"Another user is processing this worklist. Please try again later.",*7 G EXIT
S ENPMWO(0)=ENPMWO
S ENPMWO=$S(ENFR]"":ENFR,1:ENPMWO("P")_"000"),DIE="^ENG(6920,",DR="35.2///D0;36///T;32///^S X=""COMPLETED"""
W !,"Would you like to free up this terminal" S %=1 D YN^DICN G:%=1 RD3 G:%<0 EXIT G:%=0 RD2PD
W !,"Rapid deferral now in progress "
F ENK=0:0 S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) Q:ENPMWO'[ENPMWO("P")!(ENPMWO]ENTO) I $L(ENPMWO)'>ENTO("L") D
. W "." S DA=$O(^ENG(6920,"B",ENPMWO,0)) I $D(^ENG(6920,DA)) D POST I $D(DA),ENDEL="Y" D DEL
G EXIT
;
RD3 S ZTDTH=$H,ZTRTN="RD4^ENEQPMR6",ZTDESC="Rapid deferral (PM worklist)",ZTSAVE("EN*")="",ZTIO="",ZTSAVE("DIE")="",ZTSAVE("DR")="" D ^%ZTLOAD K ZTSK D ^%ZISC,HOME^%ZIS
G EXIT
;
RD4 F ENK=0:0 S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) Q:ENPMWO'[ENPMWO("P")!(ENPMWO]ENTO) I $L(ENPMWO)'>ENTO("L") D
. S DA=$O(^ENG(6920,"B",ENPMWO,0)) I $D(^ENG(6920,DA)) D POST I $D(DA),ENDEL="Y" D DEL
EXIT I $D(ENPMWO(0)) L -^ENG("PMLIST",ENPMWO(0))
K EN,ENPMWO,ENK,ENDATE,ENDEL,ENPM,ENPMDT,ENPMMN,ENPMWK,ENSHABR,ENSHKEY,ENSHOP,ENFR,ENTO,ENPMYR S:$D(ZTQUEUED) ZTREQ="@"
K DA,DIC,DR,DIE,DIK
Q
POST I $D(^ENG(6920,DA,5)),$P(^(5),U,2)]"" K DA Q
I $D(^ENG(6920,DA,5)) F I=3,4,6 S $P(^(5),U,I)=""
I $D(^ENG(6920,DA,7)) F I=0:0 S I=$O(^ENG(6920,DA,7,I)) Q:I'>0 S:$D(^(I,0)) $P(^(0),U,2)=""
D ^DIE
Q
DEL I $E($P(^ENG(6920,DA,0),U,1),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
Q
RDH1 W !,"A MONTHLY PMI list contains work orders for ANNUAL, SEMI-ANNUAL, QUARTERLY,",!,"BI-MONTHLY, and MONTHLY preventive maintenance inspections."
W !,"A WEEKLY PMI list is for WEEKLY and BI-WEEKLY inspections."
Q
RD2PH W !!,"If you want to defer only a portion of a PM worklist, you may specify the",!,"first and last work orders that you want Rapid Deferral to operate on."
W !,"Everything between and including these two work orders will be DEFERRED.",!,"Please enter the entire work order numbers (ex: 'PM-E9702M-102')."
Q
HOLD R !,"<cr> to continue, '^' to quit...",X:DTIME S ENY=1 Q
;ENEQPMR6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMR6 5174 printed Nov 22, 2024@17:03 Page 2
ENEQPMR6 ;(WASH ISC)/DH-Rapid Deferral of PM Worklist ;1/11/2001
+1 ;;7.0;ENGINEERING;**24,35,48,68**;Aug 17, 1993
+2 ;
RD ; Affected PM work orders will be DEFERRED with a DATE COMPLETE
+1 ; of TODAY
+2 ;
+3 KILL ENPMWO
SET Y=DT
XECUTE ^DD("DD")
SET ENDATE=Y
SET Y=$EXTRACT(DT,1,5)_"00"
XECUTE ^DD("DD")
SET %DT("A")="Select Month: "
SET %DT("B")=Y
SET %DT="AEPMX"
DO ^%DT
if Y'>0
GOTO EXIT
SET ENPMDT=$EXTRACT(Y,2,5)
SET ENPMMN=+$EXTRACT(Y,4,5)
SET ENPMYR=1700+$EXTRACT(Y,1,3)
+4 SET DIC="^DIC(6922,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
GOTO EXIT
SET ENSHKEY=+Y
SET ENSHOP=$PIECE(^DIC(6922,ENSHKEY,0),U,1)
SET ENSHABR=$PIECE(^(0),U,2)
RD1 READ !,"MONTHLY or WEEKLY PM List: MONTHLY// ",X:DTIME
if X="^"
GOTO EXIT
SET ENPM=$SELECT(X="":"M",$EXTRACT(X)="M":"M",$EXTRACT(X)="W":"W",1:"")
if ENPM="M"
GOTO RD2
IF ENPM']""
DO RDH1
GOTO RD1
RD11 READ !,"Which week? ",X:DTIME
if X="^"
GOTO EXIT
IF X<1!(X>5)
WRITE !,"Enter a number, 1 to 5."
GOTO RD11
+1 SET ENPMWK=X
SET ENPM=ENPM_ENPMWK
+2 ;
RD2 SET ENDEL=""
IF $DATA(^DIC(6910,1,0))
SET ENDEL=$PIECE(^(0),U,5)
+1 IF ENDEL']""
READ !!,"Should PM work orders be deleted after close out? YES//",X:DTIME
if X="^"
GOTO EXIT
if X=""!($EXTRACT(X)="Y")
SET ENDEL="Y"
IF ENDEL'="Y"
IF $EXTRACT(X)'="N"
DO COBH1^ENEQPMR4
GOTO RD2
+2 ;
RD2T WRITE !!,"This option will scan the "_$SELECT(ENPM="M":"MONTHLY",ENPM["W":"WEEKLY",1:"")_" PM Worklist of the "_ENSHOP_" Shop",!,"for "_$PIECE("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",ENPMMN)
+1 WRITE ", "_ENPMYR_$SELECT(ENPM["W":" (Week "_ENPMWK_")",1:"")_"."
+2 WRITE !!,"It will automatically assign a PM Status of 'DEFERRED' and a close out date of",!,ENDATE," to each work order on the list."
+3 WRITE !!,"Default values for labor and material costs (if any) from the Equipment File",!,"will NOT be posted to the Equipment History during RAPID DEFERRAL."
+4 WRITE !!,"Are you sure you want to proceed "
SET %=2
DO YN^DICN
if %=0
GOTO RD2T
if %'=1
GOTO EXIT
+5 SET (ENPMWO,ENPMWO("P"))="PM-"_ENSHABR_ENPMDT_ENPM_"-"
+6 IF $ORDER(^ENG(6920,"B",ENPMWO))'[ENPMWO("P")
WRITE *7,!!,"Specified worklist doesn't seem to exist. Nothing to DEFER."
DO HOLD
GOTO EXIT
+7 ;
RD2P SET ENFR=""
SET ENTO="ZZ"
SET ENTO("L")=20
+1 WRITE !!,"Would you like to specify starting and stopping points for",!,"Rapid Deferral"
SET %=2
DO YN^DICN
if %<0
GOTO EXIT
if %=2
GOTO RD2PD
IF %=0
DO RD2PH
GOTO RD2P
+2 SET J=$ORDER(^ENG(6920,"B",ENPMWO("P")))
if J'[ENPMWO("P")
GOTO EXIT
+3 WRITE !!,"Please enter the starting work order (or the sequential portion thereof)",!,"(ex: '"_J_"' or just '"_+$PIECE(J,"-",3)_"'):"
+4 READ X:DTIME
if '$TEST!($EXTRACT(X)="^")!(X="")
GOTO RD2P
+5 if X?1.2N
SET X=$SELECT(X?1N:"00"_X,1:"0"_X)
IF X?.N
SET X=ENPMWO("P")_X
+6 SET DIC="^ENG(6920,"
SET DIC("S")="I $P(^(0),U)[ENPMWO(""P"")"
SET DIC(0)="X"
DO ^DIC
KILL DIC("S")
if Y'>0
GOTO RD2P
SET ENFR=$PIECE(Y,U,2)
WRITE " ("_ENFR_")"
+7 SET ENFR(0)=$ORDER(^ENG(6920,"B",ENFR),-1)
SET ENFR=$SELECT(ENFR(0)[ENPMWO("P"):ENFR(0),1:ENPMWO("P")_"000")
+8 WRITE !!,"Now enter last work order to be deferred (or sequential portion thereof)"
+9 SET J=$ORDER(^ENG(6920,"B",ENPMWO("P")_9999),-1)
+10 WRITE !,"(ex: '"_J_"' or just '"_+$PIECE(J,"-",3)_"'): "
+11 READ X:DTIME
if '$TEST!(X="^")!(X="")
GOTO RD2P
+12 IF X?1.N
if X?1.2N
SET X=$SELECT(X?1N:"00"_X,1:"0"_X)
SET X=ENPMWO("P")_X
+13 SET DIC("S")="I $P(^(0),U)[ENPMWO(""P""),(+$P($P(^(0),U),""-"",3)>+$P(ENFR,""-"",3))"
+14 DO ^DIC
KILL DIC("S")
if Y'>0
GOTO RD2P
SET ENTO=$PIECE(Y,U,2)
SET ENTO("L")=$LENGTH(ENTO)
WRITE " ("_ENTO_")"
+15 ;
RD2PD LOCK +^ENG("PMLIST",ENPMWO):1
IF '$TEST
WRITE !!,"Another user is processing this worklist. Please try again later.",*7
GOTO EXIT
+1 SET ENPMWO(0)=ENPMWO
+2 SET ENPMWO=$SELECT(ENFR]"":ENFR,1:ENPMWO("P")_"000")
SET DIE="^ENG(6920,"
SET DR="35.2///D0;36///T;32///^S X=""COMPLETED"""
+3 WRITE !,"Would you like to free up this terminal"
SET %=1
DO YN^DICN
if %=1
GOTO RD3
if %<0
GOTO EXIT
if %=0
GOTO RD2PD
+4 WRITE !,"Rapid deferral now in progress "
+5 FOR ENK=0:0
SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
if ENPMWO'[ENPMWO("P")!(ENPMWO]ENTO)
QUIT
IF $LENGTH(ENPMWO)'>ENTO("L")
Begin DoDot:1
+6 WRITE "."
SET DA=$ORDER(^ENG(6920,"B",ENPMWO,0))
IF $DATA(^ENG(6920,DA))
DO POST
IF $DATA(DA)
IF ENDEL="Y"
DO DEL
End DoDot:1
+7 GOTO EXIT
+8 ;
RD3 SET ZTDTH=$HOROLOG
SET ZTRTN="RD4^ENEQPMR6"
SET ZTDESC="Rapid deferral (PM worklist)"
SET ZTSAVE("EN*")=""
SET ZTIO=""
SET ZTSAVE("DIE")=""
SET ZTSAVE("DR")=""
DO ^%ZTLOAD
KILL ZTSK
DO ^%ZISC
DO HOME^%ZIS
+1 GOTO EXIT
+2 ;
RD4 FOR ENK=0:0
SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
if ENPMWO'[ENPMWO("P")!(ENPMWO]ENTO)
QUIT
IF $LENGTH(ENPMWO)'>ENTO("L")
Begin DoDot:1
+1 SET DA=$ORDER(^ENG(6920,"B",ENPMWO,0))
IF $DATA(^ENG(6920,DA))
DO POST
IF $DATA(DA)
IF ENDEL="Y"
DO DEL
End DoDot:1
EXIT IF $DATA(ENPMWO(0))
LOCK -^ENG("PMLIST",ENPMWO(0))
+1 KILL EN,ENPMWO,ENK,ENDATE,ENDEL,ENPM,ENPMDT,ENPMMN,ENPMWK,ENSHABR,ENSHKEY,ENSHOP,ENFR,ENTO,ENPMYR
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL DA,DIC,DR,DIE,DIK
+3 QUIT
POST IF $DATA(^ENG(6920,DA,5))
IF $PIECE(^(5),U,2)]""
KILL DA
QUIT
+1 IF $DATA(^ENG(6920,DA,5))
FOR I=3,4,6
SET $PIECE(^(5),U,I)=""
+2 IF $DATA(^ENG(6920,DA,7))
FOR I=0:0
SET I=$ORDER(^ENG(6920,DA,7,I))
if I'>0
QUIT
if $DATA(^(I,0))
SET $PIECE(^(0),U,2)=""
+3 DO ^DIE
+4 QUIT
DEL IF $EXTRACT($PIECE(^ENG(6920,DA,0),U,1),1,3)="PM-"
SET DIK="^ENG(6920,"
DO ^DIK
+1 QUIT
RDH1 WRITE !,"A MONTHLY PMI list contains work orders for ANNUAL, SEMI-ANNUAL, QUARTERLY,",!,"BI-MONTHLY, and MONTHLY preventive maintenance inspections."
+1 WRITE !,"A WEEKLY PMI list is for WEEKLY and BI-WEEKLY inspections."
+2 QUIT
RD2PH WRITE !!,"If you want to defer only a portion of a PM worklist, you may specify the",!,"first and last work orders that you want Rapid Deferral to operate on."
+1 WRITE !,"Everything between and including these two work orders will be DEFERRED.",!,"Please enter the entire work order numbers (ex: 'PM-E9702M-102')."
+2 QUIT
HOLD READ !,"<cr> to continue, '^' to quit...",X:DTIME
SET ENY=1
QUIT
+1 ;ENEQPMR6
