IMD 1.16: 8/06/2007 12:07:10 ebmmug.008 eastbay micromate users' group micromumps ver. 16.06 turnstil-bibliography program disk issued: october 4, 1984 -EBMMUG BAKARCHIVESMMP AUTHFINDMMP AUTHSEARMMP ERRORS DATBIN MMPBURN MMPCATALOG MMPCHOOSE MMP%DATE MMP%DIR MMP%EDIT MMP%EDITH MMP CHOP MMPCOMLIST MMPCOMPARE MMPDUST MMPELIMIN MMPFINDSHLFMMPLIB MMP LISTER MMPOPENBOOKMMP %M GBL!"#$%&'()*+,-./0%M GBLN12345%M MMP67%M0 MMP89%M1 MMP:;%M10 MMP<=%M2 MMP>?%M3 MMP@A%M4 MMPBC%M5 MMP D%M6 MMPEF%M7 MMPG%M8 MMPHI%M9 MMPJK%MEDT MMP!LMN%MEDT1 MMP!OPQ%MEDTE MMPRS%MEDTE1 MMPTU%MTC GBL V%MTC MMPW%MTCD MMPXY%MTCH MMPZ[%NAMES MMP\]PAGE MMP^SCANBOOKMMP_SEARCH MMP`SHELF MMPaSHELFER MMPbSHOW MMPcSPELL MMPdeSHOWBOOKMMPfSHOWCHOPMMPgTURNSTILROU?hijkWPRNT MMPlGLOBALS DATmnopqrstuvwxyz{|GLOBALS DAT }~SHOWLISTMMPMUMPS COMMUMPS COMNSUBJ MMPEBMDIR08TXT TITSPLITMMPTOMES MMPTRASH MMPTURNSTILMMP-EBMMUG 008-EBMMUG 008  VOLUME 008 DESCRIPTION: MICRO MUMPS VERSION 4.02 - BIBLIOGRAPHY PROGRAM (ROUTINE) NUMBER SIZE NAME COMMENTS 008.1 2K %DATE .MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINES 008.2 2K %DIR .MMP " " " " " " 008.3 4K %EDIT .MMP " " " " " " 008.4 2K %EDITH .MMP " " " " " " 008.5 42K %M .GBL " " " " " " 008.6 4K %M .MMP " " " " " " 008.7 4K %M0 .MMP " " " " " " 008.8 4K %M1 .MMP " " " " " " 008.9 4K %M10 .MMP " " " " " " 008.10 4K %M2 .MMP " " " " " " 008.11 4K %M3 .MMP " " " " " " 008.12 4K %M4 .MMP " " " " " ' 008.13 2K %M5 .MMP " " " " " " 008.14 4K %M6 .MMP " " " " " " 008.15 2K %M7 .MMP " " " " " " 008.16 4K %M8 .MMP " " " " " " 008.17 4K %M9 .MMP " " " " " " 008.18 6K %MEDT .MMP " " " " " " 008.19 6K %MEDT1 .MMP " " " " " " 008.20 4K %MEDTE .MMP " " " " " " 008.21 4K %MEDTE1 .MMP " " " " " " 008.22 2K %MTC .GBL MICRO MUMPS VERSION 4.02 - TERMINALS DEFINED 008.23 2K %MTC .MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINES 008.24 4K %MTCD .MMP " " " " " " 008.25 4K %MTCH .MMP " " " " " " 008.26 4K %NAMES .MMP " " " " " " 008.27 4K -EBMMUG .008 DISK NAME & CONTENTS OF EBMMUG.008 (OCT 4,'84) 008.28 2K ARCHIVES.MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINES 008.29 2K AUTHFIND.MMP " " " " " " 008.30 2K AUTHSEAR.MMP " " " " " " 008.31 2K BIN .MMP " " " " " " 008.32 2K BURN .MMP " " " " " " 008.33 2K CATALOG .MMP " " " " " " 008.34 2K CHOOSE .MMP " " " " " " 008.35 2K CHOP .MMP " " " " " " 008.36 2K COMLIST .MMP " " " " " " 008.37 2K COMPARE .MMP " " " " " " 008.38 2K DUST .MMP " " " " " " 008.39 2K EBMDIR08.TXT DIRECTORY OF THIS DISK 008.40 2K ELIMIN .MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINE 008.41 2K ERRORS .DAT " " " " ERRORS DATA 008.42 2K FINDSHLF.MMP " " " " TURNSTILE ROUTINE 008.43 50K GLOBALS .DAT " " " " GLOBALS DATA 008.44 2K LIB .MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINES 008.45 2K LISTER .MMP " " " " " "  Files: 64 space used: 306k (80k free) %DATE .MMP 2k : %M9 .MMP 4k : CATALOG .MMP 2k : SCANBOOK.MMP 2k %DIR .MMP 2k : %MEDT .MMP 6k : CHOOSE .MMP 2k : SEARCH .MMP 2k %EDIT .MMP 4k : %MEDT1 .MMP 6k : CHOP .MMP 2k : SHELF .MMP 2k %EDITH .MMP 2k : %MEDTE .MMP 4k : COMLIST .MMP 2k : SHELFER .MMP 2k %M .GBL 42k : %MEDTE1 .MMP 4k : COMPARE .MMP 2k : SHOW .MMP 2k %M .MMP 4k : %MTC .GBL 2k : DUST .MMP 2k : SHOWBOOK.MMP 2k %M0 .MMP 4k : %MTC .MMP 2k : EBMDIR08.TXT 2k : SHOWCHOP.MMP 2k %M1 .MMP 4k : %MTCD .MMP 4k : ELIMIN .MMP 2k : SHOWLIST.MMP 2k %M10 .MMP 4k : %MTCH .MMP 4k : ERRORS .DAT 2k : SPELL .MMP 4k %M2 .MMP 4k : %NAMES .MMP 4k : FINDSHLF.MMP 2k : SUBJ .MMP 2k %M3 .MMP 4k : -EBMMUG .008 4k : GLOBALS .DAT 50k : TITSPLIT.MMP 2k %M4 .MMP 4k : ARCHIVES.MMP 2k : LIB .MMP 2k : TOMES .MMP 2k %M5 .MMP 2k : AUTHFIND.MMP 2k : LISTER .MMP 2k : TRASH .MMP 2k %M6 .MMP 4k : AUTHSEAR.MMP 2k : MUMPS .COM 42k : TURNSTIL.MMP 2k %M7 .MMP 2k : BIN .MMP 2k : OPENBOOK.MMP 2k : TURNSTIL.ROU 8k %M8 .MMP 4k : BURN .MMP 2k : PAGE .MMP 2k : WPRNT .MMP 2k y0:5.17=TiÊIÀÅrvÎÐÒzEÈxs1Ã1Oj$|Ãà à ÃBB008.46 42K MUMPS .COM " " " " COMMAND FILE 008.47 2K OPENBOOK.MMP " " " " TURNSTILE ROUTINES 008.48 2K PAGE .MMP " " " " " " 008.49 2K SCANBOOK.MMP " " " " " " 008.50 2K SEARCH .MMP " " " " " " 008.51 2K SHELF .MMP " " " " " " 008.52 2K SHELFER .MMP " " " " " " 008.53 2K SHOW .MMP " " " " " " 008.54 2K SHOWBOOK.MMP " " " " " " 008.55 2K SHOWCHOP.MMP " " " " " " 008.56 2K SHOWLIST.MMP " " " " " " 008.57 4K SPELL .MMP " " " " " " 008.58 2K SUBJ .MMP " " " " " " 008.59 2K TITSPLIT.MMP " " " " " " 008.60 2K TOMES .MMP " " " " " " 008.61 2K TRASH .MMP " " " " " " 008.62 2K TURNSTIL.MMP " " " " " " 008.63 8K TURNSTIL.ROU " " " " " " 008.64 2K WPRNT .MMP " " " " " "  2K ERRORS .DAT " " " " ERRORS DATA 008.42 2K FINDSHLF.MMP " " " " TURNSTILE ROUTINE 008.43 50K GLOBALS .DAT " " " " GLOBALS DATA 008.44 2K LIB .MMP MICRO MUMPS VERSION 4.02 - TURNSTILE ROUTINES 008.45 2K LISTER .MMP " " " " " " """W=(!"=(!="=(!`"ەO 0<2y 0<2!""!@""! "!p|G^!p>yi y!͒12y9fhbzjl,ٷnp> rt1!2ѹ2ӹɯ~( O #!۹͒:ҹAO !͒*Թȶ!͒*ֹ>/<033O _ W{ =y2ҹi&) ~#fo{ !~2ӹ!~#fo͍i`"Թi`"ֹi`"ع:2ڹi`z n&*ҹ&)~#fo*ҹ&)~#fo~#foڗ>2#×:#<ֱ2#*=‡*":*}®:=::<>2*i^#V+ d!K*}@*)): K:) O "!w [O?WGzO:VxGyOGxwq*}}嫯2̓*~wć"̀!~$6:03i"!~6*e>=)Q!QX@˥ >2 ˥!!q#p#w2wW*e_3ҫ-!s:!xQ*:<œ. ʩ.ʩAܕrr##sܕ<}rcN! ~态O>G~G!~G~o>_yG~.|°! w:ck[!x?[! ~ʤ͆[͗PPvqO-á=.:<ʰ! Vq##~_@wڰͶ:WMںʛ>úͶ >TJ:!ʷ͞x!Ǥw4 ϤPWޤPܕÂՕÂ*!!~~#~O~#FsO s#r:(„y==„*!^W*y^#Vx7=2wͼկw#KWK*"J T͞*:["+SX:ڜq:ʺ!ʵ>2ܕͤ2ѣO ̗DM͸}ޣ>r""2:2* :::29:>:>*ڈ>F6:_/G:ʧ:ڨ|OͤG:_O̗̗zW{¢|:*}|BKN¢ zyG:!vq:vՕvMڂ?Ͷ >T͓Â!">Â:G:O:h=27ryy/W!:l=:<>w##~2 4~?ɡ¹:<ɡɡüޟAX2rK:w++~=wv4͗O5:2X!"*>o+"! *!b"ݜ": r#~?w#>r# L=J Lv wȴbܕ?~O ͆ڡ†wŒ~è# # x ͗w ٠ڠ٠ڠw@ ~wb͐Úݚ!x>w~6:6~#+w#w+~;wɯ2KOFq-yl?Npg:ʓ~( ȴˆʀHÈ2xą ):@ΟO~#w͚ʀôb_++V@* )͗Os++r~Gw#* #~$%+@*9>  #>? ;*~ w-xąH"0 *ĊHEʀ@~›:6¦w͚̋ȴÇPY*{zBKNyʺ Nú2: *~w *" ݜ2>ʄ@~k:(s~*9~Ês~Ԩ~ͅ<G:<ޝ2x# W:<­:22G?>Grx~:2Ô##~*$*">2̀2kºʺ**iҺ@:O~흯2~WW:2Ôyʛ?ʔx ʔ |̷ǝÔN:r:/GyOOA +¬ ¢y2:x¹o&:W>OͫE:ڟ?N/*"y2ͦ>2 ݜwޛDM*w6# x *ow**ws#r̀*i6#6*}"w@*|<ď>!8>8> t>nͦv8 ~*ownT] KKͦޛ*w"wͦ"w@ :ÛNɛ N#Fy؛*}|h#ð*ͫ# 6RX*q6!"@**#":&2͒:È0:+Òy<_W`iͫDM*w ~bNpwޛDM*we ^#V#~2>â9͆>!"*y³*X*ÿ͂"*g*K!~<:wb##>w#wė> r!~#22Zw*q>ww:c *#*is#r*:!:)e:O!*c:Oͫ}@2æ ~á*g:o$*~K6?~wKw**i{#zir+s{O:w:Ғ4~:w?r##rp# ä |g}oì*g #G ¾1*q:*w***> r 2":O:G2!w*~zWw+ !z?#~*!* *G!O~2~m͗O~t>2?:2g͝DM*0MD"!*MD$:Oë!N: «G>O: —ù*ė :ڗn` ~#foͤ2O̗"}:O*"!s#r#p*kN#F*m^#V#F*:O}|y9*+"*}|yP#9**DM"*ks#r*ms#r#pyox*kw#w*mw#w#w>2'å2*OͶyڲò<*eͲ:0!::ò2*>*ͫ"4#4#4)7 #  w#*J|^#V#"i##"k##"m###"o#"q##"!s )*s!)*|!6~67rrorFile Exists? in Filenameòò>2a.":2:<:55;:2ɯ22{_zW{_zW )7CP/M Error On : Disk I/OInvalid DriveRead/Only FileRead/Only DiskPassword E)"!z<~rs^#V#N#FxN:oʲ̀õ(# Þry< <<%zrͷr6r9rMDÌ:o!6!h: ʚnt2 r62>rz<*9ʌ^: ~x ):*:őő>*(+"(w++2+2+ɍp؍!" >2+2*jx.#NzW::!2W!5=^x^z:m:*;#wO:͂^2¢ů͠Đ:!ڽ*(~ݎ׎5WèՐ؍j׎M2ͨxΐ*(+w"(j͌ !%"(^-:*$P:<\:W:2xM s:<9>2:*9x~+q’x2:**&~2+o#"&!+6Mŏ:W:2x ͺ*(+"(w  :܏>2*2:*(:+w"(ͺ:G::+̜2 5*(~o#"(Mš*(~`Uoj*(~#"(Ñ!*~6s!+6:+‚xoڊ{2Ó#w:2.+:.2-!%"(2*!“"&!*~4:2-Ԃ:Gͳͨ^2+>2:2*N#G2 2GH)+6:2,:!- ͌:,!͌+*(~L#Bxz:*:*(~ʓOr ͌ ͌! O(Ì*(~2**}ʷ!#¶!""÷:_:*(#w΍xH!“)6"&:!“ x5~y 5 6y(^͌@O:=7:͌y ͌:I ͌:=e: zz#͌͂:! ͌ G:Ҏ>xʝʝw>ɯw̩z:»!>wɯ:=zxzz::G:=/ͽx:Āy!4 šn!6@G:x: P:<: P n6 t6! ^6 t6u:)<͠^!Ó*"r*r"ÿ<:g:!͐*f}D! ~6t!rͷ֋O(^ƋƋƋ  :Function = File = !,!"h!9"f! ͉:2t™:!=Hgo:O*;*͂:A2=/::0! dگ61#d ڸïp#:w#6 !6:6 *#!)6.#)͂ O(BDOS > wM  2*7w#6?#7 .,:;[]=<>|!?]45#Ra{i_p# l s s l ls:¬MA96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(YAUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT D +A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) AUTHFIND AUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT AUTHSEAR AUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT BIN BIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT BURN BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOAUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=%MU~mU~%%!Programmer Utilities Scratch AreaRESR1*;.EIL.ROU;1"TURNSTIL.ROU"RESR2TURNSTIL;1"TURNSTIL"&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #Missing linestart character Stack overflow Arithmetic overflow Undefined local variable Illegal function name Illegal command name Undefined program name Undefined global name Global+value too long Directory full Program larger than partition String too long Unmatched parentheses Illegal use of not operator Illegal command terminator Too many naked references Unauthorized global access Division by zero Illegal character Syntax stack overflow Illegal expression Illegal pattern Missing comma Illegal variable name Illegal use of indirection Undefined routine line number Illegal numeric literal Missing equal sign Illegal routine or label name Invalid name syntax Unimplemented operation Symbol table overflow NOT USED AT PRESENT Duplicate label Invalid line reference No true value in $SELECT Naked global reference illegal Global file not on disk Routine not on disk Disk I/O error Routine is unnamed Routine already in library Remove or save routine Only used in indirect mode Illegal command during BREAK Command only used during BREAK Subscript missing Invalid subscript Invalid parameter Device not OPEN Running out of global space Reading from write only device Invalid device number NOT USED (FOR EXPANSION) Invalid repetition count Invalid READ count nvalid device number NOT USED (FOR EXPANSION) Invalid repetition count Invalid READ count !want the globals on? $ The global file is initialized. $GLOBALS DATBIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT ARCH QUIT S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=e: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOR YES) ",BUR I BUR="BURN BOOKS" DO ^OPENBOOK QUIT DO ^TOMES QUIT  " R !,"YOU MAY LOOK AT WORD) AARDCVARKANTEATERCAT DUMB FELINEDOG NOBLE CANINEZEBRA STRIPED HORSECATALOGUE W !!,"FOR EACH WORD TYPE 'E' IF YOU WISH TO ELIMINATE THE WORD AS A REFERENCE WORD. " W !,"A CARRIAGE RETURN WILL INCLUDE THE WORD IN THE REFERENCE LIBRARY'S INDEX." FOR R=^BEG:1:^ENT DO HORSE QUIT HORSE FOR HOOF=1,2,4,5 DO CATTLE QUIT CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN  QUIT "&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #CHOOSE R !,"REFERENCE BY SUBJECT(CR) OR AUTHOR (A)?",CHO I CHO="A" DO ^AUTHSEAR QUIT DO ^SUBJ B(R,HOOF) DO ^BIN  QUIT =1:1:M DO RIX QUIT FIX IF N=0 QUIT W !,^ALPHA(64+A),",",^SHELF(64+A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) X QUIT FIX IF N=0 QUIT W !,^ALPHA(64+A),",",^SHELF(64+A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRAS1=G2 GEDIT5 S Q="GEDIT" W !!,@LH,"A",@HL,"gain, ",@LH,"S",@HL,"top, ",@LH,"N",@HL,"ext: ",@LH,"N",@HL," :: " D READ G GEDIT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y%DATE S %DT=$P($H,",",1) S %H=%DT>21608+%DT+1460,%L=%H\1461,%YR=%H#1461 S %Y=%L*4+1837+(%YR\365),%D=%YR#365+1 S %M=1 I %YR=1460 S %D=366,%Y=%Y-1 F %I=31,%Y#4=0+28,31,30,31,30,31,31,30,31,30,31 Q:%D'>%I S %D=%D-%I,%M=%M+1 S:%D<10 %D="0"_%D S %M=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%M*3-2,%M*3) S %DT=%M_" "_%D_", "_%Y K %H,%L,%YR,%Y,%M,%D,%I Q %D="0"_%D S %MX=Y,Y="" Q SF ;Send CP/M file S FB="U DV W ""File "",N,"" being sent"" U DEV" S FLSND="S X=N F J=1:1 U FL R Y U DEV S EOR=Y=$C(26) X SEND Q:A'=SYNC X:DSP WX Q:EOR S X=Y" S N=$O(^%U("")) Q:N="" F I=1:1 S M=$O(^%U(N)),DONE=M="" X TSYNC Q:K=MAX O FL:($ZR:N) X:'DSP&'SLV FB X FLSND C FL:0 Q:Y'=$C(26) X:'DSP&'SLV END Q:DONE S N=M S Y="" G TCHECK TCHECK ;Check for transmission errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K Q n errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K%DIR ;CREATE DIRECTORY OF ROUTINE OR GLOBAL NAMES R !,"Routines, Globals, or Files? (R/G/F) ",%D Q:%D="" S %D=$E(%D) G:"RGF"'[%D %DIR X K ^%U S %V=$F("GRF",%D) O 3:("A":"SCRATCH.DAT") U 3 V %V C 3:0 O 3:("A":"SCRATCH.DAT") S %C=0 I %V'=4 F %J=0:1 U 3 R %D Q:$A(%D)=26 F %K=0:1:4 S %Y=$P($E(%D,%K*12+1,%K+1*12)," ") Q:%Y="" S ^%U(%J*5+%K+1)=%Y,%C=%C+1 E F %J=0:1 U 3 R %D Q:$A(%D)=26 F %K=0:1:3 S %Z=$P(%D,":",%K+1),%L=''%K,%Y=$P(%Z," ",1+%L),%Z=$P($E(%Z,10+%L,12+%L)," ",1) S:%Z'="" %Y=%Y_"."_%Z Q:%Y="" S ^%U(%J*4+%K+1)=%Y,%C=%C+1 S ^%U(0)=%C C 3:1 K %C,%D,%J,%K,%L,%Y,%Z Q 10+%L,12+%L)," ",1) S:%Z'="" %Y=%Y_"."_%Z Q: : ! ڗ  K ! 4Á ! 6: =! ڻ * & NK ! 4œ >3  03} Z; { ) # %EDIT ; SYSTEM EDITOR - COPYRIGHT (C) 1980 J.J.ALTHOUSE & ASSOC. K ^% S ^%=$E($T(%),3,255) F I=1:1 S X=$T(%+I) Q:'$L(X) S Y=$F(X," "),^%($E(X,1,Y-2))=$E(X,Y,255) W !,"THE EDITOR IS LOADED" D ^%EDITH Q ; ; THE CODE THAT FOLLOWS IS LOADED INTO GLOBALS ^% ; THE EDITOR IS EXECUTED BY TYPEING 'X ^%' ; % ZM : F %X=1:1 R !,">>",%1,! Q:%1="" S:%1="A" %1=%0 S %0=%1 X ^%($S($E(%1,$L(%1))=" ":99,$L(%1)=1:2,%1?1"^".E:1,1:0)) 0 X %1 1 S %G=%1,%2=@%G,%1=1 X ^%(100) S @%G=%2,%1="" 2 S %1=$F("MDLCSIEBR?G",%1) X:%1 ^%(%1+1) S %1="" 3 W "*MOVE " X ^%(113) W %2,! R "*INSERT BEFORE LABEL: ",%M,! Q:%M="" ZR @%R ZI %2:@%M 4 R "*DELET LINE(S): ",%2,! ZP @%2 R "OK TO DELET? ",*X W *X Q:X'=89 ZR @%2 W " DELETED" 5 R "*LIST LINES: ",%2,! S %5=$E(%2,1)="+" ZP:'%5 @%2 X:%5 ^(115) 6 W "*CHANGE " X ^%(113) I $L(%2) F %1=1:1 X ^%(100) Q:'$L(%3) ZR @%R ZI %2 7 R "*SEARCH FOR: ",%3,! Q:%3="" F %R=1:1 S @"%2=$T(+%R)" Q:'$L(%2) I %2[%3 W !,%2,! F %5=1:0 S %5=$F(%2,%3,%5)+0 Q:%5=0 W ?%5-1-$L(%3),">" 8 W "*INSERT BEFORE " X ^%(113) I $L(%2) W %2,! ZM @%R F %X=1:1 R "*",%2,! Q:'$L(%2) ZI %2 9 R "*REPLACE EVERY: ",%3,! R "*WITH: ",%4,! F %1=1:1 S @"%2=$T(+%1)" Q:'$L(%2) S %L=$S($E(%2,1)=" ":%L+1,1:0) S:'%L %R=$P(%2," ",1) I %2[%3 W !,%2,! X ^(119) ZR @(%R_"+"_%L) ZI %2 W !,%2 10 R "*BACKUP ROUTINE: ",%R,! ZL @%R S %N=%R_".SAV" O 4:("A":%N) U 4 W %R,! F %R=1:1 S %2=$T(+%R) W %2,! I '$L(%2) C 4:0 U 0 W "*SAVED ON A:",%N Q 11 R "*RESTORE ROUTINE: ",%R,! ZR S %N=%R_".SAV" O 4:("A":%N) U 4 R %R U 0 W !,%R," FROM ",%N,!! F %N=1:1 U 4 R %2 U 0 W %2,! ZI:$L(%2) %2 I %2="" C 4:0 R !,"OK ? ",*%X W *%X ZR:%X'=89 Q:%X'=89 ZS @%R Q 12 F %X=1000:1 Q:'$D(^%(%X)) W ^%(%X),! 13 R "*GET ROUTINE: ",%R,! ZL @%R ZP 99 S %R=$E(%1,1,$L(%1)-1),@("%2=$T("_%R_")") I $L(%2) F %1=1:1 X ^%(100) Q:'$L(%3) ZR @%R ZI %2 100 W:%1=1 %2,! R "*REPLACE: ",%3,! X:%3["..." ^%(114) I $L(%3),%2[%3 S %5=$F(%2,%3),%6=$E(%2,1,%5-$L(%3)-1) W %6 R %4 S %7=$E(%2,%5,255),%2=%6_%4_%7 W %7,! 113 S %2="" F %1=1:1 R "LABEL: ",%R,! Q:%R="" S @("%2=$T("_%R_")") Q:$L(%2) W %R," INVALID LABEL",! 114 S %5=$F(%3,"..."),%31=$E(%3,1,%5-4),%32=$E(%3,%5,255) I %2[%31,%2[%32 S %51=$F(%2,%31),%52=$F(%2,%32,%51) S:%52=%51 %52=256 S %3=$E(%2,%51-$L(%31),%52-1) 115 S %3=$P(%2,":",2) S:%3="" %3=%2 F %4=%2:1:%3 W !,@("$T(+"_%4_")") 119 F %5=1:0 S %5=$F(%2,%3,%5)+0 Q:%5=0 S %2=$E(%2,1,%5-$L(%3)-1)_%4_$E(%2,%5,255) W ?%5-1-$L(%3),">"  W !,@("N ECHO OFF O DEV U DEV Q zation" S GOOD="Successful completion" S WX="U DV W X,! U DEV" I SLV S DEV=$I ;AND THEN TUR=Aͤ,Tͤ, ͤ,=:IyG:?J yG>J2I2I!>J͐!!O"I=:IyGcG2I2I!>J͐!!O"I=:?J >J2I,++ No File Open ++ =bH, Library of Phone Numbers of Remote Systems!OH## ͛,H##B ͛,H G>$ O{+{+=> > > F#1H'H7,HIT any KEY to CONTINUE͈+MH͓+bH{+=: ž> ͝+ > ͝+rHbH, Current Settings ͘DD:ʴH͉ D,Terminal mode file buffer is :IH,in,active Unused portion o%EDITH ; SYSTEM EDITOR HELP - COPYRIGHT (C) 1980 J.J. ALTHOUSE & ASSC. F I=1:1 S X=$T(HELP+I) Q:'$L(X) S ^%(999+I)=$E(X,4,255) W !,"EDITOR HELP TEXT LOADED",! Q ; ; THE TEXT THAT FOLLOWS IS LOADED INTO THE GLOBAL ^% ; STARTING AT NODE 1000 ; THIS TEXT IS DISPLAYED WHEN A USER ENTERS '?' TO THE EDITOR ; HELP ; HELP TEXT STARTS HERE ; ENTER ONE OF THE FOLLOWING AT THE '>>' PROMPT: ; ? - TO GET THIS DISPLAY ; LABEL - FOLLOWED BY SPACE TO EDIT A LINE ; ^GLOBALREF - TO EDIT A GLOBAL NODE ; MUMPS CODE - FOR DIRECT MODE EXECUTION ; SINGLE LETTER CODES TO EDIT THE CURRENT ROUTINE: ; (A)GAIN - REPEAT PREVIOUS COMMAND ; (M)OVE - MOVE A LINE WITHIN THE ROUTINE ; (D)ELETE - DELETE LINE(S) OF THE ROUTINE ; (L)IST - LIST LINE(S) OF THE ROUTINE ; (C)HANGE - CHANGE CODE WITHIN A LINE ; (S)EARCH - SEARCH THE ROUTINE FOR A STRING ; (I)NSERT - INSERT LINE(S) INTO THE ROUTINE ; (E)VERY - REPLACE EVERY OCCURANCE OF A STRING ; (G)ET - GET A ROUTINE FROM MUMPS FILE ; (B)ACKUP - BACKUP A ROUTINE TO A CP/M FILE ; (R)ESTORE - RESTORE A ROUTINE FROM A CP/M FILE  ROU&'SLV END W SYNC,! C FL:0 Q:RSLT=1" G RCHECK RCHECK ;Check for receive errors ZR:MOD="R"&ERROR ;Clean up incomplete routine C:MOD="F"&ERROR FL:1 ;Delete incomplete file I 'SLV U DV W !!,$S(K=MAX:NOLINK,ERROR:NOSYNC,1:GOOD),!!! E ;Turn echo back on K Q RROR FL:1 ;Delete incomplete file I 'SLV U DV W !!,$S(K=MAX:NOLINK,ERROR:NOSYNC,1:GOOD),!!! E ;Turn echo bacx2y2:ߨ=O! 'ǎ:TʫX¶:ߨڶ:ց2!͇!$ǎǎ:UY~ ֕K~05:5OGyO#~05:5GO##x5157> Enter today's date (MM/DD/YY): $ Enter the current time (HH:MM): $ $1Y QCs4`e4Z80 MUMPS VERSION 4.00: $ CHOP S E=$F(JUNK," ",C) S F=E-2 S REF=$E(JUNK,C,F) QUIT ="A" DO ^AUTHSEAR QUIT DO ^SUBJ B(R,HOOF) DO ^BIN  QUIT UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT D +A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) AUTHFIND AUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT AUTHSEAR AUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT BIN BIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT BURN BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOCOMLIST W !!,^LIB(REF) W !!,^LIB(REF,1),! S TITL=REF DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(REF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT F DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(R%MU~mU~%%!Programmer Utilities Scratch AreaRESR1*;.EIL.ROU;1"TURNSTIL.ROU"RESR2TURNSTIL;1"TURNSTIL"&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #COMPARE S R=1 DO ^LISTER QUIT IB(REF,6) QUIT F DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(Re: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","DUST S ELIM=">" FOR A=1:1:26 S C=1 DO DUSTER S ELIM=ELIM_" " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QUIT S C=C-1 DO ^CHOP S ELIM=ELIM_" "_REF GOTO DUSTER " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QDEX." FOR R=^BEG:1:^ENT DO HORSE QUIT HORSE FOR HOOF=1,2,4,5 DO CATTLE QUIT CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN CHOOSE CHOOSE R !,"REFERENCE BY SUBJECT(CR) OR AUTHOR (A)?",CHO I CHO="A" DO ^AUTHSEAR QUIT DO ^SUBJ CHOP CHOP S E=$F(JUNK," ",C) S F=E-2 S REF=$E(JUNK,C,F) QUIT COMLIST COMLIST W !!,^LIB(REF) W !!,^LIB(REF,1),! S TITL=REF DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(REF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT COMPARE COMPARE S R=1 DO ^LISTER QUIT DUST DUST S ELIM=">" FOR A=1:1:26 S C=1 DO DUSTER S ELIM=ELIM_" " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QUIT S C=CELIMIN S C=$F(JUNK," ",C) IF C=0 S C=1 QUIT DO ^CHOP S S=$A(REF,1) I S=-1 QUIT I HOOF=1 GOTO TAIL I HOOF=5 GOTO TAIL IF $L(REF)<6 GOTO ELIMIN FOR T=1:1:^TRASH(S) IF REF=^TRASH(S,T) GOTO ELIMIN TAIL FOR T=1:1:^SHELF(S) IF REF=$P(^SHELF(S,T),":",1) DO ^SHELFER GOTO ELIMIN KNEE IF HOOF=1 DO ^FINDSHLF GOTO ELIMIN IF HOOF=5 DO ^FINDSHLF GOTO ELIMIN W !,REF R " ELIMINATE (E) OR KEEP (CR) ",M IF M="E" DO ^TRASH GOTO ELIMIN DO ^FINDSHLF GOTO ELIMIN F GOTO ELIMIN W !,REF R " ELIWORD) AARDCVARKANTEATERCAT DUMB FELINEDOG NOBLE CANINEZEBRA STRIPED HORSEFINDSHELF S A=$A(REF,1) S B=^SHELF(A) S ^SHELF(A)=^SHELF(A)+1 I B=0 GOTO FINDEL FIN I REF]^SHELF(A,B) S ^SHELF(A,B+1)=REF_":"_^LIB(R)_":." QUIT S ^SHELF(A,B+1)=^SHELF(A,B) S B=B-1 FINDEL I B=0 S ^SHELF(A,1)=REF_":"_^LIB(R)_":." QUIT GOTO FIN  CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN  QUIT "&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #LIB ; main subprogram PRESTART S L=^BEG START R !!,"MORE REFERENCES TO ENTER? (CR IS YES,N IS NO) ",AN IF AN="N" QUIT S ^LIB(L)=L S Y=0 S ^LIB(L,1)="" 27 R !,"AUTHOR: ",A GOTO:A="" 31 28 IF A="?" W !,"ENTER ONE AUTHOR: LASTNAME,FIRSTNAME; IF NO AUTHOR, ENTER CARRIAGE RETURN" GOTO 27 30 S ^LIB(L,1)=^LIB(L,1)_A_" " R !,"AUTHOR: ",A GOTO:A'="" 28 31 R !,"TITLE: ",T IF T="?" W !,"GIVE ARTICLE OR BOOK TITLE" GOTO 31 S ^LIB(L,2)=T_" " 32 R !,"BIBLIO: ",B IF B="?" W !,"ENTER JOURNAL,(EDITOR),DATE,VOLUME,PAGES" GOTO 32 S ^LIB(L,3)=B 40 R !,"SUMMARY: ",S IF S="" S ^LIBSUM(L)=Y GOTO 70 IF S="?" W !,"WRITE IN A SUMMARY OF THE ARTICLE IF THERE IS ONE" GOTO 40 S Y=Y+1 50 S ^LIB(L,4,Y)=S_" " S S="" GOTO 40 70 R !,"SUBJECT: ",R IF R="?" W !,"YOU MAY TYPE IN KEY REFERENCE WORDS TO USE AS SUBJECT INDICES FOR THIS ARTICLE." IF W !,"AS A METHOD TO KEEP A CURRENT REFERENCE BIBLIO FOR YOU OWN WORK; ALL THE BIBLIOS " IF W !,"UNDER 'JOESBIB' COULD LIST ALL THE REFERENCE YOU WISH TO KEEP LISTED AS A GROUP" GOTO 70 S ^LIB(L,5)=R_" " 80 R !,"WHERE: ",W IF W="?" W !,"LOCATION OF THE ARTICLE: JOES FILES, LIBRARY ONLY, ETC" GOTO 80 S ^LIB(L,6)=W R !!,"DO YOU WISH TO PROCESS REFERENCE WORDS? (CR FOR YES)",RE I RE="" S ^ENT=L DO ^CATALOG S ^BEG=L+1 GOTO PRESTART S L=L+1 GOTO START ISH TO PROCESS REFERENCE WORDS? (CR FOR YES)",RE I RE="" S ^ENT=L DO ^CATALOG LISTER S R=$F(^SHELF(L,A),":",R) LIST S T=$F(^SHELF(L,A),":",R) S U=T-2 S NUMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST I T=$L(^SHELF(L,A)) DO ^SHOWBOOK QUIT I QUIT GOTO LIST ) S U=T-2 S NUMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST +A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) AUTHFIND AUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT AUTHSEAR AUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT BIN BIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT BURN BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOOPENBOOK S ^BEG=1 K ^ENT K ^LIBSUM K ^LIB DO ^SHELF  ) S U=T-2 S NUMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST EF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT F DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(R%MU~mU~%%!Programmer Utilities Scratch AreaRESR1*;.EIL.ROU;1"TURNSTIL.ROU"RESR2TURNSTIL;1"TURNSTIL"&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #Comments for %M* routines October 13, 1983 15:01 ^%M("%M","%M",0) 11 ^%M("%M","%M",1) ************************ ^%M("%M","%M",2) * Programmer Utilities * ^%M("%M","%M",3) * * ^%M("%M","%M",4) * John Lewkowicz * ^%M("%M","%M",5) * NYSCVM 1/83 * ^%M("%M","%M",6) ************************ ^%M("%M","%M",7) ^%M("%M","%M",8) Main option and paramter pickup routine for programmer utility ^%M("%M","%M",9) routines to work on ROUTINES and GLOBALS. Assumes that the ^%M("%M","%M",10) terminal definition routines (%MTC & %MTCH) are loaded. ^%M("%M","%M",11) ^%M("%M","FDR",0) 13 ^%M("%M","FDR",1) For those commands that require a source drive, get the Drive designation ^%M("%M","FDR",2) (like A, B, C...H). Variable FDR then holds this drive ID. Has different ^%M("%M","FDR",3) meanings depending on the command: ^%M("%M","FDR",4) ^%M("%M","FDR",5) Directory - Drive on which Routines or Globals (R/G) reside. ^%M("%M","FDR",6) Edit - Drive on which R/G to be edited reside. ^%M("%M","FDR",7) List - Drive on which R/G to be listed reside. ^%M("%M","FDR",8) Find - Drive on which R/G to be searched reside. ^%M("%M","FDR",9) Change - Drive on which R/G to be changed reside. ^%M("%M","FDR",10) Save - Drive on which routines to be saved reside. ^%M("%M","FDR",11) Restore - Drive on which Save File resides. ^%M("%M","FDR",12) Kill - Drive on which R/G to be killed reside. ^%M("%M","FDR",13) ^%M("%M","FLAG",0) 5 ^%M("%M","FLAG",1) Flag Routines or Globals (as in ^%MU) to indicate that they are ^%M("%M","FLAG",2) to be processed. ^%M("%M","FLAG",3) ^%M("%M","FLAG",4) First check to see if the directory for the type (Routine or Global) ^%M("%M","FLAG",5) is defined. If not, automatically refresh directory. ^%M("%M","FLAG1",0) 7 ^%M("%M","FLAG1",1) If Directory is defined, ask User if they want to re-fresh. If so, ^%M("%M","FLAG1",2) refresh directory before going on to flag entities. Normally it ^%M("%M","FLAG1",3) is NOT necessary to refresh routinme directory since it is auto- ^%M("%M","FLAG1",4) matically done by the routines used to create, edit, and delete ^%M("%M","FLAG1",5) routines. Globals, however, can be created "on-the-sly" and often ^%M("%M","FLAG1",6) this directory must be updated to reflect the true nature of the ^%M("%M","FLAG1",7) globals available. ^%M("%M","FLAG2",0) 2 ^%M("%M","FLAG2",1) See if User wants to use the previous list of selected Routines or ^%M("%M","FLAG2",2) Globals. If so, skip the flagging section. ^%M("%M","FLAG3",0) 5 ^%M("%M","FLAG3",1) Flag the Routines/Globals in ^%MU to indicate those that are to be ^%M("%M","FLAG3",2) operated on. User can use the "*?" characters for a wild-card field ^%M("%M","FLAG3",3) and can also indicate that they do NOT want ranges of names. ^%M("%M","FLAG3",4) NOTE that if RESTORING routines or globals, The specifications are ^%M("%M","FLAG3",5) saved (^%MU("RESG" or "RESR",...)) and not the actual names. ^%M("%M","FUN",0) 15 ^%M("%M","FUN",1) Get the Function to be performed: ^%M("%M","FUN",2) ^%M("%M","FUN",3) D - Directory ^%M("%M","FUN",4) E - Edit ^%M("%M","FUN",5) L - List ^%M("%M","FUN",5.1) F - Find all occurences of a string ^%M("%M","FUN",5.2) C - Change all occurences of one string to another ^%M("%M","FUN",6) S - Save ^%M("%M","FUN",7) R - Restore ^%M("%M","FUN",8) K - Kill ^%M("%M","FUN",8.1) X - eXtended Directory (comments or top node if global) ^%M("%M","FUN",9) ^%M("%M","FUN",10) On finishing, the variable FUN will contain a single character that ^%M("%M","FUN",11) defines the desired function, and the variable FR contains a 2- ^%M("%M","FUN",12) character string defining function and type (e.g. "LR" is List ^%M("%M","FUN",13) Routine, "LG" is List Globals). ^%M("%M","FUN",14) ^%M("%M","FUN",15) Special check here for EDITING (either Globals or Routines). ^%M("%M","REFRESH",0) 2 ^%M("%M","REFRESH",1) Refresh the appropriate directory in ^%MU to reflect the current ^%M("%M","REFRESH",2) Global or Routine names existing on the selected disk. ^%M("%M","ROG",0) 3 ^%M("%M","ROG",1) See if User wants to work on Globals or Routines. Variable "Q" has ^%M("%M","ROG",2) the question label for displaying HELP text if User enters "?" or "??". ^%M("%M","ROG",3) Leave this section with ROG set to "G" for Globals, "R" for Routines. ^%M("%M","START",0) 12 ^%M("%M","START",1) Main loop entry point. Assumes that the following variables are set: ^%M("%M","START",2) ^%M("%M","START",3) DS - ";" ^%M("%M","START",4) FF - character string to clear screen (from ^%MTC) ^%M("%M","START",5) RM - Screen's right margin (from ^%MTC) ^%M("%M","START",6) HL - character sequence to go to DIM intensity (from ^%MTC) ^%M("%M","START",7) LH - character sequence to go to HIGH intensity (from ^%MTC) ^%M("%M","START",8) SDR - Default ROUTINE system drive to go back to after a change in ^%M("%M","START",9) after changing a drive. ^%M("%M","START",10) SDG - Default GLOBAL system drive to return to after possibly altering ^%M("%M","START",10.1) drive to work on globals. ^%M("%M","START",11) ^%M("%M","START",12) Start by clearing screen and displaying heading. ^%M("%M","TDR",0) 1 ^%M("%M","TDR",1) If necessary, get an output device (IO). ^%M("%M0","%M0",0) 2 ^%M("%M0","%M0",1) Process some of the Programmer Utility options that can be selected ^%M("%M0","%M0",2) in option dispatch routine %M. ^%M("%M0","DIR",0) 5 ^%M("%M0","DIR",1) Display either ROUTINE or GLOBAL directory held in ^%MU (under ^%M("%M0","DIR",2) 1st level subscript "ROU" or "GBL") on the current device ($I) ^%M("%M0","DIR",3) and flag selected entries with a "->". ^%M("%M0","DIR",4) Before looking in ^%MU switch to desired drive (FDR) and then restore ^%M("%M0","DIR",5)  back to default drives (SDR and SDG) before returning. ^%M("%M0","GLIST",0) 5 ^%M("%M0","GLIST",1) List a GLOBAL (or part of a Global) to the device specified by the ^%M("%M0","GLIST",2) variable IO. ^%M("%M0","GLIST",3) ^%M("%M0","GLIST",4) First thing to do is set to look for globals on the Drive chosen ^%M("%M0","GLIST",5) by the User (variable FDR). ^%M("%M0","GLIST1",0) 13 ^%M("%M0","GLIST1",1) Get the Global Reference to be dumped. Three types of entry can ^%M("%M0","GLIST1",2) be made: ^%M("%M0","GLIST1",3) ^%M("%M0","GLIST1",4) 1. Global Name only (NO subscripts specified) will cause the ENTIRE ^%M("%M0","GLIST1",5) global to be dumped. ^%M("%M0","GLIST1",6) 2. Global reference with subscripts specified which is a COMPLETE ^%M("%M0","GLIST1",7) reference (e.g. number of right & left parenthesis are the same). ^%M("%M0","GLIST1",8) In this case ONLY the specified NODE will be listed. ^%M("%M0","GLIST1",9) 3. Incomplete subscript reference (like "^ABC(1,2"). This will result ^%M("%M0","GLIST1",10) in a list of all global nodes from the specified node and DOWN ^%M("%M0","GLIST1",11) to be displayed. ^%M("%M0","GLIST1",12) ^%M("%M0","GLIST1",13) NOTE - uses the $ZO function to loop through the specified global. ^%M("%M0","GLIST2",0) 4 ^%M("%M0","GLIST2",1) Display 1 reference. Variable G1 contains the reference, and G2 con- ^%M("%M0","GLIST2",2) tains the data held at that reference. Display the reference and ^%M("%M0","GLIST2",3) then calculate where the data will be displayed (from $X) in case ^%M("%M0","GLIST2",4) the data requires more than 1 line. ^%M("%M0","GLIST3",0) 2 ^%M("%M0","GLIST3",1) Output from one to many line containing the data held at the reference. ^%M("%M0","GLIST3",2) Allign the start of each data line with the reference. ^%M("%M0","LDIR",0) 3 ^%M("%M0","LDIR",1) Display list of ROUTINES or GLOBALS in ^%MU from the chosen drive ^%M("%M0","LDIR",2) (FDR) on the selected device (IO), restoring to the default drives ^%M("%M0","LDIR",3) (SDR and SDG) before returning. ^%M("%M0","READ",0) 3 ^%M("%M0","READ",1) Standard keyboard read. return with E=0 if read OK, but if entry ^%M("%M0","READ",2) was either "?" or "??", dispatch to Help Text routine %M9 and set ^%M("%M0","READ",3) flag E=1 so question can be repeated. ^%M("%M0","RLIST",0) 7 ^%M("%M0","RLIST",1) List the ROUTINES flagged in the routine directory to the device ^%M("%M0","RLIST",2) defined in variable IO. ^%M("%M0","RLIST",3) ^%M("%M0","RLIST",4) After getting Date & Time and seeing if User wants comments listed ^%M("%M0","RLIST",5) too, initialize the variable X1-X4 from the labels X1-X4. These ^%M("%M0","RLIST",6) are eXecuted to do the actual print (since the routine that is ^%M("%M0","RLIST",7) to be printed will be loaded into the partition). ^%M("%M0","SDIR",0) 3 ^%M("%M0","SDIR",1) Display list of SELECTED Routines or Globals in ^%MU from the desired ^%M("%M0","SDIR",2) drive (FDR) on the current device ($I), restoring the drive to the ^%M("%M0","SDIR",3) default values (SDR and SDC) before returning. ^%M("%M0","UPPER",0) 2 ^%M("%M0","UPPER",1) Convert string in A to upper-case, returned in UA. Variable A is ^%M("%M0","UPPER",2) left untouched. ^%M("%M0","X1",0) 5 ^%M("%M0","X1",1) X1-X4 are loaded into variables X1-X4 and eXecuted to do the actual ^%M("%M0","X1",2) print. ^%M("%M0","X1",3) Loop through routine index in ^%MU and prepare to print each of the ^%M("%M0","X1",4) flagged routines. Load the routine to be printed, calculate Size ^%M("%M0","X1",5) (SIZ), and initialize Page (P) number. ^%M("%M0","X2",0) 4 ^%M("%M0","X2",1) Loop thru the program loaded in the partition picking up each line ^%M("%M0","X2",2) in the variable X. If the 1st line or if at end of page, eXecute ^%M("%M0","X2",3) X4 for new page. EXecute X3 to print comments (if any) first, and then ^%M("%M0","X2",4) print the logical line on one or more physical lines. ^%M("%M0","X3",0) 1 ^%M("%M0","X3",1) If User wants comments, and they are defined in ^%M, print them. ^%M("%M0","X4",0) 1 ^%M("%M0","X4",1) Start new page and display heading. ^%M("%M1","%M1",0) 2 ^%M("%M1","%M1",1) EDIT control for Routines and Globals ^%M("%M1","%M1",2) ^%M("%M1","EDIT",0) 4 ^%M("%M1","EDIT",1) Reset $ZE, put the routine name in the scratch global, and then ^%M("%M1","EDIT",2) establish naked reference and default pointers (LP1 and LP2) ^%M("%M1","EDIT",3) and other misc. starting values in preparation for editing the ^%M("%M1","EDIT",4) routine. ^%M("%M1","EDITA",0) 12 ^%M("%M1","EDITA",1) Set display to HIGH intensity and then pass control to routine ^%M("%M1","EDITA",2) %ZEDT to do actual editing. ^%M("%M1","EDITA",3) ^%M("%M1","EDITA",4) On return, if the general keyboard variable A starts with a semicolon ^%M("%M1","EDITA",5) (;) it indicates that the user is entering a comment (rest of A ^%M("%M1","EDITA",6) contains label for which comment is to be added) so we set up to ^%M("%M1","EDITA",7) use the same editor (%ZEDT) by now pointing into the comment ^%M("%M1","EDITA",8) global %C indexed by the program name and label. ^%M("%M1","EDITA",9) ^%M("%M1","EDITA",10) Otherwise, see if user finished with a S_ave command. If so, save ^%M("%M1","EDITA",11) the routine and put the routine name in the routine directory ^%M("%M1","EDITA",12) in ^%MU. ^%M("%M1","GEDIT",0) 6 ^%M("%M1","GEDIT",1) GLOBAL EDIT - ^%M("%M1","GEDIT",2) ^%M("%M1","GEDIT",3) Switch to desired drive and then get the global reference that is to ^%M("%M1","GEDIT",4) be edited. The logic controling the global specification and scan ^%M("%M1","GEDIT",5) is almost identical to that define when listing globals so see the ^%M("%M1","GEDIT",6) comments under GLIST^%M0. ^%M("%M1","GEDIT2",0) 5 ^%M("%M1","GEDIT2",1) With the current reference (G1) and data node (G2), loop through ^%M("%M1","GEDIT2",2) asking for strings that are to be changed and what they are to ^%M("%M1","GEDIT2",3) be changed to. On each pass, the local data node value (in G2) ^%M("%M1","GEDIT2",4) is updated but the global reference (G1) is not updated until ^%M("%M1","GEDIT2",5) GEDIT4. ^%M("%M1","GEDIT4",0) 3 ^%M("%M1","GEDIT4",1) Display the change(s) and update the global reference. Then see if ^%M("%M1","GEDIT4",2) user want to work on this node AGAIN, CONTINUE to the next node, ^%M("%M1","GEDIT4",3) or STOP editing this global. ^%M("%M1","READ",0) 3 ^%M("%M1","READ",1) Standard keyboard read retuning exact read in A, upper-case of A ^%M("%M1","READ",2) in UA and the variable E set to false if read OK or True if ^%M("%M1","READ",3) question needs repeating (e.g. displayed Help text). ^%M("%M1","REDIT",0) 14 ^%M("%M1","REDIT",1) EDIT ROUTINES - ^%M("%M1","REDIT",2) ^%M("%M1","REDIT",3) Switch Drives to look at drive FDR, then get the name of the routine ^%M("%M1","REDIT",4) to be edited. All done if user enters "^", "X", or "". ^%M("%M1","REDIT",5) If entry is "?L" or "?S", display routine directory and go back to ^%M("%M1","REDIT",6) name question. ^%M("%M1","REDIT",7) If the User enters "*" or "RESTART", assume they want to enter the ^%M("%M1","REDIT",8) routine already in ^%MRE. ^%M("%M1","REDIT",9) NOTE - the scratch global used for editing (%MRE) is to be located ^%M("%M1","REDIT",10) on the SAME drive as the routine being edited ! ^%M("%M1","REDIT",11) ^%M("%M1","REDIT",12) Otherwise, kill the scratch edit global (%MRE), and then setup $ZE ^%M("%M1","REDIT",13) to go to NEW if we get an error while trying to load the desired ^%M("%M1","REDIT",14) routine (routine dosen't exist on the indicated drive). ^%M("%M1","REND",0) 2 ^%M("%M1","REND",1) Switch back to default routine and global drives and go back to ^%M("%M1","REND",2) main options. ^%M("%M1","UPPER",0) 1 ^%M("%M1","UPPER",1)  Convert string in A to upper-case returned in variable UA. ^%M("%M1","XEQ",0) 7 ^%M("%M1","XEQ",1) Load the named routine and move into the editing global %MRE. ^%M("%M1","XEQ",2) ^%M("%M1","XEQ",3) NOTE - assumes that $ZE is set and ready to trap to label NEW ^%M("%M1","XEQ",4) if the routine dosen't exist. Also, creates an error on purpose at ^%M("%M1","XEQ",5) the end of the transfer to get back to EDIT%M1 so that we don't ^%M("%M1","XEQ",6) leave any loose ends (pending DO's etc.) since all NEW routines ^%M("%M1","XEQ",7) will automatically cause an error trap to NEW. ^%M("%M2","%M2",0) 7 ^%M("%M2","%M2",1) Programmer Utitlities - continuation from %M ^%M("%M2","%M2",2) ^%M("%M2","%M2",3) Process ROUTINE DELETE ^%M("%M2","%M2",4) GLOBAL DELETE ^%M("%M2","%M2",5) ROUTINE FIND ^%M("%M2","%M2",6) GLOBAL FIND ^%M("%M2","%M2",7) ^%M("%M2","FG1",0) 6 ^%M("%M2","FG1",1) 1st see if global namer also contains data (i.e. without subscripts), ^%M("%M2","FG1",2) if so, s D= data node and G contains reference - go check node ^%M("%M2","FG1",3) (via FG2). ^%M("%M2","FG1",4) ^%M("%M2","FG1",5) Then loop through the global and check (via FG2) each node for a possible ^%M("%M2","FG1",6) match. ^%M("%M2","FG2",0) 4 ^%M("%M2","FG2",1) Given the data node (defined in variable D), loop through the Find ^%M("%M2","FG2",2) specifications (in array F) and see if the data node matches any ^%M("%M2","FG2",3) of the specifications. If so, Do FG3 (write out the match to the ^%M("%M2","FG2",4) output device). ^%M("%M2","FG3",0) 2 ^%M("%M2","FG3",1) Had a HIT in the search, display the global reference (in G) and ^%M("%M2","FG3",2) then display the data on which we HIT (via FG4). ^%M("%M2","FIND",0) 4 ^%M("%M2","FIND",1) Common section (both ROUTINES and GLOBALS) used to get find specifications ^%M("%M2","FIND",2) and control search for those specifications. ^%M("%M2","FIND",3) ^%M("%M2","FIND",4) Select indicated drive and setup to get Find Specifications. ^%M("%M2","FIND1",0) 1 ^%M("%M2","FIND1",1) Get a string or pattern match to search for. ^%M("%M2","FIND2",0) 3 ^%M("%M2","FIND2",1) Quit if no specifications made, otherwise Use the outpur device ^%M("%M2","FIND2",2) and dispatch control to do search depending on whether we are doing ^%M("%M2","FIND2",3) routines or globals. ^%M("%M2","FINDG",0) 1 ^%M("%M2","FINDG",1) Special section to control searching through globals. ^%M("%M2","FINDR",0) 6 ^%M("%M2","FINDR",1) Process ROUTINE finds. ^%M("%M2","FINDR",2) ^%M("%M2","FINDR",3) Load up the local variables X1-X4 from labels X1-X4 to do the actual ^%M("%M2","FINDR",4) search through the routines. The routines are loaded into the partition ^%M("%M2","FINDR",5) (that's why we eXecute the search out of variables) and then searched ^%M("%M2","FINDR",6) line by line for possible finds. ^%M("%M2","GDEL",0) 4 ^%M("%M2","GDEL",1) GLOBAL DELETE ^%M("%M2","GDEL",2) ^%M("%M2","GDEL",3) Setup for a global delete (Q is question label for HELP text), and then ^%M("%M2","GDEL",4) go to RDEL1 for common (with routines) delete section. ^%M("%M2","GFIND",0) 5 ^%M("%M2","GFIND",1) GLOBAL FIND ^%M("%M2","GFIND",2) ^%M("%M2","GFIND",3) Entry point for global searches. First get the global reference, ^%M("%M2","GFIND",4) setup for search, and then dispatch control to FIND to get Find ^%M("%M2","GFIND",5) specifications and do the actual search. ^%M("%M2","RDEL",0) 4 ^%M("%M2","RDEL",1) ROUTINE DELETE ^%M("%M2","RDEL",2) ^%M("%M2","RDEL",3) Switch to selected drive and then get ready (i.e. set question Q ^%M("%M2","RDEL",4) to Routines) to DELETE routines. ^%M("%M2","RDEL1",0) 10 ^%M("%M2","RDEL1",1) This section is used for both ROUTINES and GLOBALS. ^%M("%M2","RDEL1",2) ^%M("%M2","RDEL1",3) First give User a chance to back out (or at least verify) that they ^%M("%M2","RDEL1",4) want to KILL. Ask for verification. ^%M("%M2","RDEL1",5) ^%M("%M2","RDEL1",6) If response is "?L" or "?S", display directory and re-ask question. ^%M("%M2","RDEL1",7) ^%M("%M2","RDEL1",8) Loop through ^%MU and eliminate the desired (flagged) routines or ^%M("%M2","RDEL1",9) globals. If working on routines, also delete the comments held in ^%M("%M2","RDEL1",10) ^%M. ^%M("%M2","READ",0) 1 ^%M("%M2","READ",1) Standard keyboard read. ^%M("%M2","RFIND",0) 5 ^%M("%M2","RFIND",1) ROUTINE FIND ^%M("%M2","RFIND",2) ^%M("%M2","RFIND",3) Setup to do Routine Find. First set Q for question (routines) and ^%M("%M2","RFIND",4) then go get strings to be found (via FIND). When done with FIND, ^%M("%M2","RFIND",5) Close output device (if not primary device) and Quit. ^%M("%M2","UPPER",0) 1 ^%M("%M2","UPPER",1) Convert string in A to upper-case, returned in UA. ^%M("%M3","%M3",0) 4 ^%M("%M3","%M3",1) Programmer Utilities - continuation from %M. ^%M("%M3","%M3",2) ^%M("%M3","%M3",3) Process ROUTINE CHA NGE and ^%M("%M3","%M3",4) GLOBAL CHANGE options. ^%M("%M3","FROMTO",0) 2 ^%M("%M3","FROMTO",1) Get list of strings to change FROm and what they should be replaced ^%M("%M3","FROMTO",2) by (TO). Results are left in the FROM and TO arrays. ^%M("%M3","GC1",0) 11 ^%M("%M3","GC1",1) Get the global reference to be changed. Looping through the global ^%M("%M3","GC1",2) will be controlled by how the reference was specified: ^%M("%M3","GC1",3) ^%M("%M3","GC1",4) 1. Global name ONLY (i.e. "^XXX" ) will cause the ENTIRE global ^%M("%M3","GC1",5) to be scanned for changes. ^%M("%M3","GC1",6) 2. Full global reference (i.e. "^XXX(1,2)" ) will cause ONLY the ^%M("%M3","GC1",7) SPECIFIED node to be scanned/changed. ^%M("%M3","GC1",8) 3. Partial reference (i.e. "^XYZ(1" ) will cause a scan of the ^%M("%M3","GC1",9) defined node and ALL nodes below that node. ^%M("%M3","GC1",10) ^%M("%M3","GC1",11) Loop through the FROM and TO array and display them for the user. ^%M("%M3","GC2",0) 6 ^%M("%M3","GC2",1) Get the reference and check for the obvious ("^", "?L" etc.). Then ^%M("%M3","GC2",2) setup variables for search through global. ^%M("%M3","GC2",3) ^%M("%M3","GC2",4) If the initial reference contains data, check it for changes. ^%M("%M3","GC2",5) ^%M("%M3","GC2",6) Then loop through global getting each node and checking for changes. ^%M("%M3","GC3",0) 5 ^%M("%M3","GC3",1) Have a data node in D with the reference in G. Check it against all ^%M("%M3","GC3",2) of the FROM/TO elements (in order they were entered). When done ^%M("%M3","GC3",3) variable MOD will be TRUE if changes and the variable Z will contain ^%M("%M3","GC3",4) the new data element (D holds the old one). If modified, write the ^%M("%M3","GC3",5) old and new lines out and update the global. ^%M("%M3","GC35",0) 4 ^%M("%M3","GC35",1) Write out the data node (in A) to selected device. Only write out ^%M("%M3","GC35",2) that which will fit on the line (designated by Y), and put remainder ^%M("%M3","GC35",3) on other lines (indenting in to start where the original data started ^%M("%M3","GC35",4) as reflected by X). ^%M("%M3","GC4",0) 4 ^%M("%M3","GC4",1) See if the current data node (Z) contains the FROM string. If so, ^%M("%M3","GC4",2) set the flag MOD to TRUE to indicate change, then loop through ^%M("%M3","GC4",3) string in Z making substitutions (building new line NL). When ^%M("%M3","GC4",4) done, leave updated string in Z. ^%M("%M3","GC5",0) 1 ^%M("%M3","GC5",1) Substitute TO for FROM building new data node in variable NL. ^%M("%M3","GCEND",0) 2 ^%M("%M3","GCEND",1) Clean up partition, close output device if not primary device, ^%M("%M3","GCEND",2) and switch back to default drives. ^%M("%M3","GCHANGE",0) 8 ^%M("%M3","GCHANGE",1) GLOBAL CHANGE ^%M("%M3","GCHANGE",2) ^%M("%M3","GCHANGE",3) Switch to desired Drive and then get list of FROM and TO's (held in ^%M("%M3","GCHANGE",4) local arrays FROM and TO). The basic operation of this section is to ^%M("%M3","GCHANGE",5) get a global reference (one or many nodes), then loop through the specifed ^%M("%M3","GCHANGE",6) references changing each FROM element to a TO element. When done with ^%M("%M3","GCHANGE",7) the specified reference, loop back for another reference using the ^%M("%M3","GCHANGE",8) SAME FROM and TO elements. ^%M("%M3","RCHANGE",0) 9 ^%M("%M3","RCHANGE",1) ROUTINE CHANGE ^%M("%M3","RCHANGE",2) ^%M("%M3","RCHANGE",3) Switch to desired drive and then go get list of strings to change ^%M("%M3","RCHANGE",4) FROM (held in FROM array), and list to be changed TO (in TO array). ^%M("%M3","RCHANGE",5) ^%M("%M3","RCHANGE",6) Open output device then load up the local variables X1-X3 that ^%M("%M3","RCHANGE",7) will be eXecuted to do actual routine searches and changes.. ^%M("%M3","RCHANGE",8) ^%M("%M3","RCHANGE",9) EXecute X1-X3 to load, check and modify routines. ^%M("%M3","READ",0) 1 ^%M("%M3","READ",1) Standard keyboard Read. ^%M("%M3","UPPER",0) 1 ^%M("%M3","UPPER",1) Copnvert string in A to upper-case. Leave A untouched. ^%M("%M3","X1",0) 4 ^%M("%M3","X1",1) X1-X3 Are loaded into local variables X1-X3 and are eXecuted to loop ^%M("%M3","X1",2) through the routines flagged in ^%MU and then loop through each ^%M("%M3","X1",3) line of the routine making FROM-->TO changes from the FROM and TO ^%M("%M3","X1",4) arrays. ^%M("%M4","%M4",0) 11 ^%M("%M4","%M4",1) Programmer Utilities - continuation from %M ^%M("%M4","%M4",2) ^%M("%M4","%M4",3) Process ROUTINE SAVE ^%M("%M4","%M4",4) GLOBAL SAVE ^%M("%M4","%M4",5) ROUTINE RESTORE (with comments) ^%M("%M4","%M4",6) GLOBAL RESTORE ^%M("%M4","%M4",7) ^%M("%M4","%M4",8) ^%M("%M4","%M4",9) If doing a RESTORE, go get the Description and the Date & Time node ^%M("%M4","%M4",10) from the restore file. $ZE is set to trap errors if there is no ^%M("%M4","%M4",11) file around.  ^%M("%M4","COM",0) 1 ^%M("%M4","COM",1) Ask if User wants to SAVE/RESTORE comments with the routines. ^%M("%M4","DATIM",0) 1 ^%M("%M4","DATIM",1) If doing a SAVE, get free-text date & time. ^%M("%M4","DESC",0) 1 ^%M("%M4","DESC",1) If doing a SAVE, get free-text Description of file. ^%M("%M4","DISPATCH",0) 8 ^%M("%M4","DISPATCH",1) Select the desired Routine/Global drive and then dispatch control to ^%M("%M4","DISPATCH",2) the appropriate code: ^%M("%M4","DISPATCH",3) ^%M("%M4","DISPATCH",4) RG - GLOBAL Restore ^%M("%M4","DISPATCH",5) SG - GLOBAL Save ^%M("%M4","DISPATCH",6) RR - Routine Restore ^%M("%M4","DISPATCH",7) SR - Routine Save ^%M("%M4","DISPATCH",8) ^%M("%M4","M41",0) 2 ^%M("%M4","M41",1) Check to see if doing ROUTINES. If so, want to find out if User wants ^%M("%M4","M41",2) to do comments as well (either SAVE or RESTORE). ^%M("%M4","M43",0) 3 ^%M("%M4","M43",1) On GLOBAL SAVE, see if the user wants to limit the size of the output ^%M("%M4","M43",2) file. Useful in backing up a large global on multiple volumes. Default ^%M("%M4","M43",3) vale is about 10 Mbytes. ^%M("%M4","READ",0) 1 ^%M("%M4","READ",1) Standard keyboard read. ^%M("%M4","READY",0) 1 ^%M("%M4","READY",1) Display the Description, Date & Time for User verification. ^%M("%M4","READY1",0) 5 ^%M("%M4","READY1",1) After displaying Description and Date, ask if User ready. If so, ^%M("%M4","READY1",2) go to DISPATCH if RESTORE is going on. Otherwise, get ready to ^%M("%M4","READY1",3) output Description and Date & Time as headers to the file. Set ^%M("%M4","READY1",4) $ZE to trap if the file already exists. Otherwise go to DISPATCH ^%M("%M4","READY1",5) after writing headers. ^%M("%M4","RX",0) 17 ^%M("%M4","RX",1) Read a line from the specified input device. If NOT device 5 (reader ^%M("%M4","RX",2) punch, used to computer-to-computer transafers), simply read into ^%M("%M4","RX",3) th variable A. ^%M("%M4","RX",4) If it is DEVICE 5, then there is some handshaking to be done. The ^%M("%M4","RX",5) program TRANSMITTING data must already be running on the other ^%M("%M4","RX",6) machine (it might be, or at least will look like Part TX below). ^%M("%M4","RX",7) It is waiting for a CR-LF (via READ) before sending each line. ^%M("%M4","RX",8) ^%M("%M4","RX",9) 1. Send CR-LF and read line of data into A. If nothing coming down the ^%M("%M4","RX",10) line after 10 seconds, increment error count (N) and re-try if less ^%M("%M4","RX",11) than 10. ^%M("%M4","RX",12) 2. Send CR-LF to xmitter and read verification line (length of data line). ^%M("%M4","RX",13) If nothing in 10 seconds, increment error counter (N) and try again ^%M("%M4","RX",14) if count less than 10. Otherwise a Sync. error. ^%M("%M4","RX",15) 3. If the verification line (2.) is the same as the length of the data ^%M("%M4","RX",16) line, then OK. Send back to xmitter a final OK ("") or retry ("<~>") ^%M("%M4","RX",17) message. Loop back if not OK. ^%M("%M4","TX",0) 10 ^%M("%M4","TX",1) Write the data element in A out to the device in IO. If NOT Device 5 ^%M("%M4","TX",2) (computer-to-computer link), simply write the data out. It it IS ^%M("%M4","TX",3) device 5 then: ^%M("%M4","TX",4) ^%M("%M4","TX",5) 1. Wait til reciever running (wait via READ for CR-LF). ^%M("%M4","TX",6) 2. Write out the data line. ^%M("%M4","TX",7) 3. Wait til reciever ready for verify line (READ a CR-LF). ^%M("%M4","TX",8) 4. Write out a data verification line (length of data node). ^%M("%M4","TX",9) 5. Read a final OK from reciever (Last Read). If OK="" then data recieved ^%M("%M4","TX",10) alright and quit. Otherwise, error so re-transmit entire line. ^%M("%M4","UPPER",0) 1 ^%M("%M4","UPPER",1) Convert string in A to upper-case (returned in UA). ^%M("%M5","%M5",0) 14 ^%M("%M5","%M5",1) Extension of Programmer Utilities (%M) used to get Terminal options ^%M("%M5","%M5",2) and dispatch control. ^%M("%M5","%M5",3) ^%M("%M5","%M5",4) Option Description ^%M("%M5","%M5",5) 1 Used to DEFINE a terminal (i.e. its parameters such as screen ^%M("%M5","%M5",6) length/width, cursor positioning commands etc.). ^%M("%M5","%M5",7) 2 Used to tie one of the terminals defined by option 1 to a ^%M("%M5","%M5",8) particular port number (like 0 for Console, 1 for printer, etc). ^%M("%M5","%M5",9) ^%M("%M5","%M5",10) NOTE - after using option 2, we issue a D CURRENT^%MTC in case the ^%M("%M5","%M5",11) user changed the primary IO device (console). ^%M("%M5","%M5",12) ^%M("%M5","%M5",13) ALSO contains an extension to %M0 (FLAG3...) included here to keep %M ^%M("%M5","%M5",14) under 4,000 bytes. ^%M("%M5","FLAG3",0) 5 ^%M("%M5","FLAG3",1) Flag the Routines/Globals in ^%MU to indicate those that are to be ^%M("%M5","FLAG3",2) operated on. User can use the "*?" characters for a wild-card field ^%M("%M5","FLAG3",3) and can also indicate that they do NOT want  ranges of names. ^%M("%M5","FLAG3",4) NOTE that if RESTORING routines or globals, The specifications are ^%M("%M5","FLAG3",5) saved (^%MU("RESG" or "RESR",...)) and not the actual names. ^%M("%M5","FLAGIT",0) 2 ^%M("%M5","FLAGIT",1) Go through and flag as TRUE (1) all entities with the Name or, if ^%M("%M5","FLAGIT",2) NOT, flag as FALSE (0). ^%M("%M6","DISPATCH",0) 8 ^%M("%M6","DISPATCH",1) Select the desired Routine/Global drive and then dispatch control to ^%M("%M6","DISPATCH",2) the appropriate code: ^%M("%M6","DISPATCH",3) ^%M("%M6","DISPATCH",4) RG - GLOBAL Restore ^%M("%M6","DISPATCH",5) SG - GLOBAL Save ^%M("%M6","DISPATCH",6) RR - Routine Restore ^%M("%M6","DISPATCH",7) SR - Routine Save ^%M("%M6","DISPATCH",8) ^%M("%M6","GS1",0) 4 ^%M("%M6","GS1",1) First see if there is data at the name level. If so, write the reference ^%M("%M6","GS1",2) and data out. Otherwise, drop down and loop through the designated ^%M("%M6","GS1",3) global writing out the reference on one line and the data on the ^%M("%M6","GS1",4) next line. ^%M("%M6","GS2",0) 3 ^%M("%M6","GS2",1) If we have exceeded the number of bytes the user defined for the ^%M("%M6","GS2",2) OUTput file, close the current file and allow user to insert another ^%M("%M6","GS2",3) disk and specify a new filespecification to continue the global save. ^%M("%M6","READ",0) 1 ^%M("%M6","READ",1) Standard keyboard read. ^%M("%M6","RG",0) 13 ^%M("%M6","RG",1) GLOBAL RESTORE ^%M("%M6","RG",2) ^%M("%M6","RG",3) Setup and read through restore file picking up each pair of restore ^%M("%M6","RG",4) values (G is a global reference like "^ABC(1)", and D is the data that ^%M("%M6","RG",5) should be stored at that location (can be a null). Check to see if the ^%M("%M6","RG",6) name has changed (old name in OG). If not, set the reference to the ^%M("%M6","RG",7) data value. ^%M("%M6","RG",8) ^%M("%M6","RG",9) If the name has changed, set the new name (OG) and then check to see ^%M("%M6","RG",10) if this is one of the names to be restored (RG5). If so (GO=1), set ^%M("%M6","RG",11) this node (G and D) and loop back up. ^%M("%M6","RG",12) If this name is NOT to be restored, loop through data entries until a ^%M("%M6","RG",13) another name is encountered. ^%M("%M6","RG5",0) 10 ^%M("%M6","RG5",1) We have a NEW global name (in OG like "^ABC") and now we have to ^%M("%M6","RG5",2) check and see if this global is to be restored. Loop through the ^%M("%M6","RG5",3) restore specifcations in ^%MU. Each specification consists of the ^%M("%M6","RG5",4) original user entry (like "'A2*") followed by ";", and then the ^%M("%M6","RG5",5) argument for an indirect IF used to test the name. Each name is checked ^%M("%M6","RG5",6) against ALL of the specifications, in the order they were entered, ^%M("%M6","RG5",7) since a name could be included in a general specification, later ^%M("%M6","RG5",8) eliminated from consideration (with a "'"), and still later included ^%M("%M6","RG5",9) again. When done, the flag GO will vbe TRUE or FALSE indicating whether ^%M("%M6","RG5",10) or not the name should be included. ^%M("%M6","RR",0) 8 ^%M("%M6","RR",1) ROUTINE RESTORE ^%M("%M6","RR",2) ^%M("%M6","RR",3) Restore Routines and [optionally] comments. First get a free sequential ^%M("%M6","RR",4) port (RO) so that we can save routines directly into a CP/M file ^%M("%M6","RR",5) with a ".MMP" extension. Then loop through and restore indicated ^%M("%M6","RR",6) routines and then loop through and restore comments for the indicated ^%M("%M6","RR",7) routines. NOTE that section GO is used to determine whether or not ^%M("%M6","RR",8) the routine name in R matches specifications in ^%MU(FDR. ^%M("%M6","RX",0) 17 ^%M("%M6","RX",1) Read a line from the specified input device. If NOT device 5 (reader ^%M("%M6","RX",2) punch, used to computer-to-computer transafers), simply read into ^%M("%M6","RX",3) th variable A. ^%M("%M6","RX",4) If it is DEVICE 5, then there is some handshaking to be done. The ^%M("%M6","RX",5) program TRANSMITTING data must already be running on the other ^%M("%M6","RX",6) machine (it might be, or at least will look like Part TX below). ^%M("%M6","RX",7) It is waiting for a CR-LF (via READ) before sending each line. ^%M("%M6","RX",8) ^%M("%M6","RX",9) 1. Send CR-LF and read line of data into A. If nothing coming down the ^%M("%M6","RX",10) line after 10 seconds, increment error count (N) and re-try if less ^%M("%M6","RX",11) than 10. ^%M("%M6","RX",12) 2. Send CR-LF to xmitter and read verification line (length of data line). ^%M("%M6","RX",13) If nothing in 10 seconds, increment error counter (N) and try again ^%M("%M6","RX",14) if count less than 10. Otherwise a Sync. error. ^%M("%M6","RX",15) 3. If the verification line (2.) is the same as the length of the data ^%M("%M6","R X",16) line, then OK. Send back to xmitter a final OK ("") or retry ("<~>") ^%M("%M6","RX",17) message. Loop back if not OK. ^%M("%M6","SG",0) 5 ^%M("%M6","SG",1) SAVE GLOBAL(s) ^%M("%M6","SG",2) ^%M("%M6","SG",3) Loop through the Global directory in ^%MU and pick out each global ^%M("%M6","SG",4) name that has been selected. Do part GS1 to write out each individual ^%M("%M6","SG",5) global. ^%M("%M6","SR",0) 5 ^%M("%M6","SR",1) ROUTINE SAVE ^%M("%M6","SR",2) ^%M("%M6","SR",3) Setup local variables X1-X3 that will be executed to do the actual ^%M("%M6","SR",4) save of the routines and comments. X1 controls saving of routines and ^%M("%M6","SR",5) X2-X3 control saving of comments. ^%M("%M6","TX",0) 10 ^%M("%M6","TX",1) Write the data element in A out to the device in IO. If NOT Device 5 ^%M("%M6","TX",2) (computer-to-computer link), simply write the data out. It it IS ^%M("%M6","TX",3) device 5 then: ^%M("%M6","TX",4) ^%M("%M6","TX",5) 1. Wait til reciever running (wait via READ for CR-LF). ^%M("%M6","TX",6) 2. Write out the data line. ^%M("%M6","TX",7) 3. Wait til reciever ready for verify line (READ a CR-LF). ^%M("%M6","TX",8) 4. Write out a data verification line (length of data node). ^%M("%M6","TX",9) 5. Read a final OK from reciever (Last Read). If OK="" then data recieved ^%M("%M6","TX",10) alright and quit. Otherwise, error so re-transmit entire line. ^%M("%M6","UPPER",0) 1 ^%M("%M6","UPPER",1) Convert string in A to upper-case (returned in UA). ^%M("%M8","%M8",0) 6 ^%M("%M8","%M8",1) If this is the FIRST time that the programmer utiltities have been ^%M("%M8","%M8",2) run and neither the default drives (^%MD) nor the basic terminal ^%M("%M8","%M8",3) definitions (^%MTC) have been defined, this routine will do so. ^%M("%M8","%M8",4) ^%M("%M8","%M8",5) The routine can be directly invoked at any time (D ^%M8) to change ^%M("%M8","%M8",6) the default routine and global drives. ^%M("%MTC","%MTC",0) 37 ^%M("%MTC","%MTC",1) Terminal Characteristics ^%M("%MTC","%MTC",2) John Lewkowicz - NYS Collge of Veterinary Medicine, Cornell University ^%M("%MTC","%MTC",3) ^%M("%MTC","%MTC",4) %MTC - Entry point to get a device number (asked if variable IO is NOT ^%M("%MTC","%MTC",5) defined) and then get and return the following variables defining the ^%M("%MTC","%MTC",6) terminal (NOTE, that if there is a startup string defined for the ^%M("%MTC","%MTC",7) requested device, it will be sent to that device before control is ^%M("%MTC","%MTC",8) to the User): ^%M("%MTC","%MTC",9) ^%M("%MTC","%MTC",10) IOFF - character string necessary to clear screen or do Form Feed. ^%M("%MTC","%MTC",11) IOHL - character sequence to switch from HIGH to LOW intensity. ^%M("%MTC","%MTC",12) IOLH - character sequence to switch from LOW to HIGH intensity. ^%M("%MTC","%MTC",13) IORM - Right margin (in characters) (0-IORM characters/line). ^%M("%MTC","%MTC",14) IOSL - Screen Length in lines (0-IOSL lines/page). ^%M("%MTC","%MTC",14.1) IOST - Terminal SubType (like "C-ADM3A"). ^%M("%MTC","%MTC",15) IOXY - character string necessary to position cursor to DX,DY. ^%M("%MTC","%MTC",16) ^%M("%MTC","%MTC",17) CURRENT - Entry point to get definition for "current" device (e.g. $I). It ^%M("%MTC","%MTC",18) returns to Caller after executing optional startup string with the ^%M("%MTC","%MTC",19) following variables: ^%M("%MTC","%MTC",20) ^%M("%MTC","%MTC",21) FF - character string written to do form feed or clear screen ^%M("%MTC","%MTC",22) (W @FF). ^%M("%MTC","%MTC",23) HL - character sequence written to switch from HIGH intensity display ^%M("%MTC","%MTC",24) to LOW intensity display (W @HL). ^%M("%MTC","%MTC",25) LH - character sequence written to switch from LOW intensity to HIGH ^%M("%MTC","%MTC",26) intensity display (W @LH). ^%M("%MTC","%MTC",27) RM - Right Margin of screen (0-RM characters per line). ^%M("%MTC","%MTC",28) SL - Screen Length in lines (0-SL lines per page). ^%M("%MTC","%MTC",28.1) SUB- Terminal Subtype (like "C-ADM3A"). ^%M("%MTC","%MTC",29) XY - Executable string to position cursor to position DX,DY. ^%M("%MTC","%MTC",30) ^%M("%MTC","%MTC",31) DEFINE - Entry point to Define a new terminal type. Allows creation or ^%M("%MTC","%MTC",32) modification of data for a selected terminal type including the values ^%M("%MTC","%MTC",33) for FF (IOFF), HL (IOHL), LH (IOLH), RM (IORM), SL (IOSL), XY (IOXY), ^%M("%MTC","%MTC",34) and a executable startup string. ^%M("%MTC","%MTC",35) ^%M("%MTC","%MTC",36) DEFAULT - Entry point to define default terminal for device numbers (e.g. ^%M("%MTC","%MTC",37) relate device #1 to a specific terminal type like an "LA-120"). ^%M("%MTC","CURRENT",0) 5 ^%M("%MTC","CURRENT",1) Pick up the current device's ($I) parameters. If the re is a startup ^%M("%MTC","CURRENT",2) string (will be in %X), then eXecute it. NOTE that the startup ^%M("%MTC","CURRENT",3) string CANNOT use any of the just terminal caracteristics variables ^%M("%MTC","CURRENT",4) (like LH) since we can't tell if the startup string will be issued ^%M("%MTC","CURRENT",5) via a call to %MTC or a call to CURRENT^%MTC (LH or IOLH). ^%M("%MTC","DEFAULT",0) 2 ^%M("%MTC","DEFAULT",1) Define the Terminal Names that are to be associated with specific ^%M("%MTC","DEFAULT",2) Device Numbers. ^%M("%MTC","DEFINE",0) 5 ^%M("%MTC","DEFINE",1) Define the characteristics for a spcific Terminal Name. ^%M("%MTC","DEFINE",2) ^%M("%MTC","DEFINE",3) Passes control to routine %MTCD - left here for those user programs that ^%M("%MTC","DEFINE",4) issue D DEFINE^%MTC. Both DEFINE and DEFAULT were moved to routine %MTCD ^%M("%MTC","DEFINE",5) to try to keep all routines down to 4Kbytes for portability. ^%M("%MTC","IO10",0) 7 ^%M("%MTC","IO10",1)  Get the default device name for this number (^(^(IO))) and then loop thru ^%M("%MTC","IO10",2) and setup characteristics. Last parameter setup is %X which contains ^%M("%MTC","IO10",3) any startup commands for this device. If the startup command is null, ^%M("%MTC","IO10",4) then it is defaulted to a "O IO". If not, the command is eXecuted. ^%M("%MTC","IO10",5) ^%M("%MTC","IO10",6) NOTE - if a startup string is specified, it is the responsibility of ^%M("%MTC","IO10",7) the startup code to OPEN the device %IO (so that CURRENT^%MTC can do it too). ^%M("%MTC","IOSDP",0) 3 ^%M("%MTC","IOSDP",1) Startup code for SDP device to get the name of te file to be opened and ^%M("%MTC","IOSDP",2) the Drive on which it resides (or will reside). Variable %A1 contains ^%M("%MTC","IOSDP",3) the Drive (A, B, ...) and variable %A2 the file Name and Extension. ^%M("%MTCD","DEFAULT",0) 2 ^%M("%MTCD","DEFAULT",1) Define the Terminal Names that are to be associated with specific ^%M("%MTCD","DEFAULT",2) Device Numbers. ^%M("%MTCD","DEFINE",0) 1 ^%M("%MTCD","DEFINE",1) Define the characteristics for a spcific Terminal Name. ^%M("%MTCD","DRV",0) 1 ^%M("%MTCD","DRV",1) Standard question Driver. ^%M("%MTCH","%MTCH",0) 5 ^%M("%MTCH","%MTCH",1) Terminal Characteristics - HELP text for routine %MTC ^%M("%MTCH","%MTCH",2) John Lewkowicz - NYS College of Veterinary Medicine, Cornell University ^%M("%MTCH","%MTCH",3) ^%M("%MTCH","%MTCH",4) Routine to display question explanations in resonse to a User entry of ^%M("%MTCH","%MTCH",5) "?" or "??" in the terminal definition routine %MTC. *EOF* tions in resonse to a User entry of ^%M("%MTCH","%MTCH",5) "?" or "??" in the terminal definition routine %MTC. *IO K XX Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) D CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) %M ;John Lewkowicz - NYS College of Vet. Medicine ;Programmer Utilities - main entry point for Options & Dispatch K D CURRENT^%MTC S DS=";" D:'$D(^%MD) ^%M8 S SDR=$E(^%MD,1),SDG=$E(^%MD,2) START K (DS,FF,RM,HL,LH,SDR,SDG) S $ZE="",X="Programmer Utilities - Version 1.2" W @FF,!,?RM\2-($L(X)\2),@LH,X,@HL,!! ROG S Q="ROG" W !,"Work on ",@LH,"R",@HL,"_outines, ",@LH,"G",@HL,"_lobals or on ",@LH,"T",@HL,"_erminal definitions." W " Choice: " D READ G ROG:E I A="" W @LH Q S A=$E(UA,1) I A'?1U!("RGT"'[A) W *7," ??" G ROG W ! S ROG=A I A="T" D ^%M5 G START FUN S Q="FUN" W ! F I=1:1:9 W @LH,$E("DELFCSRKX",I),@HL,"_",$P("irectory;dit;ist;ind;hange;ave;estore;ILL;tnd.Dir",DS,I)," " W !,"Choice: " D READ G FUN:E,START:"^"[A S A=$E(UA,1) S FUN=A I FUN'?1U!("DELFCSRKX"'[A) W *7," ??" G FUN W $P("irectory;dit;ist;ind;hange;ave;estore;ILL;-tended Directory",DS,$F("DELFCSRKX",A)-1) S FR=FUN_ROG,FRG=$S(FR="RR":"RESR",FR="RG":"RESG",ROG="R":"ROU",1:"GBL") W ! FDR S Q="FDR"_$S(FUN="R":1,1:2) W !,$P("Routines;Globals",DS,$F("RG",ROG)-1),@LH," ",$S(FUN="R":"TO",1:"FROM"),@HL," Drive (",@LH,"A-H",@HL,"): ",@LH,$S(ROG="R":SDR,1:SDG),@HL," :: " I "ELFCK"[FUN,A'="^" S A=$S(ROG="R":SDR,1:SDG) G FDR1 D READ S:UA="" UA=$S(ROG="R":SDR,1:SDG) S A=$E(UA,1) G FDR:E,FUN:"^"[A I A'?1U!("ABCDEFGH"'[A) W *7," ??" G FDR FDR1 S FDR=A W ! G TDR:",LG,FG,CG,"[FR!(FUN="E") FLAG G FLAG3:FUN="R" I '$D(^%MU(FRG)) D REFRESH G TDR:"DX"[FUN,FLAG3 FLAG1 S Q="RFRSH" W !,"Refresh Directory? : ",@LH,"N",@HL," :: " D READ S:UA="" UA="N" S A=$E(UA,1) G FLAG1:E I A="^" W ! G FUN:"DLSK"'[FUN,FDR I UA?1"?"1U D DIR^%M0:UA="?L",SDIR^%M0:UA="?S" G FLAG1 I "YN"'[A W *7," ??" G FLAG1 D:A="Y" REFRESH FLAG2 G TDR:"DX"[FUN S Q="OLD" W !,"Use existing list of selected ",$S(ROG="R":"Routines",1:"Globals"),"? : ",@LH,"N",@HL," :: " D READ G FLAG2:E S:UA="" UA="N" S A=$E(UA,1) I "^"[A W ! G FLAG1 I UA?1"?"1U D DIR^%M0:UA="?L",SDIR^%M0:UA="?S" G FLAG2 I "YN"'[A W *7," ??" G FLAG2 W ! G TDR:A="Y" S S="" F I=1:1 S S=$O (^%MU(FRG,S)) Q:S="" S ^(S)=0 FLAG3 D FLAG3^%M5 G:A="^" FLAG2:FUN'="R",FDR G START:'N TDR K IO I "EK"'[FUN S Q="TDR" W !!,@LH,$S(FUN="R":"Restore FROM",1:"Output TO"),@HL D ^%MTC U 0 G FDR:IO="^" S:'$D(IO) IO=0 G TDR1:IO'=5 I "SR"'[FUN W !!,*7,"Only ",@LH,"SAVE ",@HL,"& ",@LH,"RESTORE",@HL," to this device." G TDR I A="^" C:IO'=$I IO:0 G TDR TDR1 I FUN="D" D LDIR^%M0 W ! G ROG I FUN="X" D ^%M7 G START I FUN="L" D @$S(ROG="R":"RLIST^%M0",1:"GLIST^%M0") G START I FUN="E" G @$S(ROG="R":"REDIT^%M1",1:"GEDIT^%M1") I FUN="K" D @$S(ROG="R":"RDEL^%M2",1:"GDEL^%M2") G FDR:A="^",START I FUN="F" D @$S(ROG="R":"RFIND^%M2",1:"GFIND^%M2") G START I FUN="C" D @$S(ROG="R":"RCHANGE^%M3",1:"GCHANGE^%M3") G FDR:A='^",START I "RS"[FUN G ^%M4 B REFRESH W !,?5,"Collecting Directory now..." ZO (FDR:FDR) O 2:(FDR:"SCRATCH.DAT") C 2:0 O 2:(FDR:"SCRATCH.DAT") U 2 S X=$F("GR",ROG) V X W !,"*EOF*",! C 2:0 K ^%MU(FRG) O 2:(FDR:"SCRATCH.DAT") F I=1:1 U 2 R X U 0 W "." Q:X="*EOF*" S Y="" F I=1:1 S Z=$E(X,I) S:" "'[Z Y=Y_Z I " "[Z S:Y'="" ^%MU(FRG,Y)=0,Y="" Q:Z="" C 2:1 ZO (SDR:SDG) Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,25="" D P W !!,"EXTERNAL REFERENCES",! S M="X",SYM="^" D P W !!,"***** END *****",! G B1 P S L=-1,PC=0 P1 S L=$N(^XCR($J,RTN,M,L)) I L=-1 W:'PC !?3,"NONE" Q S PC=1 I M="X" W !?3,$P(L,"^",2),SYM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","%M0 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Directory, Global/Routine List DIR S S="" ZO (FDR:FDR) W @LH S X=$P("Routine;Global",DS,$F("RG",ROG)-1)_" Directory (selected entries flagged with -> )" W !!,?RM\2-($L(X)\2),X,! S N=0 F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" S:N+1*11'",1:" "),S S N=N+1 W @HL,!! ZO (SDG:SDR) Q SDIR S S="",N=0 ZO (FDR:FDR) W @LH S X="Currently SELECTED "_$P("Routines;Globals",DS,$F("RG",ROG)-1) W !!,?RM\2-($L(X)\2),X,! S N=0 F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" I ^(S) S:N+1*11'IOSL @IOFF,!! Q I $Y+2>IOSL W !,@LH,"RETURN",@HL," to continue, ",@LH,"^",@HL," to QUIT: ",@LH R A W @IOFF,! Q RLIST ZO (FDR:FDR) W @HL,! RLIST1 S Q="RLIST1" W !,"Date & {optional} Time for Heading: " D READ G RLIST1:E G RLIST3:A="^" S RLIST1=A RLIST2 S Q="RLIST2" W !,"Comments too ?: ",@LH,"Y",@HL," :: " D READ G RLIST2:E,RLIST1:A="^" S RLIST2=$E(UA)'="N" S X1=$P($T(X1),";",2,99),X2=$P($T(X2),";",2,99),X3=$P($T(X3),";",2,99),X4=$P($T(X4),";",2,99),S="" U IO W @IOLH X X1 RLIST3 K X1,X2,X3,X4,RLIST1,RLIST2 U 0 C:$I'=IO IO:0 ZO (SDG:SDR) Q X1 ;F I=1:1 S S=$O(^%MU("ROU",S)) Q:S="" I ^(S) ZR S SIZ=$S ZL @S S SIZ=SIZ-$S,P=0 X X2 X2 ;F J=1:1 X:J=1!($Y>(IOSL-6)) X4 S X=$T(+J) Q:X="" X X3 W !,?5,$P(X," ",1) S X=$P(X," ",2,255) F K=1:1 S Y=$E(X,1,IORM-16),X=$E(X,IORM-15,255) Q:Y="" W ?15,Y W:X'="" !,?13,"--" X3 ;I RLIST2 S C=$P(X," ",1) I C'="",$D(^%M(S,C,0)) S C=0 W ! F CC=1:1 S C=$O(^(C)) W:C="" ! Q:C="" X:$Y>(IOSL-6) X4 W !,?10,";; ",^(C) X4 ;W @IOFF W !!,?5,RLIST1,?40,S," ",SIZ," bytes" S P=P+1 W ?IORM-7,"Page ",P READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+ Q n errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K %M1 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Routine/Global Edit Control REDIT ZO (FDR:FDR) REDIT1 S Q="REDIT" W @HL,!,"Routine to Edit: " D READ S A=UA G REDIT:E G REND:"^X"[A I A?1"?"1U D DIR^%M0:A="?L",SDIR^%M0:A="?S" G REDIT1 I ",*,RESTART,"[(","_A_",") S A=$S('$D(^%MRE):"",1:^%MRE) G REDIT1:A="" W " : ",A G EDIT K ^%MRE S ^%MRE(0)=0 W " Loading now..." S $ZE="NEW^%M1" G XEQ NEW S ^%MRE(0)=0 W "...this is a NEW routine.",! G EDIT XEQ X "ZL @A F I=1:1 S X=$T(+I) S:X'="""" ^(I)=X I X="""" S ^(0)=I-1 Q" S $ZE="EDIT", EDIT S $ZE="",^%MRE=A,X=^%MRE(0),LP1="B",LP2="E",TTL="Routine "_A,RN=A,PRG=1 EDITA W @LH,@FF D ^%MEDT I A?1";".E D UPPER S A=UA,%LP1=LP1,%LP2=LP2,%TTL=TTL,LB=$E(A,2,99) K PRG S:'$D(^%M(RN,LB,0)) ^%M(RN,LB,0)=0 S TTL="COMMENTS FOR "_LB D ^%MEDT S LP1=%LP1,LP2=%LP2,TTL=%TTL,PRG=1 K %LP1,%LP2,%TTL,LB S X=^%MRE(0) G EDITA I A'="F" W !!,"DONE.",! G REDIT1 W !!,"Saving now..." S N=^(0) X "ZR S S=""0"" F I=1:1 S S=$O(^(S)) ZI:S'="""" ^(S) I S="""" ZS @$P(TTL,"" "",2) Q" S:'$D(^%MU("ROU",$P(TTL," ",2))) ^%MU("ROU",$P(TTL," ",2))=0 W "Done.",! G REDIT1 REND ZO (SDG:SDR) G FDR^%M:A="^",^%M GEDIT ZO (FDR:FDR) W ! GEDIT1 U 0 S Q="GREF" W @HL,!,"Global Reference: ",@LH,"^" D READ G GEDIT1:E,REND:"^"[A I UA?1"?"1U D DIR^%MO:UA?1"?L",SDIR^%M0:UA?1"?S" G GEDIT1 I $E(A,$L(A))="," S A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,F=0 I G["(" S F=$L(G,"(")=$L(G,")") S:'F GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," I $D(@G)#2 S G1=G,G2=@G D GEDIT2 G GEDIT1:A="S" G GEDIT1:F F I=1:1 S GR=$ZO(@GR) Q:GR=""!($E(GR,1,L)'=GE) S G1=GR,G2=@GR D GEDIT2 G GEDIT1:A="S" K G,GR,L,GE,G1,G2 G GEDIT1 GEDIT2 W !!,G1,"=",@LH,G2,@HL GEDIT3 W !,?5,"Change: ",@LH R T W @HL S X=T,L1=0,L2=0 I T="" G GEDIT4 I X="END"!(X="end") S L1=255,L2=256 G GEDIT39 I X'["..." S L2=$F(G2,X) G GEDIT38:'L2 S L1=L2-1-$L(X) G GEDIT39 I X="..." S L1=0,L2=256 G GEDIT39 I X?1"...".E S L1=0,X=$E(X,4,255),L2=$F(G2,X) G GEDIT38:L2<0,GEDIT39 I $E(X,$L(X)-2,$L(X))="..." S L2=256,X=$E(X,0,$L(X)-3),L1=$F(G2,X)-1-$L(X) G GEDIT38:L1<0,GEDIT39 S I=$E(X,0,$F(X,"...")-4),L1=$F(G2,I) G EDIT38:'L1 S L2=$E(X,$F(X,"..."),255),L2=$F(G2,L2,L1) G GEDIT38:'L2 S L1=L1-1-$L(I) G GEDIT39 GEDIT38 W *7," Can't Find !" G GEDIT3 GEDIT39 W !,?9,"To: ",@LH R R W @HL S G2=$E(G2,0,L1)_R_$E(G2,L2,255) G GEDIT3 GEDIT4 W !,G1,"=",@LH,G2,@HL S @G1=G2 GEDIT5 S Q="GEDIT" W !!,@LH,"A",@HL,"gain, ",@LH,"S",@HL,"top, ",@LH,"N",@HL,"ext: ",@LH,"N",@HL," :: " D READ G GEDIT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y %M10 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmers Utilities - Continued Help Text W !!,"- - -",?17,"- - - Use '^' to BACKup a question - - -",?73,"- - -",! I $D(FDR),FDR'=SDR ZO (SDR:SDG) F I=0:1 S X=$T(@Q+I) Q:X=""!(A="?"&I)!(I&($P(X," ",1)'="")) D WRITE I I,A="?",X'=""&($P(X," ",1)="") W !,?20,"Enter ",@LH,"??",@HL," for more Help.",! I 'I W !!,?20,"NO Help available for this question.",! W !,"- - -",?37,"- - -",?73,"- - -",! K I,X I $D(FDR),FDR'=SDR ZO (FDR:FDR) Q WRITE I 'I W @LH,!,$P(X,DS,2,99),@HL,! Q W ! S X=$P(X,DS,2,99) F J=1:1 W @$S(J#2:HL,1:LH),$P(X,"~",J) Q:$P(X,"~",J+1)="" W @HL Q RLIST1 ;Will be included as part of the heading on each page. RLIST2 ;"Y" to display comments (held in ^%M) along with routine(s). REDIT ;Name of routine to edit - use "*" to use the LAST routine edited. GEDIT ;Do you want to do the same node AGAIN, CONTINUE to next node, or STOP ? RDEL ;"Y" to KILL selected routines (use "?L" or "?S" for directory). GDEL ;"Y" to KILL selected globals (use "?L" or "?S" for directory). FIND ;String to be FOUND or pattern specification like "?1"AB".E" etc. FROM ;String to be CHANGED (like "ABC"). TO :String FROM is to be changed TO (can be null to Delete). COM ;"Y" to Save/Restore the comments associated with this routine. ;If ~Restoring~ and you answer ~Yes~, then all comments that might exist ;will first be ~ERASED~. DESC ;Free-text description for this save file. DATIM ;Free-text date and time to be associated with this save file. READY ;"Y" to begin the Save or Restore operation. TERM ;Enter "1" to define a Terminal, "2" to Tie a Terminal to a Port. ;~1~ Defines the physical characteristics of a given terminal (like what's ; required for cursor positioning, HI and LO intensity etc.). ;~2~ Ties a logical terminal type to a physical port. ; ;~~ to go back to options. RP ;Start operation on other computer, press here. ;Go start ~Save~ operation on other computer (use ~%M~) and once it is ; running, come back here and press ~~ key. BYTES ;Max number of BYTES per Output File. ;Used to limit the data written out so that a large global can be saved ; on ~multiple volumes~. For example, you can save a 400Mbyte files as ; two separate files by specifying a limit of the size per output file ; (like 240000 for 8" SSSD floppy output). When %M outputs the number ; of bytes specified, it will close the output file and let you enter ; another disk and file specification to continue the Save. es specified, it will close the output file and let you enter ; another disk and file specification to contEOF* tions in resonse to a User entry of ^%M("%MTCH","%MTCH",5) "?" or "??" in the terminal definition routine %MTC. *IO K XX Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) D CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) %M2 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Routine/Global Delete & Find functions RDEL ZO (FDR:FDR) S Q="RDEL" RDEL1 W !!,"Ready to ",@LH,"KILL ",@HL,"Selected ",$S(ROG="R":"Routines",1:"Globals")," (",@LH,"Y",@HL," or ",@LH,"N",@HL,"): " D READ G RDEL1:E I UA?1"?"1U D DIR^%M0:UA="?L",SDIR^%M0:UA="?S" G RDEL1 S A=$E(UA) Q:"^N"[A I A'="Y" W *7," ??" G RDEL1 W !,"KILLING Selected ",$S(ROG="R":"Routines",1:"Globals")," now...",@LH,! S S="",N=0 F I=0:1 S S=$O(^%MU(FRG,S)) Q:S="" I ^(S) S:N+1*11'IOSL X4 Q:A="^" W !,?5,L1 F L=1:1 S L1=$E(L2,1,IORM-15),L2=$E(L2,IORM-14,255) Q:L1="" W ?15,L1 W:L2'="" !,?13,"--" X4 ;W:IOST?1"P".E @IOFF,!! I $E(IOST)="C" W !,@LH,"RETURN",@HL," to Continue, ",@LH,"^",@HL," to QUIT: ",@LH R A W @IOFF,! FINDG ; FG1 I $D(@G)#2 S D=@G D FG2 Q:FL F I=1:1 S GR=$ZO(@GR) Q:GR=""!($E(GR,1,L)'=GE) S G=GR,D=@GR D FG2 Q:A="^" Q FG2 F I=1:1:II S F=F(I),X=$E(F)="?" I $S('X&(D[F):1,'X:0,D?@$E(F,2,255):1,1:0) D FG3 Q Q FG3 W G,"=" S X=$X,Y=IORM-X FG4 W ?X,$E(D,1,Y),! S D=$E(D,Y+1,255) I $Y+4>IOSL W:IOST?1"P".E @IOFF,!! I $E(IOST)="C" W !,@LH,"RETURN",@HL," to Continue, ",@LH,"^",@HL," to QUIT: ",@LH R A W @IOFF,! Q:A="^" G FG4:D'="" Q FIND9 K F,I ZO (SDR:SDG) Q GFIND U 0 S Q="GREF" W @HL,!,"Global Reference: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","%M3 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Routine/Global Change function. RCHANGE ZO (FDR:FDR) K TO,FROM S II=0 W !,@HL,! D FROMTO G RCEND:II<1 U IO W @LH,@IOFF S S="" F I=1:1:3 S @("X"_I)=$P($T(@("X"_I)),DS,2,255) X X1 U 0 W !!,"All DONE.",! RCEND K FROM,TO,X1,X2,X3,J,END ZO (SDR:SDG) U 0 C:IO'=$I IO:0 Q X1 ;S S="" F I=1:1 S S=$O(^%MU("ROU",S)) Q:S="" I ^(S) W !,S ZL @S S MOD=0 F J=1:1:II S FROM=FROM(J),TO=TO(J) X X2 I J=II,MOD ZS @S X2 ;F K=0:1 S L=$T(+K+1) Q:L="" I L[FROM S MOD=1,NL="" F M=1:1 X X3 I L="" ZR @S+K ZI NL W !,?5,NL Q X3 ;S NL=$S(L'[FROM:NL_L,1:NL_$P(L,FROM,1)_TO),L=$S(L'[FROM:"",1:$P(L,FROM,2,255)) GCHANGE ZO (FDR:FDR) GC0 K TO,FROM S II=0 W !,@HL,! D FROMTO G GCEND:II<1 GC1 S X="Global Change" U 0 W @LH,@FF,!,?RM\2-($L(X)\2),X,!! F I=1:1:II W @HL,!,I,". From: ",@LH,FROM(I),@HL,?39," To: ",@LH,TO(I) W ! GC2 S Q="GREF" W @HL,!,"Global Reference: ",@LH,"^" D READ G GC2:E,GC0:A="^",GCEND:A="" I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) U IO W @IOFF,! S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," I $D(@G)#2 S D=@G D GC3 G GC1:FL F I=1:1 S GR=$ZO(@GR) Q:GR=""!($E(GR,1,L)'=GE) S G=GR,D=@GR D GC3 G GC1 GC3 S MOD=0,Z=D F I=1:1:II S FROM=FROM(I),TO=TO(I) D GC4 I MOD W !!,G,"=" S X=$X,Y=IORM-X,A=D D GC35 W !,?X-3,"To " S A=Z D GC35 S @G=Z Q GC35 W $E(A,1,Y) S A=$E(A,Y+1,255) I A'="" W !,?X G GC35 Q GC4 Q:Z'[FROM S MOD=1,NL="" F J=1:1 D GC5 Q:Z="" S Z=NL Q GC5 S NL=$S(Z'[FROM:NL_Z,1:NL_$P(Z,FROM,1)_TO),Z=$S(Z'[FROM:"",1:$P(Z,FROM,2,255)) Q GCEND K FROM,TO,MOD C:IO'=$I IO:0 ZO (SDR:SDG) Q FROMTO S Q="FROM" W !,II+1,". From: " D READ G FROMTO:E Q:A="" S FROM=A I A="^" S II=II-1 G FROMTO:II'<0 Q TO S Q="TO" W ?39," To: " D READ I E W !!,II+1,". From: ",@LH,FROM,@HL G TO I A="^" G FROMTO S II=II+1,FROM(II)=FROM,TO(II)=A G FROMTO READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32X3 W !,?5,$P(X," ",1) S X=$P(X," ",2,255) F K=1:1 S Y=$E(X,1,IORM-16),X=$E(X,IORM-15,255) Q:Y="" W ?15,Y W:X'="" !,?13,"--" X3 ;I RLIST2 S C=$P(X," ",1) I C'="",$D(^%M(S,C,0)) S C=0 W ! F CC=1:1 S C=$O(^(C)) W:C="" ! Q:C="" X:$Y>(IOSL-6) X4 W !,?10,";; ",^(C) X4 ;W @IOFF W !!,?5,RLIST1,?40,S," ",SIZ," bytes" S P=P+1 W ?IORM-7,"Page ",P READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+ Q n errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K%M4 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Control Routine/Global Save & Restore functions. G M41:FUN'="R" RP I IO=5,FUN="R" S Q="RP" W !!,"Start ",@LH,"SAVE ",@HL,"or ",@LH,"TRANSMIT ",@HL," on other computer, press ",@LH,"",@HL,": " D READ G RP:E,END:A="^" S $ZE="M40" D RX S DESC=A D RX S DATIM=A S $ZE="" G M41 M40 U 0 W @LH,*7,!!,"Can't find designated RESTORE file.",@HL H 5 G END M41 G M42:ROG'="R" COM S Q="COM" W @HL,!,"Comments (",@LH,"Y",@HL," or ",@LH,"N",@HL,"): ",@LH,"Y",@HL," :: " D READ G COM:E Q:A="^" S COM="Y"[$E(UA) M42 G READY:FUN'="S" DESC S Q="DESC" W @HL,!,"Description: " D READ G DESC:E S DESC=A I A="^" G COM:ROG="R",END DATIM S Q="DATIM" W @HL,!,"Date & Time: " D READ G DATIM:E S DATIM=A I A="^" G DESC M43 G READY:FR'="SG" S BYT=9999999,Q="BYTES" W !,@HL,"Maximum number of BYTES output to each file: ",@LH,"9999999",@HL," :: " D READ G M43:E I A="^" G @$S(FUN="S":"DATIM",1:"END") S:A="" A=9999999 S BYT=A I A'?1N.N W *7," ??" G M43 READY S Q="READY" W !,@LH,!!,$S(ROG="R":"Routine",1:"Global")," ",$S(FUN="S":"Save",1:"Restore") W @HL,!,?5,"Description: ",@LH,DESC W @HL,!,?5,"Date & Time: ",@LH,DATIM,@HL,! READY1 W !,"Ready to Start (",@LH,"Y",@HL," or ",@LH,"N",@HL,"): ",@LH,"Y",@HL," :: " D READ G READY1:E S:A="" A="Y",UA=A I A="^" G @$S(FR="SG":"M43",FUN="S":"DATIM",1:"END") G READY1:"Y"'[$E(UA),DISPATCH:FUN="R" I IO=5 W !!,"Start ",@LH,"RESTORE ",@HL,"and press ",@LH,"",@HL," on ",@LH,"other",@HL," computer.",!! S $ZE="M44" S A=DESC D TX S A=DATIM D TX S $ZE="" G DISPATCH M44 U 0 W @LH,*7,!!,"Designated file ALREADY exists !",@HL,! H 5 G END DISPATCH G DISPATCH^%M6 READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q RX S N=0,E="<~~~~~~~~~~~~>" U IO I IO'=5 R A U 0 Q R1 R !,A:10 E S N=N+1 W E,! G R1:N<10,SYNER R2 R !,X:10 E S N=N+1 W E,! G R1:N<10,SYNER S OK=$S(X'?1N.N:0,$L(A)'=X:0,1:1),N=N+OK G SYNER:N>9 W $S(OK:"",1:E),! G R1:'OK U 0 Q SYNER S A="<~>" U 0 Q TX U IO I IO'=5 W A,! U 0 Q T1 R OK W A,! R OK G T1:OK'="" W $L(A),! R OK G T1:OK'="" U 0 Q  0 Q SYNER S A="<~>" U 0 Q TX U IO I IO'=5 W A,! Und !" G GEDIT3 GEDIT39 W !,?9,"To: ",@LH R R W @HL S G2=$E(G2,0,L1)_R_$E(G2,L2,255) G GEDIT3 GEDIT4 W !,G1,"=",@LH,G2,@HL S @G1=G2 GEDIT5 S Q="GEDIT" W !!,@LH,"A",@HL,"gain, ",@LH,"S",@HL,"top, ",@LH,"N",@HL,"ext: ",@LH,"N",@HL," :: " D READ G GEDIT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y%M5 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Control Terminal Def., Flag Routines/Globals in ^%MU S X="Terminal Characteristics" W @FF,@LH,!,?RM\2-($L(X)\2),X,!! W !,@LH,"1",@HL," - Edit/Add Terminal Definitions." W !,@LH,"2",@HL," - Assign Terminal to Physical Port.",! TERM S Q="TERM" W !,"Choice: " D READ G TERM:E Q:"^"[A I A'?1N!("12"'[A) W *7," ??" G TERM I A=1 D DEFINE^%MTC,CURRENT^%MTC G %M5 D DEFAULT^%MTC,CURRENT^%MTC G %M5 READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q FLAG3 S N=0 K:FUN="R" ^%MU(FRG) FLAG4 S Q="NAME" W !,$S(ROG="R":"Routine",1:"Global"),": " W:ROG="G" @LH,"^" D READ G FLAG4:E S A=UA,OA=A Q:"^"[A I UA?1"?"1U,FUN="R" S S="" W !,"Restore Specifications:",! F I=1:1 S S=$O(^%MU(FRG,S)) G FLAG4:S="" W ?5,$P(^(S),DS,1),! I UA?1"?"1U D DIR^%M0:UA="?L",SDIR^%M0:UA="?S" G FLAG4 S NOT=A?1"'".E S:NOT A=$E(A,2,255) S (IF,Z)="",Y=A I A="*" S IF=".E" G FLAG6 FLAG5 S C=$E(Y),Y=$E(Y,2,255) I "?*"[C S:Z'="" Z=Z_"""" S IF=IF_Z_$S(C="*":".E",C="?":"1E",1:""),Z="" G FLAG6:C="",FLAG5 S:Z="" Z="1""" S Z=Z_C G FLAG5 FLAG6 D:FUN'="R" FLAGIT S N=N+1 S:FUN="R" ^%MU(FRG,N)=OA_DS_IF G FLAG4 FLAGIT ZO (FDR:FDR) S NF=0 I $D(^%MU(FRG,A)) S ^(A)=$S(NOT:0,1:1),NF=1 W " Done." G FLAGX S S="",L=0 I IF?1"1""".E S A=$P(IF,"""",2),L=$L(A),S=$E(A,0,L-1)_$C($A(A,L)-1)_"|" F I=1:1 S S=$O(^%MU(FRG,S)) Q:S=""!($E(S,0,L)'=$E(A,0,L)) I S?@IF S ^(S)=$S(NOT:0,1:1),NF=NF+1 W " ",NF," found." FLAGX ZO (SDR:SDG) Q MU(FRG,S)) Q:S=""!($E(S,0,L)'=$E(AEOF* tions in resonse to a User entry of ^%M("%MTCH","%MTCH",5) "?" or "??" in the terminal definition routine %MTC. *IO K XX Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) D CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) %M6 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Do the Routine/Global Save or Restore DISPATCH ZO (FDR:FDR) D @(FR) I FUN="S" S A="" D TX I IO'=5 S A="*EOF*" D TX END K X1,X2,X3,X4,X5,X6,X7,X8,X9,N1,N2 U 0 C:IO'=$I IO:0 ZO (SDR:SDG) G START^%M SG S S="",N=0 F I=1:I S S=$O(^%MU(FRG,S)) Q:S="" I ^(S) D GS1 Q GS1 U 0 W !,?8,@LH,S,@HL U IO S G="^"_S I $D(@G)#2 S A=G D TX S A=@G D TX S G=G_"("""")" F J=1:1 S G=$ZO(@G) Q:G="" S A=G,N=N+$L(A)+2 D TX S A=@G,N=N+$L(A)+2 D TX U 0 W *13,J I N>BYT D GS2 Q:A="^" Q GS2 U IO S A="" D TX I IO'=5 S A="*EOF*" D TX U 0 C:IO'=$I IO:0 ZO (SDR:SDG) W !,*7,!,"Mount ",@LH,"NEXT",@HL," volume for continuation of this Save." K IO D ^%MTC S A=IO Q:A="^" U IO S A=DESC_" (continuation)" D TX S A=DATIM D TX U 0 W !,?8,@LH,S,@HL U IO S N=0 ZO (FDR:FDR) Q SR S X1=$P($T(X1),DS,2,99),X2=$P($T(X2),DS,2,99),X3=$P($T(X3),DS,2,99),X4=$P($T(X4),DS,2,99) U 0 W !,"Routines now...",! X X1 I COM S A="" D TX W !!,"Comments now...",! X X2 Q  X1 ;S S="" F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" I ^(S) U 0 W !,?8,@LH,S,@HL S A=S X X4 ZL @S F J=1:1 S A=$T(+J) X X4 Q:A="" U 0 W *13,J X2 ;S S="" F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" I ^(S) U 0 W !,?8,@LH,S,@HL S J=0 ZL @S F K=1:1 S L=$T(+K) Q:L="" S CM=$P(L," ",1) I CM'="",$D(^%M(S,CM,0)) X X3 X3 ;U IO S C="" F I=1:1 S C=$O(^(C)) Q:C="" S A=""""_S_""""_","_""""_CM_""""_","_""""_C_"""" X X4 S A=^(C) X X4 U 0 S J=J+1 W *13,J X4 ;U IO W:IO'=5 A,! Q:IO'=5 F I=1:1 R OK W A,! R OK W $L(A),! R OK Q:OK="" RG S OG="|" U 0 W ! U IO RG1 D RX S G=A D RX S D=A I $P(G,"(",1)=OG S @G=D,NL=NL+1 U 0 W *13,NL G RG1 RG2 Q:G="" S OG=$P(G,"(",1) D RG5 U 0 W:GO @LH W !,?8,OG,@HL W:'GO @LH," NOT",@HL," being restored." U IO I GO S @G=D,NL=0 G RG1 F I=1:1 D RX S G=A D RX S D=A Q:G="" G RG2:$P(G,"(",1)'=OG Q RG5 S S="",GO=0 F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" S X=^(S),NOT=$E(X)="'",X=$P(X,DS,2) I $E(OG,2,255)?@X S GO=$S(NOT:0,1:1) Q RR S RO=$S(IO'=2:2,IO'=3:3,IO'=4:4) U 0 W !,"Routines now...",! D RR0 I COM U 0 W !!,"Comments now...",! D RC0 Q GO S S="",GO=0 F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" S X=^(S),NOT=$E(X)="'",X=$P(X,DS,2) I R?@X S GO=$S(NOT:0,1:1) Q RR0 F I=1:1 D RX S R=A Q:R="" D GO U 0 W:GO @LH W !,?8,R W @HL W:'GO @LH," NOT",@HL," being restored." D RR1 S:'$D(^%MU("ROU",R)) ^%MU("ROU",R)=0 Q RR1 O:GO RO:(FDR:R_".MMP") F I=1:1 U 0 W *13,I D RX Q:A="" I GO U RO W A,! C:GO RO:0 U 0 Q RC0 S OG="|" F I=1:1 D RX S G=A D RX S D=A Q:G="" D RC1 I GO S @("^%M("_G_")")=D U 0 W *13,I Q RC1 S R=$P(G,"""",2) I R'=OG S OG=R D GO U 0 W:GO @LH W !,?8,R,@HL W:'GO @LH," NOT",@HL," being restored." I GO K ^%M(R) S I=1 Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q RX U IO I IO'=5 R A U 0 Q R1 R !,A:2 E W "<~~~~~~~~~~>",! G R1 R2 R !,X:2 E W "<~~~~~~~~~~>",! G R1 S OK=$S(X'?1N.N:0,$L(A)'=X:0,1:1) W $S(OK:"",1:"<~~~~~~~~~~>"),! G R1:'OK Q TX U IO I IO'=5 W A,! U 0 Q T1 R OK W A,! R OK G T1:OK'="" W $L(A),! R OK G T1:OK'="" U 0 Q <~~~~~~~~~~>"),! G R1:'OK Q TX U IO I IO'=5 W A,! U 0e: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","%M7 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - eXtended Directory function. XDIR S S="" ZO (FDR:FDR) U IO W @IOLH,@IOFF S X="X-tended "_$P("Routine;Global",DS,$F("RG",ROG)-1)_" Directory" W !!,?RM\2-($L(X)\2),X,! F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" D:IOSL-$Y<4 XDM Q:A="^" D:ROG="G" XDG X:ROG="R" $P($T(XDR),DS,2,99) D:A'="^" XDM W @HL,!! ZO (SDG:SDR) U 0 C:IO'=$I IO:0 Q XDM U 0 I IO=$I W @LH,!!," ",@HL,"for MORE, ",@LH,"^ ",@HL,"to QUIT: ",@LH R A W @LH W:A'="^" @IOFF Q U IO W @IOFF,! Q XDG W !,"^"_S,?10 W $S($D(@("^"_S))#2:$E(@("^"_S),1,IORM-11),1:"") Q XDR ;ZL @S S X=$T(@S) W !,S,?10,$E($P(X,DS,2,99),1,IORM-11) S X=$T(@S+1) W:X[";" !,?10,$E($P(X,DS,2,99),1,IORM-11) ),1:"") Q XDR ;ZL @S S X=$T(@1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+ Q n errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K%M8 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - 1st time initialization of defaults & Terminal Characteristics I '$D(FF) D CURRENT^%MTC S DS=";" S X="Utility Initialization" W @LH,@FF,!,?RM\2-($L(X)\2),X,@HL,!! SDR S Q="SDR" W !,"Default ROUTINE Drive (",@LH,"A-H",@HL,"): " D READ G SDR:E Q:"^"[A S A=$E(UA) I A'?1U!("ABCDEFGH"'[A) W *7," ??" G SDR S SDR=A W ! SDG S Q="SDG" W !,"Default GLOBALS Drive (",@LH,"A-H",@HL,"): " D READ G SDG:E,SDR:"^"[A S A=$E(UA) I A'?1U!("ABCDEFGH"'[A) W *7," ??" G SDG S SDG=A,^%MD=SDR_SDG_" Default Routine & Global Drives for Programmer Utilities" W " --> Filed.",!,@LH,! Q:$D(^%MTC) U 0 W !!,"Initialize Terminal Characteristics",!,"Use T_erminal option to set term. configuration.",!! F I=1:1 S X=$T(%MTC+I) Q:X="" S ^%MTC($P(X," ",1))=$P(X,";",2,99) S ^%MTC="Terminal Characteristics and Port Definitions",^%MU="Programmer Utilities Scratch Area" Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q %MTC ;Initialize values for ^%MTC 0 ;DEFAULT 1 ;OKI82A 2 ;SDP 3 ;SDP 4 ;SDP 5 ;XFER DEFAULT ;!!!!!!!!!!,#~*0~*0~79~24~W ""~C-Default Console~ XFER ;*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~ ADM3A ;*26,#~*27,*41~*27,*40~79~24~W *27,"=",*DY+32,*DX+32~C-Lier Siegler ADM3A~O %IO U %IO W *27,*40 VC4404 ;*24,#~*14~*15~79~23~W *16,*DY+32,*DX+32~C-Volker Craig VC4404 CHAT~O %IO U %IO W *15 DM1521 ;#~*4~*24~79~24~W *30,*DX+32,*DY+32~C-DataMedia 1521~ TV910 ;*27,"*"~*0~*0~79~24~W *27,*61,*DY+32,*DX+32~C-Televideo 910~ VT100 ;*27,*91,*50,*74,*27,*74,#~*0~*0~80~24~W *27,*91,DY+1,*59,DX+1,*102~C-DEC VT100~ VT52 ;*27,*72,*27,*74,#~*0~*0~79~24~W *27,*89,*DY+32,*DX+32~C-DEC VT52~ X820 ;*26,#~*27,*41~*27,*40~79~24~W *27,*61,*DY+32,*DX+32~C-XEROX 820-II~ OKI82A ;#~*0~*0~131~66~W ""~P-OKIDATA 82A~O %IO U %IO W *29 LA120 ;#~*0~*0~102~66~W ""~P-DEC LA120~ QUME ;#~*0~*0~102~66~W ""~P-QUME~ SDP ;#~*0~*0~255~99999~W ""~O-CP/M Sequential File~D IOSDP *0~*0~102~66~W ""~P-DEC LA120~ QUME ;#~*0~*0~102~66~W ""~P-QUME~ SDP ;#~ 0 Q T1 R OK W A,! R OK G T1:OK'="" W $L(A),! R OK G T1:OK'="" U 0 Q  0 Q SYNER S A="<~>" U 0 Q TX U IO I IO'=5 W A,! Und !" G GEDIT3 GEDIT39 W !,?9,"To: ",@LH R R W @HL S G2=$E(G2,0,L1)_R_$E(G2,L2,255) G GEDIT3 GEDIT4 W !,G1,"=",@LH,G2,@HL S @G1=G2 GEDIT5 S Q="GEDIT" W !!,@LH,"A",@HL,"gain, ",@LH,"S",@HL,"top, ",@LH,"N",@HL,"ext: ",@LH,"N",@HL," :: " D READ G GEDIT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y%M9 ;John Lewkowicz - NYS College of Vet. Medicine ;Cont. Programmer Utilities - Help Text G ^%M10:$T(@Q)="" W !!,"- - -",?17,"- - - Use '^' to BACKup a question - - -",?73,"- - -",! I $D(FDR),FDR'=SDR ZO (SDR:SDG) F I=0:1 S X=$T(@Q+I) Q:X=""!(A="?"&I)!(I&($P(X," ",1)'="")) D WRITE I I,A="?",X'=""&($P(X," ",1)="") W !,?20,"Enter ",@LH,"??",@HL," for more Help.",! I 'I W !!,?20,"NO Help available for this question.",! W !,"- - -",?37,"- - -",?73,"- - -",! K I,X I $D(FDR),FDR'=SDR ZO (FDR:FDR) Q WRITE I 'I W @LH,!,$P(X,DS,2,99),@HL,! Q W ! S X=$P(X,DS,2,99) F J=1:1 W @$S(J#2:HL,1:LH),$P(X,"~",J) Q:$P(X,"~",J+1)="" W @HL Q SDR ;Default Drive on which ROUTINES normally reside (A-H). SDG ;Default Drive on which GLOBALS normally reside (A-H). ROG ;Enter R, G, or T or to Quit. ;~R~ To work on ROUTINES. ;~G~ To work on GLOBALS. ;~T~ To add/modify Terminal Characteristics. FUN ;Enter the FIRST character of the desired function: ; ~D~: get a ~Directory~ of Routines or Globals (R/G). ; ~E~: ~Edit~ R/G ; ~L~: ~List~ (to specifed device) R/G ; ~F~: ~Find~ all occurences of specified string(s) or pattern(s) ; ~C~: ~Change~ all occurences of specified string(s) to new string(s) ; ~S~: ~Save~ R/G to given device (normally SDP as a CP/M file) ; ~R~: ~Restore~ Saved routines from specified device (usually SDM) ; ~K~: ~Kill~ R/G also killing entries in directory globals. ; ~X~: ~eXtended Directory~ also lists 1st two routine lines (if comments) ; or top global node if it contains data. FDR1 ;DESTINATION Disk Drive (A-H) to be retored TO. FDR2 ;SOURCE Disk Drive (A-H). RFRSH ;"Y" to refresh directory, or "?L" to get directory listing. OLD ;"Y" to use entries already selected. ;"~?L~" gets you a display of the directory. ;"~?S~" gets you a display of only Selected directory elements. NAME ;NAME(s) to be selected - question will be repeated until NULL. ;Use "~?L~" for Directory, "~?S~" for Directory of Selected names only. ; ;Use "~'~" to ~DE-SELECT~ ("'XY*" removes all names starting with "XY"). ; ;Use "~*~" to represent ANY number of characters, "~?~" to represent any SINGLE ; character. For example: ; ; ~ABC~ will select ~only one name~ "ABC" ; ~A*C~ will select ~any name~ starting with "A" and ending with "C" ; ~A?C~ will select ~any 3-letter name~ starting with "A", ending in "C" TDR ;Restore FROM Drive (A-H). GREF ;Global Reference like "^XYZ" or "^XYZ(1" or "^XYZ(2,3)". ; Use ~Name only~ ("^XYZ") to do ~entire global~. ; Use ~Partial reference~ ("^XYZ(1") for ~all nodes~ (inclusive) under entry. ; Use ~Full reference~ ("XYZ(2,3)") for ~just that node~. ; Use ~?L~ for global directory. ~ (inclusive) under entry. ; Use ~Full referencIO K XX Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) D CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) %MEDT ;John Lewkowicz - NYS College of Veterinary Medicine ;Generalized global editor S X=$S('^(0):"NO text yet\.I 0",1:"Use ""P A"" to see current text\"),A=$P(X,"\",2),X=$P(X,"\",1) S EL=^(0),LNM=EL,CL=^(LNM),RNF=0 W !!!,X_" for "_TTL," (use '?' for HELP)" K X REDIT W !,">>: " I $E(A,1)="." S A=$E(A,2,255) I A'="" W A G R1 D READ G REDIT:E I A?1".".E S A=$E(A,2,255) I A="" S A="R" W A I A?1"+"1N.N S A=LNM_A I A?1N.NP!(A?1"@".E) D UPPER S L=A D GLV G REND:L<1!'$D(^(L)) S LNM=L,CL=^(L) S A="R" R1 S C=$E(A,1) I C'="",". "[C S A=$E(A,2,255) G R1 I C=";",$D(PRG),A'=";" Q I C?1L S C=$C($A(C)-32) I C'=""&("??"[C) D ^%MEDTE G REND S A=$E(A,2,255) F I=1:1 Q:$E(A,1)'=" " S A=$E(A,2,255) I C?1U,$T(@("ED"_C))'="" G @("ED"_C) W *7," NO such command." REND S A="" S:LNM CL=^(LNM) W !! W:'LNM "(NO text yet)" W:LNM LNM D:LNM DISP K L,L1,L2 G REDIT EDA G REND EDB D BREAK^%MEDT1 G REND EDC D GLNM G REND:L1<0 S:L2<0 L2=L1 G REND:'L2 D SET,EDC0^%MEDT1 G REND EDD G EDP EDR D GLNM G REND:L1'>0!'$D(^(L1)) S LNM=L1,CL=^(LNM) W !,LNM D DISP EDR0 W !,?2,"Replace: " R A S X=A,L1=0,L2=0 G EDR9:A="" I X=">>" S L1=255,L2=256 G EDR2 I X'["..." S L2=$F(CL,X) G EDR1:'L2 S L1=L2-1-$L(X) G EDR2 I X="..." S L1=0,L2=256 G EDR2 I X?1"...".E S L1=0,X=$E(X,4,255),L2=$F(CL,X) G EDR1:L2<0,EDR2 I $E(X,$L(X)-2,$L(X))="..." S L2=256,X=$E(X,0,$L(X)-3),L1=$F(CL,X)-1-$L(X) G EDR1:L1<0,EDR2 S I=$E(X,0,$F(X,"...")-4),L1=$F(CL,I) G EDR1:'L1 S L2=$E(X,$F(X,"..."),255),L2=$F(CL,L2,L1) G EDR1:'L2 S L1=L1-1-$L(I) G EDR2 EDR1 W *7," Can't find." G EDR0 EDR2 W !,$E(CL,0,L1) R A W $E(CL,L2,255) S CL=$E(CL,0,L1)_A_$E(CL,L2,255) G EDR0 EDR9 S ^(LNM)=CL G REND EDE D ERASE^%MEDT1 G REND EDF S A="F" G EDX EDI D GLNM G REND:L1<0 S LNM=L1 D GINC S NLN=$S('LNM!$D(^(LNM)):LNM+INC,1:LNM) EDI0 I LNM,$D(^(LNM)) W !,LNM S CL=^(LNM) D DISP EDI1 W !,NLN,?6 W:'$D(PRG) ?10 D READ G EDIX:A?1".".E!(A="") S LNM=NLN,^(LNM)=A D:L1EL EL=LNM,^(0)=EL K NLN,INC W ! G REDIT EDQ D GLNM G REND:L1<0 S:L2<0 L2=L1 G REND:'L2 W !,?5,"Pattern Match X?" D READ G REND:A="" S A=".E"_A_".E" D SET S Y=$Y EDQ1 S L=$O(^(L)) G REND:L=""!(L>L2),EDQ1:^(L)'?@A S X=^(L) D MORE W L,?6,$E(X,1,72) S X=$E(X,73,255) F I=1:1 G EDQ1:X="" D MORE G REDIT:E W ?7,$E(X,1,71) S X=$E(X,72,255) EDM D MOVE^%MEDT1 G REND EDN S ^(0)=EL D RNUM^%MEDT1 S A=".P A" G REDIT EDP D GLNM G REND:L1<0 S:L2<0 L2=L1 G REND:'L2 EDP0 D SET W !! S Y=$Y EDP1 S L=$N(^(L)) G EDP2:L<0!(L>L2) S LNM=L,CL=^(L) D MORE G REDIT:E W LNM D DISP G EDP1 EDP2 W ! K L G REDIT EDS D GLNM G REND:L1<0 S:L2<0 L2=L1 G REND:'L2 W !,?5,"Search for: " D READ G REND:A="" D SET S Y=$Y EDS1 S L=$N(^(L)) G REND:L<0!(L>L2),EDS1:^(L)'[A S X=^(L) D MORE W L,?6,$E(X,1,72) S X=$E(X,73,255) F I=1:1 G EDS1:X="" D MORE G REDIT:E W ?7,$E(X,1,71) S X=$E(X,72,255) EDT D XFER^%MEDT1 G REND EDV D VIEW^%MEDT1 G REND EDX S:EL ^(0)=EL K LNM,CL,INC,NLN,EL,C,L1,L2,L,I W !! Q EDZ D GLNM G REND:L1'>0!'$D(^(L1)) S LNM=L1,CL=^(LNM) W !,CL G EDR0^%MEDT2 READ S A="",E=0 RD2 R A Q GLNM I A="#" S A=LP1_"-"_LP2 W " ["_A_"]" D UPPER S A=$S(A="":"L",A="A":"B-E",1:A),D=$S(A["-":"-",A[":":":",1:"-") S LN=LNM,L=$P(A,D,1) D GLV S L1=-1 S:L'<0 L1=L Q:L1<0 S LN=L1,L=$P(A,D,2) D:A[D GLV X "S L2=$S(L'>0:-1,1:L)" S:L2>L1 LP1=L1,LP2=L2 Q GLV S LP=$P(L,"+",2),L=$P(L,"+",1) I L'?1"@".E X "S L=$S(L="""":LN,+L=L:L,L=""L"":LNM,L=""B"":0,L=""E"":EL,1:-1)" G GLV9 S LL=$E(L,2,99),L=0 F II=1:1 S L=$N(^(L)) Q:L<0 Q:$P(^(L)," ",1)=LL GLV9 I LP F II=1:1:LP S L=$N(^(L)) I L<0 S L=EL Q K LL,II,LP Q GINC S INC=1,L2=$N(^(LNM))-LNM I L2>0 F I=1:1 Q:L2>INC S INC=INC/10 S:INC<1 RNF=1 Q DISP S LIN=CL G DI2:$D(PRG) DI1 W ?10,$E(LIN,1,70) S LIN=$E(LIN,71,255) Q:LIN="" W ! G DI1 DI2 W ?6,$P(LIN," ",1) S LIN=$P(LIN," ",2,255) DI3 W ?15,$E(LIN,1,64) S LIN=$E(LIN,65,255) Q:LIN="" W ! G DI3 SET S L=$S('L1:.00001,1:L1-.00001) Q MORE S E=0 W ! I $Y-Y>22 S Y=$Y,AA=A R "More: ",A D UPPER S:"Y"'[A E=1 S:$E(A,1)'="."&E A="."_A S:'E A=AA W ! Q UPPER F I=1:1 Q:A?.NUPC S X=$E(A,I),X=$A(X) S:X>96&(X<123) A=$E(A,0,I-1)_$C(X-32)_$E(A,I+1,255) Q "."_A S:'E A=AA W ! Q UPPER F I=1:1 Q:A?.NUPC S X=e: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","%MEDT1 ;John Lewkowicz - NYS Coleg of Veterinary Medicine ;Program Editor - extension of %MEDT BREAK D GLNM I L1<1!'$D(^(L1)) W *7," BAD line." Q S LNM=L1,CL=^(LNM) EDB1 W !,?5,"Break after characters: " D READ G EDB1:E Q:A="" S F=$F(CL,A) I 'F W *7," Can't find." G EDB1 D GINC S NLN=LNM+INC,^(LNM)=$E(CL,0,F-1),^(NLN)=$E(CL,F,255) S:NLN>EL EL=NLN,^(0)=EL Q EDC0 W !,?5,"Change every: " D READ G EDC0:E Q:A="" S X=A EDC1 W !,?5," With: " D READ G EDC1:E D LVER G EDC1:E EDC2 S L=$N(^(L)) G EDC9:L<0!(L>L2) S LNM=L,CL=^(L),I="" EDC3 S F=$F(CL,X) I 'F S CL=I_CL W:CL'=^(L) !,L D:CL'=^(L) DISP S ^(L)=CL G EDC2 S I=I_$E(CL,0,F-1-$L(X))_A,CL=$E(CL,F,255) G EDC3 EDC9 K L,F,X W ! Q ERASE ; D GLNM Q:L1<0 D SET I L1'=L2 W !,"ERASE lines "_L1_" thru "_L2_" Are you sure? N ==> " D READ I A'="Y"&(A'="y") W " [NO CHANGE]" Q F I=1:1 S L=$N(^(L)) Q:L<0!(L>L2) K ^(L) ER10 I '$D(^(EL)) S L=-1,EL=0 F I=1:1 S L=$N(^(L)) Q:L<0 S EL=L S LNM=$N(^(L2)) S:LNM<0 LNM=EL S ^(0)=EL W " ** DONE." S RNF=1 Q MOVE ; D GLNM Q:L1<0 D SET S LA=L1,LB=L2,LC=L MV1 W !,"Move lines ",LA,"-",LB," After Line: " D READ G MV1:E Q:"."[A D GLNM I L1<0 W " BAD line." G MV1 S LNM=L1 D GINC S NLN=$S('LNM!$D(^(LNM)):LNM+INC,1:LNM) MV2 S LC=$N(^(LC)) I LC<0!(LC>LB) S L2=LNM-.00001 S:LNM>EL EL=LNM G ER10 W !,NLN,?6,^(LC) S LNM=NLN,^(LNM)=^(LC) K ^(LC) D:L1EL EL=LNM,^(0)=EL W ! K GINC,X XF5 W !,"Transfer COMMENTS too?: Y ==> " D READ G XF5:E Q:A="N"!(A="n") S ROUT=^%MRE,TC="K ^%M(ROUT,LAB) S S1="""" F I=1:1 S S1=$O(^%M(RN,LAB,S1)) Q:S1="""" S X=^(S1),^%M(ROUT,LAB,S1)=X" S SC="ZL @RN F II=0:1 S A=$T(@LA+II) Q:A=N!(J' "",A W #" X "ZR ZL @A W # S A=N F I=1:1 S X=$T(+I) Q:X=N X MORE Q:A=""N""!(A=""n"") W $P(X,SP,1),?8,$P(X,SP,2,255)" S $ZE="" Q RNUM S EL=^(0),L1=0 Q:'EL W " Renumbering..." F I=1000:1 S L1=$N(^(L1)) Q:L1<0!(L1>EL) S ^(I)=^(L1) K ^(L1) F L1=1000:1:(I-1) S ^(L1-999)=^(L1) K ^(L1) S EL=I-1000,^(0)=EL Q READ ; R A S E=0 Q GLNM ; I A="#" S A=LP1_"-"_LP2 W " ["_A_"]" D UPPER S A=$S(A="":"L",A="A":"B-E",1:A),D=$S(A["-":"-",A[":":":",1:"-") S LN=LNM,L=$P(A,D,1) D GLV X "S L1=$S(L<0:-1,1:L)" Q:L1<0 S LN=L1,L=$P(A,D,2) D:A[D GLV X "S L2=$S(L'>0:-1,1:L)" S:L2>L1 LP1=L1,LP2=L2 Q GLV S LP=$P(L,"+",2),L=$P(L,"+",1) I L'?1"@".E X "S L=$S(L="""":LN,+L=L:L,L=""L"":LNM,L=""B"":0,L=""E"":EL,1:-1)" G GLV9 S LL=$E(L,2,99),L=0 F II=1:1 S L=$N(^(L)) Q:L<0 Q:$P(^(L)," ",1)=LL GLV9 I LP F II=1:1:LP S L=$N(^(L)) I L<0 S L=EL Q K LL,II,LP Q GINC ; S INC=1,L2=$N(^(LNM))-LNM I L2>0 F I=1:1 Q:L2>INC S INC=INC/10 S:INC<1 RNF=1 Q LVER S E=0 Q:A?.ANP W *7,!!,?10," key",! S E=1 Q UPPER ; F I=1:1 Q:A?.NUPC S X=$A(A,I) I X>96,X<123 S A=$E(A,0,I-1)_$C(X-32)_$E(A,I+1,255) K X,I Q DISP S LIN=CL G DI2:$D(PRG) DI1 W ?10,$E(LIN,1,70) S LIN=$E(LIN,71,255) Q:LIN="" W ! G DI1 DI2 W ?6,$P(LIN," ",1) S LIN=$P(LIN," ",2,255) DI3 W ?15,$E(LIN,1,64) S LIN=$E(LIN,65,255) Q:LIN="" W ! G DI3 SET S:L2<0 L2=L1 S L=$S('L1:.00001,1:L1-.00001) Q MORE S E=0 W ! I $Y>20 W "More? YES ==> " D READ S:"Nn"[$E(A)&(A'="") A=".P" S:A?1".".E E=1 W # F I=1:1 Q:'$X W $C(8),$C(32),$C(8) Q XFERR ; W *7,!,$ZE," BAD Routine or Line reference." G ZR10^%ZR S:A?1".".E E=1 W # F I=1:1 Q:'$X W $C(8),$C(32),$C(8) Q XFERR ; W *7,!,$ZE," BAD Routine or(FDR:FDR) U IO W @IOLH,@IOFF S X="X-tended "_$P("Routine;Global",DS,$F("RG",ROG)-1)_" Directory" W !!,?RM\2-($L(X)\2),X,! F I=1:1 S S=$O(^%MU(FRG,S)) Q:S="" D:IOSL-$Y<4 XDM Q:A="^" D:ROG="G" XDG X:ROG="R" $P($T(XDR),DS,2,99) D:A'="^" XDM W @HL,!! ZO (SDG:SDR) U 0 C:IO'=$I IO:0 Q XDM U 0 I IO=$I W @LH,!!," ",@HL,"for MORE, ",@LH,"^ ",@HL,"to QUIT: ",@LH R A W @LH W:A'="^" @IOFF Q U IO W @IOFF,! Q XDG W !,"^"_S,?10 W $S($D(@("^"_S))#2:$E(@("^"_S),1,IORM-11),1:"") Q XDR ;ZL @S S X=$T(@S) W !,S,?10,$E($P(X,DS,2,99),1,IORM-11) S X=$T(@S+1) W:X[";" !,?10,$E($P(X,DS,2,99),1,IORM-11) ),1:"") Q XDR ;ZL @S S X=$T(@1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+ Q n errors I 'SLV K ^%U U DV W !!,$S('$D(K):NOSEND,K=MAX:NOLINK,Y'="":NOSYNC,1:GOOD),!!! E K ^U ;Turn echo back on K%MEDTE ;John Lewkowicz - NYS College of Veterinary Medicine ;Routine Editor - General Help D UPPER S A=$E(A,2,9) S:A=";" A="SEMI" S:"?"[A A="1" W !!! G ^%MEDTE1:$T(@A)="" F I=1:1 S X=$T(@A+I) Q:X=""!($P(X," ",1)'="") W !,$P(X,";",2,99) Q UPPER ; F I=1:1 Q:A?.NUPC S X=$A(A,I) I X>96,X<123 S A=$E(A,0,I-1)_$C(X-32)_$E(A,I+1,255) K X,I Q 1 ; ;----------------------------------------------------------------------- ; => "B [line]" Break "line" (default=current) into 2 lines. ; => "C [L1-L2]" Change all occurences of 1 string to another ; => "E [L1-L2]" Erase lines L1-L2. ; => "F" File current routine. ; => "I [line]" Insert text after "line". ; => "M [L1-L2]" Move lines within text. ; => "P [L1-L2]" Print lines L1-L2 -or- "P #" for last range of lines ; => "Q [L1-L2]" Search L1-L2 for PATTERN MATCH. ; => "R [line]" Replace string(s) in line "line". ; => "S [L1-L2]" Search for occurence of string in lines L1-L2. ; => "N" ReNumber the lines ; => "X"  eXit without Filing ; => ";LABEL" Enter/Edit comments for LABEL. ; ; MNEMONICS for L1, L2 ; B - Begining E - End @LABEL - Line "LABEL" ; L - Current line A - All text # - Last range of lines specified ;Use "?B" for more info on Break command, "?C" for Change command, etc. ;---------------------------------------------------------------------- B ; ;BREAK command {B [line]} lets you break one line into two lines. If ; you don't specify the optional line reference ([line]), the current ; line is assumed. You will be asked after which characters in the ; line you want the break to occur. C ; ;CHANGE command {C [L1-L2]} lets you change ALL occurences of one ; string to another string. If you don't specify the optional range ; of line references ([L1-L2]), the Change will only effect the current ; line. You will be asked for both the target and the replacement ; strings. E ; ;ERASE command {E [L1-L2]} lets you erase one or more lines of text. ; If you don't specify the optional range of line references ([L1-L2]), ; the Erase will only eliminate the current line. If the range of ; line references covers more than 1 line you will be asked to verify ; the Erase request. I ; ;INSERT command {I [line]} lets you insert lines of text into the file. ; If you don't specify the optional line reference ([line]) the text ; will be inserted AFTER the Current line. If you do specify a line ; reference, the text will be inserted AFTER that line. If you say ; "I B" the text will be inserted at the begining of the file (that is ; Before any existing text). ; ;Enter null line to return to Edit mode -or- Type in an Edit command ; preceeded with a "." (as in ".P B:+5" or ".X"). M ; ;MOVE command {M [L1-L2]} lets you move lines of text around in the file. ; If you don't specify the optional range of lines to be moved ([L1- ; L2]), then the Current line will be moved. You will be asked which ; line you want the text moved AFTER.  moved ([L1- ; L2]), then the Current line will be moved. You will be asked which ; line you w 0 Q T1 R OK W A,! R OK G T1:OK'="" W $L(A),! R OK G T1:OK'="" U 0 Q  0 Q SYNER S A="<~>" U 0 Q TX U IO I IO'=5 W A,! Und !" G GEDIT3 GEDIT39 W !,?9,"To: ",@LH R R W @HL S G2=$E(G2,0,L1)_R_$E(G2,L2,255) G GEDIT3 GEDIT4 W !,G1,"=",@LH,G2,@HL S @G1=G2 GEDIT5 S Q="GEDIT" W !!,@LH,"A",@HL,"gain, ",@LH,"S",@HL,"top, ",@LH,"N",@HL,"ext: ",@LH,"N",@HL," :: " D READ G GEDIT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y%MEDTE1 ;John Lewkowicz - NYS College of Veterinary Medicine ;Routine Editor - extended explanations extension from %MEDTE F I=1:1 S X=$T(@A+I) Q:X=""!($P(X," ",1)'="") W !,$P(X,";",2,99) Q ROUT ; ;Enter the ROUTINE NAME to be edited. If that name dosen't exist, a new ; routine with that name will be created. If it DOES exist, it will be ; loaded so you can edit it. ;To use the LAST routine edited, enter the character "*". P ; ;PRINT command {P [L1-L2}} lets you print one or more lines of text. If ; you don't specify the optional rang of line references ([L1-L2]), then ; the Current line will be printed. ; The print will pause after each screenful of text. ; ;You can also use "P #" which will clear the screen and display the ; last range of line that you specified. R ; ;REPLACE command {R [line]} lets you replace the first occurence of ; a target string with another string. If you don't specify the optional ; line reference ([line]), the Replace will be done on the current ; line. You will be asked for both a target and a replacement string. ; ; You can use the characters "..." in the target string to indicate ; any and all characters (wild card). Thus a specification of: ; ; "A...CF" would indicate a target starting with "A" and ending with ; "CF" and with ANY characters in between. ; ; Use specification of ">>" to append text to end of line. Q ; ;Q - PATTERN MATCH command {Q [L1-L2]} lets you search for a pattern in ; line L1-L2. Like: ; ; 1"$L(".UN1"," ; ; will search for all occurences of a 2-parameter $L function. ;NOTE that the editor will automatically insert a .E before and after ; your pattern match. Don't you do it (takes a lot longer). S ; ;SEARCH command {S [L1-L2]} lets you search the text for a target string ; of characters. If you don't specify the optional range of lines, only ; the Current line will be searched. You will be asked for the target ; string. ; ;Use "S A" or "S B-E" to search all lines. T ; ;TRANSFER command {T [line]} lets you transfer lines of text from another ; Routine to this one. You will be asked for the Routine Name, the ; Starting Label reference (can be Label + offset), the ending Label ; reference, and the line reference after which the text will be inserted. ; After the line have been moved, you will have the option of moving ; any comments along with them. N ; ;NUMBER command permits you to renumber your text lines (for cosmetic ; purposes). F ; ;FILE the routine you are working on. V ; ;VIEW command allows you to look at other programs without eXiting ; from the editor. You will be asked for the Routine Name. X ; ;EXIT command - go back to Routine Name question WITHOUT filing any ; changes made since the last File command. SEMI ; ;To ADD or EDIT comments to be associated with any given label, enter ;a semcolon followed by the LABEL. You can then enter or edit text to be ;associated with that label. These comments will be printed when listing ;the routine with %RL but do NOT take up partition space when your routine ;is running. ents will be printed when listing ;the routine with %RL but do NOT take up partition space when your routine ;ist ~any name~ starting with "A" and ending with "C" ; ~A?C~ will select ~any 3-letter name~ starting with "A", ending in "C" TDR ;Restore FROM Drive (A-H). GREF ;Global Reference like "^XYZ" or "^XYZ(1" or "^XYZ(2,3)". ; Use ~Name only~ ("^XYZ") to do ~entire global~. ; Use ~Partial reference~ ("^XYZ(1") for ~all nodes~ (inclusive) under entry. ; Use ~Full reference~ ("XYZ(2,3)") for ~just that node~. ; Use ~?L~ for global directory. ~ (inclusive) under entry. ; Use ~Full referencIO K XX Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) D CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) SAVE OF TERMINALS DEFINITION 5/25/83 ^%MTC(0) ADM3A ^%MTC(1) OKI82A ^%MTC(2) SDP ^%MTC(3) SDP ^%MTC(4) SDP ^%MTC(5) XFER ^%MTC("ADM3A") *26,#~*27,*41~*27,*40~79~24~W *27,"=",*DY+32,*DX+32~C-Lier Siegler ADM3A~O %IO U %IO W *27,*40 ^%MTC("DEFAULT") !!!!!!!!!!,#~*0~*0~79~24~W ""~C-Default Console~ ^%MTC("DM1521") #~*4~*24~79~24~W *30,*DX+32,*DY+32~C-DataMedia 1521~ ^%MTC("H19/Z19") *27,"E",#~*27,"q"~*27,"p"~79~23~W *27,"Y",*DY+32,*DX+32~C-Heath/Zenith~ ^%MTC("LA120") #~*0~*0~102~66~W ""~P-DEC LA120~ ^%MTC("OKI82A") #~*0~*0~131~66~W ""~P-OKIDATA 82A~O %IO U %IO W *29 ^%MTC("QUME") #~*0~*0~102~66~W ""~P-QUME~ ^%MTC("SDP") #~*0~*0~255~99999~W ""~O-CP/M Sequential File~D IOSDP ^%MTC("TV910") *27,"*"~*0~*0~79~24~W *27,*61,*DY+32,*DX+32~C-Televideo 910~ ^%MTC("VC4404") *24,#~*14~*15~79~23~W *16,*DY+32,*DX+32~C-Volker Craig VC4404 CHAT~O %IO U %IO W *15 ^%MTC("VT100") *27,*91,*50,*74,*27,*74,#~*0~*0~80~24~W *27,*91,DY+1,*59,DX+1,*102~C-DEC VT100~ ^%MTC("VT52") *27,*72,*27,*74,#~*0~*0~79~24~W *27,*89,*DY+32,*DX+32~C-DEC VT52~ ^%MTC("X820") *26,#~*27,*41~*27,*40~79~24~W *27,*61,*DY+32,*DX+32~C-XEROX 820-II~ ^%MTC("XFER") *0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~ *EOF* ~79~24~W *27,*61,*DY+32,*DX+32~C-XEROX 820-II~))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","%MTC ;JML NYSCVM ;Define or Get terminal characteristics I '$D(IO) W !,"Device: " W:$D(LH) @LH R IO W:$D(HL) @HL S:IO="" IO=0 Q:IO="^" I IO?1N G IO10:$D(^%MTC(IO)) W !!,"Device NUMBER from the following list:",! F %I=0:1 Q:'$D(^%MTC(%I)) W !,?5 W:$D(LH) @LH W %I W:$D(HL) @HL W " ",$P("Console~Printer~SDP1~SDP2~SDP3~Comm.Port","~",%I+1) W:^(%I)'="" " ("_$P(^(^(%I)),"~",7)_")" W ! K %I,IO G %MTC IO10 S %X=^(^(IO)) F %I=1:1:8 S @$P("IOFF~IOHL~IOLH~IORM~IOSL~IOXR~IOST~%X","~",%I)=$P(%X,"~",%I) S %I=$I,%IO=IO S:%X="" %X="O IO" X %X U %I K %I,%X,%IO Q IOSDP W !,"File Name (like A:TEST.EXT): " W:$D(LH) @LH R %A W:$D(HL) @HL S %A1=$P(%A,":",1),%A2=$P(%A,":",2) I %A2="" S %A2=%A1,%A1="A" O IO:(%A1:%A2) K %A,%A1,%A2 Q CURRENT S %X=$S('$D(^%MTC($I)):"#~*0~*0~79~23~W *0~~",1:^(^($I))) F %I=1:1:8 S @$P("FF~HL~LH~RM~SL~XY~SUB~%X","~",%I)=$P(%X,"~",%I) S %IO=$I X %X K %I,%X,%IO Q DEFINE G DEFINE^%MTCD DEFAULT G DEFAULT^%MTCD ~HL~LH~RM~SL~XY~SUB~%X","~",%I)=$P(%X,"~",%I) S %IO=$I X %X K%MTCD ;JML NYSCVM DEFINE S DS=";",TT="" W:$D(LH) @LH W !!!!!,"Terminal Characteristics Definition",!! W:$D(HL) @HL S DL="TT;TX1;TD;FF;BLH;BHL;RM;SL;XY;SC;SV",DN="01111111101",DB="0;0;1;3;4;5;6;7;8;9;10" S DP=1 D DRV W:$D(LH) @LH Q TT ;Terminal Name I "Xx^"[A S DP=0,E="1 " Q I A?1N.N S E="1Numbers are reserved." Q I A?1"?L".E S S="@",E="1 " F I=0:1 S S=$O(^%MTC(S)) W:S="" ! Q:S="" W:'(I#2) ! W ?I#2*40,S," - ",$P(^(S),"~",7) Q:A?1"?L".E S X=$S('$D(^%MTC(A)):"",1:^(A)),OTT="" S:X'="" OTT=A F I=1:1:9 S @$P("FF;BHL;BLH;RM;SL;XY;TD;SC;SV",DS,I)=$P(X,"~",I) Q TX1 ; I TT="" S DP=0,E="1 " Q TD ;Description I A'?1U1"-".E!("CPO"'[$E(A)) S E="1Indicate type also like 'C-DEC GIGI'." Q FF ;Form Feed character(s) Q BHL ;HI->LO character(s) Q BLH ;LO->HI character(s) Q RM ;Right Margin I A'?1N.N S E="1Number please." Q SL ;Screen Length I A'?1N.N S E="1Number please." Q XY ;Cursor Positioning Q SC ;Startup Code I A'["O %IO" W " remember to 'O %IO' if needed." Q SV ;Ready to Save (Y or N) I A=""!("Yy"'[$E(A,1)) S E="1 ",DP=1 W !! Q S X=FF_"~"_BHL_"~"_BLH_"~"_RM_"~"_SL_"~"_XY_"~"_TD_"~"_SC K:OTT'="" ^%MTC(OTT) S ^%MTC(TT)=X W " --> SAVED.",!!! S E="1 ",TT="",DP=1 Q DEFAULT S DS=";",TN="" S DL="TN;TX2;TNM;TS",DN="0111",DB="0;0;1;3",DP=1 D DRV Q TN ;Device Number I "Xx^"[A S E="1 ",DP=0 Q I A?1"?L".E S S="" F I=0:1 S S=$O(^%MTC(S)) Q:S'?1N W:'(I#2) ! W ?I#2*40,S," - ",^(S) I A?1"?L".E W ! S E="1 " Q I A'?1N S E="NUMBER (0-9) only, please." Q S TNM=$S('$D(^%MTC(A)):"",1:^(A)) Q TX2 ; I TN="" S DP=0,E="1 " Q TNM ;Terminal Name I A?1"?L".E S S="@" F I=0:1 S S=$O(^%MTC(S)) Q:S="" W:'(I#2) ! W ?I#2*40,S," - ",$P(^(S),"~",7) I A?1"?L".E W ! S E="1 " Q I '$D(^%MTC(A)) S E="1 " Q TTNM S DT=DT_" - "_$P(^%MTC(DT),"~",7) Q TS ;Ready to Save (Y or N) I A=""!("Yy"'[$E(A,1)) S E="1 ",DP=1 W ! Q S ^%MTC(TN)=TNM W " --> Saved.",!! S E="1 ",TN="",DP=1 Q DRV S DF=0,A="",DM="" S:'$D(DS) DS=";" DRVA Q:'DP S DR=$P(DL,DS,DP) G DRVZ:DR=""  S DQ=$P($T(@DR),DS,2,9),A="" S:DQ[DS DQ=@$P(DQ,DS,2) G DRVG:DQ="" S DI="T"_DR,@DR=$S('$D(@DR):"",1:@DR),DT=@DR D:$T(@DI)'=""&("?"'[DT) @DI DRVB W !,$J(DQ,21),": " I "?"'[DT D DRVT W ?45 W:$X>45 !,?21 W ": " DRVC K DT S DF=1 I DM="" S DF=0 W:$D(LH) @LH R DM:600 W:$D(HL) @HL S:'$T DM="^" G:DM[DS DRVA S A=$P(DM,DS,1),DM=$P(DM,DS,2,99) DRVE D:A="@" ^VZESC G:A="@" DRVA I A="?"!(A="??") D:A="?"!(A="??") DRVHELP G DRVA S E=$E(DN,DP) I A="" G DRVJ:@DR=""&E,DRVH I A="<" S E=$S(E:"1Can't Delete",1:0) G:E DRVJ S @DR="",DE=1 W "DELETED>" G DRVH I A="^" S E=$P(DB,DS,DP),DP=$S(E="^":DP,1:E) G DRVG:E="^",DRVA DRVG S E=0,DT="" D @DR G DRVJ:E S @DR=A,DE=1 S:DT=""&DF DT=A I DT'="" D DRVT DRVH S DP=DP+1 G DRVA DRVJ S DM="" W:$D(LH) @LH W:$X+$L(E)>79 !,?22 W $S(E?1N:" What?",1:" "_$E(E,2,99)) W:$D(HL) @HL G DRVA DRVHELP D ^%MTCH Q DRVT W:$D(LH) @LH S:$D(DT)=1 DT(1)=DT F DT=1:1 Q:'$D(DT(DT)) W:$L(DT(DT))+$X>76 !,?23 W "<"_DT(DT)_">" DRVZ W:$D(HL) @HL K DT Q  W:$D(LH) @LH S:$D(DT)=1 DT(1)=DT F DT=1:1 Q:'$D(D%MTCH ;JML NYSCVM ;HELP text for %MTC W !!,"- - -",?37,"- - -",?73,"- - -" I $T(@DR)="" W !!,"NO further HELP is available." G HEND W ! F I=0:1 S X=$T(@DR+I) Q:$P(X," ",1)'=""&I W !,$P(X,";",2,9) HEND W !!,"- - -",?37,"- - -",?73,"- - -",!! Q TT ; Terminal NAME like "ADM3A" or "LA120" etc. ; ;To get a list of existing names, enter "?L". ; ;Enter "^" or "X" to QUIT data entry. TD ; Terminal Description like "C-DEC GIGI". The first character MUST ; define the terminal type (C=CRT, P=Printer, O=Other), and the 2nd ; character MUST be a "-". ; FF ;Character sequence needed to initiate a FORM FEED or Clear-The-Screen ; on the terminal. This string will be used as an indirect argument to ; a Write command (W @FF). If it is NOT the standard "#", use should ; include the "#" character as the last argument so that MUMPS will ; reset $X and $Y. ; ;Ex. for an ADM3A, enter "*26,#". BHL ;Character sequence to initiate LOW intensity display. These will be ; used as arguments to an indirect Write statement. ; ;Ex. for an ADM3A, enter "*27,*41". BLH ;Character sequence to intiate HIGH intensity display. This will be ; used as an argument to an indirect Write command. ; ;Ex. for ADM3A, enter "*27,*40". RM ;Right margin (in terms of $X [0-RM]). Most CRT's are 79. SL ;Screen Length (in LINES). Reflects $Y (0-SL lines/page). Most ; CRT's can display 24 lines so this value would be 23 (0-23). XY ;Cursor positioning command that will be eXecuted (X @XY) with the ;variable DX and DY set to the desired X and Y coordinates. This MUST ;be executable MUMPS code. ; ;Ex. for ADM3A, enter "W *24,"=",*DY+32,*DX+32". SC ; Startup Code to be executed by %MTC before returning to User. NOTE that ; it is NOT necessary to enter this filed. If you do, it MUST be executable ; MUMPS code. If you do enter it YOU MUST OPEN the device defined by ; the variable %IO. The code can contain a branch to a User defined ; routine. ; ;Ex. for OKIDATA printer, to set at 16.5 cpi, enter "O %IO U %IO W *29". SV ;Enter Y or y to save this definition. Anything else lets you review ; your answers. TN ;Device Number like 0 for the console, 1 for Printer port, etc. ; ;Enter ?L to get a list of the existing ports and their default terminals. ; ;Enter "X" or "^" to QUIT this section. TNM ;Terminal Name to be assigned to the above port like "ADM3A". This ; Name MUST already be defined (via DEFINE^%MTC). ; ;Enter ?L to get a list of Termianl Names that are defined. TS ;"Y" or "y" to save this definition. Anything else to review your ; entry. END ; of Termianl Names thaG DRVJ:E S @DR=A,DE=1 S:DT=""&DF DT=A I DT'="" D DRVT DRVH S DP=DP+1 G DRVA DRVJ S DM="" W:$D(LH) @LH W:$X+$L(E)>79 !,?22 W $S(E?1N:" What?",1:" "_$E(E,2,99)) W:$D(HL) @HL G DRVA DRVHELP D ^%MTCH Q DRVT W:$D(LH) @LH S:$D(DT)=1 DT(1)=DT F DT=1:1 Q:'$D(DT(DT)) W:$L(DT(DT))+$X>76 !,?23 W "<"_DT(DT)_">" DRVZ W:$D(HL) @HL K DT Q  W:$D(LH) @LH S:$D(DT)=1 DT(1)=DT F DT=1:1 Q:'$D(D%NAMES ;SELECT A SET OF GLOBAL or ROUTINE NAMES D ^%DIR G Y+1 X S:'$D(%D) %D="R" Y D X^%DIR K ^%U1 F %I=1:1:^%U(0) S ^%U1($P(^%U(%I)," ",1))="" K ^%U S %DEL=0 START R !!,"Option -- ",%OP G:%OP="" END I "?/ADD/A/DELETE/D/HELP/H/LIST/L/QUIT/Q"'[%OP_"/" W " ???" G START I %OP="?" D HELP G START I $E(%OP)="Q" G END D @%OP G START END I %DEL S %X="" F I=1:1 S %X=$O(^%U(%X)) Q:%X="" K:^%U(%X)="D" ^%U(%X) W !! K ^%U1,%OP,%I,%DL,%D,%NM,%X,%N,%ST,%DEL Q ; GETNMS ;Gather up names W !,"Enter the ",$S(%V=2:"global",%V=3:"routine",1:"file")," name: " W:%V=2 "^" R %NM Q:%NM="" S %DL="?*",%X="",%N=0 Q:%NM'["?"&(%NM'["*") F %I=1:1 D SCAND S:%ST'="" %X=%X_"1"""_%ST_"""" S:%N %X=%X_$S(%D="*":".",1:%N)_"E" Q:%NM="" S %NM=%X Q ; SCAND ;Return string before and after a set of delimeters F %N=1:1:$L(%NM) S %D=$E(%NM,%N) I %DL[%D S %ST=$E(%NM,1,%N-1),%NM=$E(%NM,%N+1,999) Q E S %ST=%NM,%NM="",%N=0,%D="" Q F %N=1:1 S %Y=$E(%NM) Q:%Y'=%D S %NM=$E(%NM,2,999) K %Y Q ; A ;Add names to ^%U list W "DD" ADD D GETNMS Q:%NM="" I '%N S:$D(^%U1(%NM))!(%V=2&$D(^%U1($P(%NM,"(",1)))) ^%U(%NM)="" G ADD S %X="" F %I=1:1 S %X=$O(^%U1(%X)) Q:%X="" S:%X?@%NM ^%U(%X)="" G ADD ; D ;Delete names from ^%U list W "ELETE" DELETE D GETNMS Q:%NM="" I '%N S:$D(^%U1(%NM)) ^%U(%NM)="D",%DEL=1 G DELETE S %X="" F %I=1:1 S %X=$O(^%U1(%X)) Q:%X="" S:%X?@%NM ^%U(%X)="D" S %DEL=1 G DELETE ; L ;List names in ^%U list W "IST" LIST W !! S %X="",%I=1 S %X=$O(^%U(%X)) Q:%X="" I ^%U(%X)'="D" W ?%I-1#5*15,%X W:'(%I#5) ! S %I=%I+1 G LIST+1 Q ; HELP ;List instructions H W !! F %I=1:1 S %X=$E($T(HP+%I),3,999) Q:%X="" W %X,! Q ; HP ;INSTRUCTIONS ;A or ADD -- Add names to the list ;D or DELETE -- Delete names from the list ;L or LIST -- Show the names currently in the list ;H or HELP -- Typed instead of an option to get help ;Q or QUIT -- Exit %NAMES routine ;? -- Another way to get help ; -- Another way to exit ; ; ;Instructions for entering names ; Enter either ; 1. A complete name ; 2. A name with 1 or more *'s in it ; 3. A name with 1 or more ?'s in it ; 4. A combination of 2 and 3 ; 5. A to get the next option choice ; ; Examples: ; MOM will only be the one name 'MOM' ; M*M will be any name starting with 'M' and ending with 'M' ; M?M will be any 3 letter name both starting and ending with 'M' M will be any name starting with 'M' and ending with 'M' ; IT5:E S A=$E(UA) S:"^"[A A="N" I A'?1U!("ASN"'[A) W *7," ??" G GEDIT5 G GEDIT2:A="A" W:A="S" ! Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(YPAGE S LL=^SHELF(LETS) W ! FOR LO=1:1:LL W !,^SHELF(LETS,LO) W ! QUIT UMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST e: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","SCANBOOK S ^BEG=1 K ^ENT DO ^SHELF :LL W !,^SHELF(LETS,LO) W ! QUIT UMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST UIT S C=C-1 DO ^CHOP S ELIM=ELIM_" "_REF GOTO DUSTER " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QDEX." FOR R=^BEG:1:^ENT DO HORSE QUIT HORSE FOR HOOF=1,2,4,5 DO CATTLE QUIT CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN CHOOSE CHOOSE R !,"REFERENCE BY SUBJECT(CR) OR AUTHOR (A)?",CHO I CHO="A" DO ^AUTHSEAR QUIT DO ^SUBJ CHOP CHOP S E=$F(JUNK," ",C) S F=E-2 S REF=$E(JUNK,C,F) QUIT COMLIST COMLIST W !!,^LIB(REF) W !!,^LIB(REF,1),! S TITL=REF DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(REF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT COMPARE COMPARE S R=1 DO ^LISTER QUIT DUST DUST S ELIM=">" FOR A=1:1:26 S C=1 DO DUSTER S ELIM=ELIM_" " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QUIT S C=CSEARCH S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),":",1) DO ^COMPARE GOTO UNSEARCH W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSEARCH R !,"DO YOU WANT TO REFERENCE OTHER WORDS? (Y FOR YES,CR FOR NO)",REPLY IF REPLY="Y" DO ^CHOOSE QUIT THAT WORD" UNSEARCH R !,"DO YOU WANT TO REFERENCE OTHER WORDS? (Y FOR YES,CR FOR NO)",REPLY IF REPLY="Y" DO ^CHOOSE LIMINATE (E) OR KEEP (CR) ",M IF M="E" DO ^TRASH GOTO ELIMIN DO ^FINDSHELF GOTO ELIMIN  GOTO ELIMIN W !,REF R " EWORD) AARDCVARKANTEATERCAT DUMB FELINEDOG NOBLE CANINEZEBRA STRIPED HORSESHELF FOR A=1:1:26 K ^ALPHA K ^SHELF FOR A=1:1:26 S ^SHELF(64+A)=0 S ^TRASH(64+A)=0 S ^ALPHA($A("A"))="A" S ^ALPHA($A("B"))="B" S ^ALPHA($A("C"))="C" S ^ALPHA($A("D"))="D" S ^ALPHA($A("E"))="E" S ^ALPHA($A("F"))="F" S ^ALPHA($A("G"))="G" S ^ALPHA($A("H"))="H" S ^ALPHA($A("I"))="I" S ^ALPHA($A("J"))="J" S ^ALPHA($A("K"))="K" S ^ALPHA($A("L"))="L" S ^ALPHA($A("M"))="M" S ^ALPHA($A("N"))="N" S ^ALPHA($A("O"))="O" S ^ALPHA($A("P"))="P" S ^ALPHA($A("Q"))="Q" S ^ALPHA($A("R"))="R" S ^ALPHA($A("S"))="S" S ^ALPHA($A("T"))="T" S ^ALPHA($A("U"))="U" S ^ALPHA($A("V"))="V" S ^ALPHA($A("W"))="W" S ^ALPHA($A("X"))="X" S ^ALPHA($A("Y"))="Y" S ^ALPHA($A("Z"))="Z" A("U"))="U" S ^ALPHA($A("V"))="V" S ^ALPHA($A("W"))="W" S ^ALPHA($A("X"))="X"OOSE QUIT SHELF SHELF FOR A=1:1:26 K ^ALPHA K ^SHELF FOR A=1:1:26 S ^SHELF(64+A)=0 S ^TRASH(64+A)=0 S ^ALPHA($A("A"))="A" S ^ALPHA($A("B"))="B" S ^ALPHA($A("C"))="C" S ^ALPHA($A("D"))="D" S ^ALPHA($A("E"))="E" S ^ALPHA($A("F"))="F" S ^ALSHELFER S H=$F(^SHELF(S,T),":",1) S I=$L(^SHELF(S,T)) S HA=$F(^SHELF(S,T),":",H) S IA=HA-2 I ^LIB(R)=$E(^SHELF(S,T),H,IA) QUIT S ^SHELF(S,T)=$P(^SHELF(S,T),":",1)_":"_^LIB(R)_":"_$E(^SHELF(S,T),H,I) QUIT A=HA-2 I ^LIB(R)=$E(^SHELF(S,T),H,IAE S ^BEG=L+1 GOTO PRESTART S L=L+1 GOTO START H TO PROCESS REFERENCE WORDS? (CR FOR YES)",RE I RE="" S ^ENT=L DO ^CATALOGUSHOW ;Dump out random parts of a CP/M file S NS=0 ;Start at beginning of file as default S $ZE="ERR" ENTER R "Enter file name: ",FN," and drive ",DV S DR=$ZR ;Save current routine drive ZO:DV'=$ZR DV ;Change routine drive I '$ZE(FN) W !," File """,FN,""" doesn't exist on drive ",DV,! G ENTER O 2:(DV:FN) DSP R !,"Enter record number, for next record, or Q to quit: ",S,! I S'="" G:"Qq"[$E(S) END S NS=S ;Move to NS'th record E S NS=NS+1 U 2:NS F I=1:1:20 R X U 0 Q:X=$C(26) W X,! U 2 U 0 I I'=20 F I=I:1:20 W ! W !,"Record number ",NS,! G DSP END ZO:DR'=$ZR DR ;Change routine drive back K Q ERR S X=$P($ZE,";",1) ; Get error number I X'=48 U 0 W !,"Error ",X," at ",$P($ZE,";",2),! Q E U 0 W !,"Record number outside file",! S $ZE="ERR" G DSP or number I X'=48 U 0 W !,"Error ",X," at ",$P($ZE,";",2),! Q E U 0 W !,"Record number outside fileD CD  Q RTN S RTN=$N(^UTILITY(%JO,RTN)) Q:RTN<0 D L G RTN L X LOAD S XX(0)=LC-1 LR W #,RTN,!! F LC=1:1:XX(0) S LIN=XX(LC) SPELL ;spelling check routine; JAS UCD MAY 1983 ; 18 MAY 83 2:41 PM ; S REF="^TXT(N)",NEXTN="N=$O(^TXT(N))" W #!!?30,"- SPELLING CHECKER -",!! NODE F N=0:0 S @NEXTN Q:N="" S TXT=@REF W:TXT?1" ".E ! D TXT Q TXT I TXT="" W ! Q S OKTXT=1,NEW="",TAB=0 F WNUM=1:1:$L(TXT," ") S (WORD,WRD)=$P(TXT," ",WNUM) S:WORD="" TAB=TAB+1 I WORD]"" D FILTER,PAT,LOOK:'OK,DISP I 'OK S OKTXT=0,NEW=NEW_" "_WRD Q:OKTXT ASK ;SAVE NEW WORDS=SAVE;PASS W/O COMMENT=PASS;EDIT TEXT=EDIT;ENTER NEW PATTERN=NPAT;SAVE INDIVIDUAL WORDS=INDIV W !! S L=$L($T(ASK),";")-1 F I=1:1:L S TITLE(I)=$P($P($T(ASK),";",I+1),"=",1),LABEL(I)=$P($P($T(ASK),";",I+1),"=",2) W ?15,I,?20,TITLE(I),! R ?3,"CHOOSE (1): ",*ASK,!! S ASK=$C(ASK) S:ASK<1!(ASK>L) ASK=1 D @LABEL(ASK) G TXT:'OKTXT Q ; SAVE S OKTXT=1 F WNUM=2:1:$L(NEW," ") S ^SPELL("WRD",$P(NEW," ",WNUM))="" Q PASS S OKTXT=1 Q NPAT R ?15,"Enter a MUMPS logical expression using the variable WRD",!?15,"which will be true to accept words of a certain pattern",!?15,": ",PAT,! I PAT]"" S (NPAT,^SPELL("PAT",0))=$S($D(^SPELL("PAT",0)):^(0)+1,1:1),^(NPAT)=PAT Q EDIT R "REPLACE: ",X,! Q:X="" I @REF[X S X1=$P(@REF,X,1),X2=$P(@REF,X,2,999) W X1 R X W X2 S (TXT,@REF)=X1_X_X2 E W "...NOT FOUND..." W ! G EDIT ; INDIV W ! S NEW="" F I=1:1 R ?15,"SAVE NEW WORD: ",WRD,! Q:WRD="" D FILTER S NEW=NEW_" "_WRD D SAVE S OKTXT=0 W !! Q FILTER ; remove sentence punctuation, printer controls, convert to uppercase etc. S W=WRD,WRD="" F I=1:1:$L(W) S CHR=$E(W,I),WRD=WRD_$S(CHR?1L:$C($A(CHR)-32),1:CHR) I $L(WRD)>1,".,?;:!"[$E(WRD,$L(WRD)) S WRD=$E(WRD,1,$L(WRD)-1) I $L(WRD)>1,$E(WRD,1)="(" S WRD=$E(WRD,2,$L(WRD)) I $L(WRD)>1,$E(WRD,$L(WRD))=")" S WRD=$E(WRD,1,$L(WRD)-1) Q PAT ;check for words accepted by pattern S OK=WRD="" I 'OK F NPAT=0:0 S NPAT=$O(^SPELL("PAT",NPAT)) Q:NPAT="" I @^(NPAT) S OK=1 Q Q LOOK I $D(^SPELL("WRD",WRD)) S OK=1 Q DISP W:$L(WORD)+$X>RM ! W ?TAB D BOLDWRD:'OK W:OK WORD W:$X96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","SHOWBOOK W !!,"WOULD YOU LIKE THE COMPLETE LISTING OF ANY OF THESE" R !,"ARTICLES? (CR FOR YES, N FOR NO)",AN I AN="N" QUIT R !,"PLEASE LIST THE REFERENCE NUMBERS WITH A SINGLE SPACE BETWEEN EACH NUMBER.",!,NOM DO ^SHOWCHOP QUIT  I AN="N" QUIT +A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) AUTHFIND AUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT AUTHSEAR AUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT BIN BIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT BURN BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOSHOWCHOP S JUNK="> "_NOM_" <" S C=1 SHOW I C'=1 R !,"DO YOU WANT TO SEE THE NEXT REFERENCE? (N FOR NO,CR FOR YES): ",AN I AN="N" Q S C=$F(JUNK," ",C) DO ^CHOP DO ^COMLIST I E=$L(JUNK) I QUIT GOTO SHOW CE? (N FOR NO,CR FOR YES): ",AN I AN=%MU~mU~%%!Programmer Utilities Scratch AreaRESR1*;.EIL.ROU;1"TURNSTIL.ROU"RESR2TURNSTIL;1"TURNSTIL"&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #Bibliography package October 14, 1983 09:28 ARCHIVES ARCHIVES W !," SHELF ",! FOR A=1:1:26 S N=^SHELF(64+A) FOR B=1:1:N DO FIX W !!," TRASH ",! FOR C=1:1:26 S M=^TRASH(64+C) FOR D=1:1:M DO RIX QUIT FIX IF N=0 QUIT W !,^ALPHA(64+A),",",^SHELF(64+A,B) QUIT RIX IF M=0 QUIT W !,^ALPHA(64+C),",",^TRASH(64+C,D) AUTHFIND AUTHFIND S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),",",1) DO ^COMPARE GOTO UNSE W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSE R !,"DO YOU WANT TO REFERENCE OTHER WORDS?(Y FOR YES,CR FOR NO): ",EPL I EPL="Y" DO ^CHOOSE QUIT AUTHSEAR AUTHSEAR R !,"ENTER AUTHOR'S LAST NAME: ",WORDA R !,"ENTER AUTHOR'S FIRST NAME (IF UNKNOWN-CR): ",WORDB I WORDB="" S WORD=WORDA DO ^AUTHFIND QUIT S WORD=WORDA_","_WORDB DO ^SEARCH QUIT BIN BIN DO ^DUST S C=1 S JUNK=ELIM DO ^ELIMIN QUIT BURN BURN W !,"YOU MAY BURN ALL THE BOOKS (ALL REFERENCES IRRETRIEVEABLE LOST)" W !,"(WRITE 'BURN BOOKS') " R !,"YOU MAY LOOK AT ALL THE REFERENCE WORDS (Y FOR YES) ",BUR I BUR="BURN BOOKS" DO ^OPENBOOK QUIT DO ^TOMES QUIT CATALOG CATALOGUE W !!,"FOR EACH WORD TYPE 'E' IF YOU WISH TO ELIMINATE THE WORD AS A REFERENCE WORD. " W !,"A CARRIAGE RETURN WILL INCLUDE THE WORD IN THE REFERENCE LIBRARY'S INDEX." FOR R=^BEG:1:^ENT DO HORSE QUIT HORSE FOR HOOF=1,2,4,5 DO CATTLE QUIT CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN CHOOSE CHOOSE R !,"REFERENCE BY SUBJECT(CR) OR AUTHOR (A)?",CHO I CHO="A" DO ^AUTHSEAR QUIT DO ^SUBJ CHOP CHOP S E=$F(JUNK," ",C) S F=E-2 S REF=$E(JUNK,C,F) QUIT COMLIST COMLIST W !!,^LIB(REF) W !!,^LIB(REF,1),! S TITL=REF DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(REF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT COMPARE COMPARE S R=1 DO ^LISTER QUIT DUST DUST S ELIM=">" FOR A=1:1:26 S C=1 DO DUSTER S ELIM=ELIM_" " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QUIT S C=C-1 DO ^CHOP S ELIM=ELIM_" "_REF GOTO DUSTER ELIMIN ELIMIN S C=$F(JUNK," ",C) IF C=0 S C=1 QUIT DO ^CHOP S S=$A(REF,1) I S=-1 QUIT I HOOF=1 GOTO TAIL I HOOF=5 GOTO TAIL IF $L(REF)<6 GOTO ELIMIN FOR T=1:1:^TRASH(S) IF REF=^TRASH(S,T) GOTO ELIMIN TAIL FOR T=1:1:^SHELF(S) IF REF=$P(^SHELF(S,T),":",1) DO ^SHELFER GOTO ELIMIN KNEE IF HOOF=1 DO ^FINDSHELF GOTO ELIMIN IF HOOF=5 DO ^FINDSHELF GOTO ELIMIN W !,REF R " ELIMINATE (E) OR KEEP (CR) ",M IF M="E" DO ^TRASH GOTO ELIMIN DO ^FINDSHELF GOTO ELIMIN FINDSHLF FINDSHELF S A=$A(REF,1) S B=^SHELF(A) S ^SHELF(A)=^SHELF(A)+1 I B=0 GOTO FINDEL FIN I REF]^SHELF(A,B) S ^SHELF(A,B+1)=REF_":"_^LIB(R)_":." QUIT S ^SHELF(A,B+1)=^SHELF(A,B) S B=B-1 FINDEL I B=0 S ^SHELF(A,1)=REF_":"_^LIB(R)_":." QUIT GOTO FIN LIB LIB ; main subprogram PRESTART S L=^BEG START R !!,"MORE REFERENCES TO ENTER? (CR IS YES,N IS NO) ",AN IF AN="N" QUIT S ^LIB(L)=L S Y=0 S ^LIB(L,1)="" 27 R !,"AUTHOR: ",A GOTO:A="" 31 28 IF A="?" W !,"ENTER ONE AUTHOR: LASTNAME,FIRSTNAME; IF NO AUTHOR, ENTER CARRIAGE RETURN" GOTO 27 30 S ^LIB(L,1)=^LIB(L,1)_A_" " R !,"AUTHOR: ",A GOTO:A'="" 28 31 R !,"TITLE: ",T IF T="?" W !,"GIVE ARTICLE OR BOOK TITLE" GOTO 31 S ^LIB(L,2)=T_" " 32 R !,"BIBLIO: ",B IF B="?" W !,"ENTER JOURNAL,(EDITOR),DATE,VOLUME,PAGES" GOTO 32 S ^LIB(L,3)=B 40 R !,"SUMMARY: ",S IF S="" S ^LIBSUM(L)=Y GOTO 70 IF S="?" W !,"WRITE IN A SUMMARY OF THE ARTICLE IF THERE IS ONE" GOTO 40 S Y=Y+1 50 S ^LIB(L,4,Y)=S_" " S S="" GOTO 40 70 R !,"SUBJECT: ",R IF R="?" W !,"YOU MAY TYPE IN KEY REFERENCE WORDS TO USE AS SUBJECT INDICES FOR THIS ARTICLE." IF W !,"AS A METHOD TO KEEP A CURRENT REFERENCE BIBLIO FOR YOU OWN WORK; ALL THE BIBLIOS " IF W !,"UNDER 'JOESBIB' COULD LIST ALL THE REFERENCE YOU WISH TO KEEP LISTED AS A GROUP" GOTO 70 S ^LIB(L,5)=R_" " 80 R !,"WHERE: ",W IF W="?" W !,"LOCATION OF THE ARTICLE: JOES FILES, LIBRARY ONLY, ETC" GOTO 80 S ^LIB(L,6)=W R !!,"DO YOU WISH TO PROCESS REFERENCE WORDS? (CR FOR YES)",RE I RE="" S ^ENT=L DO ^CATALOGUE S ^BEG=L+1 GOTO PRESTART S L=L+1 GOTO START LISTER LISTER S R=$F(^SHELF(L,A),":",R) LIST S T=$F(^SHELF(L,A),":",R) S U=T-2 S NUMB=$E(^SHELF(L,A),R,U) S R=T DO ^SHOWLIST I T=$L(^SHELF(L,A)) DO ^SHOWBOOK QUIT I QUIT GOTO LIST OPENBOOK OPENBOOK S ^BEG=1 K ^ENT K ^LIBSUM K ^LIB DO ^SHELF PAGE PAGE S LL=^SHELF(LETS) W ! FOR LO=1:1:LL W !,^SHELF(LETS,LO) W ! QUIT SCANBOOK SCANBOOK S ^BEG=1 K ^ENT DO ^SHELF SEARCH SEARCH S L=$A(WORD,1) FOR A=1:1:^SHELF(L) I WORD=$P(^SHELF(L,A),":",1) DO ^COMPARE GOTO UNSEARCH W !,"NO REFERENCES ARE FILED UNDER THAT WORD" UNSEARCH R !,"DO YOU WANT TO REFERENCE OTHER WORDS? (Y FOR YES,CR FOR NO)",REPLY IF REPLY="Y" DO ^CHOOSE QUIT SHELF SHELF FOR A=1:1:26 K ^ALPHA K ^SHELF FOR A=1:1:26 S ^SHELF(64+A)=0 S ^TRASH(64+A)=0 S ^ALPHA($A("A"))="A" S ^ALPHA($A("B"))="B" S ^ALPHA($A("C"))="C" S ^ALPHA($A("D"))="D" S ^ALPHA($A("E"))="E" S ^ALPHA($A("F"))="F" S ^ALPHA($A("G"))="G" S ^ALPHA($A("H"))="H" S ^ALPHA($A("I"))="I" S ^ALPHA($A("J"))="J" S ^ALPHA($A("K"))="K" S ^ALPHA($A("L"))="L" S ^ALPHA($A("M"))="M" S ^ALPHA($A("N"))="N" S ^ALPHA($A("O"))="O" S ^ALPHA($A("P"))="P" S ^ALPHA($A("Q"))="Q" S ^ALPHA($A("R"))="R" S ^ALPHA($A("S"))="S" S ^ALPHA($A("T"))="T" S ^ALPHA($A("U"))="U" S ^ALPHA($A("V"))="V" S ^ALPHA($A("W"))="W" S ^ALPHA($A("X"))="X" S ^ALPHA($A("Y"))="Y" S ^ALPHA($A("Z"))="Z" SHELFER SHELFER S H=$F(^SHELF(S,T),":",1) S I=$L(^SHELF(S,T)) S HA=$F(^SHELF(S,T),":",H) S IA=HA-2 I ^LIB(R)=$E(^SHELF(S,T),H,IA) QUIT S ^SHELF(S,T)=$P(^SHELF(S,T),":",1)_":"_^LIB(R)_":"_$E(^SHELF(S,T),H,I) QUIT SHOWBOOK SHOWBOOK W !!,"WOULD YOU LIKE THE COMPLETE LISTING OF ANY OF THESE" R !,"ARTICLES? (CR FOR YES, N FOR NO)",AN I AN="N" QUIT R !,"PLEASE LIST THE REFERENCE NUMBERS WITH A SINGLE SPACE BETWEEN EACH NUMBER.",!,NOM DO ^SHOWCHOP QUIT SHOWCHOP SHOWCHOP S JUNK="> "_NOM_" <" S C=1 SHOW I C'=1 R !,"DO YOU WANT TO SEE THE NEXT REFERENCE? (N FOR NO,CR FOR YES): ",AN I AN="N" Q S C=$F(JUNK," ",C) DO ^CHOP DO ^COMLIST I E=$L(JUNK) I QUIT GOTO SHOW SHOWLIST SHOWLIST W !,"REF: ",^LIB(NUMB) S TITL=NUMB DO ^TITSPLIT W !," ",^LIB(NUMB,1) QUIT SUBJ SUBJ R !,"ENTER A SINGLE REFERENCE WORD: ",WORD DO ^SEARCH TITSPLIT TITSPLIT S FF=$L(^LIB(TITL,2)) S EE=1 S DD=60 PLIT I FF
55 HEADER S STRT=1,BND=55 I $L(DEF)<55 W X,?20,DEF,!! S %L=%L+3 Q F J=1:1 Q:STRT>$L(DEF) D BOUND S %L=%L+1 W ! Q ; BOUND W:J=1 X ;output word on first line of definition I $L(DEF)-STRT<55 G BOUND+4 I $E(DEF,BND)=" " G BOUND+4 F K=1:1 S BND=BND-1 %C=$E(DEF,BND) Q:%C=" " W ?20,$E(DEF,STRT,BND),! S %L=%L+1 S STRT=BND+1 Q:STRT>$L(DEF) I $L(DEF)-STRT>55 S BND=STRT+55 Q E S BND=$L(DEF) Q ;END 0,$E(DEF,STRT,BND),! S %L=%L+1 S STRT=BND+1 Q:STRT>$L(DEF) I $L(DEF)_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","& WORD%MD%MTC%MUBEGTRASH SHELF ALPHA %IB%MREUMLIBLIBSUMENTWORD) AARDCVARKANTEATERCAT DUMB FELINEDOG NOBLE CANINEZEBRA STRIPED HORSE%MD?;BB Default Routine & Global Drives for Programmer Utilities%MTC-uG1-Terminal Characteristics and Port Definitions0DEFAULT 1OKI82A 2SDP 3SDP 4SDP 5XFERhADM3A^*26,#~*27,*41~*27,*40~79~24~W *27,"=",*DY+32,*DX+32~C-Lier Siegler ADM3A~O %IO U %IO W *27,*40<DEFAULT0!!!!!!!!!!,#~*0~*0~79~24~W ""~C-Default Console~?DM15214#~*4~*24~79~24~W *30,*DX+32,*DY+32~C-DataMedia 1521~*LA120 #~*0~*0~102~66~W ""~P-DEC LA120~>OKI82A3#~*0~*0~131~66~W ""~P-OKIDATA 82A~O %IO U %IO W *29$QUME#~*0~*0~102~66~W ""~P-QUME~=SDP5#~*0~*0~255~99999~W ""~O-CP/M Sequential File~D IOSDPFTV910<*27,"*"~*0~*0~79~24~W *27,*61,*DY+32,*DX+32~C-Televideo 910~ VT52~>XFER5*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~]%MTCaG_VC4404T*24,#~*14~*15~79~23~W *16,*DY+32,*DX+32~C-Volker Craig VC4404 CHAT~O %IO U %IO W *15YVT100O*27,*91,*50,*74,*27,*74,#~*0~*0~80~24~W *27,*91,DY+1,*59,DX+1,*102~C-DEC VT100~JVT52A*27,*72,*27,*74,#~*0~*0~79~24~W *27,*89,*DY+32,*DX+32~C-DEC VT52~LX820C*26,#~*27,*41~*27,*40~79~24~W *27,*61,*DY+32,*DX+32~C-XEROX 820-II~>XFER5*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~ MMPstSPELL100MMPuvSPELL52 MMPwxTURNSTILROU?yz{|WPRNT MMP}GLOBALS DAT~GLOBALS DAT BENCH1 MMPMUMPS COMMUMPS COMNCPM3 SYSD %MTC X 0 VC4404%INDX2 MMP'%INDX3 MMP()%INDX4 MMP*%INDX5 MMP+%INDX6 MMP ,%INDX7 MMP-%INDX8 MMP./%M GBL0123456789:;<=>?%M GBLN@ABCD%M MMPEF%M0 MMPGH%M1 MMPIJ%M10 MMPKL%M2 MMPMN%M3 MMPOP%M4 MMPQR%M5 MMP S%M6 MMPTU%M7 MMPV%M8 MMPWX%M9 MMPYZ%MEDT MMP![\]%MEDT1 MMP!^_%MU~mU~%%!Programmer Utilities Scratch AreaRESR1*;.EROUELIMIN0L.ROU"RESR2TURNSTIL;1"TURNSTIL"&RESR3D ^TURNSTIL;1"D ^TURNSTIL""RESR4^TURNSTIL;1"^TURNSTIL"*RESR5^TURNSTIL.ROU;1"^TURNSTIL.ROU"RESR6H;1"H"mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mU~mZ8022 COM Z8022 COMPSETMUMPSCOMSETGLOB COMERRORS DATTK MMP TKI MMPTKR MMP TKS MMP%DATE MMP%DIR MMP %EDIT MMP!"%EDITH MMP #BEG7cSHELF  652651ABEL:4:.652ADVENTURES:5:. 660 671671CARE:2:. 684681DIRT:3:.682 DOE:6:3:.683DOW:6:.684 DUMMY:2:. 691691 EVERT:5:. 700 710 721721 HOWARD:3:. 730 743741JANE:6:.742 JIM:6:5:.743 JOHN:6:4:1:. 750 760 770 781781 NATURE:3:.791791ONE:4:. 800 810 820 839831 SAILING:6:.832 SAILORS:6:.833SAM:4:.834SAWS:4:.835 SEA:6:5:.836 SEVERAL:4:.837 SHIPS:6:5:.838SOIL:3:. 842841 TURNER:1:.842 TWICE:4:. 850 860 871871 WATER:1:. 880 890 900X+TRASH~   651651 ADVENTURES 660 670 680 690 700 710 720 730 740 750 760 770 780 790 800 810 820 830 840 850 860 870 880 890 900?>>?.?00000PPpP0PPXPpXTt|P23P33223203306S32233z23v233/|+</<>#~#>#<#~/<">#<'<~<#<#<#<,~ .n.~,?.n.n.,~.n.,~ .~..? ?~.> ,&.n,?.?  t0`00  x0  PphppXxph`|p`xp0AcpPa00c00#3xxcs0txp1|tq'4'<'-','&'t'$','7'6'/','6'6'.'&'4'6'''$'>'4''#?'6'#&'5#4'4''#$'''?&?$7''''$?&7'/'7$$?'''$&ALPHA Iu " 65A 66B 67C 68D 69E 70F 71G 72H 73I 74J 75K 76L 77M 78N 79O 80P 81Q 82R 83S 84T 85U 86V 87W 88X 89Y 90Zllecting Directory now..." ZO (FDR:FDR) O 2:(FDR:"SCRATCH.DAT") C 2:0 O 2:(FDR:"SCRATCH.DAT") U 2 S X=$F("GR",ROG) V X W !,"*EOF*",! C 2:0 K ^%MU(FRG) O 2:(FDR:"SCRATCH.DAT") F I=1:1 U 2 R X U 0 W "." Q:X="*EOF*" S Y="" F I=1:1 S Z=$E(X,I) S:" "'[Z Y=Y_Z I " "[Z S:Y'="" ^%MU(FRG,Y)=0,Y="" Q:Z="" C 2:1 ZO (SDR:SDG) Q READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) QA%LPHAS %(yuZM : F %X=1:1 R !,">>",%1,! Q:%1="" S:%1="A" %1=%0 S %0=%1 X ^%($S($E(%1,$L(%1))=" ":99,$L(%1)=1:2,%1?1"^".E:1,1:0)) 0X %131,S %G=%1,%2=@%G,%1=1 X ^%(100) S @%G=%2,%1=""62/S %1=$F("MDLCSIEBR?G",%1) X:%1 ^%(%1+1) S %1=""\3UW "*MOVE " X ^%(113) W %2,! R "*INSERT BEFORE LABEL: ",%M,! Q:%M="" ZR @%R ZI %2:@%M_4XR "*DELET LINE(S): ",%2,! ZP @%2 R "OK TO DELET? ",*X W *X Q:X'=89 ZR @%2 W " DELETED"5?R "*LIST LINES: ",%2,! S %5=$E(%2,1)="+" ZP:'%5 @%2 X:%5 ^(115)Q6JW "*CHANGE " X ^%(113) I $L(%2) F %1=1:1 X ^%(100) Q:'$L(%3) ZR @%R ZI %27R "*SEARCH FOR: ",%3,! Q:%3="" F %R=1:1 S @"%2=$T(+%R)" Q:'$L(%2) I %2[%3 W !,%2,! F %5=1:0 S %5=$F(%2,%3,%5)+0 Q:%5=0 W ?%5-1-$L(%3),">" _%IBSUMRO(F5?R "*LIST LINES: ",%2,! S %5=$E(%2,1)="+" ZP:'%5 @%2 X:%5 ^(115)Q6JW "*CHANGE " X ^%(113) I $L(%2) F %1=1:1 X ^%(100) Q:'$L(%3) ZR @%R ZI %27R "*SEARCH FOR: ",%3,! Q:%3="" F %R=1:1 S @"%2=$T(+%R)" Q:'$L(%2) I %2[%3 W !,%2,! F %5=1:0 S %5=$F(%2,%3,%5)+0 Q:%5=0 W ?%5-1-$L(%3),">"`8YW "*INSERT BEFORE " X ^%(113) I $L(%2) W %2,! ZM @%R F %X=1:1 R "*",%2,! Q:'$L(%2) ZI %29R "*REPLACE EVERY: ",%3,! R "*WITH: ",%4,! F %1=1:1 S @"%2=$T(+%1)" Q:'$L(%2) S %L=$S($E(%2,1)=" ":%L+1,1:0) S:'%L %R=$P(%2," ",1) I %2[%3 W !,%2,! X ^(119) ZR @(%R_"+"_%L) ZI %2 W !,%210R "*BACKUP ROUTINE: ",%R,! ZL @%R S %N=%R_".SAV" O 4:("A":%N) U 4 W %R,! F %R=1:1 S %2=$T(+%R) W %2,! I '$L(%2) C 4:0 U 0 W "*SAVED ON A:",%N QG="R"%W !,@LH@ 5 9 12 113 1000 1008" D READ G TERM:E Q:"^"[A I A'?1N!("12"'[A) W *7," ??" G TERM I A=1 D DEFINE^%MTC,CURRENT^%MTC G %M5 D DEFAULT^%MTC,CURRENT^%MTC G %M5 READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q FLAG3 S N=0 K:FUN="R" ^%MU(FRG) FLAG4 S Q="NAME" W !,$S(ROG="R":"Routine",1:"Global"),": " W:ROG="G4691 4701 4711 4721 4731 4741 4751 4761 4771 4781 4791 4801 4811 4821 4831 4841 4851 4861 4871 4881 4891 4901 4911 4921 493126wC346% 4571 4581 4591 4601 4611 4621 4631 4641 4651 4661 4671 4681 4691 4701 4711 4721 4731 4741 4751 4761 4771 4781 4791 4801 4811 4821 4831 4841 4851 4861 4871 4881 4891 4901 4911 4921 49314941 4951 4961 4971 4981 4991 5001 5011 5021 5031 5041 5051 5061 5071 5081 5091 5101 5111 5121 5131 5141 5151 5161 5171 5181 5191 5201 5211 5221 5231 5241 5251 5261 5271 5281 5291 530130%N="S":"V(-12%F %X=1000:1 Q:'$D(^%(%X)) W ^%(%X),!)13!R "*GET ROUTINE: ",%R,! ZL @%R ZPe99]S %R=$E(%1,1,$L(%1)-1),@("%2=$T("_%R_")") I $L(%2) F %1=1:1 X ^%(100) Q:'$L(%3) ZR @%R ZI %2100W:%1=1 %2,! R "*REPLACE: ",%3,! X:%3["..." ^%(114) I $L(%3),%2[%3 S %5=$F(%2,%3),%6=$E(%2,1,%5-$L(%3)-1) W %6 R %4 S %7=$E(%2,%5,255),%2=%6_%4_%7 W %7,!113aS %2="" F %1=1:1 R "LABEL: ",%R,! Q:%R="" S @("%2=$T("_%R_")") Q:$L(%2) W %R," INVALID LABEL",!114S %5=$F(%3,"..."),%31=$E(%3,1,%5-4),%32=$E(%3,%5,255) I %2[%31,%2[%32 S %51=$F(%2,%31),%52=$F(%2,%32,%51) S:%52=%51 %52=256 S %3=$E(%2,%51-$L(%31),%52-1)J115AS %3=$P(%2,":",2) S:%3="" %3=%2 F %4=%2:1:%3 W !,@("$T(+"_%4_")")!",@HL,! H 5 G END DISPATCH G DISPATCH^%M6 READ S E(%W !!,"S (j113aS %2="" F %1=1:1 R "LABEL: ",%R,! Q:%R="" S @("%2=$T("_%R_")") Q:$L(%2) W %R," INVALID LABEL",!114S %5=$F(%3,"..."),%31=$E(%3,1,%5-4),%32=$E(%3,%5,255) I %2[%31,%2[%32 S %51=$F(%2,%31),%52=$F(%2,%32,%51) S:%52=%51 %52=256 S %3=$E(%2,%51-$L(%31),%52-1)J115AS %3=$P(%2,":",2) S:%3="" %3=%2 F %4=%2:1:%3 W !,@("$T(+"_%4_")")k119bF %5=1:0 S %5=$F(%2,%3,%5)+0 Q:%5=0 S %2=$E(%2,1,%5-$L(%3)-1)_%4_$E(%2,%5,255) W ?%5-1-$L(%3),">"1000.ENTER ONE OF THE FOLLOWING AT THE '>>' PROMPT:*1001 ? - TO GET THIS DISPLAY71002-LABEL - FOLLOWED BY SPACE TO EDIT A LINE,1003"^GLOBALREF - TO EDIT A GLOBAL NODE01004&MUMPS CODE - FOR DIRECT MODE EXECUTION each file: ",@LH,"9999999",@HL," :: " D READ W%UMMARY:(81000.ENTER ONE OF THE FOLLOWING AT THE '>>' PROMPT:*1001 ? - TO GET THIS DISPLAY71002-LABEL - FOLLOWED BY SPACE TO EDIT A LINE,1003"^GLOBALREF - TO EDIT A GLOBAL NODE01004&MUMPS CODE - FOR DIRECT MODE EXECUTION:10050SINGLE LETTER CODES TO EDIT THE CURRENT ROUTINE:.1006$(A)GAIN - REPEAT PREVIOUS COMMAND51007+(M)OVE - MOVE A LINE WITHIN THE ROUTINE1008*(D)ELETE - DELETE LINE(S) OF THE ROUTINE21009((L)IST - LIST LINE(S) OF%MRE ELIMIN 015 1ELIMIN S C=$F(JUNK," ",C)2 IF C=0 S C=1 QUIT3 DO ^CHOP4 S S=$A(REF,1)5 I S=-1 QUIT6 I HOOF=1 GOTO TAIL7 I HOOF=5 GOTO TAIL 8 IF $L(REF)<6 GOTO ELIMIN:93 FOR T=1:1:^TRASH(S) IF REF=^TRASH(S,T) GOTO ELIMINU10MTAIL FOR T=1:1:^SHELF(S) IF REF=$P(^SHELF(S,T),":",1) DO ^SHELFER GOTO ELIMIN/11'KNEE IF HOOF=1 DO ^FINDSHLF GOTO ELIMIN+12# IF HOOF=5 DO ^FINDSHLF GOTO ELIMIN:132 W !,REF R " ELIMINATE (E) OR KEEP (CR) ",M'14 IF M="E" DO ^TRASH GOTO ELIMIN!15 DO ^FINDSHLF GOTO ELIMINGOTO TAIL IF $L(REF)<6 GOTO ELIMIN FOR T=1:1:^TRASH(S) IF REF=^TRASH(S,T) GOTO ELIMIN TAIL FOR T=1:1:^SHELF(S) IF REF=$P(^SHELF(S,T),":",1) DO ^SHELFER GOTOLIBC X1111TURNER JOHN 12THE SEA 13141J 15WATER 162221DUMMY 1 22THE CARE OF DUMMY 1 2325CARE 263331 DOE HOWARD 32THE NATURE OF SOIL 3335SOIL DIRT NATURE 364441 ABEL JOHN 42THE SAW OF SAM 43%45SAWS SAM SEVERAL TWICE ONE 465551 EVERT JIM 52THE JIM EVERT STORY 53NONE;541.THE IS A STORY OF THE ADVENTURES OF JIM EVERT )55JIM EVERT ADVENTURES SEA SHIPS 56AT SEA66$61JOHN DOW JIM DOE JANE DOE +62!THE WHY AND WHY NOT OF DOW & DOE 63NONEEDT MMP![\]%MEDT1 MMP!^_LIBSUM-G1020304051610DEFAULT 1OKI82A 2SDP 3SDP 4SDP 5XFERhADM3A^*26,#~*27,*41~*27,*40~79~24~W *27,"=",*DY+32,*DX+32~C-Lier Siegler ADM3A~O %IO U %IO W *27,*40<DEFAULT0!!!!!!!!!!,#~*0~*0~79~24~W ""~C-Default Console~?DM15214#~*4~*24~79~24~W *30,*DX+32,*DY+32~C-DataMedia 1521~*LA120 #~*0~*0~102~66~W ""~P-DEC LA120~>OKI82A3#~*0~*0~131~66~W ""~P-OKIDATA 82A~O %IO U %IO W *29$QUME#~*0~*0~102~66~W ""~P-QUME~=SDP5#~*0~*0~255~99999~W ""~O-CP/M Sequential File~D IOSDPFTV910<*27,"*"~*0~*0~79~24~W *27,*61,*DY+32,*DX+32~C-Televideo 910~ VT52~>XFER5*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~ENT6Default Routine & Global Drives for Programmer UtilitiesLIBX 43%45SAWS SAM SEVERAL TWICE ONE 465551 EVERT JIM 52THE JIM EVERT STORY 53NONE;541.THE IS A STORY OF THE ADVENTURES OF JIM EVERT )55JIM EVERT ADVENTURES SEA SHIPS 56AT SEA66$61JOHN DOW JIM DOE JANE DOE +62!THE WHY AND WHY NOT OF DOW & DOE 63NONE1641$THE STORY OF JOHN JIM & JANE AT SEA -65#SEA SAILING SHIPS SAILORS SINKINGS !66WORLD-WIDE AND ALL OVER~~~!LIB~  1 43~~~E~~~~~..~~~~n~sSHELFMAR  791791ONE:4:. 800 810 820 839831 SAILING:6:.832 SAILORS:6:.833SAM:4:.834SAWS:4:.835 SEA:6:5:.836 SEVERAL:4:.837 SHIPS:6:5:.838 SINKINGS:6:.839SOIL:3:. 842841 TURNER:1:.842 TWICE:4:. 850 860 871871 WATER:1:. 880 890 900!,"UNDER 'JOESBIB' COULD LIST ALL THE REFERENCE YOU WISH TO KEEP LISTED AS A GROUP" GOTO 70 S ^LIB(L,5)=R_" " 80 ASE: ;NAME;NAME: ; ;2;40;YOUR AGE: ;AGE;AGE: ; ;2;50;YOUR SEX: ;SEX;SEX: ; ;4;0;YOUR ADDRESS: ;ADR;ADDRESS: ; ;4;40;YOUR CITY: ;CITY;CITY: ; ;6;0;YOUR OCCUPATION: ;JOB;JOB: ; UR SEX: ;SEX;SEX: ; ;4;0;YOUR ADDRESS: ;ADR;ADDRESS: ; ;4;40;YOUR ; ;2;50;YOUR SEX: ;SEX;SEX: ; ;4;0;YOUR ADDRESS: ;ADR;ADDRESS: ; ;4;40;YOUR CITY: ;CITY;CITY: ; ;6;0;YOUR OCCUPATION: ;JOB;JOB: ; UR SEX: ;SEX;SEX: ; ;4;0;YOUR ADDRESS: ;ADR;ADDRESS: ; ;4;40;YOUR CITY: ;CITY;CITY: ; ;6;0;YOUR OCCUPATION: ;SHOWLIST W !,"REF: ",^LIB(NUMB) S TITL=NUMB DO ^TITSPLIT W !," ",^LIB(NUMB,1) QUIT (N FOR NO,CR FOR YES): ",AN I AN=e: ",@LH,"^" D READ G GFIND:E I "^"[A U 0 C:IO'=$I IO:0 Q I UA?1"?"1U D DIR^%MO:UA="?L",SDIR^%M0:UA="?S" G GFIND S:$E(A,$L(A))="," A=$E(A,0,$L(A)-1) S G="^"_A,GR=$S(G["(":G,1:G_"("""")"),L=$L(G),GE=G,FL=0 I G["(" S FL=$L(G,"(")=$L(G,")") S:'FL GR=GR_")",G=G_")" S L=$L(GR),GE=$E(GR,1,L-1)_"," D FIND G GFIND READ S E=0 W @LH R A:3600 D UPPER W @HL I A'="","??"[A D ^%M9 S E=1 Q UPPER S UA=A F I=1:1 Q:UA?.NUPC S Y=$A(UA,I) S:Y>96&(Y<123) UA=$E(UA,0,I-1)_$C(Y-32)_$E(UA,I+1,255) Q [A D ^%M9 S E1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>70 !?16 W:$X'=16 "," W ARG G P1 YM,$P(L,"^",1),?16 E W !?3,SYM,L,?16 S X=^(L) F I=GRB_","_S Q:ARG="" G U1 ZR Q:ARG="" S L=":,",STR=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","_S G ZR S:S["+" GRB=GRB_","_$P(S,"+",2,999) G ZR  D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) I $E(S,1)="@" S GRB=GRB_","KqH ERRORS DATGLOBALS DATD ^DI222222222%&2'&222222222222222222      #!$"2  !$' $(26 %05@E$06BHT!(5BIVc$2@HVdr '6ETcr!"q"l"o6+#"l s#r*l"l""*ls#r*l"l*"*ls#r*l6G#"l""$'*l6#"l**ls#r*l"l**ls#r*l6+#"l*"*ls#r*l"l"""6 "l**ls#r*l"l**ls#r*l"l"""~"|"6["l"s#r*l"l"s#r*l6#6#6#6+#"l""6-#"ls#r*l"l""ls#r*l6-#6+#"l*s#r*"*l*s#r*l"6-#"l*"Ri*+6+[R"*ls#r*l"l**ls#r*l"l**ls#r*i*o*q2.X]:aa:a2j:jr!Tǒ!"e!"!".222222a2b2c2d22h2i2j2k2l2H>2m2u2{222222I22>2E>2222!"9ͭ:>22!j~w:l8>2l:i%j:j0f>2m!c>w2k!c>w2h:d&ʞ:dʞ:k>2!c>w22l"Bʹ͌:ʎͶV:cž:lV͌2c:k::iO :j :D :m7 :jS::u2.X:2uǒ>>R:  ͕>2ͱǒ:k!"&!l"+"e[:a ͜^:V *@#"@~ ? #"@~O >2*@"e"|2*e~ ʈ ~ ʈ ~ #"e!4h *e#"e~ ʈ ~ ʈ ~ ? : ڲ >2!X:w#"l[l*@$ !7D ! D *6*:l  ++~2/O :k !k4"@*@"e*:k̘":kw#6#*e+"eN>2l:bo h 5:c̓7͂:ae !l~w:bʰ /͆:cVM:d© Nͬ:c@͂:aʑ !l~w:b /8:b :co?͂:a !l~w/:b /:c̅:!l~w:d/NT:ac":c(J:dwN͆:d[ :c̠9:cC N:cB"H:dʞ >2:c̑N:cC>2b:cND:b À N"H>2:c̑N>2b:cG:b :cC>2b:cG:b :c̻H:d N? :cIͳ!l~w:b+ /8:b+ :c?͂:a !l~w:bN /:cH:!l~w:bw /[:c̕:͂:am !l~w/:b  ʩ :cv: n:co::b :cg:͂:a© !l~w:bH  :c̾:S :d> 2NT:a :c̋@c:c::d 1 :c̋@%N:cY;H $:c̻;͂:a !l~w>2g:bʇ z :cJÒ ]:cJ͂:az 2g!l~w:b /͆:cVM:d N:a ͬ:cyA͂:a® !l~w:b /:c.@!l~w:bʓ/:dDNT:ac2:c<ÓF:aʓ:ad:c̝=ÓT:aC:d „N[:cN>2:c̤=͂:a!l~w:b/:a]:dwN͆:c̩4͂:a¶!l~w:b/͆:cVM:dNͬ:c}<͂:a!l~w:bVL2:c̑-a[:c̪/͂:aL!l~w:bʦ>:d‘N[:c9æF:aʦ͆:c9͂:ay!l~w:b/5:b:c+:cJ͂:a!l~w:b/,:c̵L͂:a !l~w/:bIB[:cN:c8!l~w:bʀ/5:dyNR:cI:c|M͂:aa!l~w:bʭ/,:cI͂:a£!l~w:b:cI:dN:cLR:cI͂:a!l~w:b7&:c4B:c̼)ͬ:çM͂:a&!l~w:bʃd:cIÎ:dyN:cLÃ͡:c J͂:ad!l~w:bʰ:c̀I:dN:cL͡:c̰I͂:a°!l~w:b:cu,,:c0+͂:a!l~w:b)` :cH:!l~w:c>:bW:c̝>>2a>2:c̼):d}$'ÖN$':d}%N>2a>2R>2b:dN:d&>2bR>2b>2a>2H 2Hɯ͸>͸>͸>͸>͸>͸>͸>͸>͸> ͸> ͸> ͸> ͸> ͸>͸>͸>͸>͸>͸>͸:c̋@>͸>͸>͸>͸>͸>͸>͸>͸>͸>͸>͸>͸>!͸>"͸>#͸>$͸>%͸>&͸>'͸>(͸>)͸>*͸>+͸>,͸>-͸>.͸>/͸>0͸>1͸>2͸>3͸>4͸>6͸>7͸>2b:dNn>2a:b/:cm,:dN&/!l~w>2b|N:ddN>2b|:aw:b|>2b>2a:d¨N:a£:bʂ2a2:aʂ:dNö:d&!l~w>2a:d2aNͦ!:b:d>2a:dy'@Nͦ>2b:cK:b@:d>2ax:adͭ:ar2ax:adͭ>2a:d N:cu+ç:d ʝ2aN:c̝+>2a:dʽ2aN[:c,>2a:d2aNH:cLI>2a:d N,>2b&R2b:d&N,>2b>2a :bL ':a|:c̖L>2a{:do:c̼)2aN[>2a :bʦ ':aʟ͠':a|:c̖L>2a:d͆:clKN͆:clK :a:b :a:b:c̸K>2a>2b:d,>2b:d,2a>2aN͆:c,>2a͆:c,>2a͆:c,>2a͆>2b:c̯,>2aͦh:a:dʷ±!>wN>2aNR:a:d*N!~w:ctEÌͦ:c̝2Ì:c," :b'-:aY-:a:c̖L>2a:dWN:cQOP&:aʊ:cMÊP&:ac:dƒNP&:aʊ:cMÊ:czO:aʠ:aY>2a:c̼)Ͱ!:dN͆:d%N:ct(>2a:#:a:a :aT:a:c̎Cv:aM:c ET:a<:c,Nv:ac:c>>2a :b2 ':aʲ2a :b:dʑ2aN>2:d§ͪò ':ac:cLN:dN:c̗J͆:c̘*:d%N:h:cK:dNù2>2a:d2aN͙>2a:c-!:c̼)[:cw4:dTN<:cXK!$:c.!:a~>2bÆ>2b:c0!:c 1!͆:a^:c)!5>2a:dN5>2a:c 2!>2$:ċ82!>2$:ċ82!>2b:a!>2b:c:4![:c̺9!:c&n:dCN:cc:bl:cm,͆&v͆:c_K:d„N?'2c!X:a£:cD!R:c"@!Æ!͆:cO!͆:c&M!>2v2:aM:c̊O!5:d^N5:d2aN[>2a:d%N>2a2a:hQ:d&h͈g>2a2a:d ژ>!dژ:c>!dڀ,Ã,:d22dw#>2aN:Hʩ͹ìӅ:cgה!I++~26,#!I++~2:!2!4:w#6#:u2Z!v7L:cg*[R"ϓ:{2Z:HR">26$#6X#*7L:H{">26$#6Y#*7L"$:d^N:aʬ>2bô>2b:d%N:cdO>2:cg:H!;!;"9:cg*:cg̀y*8"ϓ:cg:A2w#6#6#:cg:A2w#6#6#:cg!I:cg:͂2a:dک>!dک:c¡>!dږ,Ù,:dw#>2aN:gʟ:c>26#6#2a:d>2a2:>:c>!Й!Й"_*_6*_"_6*_"_""_*_N:dpN:d :c>: 6"#!4>:dC>$!dC:c>: *e~w#!4>:c:!:N*6:w#6#22a2:d*e>ߦw>2ï!*e~U !~wÁ *e~L% !~wÁ *e~A8 !~wÁ *e~NK !~wÁ *e~P^ !~wÁ *e~Cq !~ wÁ *e~EY!~@wN:d>2a:c¯!!Й!Й"_*_6*_"_6*_"_*_"2:@ !>wÇ!:!:!!>w!~w:-!6U#!4:?!6L#!4:Q!6A#!4:c!6N#!4:u!6P#!4: ʇ!6C#!4:@ʙ!6E#!4!:N~w*6:c!+~2:d!>!d!:c!:dw#!4N!:c!:w#>2>2b:d""& ">2:c:":9">2d>2b,++~22"l2:ʘ"*l+"l!5*l~ h~ h~ ʎ"~"R">!22R":hR": !46 #:w#*@":m"[*eR"e[~*R"*ט*eט*l"e"@+"eN:#:d###h:hw#:mw#:2h>2m>!2b2>2222:^#:2>2"P&:aʈ#:cƒ#++~2>2":d$N!5:&:c#:#*~0#+2*+"6.#P&:a$>2:c$++~2+~20 $!5:#$:w#$:c$+:&:>&*e~E&N!5:&:dV$d$>2!5:&N>2P&:aE&:c>&s2:ar>c!r:­$:&­$*~0&:X%*"#":!2:!/%!$:$*~0$#"!5!5!5$**:D:!2:(%60#!5%2&:!2[*:$*:O "6.&:&:!ک%*"+":2:†%6#**:,""6.:!2%*#"*:X*"!2:!2*O ":X*6.#"0:͸2:!2#:c>&:&!4:!20&60#>2:w#6#:2a:r&:`&>22>2a:&:d&>2a:ʽ&:ʚ&*e~0ʮ&>2:cª&*e~w#!4!5N:d}&:c&:&60#!4:w#6#>2:c2&>2c!c>w:ʚ:d$'$'$'>2a>2a2":cM':M'*e~w#!4N:dc'>!dc'1':cx':w#6#>2b:cʟ':dŸ'>2b*e+"eN:dʰ'2a>2a2:c':'*e~w#!4N:dʹ':c':w#6#:cs(>2+~2͢"r"[r*R+"~2#"l7(*"!4:O(*l#~w+"lKr**l4"l"*:w#2++~2"p*p/O "p+"r~2`):w#6#,++~2*p~-(>2!5*p#"p*r+"r22b*r~2))(:2)):)>2:w#6#ͯ,:b2b2!5*r+"r:(#"r:p)*p~0p):`)*r6-#"r*r*p:Dâ)*r>2:bʙ):ʐ)6-#61#â)60#í):ʭ)!4:w#6#6#!Й:a`*,++~2!~Q*!:NQ*Q*! 2:aM"n*n:/O "n:O "p*n:X!2*n :͸:w#6#!Й,!~† 2:aM>2 2!7)Q*l"p"r~2+~2+~2+~2h "p^#V"n++~2LP:a*!4*r:w**r#"r:+:*p[nR"l4*p:w#"p*rD*nO #"nט!Fͻ!F:2>2[:a`+:ʸžMe!>w*!F=> 2ͅU> 2ͅU*6*̎> 2ͅU:u+! "l~2*l#"l~2ͅU!5:¹++> 2ͅU*6*6++~2/O !"lט!Й~l,*l,l,!7**6!>l,> 2ͅUQ,!c~w*~ʳ:2>2[:a¤,:ʮ,žMe!>w,++~2/O "_*_~0,>2bɯ2b,2Z>2Z6#>2:a4-!Й~s- 2:as-:s-++~2}-!}-/O !5"l*l:O "l~2:͂++~2:/O !*"^#V!R.*"~2#"~22!40*:$:.*"l^#V*l"l!0"t*l*t͕."t"l6*#.6 #*#":̘">!26 #!5:0.6#6#9:Š.6"#6#6#9*96"#6#6#9u+:ʞ.:ʞ.ͤh*"^#V*"^#V!R.!0"t*"~2#"~22!4*t*:O͛ ""tÔ.-+~2ͪQ2:Z/͈k:a2/>2*l^#V*l"lk:aL/:L/: 2*:͂pv:aL/m:aʆ/>2*lN "l>2ar:aL/:2*0*lٗ2"~=/s2:aM:/2͑-0:/>2͑-0:/{0:0!"nB0:†!"nB:b/0!7>2a50!Й!7:aL0!Й++~2/O "l!:N!~Š0>ʊ0!~1Ú0:a1!7!گ0!7!1 2! 2!5:2*l:O "l"_*_*l:D:w#6#ɯ20:a 1!741!Й~1>1! 2:a1++~2/O "p++~2/O "n:2:!1!5*n:O "n:!2*p*nG:Ϳ"n2:a1!:N!̎2++~2/O ++~2/O !7!I:a22++~2/O :͂++~2/O "p++~2/O "n2:+2*p*n:G:Ϳ"n2!4:a+2:!2m2!>wQ*l~2"p22!~w:22>!2,2,++~2*p"n#"p*n++~2/O "n>!F3*n:,3>1213:3>02:w#6#6#:3*n|3*p*n:G:Ϳ"n2:a3$3:œ3*p*n:O:G3$3:!$3*n*pO͛ "p"n3$3!:N!:N!̎ 2:a *p "n*p:D:w#6#:A2!9u+:A2!9u+S:aL42F*[* :F$:FO w#6#!Й+~2~ 4 2!4:w#:w#2:4:HC>2*l "l^#V"[*lR"l"*9R*7*~$\72"l*l++~2/O "l"+"l:5>2IvR:a5++~2!N:!Fښ5!F2!N!̎ 2:a * :O "r* :GX[ *:$5[ *:$* :O " :F!2F:!F2* * :GD:w#6#2I24:5*l~2*"l*l~2#"l"~22:26>2!>w*l:w*lN #"l"0:2>2:|6*l~2:!2!4*l:O #"l!5K6*l":6:!2!4͈k*+":a6*"n:½6m6l^l!5*"l:6*:62:6*pv:a7Zxm:a7sm2*86++~2>!M*9:w#"9͛!"9:22!Й+~2+:uW7:Yʇ7*6W7*6W7:b7"l*l++"l~27+"l~20717:02*l8:m8ǒ!T2.X:b79ǒ>2:m†8:ʆ8++~2/O +~2+~2m+~2j+~2i+~2k+~2h3V.X:2u*e+"eN!52l:d&†8!l~w+~2ͪQ:2*:O #"l:8*lN #"l!5í8*l46#:D9͈kk:a 9>! 9*EY:w#6#*:,96-#61#>2828*^#V "rí8pv:a 9m*l^#V!Rv9>! 9*~"8r:a 9*0*l:ٗ2">! 98*"l"ͩ46#!Й~M>MKs2w#6#6#9++~2/O "l:2:3:*l~2ͅU!5*l#"l:!:N*̎:½͆s:jd:idi!c~w:b2{:{„:!c~w:{”:!c~w!Й~½:>ʽ:>2>2͵2* "s#r!".͢""[*R"~2:͋@c**#"~2͈k:aF;>2*l"n~w*l^#V*l"l^#V!RX;k:aX;:;:g;;:*"l*l^#V!Rʭ;*l"n~–;lq;*n>w*l^#V*l"lq;Bk**s#r+~2ͪQ:C<͈k*l"n:a;*.+".*l^#V*l"lk:a<:;*l+"l*n+"nK*l*nH"n"l"Bk**s#r*̀y!B͂;2>2*~ʊ=:uO=':ax=:{=x=:u]=l==*~n=*~*wQ*~w"t:͂**t"l>2ͩ429"t*~2:u==:a=:{B>2>22=*~=*~*wQ: B>: !4:w#:!EB>:=:u.>=:B>!5+~2:w#6#:uj>:j>Q: _>*~w!:N*̎*t"l>2ͩ42>2E+~2>++~2/O :>+~>+~2/O ++~2/O 6#:bw#^*@":h!?͈g?:kI?"n"pͻHI"l"l*p*n!?*"@>2d2m>2:ii?>2>2!O"l*=*@"*~"!a"l!X=! 7^:m?[*eR"e[*R"*ט*eט!a!I!O:kw#:iw#:hw#:mw#!j42k2i2h>2m>2ͭNrb+tf:kO@ͻHI:ki@!l~wi@:i\@jm@:jx@fm@"l"l"lÊ@:jS:>2m>2l:@2*"l*l^#V!R@*l">w*l^#V*l"là@+~2@!Й+~22.X:\A>!\A*^#V~2#""*~AA~4A*^#V"l6*^#V":\A!>YAž\A8*6:!uoA2u:u2.XW*6:ʯBʯB›AGWïB!7!7:½A:2ߦw:A2&B:B!jͻ&B~W&B*l!5:½A!j"l~oB!y~2#"l̘"l:02w#!4:w#6#uB!j*^#V":w>2:2[:a¤BP*6ìB*6͠X*~w:u2.X*v,!222>!2:aʃC*l"n:C:C!}9>2*n̘"n>2:0C>26 #!5:0C:WC>2*n̘"n6 #6#9>2!4:!Bu+2B:ʍCu+ͪQ͈k:aʯC:I!"C:C*+"*C**2:mC[@*eR"e*eט"l*l "l~2:&D*l++^R"l!5 D*l "l^#V+"e:mHD[@"eNN͢"e:mgD[@"e"n*n+++~2/O "n"*"p*n ">2͎C,++~2:2>2*"l*"ͩ4>2b!Й>D*>2*~"n!Irbtf2ͪQ*+"xp2v:aBE:I !"~*iEm:aPE+E:bE*xiE**~2*e">2"_*_6*_"_*_*"n++"e~2"p/O "e"t+"eN>2a2*n7*n"n7*n"n"r!~F>FmF*e*pRFÏF!4*rט*eט!I*r"n7*n"n!~PFWF!~w! 2*nO "nE!7Mi!>ʞF!>E:¬F>2aF!>EF!Й͢"e͢"n"r!5!7*e+"eNMi!>ʞFÏF*t:G!>w:a2a:a͂*+"eN2"*>2͎C++~2>2"l*~-ʟG*"n*"p:2:2**l~-ʺG~0ʺG2b:m˜G[@*eR"e*eט*"n*"p:2:2fG>2b2b2g*>2͎C,++~2"l*"n:2*"p:2>2++~2"t*~-HH*l"n:2*"p:2*t~-ʘHcH*"n:2*l"p:29H*"n:2*"p:2>2*"l*"ͩ4>2b*:m´H[@*eR"e*eט͢"e:mH[@"e+~2:H++~2/O !5H*e+"eN"v*v "!k5 ͢"l"_[l*_R"_*_!c~w,!Й2:gzI~uI>uIzI2{>2{*"l͈[*6!"*~""|"*6!>w*"l͈[͟_^^`*"|!>w*~"|rb:aʕ*n"|*~"l*l~ J`I͟_*n"l`*l*rRJ!k4*e"l:d22*l~ fJ~ uJ~"\J:2*l#"l?J:\J*l#"l:mŠJ[@*lR"l*lט:2d:hw#:w#:w#:w#2h>2*2++~2"l*l/O "l!i4: !46 #:w#̈́V!X! I*:kw#:hw#:mw#>2m2k2h*l"@+"eNN6#>2!c~w,Q"[l*R"*l~2"p#"nK*l*n4"n"l+!4:w#+~26#6#!4:w#:d&h͈g:hK:d&K>2b++~2"l*l/O "l: !46 #:w#*@":m\L[*eR"e[~*R"*ט*eט:hw#:mw#>2m*l"e"@+"eN>2h2b:h´L:d&h͈g:hʡL:2>2[ž*"|*|*RL*|"l`_[**|RM*|"n"r*r#"r~ M#"r^^!I>2:2*"!\"l!l"[:a͂*"s2:a>!:w#ͼ)++~2k"*/O ""t͜^*t+~2:N++~2NM+~2!>ߦw:A2:M:2~N͆s:2!5òM͆sͅ++~2†+~2:mKN:1DN2†!~wKN!~w++~2"l*l/O "l##"n*l:X6#"lw!44:o&"nט*"l"!2]ͩ4"l:2*l++"l:N~2/O "l!5ñN*l~2:w#!Й>~ 2E:aO>2E2++~2"l:CO*l+"l~2!w!5%O*l:͂60#6#6#>2:aw#:bw#!ЙIIͪQ:̀y!B͂>Ppv:a>Pmr:a>P*l~2#"*6^#*#":̘"6(#!444>2EY:!2:%P6,#!4!5O6)#2:w#6#*2/P*e">2*r"eN:2>2>22a:‡P*e~0BQ:d­P>2*r#"r!5!5:bQN!4:dQbQ*e~0bQ:P>i*e2w!5!4:bQ:BQN:dQbQP!5:bQN:dbQ*e~2:/Q>i2w!5:Q:0bQ:ZQ>!22*e4>2aÛQ:ʛQ*r#"e:!2>i*e2w!5:{Q!4*r+"r*2+"eN͢""[*R""~2#"~2O #"0"l*l++^R+"l**SR:u RͱBR:uR͕BR*^#V~2#"*^#V"*~?Rj*6*^#V*s#r*^#V"l~2uR#"l*s#r*46#"*+++^R"l"+~2+"lʱR~2:!2*l++^R"l!5:±R*l+~2>2:R E*~wR͎C"n*n"++~2/O "n*+~2b+~2aS*:S:a ++~2:2:o&"*:O "!5:XSϓs2:a *p:̘:/O "p!5:S" :w#6#2G2F* " 2:bS!7S:aS!Й!Й:aT!7"* ~2/O ""p:I7T ~2/O ""n!~qU>qU!~TT]T!7!qU::U>ʎT 2:a}UÒT2:T*p*n:G:Ϳ"n2:aU:!2!5!ÒT*n"l:2*p*n:G:Ϳ"n2:aNU:!2!>"UT*n"lRU:!!2:2RU*n:O "l222:2G:2F*l" O " >2aɯ2F>2apU>2pU:u–U:R:u¥U:˗:u±U *~U*^#V*s#r*6*~w*^#V":w*4*#"*s#r**+V*^#V~2#"*^#V"*6*^#V*s#r*~w>2`>2! Й!XͻYV*@"|͢"e͢"@:mƒV[~"@[@*e"e:m©V[@*eR"e[~*@R"@*@ט*eט:mBW*@"*e"̈́V!X! I*:hw#:kw#:iw#:jw#:mw#:uw#2h2i2k2j2u!4>2m*"@*"e>2lL2:}W++~2+~0xW12}W>2:W:W*l+"l~DW+"l~NW+"l~EW!Ɵ7*lW:W,!ЙW::W,!Й+~22"v:X*v++^R"v!5X*v+"v~2.X!Z"l:2:RX*l"l!5:X*l"#"l"#"l""l""l"#"l""l""l""l"!~DY*^#V"*^#V*s#r*6*~X!Ɵ Yͱ!~=Y 2:a=Y:&YQ!5X͋!ͱQ:&YY:6Y*6=Y*~w*~w*~222#">22~څY~ ڔY:ʧY>26"#!44çY>26-#!4*#"!5!5!5*~2:Y:"Y6"#!4:Y:.Y>i!22!5:Y!4:w#*#"!5:§Y:Z6"#++~2"*/O "2*e">2*+"e:ZN:d}Z}ZvZZ:2!5MZ!~w"l:ʕZ:#ÞZ:2P&!>w:aZ++~2:Z*l#"x*l:X6-!4**l:DZ*60#>2:w#6#2*+"eN>2a:k22*"*~ J[#"!4!5:)[>2a* "́*l"D*"l̈́V>2͈[>2YV*D"l*l*R\:½*l"K[:ʴ[d[*l> $*l" "l^#V"*l"l*"["([R[oaK**l4"l"6̈́c*" "&*"~*">2a++~2/O :\"l*~"n*n~\"p"v2*v~ ʋ\~ ʋ\!4*v#"vn\:\ڜ\>2:!\*n*l:O͛ "l"n\*n#"n~ \#"n[\*p"n>2a* "*"2**R!]:]>2!]a:a\^*#"(^#V" [R<]P]*"^#V"\*("(^#V"[* R" ҵ]*#"* *s#r*"**s#r*+"+6- "(* *(s#rþ]*́*6+#"(^#V*( "(6+*"*"*ͨ*:w#">2a>2!X"l6 !7+~21^`*~"n:a2:I^rb:aʕ:2a*n"@"|>2:*n"|Kn*r*:"n"r*n"6e*"!~w::k_[*"r"2*~ ^~ ^~ #"!4ý^:(_>2*e"*+"eN ':a_͠':a|-\:aʐ2*+"eN*:kO "[RF_*"n*"*|+"K**nH"n"[|*r:k$*|:kO 6 #6 #"|*"e!~wrb:aʕ*n"r:b_*r#"r~ º_#"r:b_rb:aʕ[n*rRڕ*r#"r~ _#"r*"r*l"p2*~+`*^#V*s#r*6*l~2 U` U`ͅU!4*l#"l: ʬ`+`> !h`!2m`>2> 2ͅU!5:m`*l#"l~ ʀ`~ ʀ`*l~2ͅU*l#"l: “`*~w**6!X"l6 !7!Fͻ!F"l~ac:a)a:#a*l*Ra*l"f*l""la͈[ad:2>2!FJ*6*"!"j!"l*["[Rڏa*"6*"*"~"*~"|K**l4"l"*ұaQa*"l*6*"!F=e*l"~["l"* "&>2a*""(^#V"*"Rqb**&Rqb>2a*́*"*~Rab#"́*"(~nb*(nb*#" ́c+~2b!7Ûb:w#!Й:b-\:ac:b:b>2!X:w#"l[l*n$ !7>2a*n*Rc!>c*n#"n~ b#"n!b>2a>2a*"l*l"!F"p*q""p2bmc*l "l^#V"l*Rʃc-c*l "p^#V">2a*+"(*(~Rʾc"(~ʯc*(*́cc* ́c*"*"~"|*"* "#"(^#V" *( "(~+Ed "(^#V"**[*R",́*,"#",[** " *,s#r*[ ",~+ʥd*Rfd*"*,́*,#",^#V"*[** " *#"(* *(s#r[**,+",*,+",6-*6-*, ",* *,s#r**ͨ:½*l"v*"l~Fe "l^#V">R2\:aFe** ͨ*"l*"neK*l*n4"n"l6*v"l*#"l*~"n!"r!"!"p*lҤeKr*p*n4"n"p[r*lR"lleKl*p*n4"n"p8[l*n> $*n "n^#V"*n"n*l"l*[R"* "n**ns#r*+"~R@f*́*$*ͨVf* ́** ͨ* "́*"*ͨɯ2:af*n~ ʥf~ ʥf~ ~w##"n!4f6 #!4*n#"n~ ʯf~ ʯf~ f*n~w#: !4*n#"n~ f:w#6#+~2m+~2h+~2i+~2k3V!j5*e+"eN2l͢"e:mKg[@"e"l*l" ~2/O "l" ~2/O "l" "l"*e"l"p"n*n~ ʧg#"n×g*n"n"_*_*nRPh*l#~2#"l^#V"*l"l^#V"e*l~2h#~2m#"lh*[~"@[@*e"e"n[l*nR"n!5*p:/O "p*p*lKnǘ"lÙh+~2m+~2h͢"e͢"@:m‡h[~"@[@*e"e+~2/O *e+"eN>26 #!5:¬h6#6#92>2EY:!2:h6,#!4!5h2:w#6#96 #6"#6#6#9*96"#6#6#9u+*n"l*n7*n"n!~¾i 2Œi*e*pRjÃj:yj*e*pRj*e*n¾j#"n*e#"e!5Ìi!~w 2*e*pRj*n~2Ui:dʀjdj:Lj:dʀjdj:Aj:dʀjʀjdj:N-j:dʀjdj:PIj:ddj>$!ddjÀj:C]j>$!dڀjdj:d€j*n#"n!5:ij*e+"eN!!>ʵj!~µj>ʾj*l"nVi!7*n:O "n+~2m+~2h+~2k3V+~2/O !i52l*e+"eN>2:2**lҗ2">2a:!Ak>2a*""!"l*l##"l[l*.Rzk*^#V*"Uk[*R"*"l^#V"*l"l"z["l:2**lҗ2":blk*z"l:2**lҗ2":bl l*l^#V*l"lk>2al>2a*l"n^#V*l"l"v+"l*n+"nK*l*nH"n"l"*v"l*.+".:o&"t "p*t:O #"t*l"n*"l"[tR"l[l*RڨlË*.#".*l"Kl**n:"l"[t*nR"n*t*ns#r*n"nKp*4""n:w*n#"n[n*:$Bk**s#r-!(*"0(cr!͂fm͡y*"0'*6!-(͕>2*l"n^#V*l"l߄͡y*"x2!4*x"t^#V*x"x "͂£m!5!*(!͂+n1n:n:bm: n*l^#V*l"l*l "l(m>2a:b0n>2aͶy*l "l^#V"*l~2#~2"l"z["l:2*0*lٗ2"~:b·n*z"l2*l^#V!Rn:2*0*lٗ2"~:bn*l^#V*l"l!4Òn!!$!!(Ͷy*l~2"l$(!$͂5p!$(*l"l"0R~+~2:2!(͏m*t"l:2*0*lٗ2"~:2:bpw#sm:2!!(!-:w#:w#:w#:w#!4:o++~2/O +~2+~2+~2+~2!-+~2b++~2/O :5p:b5p!$(n!!$!!͂p:p3!(Ͷy*l"l*l^#V*l"l "(͡y*"n3'*6!3(͡y*l^#V!Rup:q:ʟ:ʟ>2!5*":2=}:22:2!à"~2O #"0:"q݀=}!(!">G2\:aKq_[/q!(*"'*"6*$*ͨ~>2a*$"*"^#V"*$Rq*͂ʵqËq>2a*"f~!*(Ͷy*l"l~r"l^#V*l "l(q:ar*l^#V*l"l*l^#V!RUr*"l(!͂]rͶy*l"l>2abr>2a2!(͡y*"(!͂#s͡y͏m:¦r!4jr*t "t(͡y*"t^#V"Rr!5*t"t(͡yͩ*l"tØr:#s *"~2!5*t[R"t!5ær͡y:2ͩ:o&">:Us*>:O #">_s*>">*^#V "n[>RڂsY>2Ås:s!(Ͷy*l"l*8*ls#r*6*$"^#V"*$RsK[̈́cös,>2!(!(:2(tcr!(2!(Ͷy*l"l222*l"n*l^#V!R~t:2*0*lٗ2"~:t>2!4*l^#V*l"l9t:št!4:št3!(߄*"l(!͂tͶy*l"l2/t߄:v!3(:u2!(Ͷy*l"l(!͂u͏m:2*t"l!(*l"^#V* "(͡y*^#V!R]unt#m!(͡y:2ͩsm*l^#V!R+u:£u!4:£u3!(*"l(!͂tͶy*l"l2"u!(>2!͂[vͶy*l^#V"*l"l(!͂.v!(cr!(uͶy*l^#V["n[vͰ{!(>2u!*(Ͷy*l^#V!Rv͕xwv*l "l~v"l~v"l^#V*l "l*(͕j!*(Ͷy*l"l'̀y!B(!͂rw2JͶy*l#"l*l~>w*"z*l"n*zq"z"n2bQw*l "l!J4w*"l(v>2a*l "l*(?!(ww>2a:J2!?(Ͷy*l#"l:ʬw*l "l!5Ôw*l "n"p*p~w "pùw*p#"pKl*n*p:"l"n*6*"l5~Yx"l(!(Ͷy*(!?͂2 ~}q:aʵy#q}q:ay#q*"l>2!*͂y>2#q*"n'*"l*!(*ls#r*l"l*=*l 6#"ls#r*l6#:w##"l'*l"ls#r*6!*(>2͡yͩ*l"2^#V!Rz>2* ":z:w#:w#!*(>2|z͕!*͂{!+~2+~2z!4|z̀y2!B(!͂ʥ{Ͷy*l#"l*l~2ʒ{"t#"l̘"l> !26 #!5:R{6 #6#9!4:…{u+2*t "l1{*"l({:ʯ{u+!(Ͷy*l^#V"n*l"p0([n*pR"p*l ~2"l-(*l"l!(͡y*"n^#V"*n"n0'*n"r[R"nKn*l*p:"n"l*ns#r*"l[n*rR"r*ls#r*l "l~!2*lw5Hp!(͕!-(͏m:2*t"lsm:|:|n!(Ͷy*l"l(!*͂<}Ͷy*l "l~3}*!(͕j!*(Ͷy*l"l'!(:2*0"*":2*~2!4:2ev}24[*:$*:O "*O "!4!5:L}!͂~Ͷy*l~2"l$'*6*l"l"0R~!!(!$(+~2:22>2$s*0!(ͶyB*l(*l~2"l^#V"8*l"n^#V"*n~22#"n"p* ":ʵ~:ʢ~*pN #"p!5É~*p^*R+"ÿ~* "*nKǘ"nϓs2w#6#:w#*""""2>2!(!:X!͂3$sy2$s$!(Hp!(ͪ}j*l"n*l^#V!Rʁ*l^#V*l"lb*l#"l"[>"lKn*H""l*~*lw*>*ns#r*n:w#"n:2[n*0$*n:O "n::w#"n[n*$ *n!'* "l45*"l^#V[>R"*ls#r* ~2 "n"22!44:!t!4*n^#V*n"nQ[*nR"n* "*n*s#r*":w*6:2*~2"l:܀*l^#V*l"l!5:2!4à*:$2!à:O "">22:$>2!(!(-!(!(͡y*"~":"^#V"*~ ~2 "~"z*[R""|2!4*~"l^#V"n[n*~"~*R"[*~Rڎ!5*l"~[zR"*|"4*~[n"z[z*4R"4["2*"4:!22:!'[n*2"2j!-(:!2!5!4!5[n*4"4*~"~"l:j>2mR~!-(#q*~"l*"nKn*~*|:"n"~*ns#r*ls#r*:"l"n(*n'*2*ls#r*l"l*"p"n'*4*ps#r*p"p*l=*p :w"p5*l :w"l[p*l>$*l"l$(!(͡y5!(:w#$s+~2!-(Hp!(*0ט:w#:w#:w#n+~2+~2+~2͢"0:++~2"0*0++~2/O "0:#"n++^R"0:2!44*0*n:D:2>2>2!!-(!$(!͂ބ1n:ބ:ބ* ":ބ2*"(!͂ބ1n:°!$(:2ބ$!(!-(Ͷy*l"l$'!$(:i*"v^#V"*v[R"v*l[nR"r*n"pKn*l*v:"n"l*ns#r*p"l[r*"*s#r* "~!2*w5!?(Ͷy*l#"l:J2:ʞ*l "l!5Æ*l "l*'*6J]*e~Z #5͗0T]*e~Z( 8z#8͗0$*e~Z(@AO A0(("eNog2g##~#foy0]#͗0*e~((A8[0#?~O#߾ # ##~ 7x(y~(O#߾ (##7?U  # + 0 7 =D Q V[ ] dJk s z.iREAKU LOSE O LSE OR OTO ANG] ALT> F ILL OCK[ PEN RINTJUIT EAD ETSEIEW.RITEiECUTE( 5^k)0:CJ R+Z8clsSCII(HAR5ATA^XTRACTkINDUSTIFYENGTHEXTRDERIECE ANDOM+ELECT8EXTIEWHOROLOGIOJOBSTORAGETEST'X5Y^SAVELOADPRINTJDELETEREMOVEMOVEGO(INSERTQOPTION COUNTERRORGLOBAL NAMEROUTINE+CHECKEXISTSORDERPIECEERRORX5Y^*e#"en&~2d>2a.6>2a.62 :2>2:.6.6d :2>2 *q*o22:(*"e:mʉ:ʉ!G "l:;O2kn!<6 ͂++F>;!X! >( >+I>^*>;*e[@R"ϓp#6#!;ͻЋ2>2!l"e"@ŋǒ":!<F·!j6/4 ҧ:#w!eo&)))))}_}o)TF!Br"F!~ R#ǒǒ:m_ʊG*e~ (###x/ "_*_͈g!mQ####~8######"_*_j!yҒ:mL&:m(2b2m2͓7ͶVŋ{o22ǒ2.Xŋ:ʲЋ++~/O ú*q{o: 2Ô222R *Bw#++~Gx y( # ::O*n۟=2:2:O*p=2:2O:G 0 (:2x(D8HG!>!0+۟-:2/8 : 4!۟y2!:!۟ : ̎48:2: 4 (+ ʍ!:2 x2!۟͌!4 !۟-x8G !۟/:J !۟b!۟L2j !۟>(:!>(2; !۟> -!>(#(: :(:( : >0 : >1>> ;/>-> # >x=>.y2 +H͗.(g (.(g+ hgx(w+ +͗ů~'w+ ¤#A~0_(===w#͗͗'+ ֎#͗͗A'+#͗AO7'w0+y~͗7A~'w0+ůG B͗͗xG/_yOx(G0 GB#Ag#!!ؐؐ͗͗!͗_G<8ٯ~&OG7(H(+w3~GO&H(7( +w++o'ن'w>0>o'OWy'w>+">>!!-!!A!*8͞}!!(%0#!͞!!ͱ*(0!Ï͗Ao+#ů # ې!!b!̎ؐ 0 >(ůw# $~ #,xG~ :(!:8O>O :G8 ~x yz( x=#őG8I(Gyz( (># (P~'w0 +~'wڸ ~w#8(w#ؐG+:O("x H~  (~  (++x0Gy0/_{(#{_y >0Y:(>-:( x >0*x(&{ ~0(~0#y( >.A:(:G(y >.>0z>w#> R> R~O#~R# *e[@R|Ekb~ (# yG8"x$8y$8x$$G>FGyF_zWFǒ > R ǒx(> R >*Rǒ!XҒ! >(>+RI!Oͻ!OҒ>^R*Ғǒ>R> R>R>2a)8!)8 8)8o>gy( >2a*Pyzz{{p#6#Oy0~O/_۟=2:2Gؐ0W:8x 8> O;/!۟C-!Q-۟͌ !!K-!-!C-۟͌!ؐG>_x 0G>0 !> !7!7!7iF2*v"ϓ!Й:2!˟-͌:2!̎!˟-͌!̎J%{'_z'Wy'O:( !7̈́2( F͌:(!> !7!> Ư2{6 #> :( !7!̈́ w222y=2k w>(:E(#:_Fۋ*q+R!r>]* dw+q+wO'F#O>(0<2ay($x()yx8 # x/<#2aO~(# #x>2a8& ~=>0(>ddG#~OO~!a62~( >2~~ #xG~> </# „}o|N#y# ž ##s#r+++ ~O#~Gr+s`i ##s#r_F##N <##N#Gy(;y(6x(4GN#y (x( #  >8 >(<<<2bxɷOɷOxɷRi`BMD~R#+~2+N+Fy_>_>0+2a~=0>O! ^#V鴙~0 G_~G8_~8_>2a~/O {++~O/_=(++~/O O=:G( y:( !7?2њF(4 ,F( (_F(F(_FP:(!> !7!> 2{> :( !7:W!l? w222y2k 0K (G  y(z(+ ɚ yɚz( Ěɚ:2ɚ_ > R s>њ:Eњ#ɚ]:( .62. O6O:(. 6 N#F#^#Vq#p ##s#r*))"g!i6.ð.:<2FF>}Λ OFF®>!f4!¹͘*ͩ͘*ͮ!>2"2͡y*:U^#Vzr+s##"8*6~l# yV2#yq))) "27  ‡/w*6*8 |o&"2͡y|g}_|g}o½7˜*w*6"͡y*"*6K[̈́c*8#"8!"͡y*8* s#r*6">2aF[n:<:OFH>2a!_#"lܞF*:2a F[:<#F*! ^#V"ϓ!Й!͏:a*! s#r*F[:<!F*:( ~w* 4*: $4$~a8{0.Y# i7~.i# H 7:H 6M#6M#6P'U `#EgcB R E A K --- ROUTINES ON GLOBALS ON -1 lp@pERR: IndirectionXecute????????MMP???????????DIR DIR0`'DEV : !C.6(!P~wZ80 MUMPS VERSION 4.02DEV :D COMMAND S %T=$P($H,",",2) F I=1:1:1000 S C=$N(^C(100)) S %T=$P($H,",",2)-%T-T D TIME ; K ^C Q COMMAND S J=J+1 W !,"COMMAND >>== ",$P($T(@("TS"_J)+1)," ",4,999) Q TIME W ?40,"TIME = ",%T K (J,T) Q ME ; K ^C Q COMMAND S J=J+1 W !,"SUBJ R !,"ENTER A SINGLE REFERENCE WORD: ",WORD DO ^SEARCH ," ",^LIB(NUMB,1) QUIT (N FOR NO,CR FOR YES): ",AN I AN=UIT S C=C-1 DO ^CHOP S ELIM=ELIM_" "_REF GOTO DUSTER " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QDEX." FOR R=^BEG:1:^ENT DO HORSE QUIT HORSE FOR HOOF=1,2,4,5 DO CATTLE QUIT CATTLE IF HOOF=4 FOR J=1:1:^LIBSUM(R) S JUNK=" "_^LIB(R,HOOF,J) DO ^BIN IF HOOF'=4 S JUNK=" "_^LIB(R,HOOF) DO ^BIN CHOOSE CHOOSE R !,"REFERENCE BY SUBJECT(CR) OR AUTHOR (A)?",CHO I CHO="A" DO ^AUTHSEAR QUIT DO ^SUBJ CHOP CHOP S E=$F(JUNK," ",C) S F=E-2 S REF=$E(JUNK,C,F) QUIT COMLIST COMLIST W !!,^LIB(REF) W !!,^LIB(REF,1),! S TITL=REF DO ^TITSPLIT FOR AB=1:1:^LIBSUM(REF) W !,^LIB(REF,4,AB) W !!,^LIB(REF,3) W !!,"CAN BE FOUND IN: ",^LIB(REF,6) QUIT COMPARE COMPARE S R=1 DO ^LISTER QUIT DUST DUST S ELIM=">" FOR A=1:1:26 S C=1 DO DUSTER S ELIM=ELIM_" " QUIT DUSTER S C=$F(JUNK," "_^ALPHA(64+A),C) IF C=0 S C=1 QUIT S C=C Drive B0: files: 65 space used: 320k (66k free) B0: %DATE .MMP 2k : %MEDT .MMP 6k : CHOP .MMP 2k : SHELF .MMP 2k B0: %DIR .MMP 2k : %MEDT1 .MMP 6k : COMLIST .MMP 2k : SHELFER .MMP 2k B0: %EDIT .MMP 4k : %MEDTE .MMP 4k : COMPARE .MMP 2k : SHOW .MMP 2k B0: %EDITH .MMP 2k : %MEDTE1 .MMP 4k : CPM3 .SYS 18k : SHOWBOOK.MMP 2k B0: %M .GBL 42k : %MTC .GBL 2k : DUST .MMP 2k : SHOWCHOP.MMP 2k B0: %M .MMP 4k : %MTC .MMP 2k : EBMDIR08.TXT 0k : SHOWLIST.MMP 2k B0: %M0 .MMP 4k : %MTCD .MMP 4k : ELIMIN .MMP 2k : SPELL .MMP 4k B0: %M1 .MMP 4k : %MTCH .MMP 4k : ERRORS .DAT 2k : SUBJ .MMP 2k B0: %M10 .MMP 4k : %NAMES .MMP 4k : FINDSHLF.MMP 2k : TITSPLIT.MMP 2k B0: %M2 .MMP 4k : -EBMMUG .008 2k : GLOBALS .DAT 50k : TOMES .MMP 2k B0: %M3 .MMP 4k : ARCHIVES.MMP 2k : LIB .MMP 2k : TRASH .MMP 2k B0: %M4 .MMP 4k : AUTHFIND.MMP 2k : LISTER .MMP 2k : TURNSTIL.MMP 2k B0: %M5 . MMP 2k : AUTHSEAR.MMP 2k : MUMPS .COM 42k : TURNSTIL.ROU 8k B0: %M6 .MMP 4k : BIN .MMP 2k : OPENBOOK.MMP 2k : WPRNT .MMP 2k B0: %M7 .MMP 2k : BURN .MMP 2k : PAGE .MMP 2k : B0: %M8 .MMP 4k : CATALOG .MMP 2k : SCANBOOK.MMP 2k : B0: %M9 .MMP 4k : CHOOSE .MMP 2k : SEARCH .MMP 2k :  )*= * #" )*= N#Fq#p   * )*= * ) *= ^#VN#F? H * #" )*= ^#V";  *; ^#V" * )*= ^#V"; *;  ͪ  *; q#pÝn* " ! p+q* )*= ^#V"; ! 6> ! i* &*; >OK : <2 E:/ *; ^#V*% DMf KK : *; Nf E*; ~ڻWK þE *; ~SK E = ! 6:! '= :/ = : = !: = : <2 * " !" >! .  * *&͵ "( * *&͵ > j*( #"( *DM*( V"( !" (   K!" }2 : <2 O:* * * "    >! = * DM** +" *( * " Ø* #" *&VOLUME 008 DESCRIPTION: NUMBER SIZE NAME COMMENTS CATALOG.008 CONTENTS OF CP/M VOL. 008 008.1 2K %DATE.MMP 008.2 2K %DIR.MMP 008.3 4K %EDIT.MMP 008.4 2K %EDITH.MMP 008.6 4K %M.MMP 008.7 4K %M0.MMP 008.8 4K %M1.MMP 008.9 4K %M10.MMP 008.10 4K %M2.MMP 008.11 4K %M3.MMP 008.12 4K %M4.MMP 008.13 2K %M5.MMP 008.14 4K %M6.MMP 008.15 2K %M7.MMP 008.16 4K %M8.MMP 008.17 4K %M9.MMP 008.18 6K %MEDT.MMP 008.19 6K %MEDT1.MMP 008.20 4K %MEDTE.MMP 008.21 4K %MEDTE1.MMP 008.22 2K %MTC.GBL 008.23 2K %MTC.MMP 008.24 4K %MTCD.MMP 008.25 4K %MTCH.MMP 008.26 4K %NAMES.MMP 008.27 0K -EBMMUG.008 008.28 2K ARCHIVES.MMP 008.29 2K AUTHFIND.MMP 008.30 2K AUTHSEAR.MMP 008.31 2K BIN.MMP 008.32 2K BURN.MMP 008.33 2K CATALOG.MMP 008.34 2K CHOOSE.MMP 008.35 2K CHOP.MMP 008.36 2K COMLIST.MMP 008.37 2K COMPARE.MMP 008.39 2K DUST.MMP 008.40 2K EBMDIR08.TXT 008.41 2K ELIMIN.MMP 008.42 2K ERRORS.DAT 008.43 2K FINDSHLF.MMP 008.45 2K LIB.MMP 008.46 2K LISTER.MMP 008.48 2K OPENBOOK.MMP 008.49 2K PAGE.MMP 008.50 2K SCANBOOK.MMP 008.51 2K SEARCH.MMP 008.52 2K SHELF.MMP 008.53 2K SHELFER.MMP 008.54 2K SHOW.MMP 008.55 2K SHOWBOOK.MMP 008.56 2K SHOWCHOP.MMP 008.57 2K SHOWLIST.MMP 008.58 4K SPELL.MMP 008.59 2K SUBJ.MMP 008.60 2K TITSPLIT.MMP 008.61 2K TOMES.MMP 008.62 2K TRASH.MMP 008.63 2K TURNSTIL.MMP 008.64 8K TURNSTIL.ROU 008.65 2K WPRNT.MMP K TITSPLIT 008.17 4K %M9.MMP 008.18 6K %MEDT.MMP 008.19 6K %MEDT1.MMP 008.20 4K %MEDTE.MMP 008.21 4K %MEDTE1.MMP 008.22 2K %MTC.GBL 008.23 2K %MTC.MMP 008.24 4K %MTCD.MMP 008.25 4K %MTCH.MMP 008.26 4K %NAMES.MMP 008.27 0K -EBMMUG.008 008.28 2K ARCHIVES.MMP 008.29 2K AUTHFIND.MMP 008.30 2K AUTHSEAR.MMP 008.31 2K BIN.MMP 008.32 2K BURN.MMP 008.33 2K CATALOG.MMP 008.34 2K CHOOSE.MMP 008.35 2K CHOP.MMP 008.36 2K COMLIST.MMP 008.37 2K COMPARE.MMP 008.39 2K DUST.MMP 008.40 2K EBMDIR08.TXT 008.41 2K ELIMIN.MMP 008.42 2K ERRORS.DAT 008.43 2K FINDSHLF.MMP 008.45 2K LIB.MMP 008.46 2K LISTER.MMP 008.48 2K OPENBOOK.MMP 008.4TITSPLIT S FF=$L(^LIB(TITL,2)) S EE=1 S DD=60 PLIT I FF