source: FOIAVistA/trunk/r/ENGINEERING-EN/ENY2K5.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1ENY2K5 ;(WASH ISC)/DH-Generate Y2K Work Orders ;7.15.99
2 ;;7.0;ENGINEERING;**51,55,59,61**;Aug 17, 1993
3 ; Creates or finds work orders for a specified Y2K worklist
4 ; and then makes calls to print that document
5 ; Global ^TMP($J,"ENY2"... contains sort order and equip entry numbers
6 ;
7 ; ENTECH indicates whether 'sort by tech' is in effect
8 ; TECH => IEN for Engineering Employee file
9 ; (0 => tech is undefined)
10 ; ENEMP => employee name as character string (could be "UNASSIGNED")
11 ;
12PR ; Begin
13 I '$D(^TMP($J,"ENY2")) D Q
14 . W !!,"A Y2K Worklist was requested, but there's nothing to print."
15 . D NOW^%DTC S Y=% X ^DD("DD") W !,?5,"Run time: "_Y
16 . W !,?5,"Shop: "_$S(ENSHKEY("SEL")="ALL":"ALL",1:$P(^DIC(6922,ENSHKEY("SEL"),0),U))
17 . W !,?5,"Estimated Y2K Compliance Date: "_ENY2DT("E")
18 N I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
19 N H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT,SHOP
20 I IOM>93 S HDR="HDR96^ENY2K6",LINE="LN96^ENY2K7"
21 E S HDR="HDR80^ENY2K6",LINE="LN80^ENY2K7"
22 D NOW^%DTC S Y=%,ENDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
23 I HDR="HDR96^ENY2K6" X ^DD("DD") S TIME=$P(Y,":",1,2)
24 S (TECH,ENPG,ENY)=0,ENEXPAND=1
25 U IO S X=""
26 S NODE="^TMP($J,""ENY2"",0)",NODE=$Q(@NODE),SUB=$QL(NODE)
27 S ENSHKEY=0,ENSHKEY(0)=$O(^TMP($J,"ENY2",0)) K ENXP
28 F Q:$G(X)="^" S ENSHKEY=$O(^TMP($J,"ENY2",ENSHKEY)) D:ENSHKEY'=ENSHKEY(0) COMP D:ENSHKEY="" HOLD Q:'ENSHKEY!($G(X)="^") S:ENTECH'=0 ENEMP=$O(^TMP($J,"ENY2",ENSHKEY,"")) S DA=$QS(NODE,SUB),ENHZ=@NODE D PR1
29 I $D(ENXP("LOCK")) W !!,"Abnormal termination. This worklist may be incomplete." H 5
30 D TRLR
31 G OUT ;Design EXIT
32 ;
33PR1 S ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2),ENCODE="Y2-"_ENSHABR_$E(DT,2,5),X=""
34 S ENWO=$O(^ENG(6920,"B",ENCODE_"-9999"),-1)
35 I ENWO'[ENCODE S ENWO=ENCODE_"-001"
36 E S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),$P(ENWO,"-",3)=J
37 ;
38 I ENTECH=0 D Q ;Worklist without RESP TECH
39 . 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
40 ;
41 D EMP ;With RESP TECH (may or may not be sorted by tech)
42 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
43 . I $QS(NODE,4)'=ENEMP S ENEMP=$QS(NODE,4) D EMP,TRLR,@HDR S ENPG(0)=ENPG
44 . S DA=$QS(NODE,SUB),ENHZ=@NODE
45 Q ;Return to design EXIT
46 ;
47PR2 ; need a work order?
48 Q:'$D(^ENG(6914,DA,11)) S ENWOX="",ENWO("P")=$P(^ENG(6914,DA,11),U,8),ENWO("T")=$P(^(11),U,9)
49 I ENWO("T")]"" D
50 . S J=0 F S J=$O(^ENG(6914,DA,6,J)) Q:J'>0 I $P(^ENG(6914,DA,6,J,0),U,2)=ENWO("T") S ENWOX="COMPLETE" Q
51 I ENWOX="COMPLETE" S ^TMP($J,"ENY2","COMP",DA)=ENWO("T") Q ; devices with completed Y2K work orders will not appear on worklist (don't need another work order)
52 I ENWO("P")>0,$D(^ENG(6920,ENWO("P"),0)) S ENWOX=ENWO("T") D Q
53 . I $P($G(^ENG(6920,ENWO("P"),4)),U,3)=5 S ^TMP($J,"ENY2","COMP",DA)=ENWO("T") Q ; wo exists, but is disapproved
54 . D PR3 ; use existing Y2K work order
55 I ENWO("T")]"" S ENWO=ENWO("T") D PR22,PR3 Q
56 D PR22,PR3
57 Q ;back to program segment PR1
58 ;
59PR22 ; must create a new work order from the top
60 ; ENWO as set in line PR1+1 or from ENWO("T")
61 L +^ENG(6920,"B"):20 I '$T S ENXP("LOCK")=1 Q
62 ;
63PR221 I $D(^ENG(6920,"B",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
64 I ENWO("T")="",$D(^ENG(6914,"AL",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
65 S (X,ENWOX)=ENWO
66 ;
67PR222 ; create a work order when you already have the number
68 K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENWO D FILE^DICN S ENNXL=+Y
69 L:ENNXL>0 +^ENG(6920,ENNXL):1
70 L -^ENG(6920,"B")
71 I ENNXL'>0 S ENXP("LOCK")=1 Q
72 S $P(^ENG(6914,DA,11),U,8)=ENNXL,$P(^(11),U,9)=ENWO,^ENG(6914,"AL",ENWO,DA)=""
73 S $P(^ENG(6920,ENNXL,0),U,2)=DT,$P(^(0),U,6)=ENWO,$P(^ENG(6920,ENNXL,3),U,8)=DA,^ENG(6920,"G",DA,ENNXL)="",^ENG(6920,ENNXL,2)=ENSHKEY
74 S X(1)=$O(^ENG(6920.1,"B","Y2K COMPLIANCE",0))
75 I X(1)>0,$D(^ENG(6920.1,X(1),0)) S ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1",^ENG(6920,ENNXL,8,1,0)=X(1)
76 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)=""
77 S $P(^ENG(6920,ENNXL,5),U,7)=$S($P(^ENG(6914,DA,11),U,12)]"":$P(^(11),U,12),1:"YEAR 2000 compliance.") ; work performed
78 I ENTECH=0 D ; ENEMP not included in input global
79 . S TECH=$P(^ENG(6914,DA,11),U,5) S:TECH="" TECH=0 I TECH>0 S:'$D(^ENG("EMP",TECH,0)) TECH=0
80 . S:TECH>0 ENEMP=$P(^ENG("EMP",TECH,0),U)
81 I TECH>0 D ;Set ASSIGNED and RESPONSIBLE TECH
82 . S $P(^ENG(6920,ENNXL,2),U,2)=TECH
83 . S SHOP=$S($P(^ENG(6914,DA,11),U,7)]"":$P(^(11),U,7),$P(^ENG("EMP",TECH,0),U,10)]"":$P(^(0),U,10),1:"")
84 . S ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1",^ENG(6920,ENNXL,7,1,0)=TECH_"^^"_SHOP
85 S ENDA=DA,DA=ENNXL D TEST^ENWOCOMP
86 I ENEXPAND D ST^ENWOINV S DIE="^ENG(6920,",DR="6///^S X=""Year 2000 compliance.""" D ^DIE
87 S DA=ENDA
88 I $P(EN,U,2)]""!($P(EN,U,3)]"") D WOCST
89 L -^ENG(6920,ENNXL)
90 S 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 ;increment in preparation for next hit
91 Q
92 ;
93PR3 ; do the printing
94 I ENY+12>IOSL D TRLR,@HDR Q:$G(X)="^"
95 D @LINE
96 Q
97 ;
98EMP S VACANT=0 I ENEMP=0 S TECH=0 Q
99 S TECH=$O(^ENG("EMP","B",ENEMP,0)) I TECH'>0 S TECH=0 Q
100 I '$D(^ENG("EMP",TECH,0)) S (TECH,ENEMP)=0 Q
101 S:$P(^ENG("EMP",TECH,0),U,7)="V" VACANT=1
102 Q
103 ;
104WOCST Q
105 ;
106HOLD I $G(ENPG(0))>0,ENPG=ENPG(0),ENY'>7 W !!,"There are no incomplete Y2K work orders to print.",!
107 I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue, '^' to escape...",X:DTIME S:'$T X=U
108 Q
109 ;
110TRLR ; Interpret PM STATUS and CONDITION CODE
111 I ENPG,($E(IOST,1,2)'="C-"!($D(IO("S")))) D
112 . F Q:$Y>(IOSL-4) W !
113 . K K S $P(K,"-",(IOM-1))="-" W K K K
114 . W !,"FC=>Y2K compliant NC=>Y2K non-compliant NA=>Not applicable (no Y2K issues)"
115 . W !,"CNL=>Could not locate TI=>Turned-in"
116 Q
117 ;
118COMP ; devices with completed Y2K work orders (exception messages)
119 Q:'$D(^TMP($J,"ENY2","COMP")) ; no exceptions
120 S ENPG=ENPG+1 D HOLD
121 W @IOF,"DEVICES WITH COMPLETED Y2K WORK ORDERS "_ENDATE_" Page "_ENPG
122 W !!,"The following device(s) have a Y2K CATEGORY of CONDITIONALLY COMPLIANT and",!,"yet their Y2K work order(s) are complete. They are not being printed on",!,"this Y2K worklist."
123 W !!,"You should probably use the 'Manual Equipment Selection for Y2K' option to",!,"change their Y2K CATEGORY to COMPLIANT."
124 K X S $P(X,"-",(IOM-2))="-" W !,X,!
125 S DA=0 F S DA=$O(^TMP($J,"ENY2","COMP",DA)) Q:'DA W !,?10,DA,?25,"("_^TMP($J,"ENY2","COMP",DA)_")"
126 K ^TMP($J,"ENY2","COMP")
127 Q
128 ;
129OUT K ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
130 K ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
131 K ^TMP($J)
132 I $E(IOST,1,2)'="C-",'$D(ZTQUEUED) D ^%ZISC
133 D HOME^%ZIS
134 Q
135 ;ENY2K5
Note: See TracBrowser for help on using the repository browser.