ENARS ;(WIRMFO)/SAB-SEACH ARCHIVE LOG FOR EQUIPMENT ;2.24.97
;;7.0;ENGINEERING;**40**;Aug 17, 1993
;CALLED BY ENAR
Q
S ; entry point
; ask equipment entry #
S DIR(0)="FO^1:16",DIR("A")="Search for Equipment ENTRY #"
S DIR("?")="Enter an archived equipment Entry # (e.g. 4157)"
D ^DIR K DIR G:Y=""!$D(DIRUT) EXIT
S ENEQ=$S(Y["-":$P(Y,"-",2),1:Y)
;
I ENEQ'?1.10N W $C(7),!,"Equipment ENTRY #: ",ENEQ," is not valid",! G S
S ENDA=$O(^ENG(6919,"AE",ENEQ,0))
I ENDA'?1.N W $C(7),!,"Equipment ENTRY #: ",ENEQ," was not found in an archive set",! G S
; show set info
D ID^ENAR2
S ENDA(1)=$O(^ENG(6919,"AE",ENEQ,ENDA,0))
W !!!!,"Equipment ENTRY #: ",ENEQ," was saved with record name "
W $P($G(^ENG(6919,ENDA,3,ENDA(1),0)),U)
W !,"in the archive set shown above.",!
D RECALL^DILFD(6919,ENDA_",",DUZ) ; save log entry for space bar recall
;
G S
EXIT ;
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K DIC,DIE,DJL,DJLIN,DJN,DJNM,DJSW2,DX,DY,XY
K ENDA,ENEQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARS 989 printed Nov 22, 2024@17:01:49 Page 2
ENARS ;(WIRMFO)/SAB-SEACH ARCHIVE LOG FOR EQUIPMENT ;2.24.97
+1 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
+2 ;CALLED BY ENAR
+3 QUIT
S ; entry point
+1 ; ask equipment entry #
+2 SET DIR(0)="FO^1:16"
SET DIR("A")="Search for Equipment ENTRY #"
+3 SET DIR("?")="Enter an archived equipment Entry # (e.g. 4157)"
+4 DO ^DIR
KILL DIR
if Y=""!$DATA(DIRUT)
GOTO EXIT
+5 SET ENEQ=$SELECT(Y["-":$PIECE(Y,"-",2),1:Y)
+6 ;
+7 IF ENEQ'?1.10N
WRITE $CHAR(7),!,"Equipment ENTRY #: ",ENEQ," is not valid",!
GOTO S
+8 SET ENDA=$ORDER(^ENG(6919,"AE",ENEQ,0))
+9 IF ENDA'?1.N
WRITE $CHAR(7),!,"Equipment ENTRY #: ",ENEQ," was not found in an archive set",!
GOTO S
+10 ; show set info
+11 DO ID^ENAR2
+12 SET ENDA(1)=$ORDER(^ENG(6919,"AE",ENEQ,ENDA,0))
+13 WRITE !!!!,"Equipment ENTRY #: ",ENEQ," was saved with record name "
+14 WRITE $PIECE($GET(^ENG(6919,ENDA,3,ENDA(1),0)),U)
+15 WRITE !,"in the archive set shown above.",!
+16 ; save log entry for space bar recall
DO RECALL^DILFD(6919,ENDA_",",DUZ)
+17 ;
+18 GOTO S
EXIT ;
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL DIC,DIE,DJL,DJLIN,DJN,DJNM,DJSW2,DX,DY,XY
+3 KILL ENDA,ENEQ
+4 QUIT
