source: FOIAVistA/tag/r/ENGINEERING-EN/ENEQHS.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1ENEQHS ;(WIRMFO)/JED/DH-POST REPAIR TO EQUIPMENT HISTORY ;5/11/2000
2 ;;7.0;ENGINEERING;**35,42,48,59,65**;Aug 17, 1993
3W ;W.O. HISTORY-ENTRY FROM COMP1^ENWOCOMP
4 ; EXPECTING W.O. VARIABLES U,DA,ENTEC & ENINV
5 ; where DA => IEN of work order file
6 ; ENINV => IEN of equipment file
7 Q:$D(DIU(0))
8 N ENACTN,ENDTCP,ENEMPL,ENWO,ENH,ENHRS,ENLABOR,ENMTL
9 N ENODE,ENVEND,ENSTAT,ENWORK,ENWOX,I,J,J1,K
10 I $D(^ENG(6920,DA,4)),$P(^(4),U,3)=5 Q
11 I '$D(^ENG(6914,ENINV,0)) G EXIT ; equipment record not found
12 S ENEMPL="" I ENTEC="" S ENEMPL=$S($E($P(^ENG(6920,DA,0),U),1,3)="PM-":"STAFF",1:"NO ENTRY") G W1
13 I $D(^ENG("EMP",ENTEC,0)) S ENEMPL=$E($P(^(0),U),1,15)
14W1 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
15 I '$D(^ENG(6920,DA,5)) S ENERR="NODE 5 OF W.O. IR #"_DA_" IS GONE!" G ERR
16 S ENODE=^ENG(6920,DA,5)
17 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)
18 S ENACTN="XX"
19 I $D(^ENG(6920,DA,8)) D
20 . F I=0:0 S I=$O(^ENG(6920,DA,8,I)) Q:I'>0!($L(ENACTN)=8) D
21 .. S J=$P(^ENG(6920,DA,8,I,0),U)
22 .. Q:'$D(^ENG(6920.1,J,0)) S J1=$P(^(0),U,2)
23 .. I ENACTN="XX" S ENACTN=""
24 .. S ENACTN=ENACTN_J1
25 S ENVEND="" I $D(^ENG(6920,DA,4)) S ENVEND=$P(^(4),U,4) I ENVEND]"" S ENVEND=$P(ENVEND,".",1)
26 S ENH=ENDTCP_"-"_ENACTN_U_ENWO_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMTL_U_ENVEND_U_ENEMPL_U_ENWORK
27EXT ; post history info (ENH) to equipment (ENINV)
28 Q:'$D(^ENG(6914,ENINV,0))
29 N ENNXL,ENNXT,ENOUT,ENRN,ENW
30 I $D(^ENG(6914,ENINV,6,0))'>0 S ^(0)="^6914.02A^0^0"
31 S ENW=$P(^ENG(6914,ENINV,6,0),U,1,2),ENNXL=$P(^(0),U,3),ENNXT=$P(^(0),U,4)
32 ;FOR REVERSE CHRONO, SUBTRACT YYYMMDD, X10 (TO HANDLE SAME DAY WO'S)
33 S ENRN=(9999999-ENDTCP)*10
34W2 I $D(^ENG(6914,ENINV,6,ENRN,0))>0 S ENRN=ENRN-1 G W2
35 S:ENNXL<ENRN ENNXL=ENRN S ENNXT=ENNXT+1,ENOUT=ENW_U_ENNXL_U_ENNXT
36 L +^ENG(6914,ENINV,6) S ^ENG(6914,ENINV,6,0)=ENOUT,^ENG(6914,ENINV,6,ENRN,0)=ENH L -^ENG(6914,ENINV,6)
37EXIT ;
38 Q
39 ;
40ERR W !!,*7,"ABORTING ATTEMPT TO POST INVENTORY WORK HISTORY",!,ENERR G EXIT
41 ;
42KILLHS ;REMOVE EXISTING HISTORY IF WO IS EDITED; CALLED BY ENWO1,ENWOD,ENWOME
43 I $E($P(^ENG(6920,DA,0),U,1),1,3)="PM-" S R="" D PMTXT Q:R="^"
44 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
45 S ENWO=$P(^ENG(6920,DA,0),"^",1),ENINV=$P(^(3),"^",8) Q:'$D(^ENG(6914,ENINV,6,0))
46 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
47 K ENZ
48 Q
49 ;
50PMTXT 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."
51 R !!,"<cr> to continue, '^' to abort, '?' for help ",R:DTIME Q:R'="?"
52 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."
53 W !!,"If you simply want to edit the work order, this is the way to do that too."
54 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"
55 W !,"and jump to DELETE PM WORK ORDER." G PMTXT
56 ;
57DELHS ;DELETE W.O. FROM EQUIPMENT HISTORY (non-interactive)
58 ; Called by 'AD' MUMPS x-ref on STATUS field in WORK ORDER file for
59 ; disapproved work orders
60 ; input
61 ; DA = ien of work order
62 Q:'$G(DA)
63 N END,ENINV,ENWO,ENZ
64 S ENINV=$P($G(^ENG(6920,DA,3)),U,8)
65 Q:'ENINV ; no equipment pointer
66 S ENWO=$P($G(^ENG(6920,DA,0)),U)
67 ; loop thru equipment history to find and delete w.o. ENWO
68 S (END,ENZ)=0 F S ENZ=$O(^ENG(6914,ENINV,6,ENZ)) Q:'ENZ D Q:END
69 . Q:$P($G(^ENG(6914,ENINV,6,ENZ,0)),U,2)'=ENWO ; different w.o. #
70 . ; found work order to be deleted
71 . K ^ENG(6914,ENINV,6,ENZ,0)
72 . S $P(^ENG(6914,ENINV,6,0),U,4)=$P(^ENG(6914,ENINV,6,0),U,4)-1
73 . S END=1 ; stop loop
74 Q
75 ;ENEQHS
Note: See TracBrowser for help on using the repository browser.