cABIECRS	       ;Export ;Routine output ;%ABIE; [ 05/17/01  10:49 AM ]
	;
A	N SYSNAM,POP,D,SELF,TRM,F,%TIM,ZB,ZA,EXT,EXTS,%msub
	N AUTO,NULL,ROU,VOL,DESC
	N %A,%E,%X,%ANS,IO,IOF,IOM,IOST,IOT,IOBS,IOPAR,IOSL,RMSDF,CRT,PAGE
	;
	S $ZE="",$ZT="" B 1
	S POP=0
	;D ^%RSETN("Routine(s): ","SD","MAC,INT,INC","DEVN") G KILL:POP
	D ^cABIECRN("Routine(s): ","SD","INT","DEVN") G KILL:POP
	I $O(^mtemp(%msub,""))="" G KILL ;nothing selected
	;
D	S D=$G(%ABIE("COM"))
	I 'quiet R !,"Description: ",D
	S AUTO=0
	;
	D CHECK G KILL:POP ;check if access available to all routines
IO	K QUIT
	S IO=TRFIL,OIBS="*8",OIF="#",OIM=132,IOPAR="(""WNS"")",IOSL=66,IOST="RMS",IOT="RMS",MSYS="M/WNT"
	O IO:"WNS":0 S OK=$T I 'OK W !,"Could not open file",! S QUIT=2 Q
	S SELF=(IO=$I)
	S TRM=0
	S $ZT="ERR"
	S CRT=($E(IOST)="C")
	S F=1
	D INT^%T S %TIM=$ZDATE($H,2,,4)_"  "_%TIM,SYSNAM=$P($ZV," ("),VOL=1
	;
	U 0 W !
	S DESC=D U IO W SYSNAM_"^INT^"_DESC_"^~Format=Cache.S~",!
	U IO W "%RO on ",%TIM,!
	;
	S $ZT="ERR"
	F EXT="INC","INT","MAC" D ALLEXT G XIT:POP ;output other stuff
	U IO I 'TRM W "",!,"",!
	;
	I 'SELF,TRM U IO W @IOF ;successfully finish off with a formfeed
	;
	; Exit -- clean up and finish
XIT	U 0 I 'SELF C IO ;get rid of the other device
KILL	I $D(%msub) K ^mtemp(%msub) ;kill off the temp file
	S $ZT="" Q
	;
ALLEXT	;write out everything for one extension (EXT)
	N SD,SYS,DIR,NEWPAGE,VER,BRACKET,PREFIX,GLOTOP,NAME
	N DT,OKCOMP,LANG,NL,II,X,J S SD=""                      ;RF049
