[613] | 1 | ENETRAN2 ;(WIRMFO)/DH-Transfer Electronic Work Orders ;5/8/1998
|
---|
| 2 | ;;7.0;ENGINEERING;**35,53**;Aug 17, 1993
|
---|
| 3 | ;Expects DA
|
---|
| 4 | 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)
|
---|
| 5 | LOCK L +^ENG(6920,DA):5 I '$T W !,*7,"Sorry, this Work Order is being edited by another user. Try later." G ABORT
|
---|
| 6 | S DIC="^DIC(6922,",DIC(0)="AEMQ"
|
---|
| 7 | S DIC("A")="Transfer to shop ('^'to EXIT, '^D' to DISAPPROVE): "
|
---|
| 8 | S DIC("W")="W ?60,Y"
|
---|
| 9 | S:$D(ENEWKEY) DIC("B")=ENEWKEY
|
---|
| 10 | ; set screen to prevent selection of current shop
|
---|
| 11 | I $P($G(^ENG(6920,DA,2)),U)]"" S DIC("S")="I Y'="_$P(^ENG(6920,DA,2),U)
|
---|
| 12 | D ^DIC K DIC("A"),DIC("B"),DIC("S")
|
---|
| 13 | G:X="^D" DISAP G:+Y'>0 ABORT S ENEWKEY=+Y
|
---|
| 14 | GETNO I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
|
---|
| 15 | N CODE,NUMBER
|
---|
| 16 | S CODE=$P(^DIC(6922,ENEWKEY,0),U,2)_$E(DT,2,7)_"-"
|
---|
| 17 | L +^ENG(6920,"B"):20 I '$T W !!,*7,"Can't get a new number." G ABORT
|
---|
| 18 | 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
|
---|
| 19 | S DIE="^ENG(6920,",DR="9///"_ENEWKEY_";.01///"_NUMBER_";10///TODAY"
|
---|
| 20 | D ^DIE
|
---|
| 21 | L -^ENG(6920,"B")
|
---|
| 22 | I ENERN'="ALL" K ^TMP($J,"ENEWO",ENERN),^TMP($J,DA) S ENCNT=ENCNT-1
|
---|
| 23 | S DR=$S($D(^DIE("B","ENZWOWARDXFER")):"[ENZ",1:"[EN")_"WOWARDXFER]"
|
---|
| 24 | EDIT W !!,"Edit this work order" S %=1 D YN^DICN G:%<1 EDIT
|
---|
| 25 | I %=1 D ^DIE
|
---|
| 26 | 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)
|
---|
| 27 | PRINT N WARD,SHOPKEY S WARD=0,SHOPKEY=ENEWKEY
|
---|
| 28 | D WOPRNT^ENWONEW
|
---|
| 29 | G EXIT
|
---|
| 30 | ;
|
---|
| 31 | DISAP S DIE="^ENG(6920," D EN1^ENWO2 K ^TMP($J,"ENEWO",ENERN),^TMP($J,DA) S ENCNT=ENCNT-1
|
---|
| 32 | G EXIT
|
---|
| 33 | ;
|
---|
| 34 | ABORT W !,*7,"Transfer aborted."
|
---|
| 35 | W !!,"Press <RETURN> to continue, '^' to escape... " R X:DTIME
|
---|
| 36 | S:$E(X)="^" ENEX4=1
|
---|
| 37 | EXIT ;Return to ENETRAN1
|
---|
| 38 | L -^ENG(6920,DA)
|
---|
| 39 | Q
|
---|
| 40 | ;ENETRAN2
|
---|