source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENETRAN2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1ENETRAN2 ;(WIRMFO)/DH-Transfer Electronic Work Orders ;5/8/1998
2 ;;7.0;ENGINEERING;**35,53**;Aug 17, 1993
3 ;Expects DA
4EN 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)
5LOCK 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
14GETNO 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]"
24EDIT 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)
27PRINT N WARD,SHOPKEY S WARD=0,SHOPKEY=ENEWKEY
28 D WOPRNT^ENWONEW
29 G EXIT
30 ;
31DISAP S DIE="^ENG(6920," D EN1^ENWO2 K ^TMP($J,"ENEWO",ENERN),^TMP($J,DA) S ENCNT=ENCNT-1
32 G EXIT
33 ;
34ABORT W !,*7,"Transfer aborted."
35 W !!,"Press <RETURN> to continue, '^' to escape... " R X:DTIME
36 S:$E(X)="^" ENEX4=1
37EXIT ;Return to ENETRAN1
38 L -^ENG(6920,DA)
39 Q
40 ;ENETRAN2
Note: See TracBrowser for help on using the repository browser.