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 Dec 13, 2024@01:56:29 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
