[613] | 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
|
---|