ENEQHS ;(WIRMFO)/JED/DH-POST REPAIR TO EQUIPMENT HISTORY ;5/11/2000
;;7.0;ENGINEERING;**35,42,48,59,65**;Aug 17, 1993
W ;W.O. HISTORY-ENTRY FROM COMP1^ENWOCOMP
; EXPECTING W.O. VARIABLES U,DA,ENTEC & ENINV
; where DA => IEN of work order file
; ENINV => IEN of equipment file
Q:$D(DIU(0))
N ENACTN,ENDTCP,ENEMPL,ENWO,ENH,ENHRS,ENLABOR,ENMTL
N ENODE,ENVEND,ENSTAT,ENWORK,ENWOX,I,J,J1,K
I $D(^ENG(6920,DA,4)),$P(^(4),U,3)=5 Q
I '$D(^ENG(6914,ENINV,0)) G EXIT ; equipment record not found
S ENEMPL="" I ENTEC="" S ENEMPL=$S($E($P(^ENG(6920,DA,0),U),1,3)="PM-":"STAFF",1:"NO ENTRY") G W1
I $D(^ENG("EMP",ENTEC,0)) S ENEMPL=$E($P(^(0),U),1,15)
W1 S ENWO=$P(^ENG(6920,DA,0),U) F K=0:0 S K=$O(^ENG(6914,ENINV,6,K)) Q:K'>0 S ENWOX=$P(^ENG(6914,ENINV,6,K,0),U,2) G:ENWOX=ENWO EXIT
I '$D(^ENG(6920,DA,5)) S ENERR="NODE 5 OF W.O. IR #"_DA_" IS GONE!" G ERR
S ENODE=^ENG(6920,DA,5)
S ENDTCP=$P($P(ENODE,U,2),"."),ENHRS=$P(ENODE,U,3),ENMTL=$P(ENODE,U,4),ENLABOR=$P(ENODE,U,6),ENSTAT=$P(ENODE,U,8),ENWORK=$P(ENODE,U,7)
S ENACTN="XX"
I $D(^ENG(6920,DA,8)) D
. F I=0:0 S I=$O(^ENG(6920,DA,8,I)) Q:I'>0!($L(ENACTN)=8) D
.. S J=$P(^ENG(6920,DA,8,I,0),U)
.. Q:'$D(^ENG(6920.1,J,0)) S J1=$P(^(0),U,2)
.. I ENACTN="XX" S ENACTN=""
.. S ENACTN=ENACTN_J1
S ENVEND="" I $D(^ENG(6920,DA,4)) S ENVEND=$P(^(4),U,4) I ENVEND]"" S ENVEND=$P(ENVEND,".",1)
S ENH=ENDTCP_"-"_ENACTN_U_ENWO_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMTL_U_ENVEND_U_ENEMPL_U_ENWORK
EXT ; post history info (ENH) to equipment (ENINV)
Q:'$D(^ENG(6914,ENINV,0))
N ENNXL,ENNXT,ENOUT,ENRN,ENW
I $D(^ENG(6914,ENINV,6,0))'>0 S ^(0)="^6914.02A^0^0"
S ENW=$P(^ENG(6914,ENINV,6,0),U,1,2),ENNXL=$P(^(0),U,3),ENNXT=$P(^(0),U,4)
;FOR REVERSE CHRONO, SUBTRACT YYYMMDD, X10 (TO HANDLE SAME DAY WO'S)
S ENRN=(9999999-ENDTCP)*10
W2 I $D(^ENG(6914,ENINV,6,ENRN,0))>0 S ENRN=ENRN-1 G W2
S:ENNXL<ENRN ENNXL=ENRN S ENNXT=ENNXT+1,ENOUT=ENW_U_ENNXL_U_ENNXT
L +^ENG(6914,ENINV,6) S ^ENG(6914,ENINV,6,0)=ENOUT,^ENG(6914,ENINV,6,ENRN,0)=ENH L -^ENG(6914,ENINV,6)
EXIT ;
Q
;
ERR W !!,*7,"ABORTING ATTEMPT TO POST INVENTORY WORK HISTORY",!,ENERR G EXIT
;
KILLHS ;REMOVE EXISTING HISTORY IF WO IS EDITED; CALLED BY ENWO1,ENWOD,ENWOME
I $E($P(^ENG(6920,DA,0),U,1),1,3)="PM-" S R="" D PMTXT Q:R="^"
W !!,*7,"WARNING: you must re-enter the DATE COMPLETE field,",!,"to re-post the device history ... DO THIS LAST!",!!,"<cr> to continue" R R:DTIME
S ENWO=$P(^ENG(6920,DA,0),"^",1),ENINV=$P(^(3),"^",8) Q:'$D(^ENG(6914,ENINV,6,0))
I ENINV'="" S ENZ=0 F I=1:1 S ENZ=$O(^ENG(6914,ENINV,6,ENZ)) Q:'ENZ I $D(^ENG(6914,ENINV,6,ENZ,0)),$P(^(0),"^",2)=ENWO K ^ENG(6914,ENINV,6,ENZ,0) S $P(^ENG(6914,ENINV,6,0),"^",4)=$P(^ENG(6914,ENINV,6,0),"^",4)-1 Q
K ENZ
Q
;
PMTXT W !!,"Caution: DELETION of a PM work order at this point will remove the PM",!," from the Equipment History. The DELETE WORK ORDER option in the PM module",!," does not have this effect."
R !!,"<cr> to continue, '^' to abort, '?' for help ",R:DTIME Q:R'="?"
W !!,"If you intend to delete this work order AND remove its corresponding entry",!,"in the Equipment History, this is the way to do it."
W !!,"If you simply want to edit the work order, this is the way to do that too."
W !!,"If, however, you wish to delete the work order without removing the PM itself",!,"from the Equipment History, then you should enter caret keys ('^') to abort"
W !,"and jump to DELETE PM WORK ORDER." G PMTXT
;
DELHS ;DELETE W.O. FROM EQUIPMENT HISTORY (non-interactive)
; Called by 'AD' MUMPS x-ref on STATUS field in WORK ORDER file for
; disapproved work orders
; input
; DA = ien of work order
Q:'$G(DA)
N END,ENINV,ENWO,ENZ
S ENINV=$P($G(^ENG(6920,DA,3)),U,8)
Q:'ENINV ; no equipment pointer
S ENWO=$P($G(^ENG(6920,DA,0)),U)
; loop thru equipment history to find and delete w.o. ENWO
S (END,ENZ)=0 F S ENZ=$O(^ENG(6914,ENINV,6,ENZ)) Q:'ENZ D Q:END
. Q:$P($G(^ENG(6914,ENINV,6,ENZ,0)),U,2)'=ENWO ; different w.o. #
. ; found work order to be deleted
. K ^ENG(6914,ENINV,6,ENZ,0)
. S $P(^ENG(6914,ENINV,6,0),U,4)=$P(^ENG(6914,ENINV,6,0),U,4)-1
. S END=1 ; stop loop
Q
;ENEQHS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQHS 4192 printed Apr 09, 2024@20:58:13 Page 2
ENEQHS ;(WIRMFO)/JED/DH-POST REPAIR TO EQUIPMENT HISTORY ;5/11/2000
+1 ;;7.0;ENGINEERING;**35,42,48,59,65**;Aug 17, 1993
W ;W.O. HISTORY-ENTRY FROM COMP1^ENWOCOMP
+1 ; EXPECTING W.O. VARIABLES U,DA,ENTEC & ENINV
+2 ; where DA => IEN of work order file
+3 ; ENINV => IEN of equipment file
+4 if $DATA(DIU(0))
QUIT
+5 NEW ENACTN,ENDTCP,ENEMPL,ENWO,ENH,ENHRS,ENLABOR,ENMTL
+6 NEW ENODE,ENVEND,ENSTAT,ENWORK,ENWOX,I,J,J1,K
+7 IF $DATA(^ENG(6920,DA,4))
IF $PIECE(^(4),U,3)=5
QUIT
+8 ; equipment record not found
IF '$DATA(^ENG(6914,ENINV,0))
GOTO EXIT
+9 SET ENEMPL=""
IF ENTEC=""
SET ENEMPL=$SELECT($EXTRACT($PIECE(^ENG(6920,DA,0),U),1,3)="PM-":"STAFF",1:"NO ENTRY")
GOTO W1
+10 IF $DATA(^ENG("EMP",ENTEC,0))
SET ENEMPL=$EXTRACT($PIECE(^(0),U),1,15)
W1 SET ENWO=$PIECE(^ENG(6920,DA,0),U)
FOR K=0:0
SET K=$ORDER(^ENG(6914,ENINV,6,K))
if K'>0
QUIT
SET ENWOX=$PIECE(^ENG(6914,ENINV,6,K,0),U,2)
if ENWOX=ENWO
GOTO EXIT
+1 IF '$DATA(^ENG(6920,DA,5))
SET ENERR="NODE 5 OF W.O. IR #"_DA_" IS GONE!"
GOTO ERR
+2 SET ENODE=^ENG(6920,DA,5)
+3 SET ENDTCP=$PIECE($PIECE(ENODE,U,2),".")
SET ENHRS=$PIECE(ENODE,U,3)
SET ENMTL=$PIECE(ENODE,U,4)
SET ENLABOR=$PIECE(ENODE,U,6)
SET ENSTAT=$PIECE(ENODE,U,8)
SET ENWORK=$PIECE(ENODE,U,7)
+4 SET ENACTN="XX"
+5 IF $DATA(^ENG(6920,DA,8))
Begin DoDot:1
+6 FOR I=0:0
SET I=$ORDER(^ENG(6920,DA,8,I))
if I'>0!($LENGTH(ENACTN)=8)
QUIT
Begin DoDot:2
+7 SET J=$PIECE(^ENG(6920,DA,8,I,0),U)
+8 if '$DATA(^ENG(6920.1,J,0))
QUIT
SET J1=$PIECE(^(0),U,2)
+9 IF ENACTN="XX"
SET ENACTN=""
+10 SET ENACTN=ENACTN_J1
End DoDot:2
End DoDot:1
+11 SET ENVEND=""
IF $DATA(^ENG(6920,DA,4))
SET ENVEND=$PIECE(^(4),U,4)
IF ENVEND]""
SET ENVEND=$PIECE(ENVEND,".",1)
+12 SET ENH=ENDTCP_"-"_ENACTN_U_ENWO_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMTL_U_ENVEND_U_ENEMPL_U_ENWORK
EXT ; post history info (ENH) to equipment (ENINV)
+1 if '$DATA(^ENG(6914,ENINV,0))
QUIT
+2 NEW ENNXL,ENNXT,ENOUT,ENRN,ENW
+3 IF $DATA(^ENG(6914,ENINV,6,0))'>0
SET ^(0)="^6914.02A^0^0"
+4 SET ENW=$PIECE(^ENG(6914,ENINV,6,0),U,1,2)
SET ENNXL=$PIECE(^(0),U,3)
SET ENNXT=$PIECE(^(0),U,4)
+5 ;FOR REVERSE CHRONO, SUBTRACT YYYMMDD, X10 (TO HANDLE SAME DAY WO'S)
+6 SET ENRN=(9999999-ENDTCP)*10
W2 IF $DATA(^ENG(6914,ENINV,6,ENRN,0))>0
SET ENRN=ENRN-1
GOTO W2
+1 if ENNXL<ENRN
SET ENNXL=ENRN
SET ENNXT=ENNXT+1
SET ENOUT=ENW_U_ENNXL_U_ENNXT
+2 LOCK +^ENG(6914,ENINV,6)
SET ^ENG(6914,ENINV,6,0)=ENOUT
SET ^ENG(6914,ENINV,6,ENRN,0)=ENH
LOCK -^ENG(6914,ENINV,6)
EXIT ;
+1 QUIT
+2 ;
ERR WRITE !!,*7,"ABORTING ATTEMPT TO POST INVENTORY WORK HISTORY",!,ENERR
GOTO EXIT
+1 ;
KILLHS ;REMOVE EXISTING HISTORY IF WO IS EDITED; CALLED BY ENWO1,ENWOD,ENWOME
+1 IF $EXTRACT($PIECE(^ENG(6920,DA,0),U,1),1,3)="PM-"
SET R=""
DO PMTXT
if R="^"
QUIT
+2 WRITE !!,*7,"WARNING: you must re-enter the DATE COMPLETE field,",!,"to re-post the device history ... DO THIS LAST!",!!,"<cr> to continue"
READ R:DTIME
+3 SET ENWO=$PIECE(^ENG(6920,DA,0),"^",1)
SET ENINV=$PIECE(^(3),"^",8)
if '$DATA(^ENG(6914,ENINV,6,0))
QUIT
+4 IF ENINV'=""
SET ENZ=0
FOR I=1:1
SET ENZ=$ORDER(^ENG(6914,ENINV,6,ENZ))
if 'ENZ
QUIT
IF $DATA(^ENG(6914,ENINV,6,ENZ,0))
IF $PIECE(^(0),"^",2)=ENWO
KILL ^ENG(6914,ENINV,6,ENZ,0)
SET $PIECE(^ENG(6914,ENINV,6,0),"^",4)=$PIECE(^ENG(6914,ENINV,6,0),"^",4)-1
QUIT
+5 KILL ENZ
+6 QUIT
+7 ;
PMTXT WRITE !!,"Caution: DELETION of a PM work order at this point will remove the PM",!," from the Equipment History. The DELETE WORK ORDER option in the PM module",!," does not have this effect."
+1 READ !!,"<cr> to continue, '^' to abort, '?' for help ",R:DTIME
if R'="?"
QUIT
+2 WRITE !!,"If you intend to delete this work order AND remove its corresponding entry",!,"in the Equipment History, this is the way to do it."
+3 WRITE !!,"If you simply want to edit the work order, this is the way to do that too."
+4 WRITE !!,"If, however, you wish to delete the work order without removing the PM itself",!,"from the Equipment History, then you should enter caret keys ('^') to abort"
+5 WRITE !,"and jump to DELETE PM WORK ORDER."
GOTO PMTXT
+6 ;
DELHS ;DELETE W.O. FROM EQUIPMENT HISTORY (non-interactive)
+1 ; Called by 'AD' MUMPS x-ref on STATUS field in WORK ORDER file for
+2 ; disapproved work orders
+3 ; input
+4 ; DA = ien of work order
+5 if '$GET(DA)
QUIT
+6 NEW END,ENINV,ENWO,ENZ
+7 SET ENINV=$PIECE($GET(^ENG(6920,DA,3)),U,8)
+8 ; no equipment pointer
if 'ENINV
QUIT
+9 SET ENWO=$PIECE($GET(^ENG(6920,DA,0)),U)
+10 ; loop thru equipment history to find and delete w.o. ENWO
+11 SET (END,ENZ)=0
FOR
SET ENZ=$ORDER(^ENG(6914,ENINV,6,ENZ))
if 'ENZ
QUIT
Begin DoDot:1
+12 ; different w.o. #
if $PIECE($GET(^ENG(6914,ENINV,6,ENZ,0)),U,2)'=ENWO
QUIT
+13 ; found work order to be deleted
+14 KILL ^ENG(6914,ENINV,6,ENZ,0)
+15 SET $PIECE(^ENG(6914,ENINV,6,0),U,4)=$PIECE(^ENG(6914,ENINV,6,0),U,4)-1
+16 ; stop loop
SET END=1
End DoDot:1
if END
QUIT
+17 QUIT
+18 ;ENEQHS
