ENARS.m

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 ---ENARS   989     printed  Apr 09, 2024@20:58:27                                                                                                                                                                                                        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