Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENWOREP

ENWOREP.m

Go to the documentation of this file.
  1. ENWOREP ;WIRMFO/DH,SAB-Reprint Work Orders ;2.24.98
  1. ;;7.0;ENGINEERING;**15,35,48**;Aug 17, 1993
  1. EN ; ask section
  1. S DIC="^DIC(6922,",DIC(0)="AEQM"
  1. S DIC("A")="For Engineering SECTION: ALL// "
  1. D ^DIC K DIC G:X="^" EXIT
  1. I X="" S ENDA="ALL"
  1. I +Y>0 S ENDA=+Y
  1. ASKDT ; ask date range
  1. S %DT="AEXP"
  1. S %DT("A")="Start DATE: " D ^%DT G:Y'>0 EXIT S ENFR=+Y
  1. S %DT("B")=$$FMTE^XLFDT(ENFR)
  1. S %DT("A")="Stop DATE: " D ^%DT G:Y'>0 EXIT S ENTO=+Y
  1. I ENTO<ENFR W !!,"Stop Date may not preceed Start Date.",*7,! G ASKDT
  1. S ENFR=$E(ENFR,2,7),ENTO=$E(ENTO,2,7)
  1. I ENTO<ENFR D G:'Y EXIT
  1. . S DIR("A",1)="It appears that you are reprinting across a century."
  1. . S DIR("A")="Is that what you want to do"
  1. . S DIR(0)="Y",DIR("B")="YES"
  1. . D ^DIR K DIR
  1. ;
  1. S ENBARCD=0
  1. 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
  1. ;
  1. D DEV^ENLIB G:POP EXIT
  1. I $D(IO("Q")) D G EXIT
  1. . S ZTDESC="Engineering Work Order Reprint"
  1. . S ZTRTN=$S(ENDA="ALL":"ENALL^ENWOREP",1:"ENONE^ENWOREP")
  1. . S ZTSAVE("EN*")=""
  1. . D ^%ZTLOAD,HOME^%ZIS K ZTSK
  1. G:ENDA=+ENDA ENONE
  1. ;
  1. ENALL U IO
  1. D:$E(IOST,1,2)'="C-" PSET^%ZISP
  1. S (ENDA,ENQUIT)=0
  1. F S ENDA=$O(^DIC(6922,ENDA)) Q:'ENDA!ENQUIT I ENDA#100'>89 D SECT
  1. D:$E(IOST,1,2)'="C-" PKILL^%ZISP
  1. D ^%ZISC
  1. G EXIT
  1. ;
  1. ENONE U IO
  1. D:$E(IOST,1,2)'="C-" PSET^%ZISP
  1. S ENQUIT=0
  1. D SECT
  1. D:$E(IOST,1,2)'="C-" PKILL^%ZISP
  1. D ^%ZISC
  1. G EXIT
  1. ;
  1. SECT ; reprint work orders for section ENDA
  1. S ENABR=$P(^DIC(6922,ENDA,0),U,2),ENCC=$L(ENABR)
  1. ; if entire range within century loop
  1. I ENTO'<ENFR D DATELP(ENFR,ENTO)
  1. ; if range crosses century use two ranges to print
  1. I ENTO<ENFR D DATELP(ENFR,"999999") D:'ENQUIT DATELP("000000",ENTO)
  1. Q
  1. ;
  1. DATELP(ENFR,ENTO) ; date loop for dates within a century
  1. ; input ENFR and ENTO with format YYMMDD
  1. S ENWO=ENABR_ENFR,ENDLP=0
  1. F S ENWO=$O(^ENG(6920,"B",ENWO)) D Q:ENDLP!ENQUIT
  1. . I ENWO="" S ENDLP=1 Q ; no more work orders
  1. . I ENABR'=$E(ENWO,1,ENCC)!($E(ENWO,ENCC+1)'?1N) S ENDLP=1 Q ; shop
  1. . I $E(ENWO,ENCC+1,ENCC+6)>ENTO S ENDLP=1 Q ; after stop date
  1. . S DA=$O(^ENG(6920,"B",ENWO,0))
  1. . I $P($G(^ENG(6920,DA,4)),U,3)'>4 D PRT ; only print incomplete w.o.
  1. Q
  1. ;
  1. PRT ; print one work order (DA)
  1. D ST^ENWOD1,TOP^ENWOD2
  1. D:ENBARCD BAR^ENWOD
  1. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ENQUIT=1 Q
  1. W @IOF
  1. I IO'=IO(0),'$D(ZTQUEUED) U IO(0) W "." U IO
  1. Q
  1. ;
  1. EXIT K ENABR,ENCC,ENDA,ENDLP,ENFR,ENTO,ENDSTAT,ENBARCD,ENQUIT,ENWO
  1. K %DT,DA,DTOUT,DUOUT,DIRUT,DIROUT,I,Y
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;ENWOREP