1 | ENWOREP ;WIRMFO/DH,SAB-Reprint Work Orders ;2.24.98
|
---|
2 | ;;7.0;ENGINEERING;**15,35,48**;Aug 17, 1993
|
---|
3 | EN ; ask section
|
---|
4 | S DIC="^DIC(6922,",DIC(0)="AEQM"
|
---|
5 | S DIC("A")="For Engineering SECTION: ALL// "
|
---|
6 | D ^DIC K DIC G:X="^" EXIT
|
---|
7 | I X="" S ENDA="ALL"
|
---|
8 | I +Y>0 S ENDA=+Y
|
---|
9 | ASKDT ; ask date range
|
---|
10 | S %DT="AEXP"
|
---|
11 | S %DT("A")="Start DATE: " D ^%DT G:Y'>0 EXIT S ENFR=+Y
|
---|
12 | S %DT("B")=$$FMTE^XLFDT(ENFR)
|
---|
13 | S %DT("A")="Stop DATE: " D ^%DT G:Y'>0 EXIT S ENTO=+Y
|
---|
14 | I ENTO<ENFR W !!,"Stop Date may not preceed Start Date.",*7,! G ASKDT
|
---|
15 | S ENFR=$E(ENFR,2,7),ENTO=$E(ENTO,2,7)
|
---|
16 | I ENTO<ENFR D G:'Y EXIT
|
---|
17 | . S DIR("A",1)="It appears that you are reprinting across a century."
|
---|
18 | . S DIR("A")="Is that what you want to do"
|
---|
19 | . S DIR(0)="Y",DIR("B")="YES"
|
---|
20 | . D ^DIR K DIR
|
---|
21 | ;
|
---|
22 | S ENBARCD=0
|
---|
23 | S I=$O(^ENG(6910.2,"B","PRINT BAR CODES ON W.O.",0)) I I>0,$P(^ENG(6910.2,I,0),U,2)="Y" S ENBARCD=1
|
---|
24 | ;
|
---|
25 | D DEV^ENLIB G:POP EXIT
|
---|
26 | I $D(IO("Q")) D G EXIT
|
---|
27 | . S ZTDESC="Engineering Work Order Reprint"
|
---|
28 | . S ZTRTN=$S(ENDA="ALL":"ENALL^ENWOREP",1:"ENONE^ENWOREP")
|
---|
29 | . S ZTSAVE("EN*")=""
|
---|
30 | . D ^%ZTLOAD,HOME^%ZIS K ZTSK
|
---|
31 | G:ENDA=+ENDA ENONE
|
---|
32 | ;
|
---|
33 | ENALL U IO
|
---|
34 | D:$E(IOST,1,2)'="C-" PSET^%ZISP
|
---|
35 | S (ENDA,ENQUIT)=0
|
---|
36 | F S ENDA=$O(^DIC(6922,ENDA)) Q:'ENDA!ENQUIT I ENDA#100'>89 D SECT
|
---|
37 | D:$E(IOST,1,2)'="C-" PKILL^%ZISP
|
---|
38 | D ^%ZISC
|
---|
39 | G EXIT
|
---|
40 | ;
|
---|
41 | ENONE U IO
|
---|
42 | D:$E(IOST,1,2)'="C-" PSET^%ZISP
|
---|
43 | S ENQUIT=0
|
---|
44 | D SECT
|
---|
45 | D:$E(IOST,1,2)'="C-" PKILL^%ZISP
|
---|
46 | D ^%ZISC
|
---|
47 | G EXIT
|
---|
48 | ;
|
---|
49 | SECT ; reprint work orders for section ENDA
|
---|
50 | S ENABR=$P(^DIC(6922,ENDA,0),U,2),ENCC=$L(ENABR)
|
---|
51 | ; if entire range within century loop
|
---|
52 | I ENTO'<ENFR D DATELP(ENFR,ENTO)
|
---|
53 | ; if range crosses century use two ranges to print
|
---|
54 | I ENTO<ENFR D DATELP(ENFR,"999999") D:'ENQUIT DATELP("000000",ENTO)
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | DATELP(ENFR,ENTO) ; date loop for dates within a century
|
---|
58 | ; input ENFR and ENTO with format YYMMDD
|
---|
59 | S ENWO=ENABR_ENFR,ENDLP=0
|
---|
60 | F S ENWO=$O(^ENG(6920,"B",ENWO)) D Q:ENDLP!ENQUIT
|
---|
61 | . I ENWO="" S ENDLP=1 Q ; no more work orders
|
---|
62 | . I ENABR'=$E(ENWO,1,ENCC)!($E(ENWO,ENCC+1)'?1N) S ENDLP=1 Q ; shop
|
---|
63 | . I $E(ENWO,ENCC+1,ENCC+6)>ENTO S ENDLP=1 Q ; after stop date
|
---|
64 | . S DA=$O(^ENG(6920,"B",ENWO,0))
|
---|
65 | . I $P($G(^ENG(6920,DA,4)),U,3)'>4 D PRT ; only print incomplete w.o.
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | PRT ; print one work order (DA)
|
---|
69 | D ST^ENWOD1,TOP^ENWOD2
|
---|
70 | D:ENBARCD BAR^ENWOD
|
---|
71 | I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ENQUIT=1 Q
|
---|
72 | W @IOF
|
---|
73 | I IO'=IO(0),'$D(ZTQUEUED) U IO(0) W "." U IO
|
---|
74 | Q
|
---|
75 | ;
|
---|
76 | EXIT K ENABR,ENCC,ENDA,ENDLP,ENFR,ENTO,ENDSTAT,ENBARCD,ENQUIT,ENWO
|
---|
77 | K %DT,DA,DTOUT,DUOUT,DIRUT,DIROUT,I,Y
|
---|
78 | S:$D(ZTQUEUED) ZTREQ="@"
|
---|
79 | Q
|
---|
80 | ;ENWOREP
|
---|