- 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 Feb 18, 2025@23:18:51 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
