XUSRB1 ;iscSF/RWF - More Request Broker ;6/8/04 16:41
;;8.0;KERNEL;**28,82,135,275**;Jul 10, 1995
Q ;No entry from top
;
DECRYP(S) ;decrypt passed string
;VYD 5/19/95
N ASSOCIX,IDIX,ASSOCSTR,IDSTR
Q:$L(S)'>2 "" ;Bad call
S ASSOCIX=$A($E(S,$L(S)))-31 ;get associator string index
S IDIX=$A($E(S))-31 ;get identifier string index
S ASSOCSTR=$P($T(Z+ASSOCIX),";",3,9) ;get associator string
S IDSTR=$P($T(Z+IDIX),";",3,9) ;get identifier string
Q $TR($E(S,2,$L(S)-1),ASSOCSTR,IDSTR) ;translated result
;
ENCRYP(S) ;RWF 2/5/96
N %,ASSOCIX,IDIX,ASSOCSTR,IDSTR
S ASSOCIX=$R(20)+1 ;get associator index
F S IDIX=$R(20)+1 Q:ASSOCIX'=IDIX ;get different identifier index
S ASSOCSTR=$P($T(Z+ASSOCIX),";",3,9) ;get associator string
S IDSTR=$P($T(Z+IDIX),";",3,9) ;get identifier string
;translated result
Q $C(IDIX+31)_$TR(S,IDSTR,ASSOCSTR)_$C(ASSOCIX+31)
;
SENDKEYS(RESULT) ;send encryption keys to the client
;VYD 5/19/95
N %,X
S %=1
F S X=$P($T(Z+%),";",3,9) Q:X="" S RESULT(%)=X,%=%+1
Q
;
BLDDRUM Q ;don't run this tag
N I,%,ALLCHARS,RNDMSTR,CHAR
X "ZP Z" ;position insertion point
F I=1:1:20 D
. S ALLCHARS="" F %=32:1:126 S:$C(%)'="^" ALLCHARS=ALLCHARS_$C(%)
. S RNDMSTR=""
. F %=1:1:94 D
. . S POS=$R($L(ALLCHARS))+1,CHAR=$E(ALLCHARS,POS)
. . S RNDMSTR=RNDMSTR_CHAR
. . S ALLCHARS=$P(ALLCHARS,CHAR,1)_$P(ALLCHARS,CHAR,2) ;compress by 1
. X "ZI "" ;;""_RNDMSTR" ;save random string in routine
X "ZS" ;save routine
Q
;
;
Z ;;
;;VEB_0|=f3Y}m<5i$`W>znGA7P:O%H69[2r)jKh@uo\wMb*Da !+T?q4-JI#d;8ypUQ]g"~'&Cc.LNt/kX,e{vl1FRZs(xS
;;D/Jg><p]1W6Rtqr.QYo8TBEMK-aAIyO(xG7lPz;=d)N}2F!U ,e0~$fk"j[m*3s5@XnZShv+`b'{u&_\9%|wL4ic:V?H#C
;;?lBUvZq\fwk+u#:50`SOF9,dp&*G-M=;{8Ai6/N7]bQ1szC!(PxW_YV~)3Lm.EIXD2aT|hKj$rnR@["c g'<>t%4oJHy}e
;;MH,t9K%TwA17-Bzy+XJU?<>4mo @=6:Ipfnx/Y}R8Q\aN~{)VjEW;|Sq]rl[0uLFd`g5Z#e!3$b"P_.si&G(2'Cvkc*ODh
;;vMy>"X?bSLCl)'jhzHJk.fVc6#*[0OuP@\{,&r(`Es:K!7wi$5F; DoY=p%e<t}4TQA2_W9adR]gNBG1~nIZ+3x-Um|8q/
;;:"XczmHx;oA%+vR$Mtr CBTU_w<uEK5f,SW*d8OaFGh]j'{7-~Qp#yqP>09si|VY1J!/[lN23&L4`=.D6)ZIb\n?}(ek@g
;;j7Qh[YU.u6~xm<`vfe%_g-MRF(#iK=trl}C)>GEDN *$OdHzBA98aLJ|2WP:@ko0wy4I/S&,q']5!13XcVs\?Zp"+{;Tbn
;;\UVZ;.&]%7fGq`*SA=Kv/-Xr1OBHiwhP5ukYo{2"}d |NsT,>!x6y~cz[C)pe8m9LaRI(MEFlt:Qg#D'n$W04b@_+?j<3J
;;MgSvV"U'dj5Yf6K*W)/:z$oi7GJ|t(1Ak=ZC,@]Q0?8DnbE[+L`{mq>aOR}wcB4sF_e9rh2l\x<. PyNpu%IT!&3#HX~-
;;rFkn4Z0cH7)`6Xq|yL #wmuW?Gf!2YES;.B_D=el}hN[M&x(*AasU9otd+{]g>TQjp<:v%5O"zI\@$Rb~8i-3/'V1,CJPK
;;\'%u+W)mK41L#:A6!;7("tnyRlaOe09]3EFd ITf.`@P[Q{B$_iYhZo*kbc|HUgz=D>Svr8x,X~-<NsjM}C/&J?p2wV5qG
;;QCl_329e+DTp&\?jNys V]k*M"X!$Y6[i@g>{RvF'01(45LJZU,:-uAwtB;7|%fx.n`IhSE<OoW~=bdP#/KHzrc)8mG}aq
;;!{w*PR[B9Oli~T, rFc"/?ast8=)-_Dgo<E#n4HYA%f'N;0@S7pJ`kGIedM|+C2yjvL5b3K6\Z]V(.h}umxz>XQ$qUW:1&
;;}:SHZ|O~A-bcyJ4%'5vM+ ;eo.$B)Vp\,kTDz1sGL`]*=mg2nxYPd&lErN3[8qF0@u"a_>wQKI{f6C7?9RX(t#i/U<j!Wh
;;,ry*|7<1keO:Wi C/zh4IZ>x!F[_("Dbu%Hl5Pg=]QG.LKcJ0&ont@+{;ATX6jMwBv?2#f`q\}VYm'8Es$NpU)dR~S9a3-
;;h,=/:pJ$@mlY-`bwQ)e3Xt8.RUSMV 2A;j[PN}TE9x~kL&<ns5q>_#c1%K+rIuFoa(zyDWdH]?\GB0g*4f6"Z!'v{7|OiC
;;/$*b.ts0vOx_-o"l3MHI~}!E`eJimPd>Sn&wzFUh?Kf4)g5X<,8pD:9LA{a[k;'|GyYQ=R2B\#q+cru6N1W@(C TV]7Z%j
;;qEoC?YWNtV{Brg,I(i:e7Jd#6m!D8XT"n[$~1*ZcxL.Kh2s4%Q&ju\5Gvazw+9pF@k`HA)=U3/< -}'0b;|PfSRl_MO]y>
;;`@X:!R[\tY5OBcZPh$rM_a-"vgJG%|}oIH)wWQ*jDVxlp,'+S zu(&7?>KCn4y1dE02q6b<F=8]9NAmT{Li3f/esUk.~#
;;\Zr';/SMsG76Lj$aBc[#k>u=_O@2J&X{Aft xV4~vz8Q}q)0K.NIpRnYwDhg+<"H-!(PF:m*]?,WCT|dE9o53%`liUey1b
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSRB1 3616 printed Apr 09, 2024@21:11:28 Page 2
XUSRB1 ;iscSF/RWF - More Request Broker ;6/8/04 16:41
+1 ;;8.0;KERNEL;**28,82,135,275**;Jul 10, 1995
+2 ;No entry from top
QUIT
+3 ;
DECRYP(S) ;decrypt passed string
+1 ;VYD 5/19/95
+2 NEW ASSOCIX,IDIX,ASSOCSTR,IDSTR
+3 ;Bad call
if $LENGTH(S)'>2
QUIT ""
+4 ;get associator string index
SET ASSOCIX=$ASCII($EXTRACT(S,$LENGTH(S)))-31
+5 ;get identifier string index
SET IDIX=$ASCII($EXTRACT(S))-31
+6 ;get associator string
SET ASSOCSTR=$PIECE($TEXT(Z+ASSOCIX),";",3,9)
+7 ;get identifier string
SET IDSTR=$PIECE($TEXT(Z+IDIX),";",3,9)
+8 ;translated result
QUIT $TRANSLATE($EXTRACT(S,2,$LENGTH(S)-1),ASSOCSTR,IDSTR)
+9 ;
ENCRYP(S) ;RWF 2/5/96
+1 NEW %,ASSOCIX,IDIX,ASSOCSTR,IDSTR
+2 ;get associator index
SET ASSOCIX=$RANDOM(20)+1
+3 ;get different identifier index
FOR
SET IDIX=$RANDOM(20)+1
if ASSOCIX'=IDIX
QUIT
+4 ;get associator string
SET ASSOCSTR=$PIECE($TEXT(Z+ASSOCIX),";",3,9)
+5 ;get identifier string
SET IDSTR=$PIECE($TEXT(Z+IDIX),";",3,9)
+6 ;translated result
+7 QUIT $CHAR(IDIX+31)_$TRANSLATE(S,IDSTR,ASSOCSTR)_$CHAR(ASSOCIX+31)
+8 ;
SENDKEYS(RESULT) ;send encryption keys to the client
+1 ;VYD 5/19/95
+2 NEW %,X
+3 SET %=1
+4 FOR
SET X=$PIECE($TEXT(Z+%),";",3,9)
if X=""
QUIT
SET RESULT(%)=X
SET %=%+1
+5 QUIT
+6 ;
BLDDRUM ;don't run this tag
QUIT
+1 NEW I,%,ALLCHARS,RNDMSTR,CHAR
+2 ;position insertion point
XECUTE "ZP Z"
+3 FOR I=1:1:20
Begin DoDot:1
+4 SET ALLCHARS=""
FOR %=32:1:126
if $CHAR(%)'="^"
SET ALLCHARS=ALLCHARS_$CHAR(%)
+5 SET RNDMSTR=""
+6 FOR %=1:1:94
Begin DoDot:2
+7 SET POS=$RANDOM($LENGTH(ALLCHARS))+1
SET CHAR=$EXTRACT(ALLCHARS,POS)
+8 SET RNDMSTR=RNDMSTR_CHAR
+9 ;compress by 1
SET ALLCHARS=$PIECE(ALLCHARS,CHAR,1)_$PIECE(ALLCHARS,CHAR,2)
End DoDot:2
+10 ;save random string in routine
XECUTE "ZI "" ;;""_RNDMSTR"
End DoDot:1
+11 ;save routine
XECUTE "ZS"
+12 QUIT
+13 ;
+14 ;
Z ;;
+1 ;;VEB_0|=f3Y}m<5i$`W>znGA7P:O%H69[2r)jKh@uo\wMb*Da !+T?q4-JI#d;8ypUQ]g"~'&Cc.LNt/kX,e{vl1FRZs(xS
+2 ;;D/Jg><p]1W6Rtqr.QYo8TBEMK-aAIyO(xG7lPz;=d)N}2F!U ,e0~$fk"j[m*3s5@XnZShv+`b'{u&_\9%|wL4ic:V?H#C
+3 ;;?lBUvZq\fwk+u#:50`SOF9,dp&*G-M=;{8Ai6/N7]bQ1szC!(PxW_YV~)3Lm.EIXD2aT|hKj$rnR@["c g'<>t%4oJHy}e
+4 ;;MH,t9K%TwA17-Bzy+XJU?<>4mo @=6:Ipfnx/Y}R8Q\aN~{)VjEW;|Sq]rl[0uLFd`g5Z#e!3$b"P_.si&G(2'Cvkc*ODh
+5 ;;vMy>"X?bSLCl)'jhzHJk.fVc6#*[0OuP@\{,&r(`Es:K!7wi$5F; DoY=p%e<t}4TQA2_W9adR]gNBG1~nIZ+3x-Um|8q/
+6 ;;:"XczmHx;oA%+vR$Mtr CBTU_w<uEK5f,SW*d8OaFGh]j'{7-~Qp#yqP>09si|VY1J!/[lN23&L4`=.D6)ZIb\n?}(ek@g
+7 ;;j7Qh[YU.u6~xm<`vfe%_g-MRF(#iK=trl}C)>GEDN *$OdHzBA98aLJ|2WP:@ko0wy4I/S&,q']5!13XcVs\?Zp"+{;Tbn
+8 ;;\UVZ;.&]%7fGq`*SA=Kv/-Xr1OBHiwhP5ukYo{2"}d |NsT,>!x6y~cz[C)pe8m9LaRI(MEFlt:Qg#D'n$W04b@_+?j<3J
+9 ;;MgSvV"U'dj5Yf6K*W)/:z$oi7GJ|t(1Ak=ZC,@]Q0?8DnbE[+L`{mq>aOR}wcB4sF_e9rh2l\x<. PyNpu%IT!&3#HX~-
+10 ;;rFkn4Z0cH7)`6Xq|yL #wmuW?Gf!2YES;.B_D=el}hN[M&x(*AasU9otd+{]g>TQjp<:v%5O"zI\@$Rb~8i-3/'V1,CJPK
+11 ;;\'%u+W)mK41L#:A6!;7("tnyRlaOe09]3EFd ITf.`@P[Q{B$_iYhZo*kbc|HUgz=D>Svr8x,X~-<NsjM}C/&J?p2wV5qG
+12 ;;QCl_329e+DTp&\?jNys V]k*M"X!$Y6[i@g>{RvF'01(45LJZU,:-uAwtB;7|%fx.n`IhSE<OoW~=bdP#/KHzrc)8mG}aq
+13 ;;!{w*PR[B9Oli~T, rFc"/?ast8=)-_Dgo<E#n4HYA%f'N;0@S7pJ`kGIedM|+C2yjvL5b3K6\Z]V(.h}umxz>XQ$qUW:1&
+14 ;;}:SHZ|O~A-bcyJ4%'5vM+ ;eo.$B)Vp\,kTDz1sGL`]*=mg2nxYPd&lErN3[8qF0@u"a_>wQKI{f6C7?9RX(t#i/U<j!Wh
+15 ;;,ry*|7<1keO:Wi C/zh4IZ>x!F[_("Dbu%Hl5Pg=]QG.LKcJ0&ont@+{;ATX6jMwBv?2#f`q\}VYm'8Es$NpU)dR~S9a3-
+16 ;;h,=/:pJ$@mlY-`bwQ)e3Xt8.RUSMV 2A;j[PN}TE9x~kL&<ns5q>_#c1%K+rIuFoa(zyDWdH]?\GB0g*4f6"Z!'v{7|OiC
+17 ;;/$*b.ts0vOx_-o"l3MHI~}!E`eJimPd>Sn&wzFUh?Kf4)g5X<,8pD:9LA{a[k;'|GyYQ=R2B\#q+cru6N1W@(C TV]7Z%j
+18 ;;qEoC?YWNtV{Brg,I(i:e7Jd#6m!D8XT"n[$~1*ZcxL.Kh2s4%Q&ju\5Gvazw+9pF@k`HA)=U3/< -}'0b;|PfSRl_MO]y>
+19 ;;`@X:!R[\tY5OBcZPh$rM_a-"vgJG%|}oIH)wWQ*jDVxlp,'+S zu(&7?>KCn4y1dE02q6b<F=8]9NAmT{Li3f/esUk.~#
+20 ;;\Zr';/SMsG76Lj$aBc[#k>u=_O@2J&X{Aft xV4~vz8Q}q)0K.NIpRnYwDhg+<"H-!(PF:m*]?,WCT|dE9o53%`liUey1b
