- ENWOREP ;WIRMFO/DH,SAB-Reprint Work Orders ;2.24.98
- ;;7.0;ENGINEERING;**15,35,48**;Aug 17, 1993
- EN ; ask section
- S DIC="^DIC(6922,",DIC(0)="AEQM"
- S DIC("A")="For Engineering SECTION: ALL// "
- D ^DIC K DIC G:X="^" EXIT
- I X="" S ENDA="ALL"
- I +Y>0 S ENDA=+Y
- ASKDT ; ask date range
- S %DT="AEXP"
- S %DT("A")="Start DATE: " D ^%DT G:Y'>0 EXIT S ENFR=+Y
- S %DT("B")=$$FMTE^XLFDT(ENFR)
- S %DT("A")="Stop DATE: " D ^%DT G:Y'>0 EXIT S ENTO=+Y
- I ENTO<ENFR W !!,"Stop Date may not preceed Start Date.",*7,! G ASKDT
- S ENFR=$E(ENFR,2,7),ENTO=$E(ENTO,2,7)
- I ENTO<ENFR D G:'Y EXIT
- . S DIR("A",1)="It appears that you are reprinting across a century."
- . S DIR("A")="Is that what you want to do"
- . S DIR(0)="Y",DIR("B")="YES"
- . D ^DIR K DIR
- ;
- S ENBARCD=0
- 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
- ;
- D DEV^ENLIB G:POP EXIT
- I $D(IO("Q")) D G EXIT
- . S ZTDESC="Engineering Work Order Reprint"
- . S ZTRTN=$S(ENDA="ALL":"ENALL^ENWOREP",1:"ENONE^ENWOREP")
- . S ZTSAVE("EN*")=""
- . D ^%ZTLOAD,HOME^%ZIS K ZTSK
- G:ENDA=+ENDA ENONE
- ;
- ENALL U IO
- D:$E(IOST,1,2)'="C-" PSET^%ZISP
- S (ENDA,ENQUIT)=0
- F S ENDA=$O(^DIC(6922,ENDA)) Q:'ENDA!ENQUIT I ENDA#100'>89 D SECT
- D:$E(IOST,1,2)'="C-" PKILL^%ZISP
- D ^%ZISC
- G EXIT
- ;
- ENONE U IO
- D:$E(IOST,1,2)'="C-" PSET^%ZISP
- S ENQUIT=0
- D SECT
- D:$E(IOST,1,2)'="C-" PKILL^%ZISP
- D ^%ZISC
- G EXIT
- ;
- SECT ; reprint work orders for section ENDA
- S ENABR=$P(^DIC(6922,ENDA,0),U,2),ENCC=$L(ENABR)
- ; if entire range within century loop
- I ENTO'<ENFR D DATELP(ENFR,ENTO)
- ; if range crosses century use two ranges to print
- I ENTO<ENFR D DATELP(ENFR,"999999") D:'ENQUIT DATELP("000000",ENTO)
- Q
- ;
- DATELP(ENFR,ENTO) ; date loop for dates within a century
- ; input ENFR and ENTO with format YYMMDD
- S ENWO=ENABR_ENFR,ENDLP=0
- F S ENWO=$O(^ENG(6920,"B",ENWO)) D Q:ENDLP!ENQUIT
- . I ENWO="" S ENDLP=1 Q ; no more work orders
- . I ENABR'=$E(ENWO,1,ENCC)!($E(ENWO,ENCC+1)'?1N) S ENDLP=1 Q ; shop
- . I $E(ENWO,ENCC+1,ENCC+6)>ENTO S ENDLP=1 Q ; after stop date
- . S DA=$O(^ENG(6920,"B",ENWO,0))
- . I $P($G(^ENG(6920,DA,4)),U,3)'>4 D PRT ; only print incomplete w.o.
- Q
- ;
- PRT ; print one work order (DA)
- D ST^ENWOD1,TOP^ENWOD2
- D:ENBARCD BAR^ENWOD
- I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ENQUIT=1 Q
- W @IOF
- I IO'=IO(0),'$D(ZTQUEUED) U IO(0) W "." U IO
- Q
- ;
- EXIT K ENABR,ENCC,ENDA,ENDLP,ENFR,ENTO,ENDSTAT,ENBARCD,ENQUIT,ENWO
- K %DT,DA,DTOUT,DUOUT,DIRUT,DIROUT,I,Y
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;ENWOREP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWOREP 2586 printed Jan 18, 2025@02:57:41 Page 2
- ENWOREP ;WIRMFO/DH,SAB-Reprint Work Orders ;2.24.98
- +1 ;;7.0;ENGINEERING;**15,35,48**;Aug 17, 1993
- EN ; ask section
- +1 SET DIC="^DIC(6922,"
- SET DIC(0)="AEQM"
- +2 SET DIC("A")="For Engineering SECTION: ALL// "
- +3 DO ^DIC
- KILL DIC
- if X="^"
- GOTO EXIT
- +4 IF X=""
- SET ENDA="ALL"
- +5 IF +Y>0
- SET ENDA=+Y
- ASKDT ; ask date range
- +1 SET %DT="AEXP"
- +2 SET %DT("A")="Start DATE: "
- DO ^%DT
- if Y'>0
- GOTO EXIT
- SET ENFR=+Y
- +3 SET %DT("B")=$$FMTE^XLFDT(ENFR)
- +4 SET %DT("A")="Stop DATE: "
- DO ^%DT
- if Y'>0
- GOTO EXIT
- SET ENTO=+Y
- +5 IF ENTO<ENFR
- WRITE !!,"Stop Date may not preceed Start Date.",*7,!
- GOTO ASKDT
- +6 SET ENFR=$EXTRACT(ENFR,2,7)
- SET ENTO=$EXTRACT(ENTO,2,7)
- +7 IF ENTO<ENFR
- Begin DoDot:1
- +8 SET DIR("A",1)="It appears that you are reprinting across a century."
- +9 SET DIR("A")="Is that what you want to do"
- +10 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +11 DO ^DIR
- KILL DIR
- End DoDot:1
- if 'Y
- GOTO EXIT
- +12 ;
- +13 SET ENBARCD=0
- +14 SET I=$ORDER(^ENG(6910.2,"B","PRINT BAR CODES ON W.O.",0))
- IF I>0
- IF $PIECE(^ENG(6910.2,I,0),U,2)="Y"
- SET ENBARCD=1
- +15 ;
- +16 DO DEV^ENLIB
- if POP
- GOTO EXIT
- +17 IF $DATA(IO("Q"))
- Begin DoDot:1
- +18 SET ZTDESC="Engineering Work Order Reprint"
- +19 SET ZTRTN=$SELECT(ENDA="ALL":"ENALL^ENWOREP",1:"ENONE^ENWOREP")
- +20 SET ZTSAVE("EN*")=""
- +21 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- End DoDot:1
- GOTO EXIT
- +22 if ENDA=+ENDA
- GOTO ENONE
- +23 ;
- ENALL USE IO
- +1 if $EXTRACT(IOST,1,2)'="C-"
- DO PSET^%ZISP
- +2 SET (ENDA,ENQUIT)=0
- +3 FOR
- SET ENDA=$ORDER(^DIC(6922,ENDA))
- if 'ENDA!ENQUIT
- QUIT
- IF ENDA#100'>89
- DO SECT
- +4 if $EXTRACT(IOST,1,2)'="C-"
- DO PKILL^%ZISP
- +5 DO ^%ZISC
- +6 GOTO EXIT
- +7 ;
- ENONE USE IO
- +1 if $EXTRACT(IOST,1,2)'="C-"
- DO PSET^%ZISP
- +2 SET ENQUIT=0
- +3 DO SECT
- +4 if $EXTRACT(IOST,1,2)'="C-"
- DO PKILL^%ZISP
- +5 DO ^%ZISC
- +6 GOTO EXIT
- +7 ;
- SECT ; reprint work orders for section ENDA
- +1 SET ENABR=$PIECE(^DIC(6922,ENDA,0),U,2)
- SET ENCC=$LENGTH(ENABR)
- +2 ; if entire range within century loop
- +3 IF ENTO'<ENFR
- DO DATELP(ENFR,ENTO)
- +4 ; if range crosses century use two ranges to print
- +5 IF ENTO<ENFR
- DO DATELP(ENFR,"999999")
- if 'ENQUIT
- DO DATELP("000000",ENTO)
- +6 QUIT
- +7 ;
- DATELP(ENFR,ENTO) ; date loop for dates within a century
- +1 ; input ENFR and ENTO with format YYMMDD
- +2 SET ENWO=ENABR_ENFR
- SET ENDLP=0
- +3 FOR
- SET ENWO=$ORDER(^ENG(6920,"B",ENWO))
- Begin DoDot:1
- +4 ; no more work orders
- IF ENWO=""
- SET ENDLP=1
- QUIT
- +5 ; shop
- IF ENABR'=$EXTRACT(ENWO,1,ENCC)!($EXTRACT(ENWO,ENCC+1)'?1N)
- SET ENDLP=1
- QUIT
- +6 ; after stop date
- IF $EXTRACT(ENWO,ENCC+1,ENCC+6)>ENTO
- SET ENDLP=1
- QUIT
- +7 SET DA=$ORDER(^ENG(6920,"B",ENWO,0))
- +8 ; only print incomplete w.o.
- IF $PIECE($GET(^ENG(6920,DA,4)),U,3)'>4
- DO PRT
- End DoDot:1
- if ENDLP!ENQUIT
- QUIT
- +9 QUIT
- +10 ;
- PRT ; print one work order (DA)
- +1 DO ST^ENWOD1
- DO TOP^ENWOD2
- +2 if ENBARCD
- DO BAR^ENWOD
- +3 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET ENQUIT=1
- QUIT
- +4 WRITE @IOF
- +5 IF IO'=IO(0)
- IF '$DATA(ZTQUEUED)
- USE IO(0)
- WRITE "."
- USE IO
- +6 QUIT
- +7 ;
- EXIT KILL ENABR,ENCC,ENDA,ENDLP,ENFR,ENTO,ENDSTAT,ENBARCD,ENQUIT,ENWO
- +1 KILL %DT,DA,DTOUT,DUOUT,DIRUT,DIROUT,I,Y
- +2 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- +4 ;ENWOREP