ENWO1 ;WCIOFO/DLM/DH/SAB-Process Work Order ;1/2/2001
;;7.0;ENGINEERING;**35,51,59,67**;Aug 17, 1993
ENT ;Edit work orders
D WO^ENWOUTL S DA=+Y G:DA'>0 EXIT L +^ENG(6920,DA):5 I '$T W !!,"This work order is being edited by another user. Please try again later.",*7,! G ENT
I $D(^ENG(6920,DA,5)),$P(^(5),U,2)]"" D
. W !,*7,"NOTE: This work order has already been closed out."
. I '$D(^XUSEC("ENEDCLWO",DUZ)) W !,"Security key ENEDCLWO is needed to edit closed work orders." L -^ENG(6920,DA) S DA="" Q
. S DIR(0)="Y",DIR("A")="Are you sure you want to edit this work order",DIR("B")="NO"
. D ^DIR K DIR I Y'>0 L -^ENG(6920,DA) S DA="" Q
. I $P($G(^ENG(6920,DA,3)),U,8)>0 D KILLHS^ENEQHS I $G(R)="^" S DA="" Q
. S ENWOCLOD=$P(^ENG(6920,DA,5),U,2)
. S $P(^ENG(6920,DA,5),U,2)="",$P(^ENG(6920,DA,4),U,3)=""
. D TEST^ENWOCOMP
. ; if PM work order then back out PM hours
. I $E($P($G(^ENG(6920,DA,0)),U),1,3)="PM-" D
. . N ENPMDT,PMTOT,X
. . D PMHRS^ENEQPMR4 Q:'$D(PMTOT)
. . S X=$P($P(^ENG(6920,DA,0),U),"-",2)
. . F I=1:1:$L(X) S:$E(X,I)?1N ENPMDT=$G(ENPMDT)_$E(X,I)
. . S ENPMDT=$E(ENPMDT,1,4)
. . D UNPOST^ENBCPM8
G:DA="" ENT
S DIE="^ENG(6920,",DR=$S($D(^DIE("B","ENZWOEDIT")):"[ENZWOEDIT]",1:"[ENWOEDIT]")
S ENDA=DA
D ^DIE
; if PM work order closed then post PM hours
I $G(DA),$E($P($G(^ENG(6920,DA,0)),U),1,3)="PM-",$P($G(^(5)),U,2)]"" D
. N ENPMDT,PMTOT,X
. D PMHRS^ENEQPMR4 Q:'$D(PMTOT)
. S X=$P($P(^ENG(6920,DA,0),U),"-",2)
. F I=1:1:$L(X) S:$E(X,I)?1N ENPMDT=$G(ENPMDT)_$E(X,I)
. S ENPMDT=$E(ENPMDT,1,4)
. D COUNT^ENBCPM8
L -^ENG(6920,ENDA) K ENDA
G ENT
;
CLSOUT ;Close work order
D WO^ENWOUTL S DA=+Y I DA'>0 G EXIT
I $E(^ENG(6920,DA,0),1,3)="Y2-" W !,*7,"Please use the Y2K Equipment Management Module to close Y2K work orders." G CLSOUT
L +^ENG(6920,DA):5 I '$T W !!,"This work order is being edited by another user. Please try again later.",*7 G CLSOUT
I $D(^ENG(6920,DA,5)),$P(^(5),U,2)]"" D
. W !,*7,"NOTE: This work order has already been closed out."
. I $D(^XUSEC("ENEDCLWO",DUZ)) W !,"You may use the work order EDIT or DISPLAY option to edit this work order."
. L -^ENG(6920,DA) S DA=""
I DA="" G CLSOUT
S DIE="^ENG(6920,",DR=""
; select template
D
. I $E(^ENG(6920,DA,0),1,3)="PM-" S DR=$S($D(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]") Q
. S X=$P($G(^ENG(6920,DA,2)),U)
. I X>0,$P($G(^DIC(6922,X,0)),U,5) S DR=$S($D(^DIE("B","ENZWOBIOCLSE")):"[ENZWOBIOCLSE]",1:"[ENWOBIOCLSE]") Q
. S DR=$S($D(^DIE("B","ENZWOCLOSE")):"[ENZWOCLOSE]",1:"[ENWOCLOSE]")
S ENDA=DA
D ^DIE
; if PM work order closed then post PM hours, update equip file
I $D(DA),$E($P($G(^ENG(6920,DA,0)),U),1,3)="PM-",$P($G(^(5)),U,2)]"" D
. N ENPMDT,PMTOT,X
. D PMHRS^ENEQPMR4,PMINV^ENEQPMR4
. Q:'$D(PMTOT)
. S X=$P($P(^ENG(6920,DA,0),U),"-",2)
. F I=1:1:$L(X) S:$E(X,I)?1N ENPMDT=$G(ENPMDT)_$E(X,I)
. S ENPMDT=$E(ENPMDT,1,4)
. D COUNT^ENBCPM8
L -^ENG(6920,ENDA) K ENDA
W !!
G CLSOUT
;
EQHIV ;EQUIPMENT HIST
Q ;Obsolete entry point
;
EQHI ; Equipment work order history, by entry number
S DIC("S")="I $D(^(3))" D GETEQ^ENUTL G:Y'>0 EXIT S ENDA=+Y
D NOW^%DTC S ENSTMPL="ENWOHIST"_%
W !,"Compiling SORT TEMPLATE ["_ENSTMPL_"]",!
K DD,DO S DIC="^DIBT(",DIC(0)="X",X=ENSTMPL D FILE^DICN S DA=+Y
I DA'>0 W !,"Process ABORTED.",*7 G EXIT
S ENSTMPL(0)=DA
S DIE="^DIBT(",DR="2///^S X=DT;4///^S X=6920;5///^S X=DUZ;15///^S X=""EQUIPMENT ID# EQUALS ""_ENDA" D ^DIE
F I=0:0 S I=$O(^ENG(6920,"G",ENDA,I)) Q:I'>0 S ^DIBT(DA,1,I)="" W "."
I '$D(^DIBT(DA,1)) W !!,"No work orders found. Nothing to report.",*7,! S DIK="^DIBT(" D ^DIK K DIK G EQHI
S DIC="^ENG(6914,",DA=ENDA,DIQ="ENEQ",DIQ(0)="E",DR=".01;1;4;5;53"
D EN^DIQ1 K DA,DIC,DIQ,DR
S I=0,ENCRIT="" F S I=$O(^ENG(6914,ENDA,4,I)) Q:'I D
. S J=$P($G(^ENG(6914,ENDA,4,I,0)),U,4) I J>ENCRIT S ENCRIT=J
D DEV^ENLIB G:POP EXIT
S IOP=ION,L="0",DIC="^ENG(6920,",FLDS=$S($D(^DIPT("B","ENZ EQ HIST")):"[ENZ EQ HIST]",1:"[EN EQ HIST]"),BY="["_ENSTMPL_"]",FR="@"
I $D(IO("Q")) D K ZTSK D HOME^%ZIS G EXIT
. S ZTIO=IOP,ZTRTN="DQHI^ENWO1",ZTDESC="Equipment History from Work Order Module"
. S ZTSAVE("IOP")="",ZTSAVE("EN*")="",ZTSAVE("DIC")=""
. S ZTSAVE("FLDS")="",ZTSAVE("BY")="",ZTSAVE("FR")="",ZTSAVE("L")=""
. D ^%ZTLOAD
S DIOEND="I IOST[""C-"" R !!,""Press <RETURN> to continue"",X:DTIME"
DQHI ;
D EN1^DIP
S DIK="^DIBT(",DA=ENSTMPL(0) D ^DIK K DIK
G:'$D(ZTQUEUED) EQHI
G EXIT
DSY ;Screen display work order
G EDIT^ENWOD
;
DEL ; Delete open work order
W !
K DA
S DIC("S")="I $P($G(^(5)),U,2)=""""" D WO^ENWOUTL K DIC
S DA=+Y G:DA'>0 EXIT
L +^ENG(6920,DA):5 I '$T W !!,"This work order is being edited by another user and can't be deleted.",$C(7),! G DEL
S DIR(0)="Y",DIR("A")="Delete work order "_$P($G(^ENG(6920,DA,0)),U)
D ^DIR K DIR I $D(DIRUT) G EXIT
I 'Y G DEL
S DIK="^ENG(6920," D ^DIK K DIK
W !," The work order has been deleted."
G DEL
;
INIT K DIC("S") S DIC="^DIC(6922,",DIC(0)="AEQM" D ^DIC S ENSHKEY=+Y Q
EXIT K %IS,DIC,DIE,DA,Y,DR,N,I,J,K,O,S,X,Y,Z,ENWO
K ENSTMPL,L,FLDS,BY,FR,TO,ENVANO,IOP,ENDA,ENEQ,ENCRIT
S:$D(ZTQUEUED) ZTREQ="@"
Q
;ENWO1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWO1 5216 printed Dec 13, 2024@01:56:10 Page 2
ENWO1 ;WCIOFO/DLM/DH/SAB-Process Work Order ;1/2/2001
+1 ;;7.0;ENGINEERING;**35,51,59,67**;Aug 17, 1993
ENT ;Edit work orders
+1 DO WO^ENWOUTL
SET DA=+Y
if DA'>0
GOTO EXIT
LOCK +^ENG(6920,DA):5
IF '$TEST
WRITE !!,"This work order is being edited by another user. Please try again later.",*7,!
GOTO ENT
+2 IF $DATA(^ENG(6920,DA,5))
IF $PIECE(^(5),U,2)]""
Begin DoDot:1
+3 WRITE !,*7,"NOTE: This work order has already been closed out."
+4 IF '$DATA(^XUSEC("ENEDCLWO",DUZ))
WRITE !,"Security key ENEDCLWO is needed to edit closed work orders."
LOCK -^ENG(6920,DA)
SET DA=""
QUIT
+5 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to edit this work order"
SET DIR("B")="NO"
+6 DO ^DIR
KILL DIR
IF Y'>0
LOCK -^ENG(6920,DA)
SET DA=""
QUIT
+7 IF $PIECE($GET(^ENG(6920,DA,3)),U,8)>0
DO KILLHS^ENEQHS
IF $GET(R)="^"
SET DA=""
QUIT
+8 SET ENWOCLOD=$PIECE(^ENG(6920,DA,5),U,2)
+9 SET $PIECE(^ENG(6920,DA,5),U,2)=""
SET $PIECE(^ENG(6920,DA,4),U,3)=""
+10 DO TEST^ENWOCOMP
+11 ; if PM work order then back out PM hours
+12 IF $EXTRACT($PIECE($GET(^ENG(6920,DA,0)),U),1,3)="PM-"
Begin DoDot:2
+13 NEW ENPMDT,PMTOT,X
+14 DO PMHRS^ENEQPMR4
if '$DATA(PMTOT)
QUIT
+15 SET X=$PIECE($PIECE(^ENG(6920,DA,0),U),"-",2)
+16 FOR I=1:1:$LENGTH(X)
if $EXTRACT(X,I)?1N
SET ENPMDT=$GET(ENPMDT)_$EXTRACT(X,I)
+17 SET ENPMDT=$EXTRACT(ENPMDT,1,4)
+18 DO UNPOST^ENBCPM8
End DoDot:2
End DoDot:1
+19 if DA=""
GOTO ENT
+20 SET DIE="^ENG(6920,"
SET DR=$SELECT($DATA(^DIE("B","ENZWOEDIT")):"[ENZWOEDIT]",1:"[ENWOEDIT]")
+21 SET ENDA=DA
+22 DO ^DIE
+23 ; if PM work order closed then post PM hours
+24 IF $GET(DA)
IF $EXTRACT($PIECE($GET(^ENG(6920,DA,0)),U),1,3)="PM-"
IF $PIECE($GET(^(5)),U,2)]""
Begin DoDot:1
+25 NEW ENPMDT,PMTOT,X
+26 DO PMHRS^ENEQPMR4
if '$DATA(PMTOT)
QUIT
+27 SET X=$PIECE($PIECE(^ENG(6920,DA,0),U),"-",2)
+28 FOR I=1:1:$LENGTH(X)
if $EXTRACT(X,I)?1N
SET ENPMDT=$GET(ENPMDT)_$EXTRACT(X,I)
+29 SET ENPMDT=$EXTRACT(ENPMDT,1,4)
+30 DO COUNT^ENBCPM8
End DoDot:1
+31 LOCK -^ENG(6920,ENDA)
KILL ENDA
+32 GOTO ENT
+33 ;
CLSOUT ;Close work order
+1 DO WO^ENWOUTL
SET DA=+Y
IF DA'>0
GOTO EXIT
+2 IF $EXTRACT(^ENG(6920,DA,0),1,3)="Y2-"
WRITE !,*7,"Please use the Y2K Equipment Management Module to close Y2K work orders."
GOTO CLSOUT
+3 LOCK +^ENG(6920,DA):5
IF '$TEST
WRITE !!,"This work order is being edited by another user. Please try again later.",*7
GOTO CLSOUT
+4 IF $DATA(^ENG(6920,DA,5))
IF $PIECE(^(5),U,2)]""
Begin DoDot:1
+5 WRITE !,*7,"NOTE: This work order has already been closed out."
+6 IF $DATA(^XUSEC("ENEDCLWO",DUZ))
WRITE !,"You may use the work order EDIT or DISPLAY option to edit this work order."
+7 LOCK -^ENG(6920,DA)
SET DA=""
End DoDot:1
+8 IF DA=""
GOTO CLSOUT
+9 SET DIE="^ENG(6920,"
SET DR=""
+10 ; select template
+11 Begin DoDot:1
+12 IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
SET DR=$SELECT($DATA(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]")
QUIT
+13 SET X=$PIECE($GET(^ENG(6920,DA,2)),U)
+14 IF X>0
IF $PIECE($GET(^DIC(6922,X,0)),U,5)
SET DR=$SELECT($DATA(^DIE("B","ENZWOBIOCLSE")):"[ENZWOBIOCLSE]",1:"[ENWOBIOCLSE]")
QUIT
+15 SET DR=$SELECT($DATA(^DIE("B","ENZWOCLOSE")):"[ENZWOCLOSE]",1:"[ENWOCLOSE]")
End DoDot:1
+16 SET ENDA=DA
+17 DO ^DIE
+18 ; if PM work order closed then post PM hours, update equip file
+19 IF $DATA(DA)
IF $EXTRACT($PIECE($GET(^ENG(6920,DA,0)),U),1,3)="PM-"
IF $PIECE($GET(^(5)),U,2)]""
Begin DoDot:1
+20 NEW ENPMDT,PMTOT,X
+21 DO PMHRS^ENEQPMR4
DO PMINV^ENEQPMR4
+22 if '$DATA(PMTOT)
QUIT
+23 SET X=$PIECE($PIECE(^ENG(6920,DA,0),U),"-",2)
+24 FOR I=1:1:$LENGTH(X)
if $EXTRACT(X,I)?1N
SET ENPMDT=$GET(ENPMDT)_$EXTRACT(X,I)
+25 SET ENPMDT=$EXTRACT(ENPMDT,1,4)
+26 DO COUNT^ENBCPM8
End DoDot:1
+27 LOCK -^ENG(6920,ENDA)
KILL ENDA
+28 WRITE !!
+29 GOTO CLSOUT
+30 ;
EQHIV ;EQUIPMENT HIST
+1 ;Obsolete entry point
QUIT
+2 ;
EQHI ; Equipment work order history, by entry number
+1 SET DIC("S")="I $D(^(3))"
DO GETEQ^ENUTL
if Y'>0
GOTO EXIT
SET ENDA=+Y
+2 DO NOW^%DTC
SET ENSTMPL="ENWOHIST"_%
+3 WRITE !,"Compiling SORT TEMPLATE ["_ENSTMPL_"]",!
+4 KILL DD,DO
SET DIC="^DIBT("
SET DIC(0)="X"
SET X=ENSTMPL
DO FILE^DICN
SET DA=+Y
+5 IF DA'>0
WRITE !,"Process ABORTED.",*7
GOTO EXIT
+6 SET ENSTMPL(0)=DA
+7 SET DIE="^DIBT("
SET DR="2///^S X=DT;4///^S X=6920;5///^S X=DUZ;15///^S X=""EQUIPMENT ID# EQUALS ""_ENDA"
DO ^DIE
+8 FOR I=0:0
SET I=$ORDER(^ENG(6920,"G",ENDA,I))
if I'>0
QUIT
SET ^DIBT(DA,1,I)=""
WRITE "."
+9 IF '$DATA(^DIBT(DA,1))
WRITE !!,"No work orders found. Nothing to report.",*7,!
SET DIK="^DIBT("
DO ^DIK
KILL DIK
GOTO EQHI
+10 SET DIC="^ENG(6914,"
SET DA=ENDA
SET DIQ="ENEQ"
SET DIQ(0)="E"
SET DR=".01;1;4;5;53"
+11 DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+12 SET I=0
SET ENCRIT=""
FOR
SET I=$ORDER(^ENG(6914,ENDA,4,I))
if 'I
QUIT
Begin DoDot:1
+13 SET J=$PIECE($GET(^ENG(6914,ENDA,4,I,0)),U,4)
IF J>ENCRIT
SET ENCRIT=J
End DoDot:1
+14 DO DEV^ENLIB
if POP
GOTO EXIT
+15 SET IOP=ION
SET L="0"
SET DIC="^ENG(6920,"
SET FLDS=$SELECT($DATA(^DIPT("B","ENZ EQ HIST")):"[ENZ EQ HIST]",1:"[EN EQ HIST]")
SET BY="["_ENSTMPL_"]"
SET FR="@"
+16 IF $DATA(IO("Q"))
Begin DoDot:1
+17 SET ZTIO=IOP
SET ZTRTN="DQHI^ENWO1"
SET ZTDESC="Equipment History from Work Order Module"
+18 SET ZTSAVE("IOP")=""
SET ZTSAVE("EN*")=""
SET ZTSAVE("DIC")=""
+19 SET ZTSAVE("FLDS")=""
SET ZTSAVE("BY")=""
SET ZTSAVE("FR")=""
SET ZTSAVE("L")=""
+20 DO ^%ZTLOAD
End DoDot:1
KILL ZTSK
DO HOME^%ZIS
GOTO EXIT
+21 SET DIOEND="I IOST[""C-"" R !!,""Press <RETURN> to continue"",X:DTIME"
DQHI ;
+1 DO EN1^DIP
+2 SET DIK="^DIBT("
SET DA=ENSTMPL(0)
DO ^DIK
KILL DIK
+3 if '$DATA(ZTQUEUED)
GOTO EQHI
+4 GOTO EXIT
DSY ;Screen display work order
+1 GOTO EDIT^ENWOD
+2 ;
DEL ; Delete open work order
+1 WRITE !
+2 KILL DA
+3 SET DIC("S")="I $P($G(^(5)),U,2)="""""
DO WO^ENWOUTL
KILL DIC
+4 SET DA=+Y
if DA'>0
GOTO EXIT
+5 LOCK +^ENG(6920,DA):5
IF '$TEST
WRITE !!,"This work order is being edited by another user and can't be deleted.",$CHAR(7),!
GOTO DEL
+6 SET DIR(0)="Y"
SET DIR("A")="Delete work order "_$PIECE($GET(^ENG(6920,DA,0)),U)
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO EXIT
+8 IF 'Y
GOTO DEL
+9 SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
+10 WRITE !," The work order has been deleted."
+11 GOTO DEL
+12 ;
INIT KILL DIC("S")
SET DIC="^DIC(6922,"
SET DIC(0)="AEQM"
DO ^DIC
SET ENSHKEY=+Y
QUIT
EXIT KILL %IS,DIC,DIE,DA,Y,DR,N,I,J,K,O,S,X,Y,Z,ENWO
+1 KILL ENSTMPL,L,FLDS,BY,FR,TO,ENVANO,IOP,ENDA,ENEQ,ENCRIT
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;ENWO1
