source: FOIAVistA/trunk/r/ENGINEERING-EN/ENY2KR1.m@ 1458

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1ENY2KR1 ;(WASH ISC)/DH-Rapid Y2K Close Out ;6.16.98
2 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
3CAT ; rapid closeout by equipment category
4 N CAT,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
5 S CRITER="SKIP"
6 D CAT1^ENY2K ; get a range of work orders (by equipment id)
7 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
8 S SORT=$E(CAT,1,20)
9 D Y2KWO,PROCS
10 G EXIT
11 ;
12CSN ; rapid closeout by category stock number
13 N CSN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
14 S CRITER="SKIP"
15 D CSN1^ENY2K ; get a range of work orders (by equipment id)
16 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
17 S SORT=$E(CSN,1,20)
18 D Y2KWO,PROCS
19 G EXIT
20 ;
21MEN ; rapid closeout by manufacturer equipment name (trade name)
22 ; menu option disabled at request of TAG
23 N MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
24 S CRITER="SKIP"
25 D MEN1^ENY2KA ; get a range of work orders (by equipment id)
26 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
27 S SORT=$E(MEN,1,20)
28 D Y2KWO,PROCS
29 G EXIT
30 ;
31MFG ; rapid closeout by manufacturer
32 N MFG,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
33 S CRITER="SKIP"
34 D MFG1^ENY2K ; get a range of work orders (by equipment id)
35 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
36 S SORT=$E(MFG,1,20)
37 D Y2KWO,PROCS
38 G EXIT
39 ;
40LOC ; rapid closeout by range of local identifiers
41 N LOC,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,END,WO,CRITER
42 S CRITER="SKIP"
43 D LOC1^ENY2K9 ; get a range of work orders (by equipment id)
44 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
45 S SORT=$E(LOC,1,10)_"-"_$E(END,1,10)
46 D Y2KWO,PROCS
47 G EXIT
48 ;
49MOD ; rapid closeout by manufacturer and model
50 N MFG,MOD,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
51 S CRITER="SKIP"
52 D MOD1^ENY2K ; get a range of work orders (by equipment id)
53 Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
54 S SORT=$E(MFG,1,12)_"/"_$E(MOD,1,12)
55 D Y2KWO,PROCS
56 G EXIT
57 ;
58Y2KWO ; check for open Y2K work orders
59 S DA=0,COUNT("Y2KWO")=0 F S DA=$O(^TMP($J,DA)) Q:'DA D
60 . S WO=$P($G(^ENG(6914,DA,11)),U,8) Q:WO'>0
61 . I $D(^ENG(6920,WO,0)),$P($G(^(5)),U,2)="" S ^TMP($J,"Y2KWO",DA)="",^TMP($J,"Y2KWO_LIST",$P(^ENG(6920,WO,0),U),DA)="",COUNT("Y2KWO")=COUNT("Y2KWO")+1
62 Q
63 ;
64PROCS ; close the Y2K work orders
65 I '$D(^TMP($J,"Y2KWO")) W !!,"None of the selected equipment entries have open Y2K work orders.",!,"Data base unchanged." G EXIT
66 W !!,COUNT("Y2KWO")_" of the selected equipment records have open Y2K work orders which",!,"may now be closed."
67 W !!,"First we'll print a list of the open Y2K work orders."
68 N PAGE
69 D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2)
70 W ! S %ZIS="" D ^%ZIS G:POP EXIT S PAGE=0
71 U IO
72 D HDR S (WO,DA)="" F S WO=$O(^TMP($J,"Y2KWO_LIST",WO)) Q:WO="" S DA=$O(^(WO,0)) D:DA>0 Q:$G(ESCAPE)
73 . I (IOSL-$Y)'>2 D HOLD,HDR
74 . W !,WO,?34,$J(DA,10)
75 I IO=IO(0) D HOLD G:$G(ESCAPE) EXIT
76 I IO'=IO(0) D ^%ZISC G:$G(ESCAPE) EXIT
77 W @IOF,!,"Rapid Close Out of Y2K work orders will automatically place the affected",!,"equipment in a Y2K CATEGORY of 'FULLY COMPLIANT'."
78 W !!,"It is assumed that you have reviewed the list of open Y2K work orders just",!,"printed. You will have an opportunity to remove individual work orders from"
79 W !,"this closeout list by specifying their equipment entry numbers."
80 W !!,"If any of these equipment entries have been erroneously classified as",!,"'CONDITIONALLY COMPLIANT', then you should remove them from the closeout list."
81 W !!,"You should then use the 'Delete Y2K Work Orders' option [ENY2K_DEL] to delete",!,"the work orders instead of closing them. Finally, you should use the 'Manual"
82 W !,"Equipment Selection for Y2K' option [ENY2KIND], which is under 'Y2K Data Entry'",!,"[ENY2K_ENTRY], to enter correct Y2K information for the subject equipment."
83 W !!,"Please enter any equipment entry numbers that should be removed from the",!,"closeout list:"
84 W ! S COUNT("Y2KWO","REMOVE")=0 F D GETEQ^ENUTL Q:Y'>0 D
85 . I $D(^TMP($J,"Y2KWO",+Y)) K ^(+Y) S COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO","REMOVE")+1
86 I COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO") W !!,"There's nothing left to close out. Data base unchanged." G EXIT
87 W !!,COUNT("Y2KWO")-COUNT("Y2KWO","REMOVE")_" Y2K work orders are about to be closed out. Are you sure that",!,"you want to proceed?"
88 S DIR(0)="Y",DIR("B")="YES"
89 D ^DIR K DIR I $D(DIRUT)!('Y) G EXIT
90 ;
91PROCD D FIRST Q:$G(ESCAPE) ; EQDA now set to first ^TMP($J,"Y2KWO" node
92 S COUNT=1,COUNT("LOCK")=0 F S EQDA=$O(^TMP($J,"Y2KWO",EQDA)) Q:'EQDA D SUBSQNT
93 W !,COUNT_" Y2K work orders were closed."
94 I COUNT("LOCK") D
95 . W !,"Work orders for the following "_COUNT("LOCK")_" equipment records could not be",!,"locked and were, therefore, not processed:"
96 . S EQDA=0 F S EQDA=$O(^TMP($J,"LOCK",EQDA)) Q:'EQDA D Q:$G(ESCAPE)
97 .. I (IOSL-$Y)'>2 D HOLD Q:$G(ESCAPE) W @IOF
98 .. W !,?10,EQDA
99 Q
100 ;
101FIRST ; close out first Y2K work order
102 S EQDA=$O(^TMP($J,"Y2KWO",0)),DA=$P(^ENG(6914,EQDA,11),U,8) I DA>0,'$D(^ENG(6920,DA,0)) S DA=""
103 I DA'>0 F S EQDA=$O(^TMP($J,"Y2KWO",EQDA)) Q:'EQDA S DA=$P(^ENG(6914,EQDA,11),U,8) I DA>0,$D(^ENG(6920,DA,0)) D Q:DA>0
104 . I $P($G(^ENG(6920,DA,5)),U,2)]"" S DA="" Q ; completed work order
105 . L +^ENG(6920,DA):1 I '$T S ^TMP($J,"LOCK",EQDA)="",COUNT("LOCK")=COUNT("LOCK")+1 S DA=""
106 I DA'>0 W !!,"There are no open Y2K work orders that can be closed. Data base unchanged." S ESCAPE=1 Q ;nothing to do
107 W !!,"You will be prompted to close the first Y2K work order manually, after which",!,"the system will take care of the others automatically."
108 W !!,"EQUIPMENT ID#: "_EQDA_" "_SORT_" "_$E($$GET1^DIQ(6914,EQDA,1),1,20)_" "_$E($$GET1^DIQ(6914,EQDA,4),1,20)
109 S Y2DA=DA
110 S DIE="^ENG(6920,",DR=$S($D(^DIE("B","ENZY2CLOSE")):"[ENZY2CLOSE]",1:"[ENY2CLOSE]")
111 D ^DIE I $P($G(^ENG(6920,DA,5)),U,2)="" W !,"The work order was not closed out. Terminating the option." D HOLD L -^ENG(6920,DA) S ESCAPE=1 Q
112 S X=$G(^ENG(6920,DA,5)),ENY2K("WORK")=$P(X,U,7),ENY2K("HOURS")=$P(X,U,3)
113 S ENY2K("PRIM")=$P($G(^ENG(6920,DA,2)),U,2)
114 S DATE=$P(^ENG(6920,DA,5),U,2),COST("L")=$P(^(5),U,6),COST("M")=$P(^(5),U,4),COST("V")=$P($G(^(4)),U,4)
115 S Y=DATE D DD^%DT S DATE("E")=Y
116 S COST=COST("L")+COST("M")+COST("V")
117 S DA=EQDA,DIE="^ENG(6914,",DR="71///^S X=""FC"";72.1///^S X=DATE;74///^S X=COST" D ^DIE
118 Q
119 ;
120SUBSQNT ; finish the list
121 S DA=$P(^ENG(6914,EQDA,11),U,8) Q:DA'>0 Q:'$D(^ENG(6920,DA,0))
122 Q:$P($G(^ENG(6920,DA,5)),U,2)]"" ; completed work order
123 L +^ENG(6920,DA):1 I '$T S ^TMP($J,"LOCK",EQDA)="" Q
124 S ENY2WO=$P(^ENG(6920,DA,0),U),COUNT=COUNT+1
125 S DIE="^ENG(6920,",%X="^ENG(6920,"_Y2DA_",7,",%Y="^ENG(6920,"_DA_",7," D %XY^%RCR ;assigned techs
126 S %X="^ENG(6920,"_Y2DA_",8,",%Y="^ENG(6920,"_DA_",8," D %XY^%RCR ;work actions
127 S DR="39///^S X=ENY2K(""WORK"");16///^S X=ENY2K(""PRIM"");37.5///^S X=COST(""L"");38///^S X=COST(""M"");47///^S X=COST(""V"");37///^S X=ENY2K(""HOURS"");36///^S X=DATE(""E"");32///^S X=""COMPLETED"""
128 D ^DIE
129 S DIE="^ENG(6914,",DA=EQDA,DR="71///^S X=""FC"";72.1///^S X=DATE(""E"");74///^S X=COST"
130 D ^DIE
131 Q
132 ;
133HDR ; header for Y2K work order list
134 W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1
135 W "Y2K Work Orders Now Subject to Rapid Closeout "_DATE("PRNT")_" Page: "_PAGE
136 W !,"Work Order Number",?25,"Equipment Entry Number"
137 K X S $P(X,"-",79)="-" W !,X
138 Q
139 ;
140HOLD I $E(IOST,1,2)="C-" R !,"<cr> to continue, '^' to quit...",X:DTIME S:X="^" ESCAPE=1
141 Q
142 ;
143EXIT K ^TMP($J)
144 K ENY2WO,EQDA
145 Q
146 ;ENY2KR1
Note: See TracBrowser for help on using the repository browser.