source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENARS.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: 961 bytes
RevLine 
[613]1ENARS ;(WIRMFO)/SAB-SEACH ARCHIVE LOG FOR EQUIPMENT ;2.24.97
2 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
3 ;CALLED BY ENAR
4 Q
5S ; entry point
6 ; ask equipment entry #
7 S DIR(0)="FO^1:16",DIR("A")="Search for Equipment ENTRY #"
8 S DIR("?")="Enter an archived equipment Entry # (e.g. 4157)"
9 D ^DIR K DIR G:Y=""!$D(DIRUT) EXIT
10 S ENEQ=$S(Y["-":$P(Y,"-",2),1:Y)
11 ;
12 I ENEQ'?1.10N W $C(7),!,"Equipment ENTRY #: ",ENEQ," is not valid",! G S
13 S ENDA=$O(^ENG(6919,"AE",ENEQ,0))
14 I ENDA'?1.N W $C(7),!,"Equipment ENTRY #: ",ENEQ," was not found in an archive set",! G S
15 ; show set info
16 D ID^ENAR2
17 S ENDA(1)=$O(^ENG(6919,"AE",ENEQ,ENDA,0))
18 W !!!!,"Equipment ENTRY #: ",ENEQ," was saved with record name "
19 W $P($G(^ENG(6919,ENDA,3,ENDA(1),0)),U)
20 W !,"in the archive set shown above.",!
21 D RECALL^DILFD(6919,ENDA_",",DUZ) ; save log entry for space bar recall
22 ;
23 G S
24EXIT ;
25 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
26 K DIC,DIE,DJL,DJLIN,DJN,DJNM,DJSW2,DX,DY,XY
27 K ENDA,ENEQ
28 Q
Note: See TracBrowser for help on using the repository browser.