cABIEMRS ; Export - ROUTINE SAVE ;%ABIE; [ 02/06/01  10:13 AM ]
 ;
 S $ZT="ERR^%ABIEMRS",%SEQ=1 K %SBP,%FN
 O 63::0 E  U 0 W !,"Waiting for device 63" O 63
 S OS=$ZB($V(0,-4,2),#F,1)
SDEV D:$D(%FN) CLR D OUT^%ABIEMSD I $D(QUIT) C 63 K %SEQ Q
 S QUIT=0
SIZE ;
 K %SIZE
 ; I OS=8,%DEVTYPE="HFS",%FN?1A1":"1.ANP DO  I %SIZE<1 W !!,"No space on disk" G SDEV
 ; .S %X=$E(%FN,1) NEW %A,%B,%C,%Y
 ; .S %Y=$ZOS(9,%X) F %I=1:1:3 S @("%"_$C(64+%I))=$P(%Y,"^",%I)
 ; .S %SIZE=%A*%B*%C\1024 ; available space in kbytes
SIZE1 S %SIZE=$S($D(%SIZE):%SIZE*1024,1:1024*1024*#100000) G RCMT ; max=1TB
 ;
RCMT ;
 R !,"Enter comment for dump header : ",%CMT G SDEV:%CMT="^",CNT1:%CMT'="?"
 W !,"The comment will be displayed with the date and time before the routines",!,"are restored." G RCMT
CNT1 K QUIT D INT^%RSEL I $D(QUIT) W !,"No routines selected" G EXIT
 S %RS="" W !!,"Checking Selected Routines..."
 O 63::3 E  W !,"Device 63 busy, try again later" Q
 F  S %RS=$O(^UTILITY($J,%RS)) Q:%RS=""  D
 . S %HDR=$ZBN(^ (%RS))
 . I '%HDR W !,%RS," --Has just been deleted." K ^UTILITY($J,%RS) Q
 . V %HDR I $V(17,0,1) W !,%RS," --Has no source code. Cannot be exported." K ^UTILITY($J,%RS) Q
 S %BO=$ZB($V(0,-4,2),64,1)'=0
 S QUIT=0,%NEXT="D NEXTVOL^%ABIEMRS Q:QUIT  ZL @%RN"
 S %ZPRINT="ZR  S %S=$S ZL @%RN X:%S-$S>(%SIZE-$ZB-10) %NEXT Q:QUIT  U %DEV X %ZRN S:$ZC<0 QUIT=2 Q:QUIT  F %X=1:1 S %J=$T(+%X) X:TRF'=TRT ROUTR U %DEV W %J,! Q:%J="""""
 S %ZRN="W $S(TRF=TRT:%RN,$E(%RN)=""%"":""c""_$E(%RN,2,$L(%RN)),1:%RN),!"
 I TRF'=TRT S %RN="%Q" F  S %RN=$O(^UTILITY($J,%RN)) Q:%RN=""!($E(%RN,1,2)'="%Q")  K ^(%RN)
 D INT^%T,INT^%D
 W !!,"Saving ...",!
 D WRITEHDR
 S %RN=""
 F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN=""!QUIT  U 0 W ?%I-1#8*10,%RN W:(%I#8)=0 ! U %DEV D PCODE C 63 Q:QUIT  X:PCODE %ZPRINT Q:QUIT
 I QUIT=2 U 0 W !!,"End of file reached, last portion of save may be corrupted!  Terminating save."
 E  U %DEV W !!
 U 0 W !!,"Done. "
QUIT ;
EXIT C 63 U 0 I $D(%DEV),%DEV'=$I,+%DEV C %DEV I $G(%DEVTYPE)="HFS",$ZA=-1 W !!,"Cannot write end of file.  Last part of save may be corrupted."
 I '$D(%RN) D CLR
 K OS,%DEV,%RN,%BN,%I,%J,%CMT,%TIM,%TIM1,%DAT,%DAT1,%NEXT,%SEQ,%FN,%S,%SIZE,%SBP,%TAP,%X,%ZA,%ZPRINT,QUIT,%TAPV Q
CLR ; Clear the zero length file that was created
 I OS=8&($G(%DEVTYPE)="HFS") S X=$ZOS(2,%FN)
 I OS=3&($G(%DEVTYPE)="HFS") Q:$E(%FN,1,5)="/dev/"  Q:%FN["*"  S CMD="rm -f "_%FN,X=$$TERMINAL^%HOSTCMD(CMD)
 Q
PCODE ; Test for pcode only routine
 I %DEV<47!(%DEV>62) S PCODE=1 Q
 S PCODE=$ZBN(^ (%RN)) I PCODE=0 U 0 W !,%RN," does not exist" Q
 O 63::0 E  U 0 W !,"Waiting for device 63" O 63
 V PCODE I $V(17,0,1)=0 S PCODE=1 Q  ; not a pcode routine
 S ALT=0 I $V(0,0,1)>4 S ALT=$V(32,0,4),%BR=$V(30,0,1)'=%BO I ALT,%BR S ALT=$$REV(ALT)
 S %S=1056 F  S %K=$V(1012,0,4) Q:%K=0  V %K S %S=%S+1024 ;1056=1024+32, 32 byte cushion left for rtn name, etc.
 S %K=ALT F  Q:%K=0  V %K S %S=%S+1024,%K=$V(1012,0,4)
 I %S>(%SIZE-$ZB) X %NEXT Q:QUIT
 G PC20
PC10 ;
PC20 V PCODE U %DEV W %RN_":"_$V(17,0,1)_":"_%BO W ! I $ZC S QUIT=2 Q
 U:%DEV>58&(%DEV<63) %DEV:(::::"V")
 F  W $V(0,0,1024,1) S PCODE=$V(1012,0,4) Q:PCODE=0  V PCODE
 I '$ZC,ALT V ALT F  W $V(0,0,1024,1) S PCODE=$V(1012,0,4) Q:PCODE=0  V PCODE
 I $ZC S QUIT=2
 U:%DEV>58&(%DEV<63) %DEV:(:::$C(255):"S") Q
ERR I $F($ZE,"<INTERRUPT>") K %RN U 0 W !!,"...Aborted." D:$D(OS) EXIT ZQ 0
 ZQ 1
NEXTVOL ;
 S %SEQ=%SEQ+1 U %DEV W "*EOF*",! C %DEV
 U 0 W !,"Sequence #",%SEQ-1," is full, if using removeable media, please put in the next one"
NEXTVOL1 ;
 R !,"Enter 'GO' to proceed: ",%X W !
 I %X="?" W !!,"Remove sequence #",%SEQ-1,", and put the next disk or tape into the drive.  If you are",!,"not using removeable media, you should abort this save by typing 'control C';",!,"your save will still be good up to this point." G NEXTVOL1
 I %X'="GO" W "  ??" G NEXTVOL1
 O @%DEVOARG U %DEV I $ZA U 0 W !,"Cannot access ",%FN," please correct" G NEXTVOL1
 W "DISK#",%SEQ,! S %X=$ZC
 U 0 I %X W !,"Cannot write to ",%FN," please correct" G NEXTVOL1
 S QUIT=0 Q
REV(X) ;reverse a long value
 S X=$ZH(X),X=$E("00000000",1,8-$L(X))_X
 Q $ZH($E(X,7,8)_$E(X,5,6)_$E(X,3,4)_$E(X,1,2))
WRITEHDR ;
 U %DEV W:'%DEV ! W %TIM1_"  "_%DAT1,!
 W %CMT_" via %RO",!
 Q