source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENEQPMS5.m@ 1651

Last change on this file since 1651 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1ENEQPMS5 ;(WASH ISC)/DH-Generate PM Work Orders ;4.10.98
2 ;;7.0;ENGINEERING;**35,42,51**;Aug 17, 1993
3 ; Creates or finds work orders for a specified PM worklist
4 ; and then makes calls to print that document
5 ; Global ^TMP($J,... contains sort order and equip entry numbers
6 ;
7PR ; Begin
8 I '$D(^TMP($J,"ENWL")) W !!,"PM Worklist was requested, but there's nothing to print." Q
9 N I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
10 N H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT
11 S ENLABOR=$P($G(^DIC(6910,1,0)),U,4)
12 I IOM>93 S HDR="HDR96^ENEQPMS6",LINE="LN96^ENEQPMS7"
13 E S HDR="HDR80^ENEQPMS6",LINE="LN80^ENEQPMS7"
14 D NOW^%DTC S Y=%,ENDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
15 I HDR="HDR96^ENEQPMS6" X ^DD("DD") S TIME=$P(Y,":",1,2)
16 S (TECH,ENPG,ENY)=0
17 S ENEXPAND=0 S I=$O(^ENG(6910.2,"B","EXPANDED PM WORK ORDERS",0))
18 I I>0,$P(^ENG(6910.2,I,0),U,2)="Y" S ENEXPAND=1
19 U IO S X=""
20 S NODE="^TMP($J,""ENWL"",0)",NODE=$Q(@NODE),SUB=$QL(NODE)
21 S ENSHKEY=0 K ENXP
22 F Q:$G(X)="^" S ENSHKEY=$O(^TMP($J,"ENWL",ENSHKEY)) D:ENSHKEY="" HOLD Q:'ENSHKEY!($G(X)="^") S:ENTECH'=0 ENEMP=$O(^TMP($J,"ENWL",ENSHKEY,"")) S DA=$QS(NODE,SUB),ENHZ=@NODE D PR1
23 I $D(ENXP("LOCK")) W !!,"Abnormal termination. This worklist may be incomplete." H 5
24 D TRLR
25 G OUT ;Design EXIT
26 ;
27PR1 S ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2),ENCODE="PM-"_ENSHABR_ENPMDT_ENPM,X=""
28 S ENWO=$O(^ENG(6920,"B",ENCODE_"-9999"),-1) S:ENWO'[ENCODE ENWO=ENCODE_"-001"
29 ;
30 I ENTECH=0 D Q ;Worklist without RESP TECH
31 . D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY S DA=$QS(NODE,SUB),ENHZ=@NODE Q:DA'>0
32 ;
33 D EMP ;With RESP TECH (may or may not be sorted by tech)
34 D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY D Q:DA'>0
35 . I $QS(NODE,4)'=ENEMP S ENEMP=$QS(NODE,4) D EMP,TRLR,@HDR S ENPG(0)=ENPG
36 . S DA=$QS(NODE,SUB),ENHZ=@NODE
37 Q ;Return to design EXIT
38 ;
39PR2 S ENHZ(1)=$P(ENHZ,U,2),SE=$P(ENHZ,U,3),MULT=$P(ENHZ,U,4),ENHZ=$P(ENHZ,U)
40 S ENWOX="",X1=0 F S X1=$O(^ENG(6920,"G",DA,X1)) Q:X1'>0 I $P($G(^ENG(6920,X1,0)),U)[ENCODE S ENWOX=$P(^(0),U) Q
41 S X1=0 F S X1=$O(^ENG(6914,DA,6,X1)) Q:X1'>0 I $P(^(X1,0),U,2)[ENCODE S ENWOX="*" Q
42 Q:ENWOX="*" ;PM already done
43 G:ENWOX]"" PR3
44 ;
45PR22 ; Must create a new work order
46 L +^ENG(6920,"B"):20 I '$T S ENXP("LOCK")=1 Q
47PR221 I $D(^ENG(6920,"B",ENWO))!($D(^ENG(6920,"H",ENWO))) S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),ENWO=$P(ENWO,"-",1,2)_"-"_J G PR221
48 K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENWO D FILE^DICN S ENNXL=+Y
49 L:ENNXL>0 +^ENG(6920,ENNXL):1
50 L -^ENG(6920,"B")
51 I ENNXL'>0 S ENXP("LOCK")=1 Q
52 S $P(^ENG(6920,ENNXL,0),U,2)=DT,$P(^ENG(6920,ENNXL,3),U,8)=DA,^ENG(6920,"G",DA,ENNXL)="",^ENG(6920,ENNXL,2)=ENSHKEY
53 S X1=$O(^ENG(6920.1,"B","PREVENTIVE MAINTENANCE",0))
54 I X1>0,$D(^ENG(6920.1,X1,0)) S ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1",^ENG(6920,ENNXL,8,1,0)=X1
55 I $D(^ENG(6914,DA,3)) S EN=^(3),ENPMN=$P(EN,U,6),ENLOC=$P(EN,U,5) S:ENPMN]"" $P(^ENG(6920,ENNXL,3),U)=ENPMN,^ENG(6920,"E",ENPMN,ENNXL)="" I ENLOC]"",ENLOC?.N S $P(^ENG(6920,ENNXL,0),U,4)=ENLOC,^ENG(6920,"C",ENLOC,ENNXL)=""
56 S $P(^ENG(6920,ENNXL,5),U,7)=ENHZ(1)_" PMI"
57 S EN=$G(^ENG(6914,DA,4,SE,2,MULT,0)) I EN="" S ENDA=DA,DA=ENNXL,DIK="^ENG(6920," D:$E(^ENG(6920,DA,0),1,3)="PM-" ^DIK K DIK S DA=ENDA Q
58 I $P(EN,U,4)]"" S ENLVL=$P(EN,U,4),$P(^ENG(6920,ENNXL,5),U,7)=$P(^ENG(6920,ENNXL,5),U,7)_" Level "_ENLVL
59 I $P(EN,U,5)]"" S ENPRC=$P(EN,U,5),ENPROC(2)=$S($D(^ENG(6914.2,ENPRC,0)):$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)),1:ENPRC),$P(^ENG(6920,ENNXL,5),U,7)=$P(^ENG(6920,ENNXL,5),U,7)_" "_ENPROC(2)
60 I ENTECH=0 S TECH=$P(^ENG(6914,DA,4,SE,0),U,2) S:TECH="" TECH=0 I TECH>0 S:'$D(^ENG("EMP",TECH,0)) TECH=0
61 S:TECH=0 ENEMP=0
62 I TECH>0 D ;Set ASSIGNED and RESPONSIBLE TECH
63 . S $P(^ENG(6920,ENNXL,2),U,2)=TECH
64 . S ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1",^ENG(6920,ENNXL,7,1,0)=TECH
65 . S ENEMP=$P(^ENG("EMP",TECH,0),U)
66 S ENDA=DA,DA=ENNXL D TEST^ENWOCOMP
67 I ENEXPAND D ST^ENWOINV S:$D(^ENG(6920,DA,5)) $P(^(1),U,2)=$P(^(5),U,7)
68 S DA=ENDA
69 I $P(EN,U,2)]""!($P(EN,U,3)]"") D WOCST
70 L -^ENG(6920,ENNXL)
71 S ENWO(1)=ENWO,K=$P(ENWO,"-",3),K=K+1,K=$S($L(K)=1:"00"_K,$L(K)=2:"0"_K,1:K),ENWO=$P(ENWO,"-",1,2)_"-"_K
72PR3 ;
73 S:ENWOX="" ENWOX=ENWO(1) I ENY+11>IOSL D TRLR,@HDR Q:X="^"
74 D @LINE
75 Q
76 ;
77EMP S VACANT=0 I ENEMP=0 S TECH=0 Q
78 S TECH=$O(^ENG("EMP","B",ENEMP,0)) I TECH'>0 S TECH=0 Q
79 I '$D(^ENG("EMP",TECH,0)) S (TECH,ENEMP)=0 Q
80 S:$P(^ENG("EMP",TECH,0),U,7)="V" VACANT=1
81 Q
82 ;
83WOCST S W="" I $G(TECH)>0,$D(^ENG("EMP",TECH,0)) S W=$P(^(0),U,3)
84 S:W="" W=ENLABOR
85 S H=$P(EN,U,2) I $D(^ENG(6920,ENNXL,7,0)) S $P(^ENG(6920,ENNXL,7,1,0),U,2,3)=H_"^"_ENSHKEY
86 I H>0 S $P(^ENG(6920,ENNXL,5),U,3)=H I W>0 S $P(^(5),U,6)=$J(H*W,0,2) ;Labor cost (est.)
87 S $P(^ENG(6920,ENNXL,5),U,4)=$P(EN,U,3) ;Material cost (est.)
88 Q
89 ;
90HOLD I $G(ENPG(0))>0,ENPG=ENPG(0),ENY'>7 W !!,"There are no incomplete PM work orders to print.",!
91 I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue, '^' to escape...",X:DTIME S:'$T X=U
92 Q
93 ;
94TRLR ; Interpret PM STATUS and CONDITION CODE
95 I ENPG,($E(IOST,1,2)'="C-"!($D(IO("S")))) D
96 . F Q:$Y>(IOSL-6) W !
97 . W "STATUS: P=>Pass C=>Corrective action D0=>Deferred D1=>Could not locate"
98 . W !," D2=>In use D3=>Out of service CONDITION: LN=>Like new G=>Good P=>Poor"
99 . W !,"Y2K: FC=>Fully compl NC=>Non-compl CC=>Conditionally compl NA=>Not appl"
100 . W !,"Techs may circle STATUS and/or CONDITION. Y2K CATEGORY is information only."
101 Q
102 ;
103OUT K ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
104 K ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
105 K ^TMP($J)
106 I $E(IOST,1,2)="P-",'$D(ZTQUEUED) D ^%ZISC
107 Q
108 ;ENEQPMS5
Note: See TracBrowser for help on using the repository browser.