source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENWOREP.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1ENWOREP ;WIRMFO/DH,SAB-Reprint Work Orders ;2.24.98
2 ;;7.0;ENGINEERING;**15,35,48**;Aug 17, 1993
3EN ; 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
9ASKDT ; 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 ;
33ENALL 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 ;
41ENONE 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 ;
49SECT ; 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 ;
57DATELP(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 ;
68PRT ; 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 ;
76EXIT 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
Note: See TracBrowser for help on using the repository browser.