SSD	S SD=$O(^mtemp(%msub,SD)) Q:SD=""
	S SYS=$P(SD,"@"),DIR=$P(SD,"@",2),NEWPAGE=1,VER="",BRACKET=""
	S PREFIX=$S(SYS_DIR="":"^",SYS="":"^|"""_DIR_"""|",1:"^|""^"_SYS_"^"_DIR_"""|")
	S GLOTOP=PREFIX_$S((EXT="MAC")&'VER:"rMAC"_"(ROU,0)",(EXT="MAC")&VER:"rMACSAVE"_"(ROU,VER)",(EXT="INC")&'VER:"rINC"_"(ROU,0)",(EXT="INC")&VER:"rINCSAVE"_"(ROU,VER)",1:"ROUTINE(ROU,0)")
	S:DIR]"" BRACKET="["""_DIR_""""_$S(SYS]"":","""_SYS_"""]",1:"]")
SVER	S VER=$O(^mtemp(%msub,SD,EXT,VER)),ROU="" I VER="" G SSD
SROU	S ROU=$O(^mtemp(%msub,SD,EXT,VER,ROU)) I ROU="" G SVER
	D ROUTINE Q:POP  G SROU
	; Report errors.
ERR	S $ZT="" U 0 W *7,!,$ZE G XIT
ROUTINE	I EXT="OBJ" Q  ;OBJECT code should NOT be handled here
	S OKCOMP=$$OKCOMP(ROU,EXT) I AUTO,'OKCOMP Q  ;if not ok, not auto-loadable
	S DT=$$DATE(ROU,EXT),LANG=$$LANG(ROU,EXT)                ;RF049
	I 'SELF D SHOWR
	S %RN=ROU
	I TRT="M",$E($E(%RN,1,2)'="cQ"),%RN'="cX364",%RN'="cCHARWIN",$E(%RN)="c" S %RN="%"_$E(%RN,2,$L(%RN))
	U IO W %RN,!
	S NL=$$LENGTH(ROU,EXT),NULL=$S(TRM:"",1:"."),%RN=ROU
	F II=1:1:NL S X=$G(^(II)) S:X="" X=NULL D LINE Q:POP  ;BB151
	I 'TRM W "",!
	Q
SHOWR	S NAME=BRACKET_ROU_"."_EXT_$S(VER>1:"."_VER,1:"")
	U 0 W:$X+$L(NAME)>79 !
	W NAME,@$S($X>63:"!",1:"?"_($X\16+1*16)) Q
DATE(ROU,EXT)	I EXT="INT" Q $G(^[DIR,SYS]ROUTINE(ROU,0))
	n ENV 
	i SYS="" s ENV=DIR
	e  s ENV="^"_SYS_"^"_DIR
	I EXT="MAC",'VER Q $G(^|ENV|rMAC(ROU,0))
	I EXT="MAC",VER Q $G(^|ENV|rMACSAVE(ROU,VER))
	I EXT="INC",'VER Q $G(^|ENV|rINC(ROU,0))
	I EXT="INC",VER Q $G(^|ENV|rINCSAVE(ROU,VER))
LENGTH(ROU,EXT)	I EXT="INT" Q $G(^[DIR,SYS]ROUTINE(ROU,0,0))
	n ENV 
	i SYS="" s ENV=DIR
	e  s ENV="^"_SYS_"^"_DIR
	I EXT="MAC",'VER Q $G(^|ENV|rMAC(ROU,0,0))
	I EXT="MAC",VER Q $G(^|ENV|rMACSAVE(ROU,VER,0))
	I EXT="INC",'VER Q $G(^|ENV|rINC(ROU,0,0))
	I EXT="INC",VER Q $G(^|ENV|rINCSAVE(ROU,VER,0))
OKCOMP(ROU,EXT)	N A,I S A=1,NL=$$LENGTH(ROU,EXT) F I=1:1:NL I $G(^(I))="" S A=0
	Q A
LANG(ROU,EXT)	;
	n ENV 
	i SYS="" s ENV=DIR
	e  s ENV="^"_SYS_"^"_DIR
	I EXT="INT" Q $G(^|ENV|ROUTINE(ROU,"LANG"))   ;RF049+
	I EXT="MAC",'VER Q $G(^|ENV|rMAC(ROU,0,"LANG"))
	I EXT="MAC",VER Q $G(^|ENV|rMACSAVE(ROU,VER,"LANG"))
	Q ""                                                   ;RF049-
LINE	I TRF'=TRT S %X=II,%J=X X ROUTR S X=%J
	U IO W X,!
	Q
CHECK	;Check directories for protection violations,
	;and set EXTS=list of extensions to be written.
	N SD,SYS,DIR,EXT S POP=0,EXTS="",SD=""
CHKSYS	S SD=$O(^mtemp(%msub,SD)) I SD="" S EXTS=$E(EXTS,2,999) Q
	S SYS=$P(SD,"@"),DIR=$P(SD,"@",2,999),EXT=""
CHKEXT	S EXT=$O(^mtemp(%msub,SD,EXT)) G CHKSYS:EXT=""
	D CHKONE Q:POP  G CHKEXT
CHKONE	I EXTS'[(","_EXT) S EXTS=EXTS_","_EXT ;build up list of extensions
	S $ZT="CHKERR" I EXT="OBJ",SYS="" Q:$$DIRCHK(DIR)  G CHKERR
	;Can view object code in this remote directory on local computer
	G CHKERR:EXT="OBJ"
	n ENV 
	i SYS="" s ENV=DIR
	e  s ENV="^"_SYS_"^"_DIR
	I EXT="INT",$D(^|ENV|ROUTINE) ;can read ^ROUTINE?
	I EXT="MAC",$D(^|ENV|rMAC) ;can read MAC code
	I EXT="INC",$D(^|ENV|rINC) ;can read INC code
	Q
DIRCHK(DIR)	;
	N x S x=$D(^|DIR|ROUTINE) 
	Q 1 ;will have error if not valid
CHKERR	U 0 W " "_$ZE
	W !,"[Error reading "_$S(EXT="OBJ":"object code",1:$S(EXT="INT":"^ROUTINE",EXT="MAC":"^rMAC",1:"^rINC"))
	W $S(DIR_SYS="":"]",SYS="":"in |"""_DIR_"""| ]",1:"in |""^"_SYS_"^"_DIR_"""| ]") 
	Q
VIEWINI	;get some values from %ST
	Q  ;no longer needed
STOP(x)	S x=$$UC($E(x,1,4)) Q (x["EXIT")!(x["STOP")!(x["QUIT")!(x["HALT")!($E(x)="^")
UC(x)	q $zcvt(x,"u")
YN(P,D,t)	N R,X S P=$G(P),D=$E($G(D)_"?"),t=$G(t) ;ask Yes/No w/ Prompt,Default
	S D=$S("Yy"[D:"Yes => ","Nn"[D:"No => ",1:"") ;Yes, No or no default
	F  W !,P_"? "_D Read:t R:t Read:'t R DO  I "^YN"[R Q  ;timed or non-timed read
	. S X=R,R=$TR($E(R_D_"?"),"yn","YN") I "^YN"'[R W "  enter Yes or No, please"
	S POP=(R="^") W $E($S(R="N":"No",R="Y":"Yes",1:""),$L(X)+1,3) Q R