- 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 Feb 18, 2025@23:19:33 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
