source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENWONEW.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1ENWONEW ;(WASH ISC)/DH-Work Order Entry ;8.28.97
2 ;;7.0;ENGINEERING;**1,35,42,43**;Aug 17, 1993
3WARD ; Entry point for Electronic Work Requests
4 N SHOPKEY,CODE,NUMBER,DONE,WARD,DA,DIC,DIE,DR
5 S U="^",DONE=0,WARD=1
6 I $D(^DIC(6910,1,0)),$P(^(0),U,6)]"" S SHOPKEY=$P(^(0),U,6)
7 E S DIC="^DIC(6922,",DIC(0)="AEQ",DIC("S")="I Y#100>89" D ^DIC K DIC("S") S:Y>0 SHOPKEY=+Y
8 Q:'$D(SHOPKEY)
9 S DR=$S($D(^DIE("B","ENZWOWARD")):"[ENZWOWARD]",1:"[ENWOWARD]")
10 D PROCS
11 K ENBARCD
12 Q
13 ;
14ENG ; Entry point for Work Orders to be entered by Facility Management
15 N CODE,NUMBER,DONE,WARD,SHOPKEY,ENDONE,DA,DIC,DIE,DR
16 S U="^",(DONE,WARD)=0 S:$D(ENSHKEY) SHOPKEY=ENSHKEY
17 I '$D(SHOPKEY) S DIC="^DIC(6922,",DIC(0)="AEQ" D ^DIC S:Y>0 SHOPKEY=+Y
18 Q:'$D(SHOPKEY)
19 S DR=$S($D(^DIE("B","ENZWONEW")):"[ENZWONEW]",1:"[ENWONEW]")
20 D PROCS
21 K ENBARCD
22 Q
23 ;
24PROCS ;Main process (work order entry)
25 N ENDA F D Q:DONE
26 . W !!,"Want to enter a new work order?"
27 . S DIR(0)="Y",DIR("B")=$S($D(CODE):"NO",1:"YES")
28 . D ^DIR K DIR I Y'>0 S DONE=1 Q
29 . S NUMBER="" D WONUM W:NUMBER]"" !,"WORK ORDER #: ",NUMBER
30 . I NUMBER="" S DONE=1 D
31 .. W !!,*7,"Can't seem to add to Work Order File."
32 .. W !,"Please try again later or contact IRM Service."
33 . Q:NUMBER=""
34 . S ENDA=DA L +^ENG(6920,ENDA)
35 . D WOFILL,WOEDIT D:NUMBER'="" WOPRNT L -^ENG(6920,ENDA)
36 Q
37 ;
38WONUM ;Find next sequence number & use it
39 ;Work order # returned in NUMBER, null if unsuccessful
40 I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y
41 Q:SHOPKEY'>0 I '$D(^DIC(6922,SHOPKEY,0)) Q
42 S CODE=$P(^DIC(6922,SHOPKEY,0),U,2)_$E(DT,2,7)_"-"
43 L +^ENG(6920,"B"):20 Q:'$T
44 F I=1:1 S X=CODE_$S(I<10:"00"_I,I<100:"0"_I,1:I) I '$D(^ENG(6920,"B",X)),'$D(^ENG(6920,"H",X)) S NUMBER=X Q
45 K DD,DO S DIC="^ENG(6920,",DIC(0)="LX" D FILE^DICN S DA=+Y S:DA'>0 NUMBER=""
46 L -^ENG(6920,"B")
47 Q
48 ;
49WOFILL ;Fill in known fields
50 N DR
51 S DIE="^ENG(6920,",DR="1///N;.05///"_NUMBER_";7.5////"_DUZ_";9///"_SHOPKEY
52 D ^DIE
53 Q:'WARD
54 S DR="2///C;7///"_$E($P(^VA(200,DUZ,0),U),1,15)
55 I $D(^VA(200,DUZ,.13)),$P(^(.13),U,2)]"" S DR=DR_";8///"_$P(^(.13),U,2)
56 D ^DIE
57 Q
58 ;
59WOEDIT ;Edit newly created work order (if desired)
60 D ^DIE
61 I $D(DTOUT) W !," FileMan has timed out due to inactivity. Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK,DTOUT S NUMBER="" Q
62 I '$D(^ENG(6920,DA,1)) W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
63 I $P(^ENG(6920,DA,1),U,2)="" W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
64 I 'WARD D Q:ENDONE
65 . W !!,"Do you want to CLOSE this work order now?"
66 . S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
67 . S ENDONE=$S(Y'>0:0,1:1)
68 . I ENDONE D Q
69 .. N DR
70 .. S DR=$S($D(^DIE("B","ENZWONEWCLOSE")):"[ENZWONEWCLOSE]",1:"[ENWONEWCLOSE]")
71 .. D ^DIE
72 W !!,"Edit this new work order?"
73 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR Q:Y'>0
74 I WARD D ^DIE Q
75 D EDIT1^ENWOD
76 Q
77 ;
78WOPRNT ;Print new work order (if desired)
79 N AUTOPRT,DEVICE
80 I $D(^ENG(6910.2,1,0)),$P(^(0),U,2)]"" S:$P(^(0),U,2)'="N" AUTOPRT=$P(^(0),U,2)
81 I '$D(ENBARCD) S ENBARCD=0 I $D(^ENG(6910.2,"B","PRINT BAR CODES ON W.O.")) S I=$O(^("PRINT BAR CODES ON W.O.",0)) I I>0,$P(^ENG(6910.2,I,0),U,2)="Y" S ENBARCD=1
82 I $D(AUTOPRT) D
83 . I AUTOPRT="L" D
84 .. S DEVICE="" D AUTODEV^ENWONEW2
85 .. I DEVICE="" D HOME^%ZIS Q
86 .. I DEVICE="HOME" D Q
87 ... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
88 ... D PRT1^ENWOD
89 ... D HOLD^ENWOD2 K ENWO,ENDSTAT,ENX,ENINV
90 ... D ^%ZISC
91 .. S ZTRTN="PRT1^ENWOD",ZTDESC="Work Order Auto Print (Long)"
92 .. S ZTDTH=$H
93 .. D TASK
94 . I AUTOPRT="S" D
95 .. S DEVICE="" D AUTODEV^ENWONEW2
96 .. I DEVICE="" D HOME^%ZIS Q
97 .. N IOINLOW,IOINHI D ZIS^ENUTL
98 .. I DEVICE="HOME" D Q
99 ... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
100 ... D FDAT4^ENWOP3 D ^%ZISC
101 ... K EN,ENAC,ENDPR,ENEQ,ENLOC,ENPRI,ENRDA,ENRQR
102 ... K ENSTAT,ENTEC,ENWOR,ENY
103 .. S ZTRTN="FDAT4^ENWOP3",ZTDESC="Work Order Auto Print (Short)"
104 .. S ZTDTH=$H
105 .. D TASK
106 I WARD D Q
107 . W !,"Want to print this new work order?"
108 . S DIR(0)="Y",DIR("B")="NO" D ^DIR Q:Y'>0
109 . K IO("Q") S %ZIS="Q" D ^%ZIS I POP D HOME^%ZIS Q
110 . I '$D(IO("Q")) D PRT1^ENEWOD Q
111 . D
112 .. S ZTRTN="PRT1^ENEWOD",ZTDESC="Electronic Work Order"
113 .. D TASK
114 .. K IO("Q")
115 I '$D(AUTOPRT) D
116 . W !,"Print this work order?"
117 . S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'>0
118 . D DEV^ENLIB I POP D HOME^%ZIS Q
119 . I '$D(IO("Q")) D PRT1^ENWOD Q
120 . D
121 .. S ZTRTN="PRT1^ENWOD",ZTDESC="Engineering Work Order"
122 .. D TASK
123 .. K IO("Q")
124 Q
125 ;
126TASK ;Print work order in background
127 S ZTIO=ION,ZTSAVE("DA")="",ZTSAVE("EN*")=""
128 D ^%ZTLOAD K ZTSK,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE D HOME^%ZIS
129 Q
130 ;ENWONEW
Note: See TracBrowser for help on using the repository browser.