ENEQPMR2 ;(WASH ISC)/JED/DH-Rapid PMI Close Out ;1/4/2001
;;7.0;ENGINEERING;**35,42,67**;Aug 17, 1993
RCO ; Close out using defaults
N PMTOT,PMTECH
RCOA S Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="Select Worklist Month: ",%DT("B")=Y,%DT="AEPMX" D ^%DT K %DT G:Y'>0 EXIT
I $E(Y,4,5)="00" W !,"Date of worklist must contain a month.",*7 G RCOA
S ENPMYR=$E(Y)+17,ENPMDT=$E(Y,2,5),ENPMMN=+$E(Y,4,5)
S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT S ENSHKEY=+Y,ENSHOP=$P(^DIC(6922,ENSHKEY,0),U),ENSHABR=$P(^(0),U,2)
;
RCO1 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" RCO15 I ENPM']"" D RCOH1 G RCO1
RCO11 R !,"Which week? ",X:DTIME G:X="^" EXIT I X<1!(X>5) W !,"Enter a number, 1 to 5." G RCO11
S ENPMWK=X,ENPM=ENPM_ENPMWK
RCO15 S Y=(ENPMYR-17)_ENPMDT_"00" X ^DD("DD") S %DT("B")=Y
W !!,"COMPLETION DATE (future dates will not be accepted). MONTH and YEAR are"
S %DT("A")="required, DAY is optional: ",%DT="AEP",%DT(0)="-NOW" D ^%DT K %DT G:Y'>0 EXIT
I $E(Y,4,5)="00" W !!,"Completion date must contain a month.",*7 G RCO15
S ENCDATE=Y X ^DD("DD") S ENCDATE("E")=Y
;
RCO2 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")!($E(X)="y") ENDEL="Y" I ENDEL'="Y",$E(X)'="N",$E(X)'="n" D COBH1^ENEQPMR4 G RCO2
;
RCO3 S I=0,PMTECH(I)=""
W ! K DIR S DIR("A")="Do you wish to substitute one technician for another",DIR("B")="NO",DIR(0)="Y"
S DIR("?",1)="If all of the work assigned to TECHNICIAN A has actually been done by"
S DIR("?",2)="TECHNICIAN B then you should enter 'YES' at this point and then 'Replace'"
S DIR("?")="TECHNICIAN A 'With' TECHNICIAN B."
D ^DIR K DIR G:$D(DIRUT) EXIT
I Y D G:$D(DTOUT)!($D(DUOUT)) EXIT
. W !!,"Work orders without a technician already assigned should be closed indivi-"
. W !,"dually. You'll have a chance to do this before Rapid Close Out begins."
. S DIC="^ENG(""EMP"",",DIC(0)="AEQM"
. F W ! K DIC("S") S DIC("A")="Replace: ",I=I+1 D ^DIC K DIC("A") Q:Y'>0 S PMTECH(I,0)=+Y,PMTECH(I,0,"E")=$P(Y,U,2) D S:Y>0 PMTECH(I,1)=+Y,PMTECH(I,1,"E")=$P(Y,U,2) I Y'>0 K PMTECH(I) Q
.. S DIC("A")="With: ",DIC("S")="I $P(^(0),U)'=PMTECH(I,0,""E"")" D ^DIC K DIC("A"),DIC("S")
;
RCO4 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_$E(ENPMDT,1,2)_$S(ENPM["W":" (Week "_ENPMWK_")",1:"")_". It will automatically assign a PM Status of 'PASSED'"
W !,"and a completion date of "_ENCDATE("E")," to each work order on the list,"
W !,"except for those that you close out individually."
W !!,"Default values for labor and material costs (if any) from the Equipment File",!,"will be posted to the Equipment History during Rapid Close Out."
I $O(PMTECH(0)) D
. W !!,"The PRIMARY TECHNICIANS will be changed as follows:" S I=0
. F S I=$O(PMTECH(I)) Q:I'>0 W !,?10,PMTECH(I,0,"E")_" will be changed to "_PMTECH(I,1,"E")
W !!,"Are you sure you want to proceed " S %=2 D YN^DICN G:%=0 RCO4 G:%'=1 EXIT
S (ENPMWO,ENPMWO("P"))="PM-"_ENSHABR_ENPMDT_ENPM_"-"
L +^ENG("PMLIST",ENPMWO):1 I '$T W !!,"Another user is processing this worklist. Please try again later.",*7 G EXIT
K ^ENG("TMP",ENPMWO) S J=""
F S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) Q:ENPMWO=""!(ENPMWO'[ENPMWO("P")) S DA=$O(^ENG(6920,"B",ENPMWO,0)) Q:DA'>0 I $P($G(^ENG(6920,DA,5)),U,2)="" S J=$P(^ENG(6920,DA,0),U) Q
I J="" W !!,"There are no open work orders on this list. Nothing to process.",*7 G EXIT
W !!,"Please enter any PM work orders (or the sequential portion thereof) that you",!,"wish to close out individually. Press <RETURN> to terminate the process."
;
RCO41 W !!,"Work order (ex: '",J,"' or just '",+$P(J,"-",3),"'): " R X:DTIME G:X=""!(X="^") RCO6^ENEQPMR3 I X="?" D RCOH4 G RCO41
S:X?1.2N X=$S($L(X)=1:"00"_X,1:"0"_X) I X?.N S X=ENPMWO("P")_X
S DIC="^ENG(6920,",DIC(0)="X",DIC("S")="I $P(^(0),U,1)[ENPMWO(""P"")" D ^DIC K DIC("S") I Y'>0 D RCOH4 G RCO41
S DA=+Y I $P($G(^ENG(6920,DA,5)),U,2)]"" W ?40,"Already closed." G RCO41
S ENPMWO=$P(^ENG(6920,DA,0),U),DIE="^ENG(6920,",DR=$S($D(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]")
D ^DIE S ^ENG("TMP",ENPMWO("P"),ENPMWO)=""
I $D(DA),$P($G(^ENG(6920,DA,5)),U,2)]"",$E(^ENG(6920,DA,0),1,3)="PM-" D
. I $P(^ENG(6920,DA,5),U,8)="C" D REGLR^ENEQPMR1
. D PMHRS^ENEQPMR4,PMINV^ENEQPMR4
. I ENDEL="Y" S DIK="^ENG(6920," D ^DIK K DIK
;
RCO5 R !!,"Next work order (or sequential portion), <RETURN> to quit: ",X:DTIME G:X=""!(X="^") RCO6^ENEQPMR3 S:X?1.2N X=$S($L(X)=1:"00"_X,1:"0"_X)
S ENPMWO=$S(X?3.N:ENPMWO("P")_X,1:X),X=ENPMWO,DIC="^ENG(6920,",DIC(0)="X",DIC("S")="I $P(^(0),U)[ENPMWO(""P"")" D ^DIC K DIC("S") I Y'>0 W "??" G RCO5
S DA=+Y I $P($G(^ENG(6920,DA,5)),U,2)]"" W !,?30,ENPMWO_" is already closed." G RCO5
D ^DIE S ^ENG("TMP",ENPMWO("P"),ENPMWO)=""
I $D(DA),$P($G(^ENG(6920,DA,5)),U,2)]"",$E(^ENG(6920,DA,0),1,3)="PM-" D
. I $P(^ENG(6920,DA,5),U,8)="C" D REGLR^ENEQPMR1
. D PMHRS^ENEQPMR4,PMINV^ENEQPMR4
. I ENDEL="Y" S DIK="^ENG(6920," D ^DIK K DIK
G RCO5
;
RCOH1 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
;
RCOH4 W !!,"Please enter an existing PM work order, or the sequential portion thereof.",!,"If there are no work orders to be closed out individually, enter <cr>.",!
W !,"Would you like a list of existing work orders" S %=1 D YN^DICN Q:%'=1
N J1 S J1=ENPMWO,ENY=1 F S J1=$O(^ENG(6920,"B",J1)) Q:J1'[ENPMWO("P")!(J1="") S DA=$O(^ENG(6920,"B",J1,0)) I DA>0,$P($G(^ENG(6920,DA,5)),U,2)="" D:IOSL-ENY<3 HOLD Q:X="^" S ENY=ENY+1 W !,?5,J1
Q
;
EXIT K EN,ENPMWO,ENPM,ENPMDT,ENPMYR,ENPMMN,ENPMWK,ENDATE,ENDEL,ENSHABR,ENSHOP
K DIC,DIE,DIK,DA,DR,I,J,ENY,EN1
Q
;
HOLD I $E(IOST,1,2)="C-" R !,"<cr> to continue, '^' to quit...",X:DTIME
S ENY=1
Q
;ENEQPMR2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMR2 6236 printed Jan 18, 2025@02:54 Page 2
ENEQPMR2 ;(WASH ISC)/JED/DH-Rapid PMI Close Out ;1/4/2001
+1 ;;7.0;ENGINEERING;**35,42,67**;Aug 17, 1993
RCO ; Close out using defaults
+1 NEW PMTOT,PMTECH
RCOA SET Y=$EXTRACT(DT,1,5)_"00"
XECUTE ^DD("DD")
SET %DT("A")="Select Worklist Month: "
SET %DT("B")=Y
SET %DT="AEPMX"
DO ^%DT
KILL %DT
if Y'>0
GOTO EXIT
+1 IF $EXTRACT(Y,4,5)="00"
WRITE !,"Date of worklist must contain a month.",*7
GOTO RCOA
+2 SET ENPMYR=$EXTRACT(Y)+17
SET ENPMDT=$EXTRACT(Y,2,5)
SET ENPMMN=+$EXTRACT(Y,4,5)
+3 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)
SET ENSHABR=$PIECE(^(0),U,2)
+4 ;
RCO1 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 RCO15
IF ENPM']""
DO RCOH1
GOTO RCO1
RCO11 READ !,"Which week? ",X:DTIME
if X="^"
GOTO EXIT
IF X<1!(X>5)
WRITE !,"Enter a number, 1 to 5."
GOTO RCO11
+1 SET ENPMWK=X
SET ENPM=ENPM_ENPMWK
RCO15 SET Y=(ENPMYR-17)_ENPMDT_"00"
XECUTE ^DD("DD")
SET %DT("B")=Y
+1 WRITE !!,"COMPLETION DATE (future dates will not be accepted). MONTH and YEAR are"
+2 SET %DT("A")="required, DAY is optional: "
SET %DT="AEP"
SET %DT(0)="-NOW"
DO ^%DT
KILL %DT
if Y'>0
GOTO EXIT
+3 IF $EXTRACT(Y,4,5)="00"
WRITE !!,"Completion date must contain a month.",*7
GOTO RCO15
+4 SET ENCDATE=Y
XECUTE ^DD("DD")
SET ENCDATE("E")=Y
+5 ;
RCO2 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")!($EXTRACT(X)="y")
SET ENDEL="Y"
IF ENDEL'="Y"
IF $EXTRACT(X)'="N"
IF $EXTRACT(X)'="n"
DO COBH1^ENEQPMR4
GOTO RCO2
+2 ;
RCO3 SET I=0
SET PMTECH(I)=""
+1 WRITE !
KILL DIR
SET DIR("A")="Do you wish to substitute one technician for another"
SET DIR("B")="NO"
SET DIR(0)="Y"
+2 SET DIR("?",1)="If all of the work assigned to TECHNICIAN A has actually been done by"
+3 SET DIR("?",2)="TECHNICIAN B then you should enter 'YES' at this point and then 'Replace'"
+4 SET DIR("?")="TECHNICIAN A 'With' TECHNICIAN B."
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+6 IF Y
Begin DoDot:1
+7 WRITE !!,"Work orders without a technician already assigned should be closed indivi-"
+8 WRITE !,"dually. You'll have a chance to do this before Rapid Close Out begins."
+9 SET DIC="^ENG(""EMP"","
SET DIC(0)="AEQM"
+10 FOR
WRITE !
KILL DIC("S")
SET DIC("A")="Replace: "
SET I=I+1
DO ^DIC
KILL DIC("A")
if Y'>0
QUIT
SET PMTECH(I,0)=+Y
SET PMTECH(I,0,"E")=$PIECE(Y,U,2)
Begin DoDot:2
+11 SET DIC("A")="With: "
SET DIC("S")="I $P(^(0),U)'=PMTECH(I,0,""E"")"
DO ^DIC
KILL DIC("A"),DIC("S")
End DoDot:2
if Y>0
SET PMTECH(I,1)=+Y
SET PMTECH(I,1,"E")=$PIECE(Y,U,2)
IF Y'>0
KILL PMTECH(I)
QUIT
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+12 ;
RCO4 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_$EXTRACT(ENPMDT,1,2)_$SELECT(ENPM["W":" (Week "_ENPMWK_")",1:"")_". It will automatically assign a PM Status of 'PASSED'"
+2 WRITE !,"and a completion date of "_ENCDATE("E")," to each work order on the list,"
+3 WRITE !,"except for those that you close out individually."
+4 WRITE !!,"Default values for labor and material costs (if any) from the Equipment File",!,"will be posted to the Equipment History during Rapid Close Out."
+5 IF $ORDER(PMTECH(0))
Begin DoDot:1
+6 WRITE !!,"The PRIMARY TECHNICIANS will be changed as follows:"
SET I=0
+7 FOR
SET I=$ORDER(PMTECH(I))
if I'>0
QUIT
WRITE !,?10,PMTECH(I,0,"E")_" will be changed to "_PMTECH(I,1,"E")
End DoDot:1
+8 WRITE !!,"Are you sure you want to proceed "
SET %=2
DO YN^DICN
if %=0
GOTO RCO4
if %'=1
GOTO EXIT
+9 SET (ENPMWO,ENPMWO("P"))="PM-"_ENSHABR_ENPMDT_ENPM_"-"
+10 LOCK +^ENG("PMLIST",ENPMWO):1
IF '$TEST
WRITE !!,"Another user is processing this worklist. Please try again later.",*7
GOTO EXIT
+11 KILL ^ENG("TMP",ENPMWO)
SET J=""
+12 FOR
SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
if ENPMWO=""!(ENPMWO'[ENPMWO("P"))
QUIT
SET DA=$ORDER(^ENG(6920,"B",ENPMWO,0))
if DA'>0
QUIT
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)=""
SET J=$PIECE(^ENG(6920,DA,0),U)
QUIT
+13 IF J=""
WRITE !!,"There are no open work orders on this list. Nothing to process.",*7
GOTO EXIT
+14 WRITE !!,"Please enter any PM work orders (or the sequential portion thereof) that you",!,"wish to close out individually. Press <RETURN> to terminate the process."
+15 ;
RCO41 WRITE !!,"Work order (ex: '",J,"' or just '",+$PIECE(J,"-",3),"'): "
READ X:DTIME
if X=""!(X="^")
GOTO RCO6^ENEQPMR3
IF X="?"
DO RCOH4
GOTO RCO41
+1 if X?1.2N
SET X=$SELECT($LENGTH(X)=1:"00"_X,1:"0"_X)
IF X?.N
SET X=ENPMWO("P")_X
+2 SET DIC="^ENG(6920,"
SET DIC(0)="X"
SET DIC("S")="I $P(^(0),U,1)[ENPMWO(""P"")"
DO ^DIC
KILL DIC("S")
IF Y'>0
DO RCOH4
GOTO RCO41
+3 SET DA=+Y
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
WRITE ?40,"Already closed."
GOTO RCO41
+4 SET ENPMWO=$PIECE(^ENG(6920,DA,0),U)
SET DIE="^ENG(6920,"
SET DR=$SELECT($DATA(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]")
+5 DO ^DIE
SET ^ENG("TMP",ENPMWO("P"),ENPMWO)=""
+6 IF $DATA(DA)
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
Begin DoDot:1
+7 IF $PIECE(^ENG(6920,DA,5),U,8)="C"
DO REGLR^ENEQPMR1
+8 DO PMHRS^ENEQPMR4
DO PMINV^ENEQPMR4
+9 IF ENDEL="Y"
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
End DoDot:1
+10 ;
RCO5 READ !!,"Next work order (or sequential portion), <RETURN> to quit: ",X:DTIME
if X=""!(X="^")
GOTO RCO6^ENEQPMR3
if X?1.2N
SET X=$SELECT($LENGTH(X)=1:"00"_X,1:"0"_X)
+1 SET ENPMWO=$SELECT(X?3.N:ENPMWO("P")_X,1:X)
SET X=ENPMWO
SET DIC="^ENG(6920,"
SET DIC(0)="X"
SET DIC("S")="I $P(^(0),U)[ENPMWO(""P"")"
DO ^DIC
KILL DIC("S")
IF Y'>0
WRITE "??"
GOTO RCO5
+2 SET DA=+Y
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
WRITE !,?30,ENPMWO_" is already closed."
GOTO RCO5
+3 DO ^DIE
SET ^ENG("TMP",ENPMWO("P"),ENPMWO)=""
+4 IF $DATA(DA)
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
Begin DoDot:1
+5 IF $PIECE(^ENG(6920,DA,5),U,8)="C"
DO REGLR^ENEQPMR1
+6 DO PMHRS^ENEQPMR4
DO PMINV^ENEQPMR4
+7 IF ENDEL="Y"
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
End DoDot:1
+8 GOTO RCO5
+9 ;
RCOH1 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
+3 ;
RCOH4 WRITE !!,"Please enter an existing PM work order, or the sequential portion thereof.",!,"If there are no work orders to be closed out individually, enter <cr>.",!
+1 WRITE !,"Would you like a list of existing work orders"
SET %=1
DO YN^DICN
if %'=1
QUIT
+2 NEW J1
SET J1=ENPMWO
SET ENY=1
FOR
SET J1=$ORDER(^ENG(6920,"B",J1))
if J1'[ENPMWO("P")!(J1="")
QUIT
SET DA=$ORDER(^ENG(6920,"B",J1,0))
IF DA>0
IF $PIECE($GET(^ENG(6920,DA,5)),U,2)=""
if IOSL-ENY<3
DO HOLD
if X="^"
QUIT
SET ENY=ENY+1
WRITE !,?5,J1
+3 QUIT
+4 ;
EXIT KILL EN,ENPMWO,ENPM,ENPMDT,ENPMYR,ENPMMN,ENPMWK,ENDATE,ENDEL,ENSHABR,ENSHOP
+1 KILL DIC,DIE,DIK,DA,DR,I,J,ENY,EN1
+2 QUIT
+3 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
READ !,"<cr> to continue, '^' to quit...",X:DTIME
+1 SET ENY=1
+2 QUIT
+3 ;ENEQPMR2
