ENETRAN ;(WASH ISC)/DH-Assign Electronic Work Orders ;1.30.97
;;7.0;ENGINEERING;**35**;Aug 17, 1993
EN N IOINLOW,IOINHI D ZIS^ENUTL
S %DT="XT",X="N" D ^%DT X ^DD("DD") S ENDATE=Y
I $D(ENSHKEY),ENSHKEY'>0 K ENSHKEY
I $D(ENSHKEY),ENSHKEY#100>89 D GATH2 G EXIT
S:$D(ENSHKEY) ENOLKEY=ENSHKEY K ENSHKEY I $D(^DIC(6910,1,0)),$P(^(0),U,6)]"" S ENSHKEY=$P(^(0),U,6)
E S DIC="^DIC(6922,",DIC(0)="AEQ",DIC("S")="I Y#100>89" D ^DIC K DIC("S") G:Y'>0 EXIT S ENSHKEY=+Y
I $D(ENSHKEY) D GATH2 G EXIT
GATH1 ;
S ENSHKEY=89 F S ENSHKEY=$O(^DIC(6922,ENSHKEY)) Q:ENSHKEY'>0 D:ENSHKEY#100>89 GATH2
G EXIT
GATH2 ;Procss fict shop
K ^TMP($J) S ENCNT=0
S ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1)
; get work orders from incomplete work order x-ref ("AINC")
S ENDX=0
F S ENDX=$O(^ENG(6920,"AINC",ENSHKEY,ENDX)) Q:ENDX'>0 D
. S DA=9999999999-ENDX
. Q:'$D(^ENG(6920,DA,0)) ; missing 0 node
. Q:$P($G(^ENG(6920,DA,5)),U,2)]"" ; closed out
. L +^ENG(6920,DA):1 I '$T Q ; being edited
. ; OK to add on list
. L -^ENG(6920,DA)
. S ENCNT=ENCNT+1,^TMP($J,DA)="" W:'(ENCNT#10) "."
DONE D ^ENETRAN1
Q
;
EXIT K ^TMP($J),ENSHOP,ENDA,ENDATE,ENCNT,ENL,ENWO,ENEWO,ENSHKEY,ENDSTAT,ENLOC,ENDX
K EN,ENPG,ENY,ENTO,ENFR,ENDA,ENPRI,ENMAN,ENCAT,ENEX,ENEX1,ENEX2,ENEX3,ENEX4,ENERN,ENRDT,ENBY,ENDATE,ENNX,ENEWKEY,ENSABR,ENTRAN,ENCODEN,ENCODE,ENCODEI
K I,J,K,X,DIC,DIE,DA,DR,DIWL,DIWR,DIWF
I $D(ENOLKEY) S ENSHKEY=ENOLKEY K ENOLKEY
S:$D(ZTQUEUED) ZTREQ="@"
Q
HLD S X="" W !,"Press RETURN to continue, '^' to escape..." R X:DTIME
Q
;ENETRAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENETRAN 1562 printed Dec 13, 2024@01:53:09 Page 2
ENETRAN ;(WASH ISC)/DH-Assign Electronic Work Orders ;1.30.97
+1 ;;7.0;ENGINEERING;**35**;Aug 17, 1993
EN NEW IOINLOW,IOINHI
DO ZIS^ENUTL
+1 SET %DT="XT"
SET X="N"
DO ^%DT
XECUTE ^DD("DD")
SET ENDATE=Y
+2 IF $DATA(ENSHKEY)
IF ENSHKEY'>0
KILL ENSHKEY
+3 IF $DATA(ENSHKEY)
IF ENSHKEY#100>89
DO GATH2
GOTO EXIT
+4 if $DATA(ENSHKEY)
SET ENOLKEY=ENSHKEY
KILL ENSHKEY
IF $DATA(^DIC(6910,1,0))
IF $PIECE(^(0),U,6)]""
SET ENSHKEY=$PIECE(^(0),U,6)
+5 IF '$TEST
SET DIC="^DIC(6922,"
SET DIC(0)="AEQ"
SET DIC("S")="I Y#100>89"
DO ^DIC
KILL DIC("S")
if Y'>0
GOTO EXIT
SET ENSHKEY=+Y
+6 IF $DATA(ENSHKEY)
DO GATH2
GOTO EXIT
GATH1 ;
+1 SET ENSHKEY=89
FOR
SET ENSHKEY=$ORDER(^DIC(6922,ENSHKEY))
if ENSHKEY'>0
QUIT
if ENSHKEY#100>89
DO GATH2
+2 GOTO EXIT
GATH2 ;Procss fict shop
+1 KILL ^TMP($JOB)
SET ENCNT=0
+2 SET ENSHOP=$PIECE(^DIC(6922,ENSHKEY,0),U,1)
+3 ; get work orders from incomplete work order x-ref ("AINC")
+4 SET ENDX=0
+5 FOR
SET ENDX=$ORDER(^ENG(6920,"AINC",ENSHKEY,ENDX))
if ENDX'>0
QUIT
Begin DoDot:1
+6 SET DA=9999999999-ENDX
+7 ; missing 0 node
if '$DATA(^ENG(6920,DA,0))
QUIT
+8 ; closed out
if $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
QUIT
+9 ; being edited
LOCK +^ENG(6920,DA):1
IF '$TEST
QUIT
+10 ; OK to add on list
+11 LOCK -^ENG(6920,DA)
+12 SET ENCNT=ENCNT+1
SET ^TMP($JOB,DA)=""
if '(ENCNT#10)
WRITE "."
End DoDot:1
DONE DO ^ENETRAN1
+1 QUIT
+2 ;
EXIT KILL ^TMP($JOB),ENSHOP,ENDA,ENDATE,ENCNT,ENL,ENWO,ENEWO,ENSHKEY,ENDSTAT,ENLOC,ENDX
+1 KILL EN,ENPG,ENY,ENTO,ENFR,ENDA,ENPRI,ENMAN,ENCAT,ENEX,ENEX1,ENEX2,ENEX3,ENEX4,ENERN,ENRDT,ENBY,ENDATE,ENNX,ENEWKEY,ENSABR,ENTRAN,ENCODEN,ENCODE,ENCODEI
+2 KILL I,J,K,X,DIC,DIE,DA,DR,DIWL,DIWR,DIWF
+3 IF $DATA(ENOLKEY)
SET ENSHKEY=ENOLKEY
KILL ENOLKEY
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
HLD SET X=""
WRITE !,"Press RETURN to continue, '^' to escape..."
READ X:DTIME
+1 QUIT
+2 ;ENETRAN
