- ENETRAN2 ;(WIRMFO)/DH-Transfer Electronic Work Orders ;5/8/1998
- ;;7.0;ENGINEERING;**35,53**;Aug 17, 1993
- ;Expects DA
- EN S ENXP=1 D D^ENWOD K ENXP W !!,"Ready to transfer ",$P(^ENG(6920,DA,0),U,1) I $D(^(1)) W ?35,$P(^(1),U,2)
- LOCK L +^ENG(6920,DA):5 I '$T W !,*7,"Sorry, this Work Order is being edited by another user. Try later." G ABORT
- S DIC="^DIC(6922,",DIC(0)="AEMQ"
- S DIC("A")="Transfer to shop ('^'to EXIT, '^D' to DISAPPROVE): "
- S DIC("W")="W ?60,Y"
- S:$D(ENEWKEY) DIC("B")=ENEWKEY
- ; set screen to prevent selection of current shop
- I $P($G(^ENG(6920,DA,2)),U)]"" S DIC("S")="I Y'="_$P(^ENG(6920,DA,2),U)
- D ^DIC K DIC("A"),DIC("B"),DIC("S")
- G:X="^D" DISAP G:+Y'>0 ABORT S ENEWKEY=+Y
- GETNO I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
- N CODE,NUMBER
- S CODE=$P(^DIC(6922,ENEWKEY,0),U,2)_$E(DT,2,7)_"-"
- L +^ENG(6920,"B"):20 I '$T W !!,*7,"Can't get a new number." G ABORT
- F I=1:1 S X=CODE_$S(I<10:"00"_I,I<100:"0"_I,1:I) I '$D(^ENG(6920,"B",X)),'$D(^ENG(6920,"H",X)) S NUMBER=X Q
- S DIE="^ENG(6920,",DR="9///"_ENEWKEY_";.01///"_NUMBER_";10///TODAY"
- D ^DIE
- L -^ENG(6920,"B")
- I ENERN'="ALL" K ^TMP($J,"ENEWO",ENERN),^TMP($J,DA) S ENCNT=ENCNT-1
- S DR=$S($D(^DIE("B","ENZWOWARDXFER")):"[ENZ",1:"[EN")_"WOWARDXFER]"
- EDIT W !!,"Edit this work order" S %=1 D YN^DICN G:%<1 EDIT
- I %=1 D ^DIE
- I "^^2^"[(U_$P($G(^ENG(6920,DA,4)),U,3)_U) S DR="32///IN PROGRESS" D ^DIE ; set status to 'in progress' when blank or 'pending' (may result in bulletin)
- PRINT N WARD,SHOPKEY S WARD=0,SHOPKEY=ENEWKEY
- D WOPRNT^ENWONEW
- G EXIT
- ;
- DISAP S DIE="^ENG(6920," D EN1^ENWO2 K ^TMP($J,"ENEWO",ENERN),^TMP($J,DA) S ENCNT=ENCNT-1
- G EXIT
- ;
- ABORT W !,*7,"Transfer aborted."
- W !!,"Press <RETURN> to continue, '^' to escape... " R X:DTIME
- S:$E(X)="^" ENEX4=1
- EXIT ;Return to ENETRAN1
- L -^ENG(6920,DA)
- Q
- ;ENETRAN2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENETRAN2 1844 printed Feb 18, 2025@23:19:35 Page 2
- ENETRAN2 ;(WIRMFO)/DH-Transfer Electronic Work Orders ;5/8/1998
- +1 ;;7.0;ENGINEERING;**35,53**;Aug 17, 1993
- +2 ;Expects DA
- EN SET ENXP=1
- DO D^ENWOD
- KILL ENXP
- WRITE !!,"Ready to transfer ",$PIECE(^ENG(6920,DA,0),U,1)
- IF $DATA(^(1))
- WRITE ?35,$PIECE(^(1),U,2)
- LOCK LOCK +^ENG(6920,DA):5
- IF '$TEST
- WRITE !,*7,"Sorry, this Work Order is being edited by another user. Try later."
- GOTO ABORT
- +1 SET DIC="^DIC(6922,"
- SET DIC(0)="AEMQ"
- +2 SET DIC("A")="Transfer to shop ('^'to EXIT, '^D' to DISAPPROVE): "
- +3 SET DIC("W")="W ?60,Y"
- +4 if $DATA(ENEWKEY)
- SET DIC("B")=ENEWKEY
- +5 ; set screen to prevent selection of current shop
- +6 IF $PIECE($GET(^ENG(6920,DA,2)),U)]""
- SET DIC("S")="I Y'="_$PIECE(^ENG(6920,DA,2),U)
- +7 DO ^DIC
- KILL DIC("A"),DIC("B"),DIC("S")
- +8 if X="^D"
- GOTO DISAP
- if +Y'>0
- GOTO ABORT
- SET ENEWKEY=+Y
- GETNO IF '$DATA(DT)
- SET %DT=""
- SET X="T"
- DO ^%DT
- SET DT=Y
- +1 NEW CODE,NUMBER
- +2 SET CODE=$PIECE(^DIC(6922,ENEWKEY,0),U,2)_$EXTRACT(DT,2,7)_"-"
- +3 LOCK +^ENG(6920,"B"):20
- IF '$TEST
- WRITE !!,*7,"Can't get a new number."
- GOTO ABORT
- +4 FOR I=1:1
- SET X=CODE_$SELECT(I<10:"00"_I,I<100:"0"_I,1:I)
- IF '$DATA(^ENG(6920,"B",X))
- IF '$DATA(^ENG(6920,"H",X))
- SET NUMBER=X
- QUIT
- +5 SET DIE="^ENG(6920,"
- SET DR="9///"_ENEWKEY_";.01///"_NUMBER_";10///TODAY"
- +6 DO ^DIE
- +7 LOCK -^ENG(6920,"B")
- +8 IF ENERN'="ALL"
- KILL ^TMP($JOB,"ENEWO",ENERN),^TMP($JOB,DA)
- SET ENCNT=ENCNT-1
- +9 SET DR=$SELECT($DATA(^DIE("B","ENZWOWARDXFER")):"[ENZ",1:"[EN")_"WOWARDXFER]"
- EDIT WRITE !!,"Edit this work order"
- SET %=1
- DO YN^DICN
- if %<1
- GOTO EDIT
- +1 IF %=1
- DO ^DIE
- +2 ; set status to 'in progress' when blank or 'pending' (may result in bulletin)
- IF "^^2^"[(U_$PIECE($GET(^ENG(6920,DA,4)),U,3)_U)
- SET DR="32///IN PROGRESS"
- DO ^DIE
- PRINT NEW WARD,SHOPKEY
- SET WARD=0
- SET SHOPKEY=ENEWKEY
- +1 DO WOPRNT^ENWONEW
- +2 GOTO EXIT
- +3 ;
- DISAP SET DIE="^ENG(6920,"
- DO EN1^ENWO2
- KILL ^TMP($JOB,"ENEWO",ENERN),^TMP($JOB,DA)
- SET ENCNT=ENCNT-1
- +1 GOTO EXIT
- +2 ;
- ABORT WRITE !,*7,"Transfer aborted."
- +1 WRITE !!,"Press <RETURN> to continue, '^' to escape... "
- READ X:DTIME
- +2 if $EXTRACT(X)="^"
- SET ENEX4=1
- EXIT ;Return to ENETRAN1
- +1 LOCK -^ENG(6920,DA)
- +2 QUIT
- +3 ;ENETRAN2
