XBRESTL1.m

XBRESTL1 ; acc/ohprd - routine to restore 1st line of routines from save file ;  

 ;;2.6;IHS UTILITIES;;JUN 28, 1993

 ;

 W !!,"-- ROUTINE TO RESTORE 1ST LINE OF ROUTINES FROM %RS FILE --",!

 W "CAUTION: THIS ROUTINE KILLS ALL VARIABLES, IS NOT NAMESPACED.",!

 R "ABORT HERE (^ OR CTL-C) OR PRESS RETURN TO CONTINUE: ",%:$S($D(DTIME):DTIME,1:999),! I %="^" W "-- aborted.",! G OUT

 W !

 K

GETFN R "Name of %RS-format save file: ",FN:$S($D(DTIME):DTIME,1:999),! G:"^"[FN EXIT

 I FN["?" W "(Enter the name of a unix file containing routines which was produced by %RS)",! G GETFN

 D GETHFS E  W "-- couldn't get HFS device!",! G EXIT

 U DEV

 R L1,L2

 U 0

 W "Header lines from %RS file:",!,?2,L1,!,?2,L2,!

 R "OK to proceed: N// ",%:$S($D(DTIME):DTIME,1:999),! S %=$E(%_"N") I "Yy"'[% W "-- aborted.",! G OUT

 F NR=1:1 D GETR Q:RN=""  W:NR=1 "Routines repaired:",! W ?2,$J(NR,3),": ",RL1,! D FIXL1

 C DEV

EXIT W "Bye.",!

OUT K

 Q

GETHFS ;

 F DEV=51:1:54 O DEV:(FN:"R"):1 Q:$T

 E  S DEV=0

 Q

GETR ;

 U DEV

 R RN Q:RN=""

 R RL1

 F  R RL Q:RL=""

 U 0

 Q

FIXL1 ;

 X "ZL @RN ZR +1 ZI RL1 ZS @RN"

 Q

XBRESTL1  ; acc/ohprd - routine to restore 1st line of routines from save file ;  

 +1       ;;2.6;IHS UTILITIES;;JUN 28, 1993

 +2       ;

 +3        WRITE !!,"-- ROUTINE TO RESTORE 1ST LINE OF ROUTINES FROM %RS FILE --",!

 +4        WRITE "CAUTION: THIS ROUTINE KILLS ALL VARIABLES, IS NOT NAMESPACED.",!

 +5        READ "ABORT HERE (^ OR CTL-C) OR PRESS RETURN TO CONTINUE: ",%:$SELECT($DATA(DTIME):DTIME,1:999),!

           IF %="^"

               WRITE "-- aborted.",!

               GOTO OUT

 +6        WRITE !

 +7        KILL 

GETFN      READ "Name of %RS-format save file: ",FN:$SELECT($DATA(DTIME):DTIME,1:999),!

           IF "^"[FN

               GOTO EXIT

 +1        IF FN["?"

               WRITE "(Enter the name of a unix file containing routines which was produced by %RS)",!

               GOTO GETFN

 +2        DO GETHFS

          IF '$TEST

               WRITE "-- couldn't get HFS device!",!

               GOTO EXIT

 +3        USE DEV

 +4        READ L1,L2

 +5        USE 0

 +6        WRITE "Header lines from %RS file:",!,?2,L1,!,?2,L2,!

 +7        READ "OK to proceed: N// ",%:$SELECT($DATA(DTIME):DTIME,1:999),!

           SET %=$EXTRACT(%_"N")

           IF "Yy"'[%

               WRITE "-- aborted.",!

               GOTO OUT

 +8        FOR NR=1:1

               DO GETR

               IF RN=""

                   QUIT 

               IF NR=1

                   WRITE "Routines repaired:",!

               WRITE ?2,$JUSTIFY(NR,3),": ",RL1,!

               DO FIXL1

 +9        CLOSE DEV

EXIT       WRITE "Bye.",!

OUT        KILL 

 +1        QUIT 

GETHFS    ;

 +1        FOR DEV=51:1:54

               OPEN DEV:(FN:"R"):1

               IF $TEST

                   QUIT 

 +2       IF '$TEST

               SET DEV=0

 +3        QUIT 

GETR      ;

 +1        USE DEV

 +2        READ RN

           IF RN=""

               QUIT 

 +3        READ RL1

 +4        FOR 

               READ RL

               IF RL=""

                   QUIT 

 +5        USE 0

 +6        QUIT 

FIXL1     ;

 +1        XECUTE "ZL @RN ZR +1 ZI RL1 ZS @RN"

 +2        QUIT