%RO Routine Output Utility GT.M 02-OCT-2026 18:25:06 %HOSTCMD %HOSTCMD ; [ 16.06.10 10:33 ] [ TERMINAL(%EX) ; ZSY "/bin/bash "_%EX Q '$ZSY %L12 %L12 ;10 --> 2 ; [ 15.08.01 1:46 PM ] [ 14.08.01 10:29 AM ] [ 12/13/97 10:39 PM ] N (%XMSG,%UPRCOD,%N1,%N2,%ER) S %ER=0 I '$D(%N1) S %ER=1 Q I %N1'?1N.N S %ER=1 Q S N=%N1 I K B S B(1)=1,J=1 C S A=1 F I=1:1 Q:(A*2)>N S A=A*2 S B(J)=B(J)_0 S N=N-A I N<2 S J=J+1 S B(J)=N G M S J=J+1,B(J)=1 G C M S B1=0 F J1=1:1:J S B1=B1+B(J1) S %N2=B1 Q 102(%N1) D %L12 I %ER Q -1 Q %N2 162(%N1) S @("%N1=$$^%L1ZH("""_%N1_""")") D %L12 I %ER Q -1 Q %N2 210(%N1) ; N %I,%I1 S %I1=-1,%N2=0 F %I=$L(%N1):-1:1 S %I1=%I1+1 I $E(%N1,%I) S %N2=%N2+(2**%I1) Q %N2 %L16 %L16 ;10 --> 16 ; [ 06.08.25 16:20 ] [ 12/13/97 10:39 PM ] [ 06/02/93 12:41 AM ] ;N (%XMSG,%UPRCOD,%N1,%N2,%ER) S %ER=0 I '$D(%N1) S %ER=1 Q I %N1'?1N.N S %ER=1 Q S ST="0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F" S N=%N1 I N<10 S %N2=N Q I N>10,N<16 S %N2=$P(ST,",",N+1) Q S B="" S J=0 MM S OST=N#16 S J=J+1 S B=$P(ST,",",OST+1)_B S N=N-OST\16 I N>16 G MM S J=J+1 S %N2=$P(ST,",",N+1)_B Q ; 1610(%N1) Q $$FUNC^%HD(%N1) 1016(%N1) Q $$FUNC^%DH(%N1) %L164 %L164(str) ; [ 14.05.24 16:09 ] [ new out,i,j,c,lookup set lookup="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" set out="" for i=1:1:$L(str) do . set c=$A(str,i) . set j=(c#64)+1 . set out=out_$E(lookup,j) if $L(str)#3 do . set out=out_$E("==",1,3-$L(str)#3) quit out %L1ARG %L1ARG(ST) ; [ 27.08.14 11:22 ] [ K %ARG F J=1:1:$L(ST,"&") D .S IND=$P($P(ST,"&",J),"=") Q:IND="" .S VL=$P($P(ST,"&",J),"=",2) .I IND="JB" S JB=VL Q .S %ARG(IND)=VL Q %L1ARM %L1ARM(VV) ; [ 16.10.08 13:39 ] [ 22.04.08 10:51 ] [ 17.04.08 12:42 ] [ N TM S TM=$P($H,",",2) ;;U 0 W "TM="_TM_" %STARTVV="_%STARTVV,! H 2 I TM-$G(%STARTVV)>1 Q 1 I TM-$G(%STARTVV)=1,$L($G(VV))<8 Q 1 Q 0 %L1BDK %L1BDK ; [ 11/08/99 10:58 AM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C X %chista S %SAY=" TESTING OF PROGRAMMS FROM UCI "_$$^%L1ZU(0)_" " X %XMSGV W !!!!! N $ZT S $ZT="ZG "_$ZL_":ER" N %N,%I,%ZA,%ZB,%S1 S %S1="S %ZA=$ZA,%ZB=$ZB,%I=%I+1 S ^TMPS111($J,%I)=%LIGHT1_%N_%CCL_"" LINE:""_$J(%ZA,4)_"" ,COL: ""_%ZB S %I=%I+1 S ^TMPS111($J,%I)=$T(+%ZA) S %I=%I+1 S ^TMPS111($J,%I)=""""" K ^TMPS111($J) S %N="",%I=0,%J=0 C F %J=1:1 W:'(%J#20) "." S %N=$O(^ (%N)) Q:%N="" X "ZL @%N ZS l1bdk::1 I $ZA X %S1" D ^%S2VIEW K ^TMPS111($J) Q ER I $ZS["PROT" S $ZT="ZG "_$ZL_":ER" G C %L1BDKSC %L1BDKSC ; HIPUS ^SCR() B TOHNIJOT & BITUL ^SCR LELO SHIMUSH [ 05/23/99 2:30 PM ] [ K ^UTILITY($J) S N="" F S N=$O(^ (N)) Q:N="" S ^UTILITY($J,N)="" S N="" F S N=$O(^SCR(N)) Q:N="" D .K ^L1RSE($P) .S ^L1RSE($P,"F",1)="%SCRN="""_N_"""" U 0 W !,N .S %L1RSENP="" .D ^%L1RSE .I '$G(^L1RSE($P,"FC")) U 0 W " --- NOT FOUND !!! " Q DEL X %chista S %GET="NAME++10,20,EE#++8,E,I" D ^%L1GET Q:%S=""!(%TO="END") I '$D(^SCR(%S)) S %SAY=" NOT EXIST ! " X %XMSGV(1) G DEL S %SCRN=%S D A^%L1SC S %GET=" DELETE ? (Y/N) " D NE^%L1GET I %S="Y" K ^SCR(%SCRN) W " - DELETED !" G DEL %L1BDO %L1BDO ; BDIKA IM %FNAME=1/0 [ 05/23/99 2:30 PM ] [ Q:$G(%FNAME)="" I $G(@%FNAME)'=1,$G(@%FNAME)'=0 S %SC("ER")=1 Q 3 N %FNAME S %FNAME=$P(%MBG("O"),"\",J) G %L1BDO %L1BKV BUKBA ; DELAET BOLSHIE BUKVA ; SHEER ; 25.10.93 [ 06.03.01 12:57 PM ] [ 12/22/96 2:30 PM ] ; %L1BKV("VRT") - SMESHENIE PO VERT PO UMOLCHANIY 8 ; %L1BKV("GRZ") - SMESHENIE PO GORIZONT PO UMOLCHANIY CENTR ; %L1BKV("MIL") - MILA ; %BUK,%L1BKV("MIL"),%RZD,%LABL N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1BKV) D ^%L1C X %chista S %HG=5 N $ZT S %GET=": dln ++3,70,HH#++10,H,I" D ^%L1GET Q:%S="" S %L1BKV("MIL")=%S K %L1BKV("GRZ") 1 K LIN U $P:(NOECHO:NOWRAP) N %BUK,%LABL,%RZD,LIN F I=1:1:$L(%L1BKV("MIL")) Q:I>10 S %BUK=$A(%L1BKV("MIL"),I) D D SUBR .S %BUK=$A(%L1BKV("MIL"),I),%LABL=$S(%BUK>95:"HEB",%BUK>64:"ENG",%BUK>47:"NUM",%BUK>31:"SIM") .S %RZD=$S(%BUK>95:94,%BUK>64:63,%BUK>47:46,%BUK>31:"30") S %L1BKV("GRZ")=$G(%L1BKV("GRZ"),80-$L(LIN(1))\2),%L1BKV("VRT")=$G(%L1BKV("VRT"),9) I %TYPCRT["VT" W *27,"(0" W *27,"["_%L1BKV("VRT")_";"_"1H" ;,! S %XX=%L1BKV("GRZ") F II=1:1:5 S %YY=%L1BKV("VRT")+II X %POSIC W $TR(LIN(II),"*",$S(%TYPCRT'["VT":$C(219),1:$C(97))) ;,! W:%TYPCRT["VT" *27,"(B" Q SUBR ; F II=1:1:5 S LIN(II)=$G(LIN(II))_$P($T(@%LABL+II),";",%BUK-%RZD)_" " ; F II=1:1:7 S LIN(II)=$G(LIN(II))_$P($T(@%LABL+II),";",$A(@%LABL)-94)_" " Q ; ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 HEB ;4567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567;1234567; ;** ***;****** ;*******;*******;*******; **** ;*******;*******;** ***; **** ;*******; ***** ;** ;****** ;* **** ; *** ; *** ;****** ; ** **;*******;*******; ** **;** **;***** ;****** ;* * *;*******; ; ; ; ** * ; ** ; **; ** ; **; ** ; ** ;** **;** * **; * ; **; **; ******; ** **;** **; ** ; ** ; * * ; * **;** **;** **; ** ** ; * **; * ** ; *;* * *; ** **; ; ; ; ** ; ** ; ****; ** ;** **; ** ; ** ;** **;** **; ; **; **; **; ** **;** **; ** ; ** ;** **; * **;*** **;**** **; *** ; * ;** ** ; *;* * *; ** **; ; ; ;* ** ; ** ; ** **; ** ;** **; ** ; ** ;** **;** **; ; **; **; ** ; ** **;** **; ** ; ** ;** **; * **; **; **; ** ; ** ;** * ; *;* * *; ** **; ; ; ;** **;*******;** **; ** ;** **; ** ; ** ;** **;*******; ; **; ***** ; ** ; *****;* *** ; ** ; **** ; *** ; ******; **;*******; ** ;*******;** ; *;*******;*** **; ; ; Q ENG ; ;*******; ; ; ; ; ; ; ; ; ; ; ; ; Q NUM ; ;*******; *** ;*******;*******; **** ;*******;*******;*******;*******;*******; ; ;** **; ** ;** **; **; * ** ;** ;** ; ** ;** **;** **; ; ;** **; ** ; ** ; **** ;* ** ;*******;*******; ** ; ***** ;*******;****** ; ;** **; ** ; ** ; **;*******; **;** **; ** ;** **; **;****** ; ;*******; **** ;*******;*******; ** ;*******;*******; ** ;*******;*******;****** ; Q SIM ; 32 ;33;34;35;36;37;38;39;40;41;42;43;44; 45 ; 46 ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ***** ; ***** ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ***** ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ***** ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ***** ; Q TABL ; ; *****; ** ;%%%%%%%; O 3 U 3 F I1=1:1:8 D W ! .F I2=1:1:7 D W ! ..F I3=1:1:10 D ...W $TR($J(" ",7)," ",$C(240))_" " W # Q PROBA ; X %chista S %L1BKV("VRT")=1,%L1BKV("MIL")="madpvz sjf" D 1 S %L1BKV("VRT")=9,%L1BKV("MIL")=" 123-45-678-90" D 1 S %L1BKV("VRT")=17,%L1BKV("MIL")=" wtq zkxrn" D 1 R R Q %L1BLK %L1BLK ;CDS;DISK BLOCK DUMP; [ 03/29/92 3:34 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1984 O 63::0 E U 0 W !,"VIEW BUFFER IN USE, TRY LATER." Q S %LR="",R="" G INT00 ASK1 ; S $ZT="ZG "_$ZL_":ERR^%L1BLK" I %BN'="*",%BN'?1.N,%BN'?1N1":"1.N,%BN'?1N1":"1.N1":"1"G"1N,%BN'?1.N1":"1"G"1N,%BN'?1N1":"1.N1":"1""""1"G"1N1"""",%BN'?1.N1":"1"#"1"G"1N1 DA  H`&H$Ha88g'Hd "`fgHIPsKȈH+D䈅 $f&*id dIǫD DIEDDI:$S($D(VG)#10:VG,1:"") INT1 S %LR=%BN ;DEV S %DEV=$P U 0 D:%DEV=$P CRT^%SDEV G:$D(QUIT) EXIT S %ID='(%DEV=$P) ;D SCRL G:%SC="^" DEV G:%SC="^Q" EXIT U 63 S %B=$ZA U %DEV ;W !!,"Block ",%B S X=%B D BN^BLKDMP1 ;W " (",Y,")" W:$D(VGI) ?25,"Volume group ",VGI I +$P(Y,":",2)=0 D BLKDMP^VGLABELE S R="" Q ;G ASK S %T=$V(1020,0,1),%T2=$V(1021,0,1,3) I $E(%T2,5) W !,"Block awaiting garbage collection" I %T>12!'%T Q ;W !,"Uninitialized block, or invalid block type" Q ;G ASK I %T'=3 Q ;&(%T'=3)&(%T'=4)&(%T'=8) Q W !,"BLOCK ",%B W " (",Y,")" W:$D(VGI) ?25,"VOLUME GROUP ",VGI S %I=0,%N="" D N^BLKDMP1 ;D @($P("GDIR^PTR^DATA^XDATA^RDIR^RTNHDR^RTN^MAP^JRNL^SBP^SPDIR^SPBLK","^",%T)_"^%L1BLK1") S R="" Q ;G ASK EXIT Q ;- ERR I $F($ZS,"") U 0 W !!,"Aborted ..." G EXIT ;G ASK G EXIT SCRL I %ID S %SC=0 Q R !,"Do you want to scroll? ",%SC S:%SC="" %SC="N" I %SC?1.N,%SC>0 S $Y=0 Q I %SC=$E("NO",1,$L(%SC))!(%SC=$E("no",1,$L(%SC))) S %SC=0 Q G SCRL1:%SC=$E("YES",1,$L(%SC)),SCRL1:%SC=$E("yes",1,$L(%SC)) Q:(%SC="^")!(%SC="^Q") W !,"Enter ""Y"" if you want the listing to pause every 'n' lines and wait for a",!,"Carriage Return before continuing. You will be prompted for 'n'." W !,"Or, you may enter directly the number of lines per screen." G SCRL SCRL1 W !,"How many lines per screen? <",$S(%ID:60,1:20),"> " R %SC S:%SC="" %SC=$S(%ID:60,1:20) I %SC?1.N,%SC>0 S $Y=0 Q G:%SC="^" SCRL Q:%SC="^Q" W !,"Enter the number of lines to list before pausing for a Carriage Return." G SCRL1 Q INT00 ; I '$D(%POSIC) D ^%L1C N %HBRY W %ENG ZI U 0 R !!,"FROM BLOCK:",BLOCK1 Q:BLOCK1="" W !!,"TO BLOCK :" R BLOCK2 G:"^"[BLOCK2 ZI S %DEV=$P U 0 D:%DEV=$P CRT^%SDEV G:$D(QUIT) EXIT S %ID='(%DEV=$P) D SCRL G:%SC["^Q" EXIT O 63 S $ZS="" F III=BLOCK1:1:BLOCK2 S %BN=III D ASK1 Q:$ZS'="" I '(III#20) W !,III I $D(%DEV),$D(%ID),%ID U %DEV W !! U 0 C:%DEV'=$P&+%DEV %DEV I '$D(%INT) C 63 K VG,VGI,VGVOL,VGTAB,%BL,%LR,%SC,%T2,FBLK,BNL,R,Y,Z K %C,%I,%J,%L,%L2,%L3,%N,%N2,%OF,%T,%DEV,%ID,%BN,%B,%LN,%P,%INT,A,B,BAK,C,D,E K COLL,D,F,GBN,GLB,GN,I,JRN,K,KEY,MAX,PSZ,PTR,OFST,QUI,UNT,SAVE,STRING,TYPE,UC,UI,USZ,UT,X Q %L1BRC %L1BRC(CD) ; [ 25.07.06 11:52 ] [ N TXT S TXT=$C(29)_"L"_$C(10)_$C(0)_$C(29)_"H2"_$C(13) S TXT=TXT_$C(29)_"h"_$C(90)_$C(29)_"w"_$C(2) S TXT=TXT_$C(29)_"k"_$C(73)_$C($L(CD)+2)_$C(123)_$C(66)_CD_$C(13) Q TXT %L1C %L1C ; [ 05.02.26 10:31 ] [ 16.02.25 04:06 ] [ ;---------------------------------------------------------------------- ;-- NASTROYKI ZDOC-7 ; CONNECTION TYPE - SECURE SHELL ; LAYOUT/FONTS - HEBREW/LATIN ; EMULATION - VT220 8 BIT / BLI UTF8 ;---------------------------------------------------------------------- S %XMSG(0)=+$G(^PL("LAN"),-1) ;;S GLD=$$^%L1GLD() S %L3GLD=$$^%L1GLD() S %l1b="U $P W $G(%CLI),$ZPOS_"":""_$G(%CCL),! ZP @$ZPOS U $P W ! B" S %ENGLISH=(%XMSG(0)>1!($G(^m(1))?.P1U.E)) S %TYPCRT=$$^%L1TYPCR() S %L3MYDVN=$$^%L3MYDVN() S %L3MYDV=$$^%L3MYDV() S %OPT=$S(%TYPCRT["PC":1,1:65) S %WAIT=0 I %TYPCRT="PC1" S %WAIT=1 ;K %HBRY I %XMSG(0)'>1 S %HBRY="" S %HBR="",%ENG="" S %DELAY=50000 S %HBR0="" I $G(%XMSG(0))>1 S %HBR=%HBR0 S (%MODE80,%MODE132)="" ;I %TYPCRT["PC" S %MODE80=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"61"_$C(34)_"p" I %TYPCRT["VT5" S %MODE80=$C(27)_"[?3l" ;;I %TYPCRT["PC" S %MODE132=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"?3h"_$C(155)_"61"_$C(34)_"p" I $P=1 S %MODE132=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"?3h"_$C(155)_"61"_$C(34)_"p" I %TYPCRT["VT5" S %MODE132=$C(27)_"[?3h" S %CS=$C(27,91,63,50,53,104) S %ENG="" ;$C(27,41,76) I %TYPCRT["VT" S (%ENG,%HBR)="" ;;S %ENGLISH="$G(^m(1))?.P1U.E!(%XMSG(0)>1)" S %LIGHT="W *27,""[1m""" S %LIGHT1=$C(27)_"[1m" S %L1DEV="$S($$^%L3MYLPT():$$^%L3MYLPT(),$D(^PL(""LP"")):^(""LP""),1:3)" S %L1SUG="$S($$SUG^%L3MYLPT():$$SUG^%L3MYLPT(),$$^%L3MYLPT:5,$D(^PL(""LP"",""SUG"")):^(""SUG""),1:5)" S %CVET=$$^%L3CVET I $D(^VIEWONLY) S %CVET=0 D .S %CV("BCF")=$C(27,91)_"30m" .S %CV("RF")=$C(27,91)_"31m" .S %CV("GF")=$C(27,91)_"32m" .S %CV("YF")=$C(27,91)_"33m" .S %CV("BF")=$C(27,91)_"34m" .S %CV("MF")=$C(27,91)_"35m" .S %CV("CF")=$C(27,91)_"36m" .S %CV("WF")=$C(27,91)_"37m" .S %CV("BCB")=$C(27,91)_"40m" .S %CV("RB")=$C(27,91)_"41m" .S %CV("GB")=$C(27,91)_"42m" .S %CV("YB")=$C(27,91)_"43m" .S %CV("BB")=$C(27,91)_"44m" .S %CV("MB")=$C(27,91)_"45m" .S %CV("CB")=$C(27,91)_"46m" ;; S %CV("BB")=%CV("CB"),%CV("WF")=%CV("BF") .S %CV("WB")=$C(27,91)_"47m" .S %CL0=$$CL0^%L3CVET .S %CL1=$C(27,91)_"45;37m" .S %CL2=$C(27,91)_"47;31m" .N N I '%CVET S N="" F S N=$O(%CV(N)) Q:N="" S %CV(N)="" .I '%CVET S (%CL0,%CL1,%CL2)="" s %pravo=$C(27,91,67) s %levo=$C(27,91,68) s %vniz=$C(27,91,66) s %vverx=$C(27,91,65) s %pravon="w $C(27,91),%pn,$C(67)" s %levon="w $C(27,91),%pn,$C(68)" s %vnizn="w $C(27,91),%pn,$C(66)" s %vverxn="W $C(27,91),%pn,$C(65)" s %POSIC="S:%YY>24&(%TYPCRT[""VT"") %YY=24 W $C(27,91),(%YY\1+1),"";"",(%XX\1+1),""H""" ; s %POSIC="S:%YY>24 %YY=24 W $C(27,91),(%YY\1),"";"",(%XX\1),""H""" s %POSIC1="W $C(27,91),%YY,"";"",%XX,""H""" S %SCROLL="W $C(27,91),%Y1,"";"",%Y2,$C(114) W $C(27,91),%Y1,"";"",1,""H""" s %vverxe=$C(27,91,48,59,48,72) S ZPT00=""",""",ZPT01=",""",SKOB01=""")",SKOB02="(""" ;;S %XCL="W $C(27,91,48,109) W:$G(%CVET) %CL0" S %XCL="W $C(27,91,48,109) W:$G(%CVET) %CL0 W:$D(%HBRY)&(%TYPCRT'[""VT"") %HBR" S %CCL=$C(27,91,48,109) S:$G(%CVET) %CCL=%CCL_%CL0 S %chists=$C(27,91,75),%chiste="W $C(27,91,74)",%chista="X %XCL W:%CVET %CV(""BB""),%CV(""WF"") W *27,""[1;1H"" W $C(27,91),2,""J"",#" I %TYPCRT="VT220" S %chists=$C(27,91,48,75) ;,%chista="W $C(27,91,50,74) W #",%chiste="W $C(27,91,74)" s PEREX="W *13,%chists" I %TYPCRT="PC1" S %CLI=$C(27,91,55,109) E S %CLI=$C(27,91,55,109) I %CVET S %CLI=%CV("WB")_%CV("BF") ; S %TEN1="XEUGPA>HIBC;VZJYLFK`W,RSMDNO'/Q????????­????????¤f????????·????????¸????????¹w????????»????????¼????????½????????¥????????«g????????¨????????¦????????²????????bš?¬?????¬???????¬??????`z¬????¬??????¬?????????????©????????°/" S %TES1="abcdgehiklmoprtvyz,`xwfjqsu/'." ; . -> , S %TES2="cdsvjuyhfkoibgpma,'trezlx;"_$S(%XMSG(0)<0:$C(149),1:$C(245))_"qw/" S %TEN="qwertyuiopasdfghjkl;'zxcvbnm,/" S %THB="/'"_$C(247)_$C(248)_$C(224)_$C(232)_$C(229)_$C(239)_$C(237) S %THB=%THB_$C(244)_$C(249)_$C(227)_$C(226)_$C(235)_$C(242)_$C(233) S %THB=%THB_$C(231)_$C(236)_$C(234)_$C(243)_","_$C(230)_$C(241)_$C(225) S %THB=%THB_$C(228)_$C(240)_$C(238)_$C(246)_$C(250)_$C(46)_$C(245) I %TYPCRT["VT" S %THB=%TEN I %XMSG(0)<0 D .N %J F %J=1:1:$L(%THB) S $E(%THB,%J)=$S($A(%THB,%J)>223:$C($A(%THB,%J)-96),1:$E(%THB,%J)) S %TBIG="QWERTYUIOPASDFGHJKL;'ZXCVBNM,./????????­????????¤f????????·????????¸????????¹w????????»????????¼????????½????????¥????????«g????????¨????????¦????????²????????bš?¬?????¬???????¬??????`z¬????¬??????¬?????????????©????????°/" ; CAPS LOCK + S %TSMALL=%TEN ; S %XMSG="N %SAY2,%CLSAY,%INVR,%RGST,%RBUA,z N:'$D(%L1GETR) %XX,%YY S z="","",%SAY2=$P(%SAY,""++"",2),%YY=$P(%SAY2,z),%XX=$P(%SAY2,z,2),%RGST=$P(%SAY2,z,3),%INVR=$P(%SAY2,z,4),%RBUA=$P(%SAY2,z,5),%CLSAY=$P(%SAY2,z,6) X %XMSG(1)" S %XMSG(1)="Q:$L($P)<3 U $P:(NOECHO:NOWRAP) N %SAY3,%CLS1,%CLS2,%XX1,%XX2 S %SAY3=$P(%SAY,""++"",3) S %CLS1=$P(%SAY3,"","") S %CLS2=$P(%SAY3,"","",2) X %XMSG(2)" ;;S %XMSG(2)="N %SAY1 S %SAY1=$P(%SAY,""++"") S:%RGST[""H""!(%SAY?.E1L.E) %SAY1=$TR($TR(%SAY1,%TES1,%TES2),%TEN,%THB) X %XMSG(3),%XMSG(4),%XMSG(5),%XMSG(6),%XMSG(7)" S %XMSG(2)="N %SAY1 S %SAY1=$P(%SAY,""++"") S:%RGST[""H""!(%SAY?.E1L.E) %SAY1=$$W^%L1C(%SAY1) X %XMSG(3),%XMSG(4),%XMSG(5),%XMSG(6),%XMSG(7)" S %XMSG(3)="S:$E(%XX,$L(%XX))="">"" %XMSG(10)=1,%XX=+%XX I %XX?1N.N,%YY?1N.N,%XX<81,%YY<25 X %POSIC" S %XMSG(4)="W:%CLSAY=""C"" *13,%chists X:%CLSAY=""C"" %XMSG(3) W:%INVR=""I"" %CLI" S %XMSG(41)="X:$E(%CLS1,4)=""L""!($E(%CLS2,4)=""L"") %XMSG(12) I $L(%CLS1),$L(%CLS2) W:$D(%CV(%CLS1)) %CV(%CLS1) W:$D(%CV(%CLS2)) %CV(%CLS2)" S %XMSG(5)="X %XMSG(50) D:%RBUA=""R""&'$D(%ZMSFO) TV^%L1RBUA(%YY,%XX1,%YY+2,%XX2) X %POSIC X %XMSG(41),%XMSG(51)" S %XMSG(50)="S %XX1=$S($E(%RGST)=""E"":%XX,1:%XX-$L($TR(%SAY1,""{}"",""""))),%XX2=$S($E(%RGST)=""E"":%XX+$L($TR(%SAY1,""{}"",""""))+2,1:%XX+1)" S %XMSG(51)="W:%TYPCRT'[""VT"" %HBR I $E(%RGST)=""H"" S:$D(%XMSG(10)) %XX=80-%XX S %XX=%XX-$L($TR(%SAY1,""{}"","""")) S:%XX<0 %XX=0 X %POSIC" ;S %XMSG(6)=" %XMSG(8) I $E(%RGST,2)=""H"" K %CLS1,%CLS2 I $E(%RGST)=""H"" S %XX=%XX-1 S:%XX<0 %XX=0 X %POSIC" S %XMSG(6)="X %XMSG(8) I $E(%RGST,2)=""H"" K %CLS1,%CLS2 I $E(%RGST)=""H"" S %XX=%XX-1 S:%XX<0 %XX=0 X %POSIC" S %XMSG(7)="W:(%TYPCRT[""PC"") %HBR X %XCL K %SAY1,%RGST,%INVR,%XMSG(10)" ; --- S %XMSG(8)="N I W $P(%SAY1,""{}"") F I=2:1:$L(%SAY1,""{}"") W:I#2&(%INVR=""I"")!('(I#2)&(%INVR'=""I"")) %CLI X:I#2&(%INVR'=""I"")!('(I#2)&(%INVR=""I"")) %XCL,%XMSG(41) W $P(%SAY1,""{}"",I)" S %XMSG(11)="N %L F %L=1:1:$L($P(%SAY1,""{}"")) I $E(%SAY1,%L)'="" "" S %L=%L-1 Q" S %XMSG(12)="X %LIGHT S %CLS1=$TR($E(%CLS1,1,3),"" "",""""),%CLS2=$TR($E(%CLS2,1,3),"" "","""") X %LIGHT" I '%ENGLISH S %XMSGN="N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++24,""_%SAY1X_"",HH,I,,C++RB,WF"" X %XMSG" ; S $Y=24" I %ENGLISH S %XMSGN="N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++24,""_%SAY1X_"",EE,I,,C++RB,WF"" X %XMSG" ; S $Y=24" I '%ENGLISH S %XMSGV="Q:$L($P)<3 N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++0,""_%SAY1X_"",HH,I,,C++RF,WB"" X %XMSG" ; S $Y=0" I %ENGLISH S %XMSGV="Q:$L($P)<3 N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-$L($TR(%SAY1,""{}"",""""))\2 S %SAY=%SAY1_""++0,""_%SAY1X_"",EE,I,,C++RF,WB"" X %XMSG" ;S $Y=0" S %XMSGV(1)="Q:$L($P)<3 W *7,*7,*7 W:$G(%CVET) %CV(""WB""),%CV(""RF"") N %SAY2 S %SAY2=$J("""",$L($P(%SAY,""++""))) X %XMSGV H $S($L(%SAY2)<15:1,$L(%SAY2)<30:2,$L(%SAY2)<60:3,1:4) S %SAY="""" X %XCL X %XMSGV X %XCL" S %XMSGV("ER")="N i F i=1:1:5 W *7 ;S %SAY="" ! d ` i b y "" X %XMSGV" S %XMSGN("ER")="N i F i=1:1:5 W *7 ;S %SAY="" ! d ` i b y "" X %XMSGN" I %XMSG(0)>1 S %XMSGV("ER")="S %SAY="" E R R O R ! "" X %XMSGV(1)" S %XMSGV("NO")="S %SAY="" ! mipezp oi` "" X %XMSGV(1)" I %XMSG(0)>1 S %XMSGV("NO")="S %SAY="" Has no data ! "" X %XMSGV(1)" S %XMSGN(1)="Q:$L($P)<3 W *7,*7,*7 N %SAY2 S %SAY2=$J("""",$L($P(%SAY,""++""))) X %XMSGN H $S($L(%SAY2)<15:1,$L(%SAY2)<30:2,$L(%SAY2)<60:3,1:4) X %XCL S %SAY="""" X %XMSGN X %XCL" S %LEVO=68,%PRAVO=67,%VNIZ=66,%VVERX=65,%VVERXE=72,%CHISTE=74,%CHISTS=75 S ZWEZD="*******************************************************************" S %DEL=8 S %UPRCOD("0132")="BEGF" S %UPRCOD("04")="BEGF" S %UPRCOD("039")="BEGF" S %UPRCOD("0118")="ENDF" S %UPRCOD("0101")="ENDF" S %UPRCOD("2843")="ENDF" S %UPRCOD("0100")="ENDF" S %UPRCOD(7968)="LEVO" S %UPRCOD(9168)="LEVO" S %UPRCOD(5147)="LEVO" S %UPRCOD(9167)="PRAVO" S %UPRCOD(4891)="PRAVO" S %UPRCOD(7967)="PRAVO" S %UPRCOD(9172)="HOME" S %UPRCOD(9149126)="HOME" I %TYPCRT["VT5" S %UPRCOD(915052126)="HOME" S %UPRCOD("071")="HOME" S %UPRCOD("0119")="BEGF" ;;S %UPRCOD("039")="VVERXE" S %UPRCOD("0117")="ENDF" S %UPRCOD(9165)="VVERX" S %UPRCOD(7965)="VVERX" S %UPRCOD(4379)="VVERX" S %UPRCOD(9166)="VNIZ" S %UPRCOD(7966)="VNIZ" S %UPRCOD(4635)="VNIZ" S %UPRCOD("096")="KOD" S %UPRCOD("2")="HBEN" S %UPRCOD(127)="DEL" S %UPRCOD(9151126)="DEL" S %UPRCOD(8)="DEL" S %UPRCOD(9)="TAB" S %UPRCOD(27)="ESC" S %UPRCOD(25)="ESC" S %UPRCOD(11035)="ESC" S %UPRCOD(915051126)="ESC" S %UPRCOD("015")="TABN" S %UPRCOD("10779")="TABN" S %UPRCOD(22)="ADDL" S %UPRCOD(919169)="ADDL" S %UPRCOD(21)="DELL" S %UPRCOD(914955126)="DELL" S %UPRCOD(7986)="COR" S %UPRCOD(9755)="COR" S %UPRCOD(914956126)="COR" S %UPRCOD(11)="COR" S %UPRCOD("079")="ENDS" S %UPRCOD("15")="ENDS" S %UPRCOD("29")="ENDS" S %UPRCOD(9152126)="ENDS" S %UPRCOD("11291")="HOME" S %UPRCOD(7987)="FIND" S %UPRCOD(5403)="FIND" S %UPRCOD(10011)="FIND" S %UPRCOD(914957126)="FIND" S %UPRCOD(7963)="CHISTS" S %UPRCOD(28)="CHISTS" S %UPRCOD(914949126)="CHISTS" S %UPRCOD(919165)="CHISTS" S %UPRCOD(919166)="CHISTE" S %UPRCOD(914950126)="CHISTE" S %UPRCOD(8219)=$S(%TYPCRT="VT220":"PGUP",%TYPCRT="VT520":"CHISTE",1:"CHISTS") S %UPRCOD("31")="CHISTS" S %UPRCOD(7981)=$S(%TYPCRT="VT220":"PGDN",1:"CHISTE") S %UPRCOD(8475)=$S(%TYPCRT="VT220":"PGDN",%TYPCRT="VT520":"SBROS",1:"CHISTE") S %UPRCOD(5915)="CHISTE" S %UPRCOD(7982)="SBROS" S %UPRCOD(919167)="SBROS" S %UPRCOD(914951126)="SBROS" S %UPRCOD(8731)=$S(%TYPCRT="VT520":"IND",1:"SBROS") ;;S %UPRCOD(6171)=$S(%TYPCRT="VT520":"BEGF",1:"SBROS") S %UPRCOD(6171)="ENDS" S %UPRCOD(7983)="IND" S %UPRCOD(919168)="IND" S %UPRCOD(914952126)="IND" S %UPRCOD(8987)=$S(%TYPCRT="VT520":"ADDL",1:"IND") S %UPRCOD(7984)="ADDL" S %UPRCOD(914953126)="ADDL" S %UPRCOD(9243)="ADDL" S %UPRCOD(11547)="ADDL" S %UPRCOD(7985)="DELL" S %UPRCOD(9499)="DELL" S %UPRCOD(7988)="SAVE" S %UPRCOD(10267)="SAVE" S %UPRCOD(7989)="REST" S %UPRCOD(10523)="REST" S %UPRCOD(12)="PGLN" S %UPRCOD(16)="PGRG" S %UPRCOD("073")="PGUP" S %UPRCOD("1307")="PGUP" S %UPRCOD("6427")="PGUP" S %UPRCOD("9153126")="PGUP" S %UPRCOD("30")="PGUP" S %UPRCOD("081")="PGDN" S %UPRCOD("14")="PGDN" S %UPRCOD("1563")="PGDN" S %UPRCOD("6683")="PGDN" S %UPRCOD("9154126")="PGDN" S %UPRCOD("082")="INS" S %UPRCOD("5659")="INS" S %UPRCOD("9150126")="INS" S %UPRCOD("094")="HELP" S %UPRCOD("053126")="HELP" S %UPRCOD("2843")="HELP" S %UPRCOD("095")="HBR" S %UPRCOD("098")="MDRG" S %UPRCOD("4")="MDRG" S %UPRCOD("0112")="MDRG" S %UPRCOD(13)="BK" S %UPRCOD(7451)="BK" S %UPRCOD(20)="VNIZE" S %UPRCOD(24)="XEC" S %UPRCOD(23)="ADD" S %UPRCOD(31)="FINDS" S %UPRCOD(7)="MET" S %UPRCOD(1)="MOD" S %UPRCOD(18)="REST" S %UPRCOD(915049126)="REST" S %UPRCOD(26)="SAVE" S %UPRCOD(915048126)="SAVE" S %UPRCOD(5)="MOD" S %UPRCOD(6)="FIND" Q ; DB(I) ; U $P W %vverxe,I," ",$C(224) H 1 Q ; W(%ST) ; -- write %ST N %ST1,%SMB S %ST1="" N %J F %J=1:1:$L(%ST) D .S %SMB=$A(%ST,%J) .;;I %SMB>95,%SMB<123 S %SMB=%SMB+$S($P="/dev/pts/0":32,1:128) .I %SMB>95,%SMB<123 S %SMB=%SMB+128 .S %ST1=%ST1_$C(%SMB) Q %ST1 %L1C0 %L1C ; [ 15.02.25 15:31 ] [ 16.02.24 05:18 ] [ 09.01.24 11:19 ] ;---------------------------------------------------------------------- ;-- NASTROYKI ZDOC-7 ; CONNECTION TYPE - SECURE SHELL ; LAYOUT/FONTS - HEBREW/LATIN ; EMULATION - VT220 8 BIT / BLI UTF8 ;---------------------------------------------------------------------- S %XMSG(0)=+$G(^PL("LAN"),-1) ;;S GLD=$$^%L1GLD() S %L3GLD=$$^%L1GLD() S %l1b="U $P W $G(%CLI),$ZPOS_"":""_$G(%CCL),! ZP @$ZPOS U $P W ! B" S %ENGLISH=(%XMSG(0)>1!($G(^m(1))?.P1U.E)) S %TYPCRT=$$^%L1TYPCR() S %L3MYDVN=$$^%L3MYDVN() S %L3MYDV=$$^%L3MYDV() S %OPT=$S(%TYPCRT["PC":1,1:65) S %WAIT=0 I %TYPCRT="PC1" S %WAIT=1 ;K %HBRY I %XMSG(0)'>1 S %HBRY="" S %HBR="",%ENG="" S %DELAY=50000 S %HBR0="" I $G(%XMSG(0))>1 S %HBR=%HBR0 S (%MODE80,%MODE132)="" ;I %TYPCRT["PC" S %MODE80=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"61"_$C(34)_"p" I %TYPCRT["VT5" S %MODE80=$C(27)_"[?3l" ;;I %TYPCRT["PC" S %MODE132=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"?3h"_$C(155)_"61"_$C(34)_"p" I $P=1 S %MODE132=$C(27)_"[64"_$C(34)_"p"_$C(155)_"?3l"_$C(155)_"?3h"_$C(155)_"61"_$C(34)_"p" I %TYPCRT["VT5" S %MODE132=$C(27)_"[?3h" S %CS=$C(27,91,63,50,53,104) S %ENG="" ;$C(27,41,76) I %TYPCRT["VT" S (%ENG,%HBR)="" ;;S %ENGLISH="$G(^m(1))?.P1U.E!(%XMSG(0)>1)" S %LIGHT="W *27,""[1m""" S %LIGHT1=$C(27)_"[1m" S %L1DEV="$S($$^%L3MYLPT():$$^%L3MYLPT(),$D(^PL(""LP"")):^(""LP""),1:3)" S %L1SUG="$S($$SUG^%L3MYLPT():$$SUG^%L3MYLPT(),$$^%L3MYLPT:5,$D(^PL(""LP"",""SUG"")):^(""SUG""),1:5)" S %CVET=$$^%L3CVET I $D(^VIEWONLY) S %CVET=0 D .S %CV("BCF")=$C(27,91)_"30m" .S %CV("RF")=$C(27,91)_"31m" .S %CV("GF")=$C(27,91)_"32m" .S %CV("YF")=$C(27,91)_"33m" .S %CV("BF")=$C(27,91)_"34m" .S %CV("MF")=$C(27,91)_"35m" .S %CV("CF")=$C(27,91)_"36m" .S %CV("WF")=$C(27,91)_"37m" .S %CV("BCB")=$C(27,91)_"40m" .S %CV("RB")=$C(27,91)_"41m" .S %CV("GB")=$C(27,91)_"42m" .S %CV("YB")=$C(27,91)_"43m" .S %CV("BB")=$C(27,91)_"44m" .S %CV("MB")=$C(27,91)_"45m" .S %CV("CB")=$C(27,91)_"46m" ;; S %CV("BB")=%CV("CB"),%CV("WF")=%CV("BF") .S %CV("WB")=$C(27,91)_"47m" .S %CL0=$$CL0^%L3CVET .S %CL1=$C(27,91)_"45;37m" .S %CL2=$C(27,91)_"47;31m" .N N I '%CVET S N="" F S N=$O(%CV(N)) Q:N="" S %CV(N)="" .I '%CVET S (%CL0,%CL1,%CL2)="" s %pravo=$C(27,91,67) s %levo=$C(27,91,68) s %vniz=$C(27,91,66) s %vverx=$C(27,91,65) s %pravon="w $C(27,91),%pn,$C(67)" s %levon="w $C(27,91),%pn,$C(68)" s %vnizn="w $C(27,91),%pn,$C(66)" s %vverxn="W $C(27,91),%pn,$C(65)" s %POSIC="S:%YY>24&(%TYPCRT[""VT"") %YY=24 W $C(27,91),(%YY\1+1),"";"",(%XX\1+1),""H""" ; s %POSIC="S:%YY>24 %YY=24 W $C(27,91),(%YY\1),"";"",(%XX\1),""H""" s %POSIC1="W $C(27,91),%YY,"";"",%XX,""H""" S %SCROLL="W $C(27,91),%Y1,"";"",%Y2,$C(114) W $C(27,91),%Y1,"";"",1,""H""" s %vverxe=$C(27,91,48,59,48,72) S ZPT00=""",""",ZPT01=",""",SKOB01=""")",SKOB02="(""" ;;S %XCL="W $C(27,91,48,109) W:$G(%CVET) %CL0" S %XCL="W $C(27,91,48,109) W:$G(%CVET) %CL0 W:$D(%HBRY)&(%TYPCRT'[""VT"") %HBR" S %CCL=$C(27,91,48,109) S:$G(%CVET) %CCL=%CCL_%CL0 S %chists=$C(27,91,75),%chiste="W $C(27,91,74)",%chista="X %XCL W:%CVET %CV(""BB""),%CV(""WF"") W *27,""[1;1H"" W $C(27,91),2,""J"",#" I %TYPCRT="VT220" S %chists=$C(27,91,48,75) ;,%chista="W $C(27,91,50,74) W #",%chiste="W $C(27,91,74)" s PEREX="W *13,%chists" I %TYPCRT="PC1" S %CLI=$C(27,91,55,109) E S %CLI=$C(27,91,55,109) I %CVET S %CLI=%CV("WB")_%CV("BF") ; S %TEN1="XEUGPA>HIBC;VZJYLFK`W,RSMDNO'/Qfg/" S %TES1="abcdgehiklmoprtvyz,`xwfjqsu/'." ; . -> , S %TES2="cdsvjuyhfkoibgpma,'trezlx;"_$S(%XMSG(0)<0:$C(149),1:$C(245))_"qw/" S %TEN="qwertyuiopasdfghjkl;'zxcvbnm,/" S %THB="/'"_$C(247)_$C(248)_$C(224)_$C(232)_$C(229)_$C(239)_$C(237) S %THB=%THB_$C(244)_$C(249)_$C(227)_$C(226)_$C(235)_$C(242)_$C(233) S %THB=%THB_$C(231)_$C(236)_$C(234)_$C(243)_","_$C(230)_$C(241)_$C(225) S %THB=%THB_$C(228)_$C(240)_$C(238)_$C(246)_$C(250)_$C(46)_$C(245) I %TYPCRT["VT" S %THB=%TEN I %XMSG(0)<0 D .N %J F %J=1:1:$L(%THB) S $E(%THB,%J)=$S($A(%THB,%J)>223:$C($A(%THB,%J)-96),1:$E(%THB,%J)) S %TBIG="QWERTYUIOPASDFGHJKL;'ZXCVBNM,./fg/" ; CAPS LOCK + S %TSMALL=%TEN ; S %XMSG="N %SAY2,%CLSAY,%INVR,%RGST,%RBUA,z N:'$D(%L1GETR) %XX,%YY S z="","",%SAY2=$P(%SAY,""++"",2),%YY=$P(%SAY2,z),%XX=$P(%SAY2,z,2),%RGST=$P(%SAY2,z,3),%INVR=$P(%SAY2,z,4),%RBUA=$P(%SAY2,z,5),%CLSAY=$P(%SAY2,z,6) X %XMSG(1)" S %XMSG(1)="Q:$L($P)<3 U $P:(NOECHO:NOWRAP) N %SAY3,%CLS1,%CLS2,%XX1,%XX2 S %SAY3=$P(%SAY,""++"",3) S %CLS1=$P(%SAY3,"","") S %CLS2=$P(%SAY3,"","",2) X %XMSG(2)" ;;S %XMSG(2)="N %SAY1 S %SAY1=$P(%SAY,""++"") S:%RGST[""H""!(%SAY?.E1L.E) %SAY1=$TR($TR(%SAY1,%TES1,%TES2),%TEN,%THB) X %XMSG(3),%XMSG(4),%XMSG(5),%XMSG(6),%XMSG(7)" S %XMSG(2)="N %SAY1 S %SAY1=$P(%SAY,""++"") S:%RGST[""H""!(%SAY?.E1L.E) %SAY1=$$W^%L1C(%SAY1) X %XMSG(3),%XMSG(4),%XMSG(5),%XMSG(6),%XMSG(7)" S %XMSG(3)="S:$E(%XX,$L(%XX))="">"" %XMSG(10)=1,%XX=+%XX I %XX?1N.N,%YY?1N.N,%XX<81,%YY<25 X %POSIC" S %XMSG(4)="W:%CLSAY=""C"" *13,%chists X:%CLSAY=""C"" %XMSG(3) W:%INVR=""I"" %CLI" S %XMSG(41)="X:$E(%CLS1,4)=""L""!($E(%CLS2,4)=""L"") %XMSG(12) I $L(%CLS1),$L(%CLS2) W:$D(%CV(%CLS1)) %CV(%CLS1) W:$D(%CV(%CLS2)) %CV(%CLS2)" S %XMSG(5)="X %XMSG(50) D:%RBUA=""R""&'$D(%ZMSFO) TV^%L1RBUA(%YY,%XX1,%YY+2,%XX2) X %POSIC X %XMSG(41),%XMSG(51)" S %XMSG(50)="S %XX1=$S($E(%RGST)=""E"":%XX,1:%XX-$L($TR(%SAY1,""{}"",""""))),%XX2=$S($E(%RGST)=""E"":%XX+$L($TR(%SAY1,""{}"",""""))+2,1:%XX+1)" S %XMSG(51)="W:%TYPCRT'[""VT"" %HBR I $E(%RGST)=""H"" S:$D(%XMSG(10)) %XX=80-%XX S %XX=%XX-$L($TR(%SAY1,""{}"","""")) S:%XX<0 %XX=0 X %POSIC" ;S %XMSG(6)=" %XMSG(8) I $E(%RGST,2)=""H"" K %CLS1,%CLS2 I $E(%RGST)=""H"" S %XX=%XX-1 S:%XX<0 %XX=0 X %POSIC" S %XMSG(6)="X %XMSG(8) I $E(%RGST,2)=""H"" K %CLS1,%CLS2 I $E(%RGST)=""H"" S %XX=%XX-1 S:%XX<0 %XX=0 X %POSIC" S %XMSG(7)="W:(%TYPCRT[""PC"") %HBR X %XCL K %SAY1,%RGST,%INVR,%XMSG(10)" ; --- S %XMSG(8)="N I W $P(%SAY1,""{}"") F I=2:1:$L(%SAY1,""{}"") W:I#2&(%INVR=""I"")!('(I#2)&(%INVR'=""I"")) %CLI X:I#2&(%INVR'=""I"")!('(I#2)&(%INVR=""I"")) %XCL,%XMSG(41) W $P(%SAY1,""{}"",I)" S %XMSG(11)="N %L F %L=1:1:$L($P(%SAY1,""{}"")) I $E(%SAY1,%L)'="" "" S %L=%L-1 Q" S %XMSG(12)="X %LIGHT S %CLS1=$TR($E(%CLS1,1,3),"" "",""""),%CLS2=$TR($E(%CLS2,1,3),"" "","""") X %LIGHT" I '%ENGLISH S %XMSGN="N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++24,""_%SAY1X_"",HH,I,,C++RB,WF"" X %XMSG" ; S $Y=24" I %ENGLISH S %XMSGN="N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++24,""_%SAY1X_"",EE,I,,C++RB,WF"" X %XMSG" ; S $Y=24" I '%ENGLISH S %XMSGV="Q:$L($P)<3 N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-(80-$L($TR(%SAY1,""{}"",""""))\2) S %SAY=%SAY1_""++0,""_%SAY1X_"",HH,I,,C++RF,WB"" X %XMSG" ; S $Y=0" I %ENGLISH S %XMSGV="Q:$L($P)<3 N %SAY1,%SAY1X S %SAY1=$P(%SAY,""++""),%SAY1X=80-$L($TR(%SAY1,""{}"",""""))\2 S %SAY=%SAY1_""++0,""_%SAY1X_"",EE,I,,C++RF,WB"" X %XMSG" ;S $Y=0" S %XMSGV(1)="Q:$L($P)<3 W *7,*7,*7 W:$G(%CVET) %CV(""WB""),%CV(""RF"") N %SAY2 S %SAY2=$J("""",$L($P(%SAY,""++""))) X %XMSGV H $S($L(%SAY2)<15:1,$L(%SAY2)<30:2,$L(%SAY2)<60:3,1:4) S %SAY="""" X %XCL X %XMSGV X %XCL" S %XMSGV("ER")="N i F i=1:1:5 W *7 ;S %SAY="" ! d ` i b y "" X %XMSGV" S %XMSGN("ER")="N i F i=1:1:5 W *7 ;S %SAY="" ! d ` i b y "" X %XMSGN" I %XMSG(0)>1 S %XMSGV("ER")="S %SAY="" E R R O R ! "" X %XMSGV(1)" S %XMSGV("NO")="S %SAY="" ! mipezp oi` "" X %XMSGV(1)" I %XMSG(0)>1 S %XMSGV("NO")="S %SAY="" Has no data ! "" X %XMSGV(1)" S %XMSGN(1)="Q:$L($P)<3 W *7,*7,*7 N %SAY2 S %SAY2=$J("""",$L($P(%SAY,""++""))) X %XMSGN H $S($L(%SAY2)<15:1,$L(%SAY2)<30:2,$L(%SAY2)<60:3,1:4) X %XCL S %SAY="""" X %XMSGN X %XCL" S %LEVO=68,%PRAVO=67,%VNIZ=66,%VVERX=65,%VVERXE=72,%CHISTE=74,%CHISTS=75 S ZWEZD="*******************************************************************" S %DEL=8 S %UPRCOD("0132")="BEGF" S %UPRCOD("04")="BEGF" S %UPRCOD("039")="BEGF" S %UPRCOD("0118")="ENDF" S %UPRCOD("0101")="ENDF" S %UPRCOD("2843")="ENDF" S %UPRCOD("0100")="ENDF" S %UPRCOD(7968)="LEVO" S %UPRCOD(9168)="LEVO" S %UPRCOD(5147)="LEVO" S %UPRCOD(9167)="PRAVO" S %UPRCOD(4891)="PRAVO" S %UPRCOD(7967)="PRAVO" S %UPRCOD(9172)="HOME" S %UPRCOD(9149126)="HOME" I %TYPCRT["VT5" S %UPRCOD(915052126)="HOME" S %UPRCOD("071")="HOME" S %UPRCOD("0119")="BEGF" ;;S %UPRCOD("039")="VVERXE" S %UPRCOD("0117")="ENDF" S %UPRCOD(9165)="VVERX" S %UPRCOD(7965)="VVERX" S %UPRCOD(4379)="VVERX" S %UPRCOD(9166)="VNIZ" S %UPRCOD(7966)="VNIZ" S %UPRCOD(4635)="VNIZ" S %UPRCOD("096")="KOD" S %UPRCOD("2")="HBEN" S %UPRCOD(127)="DEL" S %UPRCOD(9151126)="DEL" S %UPRCOD(8)="DEL" S %UPRCOD(9)="TAB" S %UPRCOD(27)="ESC" S %UPRCOD(25)="ESC" S %UPRCOD(11035)="ESC" S %UPRCOD(915051126)="ESC" S %UPRCOD("015")="TABN" S %UPRCOD("10779")="TABN" S %UPRCOD(22)="ADDL" S %UPRCOD(919169)="ADDL" S %UPRCOD(21)="DELL" S %UPRCOD(914955126)="DELL" S %UPRCOD(7986)="COR" S %UPRCOD(9755)="COR" S %UPRCOD(914956126)="COR" S %UPRCOD(11)="COR" S %UPRCOD("079")="ENDS" S %UPRCOD("15")="ENDS" S %UPRCOD("29")="ENDS" S %UPRCOD(9152126)="ENDS" S %UPRCOD("11291")="HOME" S %UPRCOD(7987)="FIND" S %UPRCOD(5403)="FIND" S %UPRCOD(10011)="FIND" S %UPRCOD(914957126)="FIND" S %UPRCOD(7963)="CHISTS" S %UPRCOD(28)="CHISTS" S %UPRCOD(914949126)="CHISTS" S %UPRCOD(919165)="CHISTS" S %UPRCOD(919166)="CHISTE" S %UPRCOD(914950126)="CHISTE" S %UPRCOD(8219)=$S(%TYPCRT="VT220":"PGUP",%TYPCRT="VT520":"CHISTE",1:"CHISTS") S %UPRCOD("31")="CHISTS" S %UPRCOD(7981)=$S(%TYPCRT="VT220":"PGDN",1:"CHISTE") S %UPRCOD(8475)=$S(%TYPCRT="VT220":"PGDN",%TYPCRT="VT520":"SBROS",1:"CHISTE") S %UPRCOD(5915)="CHISTE" S %UPRCOD(7982)="SBROS" S %UPRCOD(919167)="SBROS" S %UPRCOD(914951126)="SBROS" S %UPRCOD(8731)=$S(%TYPCRT="VT520":"IND",1:"SBROS") ;;S %UPRCOD(6171)=$S(%TYPCRT="VT520":"BEGF",1:"SBROS") S %UPRCOD(6171)="ENDS" S %UPRCOD(7983)="IND" S %UPRCOD(919168)="IND" S %UPRCOD(914952126)="IND" S %UPRCOD(8987)=$S(%TYPCRT="VT520":"ADDL",1:"IND") S %UPRCOD(7984)="ADDL" S %UPRCOD(914953126)="ADDL" S %UPRCOD(9243)="ADDL" S %UPRCOD(11547)="ADDL" S %UPRCOD(7985)="DELL" S %UPRCOD(9499)="DELL" S %UPRCOD(7988)="SAVE" S %UPRCOD(10267)="SAVE" S %UPRCOD(7989)="REST" S %UPRCOD(10523)="REST" S %UPRCOD(12)="PGLN" S %UPRCOD(16)="PGRG" S %UPRCOD("073")="PGUP" S %UPRCOD("1307")="PGUP" S %UPRCOD("6427")="PGUP" S %UPRCOD("9153126")="PGUP" S %UPRCOD("30")="PGUP" S %UPRCOD("081")="PGDN" S %UPRCOD("14")="PGDN" S %UPRCOD("1563")="PGDN" S %UPRCOD("6683")="PGDN" S %UPRCOD("9154126")="PGDN" S %UPRCOD("082")="INS" S %UPRCOD("5659")="INS" S %UPRCOD("9150126")="INS" S %UPRCOD("094")="HELP" S %UPRCOD("053126")="HELP" S %UPRCOD("2843")="HELP" S %UPRCOD("095")="HBR" S %UPRCOD("098")="MDRG" S %UPRCOD("4")="MDRG" S %UPRCOD("0112")="MDRG" S %UPRCOD(13)="BK" S %UPRCOD(7451)="BK" S %UPRCOD(20)="VNIZE" S %UPRCOD(24)="XEC" S %UPRCOD(23)="ADD" S %UPRCOD(31)="FINDS" S %UPRCOD(7)="MET" S %UPRCOD(1)="MOD" S %UPRCOD(18)="REST" S %UPRCOD(915049126)="REST" S %UPRCOD(26)="SAVE" S %UPRCOD(915048126)="SAVE" S %UPRCOD(5)="MOD" S %UPRCOD(6)="FIND" Q ; DB(I) ; U $P W %vverxe,I," ",$C(224) H 1 Q ; W(%ST) ; N %ST1,%SMB S %ST1="" N %J F %J=1:1:$L(%ST) D .S %SMB=$A(%ST,%J) .;;I %SMB>95,%SMB<123 S %SMB=%SMB+$S($P="/dev/pts/0":32,1:128) .I %SMB>95,%SMB<123 S %SMB=%SMB+128 .S %ST1=%ST1_$C(%SMB) Q %ST1 %L1CALC CCCCM ; CALCULATOR ; SHEER [ 03/07/94 12:45 PM ] D ^%L1C W %HBR ; K (%HBR,%ENG,%UPRCOD,%chista,%chists,%POSIC,%POSIC1,%OPT) ; KOD SYMBOL KOD ; SYM SYMBOL S LIN=1 ; LIN SCREEN NUMBER LINE S IND=1 ; IND GLOBAL NUMBER LINE S CALC=1 ; CALC CALCULATOR NUMBER ( 1/2 ) S SIM="+" ; SIM SIMAN S MIS="" ; MIS MISPAR S SUM=0 ; SUM REZALT S TIP=3 ; TIP 1 - BBOD 1-SIM, 2 - BBOD 2-SIM, 3 - BBOD 1-MIS 4 - BBOD MIS S MAXL=$S($P=1:18,%OPT=65:18,1:9),OKHO=MAXL+5 ; MAXL MAX KOL-BO LIN B OKHE S APP=0 ; APP + K KOOPD X S RRR=0,STR=1,STR1=0 S POZ="W *27,""[""_YY_"";""_(XX+APP)_""H""" SET ; FIRST SET ; BK - . 0 1 2 3 4 5 6 7 8 9 M G S PAT3=",13,45,46,48,49,50,51,52,53,54,55,56,57,77,71," S PAT4=",46,48,49,50,51,52,53,54,55,56,57," S PAT11=",37,77," S PAT1=",13,42,43,45,47,35,92,69,67,77,61,71,81" ; % BK * + - / # \ E C M = G Q S HELP="ESC - d`ivi ? - xb`n zbvd ; N - xb`n, C - jqn :iewip Q - itilg oeaygn H - dxfr" K ^CALC($P) ; --- 65 X %chista W *27,"[1;35H","o e a y g n" D START G MAIN Q START ; W *27,"[3;1H" W " dlert jxr d`vez dlert jxr d`vez ",! I %OPT'=65 D .W *27,"[4;1;"_(MAXL+5)_";39b",*27,"[2;1;4;39b",*27,"[4;41;"_(MAXL+5)_";79b",*27,"[2;41;4;79b" .W *8,$C(195),*27,"[37C",$C(180),*13,$C(195),*27,"[37C",$C(180) .F XX=8,23,48,63 D ..W *27,"[2;"_XX_"H" ..W $C(194),*10,*8,$C(179),*10,*8,$C(193) I %OPT=65 D .; ON GRAF $C(27,40,48)=*27,"(0" --- OFF GRAF $C(27,40,66)=*27,"(B" .I %TYPCRT["VT" W *27,"(0" .F I=2,4,MAXL+5 W *27,"["_I_";1H" W $TR($J(" ",79)," ","q") .F %YY=3:1:MAXL+5 F %XX=1,39,41,79 X %POSIC1 W "x" .S %YY=2 F %XX=1,41 X %POSIC1 W "l" .S %YY=2 F %XX=39,79 X %POSIC1 W "k " .S %YY=4 F %XX=1,41 X %POSIC1 W "t" .S %YY=4 F %XX=39,79 X %POSIC1 W "u " .S %YY=MAXL+5 F %XX=1,41 X %POSIC1 W "m" .S %YY=MAXL+5 F %XX=39,79 X %POSIC1 W "j " .F XX=8,23,48,63 D ..W *27,"[2;"_XX_"H" ..W $C(119),*10,*8,$C(120),*10,*8,$C(118) .I %TYPCRT["VT" W *27,"(B" W *27,"["_(MAXL+5)_";1H",! D HELP 0 W *27,"["_(4+LIN)_";"_($S(TIP<3:2+TIP,1:7+TIP)+APP)_"H" Q MAIN ; W %ENG R *KOD W *27,7 S:KOD=61 KOD=43 S SYM=$C(KOD) I SYM="E"!(SYM="e")!(SYM="w") W %HBR G END I SYM="H"!(KOD=104)!(KOD=105)!(KOD=137) W *27,7 W %HBR D ^%L1CALCH,START,VID G MAIN I SYM="N"!(SYM="n") G NNN I SYM="C"!(SYM="c")!(SYM="a") W %HBR G CLEAR I SYM="Q"!(SYM="q") W %HBR G CHAN I SYM="?" D 63 S SYM="L" D 63 D START,VID G MAIN I SYM="m"!(SYM="v") S KOD=77,SYM="M" I SYM="g"!(SYM="r") S KOD=71,SYM="G" I KOD=8 G BS I KOD=127 G DEL S ZB=$ZB R *R1:0 I R1>0 S ZB=$S(ZB=0:0_R1,1:R1) ; --- 0_R1 R *R1:0 I R1>0 S ZB=ZB_R1 I $D(%UPRCOD(ZB)),"TAB,VVERX,VNIZ,PRAVO,LEVO,PGUP,PGDN,ESC"[%UPRCOD(ZB) G @%UPRCOD(ZB) I TIP>4 G 4 G @TIP ESC ; I TIP>2 G TAB W %HBR G END HELP ; U $P:(NOECHO:NOWRAP) F F=1:1:$L(HELP) S EE=$E(HELP,F) W:"ESC?NTABHQ"[EE *27,"[7m" W EE,*27,"[0m" S %X=0 ; W:"E?NCTABHQ"[EE *27,"[0m" S %X=0 Q END ; W *27,"["_(MAXL+5)_";1H",!,*27,"[J"," : 4 - d`ivi 3 - ycg xefgn 2 - jynd 1 - dqtcd " W *27,"["_(MAXL+5)_";1H",! R R#1 I R<1!(R>4) W *7 H 1 G END I R=1 G PRINT I R=2 W *27,"["_(MAXL+5)_";1H",! D HELP W *27,8 G MAIN I R=3 S RRR=1 D 63 G CCCCM+3 W *7,*27,"["_(MAXL+5)_";1H" D ^%L1C Q VVERX ; I IND=1 W *7 G MAIN I TIP=2 W *27,"[D" S TIP=1 I TIP>3 W *27,"["_(TIP-3)_"D" S TIP=3 I LIN=1 S IND=IND-1,ST=IND,FN=IND+MAXL-1,YY=5,XX=$S(TIP<3:2+TIP,1:7+TIP) D G MAIN .S:'$D(^CALC($P,CALC,FN)) FN=$ZP(^CALC($P,CALC,"")) .D CBET,POZ,READ D:CALC=1 IND S LIN=LIN-1,IND=IND-1 D READ D:CALC=1 IND W *27,"[A" G MAIN Q PGUP ; I IND'>LIN W *7 G MAIN S TIP=1,LIN=1,IND=MAXL*(IND-MAXL\MAXL)+1 S ST=IND,FN=IND+MAXL-1,YY=5,XX=$S(TIP<3:2+TIP,1:7+TIP) D CBET,POZ,READ D:CALC=1 IND G MAIN Q PGDN ; I '$D(^CALC($P,CALC,IND\MAXL+1*MAXL+1)) W *7 G MAIN S TIP=1,LIN=1,IND=IND\MAXL+1*MAXL+1 S ST=IND,FN=IND+MAXL-1,YY=5,XX=3 S:'$D(^CALC($P,CALC,FN)) FN=$ZP(^CALC($P,CALC,"")) F ICB=1:1:MAXL-1 W *27,"["_(5+ICB)_";"_(3+APP)_"H" W *27,"[36X" D CBET,POZ,READ D:CALC=1 IND G MAIN Q READ ; I '$D(^CALC($P,CALC,IND)) S (SIM,MIS,SUM)="" Q S SIM=$P(^CALC($P,CALC,IND),","),MIS=$P(^(IND),",",2),SUM=$P($G(^(IND-1)),",",3) Q VNIZ ; I '$D(^CALC($P,CALC,IND)) W *7 G MAIN I IND=$ZP(^CALC($P,CALC,"")) W *7 G MAIN I TIP=2 W *27,"[D" S TIP=1 I TIP>3 W *27,"["_(TIP-3)_"D" S TIP=3 I LIN=MAXL S IND=IND+1,ST=IND-MAXL+1,FN=IND,YY=4+MAXL,XX=$S(TIP<3:2+TIP,1:7+TIP) D CBET,POZ,READ D:CALC=1 IND G MAIN S LIN=LIN+1,IND=IND+1 D READ D:CALC=1 IND W *27,"[B" G MAIN Q PRAVO ; I TIP=2!(TIP=14)!(TIP>2&(TIP-2>$L(MIS)))!(TIP=1&((SIM'["M"&(SIM'["G")))) W *7 G MAIN S TIP=TIP+1 W *27,"[C" G MAIN Q LEVO ; I TIP=1!(TIP=3) W *7 G MAIN S TIP=TIP-1 W *27,"[D" G MAIN Q TAB ; W *27,"["_(4+LIN)_";"_(3+APP)_"H" S TIP=1 G MAIN Q BS ; I TIP=1!(TIP=3) W *7 G MAIN W *8 S TIP=TIP-1 I TIP=1 S SIM="" W " ",*8 G MAIN I TIP>2 W $E(MIS,TIP-1,22),$J("",15-TIP) W *27,"["_(LIN+4)_";"_(TIP+7+APP)_"H" S MIS=$E(MIS,1,TIP-3)_$E(MIS,TIP-1,22) G MAIN Q DEL ; I TIP=1 S SIM=$E(SIM,2) W SIM," ",*8 G MAIN I TIP=2 W " ",*8 S SIM=$E(SIM) G MAIN I TIP>2 W $E(MIS,TIP-1,22),$J("",15-TIP) W *27,"["_(LIN+4)_";"_(TIP+7+APP)_"H" S MIS=$E(MIS,1,TIP-3)_$E(MIS,TIP-1,22) G MAIN Q CLEAR ; W *27,7 W *27,"["_(MAXL+5)_";1H",!,*27,"[J","k : ( l/k ) oeaykn zewpl " W *27,"["_(MAXL+5)_";1H",! R R#1 S:R="" R="k" W *27,"["_(MAXL+5)_";1H",! D HELP W *27,8 I R'="k"&(R'="F") G MAIN S LIN=1,IND=1,MIS="",SIM="+",TIP=3,SUM=0 K ^CALC($P,CALC) D:CALC=1 IND F ICB=1:1:MAXL W *27,"["_(4+ICB)_";"_(3+APP)_"H" W *27,"[36X" W *27,"[5;"_(10+APP)_"H" G MAIN Q CHAN ; S STO=IND-LIN+1 I CALC=1 D D 0 G MAIN .I $D(^CALC($P,2)) D ..W *27,"["_(MAXL+5)_";1H",!,*27,"[J","k : ( l/k ) dpyn oeaykn zewpl " ..W *27,"["_(MAXL+5)_";1H",! R R#1 S:R="" R="k" ..W *27,"["_(MAXL+5)_";1H",! D HELP ..I R="k"!(R="F")!(R="f") K LIN2,IND2,TIP2,SIM2,MIS2,SUM2,^CALC($P,2) F I=5:1:MAXL+4 W *27,"["_I_";43H",*27,"[36X" .S LIN1=LIN,IND1=IND,TIP1=TIP,SUM1=SUM,SIM1=SIM,MIS1=MIS .S CALC=2,APP=40,LIN=$G(LIN2,1),IND=$G(IND2,1),TIP=$G(TIP2,3),SUM=$G(SUM2,0) .S SIM=$G(SIM2,"+"),MIS=$G(MIS2,"") I CALC=2 D G MAIN .I TIP1>2 D 6 ..W *27,"["_(MAXL+5)_";1H",!,*27,"[J","1 : 3 - z`vl 2 - ( M0 ) oexkifa xenyl 1 - xtqn xiardl " ..W *27,"["_(MAXL+5)_";1H",! R R#1 S:R="" R=1 I R<1!(R>3) W *7 H 1 G 6 ..W *27,"["_(MAXL+5)_";1H",! D HELP .S LIN2=LIN,IND2=IND,TIP2=TIP,SUM2=SUM,SIM2=SIM,MIS2=MIS .S SIM=SIM1,MIS=$S($G(R)=1:+$J(SUM,0,2),1:$G(MIS1)) I $G(R)=2 S M0=+$J(SUM,0,2) .S CALC=1,APP=0,LIN=$G(LIN1,1),IND=$G(IND1,1),TIP=$G(TIP1,3),SUM=$G(SUM1,0) .W *27,"["_(4+LIN)_";"_($S(TIP<3:2+TIP,1:10)+APP)_"H" .I TIP<3 S MIS="" Q .W MIS S TIP=3+$L(MIS),PN=11-$L(MIS) W *27,"["_PN_"X" Q 63 ; ??? W *27,7 W %HBR ; D:CALC=2 GET^%VIDEO(.TEXT,0,1,40,23,2) D:CALC=1 GET^%VIDEO(.TEXT,40,1,80,23,2) F I=2:1:23 W *27,"["_I_";"_(41-APP)_"H",*27,"[39X" W *27,"[2;"_(41-APP)_";"_OKHO_";"_(79-APP)_"b" I SYM="?"!RRR S STR=1,STR1=0,MM=0 F I=0:1:9 W *27,"["_(2+STR)_";"_(44-APP)_"H" I $D(@("M"_I)) S STR=STR+1,MM=MM+@("M"_I) W "M",I,"=",$$JJ(@("M"_I)) I SYM="?",STR=1 S STR1=STR I SYM="L" S STR=1,MM=0 F I=0:1:9 W *27,"["_(2+STR)_";"_(44-APP)_"H" I $D(^CCCC(I)) S STR=STR+1,MM=MM+^CCCC(I) W "G",I,"=",$$JJ($P(^CCCC(I)," ")),$J($P(^CCCC(I)," ",2),19) I STR>1 W *27,"["_(2+STR)_";"_(47-APP)_"H",*27,"[7m",$$JJ(MM),*27,"[0m"," : lkd jq" I 'RRR,(STR>1&(SYM="?"))!(SYM="L"&(STR>1))!(SYM="L"&(STR=1)&(STR1=1)) D .W *27,"["_OKHO_";1H",!,*27,"[J"," <- edylk ywn ugl " W:STR=1&(STR1=1) "wix oexkif" .W *27,"["_OKHO_";1H",! R R#1 I RRR,STR>1 D 633 .W *27,"["_OKHO_";1H",!,*27,"[J"," : ( k/l ) ipnf xb`n iewip " .W *27,"["_OKHO_";1H",! R R#1 I ",F,f,k,K,l,"'[(","_R_",") W *7 G 633 .I R="k"!(R="F")!(R="f") K M0,M1,M2,M3,M4,M5,M6,M7,M8,M9 W %HBR,*27,"[2K",*7,?35,*27,"[7m"," iwp ipnf xb`n ",*27,"[0m" H 2 W *27,"["_OKHO_";1H",! D HELP W *27,8 ; D:CALC=2 PUT^%VIDEO(TEXT,0,1,40,23,2) D:CALC=1 PUT^%VIDEO(TEXT,40,1,80,23,2) W *27,8 ; I SYM="L" D START,VIDEO ; D START,VIDEO Q VID ; W *27,7 S ST=$G(STO,1),INDO=IND,LINO=LIN,CALC=$S(CALC=1:2,1:1),APP=$S('APP:40,1:0) S FN=ST+MAXL-1,YY=5,XX=3 S:'$D(^CALC($P,CALC,FN)) FN=$ZP(^CALC($P,CALC,"")) F ICB=1:1:MAXL W *27,"["_(4+ICB)_";"_(3+APP)_"H" W *27,"[36X" D CBET S IND=INDO,LIN=LINO,CALC=$S(CALC=1:2,1:1),APP=$S('APP:40,1:0) W *27,8 Q 71 ; W *27,"["_OKHO_";1H",!,*27,"[J" S %GET=" : dxrd++"_OKHO_",30,HH#"_$P(^CCCC($E(SIM,2))," ",2)_"++18,H,I++" D ^%L1GET W %HBR,*27,"["_OKHO_";1H",! D HELP Q NNN ; W *27,7,*27,"["_OKHO_";1H",!,*27,"[J" S %GET=": 0 - z`vl ; 3 - (M+G)xb`nd lk, 2 - (G)reaw xb`n, 1 - (M)ipnf xb`n : zewpl++"_OKHO_",78,HH#0++1,E,++" D ^%L1GET I %S<0!(%S>4) S %S=0 I %S=1 K M0,M1,M2,M3,M4,M5,M6,M7,M8,M9 S SAY="ipnf" I %S=2 K ^CCCC S SAY="reaw" I %S=3 K M0,M1,M2,M3,M4,M5,M6,M7,M8,M9 K ^CCCC S SAY="" I %S>0 W %HBR,*27,"[2K",*7,?45,*27,"[7m"," iwp "_SAY_" xb`n ",*27,"[0m" H 2 W %HBR,*27,"["_OKHO_";1H",! D HELP W *27,8 G MAIN Q 1 ; I KOD=13&(SIM'="") G W I KOD=56 S KOD=42 G S I KOD=95 S KOD=45 G S I KOD=46!(KOD=63)!(KOD=58)!(KOD=59)!(KOD=115)!(KOD=147) S KOD=47 G S I KOD=51 S KOD=35 G S I KOD=124 S KOD=92 G S I KOD=13!(PAT1'[(","_KOD_",")) W *7 G MAIN S S SYM=$C(KOD) W SYM W:KOD'=77&(KOD'=71) " " S SIM=SYM I KOD=77!(KOD=71) S TIP=2 G MAIN W I $D(^CALC($P,CALC,IND)) D PERE S LIN=LIN-1,IND=IND-1 D:CALC=1 IND D READ W *27,"["_(4+LIN)_";"_(10+APP)_"H" S TIP=3 G MAIN Q 2 ; I KOD=13&($L(SIM)>1) G W I KOD=13 D .I SIM="M" F SYM=1:1 Q:'$D(@(SIM_SYM)) .I SIM="G" F SYM=1:1 Q:'$D(^CCCC(SYM)) .S SYM=SYM#10,KOD=$A(SYM) I SYM'?1N W *7 G MAIN S YY=LIN+4,XX=10,SIM=SIM_SYM_"=",MIS=+$J(SUM,0,2),TIP=3+$L(MIS) I MIS'<1E9 S MIS=$$JJ(MIS),TIP=3+$L(MIS) W SYM_"=" X POZ W MIS G MAIN Q 3 ; I KOD=62!(KOD=117)!(KOD=149) S KOD=46,SYM=$C(KOD) G 31 I KOD=63 S KOD=47,SYM=$C(KOD) G 31 I KOD=13&($D(^CALC($P,CALC,IND))) G 4 I KOD=13&('$D(^CALC($P,CALC,IND))) W *7 G MAIN I PAT3'[(","_KOD_",") W *7 G MAIN 31 W SYM S MIS=SYM_$E(MIS,2,22),TIP=4 G MAIN Q 4 ; I MIS="M"!(MIS="G"),KOD=13 D .I MIS="M" F SYM=0,9:-1:1 Q:$D(@("M"_SYM)) .I MIS="G" F SYM=0,9:-1:1 Q:$D(^CCCC(SYM)) .S KOD=$A(SYM) I MIS="M"!(MIS="G"),SYM'?1N G MAIN I MIS="M"!(MIS="G") S MIS=MIS_SYM_"="_$S(MIS="M":$G(@(MIS_SYM),0),1:$P($G(^CCCC(SYM),0)," ")) W SYM,"=",$P(MIS,"=",2) S TIP=1 D PERE S SIM=$P($G(^CALC($P,CALC,IND),""),",") W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=62!(KOD=117)!(KOD=149) S KOD=46,SYM=$C(KOD) G 40 I KOD=63 S KOD=47,SYM=$C(KOD) G 40 I KOD=58!(KOD=59)!(KOD=115)!(KOD=147) S KOD=47,SYM=$C(KOD) G 40 I KOD=13 S TIP=1 D PERE S SIM=$P($G(^CALC($P,CALC,IND),""),",") W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=37 D 41 D PERE S TIP=1 W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=77!(KOD=71) S TIP=2 D PERE S SIM=$C(KOD) W *27,"["_(4+LIN)_";"_(3+APP)_"H",SYM G MAIN 40 I PAT1[(","_KOD_",") S TIP=3 D PERE W *27,"["_(4+LIN)_";"_(3+APP)_"H" S SIM=SYM W SIM W *27,"["_(4+LIN)_";"_(10+APP)_"H" G MAIN I PAT4'[(","_KOD_",") W *7 G MAIN 41 S MISO=MIS S MIS=$E(MIS,1,TIP-3)_SYM_$E(MIS,TIP-1,22) I TIP<15,MIS?.1"-".12N.1".".1"%"!(MIS?.1"-".11N1".".6N.1"%") S TIP=TIP+1 W SYM Q:KOD=37 G MAIN W *7 S MIS=MISO G MAIN Q PERE ; D COM,CB,GLO D:CALC=1 IND I LIN>MAXL S LIN=MAXL,ST=IND-MAXL+1,FN=IND-1 D CBET,CHIS Q:'$D(^CALC($P,CALC,IND)) S LINO=LIN,INDO=IND I LIN>MAXL S LIN=MAXL F IPE=IND:1 Q:'$D(^CALC($P,CALC,IPE)) S SIM=$P(^CALC($P,CALC,IPE),","),MIS=$P(^(IPE),",",2) D COM D:LIN'>MAXL CB D GLO S LIN=LINO,IND=INDO D READ Q COM ; COMPUTE S OPER=MIS I KOD=37!(MIS["%") D Q .I SIM="*" S SUM=SUM*MIS/100 Q .I SIM="+" S SUM=SUM*MIS/100+SUM Q .I SIM="-" S SUM=SUM-(SUM*MIS/100) Q .I SIM="/" W:+MIS=0 *7 Q:+MIS=0 S SUM=SUM*100/MIS Q .I SIM="\" W:+MIS=0 *7 Q:+MIS=0 S SUM=$J(SUM*100/MIS,0,0) Q .W *7 Q I SIM["M" S @($P(SIM,"="))=MIS Q I SIM["G" S $P(^CCCC($E(SIM,2))," ")=MIS D:'$D(^CALC($P,CALC,IND)) 71 S $P(^CCCC($E(SIM,2))," ",2)=%S Q I MIS["M"!(MIS["G") S OPER=$P($P(MIS,"=",2)," ") I ",/,\,#,"[(","_SIM_",") I +OPER=0 W *7,*7,*7 Q X "S SUM="_SUM_SIM_+OPER Q CB ; W *27,"["_(4+LIN)_";"_(26+APP)_"H" W $$JJ(SUM) Q GLO ; S ^CALC($P,CALC,IND)=SIM_","_MIS_","_SUM S LIN=LIN+1,IND=IND+1,MIS="" I KOD=37 S KOD=13,SIM="" Q CBET ; S COL="3,10,26",CEL="0,0,12",DRO="0,0,2" F ICB=ST:1:FN W *27,"["_(5-ST+ICB)_";"_(3+APP)_"H" W *27,"[36X" D .F P=1,2 W *27,"["_(5-ST+ICB)_";"_($P(COL,",",P)+APP)_"H" W $P(^CALC($P,CALC,ICB),",",P) .W *27,"["_(5-ST+ICB)_";"_(26+APP)_"H" W $$JJ($P(^CALC($P,CALC,ICB),",",3)) Q CHIS ; W *27,"["_(6-ST+ICB)_";"_(3+APP)_"H" W *27,"[36X" Q POZ ; W *27,"["_YY_";"_(XX+APP)_"H" Q IND ; W *27,7,*27,"[1;1H",*27,"[7m",$J(IND,3)," ",*27,"[0m",*27,8 Q JJ(X) ; I X<1E9,X>(-1E8) S X=$J(X,12,2) Q X S EE=$L($P(X,"."))-9,X=$J($E(X,1,10)/10,9,0) S:$L(X)>9 X=$E(X,1,9),EE=EE+1 S X=X_"E"_EE_" " Q X PRINT ; S III=$P O 3 U 3 W ! D ^%D W " " D ^%T W ! W "---------------------------------------",! W " dlert jxr d`vez ",! W "---------------------------------------",! F I=1:1 Q:'$D(^CALC(III,1,I)) W $P(^(I),","),?10,$P(^(I),",",2),?25,$J($P(^(I),",",3),12,2),! W # C 3 U $P:(NOECHO:NOWRAP) G END %L1CALC1 CCCCM ; CALCULATOR ; SHEER [ 16.12.03 10:18 ] [ 14.12.03 16:43 ] [ 01/18/93 2:08 PM ] D ^%L1C W %HBR K (%HBR,%ENG) ; KOD SYMBOL KOD ; SYM SYMBOL S LIN=1 ; LIN SCREEN NUMBER LINE S IND=1 ; IND GLOBAL NUMBER LINE S CALC=1 ; CALC CALCULATOR NUMBER ( 1/2 ) S SIM="+" ; SIM SIMAN S MIS="" ; MIS MISPAR S SUM=0 ; SUM REZALT S TIP=3 ; TIP 1 - BBOD 1-SIM, 2 - BBOD 2-SIM, 3 - BBOD 1-MIS 4 - BBOD MIS S MAXL=$S($P>1:9,1:18) ; MAXL MAX KOL-BO LIN B OKHE S APP=0 ; APP + K KOOPD X S RRR=0 ; S POZ="W *27,""[""_YY_"";""_(XX+APP)_""H""" SET ; FIRST SET ; . 0 1 2 3 4 5 6 7 8 9 M S PAT3=",13,46,48,49,50,51,52,53,54,55,56,57,77," S PAT4=",46,48,49,50,51,52,53,54,55,56,57," S PAT11=",37,77," S PAT1=",13,42,43,45,47,35,92,69,67,77,61," ; % BK * + - / # \ E C M = S HELP="E - d`ivi, ? - xb`n dbvd, N - xb`n iewip, C - itilg oeaygn, TAB - dxfg, H - dxfr" K ^CALC START ; W #?34,"o e a y g n",!! W " dlert jxr d`vez dlert jxr d`vez",! W *27,"[4;1;"_(MAXL+5)_";39b",*27,"[2;1;4;39b",*27,"[4;41;"_(MAXL+5)_";79b",*27,"[2;41;4;79b" ;W *8,$C(195),*27,"[37C",$C(180),*13,$C(195),*27,"[37C",$C(180) ;F XX=8,23,48,63 D .W *27,"[2;"_XX_"H" .W $C(194),*10,*8,$C(179),*10,*8,$C(193) ; W *27,"[4;1;3;39b",*27,"[2;1;4;39b",*27,"[4;41;3;79b",*27,"[2;41;4;79b" W *27,"["_(MAXL+5)_";1H",!,HELP O 0:(0::::65) 0 W *27,"["_(4+LIN)_";"_($S(TIP<3:2+TIP,1:7+TIP)+APP)_"H" ; MAIN ; W %ENG R *KOD W *27,7 S:KOD=61 KOD=43 S SYM=$C(KOD) ; W !,$ZB G MAIN I SYM="E"!(SYM="e")!(SYM="w") W %HBR G END I SYM="H"!(KOD=104)!(KOD=105)!(KOD=137) W *27,7 W %HBR G HELP I SYM="N"!(SYM="n") K M0,M1,M2,M3,M4,M5,M6,M7,M8,M9 G 63 I KOD=8 G BS I KOD=9 G TAB I KOD=127 G DEL I SYM="C"!(SYM="c")!(SYM="a") W %HBR G CHAN I $ZB=4379 G BBERX I $ZB=4635 G BNIZ I $ZB=4891 G PRABO I $ZB=5147 G LEBO I SYM="?" G 63 I SYM="m"!(SYM="v") S KOD=77,SYM="M" I TIP>4 G 4 G @TIP END ; W *27,"["_(MAXL+5)_";1H",!,*27,"J"," : 4 - d`ivi 3 - ycg xefdn 2 - jynd 1 - dqtcd " W *27,"["_(MAXL+5)_";1H",! R R#1 I R<1!(R>4) W *7 H 1 G END I R=1 G PRINT I R=2 W *27,"["_(MAXL+5)_";1H",!,HELP,*27,8 G MAIN I R=3 S RRR=1 D 63 G CCCCM+3 W *7,*27,"["_(MAXL+5)_";1H" D ^%L1C Q BBERX ; I IND=1 W *7 G MAIN I TIP>3 W *27,"["_(TIP-3)_"D" S TIP=3 I LIN=1 S IND=IND-1,ST=IND,FN=IND+MAXL-1,YY=5,XX=$S(TIP<3:2+TIP,1:7+TIP) D CBET,POZ,READ D:CALC=1 IND G MAIN I IND>$ZP(^CALC(CALC,"")) S:MIS="" MIS=0 S ^CALC(CALC,IND)=SIM_","_MIS S LIN=LIN-1,IND=IND-1 D READ D:CALC=1 IND W *27,"A" G MAIN Q READ ; S SIM=$P(^CALC(CALC,IND),","),MIS=$P(^(IND),",",2),SUM=$P($G(^(IND-1)),",",3) Q BNIZ ; I '$D(^CALC(CALC,IND)) W *7 G MAIN I IND=$ZP(^CALC(CALC,"")) W *7 G MAIN I TIP>3 W *27,"["_(TIP-3)_"D" S TIP=3 I LIN=MAXL S IND=IND+1,ST=IND-MAXL+1,FN=IND,YY=4+MAXL,XX=$S(TIP<3:2+TIP,1:7+TIP) D CBET,POZ,READ D:CALC=1 IND G MAIN S LIN=LIN+1,IND=IND+1 D READ D:CALC=1 IND W *27,"B" G MAIN Q PRABO ; I TIP=2!(TIP=11)!(TIP>2&(TIP-2>$L(MIS)))!(TIP=1&(SIM'["M")) W *7 G MAIN S TIP=TIP+1 W *27,"C" G MAIN Q LEBO ; I TIP=1!(TIP=3) W *7 G MAIN S TIP=TIP-1 W *27,"[D" G MAIN Q TAB ; W *27,"["_(4+LIN)_";"_(3+APP)_"H" S TIP=1 G MAIN Q BS ; I TIP=1!(TIP=3) W *7 G MAIN W *8 S TIP=TIP-1 I TIP=1 S SIM="" W " ",*8 G MAIN I TIP>2 W $E(MIS,TIP-1,22),$J("",13-TIP) W *27,"["_(LIN+4)_";"_(TIP+7+APP)_"H" S MIS=$E(MIS,1,TIP-3)_$E(MIS,TIP-1,22) G MAIN Q DEL ; I TIP=1 S SIM=$E(SIM,2) W SIM," ",*8 G MAIN I TIP=2 W " ",*8 S SIM=$E(SIM) G MAIN I TIP>2 W $E(MIS,TIP-1,22),$J("",13-TIP) W *27,"["_(LIN+4)_";"_(TIP+7+APP)_"H" S MIS=$E(MIS,1,TIP-3)_$E(MIS,TIP-1,22) G MAIN Q CHAN ; I CALC=1 D G 0 .I $D(^CALC(2)) D ..W *27,"["_(MAXL+5)_";1H",!,*27,"J","k : ( l/k ) dpyn oeaykn zewpl " ..W *27,"["_(MAXL+5)_";1H",! R R#1 S:R="" R="k" ; I R<1!(R>1) W *7 H 1 G CHAN+2 ..W *27,"["_(MAXL+5)_";1H",!,HELP ..I R="k"!(R="F")!(R="f") K LIN2,IND2,TIP2,SIM2,MIS2,SUM2,^CALC(2) F I=5:1:MAXL+4 W *27,"["_I_";43H",*27,"[35X" .S LIN1=LIN,IND1=IND,TIP1=TIP,SUM1=SUM,SIM1=SIM,MIS1=MIS .S CALC=2,APP=40,LIN=$G(LIN2,1),IND=$G(IND2,1),TIP=$G(TIP2,3),SUM=$G(SUM2,0) .S SIM=$G(SIM2,"+"),MIS=$G(MIS2,"") I CALC=2 D G MAIN .I TIP1>2 D 6 ..W *27,"["_(MAXL+5)_";1H",!,*27,"J","1 : 3 - z`vl 2 - ( M0 ) oexkifa xenyl 1 - xtqn xiardl " ..W *27,"["_(MAXL+5)_";1H",! R R#1 S:R="" R=1 I R<1!(R>3) W *7 H 1 G 6 ..W *27,"["_(MAXL+5)_";1H",!,HELP .S LIN2=LIN,IND2=IND,TIP2=TIP,SUM2=SUM,SIM2=SIM,MIS2=MIS .S SIM=SIM1,MIS=$S($G(R)=1:+$J(SUM,0,2),1:$G(MIS1)) I $G(R)=2 S M0=+$J(SUM,0,2) .S CALC=1,APP=0,LIN=$G(LIN1,1),IND=$G(IND1,1),TIP=$G(TIP1,3),SUM=$G(SUM1,0) .W *27,"["_(4+LIN)_";"_($S(TIP<3:2+TIP,1:10)+APP)_"H" .I TIP<3 S MIS="" Q .W MIS S TIP=3+$L(MIS),PN=11-$L(MIS) W *27,"["_PN_"X" Q 63 ; ?????????? W *27,7 W %HBR D:CALC=2 GET^%VIDEO("TEXT",0,1,40,24,2) D:CALC=1 GET^%VIDEO("TEXT",40,1,80,24,2) F I=2:1:23 W *27,"["_I_";"_(41-APP)_"H",*27,"[39X" S OKHO=MAXL+5 W *27,"[2;"_(41-APP)_";"_OKHO_";"_(79-APP)_"b" S STR=1,MM=0 F I=0:1:9 W *27,"["_(2+STR)_";"_(48-APP)_"H" I $D(@("M"_I)) S STR=STR+1,MM=MM+@("M"_I) W "M",I," = ",$J(@("M"_I),12) I STR>1 W *27,"["_(2+STR)_";"_(53-APP)_"H",*27,"[7m",$J(MM,12,2),*27,"[0m"," : lkd jq" I 'RRR D .W *27,"["_OKHO_";1H",!,*27,"J"," <- ywn edylk ugl ",$S(STR=1:"wix oexkif"_$J("",30),1:$J("",40)) .W *27,"["_OKHO_";1H",! R R#1 I RRR,STR>1 D 633 .W *27,"["_OKHO_";1H",!,*27,"J"," : ( 0/1 ) xb`n iewip " .W *27,"["_OKHO_";1H",! R R#1 I 10'[R W *7 G 633 .I R=1 K M0,M1,M2,M3,M4,M5,M6,M7,M8,M9 W *27,"["_OKHO_";1H",!,HELP D:CALC=2 PUT^%VIDEO("TEXT",0,1,40,24,2) D:CALC=1 PUT^%VIDEO("TEXT",40,1,80,24,2) W *27,8 G:'RRR MAIN Q 1 ; I KOD=13&(SIM'="") G W ; I KOD=13&($D(^CALC(CALC,IND))) G W I KOD=56 S KOD=42 G S I KOD=95 S KOD=45 G S I KOD=46!(KOD=63)!(KOD=58)!(KOD=59)!(KOD=115)!(KOD=147) S KOD=47 G S I KOD=51 S KOD=35 G S I KOD=124 S KOD=92 G S I KOD=13!(PAT1'[(","_KOD_",")) W *7 G MAIN S S SYM=$C(KOD) W SYM W:KOD'=77 " " S SIM=SYM I KOD=77 S TIP=2 G MAIN W W *27,"["_(4+LIN)_";"_(10+APP)_"H" S TIP=3 G MAIN Q 2 ; I KOD=13&($L(SIM)>1) G W I SYM'?1N W *7 G MAIN S YY=LIN+4,XX=10,SIM=SIM_SYM_"=",MIS=SUM,TIP=3+$L(MIS) W SYM_"=" X POZ W MIS G MAIN Q 3 ; I KOD=62!(KOD=117)!(KOD=149) S KOD=46,SYM=$C(KOD) G 31 I KOD=63 S KOD=47,SYM=$C(KOD) G 31 I KOD=13&($D(^CALC(CALC,IND))) G 4 I KOD=13&('$D(^CALC(CALC,IND))) W *7 G MAIN I PAT3'[(","_KOD_",") W *7 G MAIN 31 W SYM S MIS=SYM_$E(MIS,2,22),TIP=4 G MAIN Q 4 ; I MIS="M",SYM'?1N G MAIN I MIS="M" S MIS="M"_SYM_"="_$G(@(MIS_SYM),0) W SYM,"=",$P(MIS,"=",2) S TIP=1 D PERE S SIM=$P($G(^CALC(CALC,IND),""),",") W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=62!(KOD=117)!(KOD=149) S KOD=46,SYM=$C(KOD) G 40 I KOD=63 S KOD=47,SYM=$C(KOD) G 40 I KOD=58!(KOD=59)!(KOD=115)!(KOD=147) S KOD=47,SYM=$C(KOD) G 40 I KOD=13 S TIP=1 D PERE S SIM=$P($G(^CALC(CALC,IND),""),",") W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=37 S TIP=1,MIS=MIS_SYM W SYM D PERE W *27,"["_(4+LIN)_";"_(3+APP)_"H" G MAIN I KOD=77 S TIP=2 D PERE S SIM="M" W *27,"["_(4+LIN)_";"_(3+APP)_"H",SYM G MAIN 40 I PAT1[(","_KOD_",") S TIP=3 D PERE W *27,"["_(4+LIN)_";"_(3+APP)_"H" S SIM=SYM W SIM W *27,"["_(4+LIN)_";"_(10+APP)_"H" G MAIN I PAT4'[(","_KOD_",") W *7 G MAIN 41 I MIS_SYM?.9N!(MIS_SYM?.9N1".".2N) S MIS=$E(MIS,1,TIP-3)_SYM_$E(MIS,TIP-1,22),TIP=TIP+1 W SYM G MAIN W *7 G MAIN Q PERE ; D COM,CB,GLO D:CALC=1 IND I LIN>MAXL S LIN=MAXL,ST=IND-MAXL+1,FN=IND-1 D CBET,CHIS Q:'$D(^CALC(CALC,IND)) S LINO=LIN,INDO=IND I LIN>MAXL S LIN=MAXL F IPE=IND:1 Q:'$O(^CALC(CALC,IPE)) S SIM=$P(^CALC(CALC,IPE),","),MIS=$P(^(IPE),",",2) D COM D:LIN'>MAXL CB D GLO S LIN=LINO,IND=INDO D READ Q COM ; COMPUTE S OPER=MIS I KOD=37!(MIS["%") D Q .I SIM="*" S SUM=SUM*MIS/100 Q .I SIM="+" S SUM=SUM*MIS/100+SUM Q .I SIM="-" S SUM=SUM-(SUM*MIS/100) Q .I SIM="/" Q:MIS=0 S SUM=SUM*100/MIS Q I SIM["M" S @($P(SIM,"="))=MIS Q I MIS["M" S OPER=$P(MIS,"=",2) I ",/,\,#,"[(","_SIM_",") I OPER=0 W *7,*7,*7 Q X "S SUM="_SUM_SIM_OPER Q CB ; W *27,"["_(4+LIN)_";"_(26+APP)_"H" W $J(SUM,12,2) Q GLO ; S ^CALC(CALC,IND)=SIM_","_MIS_","_SUM S LIN=LIN+1,IND=IND+1,MIS="" Q CBET ; S COL="3,10,26",CEL="0,0,12",DRO="0,0,2" F ICB=ST:1:FN W *27,"["_(5-ST+ICB)_";"_(3+APP)_"H" W *27,"[35X" D .F P=1,2 W *27,"["_(5-ST+ICB)_";"_($P(COL,",",P)+APP)_"H" W $P(^CALC(CALC,ICB),",",P) .W *27,"["_(5-ST+ICB)_";"_(26+APP)_"H" W $J($P(^CALC(CALC,ICB),",",3),12,2) Q CHIS ; W *27,"["_(6-ST+ICB)_";"_(3+APP)_"H" W *27,"[35X" Q POZ ; W *27,"["_YY_";"_(XX+APP)_"H" Q IND ; W *27,7,*27,"[1;1H",*27,"[7m",$J(IND,3)," ",*27,"[0m",*27,8 Q HELP ; D:CALC=2 GET^%VIDEO("TEXT",0,1,40,24,2) D:CALC=1 GET^%VIDEO("TEXT",41,1,80,24,2) F PAGE=0:1 D Q:T="Q" .F I=1:1:MAXL S T=$P($T(H+I+(PAGE*MAXL)),";",2) Q:T="Q" W *27,"["_(4+I)_";"_(42-APP)_"H" W:T'[":" T W:T[":" $P(T,":"),*27,"[7m"," :",$P(T,":",2),*27,"[0m" .I I 1 - jynd, 2 - dxfg, 3 - d`ivi " .W *27,"["_(MAXL+5)_";1H",! R R#1 .I R=3 S T="Q" Q .I R=2 S PAGE=PAGE-2 D S:T="Q" T="" Q ..I PAGE<-1 S PAGE=-1 W *7," dxfr dligz ",*27,"K" H 1 .I T="Q"!($P($T(H+I+1+(PAGE*MAXL)),";",2)="Q") W *7," dxfr sq ",*27,"K" H 1 S PAGE=PAGE-1,T="" W *27,"["_(MAXL+5)_";1H",!,HELP D:CALC=2 PUT^%VIDEO("TEXT",0,1,40,24,2) D:CALC=1 PUT^%VIDEO("TEXT",41,1,80,24,2) W *27,8 G MAIN H ; ; ; : dlert ; ; / * - +; ; 7#2=1 # 7\2=3 \; ; oexkf M9--M0; ; ; ; : jxr ; ; 123456789 ; ; 123456789. ; ; 123456789.1 ; ; 123456789.12; ; .1; ; .12; ; M0--M9; ; : mifeg` mr zelert ; ; 200 = mekq m`; ; * 10% = 20; ; + 10% = 220; ; - 10% = 180; ;Q Q PRINT ; O 3 U 3 W ! D ^%D W " " D ^%T W ! W "---------------------------------------",! W " dlert jxr d`vez ",! W "---------------------------------------",! F I=1:1 Q:'$D(^CALC(1,I)) W $P(^(I),","),?10,$P(^(I),",",2),?25,$J($P(^(I),",",3),12,2),! W # C 3 U 0:(0::::65) G END %L1CALCH %L1CALCH ; CALCULATOR HELP ; SHEER [ 03/01/93 9:20 AM ] HELP ; F PAGE=0:1 D Q:T="Q" .F I=1:1:MAXL S T=$P($T(H+I+(PAGE*MAXL)),";",2) Q:T="Q" W *27,"["_(4+I)_";"_(42-APP)_"H" W:T'[":" T W:T[":" $P(T,":"),*27,"[7m"," :",$P(T,":",2),*27,"[0m" .I I 1 - jynd, 2 - dxfg, 3 - d`ivi " .W *27,"["_(MAXL+5)_";1H",! R R#1 .I R=3 S T="Q" Q .I R=2 S PAGE=PAGE-2 D S:T="Q" T="" Q ..I PAGE<-1 S PAGE=-1 W *7," dxfr dligz ",*27,"K" H 1 .I T="Q"!($P($T(H+I+1+(PAGE*MAXL)),";",2)="Q") W *7," dxfr seq ",*27,"K" H 1 S PAGE=PAGE-1,T="" W *27,"["_(MAXL+5)_";1H",! D HELP^%L1CALC W *27,8 Q ; 25.02.93 H ; ; ; : dlert ; ; ; ; / * - +; ; 7\2=3 <-- mly welig - \; ; 7#2=1 <-- zix`y - #; ; ipnf xb`n zxiny M9--M0; ; reaw xb`n zxiny G9--G0; ; ; ; : jxr ; ; ; ; 123456789 ; ; 123456789. ; ; 123456789.1 ; ; 123456789.12; ; .1; ; .12; ; ipnf xb`nn xefgiy M0--M9; ; reaw xb`nn xefgiy G0--G9; ; ; ; : mifeg` mr zelert ; ; ; ; 200 * 10% = 20; ; 200 + 10% = 220; ; 200 - 10% = 180; ; 200 / 10% = 2000; ;Q Q %L1CALL %L1CALL(%PROG,%SCRN,%VRBLIST) ; [ 30.06.03 18:19 ] [ 23.06.03 11:28 ] [ 07/08/99 9:17 AM ] N MAC1,MAC2,%I,%V K ^zms0($P) S MAC1="^zms($P)",MAC2="^zms0($P)" D ^%S1GC1 K ^zms($P) S:%PROG'["^" %PROG="^"_%PROG N %UCI,%UCO S %UCO=$ZROUTINES_"^"_$ZGBLDIR ;$$^%L1ZU(0) S:%UCO["," %UCO=$P(%UCO,",") I %PROG["[" D .S %UCI=$P($P(%PROG,"[",2),"]") .S %PROG=$P(%PROG,"[")_$P(%PROG,"[",3,20) .S:%UCI["," %UCI=$P(%UCI,",") .S ^zms($P,"SCRN")=$G(%SCRN) .S ^zms($P,"UCO")=%UCO .S ^zms($P,"UCI")=%UCI S ^zms($P)=%PROG,^zms($P,"SCRN")=$G(%SCRN) N %VRBIN,%VRBOUT S %VRBIN=$P($G(%VRBLIST),">") ;;S %VRBOUT=$P(%VRBLIST,">",2) I $D(%L1SCRG),%VRBIN'["%L1SCRG" S %VRBIN=%VRBIN_",%L1SCRG" F %I=1:1:$L(%VRBIN,",") S %V=$P(%VRBIN,",",%I) I $L(%V) D .I $D(@%V)>9 S MAC1=%V,MAC2="^zms($P,""V"",%V)" D ^%S1GC1 Q .I $D(@%V)#2 S ^zms($P,"V",%V)=@%V Q D ^%L1ZMST N %N S %N="" F S %N=$O(^zms($P,"O",%N)) Q:%N="" D .I $D(^(%N))>9 S MAC1="^zms($P,""O"",%N)",MAC2=%N D ^%S1GC1 Q .I $D(^(%N))#2 S @%N=^(%N) D K ^zms($P) S MAC1="^zms0($P)",MAC2="^zms($P)" D ^%S1GC1 K ^zms0($P) Q %L1CERGS %L1CERGS ; RESTORING PROGRAMM CATALOG [ 06.07.03 08:40 ] [ 25.06.03 22:14 ] [ 21.06.03 22:12 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S PRDT="S DT=$S(A?2N1"".""2N1"".""2N:$$^%L1DC(A,3),1:$$^%L1DC($$^%L1DC(A,5),4))" S %GET=" 99 yiwz zeipkez belhw xefgiyl " D N^%L1GET Q:%S'=99 K %ZR S %ZR="*",%ZE=".m" d init^%RSEL s out=0 d work^%RSEL S N="" F S N=$O(%ZR(N)) Q:N="" D .S A=$P($P($T(@("+1^"_N)),"[ ",2)," ") Q:'A X PRDT .I DT S ^%ERGS(DT,N)="",IND=$O(^%ERGS(DT,N,99999),-1)+1 S:IND=1 ^%ERGS(DT,N,IND)="" U 0 W "." S %GET="" D N^%L1GET Q %L1CH %L1CH ; CREATING PHON BEATIFUL [ 16.12.03 10:18 ] [ 14.12.03 16:43 ] [ 12.06.03 08:49 ] N %ECHO X %chista Q:%TYPCRT'="PC" D .N %VD,I,J U $P:(NOECHO:NOWRAP) .W $C(27),"[1;1;25;80w" .F I=1:1:25 W $TR($J("",80)," ",$C(177)) Q %L1CL %L1CL ; MY CALCULATOR [ 11.04.05 15:39 ] [ 06.04.05 21:52 ] [ 31.07.00 9:32 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1CL) D ^%L1C BG ;S LG=8,RG=72,VG=3,NG=21 W %ENG S LG=8,RG=72,VG=3,NG=19 W %ENG S X1=LG,X2=RG,Y1=VG,Y2=NG+2 S %SH=0 X %chista K ^L1CL(%L3MYDVN,"NG"),^L1CL(%L3MYDVN,"SH") X %LIGHT S %SAY=" dlert : xtqn : d`vez :++"_(VG-2)_",69,HH" X %XMSG X %XCL W %ENG,*27,"["_VG_";"_(NG+1)_"r",%HBR S %YY=VG-2,%XX=0 X %POSIC ;C KPDV O KPDV:(FN1) N ST5 F U KPDV R ST5 Q:$ZC=-1 U @KPTT W !,ST5 D NST S %SUM=0,%SGN="+" D NST NX S %S=0,%TO="" U 0 S %YY=YY+2,%XX=60 X %POSIC S $Y=%YY W ! D NST ZM S %ZMSL="=+-:/\" W %ENG S %GET="++"_YY_",39,E#++12,E,I",%ZMSF="" D ^%L1GET I %TO="" S %TO="+" I %TO="F1"!(%TO="F2")!(%TO="F3")!(%TO="F4"),%S W *7 G ZM S %SH=%SH+1 I %TO="F1"!(%TO="F2")!(%TO="F3")!(%TO="F4"),'%S D VSV(%S,"=",%SUM+%S,YY) S %L1CL("TO")=%TO G END I %TO="END"!(%TO="="),'%S D VSV(%S,"=",%SUM+%S,YY) G END I %TO="END"!(%TO="="),%S S %S="",%TO="+" G ZM S %ER=0 I $L(%SGN)=1,"+-/\"[%SGN D G:"=+-/\"[%TO&(%TO'="") NX .S ^L1CL(%L3MYDVN,"SH",%SH)=$S(%SGN="-":"-",1:"")_%S .S %MSP=%S .I %S["*",$E(%S)="*" S %S=%SUM*$P(%S,"*",2) S @("%SUM="_%S) G V .I $E(%S)="/"!($E(%S)=":"),$E(%S,2,25) S %S=%SUM/$E(%S,2,25) S @("%SUM="_%S) G V .I %S["*",$E(%S)'="*" S %S=$P(%S,"*")*$P(%S,"*",2) S %MSP=%MSP_"="_$J(%S,2,2) .I %S["/",$P(%S,"/",2) S %S=$P(%S,"/")/$P(%S,"/",2) S %MSP=%MSP_"="_$J(%S,2,2) .I %MSP?1N.N S %MSP=$J(%MSP,2,2) .I %MSP?1N.N1"%" S %S=%SUM*%MSP*.01,%MSP=%MSP_"="_$J(%S,2,2) .I %S!(%SGN="*") S @("%SUM="_%SUM_%SGN_+%S) .S %SGN=%TO Q:"=+-*/\"'[%TO V .D VSV(%MSP,%SGN,%SUM,YY) S %TO="" G ZM NST ; S ^L1CL(%L3MYDVN,"NG")=$S($G(^L1CL(%L3MYDVN,"NG"))+1>(NG-2):NG-2,1:$G(^L1CL(%L3MYDVN,"NG"),VG-2)+1) S YY=^L1CL(%L3MYDVN,"NG") Q VSV(%MSP,%SGN,%SUM,YY) ; S %SAY=$J(%MSP,14)_"++"_YY_",39,E" X %XMSG S %SAY=%SGN_" ++"_(YY+1)_",34,E" X %XMSG S %SAY=$J(%SUM,8,2)_"++"_YY_",60,E" X %XMSG I $D(%L1CL("PC")) D .S %GL=%L1CL("PC") S %IND=$O(@%GL@(99999),-1)+1 .S @%GL@(%IND)=" "_%SGN_" "_$J(%MSP,14)_" = "_%SUM .I %SGN="=" S @%GL@(%IND+1)=$C(10,10,10,10,10)_$G(%L1CL("CUT"))_$C(10,10,10,10) Q END S %L1CL("SUM")=%SUM Q %L1CLC %L1CLC ; CALCCULATOR ONE-LINE [ 30.11.01 11:19 PM ] [ 22.08.01 12:15 PM ] [ 11/06/97 8:25 AM ] N (%UPRCOD,%XMSGV,%XMSGN,%XMSG,%L1CLC) D ^%L1C N $ZT S $ZT="ZG "_$ZL_":ER" S VVERX=0 I $Y'<20 S VVERX=1 M0 S %FLINS=1 K %L1CLC S %GET=": aeyigl iehia yiwdl `p++"_$S('VVERX:24,1:0)_",70,HH,,,C#"_$G(%L1BT)_"++40,E,I++1234567890.,()[]{}%X|:/+-*+" D ^%L1GET Q:%S=""!(%TO="END") S %L1BT=%S S %S=$TR(%S,"X:|[]{},","*//()().") I $L(%S,"(")'=$L(%S,")") S %SAY=" miixbeq zenka d`iby " X:VVERX %XMSGV(1) X:'VVERX %XMSGN(1) G M0 S I=1,S=%S,UR=1 K ZN,V BEG ; I $E(S,I)="" D VC G EN I $E(S,I)="(" S ZN(UR)=$E(S,I-1) S:ZN(UR)="" ZN(UR)="+" S:ZN(UR)=")"!(ZN(UR)?1N) ZN(UR)="*" S UR=UR+1 G ADI I $E(S,I)=")" D VC S UR=UR-1 G:UR<1 ER S VUR=$G(V(UR)) S V(UR)=VUR_$S("+-*/"[$E(VUR,$L(VUR)):"",1:ZN(UR))_V G ADI S V(UR)=$G(V(UR))_$E(S,I) ADI S I=I+1 G BEG VC S S2=V(UR),ZN="",S4="",V=0,J1=1,JOLD=1 D X "S V="_S4 K V(UR) Q C .S S3="" ;W !," V(",UR,") = "_V(UR) H 1 C1 .F J=J1:1:$L(S2) Q:"+-*/"[$E(S2,J) S S3=S3_$E(S2,J) .I S3="",J<$L(S2) S S3=$E(S2,J) S J1=J+1 G C1 .I J'<$L(S2),$L(ZN),$L(S3) D:S3["%" PRCNT Q:S3["%" S @("S4="_S4_ZN_S3) Q .I J'<$L(S2) S:S4="" S4=S3 Q .S ZN1=$E(S2,J),S31="",JOLD=J C2 .F J2=J+1:1:$L(S2) Q:"+-*/"[$E(S2,J2) S S31=S31_$E(S2,J2) .S ZN2="" I J2<$L(S2),S31="" S S31=$E(S2,J2),J=J2 G C2 .I J2<$L(S2) S ZN2=$E(S2,J2) .;W !,"S4=",S4," ZN=",ZN," S3=",S3," ZN1=",ZN1," S31=",S31," ZN2=",ZN2 H 2 .;-------- +,- & *,/ .I ZN="",ZN1="+"!(ZN1="-"),ZN2="*"!(ZN2="/"),S31'["%" S:S31["%" S31=S31*.01 S S32="" D S @("S30="_S31_ZN2_S32) S @("S4="_S4_ZN_S3_ZN1_S30) S ZN=$E(S2,J3),J1=J3+1,ZN1="",ZN2="" Q:J1>$L(S2) G C ..F J3=J2+1:1:$L(S2) Q:"+-"[$E(S2,J3)&("+-*/"'[$E(S2,J3-1)) S S32=S32_$S($E(S2,J3)'="%":$E(S2,J3),1:"*.01") ..S @("S32="_S32) .I ZN="+"!(ZN="-"),ZN1="*"!(ZN1="/"),S3'["%" S J3=J2 D:ZN2'="" S @("S30="_S3_ZN1_S31) S @("S4="_S4_ZN_S30) S ZN=$E(S2,J3),ZN1="",ZN2="",J1=J3+1 Q:J1>$L(S2) G C ..F J3=J2:1:$L(S2) Q:"+-"[$E(S2,J3)&("+-*/"'[$E(S2,J3-1)) S S31=S31_$S($E(S2,J3)'="%":$E(S2,J3),1:"*.01") ..S @("S31="_S31) .I S3["%",ZN="" D PRCNT S ZN=ZN2,(ZN1,ZN2)="" S J1=J2+1 Q:J1>$L(S2) G C .I S3["%",ZN'="" D PRCNT S ZN=ZN1 S (ZN1,ZN2)="" S J1=JOLD+1 Q:J1>$L(S2) G C .;I ZN="" S @("S4="_S3_ZN1_S31) S ZN=ZN2,(ZN1,ZN2)="" S J1=J2+1 Q:J1>$L(S2) G C .S @("S4="_S4_ZN_S3) S ZN=ZN1 S (ZN1,ZN2)="" S J1=JOLD+1 Q:J1>$L(S2) G C Q PRCNT ; I ZN="+"!(ZN="-") S @("S4="_S4_"*("_100_ZN_+S3_")*.01") I ZN="*"!(ZN="/") S @("S4="_S4_ZN_+S3_"*.01") Q EN S %L1CLC=$J(V,3,3),%GET=" - dcyl xiardl . "_%L1BT_"="_%L1CLC I 'VVERX D N^%L1GET I VVERX D V^%L1GET I %TO="F9" S %S=99 I %S=99 S %L1CLC("F")=1 Q ER I VVERX X %XMSGV("ER") I 'VVERX X %XMSGN("ER") S $ZT="ZG "_$ZL_":ER^%L1CLC" D ^%L1C G M0 %L1CLJOB %L1CLJOB ; [ 08.04.07 08:53 ] [ 17.11.05 16:49 ] [ 24.08.05 16:02 ] [ N GLD,N,TNMB S GLD=$$^%L1GLD D ^%L1LJ ; S N="" F S N=$O(^[GLD]devi(N)) Q:N="" I N?1N.N,'$D(^listjob(N)) D .S TNMB=^[GLD]devi(N) K ^[GLD]devi(N) .I TNMB?1N.N K ^[GLD]dev("TERM"_TNMB) Q %L1CLRTM %L1CLRTM(TM) ; [ 05.03.08 05:04 ] [ I TM["PM",TM[":" D Q TM .S TM=$$SPA^%L1FRM(TM) .S TM=$P(TM," PM") .I TM<12 S TM=$P(TM,":")+12_":"_$P(TM,":",2) Q .S TM=$P(TM,":")_":"_+$P(TM,":",2) ; I TM["AM",TM[":" D Q $P(TM,":",1,2) .S TM=$$SPA^%L1FRM(TM) .S TM=$P(TM," AM") ; Q $P(TM,":",1,2) %L1CNV %L1CNV(%ST) ; [ 10.12.25 14:00 ] [ 08.10.25 13:35 ] [ 18.09.25 16:46 ] N %OU,%J S %OU="" N %ST1 S %ST1=$$INVH^%L1FRM(%ST) F %J=1:1:$L(%ST1) D .S SMB=$A(%ST1,%J) .I SMB>95&(SMB<123) S SMB=SMB+1392 .N UTF S UTF=$$NULL^%L1FRM($$FUNC^%DH(SMB)) .S UTF=$TR($J(UTF,4)," ",0) .S %OU=%OU_"\U"_UTF Q $$FUNC^%LCASE(%OU) ; ; U2H(%ST,NOUPR) ; N %OU,%J,%SMB,%SMB1 S %OU="" S %J=0 U2HC S %J=%J+1 I %J>$L(%ST) G U2HE I $E(%ST,%J,%J+1)="\u" D G U2HC .S %SMB1=$$FUNC^%HD($$FUNC^%LCASE($E(%ST,%J+2,%J+5))) .I %SMB1>1392 S %SMB1=%SMB1-1392 .S %OU=%OU_$C(+%SMB1) .S %J=%J+5 ; I '$G(NOUPR) S %OU=%OU_$$FUNC^%UCASE($E(%ST,%J)) I $G(NOUPR) S %OU=%OU_$E(%ST,%J) G U2HC ; U2HE ; Q $$INVH^%L1FRM(%OU) ; UTF2H(%TXT) ; N (%TXT) S %OU="" F %J=2:1:$L(%TXT,"%u") D .S %CD=$P(%TXT,"%u",%J) .S %CDD=$$FUNC^%HD(%CD) .S %OU=$C(%CDD-1392)_%OU Q %OU ; U2D(ST,H2U) ; N J,ST1 S J=0,ST1="" S J=0 U2DC S J=J+1 I J>$L(ST) Q ST1 ; I $E(ST,J)=$C(215) D S J=J+1 G U2DC .N SMB S SMB=$C($A(ST,J+1)-48) .S ST1=ST1_$S($G(H2U):$$H2U^%L1FRM(SMB),1:SMB) ; S ST1=ST1_$E(ST,J) G U2DC ; U2DI(ST) ; N J,ST1,ST2 S J=0,ST1="",ST2="" S J=0 U2DCI S J=J+1 I J>$L(ST) Q ST1 I $E(ST,J)=$C(215) S ST2=$C($A(ST,J+1)-48)_ST2 S J=J+1 G U2DCI S ST1=ST1_ST2_$E(ST,J) S ST2="" G U2DCI ; D2U(ST) ; N J,ST1 S J=0,ST1="" S J=0 D2UC S J=J+1 I J>$L(ST) Q ST1 I $A(ST,J)>95,$A(ST,J)<123 S ST1=ST1_$C(215)_$C($A(ST,J)+48) G D2UC S ST1=ST1_$E(ST,J) G D2UC ; %L1COD %L1COD ; SHIFT+ ---> COMMAND [ 05/23/99 4:21 PM ] [ 07/19/94 5:43 PM ] N %S,%STR,%N ZS U 0 S %S="" W !!,"STRING:" D ^%ZMSL G:%S="" END S %STR="" F %I=1:1:$L(%S) S %STR=%STR_$$^%L1ZH($A($E(%S,%I))) S %STRING=%S ZF S %S="" W !!,"PF-NUMBER: F1=17,F2=18,F3=19,F4=20,F5=21,F6=22,F7=23,F8=24,F9=25 > " D ^%ZMSL G:%S="" ZS S %N=%S I %N<17!(%N>25) W *7," ???" G ZF W $C(27),"P1;1|"_%N_"/"_%STR_$C(27)_"/" W !!,"CALL "_%STRING_" - /F"_(%N-16) G ZS END Q IN S %STR="" F %I=1:1:$L(%S) S %STR=%STR_$$^%L1ZH($A($E(%S,%I))) W $C(27),"P1;1|"_%N_"/"_%STR_$C(27)_"/" Q I ; S %S="D ^%DEBUG",%N=17 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="/R",%N=18 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="X %chista",%N=19 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="U $P:(ECHO:WRAP)",%N=20 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="/B",%N=21 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="/S",%N=22 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="W %ENG",%N=23 D IN W !!,"CALL "_%S_" - /F"_(%N-16) S %S="W %HBR",%N=24 D IN W !!,"CALL "_%S_" - /F"_(%N-16) Q TV W $C(27),"P1;1|17/0011"_$C(27)_"/" Q %L1COPY %L1COPY N (%UPRCOD,%XMSG) D ^%L1C ; FILE1 --> FILE2 [ 05.06.03 14:24 ] [ 13.04.01 1:57 PM ] [ 06.06.00 11:55 AM ] N $ZT S $ZT="" U 0 S PRT=%L3MYDVN N %HBRY W %ENG S %S="" Z1 X %chista S %SAY=" FILE COPY " X %XMSGV X %XCL S %FL="",%FLINS="",%LS=40 U 0 W !!,%LIGHT1,%CV("YF"),"FULL NAME OF HOST FILE (INPUT) : ",%CV("CF") D ^%ZMSL K %L1GET ; I %S="?"!(%TO="F7") D O13^%L1OS S %S=$S($G(%PATH)'="":%PATH_"\",1:"")_$TR($E(%L2VNM,1,8)_"."_$E(%L2VNM,11,13)," ","") G Z1 I %S=""!(%TO="END") G END S FILE1=%S S %ER=$$^%L1ZOS(10,FILE1) I %ER<0 W %ENG D ^%L1OS1 G Z1 O FILE1:(READONLY:REWIND):2 E U 0 W !,"*** FILE "_FILE1_" IN USE !" G Z1 I $ZC>0 D OE G Z1 S %ER=0 D CAMA(FILE1) I '%CAMA S %SAY=" NOTHING TO COPY " X %XMSGV(1) G Z1 U 0 W !?30,$J(%CAMA/1024,3,3)_"K" ; Z2 U $P S %S=FILE1,%FLINS=1,%LS=40 K %L1GET W !!,%LIGHT1,%CV("YF"),"FULL NAME OF HOST FILE (OUTPUT): ",%CCL,%CLI D ^%ZMSL G:%S=""!(%TO="END")!(%TO="UP")!(%TO="PGUP") Z1 S FILE2=%S FL2 ; S %L1CPOK=0 W !! I $$^%L1ZOS(10,FILE2)'<0 S %Q("Z")="FILE IN DIRECTORY! ARE YOU SURE",%Q("U")="N" D ^%S1ASK G:'YES END:$D(TV),Z2 S %ER=$$^%L1ZOS(2,FILE2) ;;I %ER<0 W %ENG D ^%L1OS1 G END:$D(TV),Z1 O FILE2:(WRITE:NEWVERSION):2 E U $P S %S=" FILE "_FILE2_" IN USE ! " X %XMSGV(1) G END:$D(TV),Z1 ; I FILE2["PT:\" D G Z1 .N %I,%A,%B,%J S %I=0,%J=0,%B="" CPT .S %I=%I+1 I %I>%CAMA D:$L(%B) ZPT Q .U FILE1 R *%A Q:$ZC>0 .S %B=%B_$C(%A) I $L(%B)>100!($ZC<0) D ZPT .Q:$ZC<0 G CPT ; ZSY "cp -R "_FILE1_" "_FILE2 ;;F %I=1:1 Q:%I>%CAMA U FILE1 R *%A Q:$ZC>0 U FILE2 W $C(%A) Q:$ZC I '(%I#1024) U 0 W *27,*7 S %SAY=%I\1024_"K" X %XMSGV W *27,*8 C FILE1,FILE2 S %L1CPOK=1 S %GET="" D N^%L1GET Q:$D(TV) G Z1 END I $G(FILE1)'="",FILE1'=$P C FILE1 I $G(FILE2)'="",FILE2'=$P C FILE2 Q ; TE W *7,!,"TRANSFER ERROR $ZC=",$ZC Q OE W !!,*7,"*** OPEN ERROR ! $ZC=",$ZC H 2 Q CAMA(%NMF) ; S %CAMA=$P($$^%L1FLP(%NMF),"^",2) Q TV(FILE1,FILE2) ; S %ER=$$^%L1ZOS(10,FILE1) I %ER<0 W %ENG D ^%L1OS1 G END D CAMA(FILE1) O FILE1:(REWIND:READONLY):2 E S %SAY="*** FILE "_FILE1_" IN USE !" X %XMSGV(1) G END I $ZC>0 D OE G END S TV="" G FL2 ; ZPT S %J=%J+1 D TVB^%L1PTW(%NMF,%B,%J) S %B="" Q %L1CRC %L1CRC(%N) ; [ 20.09.05 16:13 ] [ 11.01.05 12:34 PM ] [ 15.08.01 2:56 PM ] I '$D(%L102)!'$D(%L210) D .N L102 .F %I=1:1:255 S L102=$$102(%I),%L102(%I)=L102,%L210(L102)=%I N %CRC,%CRC2,%I S %CRC=0 F %I=1:1:$L(%N) I $$CYC($A($E(%N,%I))) S %CRC2=$$102(%CRC) S %CRC2=$TR($J(%CRC2,16)," ",0) Q $C($$210($E(%CRC2,1,8)))_$C($$210($E(%CRC2,9,16))) ; CYC(%CP) ; ;--- IN %CRC N %C,%CRCOLD,%C2 S %C=$$^%L1ZB(%CP,255,1) F %COUNT=8:-1:1 D .S %CRCOLD=%CRC .S %CRC=%CRC*2 .D CRC .S %C=%C*2 .S %C2=$$102(%C) .I $E(%C2,$L(%C2)-8) S %CRC=%CRC+1 .S %C2=$TR($J(%C2,8)," ",0) .;I $E(%C2) S %CRC=%CRC+1 .S %C2=$E(%C2,$L(%C2)-7,$L(%C2)) .S %C=$$210(%C2) .I $$^%L1ZB(%CRCOLD,32768,1) S %CRC=$$^%L1ZB(%CRC,$$^%L1ZH("1021#"),6) D CRC Q %CRC ; CRC ; N %CRC2 S %CRC2=$$102(%CRC) S %CRC2=$E(%CRC2,$L(%CRC2)-15,$L(%CRC2)) S %CRC=$$210(%CRC2) Q %L12 ;10 --> 2 ; [ 15.08.01 1:46 PM ] [ 14.08.01 10:29 AM ] [ 12/13/97 10:39 PM ] N (%XMSG,%UPRCOD,%N1,%N2,%ER) S %ER=0 I '$D(%N1) S %ER=1 Q I %N1'?1N.N S %ER=1 Q S N=%N1 I K B S B(1)=1,J=1 C S A=1 F I=1:1 Q:(A*2)>N S A=A*2 S B(J)=B(J)_0 S N=N-A I N<2 S J=J+1 S B(J)=N G M S J=J+1,B(J)=1 G C M S B1=0 F J1=1:1:J S B1=B1+B(J1) S %N2=B1 Q 102(%N1) I $D(%L102(%N1)) Q %L102(%N1) D %L12 I %ER Q -1 Q %N2 162(%N1) S @("%N1=$$^%L1ZH("""_%N1_"#"")") D %L12 I %ER Q -1 Q %N2 210(%N1) ; I $D(%L210(%N1)) Q %L210(%N1) N %I,%I1 S %I1=-1,%N2=0 F %I=$L(%N1):-1:1 S %I1=%I1+1 I $E(%N1,%I) S %N2=%N2+(2**%I1) Q %N2 %L1CRC0 %L1CRC(%N) ; [ 20.09.05 16:03 ] [ 19.09.05 17:09 ] [ 03.06.04 09:13 ] N %CRC,%CRC2,%I S %CRC=0 F %I=1:1:$L(%N) I $$CYC($A($E(%N,%I))) S %CRC2=$$102(%CRC) S %CRC2=$TR($J(%CRC2,16)," ",0) Q $C($$210($E(%CRC2,1,8)))_$C($$210($E(%CRC2,9,16))) ; CYC(%CP) ; ;--- IN %CRC N %C,%CRCOLD,%C2 S %C=$$^%L1ZB(%CP,255,1) F %COUNT=8:-1:1 D .S %CRCOLD=%CRC .S %CRC=%CRC*2 .D CRC .S %C=%C*2 .S %C2=$$102(%C) .I $E(%C2,$L(%C2)-8) S %CRC=%CRC+1 .S %C2=$TR($J(%C2,8)," ",0) .;I $E(%C2) S %CRC=%CRC+1 .S %C2=$E(%C2,$L(%C2)-7,$L(%C2)) .S %C=$$210(%C2) .I $$^%L1ZB(%CRCOLD,32768,1) S %CRC=$$^%L1ZB(%CRC,$$^%L1ZH("1021#"),6) D CRC Q %CRC ; CRC ; N %CRC2 S %CRC2=$$102(%CRC) S %CRC2=$E(%CRC2,$L(%CRC2)-15,$L(%CRC2)) S %CRC=$$210(%CRC2) Q %L12 ;10 --> 2 ; [ 15.08.01 1:46 PM ] [ 14.08.01 10:29 AM ] [ 12/13/97 10:39 PM ] N (%XMSG,%UPRCOD,%N1,%N2,%ER) S %ER=0 I '$D(%N1) S %ER=1 Q I %N1'?1N.N S %ER=1 Q S N=%N1 I K B S B(1)=1,J=1 C S A=1 F I=1:1 Q:(A*2)>N S A=A*2 S B(J)=B(J)_0 S N=N-A I N<2 S J=J+1 S B(J)=N G M S J=J+1,B(J)=1 G C M S B1=0 F J1=1:1:J S B1=B1+B(J1) S %N2=B1 Q 102(%N1) D %L12 I %ER Q -1 Q %N2 162(%N1) S @("%N1=$$^%L1ZH("""_%N1_"#"")") D %L12 I %ER Q -1 Q %N2 210(%N1) ; N %I,%I1 S %I1=-1,%N2=0 F %I=$L(%N1):-1:1 S %I1=%I1+1 I $E(%N1,%I) S %N2=%N2+(2**%I1) Q %N2 %L1CRC8 %L1CRC8(S) ; [ 13.04.08 14:55 ] [ 10.04.08 12:43 ] [ 25.03.08 11:35 ] [ N CRC8,M,J,K,X,X1 S CRC8=0 F M=1:1:$L(S) D .S X=$A($E(S,M,M)) .F K=0:1:7 D ..S J=$$BITOUT($ZBITAND($$BITIN(1),$ZBITXOR($$BITIN(X),$$BITIN(CRC8)))) ..S CRC8=$$BITOUT($ZBITAND($$BITIN(CRC8\2),$$BITIN($$^%L1ZH("FF")))) ..S X=$$BITOUT($ZBITAND($$BITIN(X\2),$$BITIN($$^%L1ZH("FF")))) ..I J D ...S CRC8=$$BITOUT($ZBITXOR($$BITIN(CRC8),$$BITIN($$^%L1ZH("8C")))) Q CRC8 BITIN(X) S X1=$ZBITSTR(8,0) F N=1:1:8 S B=X#2,X=X\2 I B S X1=$ZBITSET(X1,N,1) Q X1 BITOUT(X) S X1=0 F N=1:1:8 I $ZBITGET(X,N) S X1=X1+(2**(N-1)) Q X1 %L1CRDTC %L1CRDTC ; [ 23.11.06 17:32 ] [ 08.10.06 12:18 ] [ XMIN(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"XMIN")) XMAX(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"XMAX")) YMIN(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"YMIN")) YMAX(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"YMAX")) PORT(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"PORT")) NO(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"NO")) KB(STAM) ;;I $G(^[$$^%L1GLD]P1PRM("HZMTCH")),$D(^P1HZMS(%L3MYDVN)) Q 1 Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$^%L1INDTC,"KB")) ; XMIN1(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$P^%L1INDTC,"XMIN")) XMAX1(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$P^%L1INDTC,"XMAX")) YMIN1(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$P^%L1INDTC,"YMIN")) YMAX1(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$P^%L1INDTC,"YMAX")) PORT1(STAM) Q $G(^[$$^%L1GLD]P1PRM("TOUCH",$$P^%L1INDTC,"PORT")) %L1CRMN %L1CRMN ; [ 03.04.07 20:22 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) BG K D ^%L1C K ^TEMP($P) S %SCRN="CRMN" SC D ^%L1SC I %BS G END D IS3^%L1GET I %S=1 G SC I %S=0 K ^TEMP($P) D A^%L1SC G BG D SAVE K ^TEMP($P) D A^%L1SC G BG END K ^TEMP($P) Q ; PACKAGE1 ; S ^WBMENU(PACKAGE)=PACKAGE1 Q MENU ; I %TO="F7" D S %SC("ST")=1 Q .S MAC="^WBMENU("""_PACKAGE_""")" .S %L1("EU")=2,%L1("BE")=4 .S %L1("TXT1")="%NXS<>30H\/%NXN<>6" .D ^%L1NU Q:FLAG'="" .S MENU=INDEX,MENU1="" .I $L(MENU) S MENU1=$G(^WBMENU(PACKAGE,MENU)) ; S MENU1=$G(^WBMENU(PACKAGE,MENU)) Q MENU1 ; Q ; LNG ; S N="",I=0 F S N=$O(^WBMENU(PACKAGE,MENU,N)) Q:N="" D .S US=$G(^WBMENU(PACKAGE,MENU,N,"US"),1) .S ADR=$$UP(^("ADR")) .S ST=$G(^WBMENU(PACKAGE,MENU,N,"LNG",LNG)) .S I=I+1 .S ^TEMP($P,I)=US_"\"_ST_"\"_ADR Q SAVE ; K ^WBMENU(PACKAGE,MENU) F I=1:1 Q:'$D(^TEMP($P,I)) D .S A=^(I) .S US=$P(A,"\",1) I US="" S US=1 .S ST=$P(A,"\",2) Q:ST="" .S ADR=$P(A,"\",3) Q:ADR="" .S ^WBMENU(PACKAGE,MENU,I,"LNG",LNG)=ST .S ^WBMENU(PACKAGE,MENU,I,"US")=US .S ^WBMENU(PACKAGE,MENU,I,"ADR")=$$LOW(ADR) ; S ^WBMENU(PACKAGE,MENU)=MENU1 Q UP(TXT) Q $$FUNC^%UCASE(TXT) LOW(TXT) Q $$FUNC^%LCASE(TXT) %L1CURL %L1CURL(TO,MTD,DOP) ; [ 16.04.26 12:14 ] [ 10.12.24 09:54 ] [ 10.11.24 11:06 ] N (JB,%ARG,%REM,TO,MTD,DOP) S FLOU="/tmp/flcurlou"_+$H_"_"_JB_"_"_$P($H,",",2) S CMD="curl -m 60 -s -w ""%{http_code}"" -X "_MTD_" --location """_TO_"""" I MTD="GET" D .S CMD=CMD_" -o /dev/null > "_FLOU ; S ^CURL($P($H,","),$P($H,",",2))=CMD ZSY CMD S ^CURL($P($H,","),$P($H,",",2),"ZSY")=$ZSY I $ZSY Q -$ZSY ; I '$$EXIST^%L1ZOS(FLOU) Q "NO ANSWER" O FLOU:(REWIND:READONLY) U FLOU R ANS C FLOU S ^CURL($P($H,","),$P($H,",",2),"ANS")=$E(ANS,1,2000) I ANS="" S ANS="NO ANSWER CODE" Q ANS %L1D2W %L1D2W(%TXT) ; [ 05.10.04 19:31 ] [ N TS0,TSS,TS1 D ^%L1TS Q $TR(%TXT,TS0,TS1) %L1DAT %L1DAT ; [ 24.10.06 07:54 ] [ 23.10.05 14:03 ] [ 24.10.04 12:30 ] D USE N %BEG,%DD,%MM,%HH,A,A1,A2,ZB,ZB0,C,C1 I '$D(%MOUSE) S %MOUSE=$$INIT^%L2MOUSE K %screen S %BEG=1 K %L1NMB("ALB") K %ECHO S %L1DAT="",%L1DAT1="",%TO="" S:'$D(%XX) %XX=$X-8 S:%XX<0 %XX=0 S %XX1=%XX S:'$D(%YY) %YY=$Y S:%XX>72 %XX=72 S:%YY>24 %YY=24 S %YY1=%YY X %POSIC S %TO="" S %S="" I $D(%L1DS) S %S=$TR(%L1DS,"/.","") I $L(%S)>6 S %S=$E(%S,1,4)_$E(%S,7,8) D PD I %S'="" S %L1DAT=$$^%L1DC(%S,2),%L1DAT1=$$^%L1DC(%S,".") G:$D(%L1DATL)!($D(%L1GET)) END VDD X %POSIC D VV V0 I %S?." " S %S="",%L1DAT="",%L1DAT1="" D PD G END I '$D(%L1TM),%S'?6N&(%TO="END") S %S="" D PD G END S %DD=$E(%S,1,2),%MM=$E(%S,3,4),%HH=$E(%S,5,6) S %DD=$TR(%DD," ",0) I %DD>31!(%DD<1) W *7 G VDD S %MM=$TR(%MM," ",0) I %MM>12!(%MM<1) W *7 G VDD S %HH=$TR(%HH," ",0) S %L1DAT=%HH_%MM_%DD S %L1DAT1=%DD_"."_%MM_"."_%HH I '$$^%L1DC(%L1DAT1,3) D D PD G VDD .N %XX,%YY .W *7,*27,7 S %SAY=" ! miiw `l jix`z " X %XMSGV(1) W *27,8 K %HH,%MM,%DD G END ; VV N %I D USE S %I=1 N A,A1,%II N %ML S %ML=$S($D(%L1TM):4,1:6) VR ; S A="" I $G(%MOUSE),'$$KB^%L2MOUSE W *27,7 S A=$$^%L1NMB("") W *27,8 I A="ENTER" S A=13 G VR1 I $L(A),A?1N S A=$A(A) G VR1 .I $G(%TO)="DEL" S A=8,%TO="" I A="=" G ESC I $L(A),A?1U.E,$T(@A)'="" G @A I A="DEL" S A=8 G VR1 I $G(%MOUSE),'$$KB^%L2MOUSE G VR1 ; K %ZB R *A S %TO="" G:%TYPCRT="PC" VR1 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))'="" G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) ; VR1 I A=13,$L(%S)=%ML!(%S?." ") Q I A=13&$D(%L1TM) S %S=%S_$TR($J("",%ML-$L(%S))," ",0) Q I A=13&(%S?1N) S A=$A(%S),%S=0 W *8,0 G VM I A=13&(%S?3N) S A=$A($E(%S,3)),%S=$E(%S,1,2)_"0" W *8,0 G VM G:A=13 VR I A=127!(A=8) G:%S="" VV S A=32 G:%I'>$L(%S) VM D G VR .I $L(%S)=1 S %S="" W *8," ",*8 S %I=1 Q .S %S=$E(%S,1,%I-2) .I '(%I#2)!(%I>%ML) W *8," ",*8 .E W *8,*8," ",*8 .S %I=%I-1 I $L($ZB)>3,$D(%UPRCOD($ZB)),$T(@%UPRCOD($ZB))'="" G @$T(@%UPRCOD($ZB)) I A=0 R *A1:0 G:'$D(%UPRCOD(A_A1)) VR G:$T(@%UPRCOD(A_A1))="" VR G @(%UPRCOD(A_A1)) I A=20,$G(^zms($I))?1"^"."%"1U.E W *27,7 D ^%L1ZMST S $X=%XX,$Y=%YY G VV I A=25 G ESC READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) ; 27 I A=27 D DELAY R:'$D(%FLL) *A1:%WAIT G:A1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL) *A2:%WAIT Q:A2<0 S:A2>0 C=A1_A2 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *A3:%WAIT S:A3>0 C=C_A3 Q:A3<0 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *A4:%WAIT S:A4>0 C=C_A4 I A=27 G ESC ;;I A=27 S %ZB=$ZB R *A1:0 G:A1<0 ESC R *A2:0 S A2=A1_A2 I $D(%UPRCOD(A2)),$T(@%UPRCOD(A2))'="" G @(%UPRCOD(A2)) I A=61 G ESC I $G(%ZB)=27 G ESC I $D(%UPRCOD(A)),$T(@%UPRCOD(A))'="" G @(%UPRCOD(A)) I %I>%ML S A=13 G VR1 I A<48!(A>57) G VR VM S %S=$E(%S,1,%I-1)_$C(A)_$E(%S,%I+1,%ML) W $C(A) W:'(%I#2)&(%I<%ML) %pravo S %I=%I+1 G VR Q END K %L1DS X %XCL I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) K %L1NMB Q ESC R *A1:0 R *A1:0 I $D(%L1TM) S A=13,%TO="END" G VR1 I %S?6N!(%S?.P) S A=13,%TO="END" G VR1 I $L($TR(%S," ",""))<6 S A=13,%S="",%TO="END" G VR1 G VR DELL R *A1:0 R *A1:0 S %TO="F6" Q COR R *A1:0 R *A1:0 S %TO="F7" I $D(^r($J)),'$D(%L1CALL),'$D(%L1TM) D TV^P1HZGDAT("%S") S %TO="" S %S=$TR(%S,"/.","") D PD I '%S X "N %I F %I=1:1:8 W *8" G VV Q CHISTE R *A1:0 R *A1:0 S %TO="F2" D SAVE^%L3MBGG S %S=$$TV^%L1LUAH I '%S S %S="" D REST^%L3MBGG S %TO="" S:%S %S=$TR($$^%L1DC(%S,1),"/.","") D PD I '%S X "N %I F %I=1:1:8 W *8" G VV Q FIND R *A1:0 R *A1:0 S %TO="F8" Q SAVE R *A1:0 R *A1:0 S %TO="F9" Q REST R *A1:0 R *A1:0 S %TO="F10" Q ENDS R *A1:0 R *A1:0 S %TO="ENDS" Q PGUP R *A1:0 R *A1:0 S %TO="PGUP" Q PGDN R *A1:0 R *A1:0 S %TO="PGDW" Q PGLN R *A1:0 R *A1:0 S %TO="PGLN" Q PGRG R *A1:0 R *A1:0 S %TO="PGRG" Q BEGF R *A1:0 R *A1:0 S %TO="BEGF" Q ENDF R *A1:0 R *A1:0 S %TO="ENDF" Q MOD R *A1:0 R *A1:0 S %TO="DEL" Q HOME R *A1:0 R *A1:0 S %TO="HOME" Q INS R *A1:0 R *A1:0 S %TO="INS" Q TAB R *A1:0 R *A1:0 S %TO="TAB" Q TABN R *A1:0 R *A1:0 S %TO="TABN" Q IND S %TO="F4" D DELAY R *A1:0 R *A1:0 Q ADDL S %TO="F5" R *A1:0 R *A1:0 Q MVUP S %TO="MVUP" R *A1:0 R *A1:0 Q MVDW S %TO="MVDW" R *A1:0 R *A1:0 Q VNIZE ; I $G(^zms($I))?1"^"."%"1U.E W *27,7 K:%TYPCRT="PC" ^zms($P,"SCRN") D ^%L1ZMST S $X=%XX,$Y=%YY D PD G VDD PRSC ; D ^%L1PRSC G VDD SHIFT1 D PUT W *27,8 X:%I>1 "S %pn=%I-1 X %levon" D .N %BE S %BE="E" D PD G VDD PUT I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q PD ; I $D(^r($J)),'$D(%L1GET),'$D(%L1TM) D .N %XX,%YY D H^P1HZGDAT X %POSIC W %ENG,%CLI,$J($E(%S,1,2),2) X %XCL W "." W %ENG,%CLI,$J($E(%S,3,4),2) X %XCL W "." I $L($TR(%S,"./:"))<8 W %ENG,%CLI,$J($E(%S,5,6),2) Q W %ENG,%CLI,$J($E(%S,7,8),2) Q Q DELAY Q F %II=1:1:400 Q LEVO G:%I=1 VR S %I=%I-1 W *8 W:%I=2!(%I=4) *8 G VR PRAVO G:%I>%ML!(%I-1>$L(%S)) VR S %I=%I+1 W %pravo W:%I=3!(%I=5) %pravo G VR VVERX G:$L(%S)<%ML&$L(%S) VR S %TO="UP" G END VNIZ G:$L(%S)<%ML&($L(%S)) VR S %TO="DW" G END USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q %L1DBG %DEBUG ;BPS;INTERACTIVE DEBUGGING ROUTINE [ 04/25/98 10:38 AM ] [ 01/15/92 5:02 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1988 U 0 N %I,%IO,%X,%Y,%Z S $ZT="ZG "_$ZL_":ERROR^%L1DBG" MENU ;DISPLAY MENU MENU0 ; W !?10,$P($P($ZV,","),"-")," - Interactive Debugging Utility" MENU1 W !!,"Available options:",! F %I=0:1 S %Y=$P($T(TEXT+%I),";",2) Q:%Y="*" W !?4,%I+1," - ",%Y W !!,"Select option: " R %X G:%X="^Q" EXIT I %X=""!(%X="^") G EXIT I %X'?1N F %I=0:1 S %Y=$T(TEXT+%I) G:%Y["*" MENU2 I $ZB(%X,"_",1)=$E($ZB($P(%Y,";",2),"_",1),1,$L(%X)) W $E($P(%Y,";",2),$L(%X)+1,99) S %X=%I+1 Q S %Y=$T(TEXT+%X-1) G @($P(%Y,";",3)) MENU2 W:%X'="?" *7 W !!,"Enter the option number to select an option, or" W !,"Enter enough characters to identify the option, or" W !,"Enter '^' or '^Q' to exit the utility." G MENU1 ENABLE ;Enable Error and Ctrl-c Trapping D DBGIO G:%IO["^" MENU0 ZM 2:%IO V $V(280,$J,4,8)+112::1:2 ;errors V $V(280,$J,4,8)::1:2 ;V $V(280,$J,4,8)+128::1:2 ; ctrl-c ;V $V(280,$J,4,8)+64::1:2 ; line step W !!,"Debugging Environment Enabled" G EXIT DISABLE ;Disable Error Trapping W !!,"Debugging Environment Disabled" ZM 0:0 G EXIT RUN ;Interactively Debug a Routine S %Z=$ZT RUN1 ; R !!,"Enter Routine Name: ",%X G:%X=""!(%X="^") MENU0 I %X="?" W !!,"Enter the name of the routine to be debugged.",!,"You may enter a routine name, or line^routine.",!,"Enter '^' to return to the previous question, or",!,"Enter '^Q' to exit the utility" G RUN1 S %Y=$P($S(%X["^":$P(%X,"^",2),1:%X),"("),$ZT="ZG "_$ZL_":RUNER^%L1DBG" S:%X'["^" %X="^"_%X I '$D(^ (%Y)) W *7," ...Routine does not exist" S $ZT="ZG "_$ZL_":" G RUN1 X "S %Y=$T("_$P(%X,"(")_")" ;I $T(@%X)="" W *7," ...Line does not exist" S $ZT="ZG "_$ZL_":" G RUN1 I %Y="" W *7," ...Line does not exist" S $ZT="ZG "_$ZL_":" G RUN1 D DBGIO G:%IO["^" MENU0 I $V(280,$J,4) V $V(280,$J,4,8)+112::0:2 ZM 2:%IO S %I=$V(280,$J,4,8) V %I+752::$L(%X):1,%I+753::%X:$L(%X):1 S $ZT="ZG "_$ZL_":RUN2^%L1DBG" I 1/0 RUN2 ; N %X,%I S %I=$V(280,$J,4,8) S $ZT="ZG "_$ZL_":",$ZS="" V %I::#8001:2,%I+112::1:2 S %X=$V(%I+753,-3,$V(%I+752,-3,1),1) D BRKPT(0,$P(%X,"(")) I $F(%X,"(") D @($$RUNR^%L1DBG) Q G @$$RUNR^%L1DBG RUNR() N ZZ V %I+645::0:1 S ZZ=%X K %X,%I,%IO,%Y,%Z Q ZZ RUNER W *7," ...Invalid entry reference" G RUN1 BRKPT(B,T) ;set break point B to T N BP,CMD,ENT,DSP,ROUT,%BRKPT,E,A,D S D=$V(280,$J,4,8) I 'D U 0 W *7,!,"BRKPT^%L1DBG: Debugging Environment not Active ***",! Q S %BRKPT(+B)=T G BRKSET^%DEBUGI1 DBGIO ;Get debug device N %DT S %DT=$V(5,-5) IO1 W !,"Debug device <",$I,">: " R %IO I %IO=""!(%IO=$I)!(%IO=0) S %IO=0 Q I %IO["^" Q I %IO="?" W !,"Enter the terminal device number which will be used for",!,"controlling the debugger. All debugging prompts and" I W !,"error messages will be directed to this device. Note that",!,"this device will NOT be closed at the end of debugging." I G IO1 I %IO'?1.N W *7,!,"Device number must be numeric",! G IO1 I %IO=2!(%IO>19&(%IO<64))!((%IO>199)&(%IO<256)) W *7,!,"Invalid value...Terminal devices are 1,3-19,64-199,256 and up.",! G IO1 I $V(%IO*2+%DT,-3,2)#2 W *7," ...Device does not exist",! G IO1 O %IO::1 E W *7," ...Device is in use",! G IO1 Q HELP ;Display HELP text S %HELP="HELP1" W # D ^%DEBUGI2 G MENU EXIT ;Exit Interactive Debugger Q ERROR ; I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q TEXT ;Run a Program;RUN ;Enable Debugging Environment;ENABLE ;Disable Debugging Environment;DISABLE ;HELP Information;HELP ;* %L1DBGI %DEBUGI ;BPS;EXECUTION DEBUGGING AID;[ 07/01/91 10:32 AM ] [ 04/25/98 10:34 AM ] [ 07/01/91 10:32 AM ] [ 04/25/98 10:10 AM ] ;COPYRIGHT 1988 (C) MICRONETICS DESIGN CORP. W *7,!!,"Routine must be called at an entry point" Q ;Internal Execution Starts At +5 S %DEBUG02=$V(280,$J,4,8) V %DEBUG02+60::$ZA:4 U $V(%DEBUG02+10,-3,2):(::::#80040:#8800001) I $V(%DEBUG02+2,-3,1)=3 S %DEBUG02=$V(%DEBUG02+52),%DEBUG00=$V($V(%DEBUG02+12,-3,4),-3,$V(%DEBUG02+10,-3,2),9) D XEQ G:$T CONT I $V($V(280,$J,4,8)+14,-3,1)=12 W !," $ZSRROR=""",$ZS,"""" I $E($V(0,$J,2,3),11) W "Old Error Trapping Mode" I $V($V(280,$J,4,8)+14,-3,1)<20 D STACK^%DEBUGI1 LOOP ; D PNAME D PROMPT I $D(^%dbg($P,"B")) D CMD^%DEBUGI1 ; *** LEV D zr ;S:$G(zr)["^" z=$D(@zr) I %DEBUG00="" G RETURN S %DEBUG02=$E(%DEBUG00,1) I %DEBUG02="/" D CMD^%DEBUGI1 G LOOP:$D(%DEBUG00),RETURN G:%DEBUG02="q"!(%DEBUG02="Q") QUIT I $F("BCDEFGHIJKLNOPQRSUVWXZbcdefghijklnopqrsuvwxz",$E(%DEBUG00)) D XEQ G CONT:$T,LOOP W #,"Enter MUMPS command to be executed, or" S %HELP="HELP" D ^%DEBUGI2 ;W !,"Debugger command (/H for help), or" ;W !,"a null line to execute the next line or command, or" ;W !,"ZGO to continue execution until next breakpoint without stepping, or" ;W !,"Q to terminate execution",! ;W !!,"ENTER COMMAND TO BE EXECUTED" ;W !,"USE " W "ZGO OR " W "QUIT TO EXIT",! G LOOP QUIT D CLRSTEP B 2 S $ZT="ZG "_$ZL_":RETURN^%DEBUGI" ZM 0:0 I 1/0 ;FORCE AN ERROR TO ENTER TRAP CONT D CLRSTEP ;ENTERED FOR ZGO RETURN B -2 W:$X ! S %DEBUG02=$V($V(280,$J,4,8)+10,-3,2) U %DEBUG02:(:::::#80040),%DEBUG02:(::::$V($V(280,$J,4,8)+60,-3,4)) K %DEBUG00,%DEBUG02,^%dbg($P) ;*** LEV 10.07.94 D zr ;S:$G(zr)["^" z=$D(@zr) Q zr S:$G(zr)["^" z=$O(@zr) Q XEQ S $ZTRAP="XEQTRAP^%DEBUGI" N %DEBUG02 W ! X "K %DEBUG00 "_%DEBUG00,"U "_$V($V(280,$J,4,8)+10,-3,2) I $V($V(280,$J,4,8)+13,-3,1) Q Q XEQTRAP H:$ZS[" " I $ZB($V(DDB+23,-3,1),8,1) R X E F R X#1 I $ZB'=127 Q:X=""!(X=" ") R Y S X=X_Y Q:$ZB'=127 W:$L(X) $C(8,32,8) I X=" "!(X="/C") S X=1 E I $L(X) S %DEBUG00=X Q E S X=$ZB I X#256=27 S X=X\256,X=$S(X=32:1,1:2) E S X=$S(X=13:0,1:2) G PROMPT2 PROMPTE H:$ZS["9 W "<",$P($T(DBGCODE),";",CD-8),">" E W "" S ET=0 D PRINTLEV^%DEBUGI1 Q PRTCODE S IDX=$V(D+38,-3,2)+1 W ":",$V(D+32,-3,2),":",$V(D+34,-3,2) ;W ":",$V(XL+60,-3,2) W " " Q DBGCODE ;Break;Interrupt;Error;;;;;;;;LineStep;CmdStep %L1DBGI1 %DEBUGI1 ;BPS;EXECUTION DEBUGGING AID;[ 07/31/90 5:36 PM ] [ 04/25/98 10:35 AM ] [ 07/31/90 5:36 PM ] [ 04/25/98 10:07 AM ] ;COPYRIGHT 1988 (C) MICRONETICS DESIGN CORP. W *7,!!,"Routine must be called at an entry point" Q CMD ; N D,X S D=$V(280,$J,4,8),%DEBUG02=$E(%DEBUG00,2),X=$F("BCEHLRST",%DEBUG02)-1 I $D(^%dbg($P,"B")) D G BRKSET ;*** LEV .N N,N1,OK S N="" F S N=$O(^%dbg($P,"B",N)) Q:N="" D ..S OK=0 F N1=1:1:10 Q:$V(N1*48+D+160)=0 ..I N1<9 S %BRKPT(N1)=^(N)_":1;" K ^(N) .D ZR D ZR I X<0 S X=$F("bcehlrst",%DEBUG02)-1 G:X>0 @$P("BRK,CTR,ENVIRON,HELP,LTR,RET,STACK,TOG",",",X) W !,"** INVALID '/' COMMAND **" Q STACK ; Format the Execution Stack N D,XL,RL,LI,NA,LE,ET S D=$V(280,$J,4,8),XL=$V(D+16),ET=1 F LE=$V(D+22,-3,2):-1:0 W !,$J(LE,2),") " S RL=$V(XL+4) D PRINTLEV S XL=$V(XL) Q:XL=0 Q PRINTLEV ; S:$R'["%dbg" zr=$R D ZR I $V(XL+8,-3,1)=0 W "*XECUTE*" S NA=$V(XL+68,-3,4),LI=$V(XL+66,-3,2) G:'LI PRTLINE1 V D+42::LI:2,D+752::$V(NA,-3,LI,9)::9 G PRTLINE S NA=$V(XL+78,-3,2),LI="+"_$S(NA>0:NA,1:1),NA="^"_$V(RL+12,-3,$V(RL+11,-3,1),1) W LI,NA Q:NA="^" L ^%dbg:0 I U 0 S ^%dbg=$P_"^"_$$^%L1ZU(0),^%dbg($P)=LI_NA X "S LI=$P($T("_LI_NA_"),"" "",2,999)" D ZR V D+42::$L(LI):2,D+752::LI::9 PRTLINE ; V D+40::$V(XL+60,-3,2):2,D+3::1:1 ZM 3 S LI=$V(D+38,-3,2) W ":",$V(D+32,-3,2),":",$V(D+34,-3,2) W ":",$V(XL+60,-3,2),": " I LI=65535 W " " E W $V(D+752+LI+$S($ZB($V(0,-4,2),128,1):LI,1:0),-3,$V(D+42,-3,2)-LI,9) PRTLINE1 ; S LI=$V(XL+84,-3,1) I ET,LI W !," $ZTRAP=""",$V(XL+85+($ZB($V(0,-4,2),128,1)'=0),-3,LI,9),"""" Q BRK N BP,CMD,ENT,DSP,ROUT,%BRKPT,B,E,A,F S F=0 S E=$E(%DEBUG00,3,999) G:$L(E)=0 BRKDISPA I $E(E)="=" F B=1:1:9 Q:$V(B*48+D+160)=0 E I $E(E)?1N S B=+E,E=$E(E,2,999) E W *7,!,"Invalid Break Number" Q I $L(E)=0 D BRKDISP W:'F " ... Breakpoint not defined" Q I $E(E)'="=" W *7,!,"Invalid Syntax" Q I $L(E)>1 S %BRKPT(B)=$E(E,2,999) G BRKSET F R " EntryRef: ",ENT Q:ENT'="?" W !,"Specify a MUMPS entry reference; i.e. Label+no^routine",!,?20," or RETURN to delete current break point",! I ENT="" S %BRKPT(B)="" G BRKSET F R " Command Number: ",CMD Q:CMD'="?" W !,"Specify a relative command number in line; First command is number 1",! I CMD'="" S ENT=ENT_":"_CMD F R " Action: ",A Q:A'="?" W !,"Specify MUMPS code to be executed at the time the break point is reached",! I A'="" S:CMD="" ENT=ENT_":" S ENT=ENT_";"_A S %BRKPT(B)=ENT BRKSET F B=-1:0 D Q:B=-1 . S B=$N(%BRKPT(B)) Q:B=-1 I %BRKPT(B)="" V B*48+D+160::0:2 Q . S E=$P(%BRKPT(B),";",1),A=$P(%BRKPT(B),";",2) . I E["^" S ENT=$P(E,"^",1),ROUT=$P(E,"^",2),CMD=$P(ROUT,":",2),ROUT=$P(ROUT,":",1) . E S ENT=$P(E,":",1),CMD=$P(E,":",2),ROUT="" . S DSP=0 D BRKSET1 V D+3::2:1 ZM 3 ;RECOMPILE ALL BREAK POINTS F B=-1:0 D Q:B=-1 I E V BP::0:2 W !,"B",B,": *** ",$P("Routine,Line,Command",",",E)," not found ***" . S B=$N(%BRKPT(B)) Q:B=-1 S BP=B*48+D+160,E=0 Q:'$V(BP,-3,2) . I '$V(BP+40,-3,4) S E=1 Q . I '$V(BP+44,-3,2) S E=2 Q . ;I '$V(BP+46,-3,2) S E=3 Q . Q Q BRKSET1 I $F(ENT,"+") S DSP=$P(ENT,"+",2),ENT=$P(ENT,"+",1) S:ENT="" DSP=DSP-1 S BP=B*48+D+160 S:$L(ENT)>8 ENT=$E(ENT,1,8) S:$L(ROUT)>8 ROUT=$E(ROUT,1,8) S:$L(A)>272 A=$E(A,1,272) I ROUT="" S ROUT=$V($V(D+16)+4),ROUT=$V(ROUT+12,-3,$V(ROUT+11,-3,1),1) I ROUT="" W !,"*** No active routine ***" V BP::0:2 Q V BP+16::DSP:2,BP+18::$L(ENT):1,BP+19::ENT::1 S:CMD CMD=CMD-1 V BP+27::$L(ROUT):1,BP+28::ROUT::1,BP+36::CMD:2,BP+38::0:2 I $L(A) V BP::3:2,D+752::A::9,D+42::$L(A):2,D+52::BP:4:8,D+3::3:1 ZM 3 E V BP::1:2 ;NO ACTION STRING Q BRKDISPA F B=0:1:9 D BRKDISP ;F B=1:1:6 S BP=B-1*16+64+D D BRKMAIN I 'F W !,"*** No Break Points set ***" Q BRKDISP S BP=B*48+D+160 Q:$V(BP,-3,2)=0 I 'F S F=1 W !,"BrkPt = Entry point : Cmnd ; Action" W !," B",B," = " S E=$V(BP+18,-3,1),DSP=$V(BP+16,-3,2),A=$V(BP+27,-3,1),CMD=$V(BP+36,-3,2) I E W $V(BP+19,-3,E,1) W:DSP "+",DSP E W:DSP "+",DSP+1 W "^",$V(BP+28,-3,A,1) I CMD W ?28,": ",CMD+1 S A=$V(BP+10,-3,2) I A S E=$V(BP+12,-3,4) W ?35,"; ",$V(E,-3,A,9) Q BRKMAIN I $V(BP,-3,2) W $P("LS,CS,AR,ER,CT,BK",",",B),"=" E Q S A=$V(BP+10,-3,2) I A W ";",$V($V(BP+12,-3,4),-3,A) W ! Q TOG I $V(D+21,-3,1) V D+21::0:1,D+4::$V(D+8,-3,2):2 E V D+21::1:1,D+8::$V(D+4,-3,2):2,D+4::$V(D+22,-3,2):2 ;I $V(D+21,-3,1) V D+21::0:1,D+4::32767:2,D+8::32767:2 ;E V D+21::1:1,D+4::$V(D+22,-3,2):2,D+8::$V(D+22,-3,2):2 W ! G ENVSTEP LTR V D+64::1:2,D+80::0:2 Q CTR V D+80::1:2,D+64::0:2 Q HELP ;DISPLAY HELP INFORMATION S %HELP="HELP" W # D ^%DEBUGI2 Q RET V D+8::$V(D+4,-3,2):2,D+4::$V(D+22,-3,2)-1:2 ;,D+80::1:2,D+64::0:2 K %DEBUG00 Q ENVIRON ; N XL,FL,IO S XL=$V(D+16) W !,"SYSTEM VARIABLES: $TEST=",$V(D+20,-3,1)," $JOB=",$J," $PO=" S IO=$V(D+56,-3,2) W $S(IO:IO,1:$P)," $X=",$V(D+58,-3,1)," $Y=",$V(D+59,-3,1) W !?18,"$ZUCI(0)=",$ZUCI(0)," $ZSRROR=",$ZS W !?18,"$ZREFERENCE=",$R S IO=$V(D+645,-3,1) I IO W !?18,"Last GOTO from +",$V(D+654,-3,2),"^",$V(D+646,-3,IO,1) I $E($V(0,$J,2,3),11) W !?18,"Old Error Trapping Mode" ;I $V(D+64,-3,2) W !,"Line Step active" ;I $V(D+80,-3,2) W !,"Command Step active" W !,?18 ENVSTEP W "Step ",$S($V(D+21,-3,1):"Over",1:"Into")," mode" W ! Q ZR S:$G(zr)["^" z=$O(@zr) Q %L1DBGV %L1DBGV ; VIEW FOR %DEBUG [ 05/08/95 7:33 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C I '$D(^%dbg) S %SAY=" YOU ARE NOT INTO DEBUGGER" X %XMSGV(1) Q S PRT=+$G(^%dbg) I 'PRT S %SAY=" YOU ARE NOT INTO DEBUGGER" X %XMSGV(1) Q S %S=$P($G(^%dbg),"^",2) S %UI=$P(%S,","),%VG=$P(%S,",",2) I $ZU(%UI,%VG)'>0 W *7," ???" G Z S %UIN=$P($ZU(%UI,%VG),",") S %VGN=$P($ZU(%UI,%VG),",",2) V 2:$J:%VGN*32+%UIN:2 S PRT=+$G(^%dbg) I 'PRT S %SAY=" YOU ARE NOT INTO DEBUGGER" X %XMSGV(1) Q I '$D(^%dbg(PRT)) S %SAY=" YOU ARE NOT INTO DEBUGGER" X %XMSGV(1) Q S %RNAME=$P(^%dbg(PRT),"^",2),%S2V("LAB")=$P(^%dbg(PRT),"^") ;I $E(%S2V("LAB"))="+",%S2V("LAB")>1 S %S2V("LAB")="+"_(%S2V("LAB")-1) S %FLI=1,TXT1=" "_%RNAME_" " D M1^%L1RV Q %L1DBM3 %L1DMB3 ;JWC;MOUNT VOLUME GROUPS [ 10/03/93 11:08 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1990 ZF D PTRS^%VGUTIL,OS^%VGUTIL,DSK^%VGUTIL1:'OS,GETVG^%VGUTIL K %DEV D VGSLOT I QF W !,"No room to mount another volume group" Q I OS D GETHFS^%SDEV I '%DEV W *7,!!,"No HFS devices available..." K %DEV Q RETRY D HNAME Q:QF D VGNAME I QF ZU 0 W !,"Volume is not initialized",*7 G RETRY I $D(VG(VGNAME)) D QAGN G:QF=1 RETRY Q:QF I VIN W !,*7,"This is not a volume 0" G RETRY W !,"Mounting." S %VGI=VGIN D START Q:QF D MOUNT^TRANSLA1 W:VGIN "done." ;D DBMAINT^%SP Q START D GETVOLS I QF W !,"Error in finding volumes for this volume group",*7 Q D CHKVOLS I QF W !,"mounting aborted." Q D MTVOLS^%L3MOUNT,MOUNT,SETSAT^UMOUNT,SETUCI^%L3MOUNT S $ZS="" I $D(^ ("DDP")) S %ZT=$ZT,$ZT="ZG "_$ZL_":PLDER" D DBCHG^DDP S $ZT=%ZT PLDER I $ZS'="",'$F($ZS,"1 F I=1:1:VOLS-1 S VF=I-1*12+512+44,VG0N(I)=$V(VF,0,8,1),VG0M(I)=$V(VF+8,0,2) C:$D(%DEV) %DEV Q HNAME ; I $D(^%L1DBM3)#2 S (HNAME,X)=^%L1DBM3,QF=0 Q ;*** LEV W !!,"Enter ",$S(OS:"host file name",1:"disk address") R " for volume group: ",X S QF=0,HNAME=X I X="^Q"!(X="^q")!("^"[X) S QF=1 Q I HNAME?.E1C.E W !,"Invalid characters entered",*7 G HNAME I HNAME["?" W !!?3 W:'OS "Enter the hexadecimal address of the disk which" I W:OS "Enter the full name of the host operating system file which" I W !?3,"contains the first volume of the volume group to mount." I W:'OS !?3,"Enter '^L' for a list of accessible disks." I W !?3,"Enter '^' to return to the previous question." I W !?3,"Enter '^Q' to exit to the utility." G HNAME D CHKNAME G:QF HNAME Q CHKNAME ; S QF=0 G:'OS CHKNAME1 O %DEV:(HNAME:"R") U %DEV S ZA=$ZA ZU 0 C %DEV I ZA<0 W !,"File name ",HNAME," does not exist." S QF=1 Q O 63 O %DEV:(HNAME:"CBR") Q CHKNAME1 I HNAME="^L" S X="" W !,"Accessible disks are:",! I F I=0:1 S X=$O(%DSK(X)) Q:X="" W ?(I#10*8),X W:$X>70 ! I S QF=1 Q I '$D(%DSK(HNAME)) W !,"Disk ",HNAME," not available" S QF=1 Q Q QAGN ; I $D(^%L1DBM3("ALT")) S X=^%L1DBM3("ALT") G QAGNR ;*** LEV W !,"You have selected volume group '",VGNAME,"' which is already mounted" R !,"To continue mount, enter an alternate volume group name: ",X QAGNR ; I X="^L"!(X="^l") D VGLIST^%VGUTIL G QAGNX I X="^" S QF=1 Q I X="^Q" S QF=2 Q I X?3U S VGALT=X D HASH^%VGUTIL S $P(LABEL(0),"^",5)=Y,QF=0 Q W !," Each mounted volume group must have a unique 3 letter name." W !," Since the volume group you want to mount has the same name " W !," as one which is already mounted, you must give it a " W !," surrogate name which will be valid as long as it is mounted." W !," Enter '^L' to see a list of mounted volume groups." W !," Enter '^' to return to the previous question" W !," Enter '^Q' to exit the utility." QAGNX R !!,"Please enter an alternate volume group name: ",X G QAGNR VGSLOT S QF=1 F VGIN=1:1:7 S VGOF=$V(VGIN*4+VGTAB) Q:'VGOF I '$V(VGOF+4,-3,2) S QF=0 Q O63 O 63::2 E ZU 1 W *7,!,"*** %L1DBM3: DEVICE 63 IN USE ! " H 2 Q ;*** LEV %L1DC %L1DC(%L1DC,%N) ; DATA CONVERTION [ 19.09.21 08:22 ] [ 07.06.18 14:22 ] [ 12.02.18 15:26 ] ; %N=1 --- YYMMDD ---> DD.MM.YY ; %N=2 --- DD.MM.YY, DD/MM/YY, DDMMYY ---> YYMMDD ; %N=3 --- DD.MM.YY, DD/MM/YY, DDMMYY ---> $H ; %N=4 --- YYMMDD ---> $H ; %N=5 ----MM/DD/YY ---> YYMMDD ; %N=6 ----MM/DD/YY ---> DD.MM.YY ; %N="." --- DDMMYY ---> DD.MM.YY ; %N="/" --- DDMMYY ---> DD/MM/YY ; %N=7 --- DD.MM.YY, DD/MM/YY ---> DDMMYY ; %N=8 --- DD.MM.YY, DD/MM/YY ---> 1,2,3,4,5,6,7 ; %N=9 --- $H -> y,e,...,` ; %N=10 --- YYMM -> $H N %DS,%DN,%DD,%MM,%YY,N S %L1DC=$P($E(%L1DC,1,10)," ") I %L1DC?.P Q "?????" I %N=1,%L1DC?5N!(%L1DC?5N1","1N.N) S %L1DC=$ZD(%L1DC,"DD/MM/YY") I %N=1,$L(%L1DC,"/")>2!($L(%L1DC,".")>2) S %L1DC=$TR(%L1DC,"./",""),%L1DC=$E(%L1DC,1,2)_"."_$E(%L1DC,3,4)_"."_$$GG(%L1DC) Q %L1DC I %N=1,%L1DC?8N.N S %L1DC=$$^W4DTL(%L1DC) I %N=1 S %L1DC=$$GG(%L1DC)_"."_$E(%L1DC,3,4)_"."_$E(%L1DC,1,2) Q %L1DC I %N=2,%L1DC?5N!(%L1DC?5N1","1N.N) S %L1DC=$TR($ZD(%L1DC,"DD/MM/YY"),"./","") S %L1DC=$$GG(%L1DC)_$E(%L1DC,3,4)_$E(%L1DC,1,2) Q %L1DC I %N=2 D DOP S %L1DC=$TR(%L1DC,"/.","") S %L1DC=$$GG(%L1DC)_$E(%L1DC,3,4)_$E(%L1DC,1,2) Q %L1DC I %N=3 Q:$P(%L1DC,",")?5N %L1DC D DOP D DI S:$G(%ER) %N=9 Q $G(%DN,"?????") I %N=4 Q:$P(%L1DC,",")?5N %L1DC S:%L1DC?8N %L1DC=$E(%L1DC,3,8) Q:%L1DC'?6N "?????" S %L1DC=$E(%L1DC,5,6)_$E(%L1DC,3,4)_$E(%L1DC,1,2) D DOP D DI S:$G(%ER) %N=9 Q $G(%DN,"?????") I %N=5 S %L1DC=$$GG(%L1DC)_$TR($J($P(%L1DC,"/",1),2)," ",0)_$TR($J($P(%L1DC,"/",2),2)," ",0) Q %L1DC I %N=6 S %L1DC=$TR($J($P(%L1DC,"/",2),2)," ",0)_"."_$TR($J($P(%L1DC,"/",1),2)," ",0)_"."_$$GG(%L1DC) Q %L1DC I %N="." D DOP S %L1DC=$TR(%L1DC,"/.",""),%L1DC=$E(%L1DC,1,2)_"."_$E(%L1DC,3,4)_"."_$$GG(%L1DC) Q %L1DC I %N="/" D DOP S %L1DC=$TR(%L1DC,"/.",""),%L1DC=$E(%L1DC,1,2)_"/"_$E(%L1DC,3,4)_"/"_$$GG(%L1DC) Q %L1DC I %N=7 S %L1DC=$E(%L1DC,1,2)_$E(%L1DC,4,5)_$E(%L1DC,7,8) Q %L1DC I $E(%N,1,2)="1+"!($E(%N,1,2)="2+") D COMP($P(%N,"+"),$P(%N,"+",2),"+") Q %L1DC I $E(%N,1,2)="1-"!($E(%N,1,2)="2-") D COMP($P(%N,"-"),$P(%N,"-",2),"-") Q %L1DC I %N=8 N %D S %D=$$^%L1DC(%L1DC,3) Q:'%D 0 S %D=(%D-55022#7) S:'%D %D=7 Q %D I %N=9 S:%L1DC["."!(%L1DC["/") %L1DC=$$%L1DC(%L1DC,3) S %D=(%L1DC-55022#7) S:'%D %D=7 Q $E("`abcdey",%D) I %N=10 Q $$%L1DC(%L1DC_"01",4) Q 0 DOP N %DD,%MM,%YY DOP1 I %L1DC'["."&(%L1DC'["/") S %L1DC=$TR($J(%L1DC,6)," ",0),%DD=$E(%L1DC,1,2),%MM=$E(%L1DC,3,4),%YY=$$GG(%L1DC) I %L1DC["." S %DD=$P(%L1DC,"."),%MM=$P(%L1DC,".",2),%YY=$P(%L1DC,".",3) I %L1DC["/" S %DD=$P(%L1DC,"/"),%MM=$P(%L1DC,"/",2),%YY=$P(%L1DC,"/",3) S %DD=$TR($J(%DD,2)," ",0),%MM=$TR($J(%MM,2)," ",0),%YY=$TR($J(%YY,2)," ",0) I $L(%YY)=4 S %YY=$E(%YY,3,4) EDOP S %L1DC=%DD_%MM_%YY S %DS=%MM_"/"_%DD_"/"_$S($L(%YY)=4:%YY,%YY<50:"20"_%YY,1:"19"_%YY) Q ; COMP(%N,%N1,%SGN) ; N %OLDDC S %OLDDC=%L1DC I %N1="M" D DOP1 D G ECOMP .I %SGN="+" D ..I %MM=12 S %L1DC=%DD_"/"_"01"_"/"_$$YR(%YY+1) Q ..S %L1DC=%DD_"/"_$TR($J(%MM+1,2)," ",0)_"/"_$$YR(%YY) .I %SGN="-" D ..I +%MM=1 S %YY=$S('%YY:99,1:%YY-1) S %L1DC=%DD_"/"_"12"_"/"_$$YR(%YY) Q ..S %L1DC=%DD_"/"_$TR($J(%MM-1,2)," ",0)_"/"_$$YR(%YY) I %SGN="-" S %N1=-%N1 S %L1DC=$$%L1DC(%L1DC,$S($E(%L1DC,1,2)>31!(%OLDDC?6N&(%N=2)&($$GG(%L1DC)<32)):4,1:3)) I %L1DC S %L1DC=$ZD(%L1DC+%N1,"DD/MM/YY"),%L1DC=$P(%L1DC,"/",1,2)_"/"_$$YR($P(%L1DC,"/",3)) ECOMP I %N=2 S %L1DC=$E(%L1DC,7,8)_$E(%L1DC,4,5)_$E(%L1DC,1,2) Q YR(%Y) Q $TR($J(%Y#100,2)," ",0) GG(%DC) ; I $P(%DC,"/",3)?4N Q $E($P(%DC,"/",3),3,4) I $P(%DC,"/",3)?2N Q $P(%DC,"/",3) I $P(%DC,".",3)?4N Q $E($P(%DC,".",3),3,4) I $P(%DC,".",3)?2N Q $P(%DC,".",3) I %DC?5N!(%DC?5N1","1N.N) Q $$GG($ZD(%DC,"DD/MM/YY")) I %DC?8N Q $E(%DC,7,8) Q $E(%DC,5,6) YYMM(D) Q $E($$^%L1DC(D,2),1,4) MM(D) Q $E($$YYMM(D),3,4) FM(D) ; Q $$%L1DC($$YYMM(D)_"01",4) LM(D) ; N DD S DD=31 LM1 ; I $$%L1DC($$YYMM(D)_DD,4) Q $$%L1DC($$YYMM(D)_DD,4) I DD<28 Q "" S DD=DD-1 G LM1 ; LMM(D) ; N DD S DD=31 LMM1 ; I $$%L1DC($$YYMM(D)_DD,4) Q DD S DD=DD-1 G LMM1 ; DI ; N yy,mm,dd s mm=$p(%DS,"/") s dd=$P(%DS,"/",2) s yy=$P(%DS,"/",3) i $l(yy)<3 s yy=yy+$S(yy<50:2000,1:1900) i dd>$s(+mm'=2:$e(303232332323,mm)+28,yy#4:28,yy#100:29,yy#400:28,1:29) q n cc,dat s dat=yy-1841,mm=mm-1,cc=1 i dat<0 s dd=dd-1,cc=-1 s dat=dat\4*1461+(dat#4-$s(dat'<0:0,1:4)*365)+(mm*30)+$e(10112234455,mm)+dd-(yy-1800\100-(yy-1600\400)) i yy#4,mm>1 s dat=dat-cc i yy#100=0,mm<2,yy#400 s dat=dat+cc s %DN=dat q ; NEXTM(%L1DC,STEP) ; N DAT,DD,MM,YY,DD1,MM1,YY1,I S:'$G(STEP) STEP=1 S I=STEP+1 S DAT=%L1DC I +DAT?5N S DAT=$$%L1DC(DAT,1) S DD=$E(DAT,1,2) S MM=$E(DAT,4,5) S YY=$E(DAT,7,8) S MM1=$S(MM+I-1<13:$TR($J(MM+I-1,2)," ",0),1:$TR($J(MM+I-1.1#12+.1,2)," ",0)) S YY1=$S(MM+I-1<13:YY,1:YY+((MM+I-1.1)\12)) S DD1=DD I DD=29,+MM1=2 S DD1=28 N DTPR S DTPR=DD1_"."_MM1_"."_YY1 Q DTPR ; DECD(NUM) ; S NUM=NUM-1344444976117 N H1 S H1=NUM\(3600*24) N H2 S H2=NUM-(H1*3600*24) Q H1_","_H2 ; EPOH2D(%L1DC) ; N (%L1DC) S EPTM=%L1DC S YYSC=31556926 S MMSC=2629743 S DDSC=86400 S HRSC=3600 S MNSC=60 S EPYY=1970 S MILSEC=1000 S GMTOFFST=7200 ; JERUSALEM GMT+2HR S EPTM=EPTM/1000+GMTOFFST S CURYY=EPTM/YYSC\1+EPYY S CURMM=EPTM#YYSC\MMSC+1 S CURDD=EPTM#MMSC\DDSC+1 S CURHR=EPTM#DDSC\HRSC+1 S CURMN=EPTM#HRSC\MNSC F I="CURDD","CURMM","CURHR","CURMN" S @I=$TR($J(@I,2)," ",0) Q CURDD_"/"_CURMM_"/"_CURYY_" "_CURHR_":"_CURMN ; EPOH2T(%L1DC) ; N (%L1DC) S EP=%L1DC\1000 S CMD="date -d @"_EP_" +'%d/%m/%Y %R'" S EPCNV="epoh2dt" S DAT="" O EPCNV:(command=CMD:readonly)::"PIPE" U EPCNV R DAT C EPCNV Q DAT %L1DEFW0 ; [ 27.06.08 09:29 ] [ 10.10.07 15:40 ] [ %L1DEFWS ; [ 21.03.07 08:48 ] [ 05.02.07 16:42 ] [ 30.09.06 19:02 ] H .1 N FL,A,GLD,N,JOB,ID,TNMB D ^%L1CLJOB S GLD=$$^%L1GLD ; ZSY "wsstat" S FL="wsstat.log" I $$^%L1ZOS(10,FL)<0 Q O FL K ^devi20($J) M ^devi20($J)=^[GLD]devi2 K ^[GLD]devi1,^[GLD]devi2 F U FL R A Q:$ZEOF D .N DEV S DEV="/dev/"_$P(A," ") .S ^[GLD]devi1(DEV)=$P(A," ",2) ; $P -> IP .I $L($P(A," ",2)) D ..S ^[GLD]devi2($P(A," ",2))=DEV ; IP -> $P ; I $P'="",$D(^zcmd($P)) D .N A,N S A=$G(^($P)) Q:A="" .S N="" F S N=$O(^[GLD]devi2(N)) Q:N="" I ^(N)=$P K ^(N) .S ^[GLD]devi2(A)=$P ; N N CL C FL ;;S N="",PR=0 F S N=$O(^devi20($J,N)) Q:N="" I ^(N)'=$G(^[GLD]devi2(N)) S PR=1 ; ;;I PR S N="" F S N=$O(^[GLD]dev(N)) Q:N="" D .S DV=$G(^(N)) Q:DV="" .I $G(^%TYPCRT(N))'["PC" Q .I DV["/pts/" K ^[GLD]devi(DV) ; S N="" F S N=$O(^[GLD]devi3(N)) Q:N="" D .S NM=$G(^(N)) Q:NM="" .S DV=$G(^[GLD]devi2(N)) Q:DV="" .;;I $G(^%TYPCRT(NM))'["PC" Q .S ^[GLD]dev(NM)=DV .S ^[GLD]devi(DV)=NM .S N1="" F S N1=$O(^[GLD]devi(N1)) Q:N1="" I N1'=DV,$G(^(N1))=NM K ^(N1) ; K ^devi20($J) Q TV(STAM) ; N FL,A S FL="/tmp/info/HOSTNAME" I '$$SIZE^%L1ZOS(FL) Q "?" O FL:(EXC="G CL1") U FL R A CL1 C FL Q A %L1DEFWS ; [ 23.02.09 14:45 ] [ 19.02.09 14:01 ] [ 09.07.08 12:21 ] %L1DEFWS ; [ 21.03.07 08:48 ] [ 05.02.07 16:42 ] [ 30.09.06 19:02 ] H .1 N FL,A,GLD,N,JOB,ID,TNMB D ^%L1CLJOB S GLD=$$^%L1GLD ; F I=1:1:3 Q:'$D(^FLWSSTAT) H 1 S ^FLWSSTAT=$P ZSY "/pos/sbin/wsstat" H 1 S FL="/usr/local/mumps/wsstat.log" I $$^%L1ZOS(10,FL)<0 Q O FL K ^devi20($J) M ^devi20($J)=^[GLD]devi2 K ^[GLD]devi1,^[GLD]devi2 F U FL R A Q:$ZEOF D .N DEV S DEV="/dev/"_$P(A," ") .S ^[GLD]devi1(DEV)=$P(A," ",2) ; $P -> IP .;;K ^[GLD]zcmd(DEV) .N N S N="" F S N=$O(^[GLD]devi(N)) Q:N="" D ; *** LEV 08/07/08 ..I N'=DEV,^(N)=$P(A," ",2) K ^[GLD]devi(N) .I $L($P(A," ",2)) D ..S ^[GLD]devi2($P(A," ",2))=DEV ; IP -> $P ..S N="" F S N=$O(^[GLD]devi2(N)) Q:N="" D ; *** LEV 08/07/08 ...I N'=$P(A," ",2),^(N)=DEV K ^[GLD]devi2(N) ; ; I $P'="",$D(^zcmd($P)) D .N A,N S A=$G(^($P)) Q:A="" .S N="" F S N=$O(^[GLD]devi2(N)) Q:N="" I ^(N)=$P K ^(N) .S ^[GLD]devi2(A)=$P .S ^[GLD]devi1($P)=A ; N N CL C FL ;;S N="",PR=0 F S N=$O(^devi20($J,N)) Q:N="" I ^(N)'=$G(^[GLD]devi2(N)) S PR=1 ; ;;I PR S N="" F S N=$O(^[GLD]dev(N)) Q:N="" D .S DV=$G(^(N)) Q:DV="" .I $G(^%TYPCRT(N))'["PC" Q .I DV["/pts/" K ^[GLD]devi(DV) ; S N="" F S N=$O(^[GLD]devi3(N)) Q:N="" D .S NM=$G(^(N)) Q:NM="" ; NM ---- NOMER MASOFA .S DV=$G(^[GLD]devi2(N)) Q:DV="" ; --- $P .;;I $G(^%TYPCRT(NM))'["PC" Q .S ^[GLD]dev(NM)=DV .S ^[GLD]devi(DV)=NM .S N1="" F S N1=$O(^[GLD]devi(N1)) Q:N1="" D ..I N1'=DV,$G(^(N1))=NM K ^(N1) .S N1="" F S N1=$O(^[GLD]dev(N1)) Q:N1="" D ..I N1'=NM,$G(^(N1))=DV K ^(N1) ; K ^devi20($J) K ^FLWSSTAT Q TV(STAM) ; N FL,A S FL="/tmp/info/HOSTNAME" I '$$SIZE^%L1ZOS(FL) Q "?" O FL:(EXC="G CL1") U FL R A CL1 C FL Q A %L1DEV %L1DEV ; [ 23.11.06 17:15 ] [ 27.06.06 17:23 ] [ 13.02.06 16:06 ] S %SCRN="L1DEV" K ^P1HZMS(%L3MYDVN) K ^TEMP($P) S GLD=$$^%L1GLD S N="" F S N=$O(^[GLD]%TYPCRT(N)) Q:N="" I 'N S N1=+$G(^[GLD]devi(N)) S ^[GLD]%TYPCRT(N1)=^[GLD]%TYPCRT(N) K ^[GLD]%TYPCRT(N) S N="" F S N=$O(^[GLD]%CVET(N)) Q:N="" I 'N S N1=+$G(^[GLD]devi(N)) S ^[GLD]%CVET(N1)=^[GLD]%CVET(N) K ^[GLD]%CVET(N) S N="",I=0 F S N=$O(^[GLD]dev(N)) Q:N="" D .N P,CEVA,TYPC,SHIFT,N1 .S P=$G(^[GLD]dev(N)) .S CEVA=$G(^[GLD]%CVET(N)) .S TYPC="" I $L(P) S TYPC=$G(^[GLD]%TYPCRT(N)) .S SHIFT=$G(^[GLD]SMXY(N)) .S N1=N I $E(N,1,4)="TERM" Q .S I=I+1,^TEMP($P,I)=N1_"\"_P_"\"_$G(^[GLD]dev(N,"H"))_"\"_TYPC_"\"_CEVA_"\"_SHIFT SC D ^%L1SC D IS3^%L1GET I %S=1 G SC I %S=0 G END ; S N="" F S N=$O(^[GLD]dev(N)) Q:N="" D .I $E(N,1,4)'="TERM" K ^[GLD]dev(N) S N="" F S N=$O(^[GLD]devi(N)) Q:N="" D .I N'?1N.N K ^[GLD]devi(N) ; F I=1:1 Q:'$D(^TEMP($P,I)) D .S A=$G(^(I)) Q:A="" S N=$P(A,"\") Q:'N .S SHEM=$$SPA^%L1FRM($P(A,"\",2)) Q:SHEM?.P I SHEM'["/",'SHEM S SHEM="/dev/"_SHEM .S ^[GLD]dev(N)=SHEM .S ^[GLD]dev(N,"H")=$P(A,"\",3) .S ^[GLD]devi(SHEM)=N .K ^[GLD]%TYPCRT(N) I $P(A,"\",4)'?.P S ^[GLD]%TYPCRT(N)=$P(A,"\",4) .K ^[GLD]%CVET(N) I $P(A,"\",5)'?.P S ^[GLD]%CVET(N)=$P(A,"\",5) .K ^[GLD]SMXY(N) I $P(A,"\",6) S ^[GLD]SMXY(N)=$P(A,"\",6) END K ^TEMP($P) Q %L1DEV0 %L1DEV ; [ 09.07.06 12:08 ] [ 13.02.06 16:06 ] [ 25.02.05 12:11 ] S %SCRN="L1DEV" K ^TEMP($P) S GLD=$$^%L1GLD S N="" F S N=$O(^[GLD]%TYPCRT(N)) Q:N="" I 'N S N1=+$G(^[GLD]devi(N)) S ^[GLD]%TYPCRT(N1)=^[GLD]%TYPCRT(N) K ^[GLD]%TYPCRT(N) S N="" F S N=$O(^[GLD]%CVET(N)) Q:N="" I 'N S N1=+$G(^[GLD]devi(N)) S ^[GLD]%CVET(N1)=^[GLD]%CVET(N) K ^[GLD]%CVET(N) S N="",I=0 F S N=$O(^[GLD]dev(N)) Q:N="" D .N P,CEVA,TYPC,SHIFT,N1 .S P=$G(^[GLD]dev(N)) .S CEVA=$G(^[GLD]%CVET(N)) .S TYPC="" I $L(P) S TYPC=$G(^[GLD]%TYPCRT(N)) .S SHIFT=$G(^[GLD]SMXY(N)) .S N1=N I $E(N,1,4)="TERM" Q .S I=I+1,^TEMP($P,I)=N1_"\"_P_"\"_$G(^[GLD]dev(N,"H"))_"\"_TYPC_"\"_CEVA_"\"_SHIFT SC D ^%L1SC D IS3^%L1GET I %S=1 G SC I %S=0 G END K ^[GLD]dev,^[GLD]devi F I=1:1 Q:'$D(^TEMP($P,I)) D .S A=$G(^(I)) Q:A="" S N=$P(A,"\") Q:'N .S SHEM=$$SPA^%L1FRM($P(A,"\",2)) Q:SHEM?.P I SHEM'["/",'SHEM S SHEM="/dev/"_SHEM .S ^[GLD]dev(N)=SHEM .S ^[GLD]dev(N,"H")=$P(A,"\",3) .S ^[GLD]devi(SHEM)=N .K ^[GLD]%TYPCRT(N) I $P(A,"\",4)'?.P S ^[GLD]%TYPCRT(N)=$P(A,"\",4) .K ^[GLD]%CVET(N) I $P(A,"\",5)'?.P S ^[GLD]%CVET(N)=$P(A,"\",5) .K ^[GLD]SMXY(N) I $P(A,"\",6) S ^[GLD]SMXY(N)=$P(A,"\",6) END K ^TEMP($P) Q %L1DG %L1DG ; DIAGRAMMA UNIVERSALI ; SHEER ; 23/09/93 [ 25.02.05 12:16 ] [ 28.03.04 11:35 ] [ 02.04.01 9:08 AM ] N (MM1,YY1,TOT,%L1DG,%UPRCOD,%XMSGV,%XMSG,%XMSGN) D ^%L1C S %HBRY="" ; %L1DG("Y") - EDINICA IZMERENIA PO Y ; %L1DG("X1") - EDINICA IZMERENIA PO X ; %L1DG("X2") - EDINICA IZMERENIA PO X ; %L1DG("SHEM") - NAZVANIE GRAFIKA ; %L1DG("DATE") - DATE ; %L1DG("SHIR") - SHIRINA EDINICY PO X ; %L1DG("KOL") - KOLICHESTVO %L1DG("SHIR")*%L1DG("KOL")'>62 ; %L1DG("TIP") - TIP GRAFIKA 1 - MESAC PO DNAM, 2 - GOD PO MESACAM ; 3 - DEN PO CHASAM , 4 - MESSYC PO NEDELJAM ; %L1DG("RAZ") - IF $G(%L1DG("RAZ")) BYDET PROBEL MEGDU GRAFAMI ; %L1DG("HELP") - HELP NA 25 STROKE ; TOT(IND) - LOKAL NETYNIM GDE IND NUMBER PO X ; IF %L1DG("TIP")=1 --- %L1DG("DATE"),%L1DG("SHEM"),MM1,YY1 ; IF %L1DG("TIP")=2!3 --- %L1DG("DATE"),%L1DG("SHEM") ; ELSE --- %L1DG("Y"),%L1DG("X1"),%L1DG("X2"),%L1DG("SHEM"),%L1DG("DATE") ; %L1DG("SHIR"),%L1DG("KOL") S %L1DG("TIP")=$G(%L1DG("TIP"),0),%L1DG("Y")=$TR($TR($G(%L1DG("Y"),"g''y"),%TES1,%TES2),%TEN,%THB) S %L1DG("RAZ")=$S($G(%L1DG("RAZ")):1,1:0) 0 ; I '$D(TOT) W *7,!!?30," mipezp oi` " H 1 W *7 H 1 W *27,"[2K" G END I '$D(TOT) S %SAY=" mipezp oi` " X %XMSGN(1) G END S IND=$O(TOT("")),MAX=TOT(IND) F S IND=$O(TOT(IND)) Q:IND="" I TOT(IND)>MAX S MAX=TOT(IND) S TYP=$S(%TYPCRT["PC":1,1:0) I TYP S VRT=$C(180),HRZ=$C(196),UGOL=$C(192),DA=$C(219),BB=$C(223),NIZ=$C(220),MIN=$C(205),MINUS=$C(220) E S VRT=$C(117),HRZ=$C(113),UGOL=$C(109),DA=$C(97),BB=$C(111),NIZ=$C(113),MIN=$C(112),MINUS=$C(115) S MASH=1,ELEF="" S MAX=MAX/20 S:MAX>1000 MAX=MAX/1000,ELEF=$TR($TR("sl` ",%TES1,%TES2),%TEN,%THB) I MAX>100 S MAX=MAX/100,MASH=100 ;S MASH=MASH*$S(MAX>3:MAX+$S(MAX#5=0:0,1:5)\5*5,MAX>2:3,MAX>1:2,1:1),MSH=MASH*$S(ELEF="":1,1:1000) S MASH=MASH*$S(MAX>3:MAX+$S(MAX#10=0:0,1:10)\10*10,MAX>2:3,MAX>1:2,1:1),MSH=MASH*$S(ELEF="":1,1:1000) S XXX="",SAX="" F S XXX=$O(TOT(XXX)) Q:XXX="" S SAX=SAX+TOT(XXX) S SAX=$J(SAX,0,2) ; --- I ELEF["sl`" S SAX=$J(SAX/1000,0,3) F I=4:1:23 S LIN(I)=%CV("YF")_$J(I-3*MASH,6)_%CV("WF")_" "_VRT S LIN(3)=$J(UGOL,8) S LIN(1)=$J(" ",8)_$G(%L1DG("X1")),LIN(2)=$J(" ",8)_$G(%L1DG("X2")) 1 I %L1DG("TIP")=1 S %L1DG("KOL")=31,%L1DG("SHIR")=2 D .S DAY=$$^%L1DC("01/"_MM1_"/"_YY1,8) S DAY=DAY*2 .S LIN(1)=$J("",9)_$TR($TR($E(" ` a b c d e y ` a b c d e y ` a b c d e y ` a b c d e y ` a b c d e y ` a b",%TES1,%TES2),%TEN,%THB),DAY,DAY+61) .S LIN(1)=LIN(1)_$TR($TR(" -- mei",%TES1,%TES2),%TEN,%THB) .S LIN(2)=$J(" ",8) F I=1:1:31 S LIN(2)=LIN(2)_$J(I#10,2) .S LIN(2)=LIN(2)_$TR($TR(" -- jix`z",%TES1,%TES2),%TEN,%THB) 2 I %L1DG("TIP")=2 S %L1DG("KOL")=12,%L1DG("SHIR")=5 D .S LIN(2)=$J(" ",6) F I=1:1:12 S LIN(2)=LIN(2)_$J(I,5) .S LIN(2)=LIN(2)_$TR($TR(" --- yceg",%TES1,%TES2),%TEN,%THB) .S LIN(1)=$J(" ",8)_$TR($TR(" epi xat uxn xt` i`n ipei ilei be` htq we` aep nvc ",%TES1,%TES2),%TEN,%THB) 3 I %L1DG("TIP")=3 S %L1DG("KOL")=24,%L1DG("SHIR")=3 D .S LIN(2)=$J($TR($TR("zery ",%TES1,%TES2),%TEN,%THB),7) F I=0:1:23 S LIN(2)=LIN(2)_$J(I,2)_" " .S LIN(1)="" 4 I %L1DG("TIP")=4 S %WK=$$^%L1WEEK(YY1,MM1) D .S %L1DG("KOL")=$L(%WK,","),%L1DG("SHIR")=8,%L1DG("RAZ")=1 .S LIN(1)="" .S LIN(2)=$J(" ",8) .F I=1:1:%L1DG("KOL") S LIN(2)=LIN(2)_$J($P(%WK,",",I),7)_" " .S LIN(2)=LIN(2)_$TR($TR(" : zereay",%TES1,%TES2),%TEN,%THB) ; ; --- S LIN(24)=" "_%L1DG("Y")_" "_ELEF_SAX_$J(%L1DG("SHEM"),40)_$J(%L1DG("DATE"),60-$L($J(%L1DG("SHEM"),40))) S LIN(24)=" "_%L1DG("Y")_$J(ELEF,5)_%CV("RF")_$J($TR($TR(%L1DG("SHEM"),%TES1,%TES2),%TEN,%THB),40)_$J(%L1DG("DATE"),60-$L($J(%L1DG("SHEM"),40))) I $D(%L1DG("HELPCOM")) X "S %L1DG(""HELP"")="_$TR($TR(%L1DG("HELPCOM"),%TES1,%TES2),%TEN,%THB) G L1 S %L1DG("HELP")=$S($G(%L1DG("HELP"))="":$J("",50),1:"("_$G(%L1DG("HELP"))_") ")_%CV("WF")_" "_SAX_" : "_%L1DG("Y")_" k""dq++24,72,HH,,,C" L1 F I=1:1:%L1DG("KOL") S TOT(0)=$G(TOT(I))/MSH S TOT=$J($G(TOT(I))/MSH+.5*2,0,0)/2 D .S CVET=%CV("CF") .S:TOT(0) LIN(3)=LIN(3)_CVET D S:'%L1DG("RAZ") LIN(3)=LIN(3)_%CV("WF") ..F XX=1:1:%L1DG("SHIR") S LIN(3)=LIN(3)_$S(TOT>1:$S(TYP:BB,1:HRZ),TOT=1:BB,TOT(0)>0:MIN,$G(TOT(I))<0:MINUS,1:HRZ) S:%L1DG("RAZ")&(XX=%L1DG("SHIR")) $E(LIN(3),$L(LIN(3)))=%CV("WF")_HRZ .I TOT<0 X "F LIN=4:1:23 F XX=1:1:%L1DG(""SHIR"") S LIN(LIN)=LIN(LIN)_""-""" Q .I TOT<1 G T .F LIN=4:1:TOT+2 D ..S CVET=%CV("CF") I $D(TOT(I))>1,LIN>(TOT(I,1)/MSH+3) I TOT(I)'=TOT(I,1) S CVET=%CV("RF") ;---- CEVA AHER ..S LIN(LIN)=LIN(LIN)_CVET D S LIN(LIN)=LIN(LIN)_%CV("WF") ...F XX=1:1:%L1DG("SHIR") S LIN(LIN)=LIN(LIN)_DA S:%L1DG("RAZ")&(XX=%L1DG("SHIR")) $E(LIN(LIN),$L(LIN(LIN)))=" " .S TOP=TOT\1+3 .S LIN(TOP)=LIN(TOP)_CVET D S LIN(TOP)=LIN(TOP)_%CV("WF") ..F XX=1:1:%L1DG("SHIR") S LIN(TOP)=LIN(TOP)_$S(TOT#1=0:"-",1:NIZ) I %L1DG("RAZ")&(XX=%L1DG("SHIR"))&(TOT#1) S $E(LIN(TOP),$L(LIN(TOP)))=" " T .F LIN=TOT\1+4:1:23 F XX=1:1:%L1DG("SHIR") S LIN(LIN)=LIN(LIN)_"-" S SHIR=%L1DG("KOL")*%L1DG("SHIR") I SHIR<71 S LIN(3)=LIN(3)_$TR($J(" ",71-SHIR)," ",HRZ)_">" PRINT ; W %HBR X %chista U $P:(NOECHO:NOWRAP) I %TYPCRT["VT" W *27,"(B" X %LIGHT W %CV("CF"),LIN(24) W %CL0 ;W *27,"(0" W ! F I=23:-1:3 D:%TYPCRT["PC" W:%TYPCRT["VT" LIN(I) W ! I %TYPCRT["VT" W *27,"(0" W ! F I=23:-1:3 W LIN(I) W ! .F I1=1:1:$L(LIN(I)) S SMB=$E(LIN(I),I1) W $S(SMB="-":$C(27,91)_"37;2m"_"-"_$C(27,91)_"1m",1:SMB) I %TYPCRT["VT" W *27,"(B" W %CV("YF") S $X=0 W LIN(2),!,LIN(1) S J=0 K ^GRPH($J) F I=24:-1:1 S J=J+1 S LN=LIN(I) S ^GRPH($J,J)=$$TR(LN) S %SAY=%L1DG("HELP") X %XMSG S ^GRPH($J,$O(^GRPH($J,999),-1)+1)=$J("",6)_$$TR($P(%L1DG("HELP"),"++")) X %XCL I '$$HZGTOUCH^%L2MOUSE W $C(27,91,63,50,53,108) R R#1 W $C(27,91,63,50,53,104) I $$HZGTOUCH^%L2MOUSE D .S MTXT("B")=%CV("MB") .S MTXT(1,1)="d`ivi" .S MTXT(1,1,"TO")="END" .I $$KB^%L2MOUSE S MTXT(1,1,"I")="ESC" .S Y0=4,Y2=5,X0=73,X2=79 .S COLX=$O(MTXT(1,20),-1),COLY=1,SH=1 .S STEPX=6,STEPY=2,%PREV="" .D TV^P1RBUA S %S="" ; S %GET=" 99 - qitcdl " D N^%L1GET I %S=99 D .S %DEV="USTR" D OPEN^%L1LPT Q:%EROP .U USTR D ^%L1TS .N %AT,ST S %AT=$$^%L1HEAD("") I $L(%AT) S ST=%L1OUT("MDP","B")_$$CENTRB^%L1FRM($TR($TR(%AT,"#_",""),TS0,TSS),%L1OUT("MDP","GWPC"))_%L1OUT("MDP","N") W $TR(ST,TS0,TSS),!! .W ! F J=1:1 Q:'$D(^GRPH($J,J)) W $TR(^(J),TS0,TSS),! .D CLOSE^%L1LPT END K %L1DG Q ; --- ,TOT Q TR(LN) ; N N S N="" F S N=$O(%CV(N)) Q:N="" S LN=$$RPL^%L1FRM(LN,%CV(N),"") I 'TYP,J>1,J<23 S LN=$TR(LN,$C(117,113,109,97,111,113,112,115),$C(180,196,109,219,223,220,205,220)) Q LN %L1DIAL %L1DIAL(PORT,PHONE) ; [ 24.11.05 09:40 ] [ 01.02.04 13:41 ] [ 08.08.03 16:32 ] [ D DELLOCK^%L2MOUSE($G(@$$^W4DEV@(PORT))) ZSY "/etc/ppp/ppp-on "_PHONE_" "_^[$$^%L1GLD]dev(PORT) U $P W !!,$S($ZSY:"ERROR "_$ZSY,1:"CONNECTION ESTABLISHED") Q OFF ZSY "/etc/ppp/ppp-off" U $P W !!,$S($ZSY:"ERROR "_$ZSY,1:"CONNECTION CLOSED") Q %L1DIR %L1DIR ; SAVE UCI STATUS TO FILE '#DIR' [ 05/23/99 5:05 PM ] [ 10/17/93 11:22 AM ] GO O 63::0 E U 0 W *7,!,"VIEW BUFFER BUSY, TRY AGAIN LATER" Q D GETVG^%VGUTIL S VGTAB=$V(10,-5) S $ZT="ZG "_$ZL_":ERR^%L1DIR" O 51:("#DIR":"A"):1 E U 0 W *7,!," DEVICE 51 BUSY " Q U 51 W !!,?5,$P($P($ZV,","),"-")," UCI Status",?$X+5,$ZD($H),?$X+5 D ^%T W !! F VGI=0:1:VG-1 D DISPUCI I VGI=(VG-1) D LEG EXIT ; C 63,51 K VGTAB,VGI,VG Q ;ASK SYSTEM NAME IF APPROPRIATE DISPUCI ;DISPLAY UCITABLE IN ONE VOLUME GROUP D GETVOL^%VGUTIL S VGTAB=$V(10,-5) K UCICNT S UCICNT=0 F X=1:1:$V(12,-4,2) I $ZU(X,VGI)'="" S UCICNT(X)="",UCICNT=UCICNT+1 ST W !,"Volume group index : ",VGI W !,"Volume group name : ",$V($V(VGI*4+VGTAB),-3,3,1),! I 'UCICNT W !,"No UCIs defined.",! Q S UCTB=$V($V(VGI*4+VGTAB)+20) ;GET UCI TABLE S T(0)=0,T(1)=7,T(2)=13,T(3)=24,T(4)=35,T(5)=46,T(6)=57,T(7)=68,T(8)=80 W !,?T(0),"UCI",?T(1),"UCI",?T(2),"Global",?T(3),"Routine",?T(4),"Rtn Exp/",?T(5),"Data Exp/",?T(6),"Ptr exp/",?T(7),"Jrnl stat/" W !,?T(0),"Index",?T(1),"Name",?T(2),"Directory",?T(3),"Directory",?T(4),"Exp Lim",?T(5),"Exp Lim",?T(6),"Exp Lim",?T(7),"Pword/Lib" W ! F I=0:1:7 W ?T(I),$E("--------------",1,T(I+1)-T(I)-2) LOOP F UCI=1:1:$V(12,-4,2) D:$D(UCICNT(UCI)) PRINT Q LEG W !!,"Legend:" W !,"Directories are given as actual block numbers.",!,"Expansion pointers are expressed as Map numbers." K UCICNT,UCTB,T,UCI,UCSTA,UC,X Q PRINT ; S UCSTA=UCI-1*32+UCTB,UC(1)=$V(UCSTA,-3,2),X=UC(1) D UNHASH^%VGUTIL S UC(1)=X ;UNHASH NAME S UC(2)=$V(UCSTA+4,-3,4),UC(3)=$V(UCSTA+8,-3,4) F UC=4:1:9 S UC(UC)=$V(UCSTA+$P(";;;20;16;12;22;18;14",";",UC),-3,2) S UC(10)=$S($V(UCSTA+30,-3,1)\128:"YES",1:"NO") S UC(11)=$V(UCSTA+24,-3,3,1) S:UC(11)=$C(0,0,0) UC(11)="" S UC(12)=$V(UCSTA+31,-3,1) W !,?T(0),$J(UCI,3),?T(1),UC(1) S CHG=UC(2) D CONV S UC(2)=CON W ?T(2),UC(2) ;gdir S CHG=UC(3) D CONV S UC(3)=CON W ?T(3),UC(3) ;rdir PEXP W ?T(4),UC(4)+1 ;rtn exp W ?T(4),"/" I UC(7)<#FFFF W UC(7)+1 ;rtn exp limit E W "NONE" W ?T(5),UC(5)+1 ;gdat exp W ?T(5),"/" I UC(8)<#FFFF W UC(8)+1 ;gdat exp limit E W "NONE" W ?T(6),UC(6)+1 ;gptr exp W ?T(6),"/" I UC(9)<#FFFF W UC(9)+1 ;gptr exp limit E W "NONE" W ?T(7),UC(10) ;journaling W ?T(7),"/",UC(11),"/",UC(12),! Q CONV F VOLN=0:1:VGVOL-1 Q:CHG<$P(VGVOL(VOLN),"^",2) I CHG<$P(VGVOL(VOLN),"^",2) S VCC=VOLN-1 E S VCC=VOLN S XX(1)=VCC,XX(2)=CHG-$P(VGVOL(VCC),"^",2)-1 K VOLN,VCC S CON=XX(1)_":"_(XX(2)+1) Q ERR ; I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q I ; O 63::0 E U 0 W *7,!,"VIEW BUFFER BUSY, TRY AGAIN LATER" Q D GETVG^%VGUTIL S VGTAB=$V(10,-5) S $ZT="ZG "_$ZL_":ERR^%L1DIR" O 51:("#DIR1":"A"):1 E U 0 W *7,!," DEVICE 51 BUSY " Q U 51 W !!,$$^%L1DC($H,1),!! F VGI=0 D .D GETVOL^%VGUTIL S VGTAB=$V(10,-5),MGR=$$^%L1ZU(0) .K UCICNT S UCICNT=0 F X=1:1:$V(12,-4,2) I $ZU(X,VGI)'="" S UCICNT(X)="",UCICNT=UCICNT+1 .S N="" F S N=$O(UCICNT(N)) Q:N="" D ..V 2:$J:N:2,108:$J:42000:4 ..S N1="^" F S N1=$O(@N1) Q:N1="" S N1="^"_N1 W !,$ZU(N)," ",N1,$J("",10-$L(N1)),$ZBN(@N1) ..V 2:$J:+$ZU("MGR"):2,108:$J:60000:4 C 51 Q %L1DISP %L1DISP(USTR) ; [ 13.01.06 11:05 ] [ I USTR=0!(USTR=$P) Q 1 Q 0 %L1DOS %L1DOS(%CMD,%PATH,%OUT,%TR) ; [ 03.10.06 13:42 ] [ 28.09.06 10:50 ] [ 17.05.06 15:51 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%CMD,%PATH,%OUT,%TR) D ^%L1C S PATHDOS=$$PATH S %NMF0=PATHDOS_"l1dos"_$j S %NMF=PATHDOS_"l1"_$j_".bat" S %NMF1="l1"_$j_".bat" ; S DOSEMU="/usr/local/bin/dosemu.bin" I $$^%L1ZOS(10,DOSEMU)<0 S DOSEMU="/usr/bin/dosemu.bin" I $$^%L1ZOS(2,%NMF0) O %NMF0:(WRITE:NEWVERSION) U %NMF0 W "#!/bin/bash -f",!! S %ST=DOSEMU_" -k -D -a -E "_%NMF1 I $L($G(%OUT)) S %ST=%ST_" > "_%OUT I '$L($G(%OUT)),%TYPCRT["VT",$G(%TR)'="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r %L1FLTR" I '$L($G(%OUT)),%TYPCRT["VT",$G(%TR)="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r TV^%L1FLTR" W %ST,! C %NMF0 I $$^%L1ZOS(2,%NMF) O %NMF:(WRITE:NEWVERSION) U %NMF I $L($G(%PATH)),%PATH'["/" W "CD "_%PATH,! I %CMD[".BAT"!(%CMD[".bat") W "call "_%CMD,! E W %CMD,! W "exitemu",! C %NMF ZSY "unix2dos "_%NMF I $$TERMINAL^%HOSTCMD(%NMF0) I $$^%L1ZOS(2,%NMF0) I $$^%L1ZOS(2,%NMF) Q PATH(STAM) ; N PATHDOS I $D(^PATHDOS) S PATHDOS=$G(^PATHDOS) G PATH1 S PATHDOS=$G(^[$$^%L1GLD]PL("PATHM")) S PATHDOS=$P(PATHDOS,"/",1,$L(PATHDOS,"/")-2) PATH1 I PATHDOS="" S PATHDOS="/root/dosemu/freedos" I $E(PATHDOS,$L(PATHDOS))'="/" S PATHDOS=PATHDOS_"/" I '$D(^PATHDOS) S ^PATHDOS=PATHDOS Q PATHDOS %L1DOS1 %L1DOS(%CMD,%PATH,%OUT,%TR) ; [ 03.10.06 13:40 ] [ 28.09.06 10:50 ] [ 17.05.06 15:51 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%CMD,%PATH,%OUT,%TR) D ^%L1C S PATHDOS=$$PATH S %NMF0=PATHDOS_"l1dos"_$j S %NMF=PATHDOS_"l1"_$j_".bat" S %NMF1="l1"_$j_".bat" ; S DOSEMU="/usr/local/bin/dosemu.bin" I $$^%L1ZOS(10,DOSEMU)<0 S DOSEMU="/usr/bin/dosemu.bin" I $$^%L1ZOS(2,%NMF0) O %NMF0:(WRITE:NEWVERSION) U %NMF0 W "#!/bin/bash -f",!! ;;w "/usr/local/bin/dosemu.bin -k -D -a -I 'keystroke "" "_%NMF1_"\r"" '",! S %ST=DOSEMU_" -k -D -a -E "_%NMF1 ;;W "#!/bin/bash",!! ;;S %ST="/usr/local/bin/dosemu.bin -I 'dosbanner off' quite -E "_%NMF1 I $L($G(%OUT)) S %ST=%ST_" > "_%OUT I '$L($G(%OUT)),%TYPCRT["VT",$G(%TR)'="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r %L1FLTR" I '$L($G(%OUT)),%TYPCRT["VT",$G(%TR)="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r TV^%L1FLTR" W %ST,! C %NMF0 I $$^%L1ZOS(2,%NMF) O %NMF:(WRITE:NEWVERSION) U %NMF I $L($G(%PATH)),%PATH'["/" W "CD "_%PATH,! I %CMD[".BAT"!(%CMD[".bat") W "call "_%CMD,! E W %CMD,! W "exitemu",! C %NMF ZSY "unix2dos "_%NMF I $$TERMINAL^%HOSTCMD(%NMF0) I $$^%L1ZOS(2,%NMF0) I $$^%L1ZOS(2,%NMF) Q PATH(STAM) ; N PATHDOS I $D(^PATHDOS) S PATHDOS=$G(^PATHDOS) G PATH1 S PATHDOS=$G(^[$$^%L1GLD]PL("PATHM")) S PATHDOS=$P(PATHDOS,"/",1,$L(PATHDOS,"/")-2) PATH1 I PATHDOS="" S PATHDOS="/root/dosemu/freedos" I $E(PATHDOS,$L(PATHDOS))'="/" S PATHDOS=PATHDOS_"/" I '$D(^PATHDOS) S ^PATHDOS=PATHDOS Q PATHDOS %L1DPRO %L1DPRO ; KILL GLOBAL PROTECTION [ 06/05/96 7:48 AM ] N (%RNAME,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%Z,%S2V) D ^%L1C S $ZT="ZG "_$ZL_":ER" ; [ 06/05/96 7:35 AM ] Z W !,"UCI:" S (%S,%UCIOLD)=$$^%L1ZU(0),%LS=7 S %UIO=$P(%UCIOLD,","),%VGO=$P(%UCIOLD,",",2) S %UION=$P($ZU(%UIO,%VGO),",") S %VGON=$P($ZU(%UIO,%VGO),",",2) D ^%ZMSL Q:%S=""!($G(%TO)="END") S %UI=$P(%S,","),%VG=$P(%S,",",2) I $ZU(%UI,%VG)'>0 W *7," ???" G Z S %UIN=$P($ZU(%UI,%VG),",") S %VGN=$P($ZU(%UI,%VG),",",2) M W !!,"GLOBAL NAME :^" S %LS=8,%S="" D ^%ZMSL S %GNAME=%S Q:%GNAME=""!($G(%TO)="END") I %GNAME'?."%"1U.U.N W *7 G M S %GLB="["_%UI_","_%VG_"]"_%GNAME B S %STAT="4,4,4,4" D ^%L1GCH G M ER Q %L1DVR16 %L1DVR16 ;BFH;RESET XOFF FLAG FOR ANY PORT [ 10/28/01 3:30 PM ] [ 01/15/95 06:26 PM ] ;Copyright Micronetics Design Corp. @1990 N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1RCV,PORT) D LOOKUP I 'QF D RESET Q D banner^%UTL("Port Reset Utility") I $ZB($V(0,-4,2),#F,1)'=8 W !,"Not available for this version of MSM" Q NEW S $ZT="ZG "_$ZL_":ERR^DEVRESET" DEV ; R !!,"Port number: ",PORT Q:PORT="" I PORT="?" W !," Enter a port number or '^L' for list of available ports" G DEV I PORT="^L" D LIST G DEV D LOOKUP I QF W ! DO G DEV .I QF=1 W "Port does not exist" Q .I QF=2 W "Device not defined in internal configuration table" Q .I QF=3 W "Device not installed in this system" Q .I QF=4 W "Not available for MCC devices" Q .I QF=5 W "Not available for the console" Q D DISPLAY D RESET I DEV?1"SPARN".E W !,"xoff state reset to normal" E W !,"Port reset, I/O buffers cleared." ;W !,"Flags on after reset:" ;D DISPLAY G DEV LOOKUP ; Find device and offset for patch ; This is used as an entry point by KILLJOB ; PORT must be defined S QF=0 S CONFIG=+^|"MGR"|SYS("CONFIG",$P(^|"MGR"|SYS("CONFIG"),";",2)) I '$D(^|"MGR"|SYS(CONFIG,"DDB",PORT)) S QF=1 Q S DEV=$P(^(PORT),",",2) S CPU386=($V(0,-4,2)\#100#16=5) S CNFG=$V(18,-5),DEVLST=$V(CNFG+8,-3,4) F DI=DEVLST:12 Q:$V(DI,-3,1)=0 G:DEV=$P($V(DI,-3,8,1),$C(0)) LOOKUP1 S QF=2 Q LOOKUP1 ; S DI=$V(DI+8,-3,4) I DI=0 S QF=3 Q I DEV?1"MCC"2N S QF=4 Q I DEV="CON" S QF=5 Q S OFFSET=$S(CPU386:14,1:12) S IOBUF=$S(CPU386:64,1:50) Q LIST ; S CONFIG=+^|"MGR"|SYS("CONFIG",$P(^|"MGR"|SYS("CONFIG"),";",2)) W !!,"Ports defined for configuration ",$P(^|"MGR"|SYS("CONFIG"),";",2),! S X="" F S X=$O(^|"MGR"|SYS(CONFIG,"DDB",X)) Q:X="" W !,X,?8,$P(^(X),",",2) Q RESET ; Reset the port ; Used as an entry point by KILLJOB I DEV?1"SPARN".E G SMART ; turn off 2,4 V DI+OFFSET::$ZB($V(DI+OFFSET,-3,1),#F9,1):1 F X=IOBUF,IOBUF+2 V DI+X+1::$V(DI+X,-3,1):1 ; clear ring buffers ZU PORT W $C(0) U 0 EXIT Q ERR I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT Q 0 Q 1 SMART ; V 40:$J:$ZB($V(40,$J,2),#10,7):2 ; disable view check for shmem address >1MB NEW (DI,CPU386,PORT,OFFSET) S DI=$V($V(4*PORT+$V(7,-5),-3,0)+76,-3,0) S PN=$V(DI+$S(CPU386:17,1:15),-3,1) S X=$V(DI+$S(CPU386:18,1:16),-3,4) S WINDBASE=$ZH($ZH($V(X+$S(CPU386:28,1:26),-3,2))_"0000") V 44:$J:$ZB($V(44,$J,2),#1,7):2 S OUTQUE=$V(WINDBASE+8,-3,2)+WINDBASE S OUTOLD=$V(WINDBASE+#0E,-3,2) S quesize=$V(WINDBASE+2,-3,2),message=$C(51,PN,1,+#FF) S remain=quesize-OUTOLD I remain<4 V OUTQUE+OUTOLD::$E(message,1,remain):remain:1,OUTQUE::$E(message,remain+1,4):4-remain:1,WINDBASE+#0E::4-remain:2 G skip V OUTQUE+OUTOLD::$C(51,PN,1,+#FF):4:1 I remain=4 V WINDBASE+#0E::0:2 E V WINDBASE+#0E::$V(WINDBASE+#0E,-3,2)+4:2 skip S OFFSET=$S(CPU386:14,1:12) V 44:$J:$ZB($V(44,$J,2),#1,2):2 V 40:$J:$ZB($V(40,$J,2),#10,2):2 ; enable view check Q DISPLAY ; W ?25,"DI-BLOCK AT: ",$ZH(DI),! W !,"Current port flags:" S X=$V(DI+OFFSET,-3,1) I 'X W !?3,"no flags set" I $ZB(X,1,1) W !?3,"waiting on output" I $ZB(X,2,1) W !?3,"output busy" I $ZB(X,4,1) W !?3,"xoff state" I $ZB(X,8,1) W !?3,"control-o state" I $ZB(X,#10,1) W !?3,"waiting on input" I $ZB(X,#20,1) W !?3,"interrupt routine echo" I $ZB(X,#40,1) W !?3,"read abort" I $ZB(X,#80,1) W !?3,"xoff sent" W ! Q %L1DVR8 %L1DVR8 ; DEVRESET 4.0.* [ 19.07.01 8:37 AM ] [ 05.07.01 3:14 PM ] [ 13.11.00 9:33 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1RCV,PORT) D LOOKUP I 'QF D RESET Q LOOKUP ; Find device and offset for patch ; This is used as an entry point by KILLJOB ; PORT must be defined S QF=0 S CONFIG=+^["MGR"]SYS("CONFIG",$P(^["MGR"]SYS("CONFIG"),";",2)) I '$D(^["MGR"]SYS(CONFIG,"DDB",PORT)) S QF=1 Q S DEV=$P(^(PORT),",",2) S CPU386=($V(0,-4,2)\#100#16=5) S CNFG=$V(18,-5),DEVLST=$V(CNFG+8,-3,4) F DI=DEVLST:12 Q:$V(DI,-3,1)=0 G:DEV=$P($V(DI,-3,8,1),$C(0)) LOOKUP1 S QF=2 Q LOOKUP1 ; S DI=$V(DI+8,-3,4) I DI=0 S QF=3 Q I DEV?1"MCC"2N S QF=4 Q I DEV="CON" S QF=5 Q S OFFSET=$S(CPU386:14,1:12) S IOBUF=$S(CPU386:64,1:50) Q RESET ; Reset the port ; Used as an entry point by KILLJOB I DEV?1"SPARN".E G SMART ; turn off 2,4 V DI+OFFSET::$ZB($V(DI+OFFSET,-3,1),#F9,1):1 F X=IOBUF,IOBUF+2 V DI+X+1::$V(DI+X,-3,1):1 ; clear ring buffers ZU PORT W $C(0) I '$D(%L1RCV) ZU 0 EXIT Q ERR I $F($ZS,""),'$D(%L1RCV) ZU 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q SMART ; V 40:$J:$ZB($V(40,$J,2),16,7):2 ; disable view check NEW (DI,CPU386,PORT,OFFSET) S DDBTAB=$V(7,-5) S DI=$V($V(PORT*4+DDBTAB)+76) S PN=$V(DI+$S(CPU386:17,1:15),-3,1) S X=$V(DI+$S(CPU386:18,1:16),-3,4) S WINDBASE=$ZH($ZH($V(X+$S(CPU386:28,1:26),-3,2))_"0000") V 44:$J:$ZB($V(44,$J,2),1,7):2 S OUTQUE=$V(WINDBASE+8,-3,2)+WINDBASE S OUTOLD=$V(WINDBASE+#0E,-3,2) S quesize=$V(WINDBASE+2,-3,2),message=$C(51,PN,1,+#FF) S remain=quesize-OUTOLD I remain<4 V OUTQUE+OUTOLD::$E(message,1,remain):remain:1,OUTQUE::$E(message,remain+1,4):4-remain:1,WINDBASE+#0E::4-remain:2 G skip V OUTQUE+OUTOLD::$C(51,PN,1,+#FF):4:1 I remain=4 V WINDBASE+#0E::0:2 E V WINDBASE+#0E::$V(WINDBASE+#0E,-3,2)+4:2 skip S OFFSET=$S(CPU386:14,1:12) V 44:$J:$ZB($V(44,$J,2),1,2):2 V 40:$J:$ZB($V(40,$J,2),16,2):2 ; reenable view check Q %L1DVRES %L1DVRES(PORT) ; DEVICE RESET ; [ 28.10.01 4:41 PM ] [ 13.11.00 9:33 AM ] [ 13.07.00 4:12 PM ] Q I $ZV["4.0" D ^%L1DVR8 Q I $ZV["4.4" D ^%L1DVR16 Q Q %L1ED %L1ED ; [ 28.12.23 17:57 ] [ 18.05.05 11:05 ] [ 28.02.05 20:37 ] N L1EDZDIR S L1EDZDIR=$ZDIR N %L1DIR I $L($G(%NAM)) S %S=%NAM D:%S'="$"&(%S'="-") RED1(%S) D ERG G END CYC F S %NONAME=0 D RED Q:%NONAME END S $ZDIR=L1EDZDIR Q ; RED U $P W ! S %GET="ROUTINE NAME :++24,2,EE,,,C#++8,E,I" D ^%L1GET I %S=""!(%TO="END") S %NONAME=1 Q I %S="-"!(%S="$") G ERG D RED1(%S) ERG K ^S222($J) M ^S222($J)=^S000($P) I '$D(%NAM) K U,L,R u $P s $ZT="",%TIP="R" d ^%S2ERG S $ZT="" X %chista K %Q S %Q("Z")=" SAVE ",%Q("X")=1,%Q("Y")=0 D ^%S1ASK I 'YES G ERED ERGN S %GET="NAME :++0,20,EE#"_$P($TR($ZPARSE($G(%PR),"NAME"),"_","%"),".")_"++8,E,I" D ^%L1GET Q:%S="" S %PROG=%S s %PR=$TR(%S,"%","_")_".m" I $L($G(%L1DIR)) S %PR=%L1DIR_%PR S %CMM=$P(^S000($P,1)," ;",2,90) D S %CMM=$P(%CMM," [ ")_" [ "_$ZD($H,"DD.MM.YY 24:60")_" ] [ "_$P(%CMM,"[ ",2+%DFR,3+%DFR) S ^(1)=$P($G(^S000($P,1))," ;")_" ;"_%CMM .S %DFR=0 S %DTOLD=$P($P(%CMM,"[ ",2)," ",1) I $$^%L1DC($H,1)=%DTOLD S %DFR=1 S $ZT="g WNOOPEN" o %PR:(newversion) s $ZT="" f I=1:1 q:'$D(^S000($P,I)) u %PR w $$STW(^(I)),! c %PR u $P K ^UTILITY($J),^TMPS111($J) M ^UTILITY($J,1,"[ NEW ]")=^S000($P) M ^UTILITY($J,2,"[ OLD ]")=^S222($J) S ^UTILITY($J,1)="[ NEW ]" S ^UTILITY($J,2)="[ OLD ]" D ^%L2RCMP S DIR=$ZGBLDIR I %L1DIR="/usr/local/mumps/" S DIR="/usr/local/mumps/mumps.gld" M ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=^TMPS111($J) S ^[DIR]%ERGS(+$H,%PROG)=$$^%L1ZU(0) W !,"COMMENT :",! S %S="" D ^%ZMSL S ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=%S S ^[DIR]%ERGS(+$H,%PROG)=$ZROU W ! ZLINK %PR ERED k ^S000($P),^TMPS111($J),^S222($J) Q RNOOPEN U $P W *7," NO PROGRAMM ! " q WNOOPEN U $P W *7," ERROR !" G ERGN ; RED1(%S) s %PR=$TR(%S,"%","_")_".m" K ^S000($P) S $ZT="g RNOOPEN" S %L1DIR=$$DIR(%PR) I $L(%L1DIR) D .I $E(%L1DIR,$L(%L1DIR))'="/" S %L1DIR=%L1DIR_"/" .S %PR=%L1DIR_%PR c %PR o %PR:(readonly:record=2048:rewind) S $ZT="g REOF" N I,X S I=0 f u %PR r X S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") REOF ; c %PR Q DIR(%PR) ; N %DIR S %DIR="" I '$$EXIST^%L1ZOS(%PR) D .N OK S OK=0 .F ND=1:1:$L($ZROU," ") D Q:OK ..N ZD S ZD=$P($ZROU," ",ND) I $E(ZD,$L(ZD))'="/" S ZD=ZD_"/" ..I $$EXIST^%L1ZOS(ZD_%PR) S %DIR=ZD,OK=1 Q Q %DIR ; STW(ST) N ST0,J,SMB S ST0="" F J=1:1:$L(ST) D .S SMB=$E(ST,J) .I $A(SMB)>127&($A(SMB)<155) S SMB=$C($A(SMB)-32) ;;,SMB=$TR(SMB,%TES2,%TES1) .S ST0=ST0_SMB Q ST0 %L1ED0 %L1ED ; [ 18.05.05 11:05 ] [ 28.02.05 20:37 ] [ 08.08.03 11:02 ] ; V1 N L1EDZDIR S L1EDZDIR=$ZDIR N %L1DIR I $L($G(%NAM)) S %S=%NAM D:%S'="$"&(%S'="-") RED1(%S) D ERG G END CYC F S %NONAME=0 D RED Q:%NONAME END S $ZDIR=L1EDZDIR Q ; RED U $P W ! S %GET="ROUTINE NAME :++24,2,EE,,,C#++8,E,I" D ^%L1GET I %S=""!(%TO="END") S %NONAME=1 Q I %S="-"!(%S="$") G ERG D RED1(%S) ERG K ^S222($J) M ^S222($J)=^S000($P) I '$D(%NAM) K U,L,R u $P s $ZT="",%TIP="R" d ^%S2ERG S $ZT="" X %chista K %Q S %Q("Z")=" SAVE ",%Q("X")=1,%Q("Y")=0 D ^%S1ASK I 'YES G ERED ERGN S %GET="NAME :++0,20,EE#"_$P($TR($ZPARSE($G(%PR),"NAME"),"_","%"),".")_"++8,E,I" D ^%L1GET Q:%S="" S %PROG=%S s %PR=$TR(%S,"%","_")_".m" I $L($G(%L1DIR)) S %PR=%L1DIR_%PR S %CMM=$P(^S000($P,1)," ;",2,90) D S %CMM=$P(%CMM," [ ")_" [ "_$ZD($H,"DD.MM.YY 24:60")_" ] [ "_$P(%CMM,"[ ",2+%DFR,3+%DFR) S ^(1)=$P($G(^S000($P,1))," ;")_" ;"_%CMM .S %DFR=0 S %DTOLD=$P($P(%CMM,"[ ",2)," ",1) I $$^%L1DC($H,1)=%DTOLD S %DFR=1 S $ZT="g WNOOPEN" o %PR:(newversion) s $ZT="" f I=1:1 q:'$D(^S000($P,I)) u %PR w $$STW(^(I)),! c %PR u $P K ^UTILITY($J),^TMPS111($J) M ^UTILITY($J,1,"[ NEW ]")=^S000($P) M ^UTILITY($J,2,"[ OLD ]")=^S222($J) S ^UTILITY($J,1)="[ NEW ]" S ^UTILITY($J,2)="[ OLD ]" D ^%L2RCMP S DIR=$ZGBLDIR I %L1DIR="/usr/local/mumps/" S DIR="/usr/local/mumps/mumps.gld" M ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=^TMPS111($J) S ^[DIR]%ERGS(+$H,%PROG)=$$^%L1ZU(0) W !,"COMMENT :",! S %S="" D ^%ZMSL S ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=%S S ^[DIR]%ERGS(+$H,%PROG)=$ZROU W ! ZLINK %PR ERED k ^S000($P),^TMPS111($J),^S222($J) Q RNOOPEN U $P W *7," NO PROGRAMM ! " q WNOOPEN U $P W *7," ERROR !" G ERGN ; RED1(%S) s %PR=$TR(%S,"%","_")_".m" K ^S000($P) S $ZT="g RNOOPEN" S %L1DIR=$$DIR(%PR) I $L(%L1DIR) D .I $E(%L1DIR,$L(%L1DIR))'="/" S %L1DIR=%L1DIR_"/" .S %PR=%L1DIR_%PR c %PR o %PR:(readonly:record=2048:rewind) S $ZT="g REOF" N I,X S I=0 f u %PR r X S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") REOF ; c %PR Q DIR(%PR) ; N %DIR S %DIR="" I '$$EXIST^%L1ZOS(%PR) D .N OK S OK=0 .F ND=1:1:$L($ZROU," ") D Q:OK ..N ZD S ZD=$P($ZROU," ",ND) I $E(ZD,$L(ZD))'="/" S ZD=ZD_"/" ..I $$EXIST^%L1ZOS(ZD_%PR) S %DIR=ZD,OK=1 Q Q %DIR ; STW(ST) N ST0,J,SMB S ST0="" F J=1:1:$L(ST) D .S SMB=$E(ST,J) .I $A(SMB)>127&($A(SMB)<155) S SMB=$C($A(SMB)-32) .S ST0=ST0_SMB Q ST0 %L1ENVAR %L1ENVAR(%VAR) ; [ 05.06.10 20:12 ] [ 06.06.06 07:31 ] [ 17.05.06 15:52 ] Q $ZTRNLNM(%VAR) %L1ER %L1ER ; [ 20.06.07 08:29 ] [ 20.11.05 14:37 ] [ 04.01.04 11:42 ] K (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C,^%L1TS U 0 N $ZT S $ZT="G ER^%L1ER" K %CLEAR Z X %chista S %SAY=" ERRORS MONITOR " X %XMSGV S %GET=":jix`z++3,70,HH#"_$$^%L1DC($H,1)_"++8,D,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S HH=$$^%L1DC(%L1DAT,4) G:'HH Z K ^er1($P) N N,I S N="",I=0,N0="" F S N0=$O(^er(HH,N0)) Q:N0="" D .F S N=$O(^er(HH,N0,N)) Q:N="" S I=I+1,^er1($P,I)=^(N)_"~"_$R K %L1 M S MAC="^er1($P)" S %L1("EU")=2,%L1("BE")=6 S %L1("T2")=" S %SAY="" [""_$$FUNC^%UCASE($ZG)_""] ""_%L1DAT1_"" "" X %XMSGV" S %L1("TXT1")="$P(%NXS,""~"",1,2)_$J("""",15-$L($P(%NXS,""~"",1,2)))\/$E($P(%NXS,""~"",3),1,50)_$J("""",50-$L($P(%NXS,""~"",3)))<>50" S %L1("PLACE")="D PLACE^%L1ER" X %chista S %L1("NOHB")="" D ^%L1NU I FLAG'="" K ^er1($P) G %L1ER S %L1("IND")=INDEX S INDEX=@MAC S MAC=$P(INDEX,"~",4) I $L(MAC,",")<2,$P(INDEX,"~",5)["^er(" S MAC=$P(INDEX,"~",5) I $L(MAC)<2 D POISK(INDEX) G M S (MAC0,MAC)=$E(MAC,1,$L(MAC)-1)_",""S"")" I $D(@MAC)<10 D POISK(INDEX) G M ; M1 D I FLAG'="" G M .N %L1 M2 .S MAC=MAC0 S %L1("EU")=5,%L1("BE")=6 .S %L1("T2")="D KOT^%L1ER" .S %L1("TXT1")="$P(%NXS,""~"")_$J("""",15-$L($P(%NXS,""~"")))" .S %L1("US")="%NXS'[""Indirection""" .X %chista S %L1("NOHB")="" .D ^%L1NU I FLAG'="" Q .S %L1("IND")=INDEX .S INDEX=@MAC D POISK(INDEX) .G M2 Q POISK(INDEX) ; N %NAM,U,%I,%L1ER,%FLI,%TIP,L,R S INDEX=$P($TR($P(INDEX,"~")," ",""),"(") S %NAM=$P($P(INDEX,"^",2),":"),U=+$P($P(INDEX,"^"),"+",2) Q:%NAM?.P I $D(%JSP) D ED^%W1JSP(%NAM) Q D .N MET S MET=$P($P(INDEX,"^"),"+") .K ^S000($P) D RED1^%L1ED(%NAM) .I $L(MET) F %I=1:1 Q:'$D(^S000($P,%I)) I $P($P(^S000($P,%I)," "),"(")=MET S U=U+%I Q .K ^S000($P) ; S %L1ER="",%FLI=1,%TIP="R" K L,R D ^%L1ED K %L1ER Q ER W #,"$ZS=",$ZS H 2 G %L1ER PLACE ; S INDEX=$G(%IND(%K+%I-%COLI)),%NXS=$G(@%L1("MAC")@(INDEX)) S %SAY=$$FUNC^%UCASE($P(%NXS,"~",4,5)) X %XMSGN Q KOT S %SAY=" ["_$$FUNC^%UCASE($ZG)_"] "_%L1DAT1_" " X %XMSGV S %SAY=$$FUNC^%UCASE($P(@($P(MAC0,",",1,$L(MAC0,",")-1)_")"),"~",2,3))_"++3,60,HH,I" X %XMSG Q %L1F2G %L1F2G(%F,%G) ; [ 19.11.05 17:25 ] [ K @%G o %F:(readonly:record=2048:rewind) N $ZT S $ZT="g REOF" N I,X S I=0 f u %F r X S I=I+1,@%G@(I)=X REOF ; c %F Q %L1FIND %L1FIND ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C U $P:(X=0:Y=21:CLEARSCREEN) ZF S %GET="FILE NAME :++20,5,EE,,R#++50,E,I" D ^%L1GET Q:%S=""!(%TO="END") S %NMF=%S I %S'[".",%S'["*" S %NMF=%NMF_"*" S %GET="BEGIN FROM :++22,5,EE#"_$ZDIR_"++50,E,I" D ^%L1GET I %S=""!(%TO="END") G ZF S %PATH=%S S %CMD="find "_%PATH_" -name '"_%NMF_"' > l1os.f" ZSY %CMD ZSY "vi l1os.f" Q %L1FL %L1FL ;DJM;FIRST ROUTINE LINE DISPLAY; [ 08.12.03 11:40 ] [ 21.08.03 11:18 ] [ 05/23/99 1:41 PM ] ;Copyright Micronetics Design Corp. @1984 N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC) S LAN=$G(^PL("LAN")) D ^%L1C U 0 W %ENG X %chista W "First Line Display Utility" N $ZT S $ZT="ZG "_$ZL_":ERROR^%L1FL" U 0 K ^TMPS111($J) S %SH=0 K QUIT D CALL^%RSEL I $D(%ZR)<10 W !,"No routines selected" G EXIT S %CC="",%PCT=0 W !!! RSEL1 F %I=1:1 S %CC=$O(%ZR(%CC)) Q:%CC="" D .S %RR=$TR(%CC,"%","_")_".m" Q:'$P($$^%L1FLP(%RR),"^",2) ;Q:'$$EXIST^%L1ZOS(%RR) .C %RR O %RR:(readonly:rewind) .S TXT=$TR($P(%RR,"."),"_","%") D S1 .U %RR R TXT C %RR D S1 S TXT="" D S1 .U $P W:'(%SH#10) "." S TXT="" D S1 S TXT=(%SH\2)_" Routine"_$S(%PCT=1:"",1:"s")_" processed." D S1 S %S2V("PROG")="VIEW^%L1FL" S %S2V("TXT1")=" SHOW PROGRAMM - " S %S2V("IND")=2,%S2V("NOHB")="" D ^%S2VIEW G EXIT RSEL2 ; I $F($ZS,"") S $ZT="ZG "_$ZL_":RSEL2^%L1FL" S TXT="Routine: "_%CC_" not found." D S1 G RSEL1 G ERROR EXIT ; S $ZT="" K ^TMPS111($J) S ^PL("LAN")=LAN K:'$G(^PL("LAN")) ^PL("LAN") Q ERROR ; I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT X ^ZT Q S1 S %SH=%SH+1,^TMPS111($J,%SH)=TXT K TXT Q VIEW Q:'$G(U) N %RN S %RN=$P($P($E(^TMPS111($J,U),1,8)," "),":") G VW TV(%RN) ; VW N %LAB,%RN0 S %LAB="" S %RN0=%RN I %RN["^" S %LAB=$P(%RN,"^"),%RN0=$P(%RN,"^",2) S %RN=$TR(%RN0,"%","_")_".m" I $L(%RN) D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%RN,%RN0,%LAB) D ^%L1C .S $ZT="ZG "_$ZL_":EVIEW^%L1FL" .O %RN:(readonly:rewind) .K ^S999($J) S MAC1="^TMPS111($J)",MAC2="^S999($J)" D ^%S1GC1 .K ^TMPS111($J) .F I=1:1 U %RN R A Q:$ZEOF S ^TMPS111($J,I)=A I $L(%LAB) D ..I $P(A," ")=$P(%LAB,"+") S %S2V("U")=I+$P(%LAB,"+",2) .C %RN U $P S $ZT="",%S2V("NOHB")="" .S %S2V("TXT1")=" "_%RN0_" . PRESS TO EXIT " .D ^%S2VIEW .K ^TMPS111($J) .S MAC2="^TMPS111($J)",MAC1="^S999($J)" D ^%S1GC1 .K ^S999($J) EVIEW Q ; ERG ; Q:'$G(U) N %PR S %PR=$P($P($E(^TMPS111($J,U),1,8)," "),":") Q:'$L(%PR) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%PR) D ^%L1C K ^S000($P) S %L1ER="",%FLI=1 X ^%ERG(2) K %L1ER K ^S000($P) Q %L1FL2P %L1FL2P ; FIL2 -> PORT; [ 03.05.00 1:32 PM ] [ 08/19/2000 8:29 AM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) BG K D ^%L1C FL U 0:(0::::0) X %chista S %SAY=" FILE --> PORT " X %XMSGV S %GET="ENTER FILE NAME :++3,5,EE#"_$G(%FILE)_"++30,E,I++++ FIND - F7 " D ^%L1GET I %TO="F7" D G FL .S %L1OS="1,2,3,4,5,6" .D O13^%L1OS Q:'$D(%L2VNM) Q:%L2VNM="" Q:%L2VNM["1 C %PORT U 0 S %GET="DONE . PRESS " D N^%L1GET INT S %XX=0,%YY=9 X %POSIC X %chiste U $P:(ECHO:WIDTH=80) F U 0 R !!,"ENTER COMMAND TO PORT : ",%COM Q:%COM=""!(%TO="END") ZU %PORT W %COM W @("$C("_%DLM_")") ZP R !!,"CREATE MUMPS ROUTINE (Y/N) : ",YES S:YES="y"!(YES="k") YES="Y" I YES'="Y",YES'="N" G ZP S KV="""" I YES="Y" D .R !!,"ROUTINE NAME : ",RNAME Q:RNAME="" .C 51 O 51:(%FILE:"R":::"S":$C(13,10)):2 E S %SAY=" PORT 51 BUSY ! " X %XMSGV(1) Q .S X(1)="ZR ZI RNAME_"" ; CREATED FROM FILE ""_%FILE ZI "" N PORT S PORT=""_%PORT_"" O PORT U PORT"" X X(2),X(3)" .S X(2)="F U 51 R %A S ZC=$ZC X X(20) ZI "" W ""_%B_KV_"",!"" Q:ZC" .S X(3)="ZI "" C PORT"" ZI "" Q ;"" X X(4)" .S X(4)="ZS @RNAME" .S X(20)="S %B=KV F %I=1:1:$L(%A) S %B=%B_$S($A(%A,%I)<32!($A(%A,%I)>154):KV_""_$C(""_$A(%A,%I)_"")_""_KV,1:$E(%A,%I))" .X X(1) .C 51 U 0 S %GET="DONE . PRESS " D N^%L1GET G FL %L1FLAG %L1FLAG(GLOB) ; [ 18.04.12 16:22 ] [ 27.02.06 15:16 ] [ 27.11.05 22:08 ] [ N %JOB S %JOB=$G(@GLOB) I %JOB=$J Q 0 ; I %JOB="" S @GLOB=$J Q 0 Q 1 D ^%L1LJ I '$D(^listjob(%JOB)) S @GLOB=$J Q 0 Q 1 %L1FLOP %L1FLOP ; [ 29.06.03 22:00 ] [ 27.05.03 08:15 ] [ ZSY "umount /mnt/floppy/" H 1 ZSY "mount /mnt/floppy/" Q %L1FLP %L1FLP(%X) ; DOS FILE ATTRIBUTES : NAME^SIZE^$H^TM [ 14.11.09 10:01 ] [ 28.02.07 09:56 ] [ 15.10.06 14:27 ] I $$WEB^W3MAIN'["192.168.1.182" Q $$^%L1SZ(%X) ; N %I,%SZ,%DT,%TM,%WN,%A,%NM,%M N $ZT S $ZT="ZG "_$ZL_":ER" S %NM=$ZPARSE(%X,"NAME")_$ZPARSE(%X,"TYPE") S %XX=$ZPARSE(%X) S %WN="L1FLP."_$ZPARSE($P,"NAME") ZSY "ls -l "_%XX_" > "_%WN O %WN:(READONLY:REWIND:EXCEPTION="G ER^%L1FLP") U %WN R %A C %WN:DELETE Q $$PRS(%A) ; ER U $P Q "" ;Jan;Feb;Mar;Apr;May;Jun;Jul;Aug;Sep;Oct;Nov;Dec; ;ipe;tax;nxu;`tx;n`i;iep;iel;`eb;qth;`ew;pea;cvn; PRS(%A) ; --> %NM,%SZ,%DT,%TM I $G(%A)="" Q "" S %A=$$SP1^%L1FRM(%A) I %A?.P Q "" N $ZT S $ZT=$G(^ZT) N %I,%M,%M1,%MM,%DT,%SZ,%TM,%NM D ^%L1TS S %MM=$T(ER+1) F %I=2:1:$L(%MM,";")-1 S %M($P(%MM,";",%I))=%I-1 S %MM=$T(ER+2) F %I=2:1:$L(%MM,";")-1 S %M1($P(%MM,";",%I))=%I-1 S %SZ=$P(%A," ",5) I $P(%A," ",6)["-" D G PRS1 .N %DT0 S %DT0=$P(%A," ",6) .S %DT0=$P(%DT0,"-",3)_"/"_$P(%DT0,"-",2)_"/"_$P(%DT0,"-") .S %DT=$$^%L1DC(%DT0,3) .S %TM=$P(%A," ",7) S %DT=$P(%A," ",6)_$P(%A," ",7) I $L(%DT)<4 S %DT="",%TM="" G PRS1 S %MM("MMD")=$G(%M($E(%DT,1,3)),"00") I '%MM("MMD") S %MM("MMD")=$G(%M1($E(%DT,1,3)),"00") I '%MM("MMD") S %MM("MMD")=$G(%M1($TR($E(%DT,1,3),TS1,TS0)),"00") S %MM("MMH")=$P($ZD($H,"DD/MM/YY"),"/",2) S %MM("YYH")=$P($ZD($H,"DD/MM/YY"),"/",3) S %MM("YYD")=%MM("YYH") I %MM("MMD")>%MM("MMH") S %MM("YYD")=%MM("YYD")-1 S %DT=$$^%L1DC($TR($E(%DT,4,5)," ",0)_"/"_%MM("MMD")_"/"_%MM("YYD"),3) S %TM=$P(%A," ",8) PRS1 S %NM=$P(%A," ",9) Q %NM_"^"_%SZ_"^"_%DT_"^"_%TM %L1FLTR %L1FLTR ; [ 04.07.03 22:48 ] [ 03.07.03 13:02 ] [ N A,FL,TSS,TS0,END,FL,EXITEMU,WORD BG D ^%L1TS S END=0,WORD="",EXITEMU=0 N $ZT S $ZT="G END^%L1FLTR" K ^EXITEMU($P) U $P:(NOECHO:NOWRAP) F U $P R *A:500 Q:A<0 D Q:END .S WORD=WORD_$C(A) .S WORD=$E(WORD,$L(WORD)-20,$L(WORD)) .;;S ^WORD($P)=WORD .;;S ^WORD($P,"A")=A .I A=13!(A=32)!(A=10)!(A=3) S WORD="" I EXITEMU S END=1 Q .I $D(^EXITEMU($P)) S END=1 .I $$FUNC^%UCASE(WORD)["EXITEMU" S EXITEMU=1 .I A>127 W $TR($C(A),TSS,TS0) Q .I A>96&(A<123),$G(FL) W $C(A-32) Q .W $C(A) ;;ZSY "kill "_$J END ; Q TV S FL=1 G BG %L1FND %L1FND ; [ 29.10.25 12:44 ] [ 17.09.21 13:03 ] [ 06.09.21 15:10 ] N (JB,%ARG,%REM) D ^%L1C S %SCRN="FND" D ^%L1SC I $G(DIR)="" Q ; S FL="/home/gtmuser/l1fnd"_$J I $$EXIST^%L1ZOS(FL) ZSY "rm "_FL S CMD="find "_DIR_" -type f" I $G(DEPTH) S CMD=CMD_" -maxdepth="+DEPTH I NAME'="" S CMD=CMD_" -name """_NAME_""" " I SIZE'="" D .I SIZE'["+",SIZE'["-" S SIZE="+"_SIZE .S CMD=CMD_" -size "_SIZE_" " I AGO S CMD=CMD_" -mtime "_AGO I EXEC'="" S CMD=CMD_" -exec "_EXEC_" {} \;" S CMD=CMD_" 2>/dev/null >> "_FL ZSY CMD ZSY "vi "_FL ZSY "rm "_FL Q %L1FP %L1FP(%INP,%DLMT,%STRNG,%NDLMT) ; FIND STRING AFTER DELIMITER [ 05/23/99 4:40 PM ] [ 02/17/94 11:01 AM ] ; ---- %INP - VH. STR. ; %DLMT - DELIMITER ; %STRNG - STRING, KOT NADO NAITI ; %NDLMT - POSLE KAKOGO DELIMITERA NACHAT POISK I $G(%DLMT)=""!($G(%INP)="")!($G(%STRNG)="") Q 0 S %FND=0 N %HLK,%J F %J=$G(%NDLMT)+1:1:$L($G(%INP),%DLMT) S %HLK=$P(%INP,%DLMT,%J) I %HLK=%STRNG S %FND=%J Q Q %FND %L1FRM %L1FRM ; [ 30.09.26 13:59 ] [ 30.06.26 10:01 ] [ 26.10.25 07:45 ] PRS(%TXT,%MKT,%RZD) ; N %I,%NM F %I=1:1:$L(%MKT,%RZD) S %NM=$P(%MKT,%RZD,%I) I %NM'?.P S @%NM=$$SPA($P(%TXT,%RZD,%I)) Q SET1(%MKT,%VRB,%RZD) ; N %I,%NM F %I=1:1:$L(%MKT,%RZD) S %NM=$P(%MKT,%RZD,%I) I %NM'?.P,$D(@%NM) S $P(@%VRB,%RZD,%I)=@%NM Q SET(%VR1,%STR1,%RZD1,%VR2,%STR2,%RZD2) ; N %I,%NM,%L1FRM F %I=1:1:$L(%STR1,%RZD1) D .S %NM=$P(%STR1,%RZD1,%I) I %NM'?.P S %L1FRM("SET",%NM)=$P($G(%VR1),%RZD1,%I) F %I=1:1:$L(%STR2,%RZD2) D .S %NM=$P(%STR2,%RZD2,%I) I %NM'?.P,$D(%L1FRM("SET",%NM)) D ..S $P(@%VR2,%RZD2,%I)=%L1FRM("SET",%NM) Q HBR(TXT,LN) ; I $G(%ENGLISH),TXT'?.P.N1"."1N.N S TXT=$E(TXT,1,LN)_$J("",LN-$L(TXT)) Q TXT S TXT=$J($E(TXT,$L(TXT)-LN+1,$L(TXT)),LN) Q TXT ENG(TXT,LN) ; S TXT=$E(TXT,1,LN)_$J("",LN-$L(TXT)) Q TXT FMTENG(TXT) N TX S TX=$E(TXT)_$$FUNC^%LCASE($E(TXT,2,1000)) Q TX NULL(TXT) ; --------- DELETE LEADING ZEROES N I F I=1:1:$L(TXT)+1 Q:$E(TXT,I)'=0 S TXT=$E(TXT,I,255) Q TXT CENTR(TXT,LN) ; I '$G(LN) S LN=$$WD N RV S RV=LN-$L(TXT)\2+$L(TXT) S TXT=$J(TXT,RV)_$J("",LN-RV) Q TXT ; CENTRB(TXT,LN) ;---- CENTER FOR BIG LETEERS I '$G(LN) S LN=$$WD S LN=LN\2 Q $J("",(LN-$L(TXT))\2)_TXT ;;Q $J("",LN-($L(TXT)*2)\4)_TXT ;;Q $J("",(29-$L(TXT))\2)_TXT SPR(TXT) ; ---- CLEAR RIGHT SPACE N I F I=$L(TXT):-1:0 Q:$E(TXT,I)'=" " S TXT=$E(TXT,1,I) Q TXT SPL(TXT) ; ---- CLEAR LEFT SPACE N I F I=1:1:$L(TXT)+1 Q:$E(TXT,I)'=" " S TXT=$E(TXT,I,$L(TXT)) Q TXT SPA(TXT) ; ---- CLEAR RIGHT & LEFT SPACE S TXT=$$SPL(TXT) S TXT=$$SPR(TXT) Q TXT SPC(TXT) ; TXT --> T X T N I,TXT1 S TXT1="" F I=1:1:$L(TXT) S TXT1=TXT1_$E(TXT,I)_" " S TXT=TXT1 Q TXT SP1(TXT) ;TXT TXT -> TXT TXT N I,TXT1,FL S TXT1="",FL=1 F I=1:1:$L(TXT) D .S FL=$S($E(TXT,I)=" ":FL-1,1:2) S:FL<0 FL=0 .I FL S TXT1=TXT1_$E(TXT,I) Q TXT1 NUM(TXT) ; ---- CLEAR RIGHT SPACE N TX S TX="" N I F I=1:1:$L(TXT) I $E(TXT,I)?1N S TX=TX_$E(TXT,I) Q TX L(ST,%D1,%D2) ;-- LENGTH OF LINE (B+N), %D1'=%D2 N L,N,%I,ST1 S L=0 I %D1=%D2 D Q L .F %I=1:1:$L(ST,%D1) S L=L+($L($P(ST,%D1,%I))*$S(%I#2:1,1:2)) S L=$L($P(ST,%D1)),%I=2,N="" L1 S ST1=$P(ST,%D1,%I) I $L(ST1)=0 Q L S ST1=$P(ST1,%D2) S L=L+($L(ST1)*2)+$L($P($P(ST,%D2,%I),%D1)) S %I=%I+1 G L1 ; LTX(TX) ; N SM,LTX,PRB S LTX=0,PRB=0 N J,J1,J2 F J=1:1:$L(TX) D .F J1="B","BB" D Q ..I $G(%MDP(J1))'="",$E(TX,J,J+$L(%MDP(J1))-1)=%MDP(J1) S PRB=1,J=J+$L(%MDP(J1)) .F J1="N" D Q ..I $G(%MDP(J1))'="",$E(TX,J,J+$L(%MDP(J1))-1)=%MDP(J1) S PRB=0,J=J+$L(%MDP(J1)) .N PRM S PRM=0 .F J2="" F S J2=$O(%MDP(J2)) Q:J2="" D ..I J2="B"!(J2="BB")!(J2="N") Q ..I $G(%MDP(J2))'="",$E(TX,J,J+$L(%MDP(J2))-1)=%MDP(J2) S J=J+$L(%MDP(J2)),PRM=1 .Q:PRM .I $E(TX,J)="" Q .I J>$L(TX) Q .I PRB S LTX=LTX+2 Q .S LTX=LTX+1 Q LTX ; ; RPL(TXT,%S1,%S2) ; --- %S1 --> %S2 N TXT1,I S TXT1="" I %S1="" Q TXT F I=1:1:$L(TXT,%S1) S TXT1=TXT1_$P(TXT,%S1,I)_$S($P(TXT,%S1,I,255)[%S1:%S2,1:"") Q TXT1 RPLA(%TXT,%ARR,%DLM1,%DLM2) ; %TXT[(DLM1+SUBSTR+DLM2) -->- %ARR() N TXT1,TXT2,TXT3,I,IND S TXT1=%TXT,I=1 I %TXT="" Q TXT1 I %TXT'[%DLM1!(%TXT'[%DLM2)!($D(@%ARR)<10) Q TXT1 S TXT1=$P(%TXT,%DLM1) RPLA1 S IND=$P($P(%TXT,%DLM1,I+1),%DLM2),TXT3=$P($P(%TXT,%DLM2,I+1),%DLM1) I IND'="",$D(@%ARR@(IND)) S TXT1=TXT1_@%ARR@(IND)_TXT3 E S TXT1=TXT1_%DLM1_IND I $L(%TXT,%DLM2)>I S TXT1=TXT1_%DLM2_TXT3 S I=I+1 I $L(%TXT,%DLM1)'>I Q TXT1 G RPLA1 ; CLRDLM(%TXT,%DLM1,%DLM2) ; %TXT[(DLM1+SUBSTR+DLM2) -->- %TXT WITHOUT SUBSTR N %TXT1,%TXT2,%TXT3,I S I=1,%TXT1="",%TXT2="",%TXT3="" CLRDLM1 I %TXT'[%DLM2!(%TXT'[%DLM1) S %TXT1=%TXT1_%TXT G ECLRDLM S %TXT2=$P(%TXT,%DLM1) I '$L($P(%TXT,%DLM1,2,255)) S %TXT1=%TXT1_%TXT2_$S(%TXT[%DLM1:%DLM1,1:"") G ECLRDLM S %TXT=%DLM1_$P(%TXT,%DLM1,2,255) ; I %TXT[%DLM1,%TXT[%DLM2 S %TXT3=$P(%TXT,%DLM2,2) I %TXT[%DLM2,%TXT[%DLM1 S %TXT=$P(%TXT,%DLM2,2,255) I %TXT3[%DLM1 S %TXT3=$P(%TXT3,%DLM1) I $L(%TXT3) S %TXT=$P(%TXT,%TXT3,2,255) ;;I '$L($P(%TXT,%DLM1,3,255)) S %TXT1=%TXT1_%TXT2_%TXT3 G ECLRDLM ;;S %TXT=%DLM1_$P(%TXT,%DLM1,3,255) ; S %TXT1=%TXT1_%TXT2_%TXT3 I (%TXT2=""&(%TXT3=""))!(%TXT="") G ECLRDLM G CLRDLM1 ECLRDLM ; Q %TXT1 ; CLWEB(TXT) ; N TXT1 S TXT1=$$RPL(TXT,"%","$1$") S TXT1=$$RPL^%L1FRM(TXT1," ","%20") S TXT1=$$RPL(TXT1,"""","%22") S TXT1=$$RPL(TXT1,"#","%23") S TXT1=$$RPL(TXT1,"\","%5C") S TXT1=$$RPL(TXT1,"/","%2F") S TXT1=$$RPL(TXT1,"~","%7E") S TXT1=$$RPL(TXT1,"'","%27") S TXT1=$$RPL(TXT1,"`","%60") S TXT1=$$RPL(TXT1,"+","%2B") S TXT1=$$RPL(TXT1,"&","%26") S TXT1=$$RPL(TXT1,"=","%3D") S TXT1=$$RPL(TXT1,";","%3B") S TXT1=$$RPL(TXT1,":","%3A") S TXT1=$$RPL(TXT1,",","%2C") S TXT1=$$RPL(TXT1,"(","%28") S TXT1=$$RPL(TXT1,")","%29") Q TXT1 ; CNWEB(TXT) ; N TXT1 S TXT1=$$RPL(TXT,"$1$","%") S TXT1=$$RPL^%L1FRM(TXT1,"%25","%") S TXT1=$$RPL^%L1FRM(TXT1,"%20"," ") S TXT1=$$RPL(TXT1,"%22","""") S TXT1=$$RPL(TXT1,"%23","#") S TXT1=$$RPL(TXT1,"%5C","\") S TXT1=$$RPL(TXT1,"%2F","/") S TXT1=$$RPL(TXT1,"%7E","~") S TXT1=$$RPL(TXT1,"%27","'") S TXT1=$$RPL(TXT1,"%60","`") S TXT1=$$RPL(TXT1,"%2B","+") S TXT1=$$RPL(TXT1,"%26","&") S TXT1=$$RPL(TXT1,"%3D","=") S TXT1=$$RPL(TXT1,"%3A",":") S TXT1=$$RPL(TXT1,"%3B",";") S TXT1=$$RPL(TXT1,"%2C",",") S TXT1=$$RPL(TXT1,"%3F","?") S TXT1=$$RPL(TXT1,"%60","`") S TXT1=$$RPL(TXT1,"%28","(") S TXT1=$$RPL(TXT1,"%29",")") ; N J F J=1:1:$L(TXT1) Q:$E(TXT1)'="?" S TXT1=$E(TXT1,2,$L(TXT1)) Q TXT1 ; CLWEBKV(TXT) ; N TXT1 S TXT1=$$RPL(TXT,"""","\""") S TXT1=$$RPL(TXT1,"'","\'") Q $$^W4CLWTXT(TXT1) ; --- 29/12/21 - $$CLWEB ; CLHT(OU) N I,OU1 S OU1="" F I=1:1:$L(OU,"") D .I (I#2) S OU1=OU1_$$CLHTML($P(OU,"",I)) Q .S OU1=OU1_$P(OU,"",I) Q OU1 ; CLHTML(TXT) ; N TXT1 I '$D(H2UG) D .S TXT1=$$RPL(TXT,"""",""") .S TXT1=$$RPL(TXT1,"'","'") I $D(H2UG) D .S TXT1=$$RPL(TXT,"""","\u0022") .S TXT1=$$RPL(TXT1,"'","\u0027") Q TXT1 ; CLEAR(V) ; N V0,J S V0="" S V=$TR(V,"?","") F J=1:1:$L(V) I $A(V,J)>31,$A(V,J)<127 S V0=V0_$E(V,J) Q V0 ; ESC(TXT,ESCY) ; N TXT1,I,X S I=1,TXT1="",X=1,TXT=TXT_" " ESC1 F I=I:1:$L(TXT) Q:$E(TXT,I)'=" " I I=$L(TXT) Q TXT1 S TXT1=TXT1_$C(27,91)_ESCY_";"_I_"H" S X=I F I=I:1:$L(TXT) Q:$E(TXT,I)=" " D ESC2 I I=$L(TXT) Q TXT1 S X=I G ESC1 ESC2 S TXT1=TXT1_$E(TXT,X,I-($E(TXT,I)=" ")) Q ; H2UG(TXT) ; N H2UG S H2UG="" I $$^%W1LNG'="H" Q $$CLHT(TXT) I $$^%W1LNG="R" Q $$CLHT($$R2U(TXT)) I $$^%W1LNG'="H" Q $$CLHT(TXT) N OU,OU1,I S OU=$$^%W1H2U(TXT),OU1="" ; N J F J=96:1:122 D .N SMB S SMB=$$FUNC^%DH(J+1392) .S SMB=$E(SMB,$L(SMB)-3,$L(SMB)) .S H2U($C(J))="\u"_SMB ; F I=1:1:$L(OU,"") D .I (I#2) S OU1=OU1_$$CLHT($$H2U1($P(OU,"",I))) Q .S OU1=OU1_$P(OU,"",I) Q OU1 ; ; H2U(TXT,WIN,NOTRG) ; I $G(TXT)="" Q "" S TXT=$$CNWEB^%L1FRM(TXT) I $$^%W1LNG="R" Q $$CLHT($$R2U(TXT)) I $$^%W1LNG'="H" Q $$CLHT(TXT) ; I $G(NOTRG) G H2UMET I $$GETP^%W1PRM("ELPOS"),$$SUPER^W3PRM!$$TAW^W4PRM,$E(TXT)'="_" D .S TXT=$$RPL(TXT,"ogley","dtew") .S TXT=$$RPL(TXT,"zepgley","zetew") .S TXT=$$RPL(TXT,"xvln","(z)i`tew") .S TXT=$$RPL(TXT,"mixvln","mi`tew") ; I $$GETP^%W1PRM("ELPOS"),$$SUPER^W3PRM D .S TXT=$$RPL(TXT,"dcrqn","zepg") ; H2UMET ; I TXT["%60" S TXT=$$RPL(TXT,"%60","`") N OU,OU1,I S OU=$$^%W1H2U(TXT),OU1="" N H2U N J F J=96:1:122 S H2U($C(J))="&#"_(J+1392)_";" I $G(WIN) K H2U F J=224:1:250 S H2U($C(J))="&#"_(J+1392-128)_";" F I=1:1:$L(OU,"") D .I (I#2) S OU1=OU1_$$CLHT($$H2U1($P(OU,"",I))) Q .S OU1=OU1_$P(OU,"",I) Q OU1 ; H2U1(O) ; N O1 S O1="" N I F I=1:1:$L(O) D .S O1=O1_$S($D(H2U($E(O,I))):H2U($E(O,I)),1:$E(O,I)) Q O1 ; U2H(ST) ; N ST1,IND I $E(ST)="?" S ST=$E(ST,2,255) I $A(ST)=$C(160) S ST=$E(ST,2,255) N FL S FL=0,ST1=ST,IND="" D .S ST1="" .N J F J=1:1:$L(ST) D ..I $E(ST,J)="&",$E(ST,J+1)="#" S FL=1,J=J+1 Q ..I FL,$E(ST,J)=";" S FL=0 S:IND>1392&(IND<(1392+123)) ST1=ST1_$C(IND-1392) S IND="" Q ..I FL S IND=IND_$E(ST,J) Q ..S ST1=ST1_$E(ST,J) .;;S ST1=$$INV^%L1FRM(ST1) I FL S:IND>1392&(IND<(1392+123)) ST1=ST1_$C(IND-1392) Q ST1 ; R2U(TXT) N I,J,M1,M2,SMB,SMB1,SMB2,TXT1,LNG S M2="",TXT1="" S M1="A,B,V,G,D,E,J,Z,I,!I,K,L,M,N,O,P,R,S,T,U,F,H,C,!04,!06,!S,!T,Y,!M,!E,!U,!A" S M1=M1_",a,b,v,g,d,e,j,z,i,!i,k,l,m,n,o,p,r,s,t,u,f,h,c,!4,!6,!s,!t,y,!m,!e,!u,!a" F I=1040:1:1103 S M2=M2_I_"," S TXT1="",LNG=0 F I=1:1:$L(TXT) D .S SMB=$E(TXT,I),SMB1="",SMB2="" .I SMB="!" D ..S SMB1=$E(TXT,I+1) ..I SMB1="0"!(SMB1="%") S SMB2=$E(TXT,I+2) ..I SMB1="%" S LNG=1-LNG,SMB=SMB2 ..E S SMB=SMB_SMB1_SMB2 .N OK S OK=0 .I 'LNG F J=1:1:$L(M1,",") I $P(M1,",",J)=SMB S TXT1=TXT1_"&#"_$P(M2,",",J)_";",OK=1 Q .I 'OK S TXT1=TXT1_SMB .I SMB2'="" S I=I+2 Q .I SMB1'="" S I=I+1 Q Q TXT1 ; WDOP(TXT,DL) ; Q $J(TXT,DL) ;;Q $$RPL^%L1FRM($J(TXT,DL)," ","%20") ; INV(TXT) ; N TXT1,I S TXT1="" F I=1:1:$L(TXT) S TXT1=$E(TXT,I)_TXT1 Q TXT1 ; INVD(TXT,D1,D2) ; I $G(D2)="" S D2=D1 N TXT1,I S TXT1="" F I=1:1:$L(TXT,D1) S TXT1=$P(TXT,D1,I)_D2_TXT1 Q $E(TXT1,1,$L(TXT1)-1) ; INVH(TXT) ; N DIR,N S DIR=$$^%W1DIR I $G(DIR)="LTR" Q TXT Q $$^%W1H2U(TXT) ; N I,J,HB,W,TXT1 S TXT1="" N DMLS S DLMS="=-)(*&^%$#@!\[]';?><|" N J F J=1:1:$L(DLMS) S TXT=$$RPL^%L1FRM(TXT,$E(DLMS,J)," "_$E(DLMS,J)_" ") N I F I=1:1:$L(TXT," ") D .S W=$P(TXT," ",I) .S HB=0 F J=1:1:$L(W) I $$INVHB($A($E(W,J))) S HB=1 Q .S TXT1=$S(HB:$$INV(W),1:W)_" "_TXT1 N J F J=1:1:$L(DLMS) S TXT1=$$RPL^%L1FRM(TXT1," "_$E(DLMS,J)_" ",$E(DLMS,J)) Q $$SPA(TXT1) ; INVHBW(TXT) ; N TXT1,TXT2,I,I1,A,B,TS0,TS1,TSS,HB,HB0 S HB=0,HB0=0 S TXT0="" F I=1:1:$L(TXT) Q:$A($E(TXT,I))>95 S TXT0=$E(TXT,1,I-1),TXT=$E(TXT,I,$L(TXT)) S I=0,TXT1="",TXT2="" D ^%L1TS INVHBW1 S I=I+1 I I>$L(TXT) D INVHBW2 G INVHBWE S A=$A($E(TXT,I)) ;I $$INVEN(A) S HB0=HB,HB=0 I '$$INVHB(A) S HB0=HB,HB=0 I $$INVHB(A) S HB0=HB,HB=1 I A>31&(A<48)!(A=58)!(A=124) D .F I1=I+1:1 Q:$E(TXT,I1)'=" " .;I $$INVEN($A($E(TXT,I1))) S HB=0 Q .I '$$INVHB($A($E(TXT,I1))) S HB=0 Q .I $$INVHB($A($E(TXT,I1))) S HB=1 I HB0'=HB,HB,$L(TXT2) S TXT1=$C(A)_TXT2_TXT1 S TXT2="" G INVHBW1 I HB0'=HB,'HB,$L(TXT2) S TXT1=$C(A)_TXT2_TXT1 S TXT2="" G INVHBW1 I HB S TXT2=$C(A)_TXT2 G INVHBW1 S TXT2=TXT2_$C(A) G INVHBW1 INVHBWE Q $TR(TXT1,TS0,TS1) ; INVHBW2 N I2 S HB=0 F I2=1:1:$L(TXT2) I $$INVHB($A($E(TXT2,I2))) S HB=1 Q I $L(TXT2),'HB S TXT1=TXT0_TXT1_TXT2 S TXT2="" Q I $L(TXT2),HB S TXT1=TXT0_TXT2_TXT1 S TXT2="" Q ; INVEN(A) ; I A>47&(A<58)!(A>64&(A<91))!(A=124) Q 1 Q 0 ; INVHB(A) I A>95&(A<123) Q 1 I A>127&(A<155) Q 1 I A>223&(A<251) Q 1 Q 0 ; INVEH(TXT) ; N A S A=$$SPL(TXT) Q A_$J("",$L(TXT)-$L(A)) ; CLST(ST,%B,%N) ; S %PRW1=0 I '$D(%LIGHT1) D ^%L1C I '$D(TSS)!'$D(TS0) D ^%L1TS I ST[%CLI S ST=$$RPL^%L1FRM(ST,%CLI,%B),%PRW1=1 I ST[($C(27,91,48,109)) S ST=$$RPL^%L1FRM(ST,$C(27,91,48,109),%N) S %PRW1=0 I ST[$TR($C(27,91,48,109),TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR($C(27,91,48,109),TS0,TSS),%N) S %PRW1=0 I ST[$TR(%CLI,TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR(%CLI,TS0,TSS),%B),%PRW1=1 I ST[$TR($C(27,91,48,109),TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR($C(27,91,48,109),TS0,TSS),%N) S %PRW1=0 I ST[%CL0,%CL0'="" S ST=$$RPL^%L1FRM(ST,%CL0,"") I ST[$TR(%CL0,TS0,TSS),%CL0'="" S ST=$$RPL^%L1FRM(ST,$TR(%CL0,TS0,TSS),"") I ST[%HBR S ST=$$RPL^%L1FRM(ST,%HBR,"") I ST[%ENG S ST=$$RPL^%L1FRM(ST,%ENG,"") I ST[%LIGHT1 S ST=$$RPL^%L1FRM(ST,%LIGHT1,"") I ST[$TR(%LIGHT1,TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR(%LIGHT1,TS0,TSS),"") I %PRW1 S ST=ST_%N S %PRW1=0 Q ST ; CLA(ST) ;--- >64,<122 N ST1,%I S ST1="" F %I=1:1:$L(ST) I $A($E(ST,%I))'<32,$A($E(ST,%I))'>122 S ST1=ST1_$E(ST,%I) Q ST1 ; MC(%ST1,%D1,%ST2,%D2) ;-- PECHAT LEFI MACKET N %MP,%I,%ST3 S %ST3=" " F %I=1:1:$L(%ST1,%D1) S %RV=$P(%ST1,%D1,%I) S %ST3=%ST3_$J(%RV,$L($P(%ST2,%D2,%I+1)))_" " Q $E(%ST3,1,$L(%ST3)-1) ; MCH(%ST1,%D1,%ST2,%D2) ; -- PECHAT LEFI MACKET (AFUH) N %MP,%I,%ST3 S %ST3=" " F %I=1:1:$L(%ST1,%D1) S %RV=$P(%ST1,%D1,$L(%ST1,%D1)-%I+1) S %ST3=%ST3_$$HBR^%L1FRM(%RV,$L($P(%ST2,%D2,%I+1)))_" " Q $E(%ST3,1,$L(%ST3)-1) ; FNDARR(%REF,%VL,%PR) ; S %IND="" N %N,%OK S %N="",%OK=0 F S %N=$O(@%REF@(%N)) Q:%N="" D Q:%OK .I '$G(%PR),@%REF@(%N)=%VL S %OK=1 Q .I '$G(%PR),@%REF@(%N)[%VL S %OK=1 Q I %OK S %IND=%N Q %OK_"\"_%IND ; DLG(%FRAZA,%DLG) ;------------ %FRAZA --> %CHAST(1-%KSS) LEFI %DLG I '$G(%NR) S %NR=1 N %I,%POZ K %CHAST(%NR) S %I=0 G DELGEND1:$L(%FRAZA)'>%DLG DELGC F %POZ=$L(%FRAZA)-%DLG+1:1:$L(%FRAZA) G DLG1:",:;?- "[$E(%FRAZA,%POZ) S %I=%I+1,%CHAST(%NR,%I)="-"_$E(%FRAZA,$L(%FRAZA)-%DLG+2,$L(%FRAZA)),%FRAZA=$E(%FRAZA,1,$L(%FRAZA)-%DLG+1) G DELGEND1 DLG1 S %I=%I+1,%CHAST(%NR,%I)=$J($E(%FRAZA,%POZ,$L(%FRAZA)),%DLG) S %FRAZA=$E(%FRAZA,1,%POZ-1) DELGEND1 G:$L(%FRAZA)>%DLG DELGC S %KSS=%I+1 S %CHAST(%NR,%KSS)=$J(%FRAZA,%DLG) I %CHAST(%NR,%KSS)["" D .N %DLM S %DLM="" .N %A S %A=%CHAST(%NR,%KSS) .N %J,%A1,%A2 S %A1=$P(%A,%DLM) .F %J=2:2:$L(%A,%DLM) D ..S %A2=$P(%A,%DLM,%J) ..S %A1=%A1_$C(27,45,2)_%A2_$C(27,45,0)_$P(%A,%DLM,%J+1) .S %CHAST(%NR,%KSS)=%A1 Q ; DLGE(%FRAZA,%DLG) ;------------ %FRAZA --> %CHAST(1-%KSS) LEFI %DLG N %SM,%RZD S %RZD=",:;?- " I '$G(%NR) S %NR=1 N %I,%POZ,%J,%K K %CHAST(%NR) S %K=1 S %I=0 I $L(%FRAZA)'>%DLG S %CHAST(1,1)=$$ENG(%FRAZA,%DLG) Q F %J=1:1:$L(%FRAZA) Q:$E(%FRAZA,%J)'=" " S %K=%K+1 S %FRZ=$E(%FRAZA,%K,%K+%DLG-1) I %RZD[$E(%FRAZA,%K+%DLG) S %POZ=$L(%FRZ) G DLGE2 DLGE1 F %POZ=$L(%FRZ):-1:1 G DLGE2:%RZD[$E(%FRZ,%POZ) DLGE2 ; I %POZ=1 S %POZ=$L(%FRZ) S %SM=0 I %RZD[$E(%FRZ,%POZ) S %POZ=%POZ-1,%SM=1 S %I=%I+1,%CHAST(%NR,%I)=$$ENG($E(%FRZ,1,%POZ),%DLG) S %K=%K+%POZ+%SM Q:%K>$L(%FRAZA) I $E(%FRAZA,%K)=" " S %K=%K+1 ;;F %J=%K:1:$L(%FRAZA) Q:$E(%FRAZA,%J)'=" " S %K=%K+1 S %FRZ=$E(%FRAZA,%K,%K+%DLG-1) I %K+%DLG>$L(%FRAZA) D Q .S %I=%I+1,%CHAST(%NR,%I)=$$ENG(%FRZ,%DLG) I %RZD[$E(%FRAZA,%K+%DLG) S %POZ=$L(%FRZ) G DLGE2 G DLGE1 ; H2J(ST) ; S ST=$$CNWEB(ST) N ST1,IND N FL S FL=0,ST1=ST,IND="" S ST=$$H2U(ST) D .S ST1="" .N J F J=1:1:$L(ST) D ..I $E(ST,J)="&",$E(ST,J+1)="#" S FL=1,J=J+1 Q ..I $E(ST,J)="<",$E(ST,J+1)=">" S ST1=ST1_"<>",J=J+1 Q ..I $E(ST,J)=">",$E(ST,J+1)="<" S ST1=ST1_"<>",J=J+1 Q ..I FL,$E(ST,J)=";" S FL=0 S ST1=ST1_IND_"," S IND="" Q ..I FL S IND=IND_$E(ST,J) Q ..S ST1=ST1_$A($E(ST,J))_"," I $E(ST1,$L(ST1))="," S ST1=$E(ST1,1,$L(ST1)-1) Q ST1 ; MIN2HR(DAKOT) ; Q $$DOP(DAKOT\60)_":"_$$DOP(DAKOT#60) ; DOP(TM,DL) ; I '$G(DL) S DL=2 Q $TR($J(TM,DL)," ",0) ; DCD(A) ; I '$D(TSS) D ^%L1TS N J,B,CHR S B="",J=0 DCDC S J=J+1 I J>$L(A) G DCDE S CHR=$A(A,J) I CHR'=215 D G DCDC .S B=B_$C(CHR) S J=J+1 I J>$L(A) G DCDE S CHR=$A(A,J) S B=B_$C(CHR-16) G DCDC DCDE ; S B=$$SPA(B) S B=$TR(B,TSS,TS0) Q $$^%W1H2U(B) ; COUPLE(PRM,DLM) ; I $G(DLM)="" S DLM=";" N A,B,COUPL,I F I=1:1:$L(PRM,DLM)-1 D .S COUPL=$P(PRM,DLM,I) .S A=$P(COUPL,"=") Q:A="" .S B=$P(COUPL,"=",2) .S @A=B Q ISCODE(TXT) ; I $G(TXT)="" Q 0 N OK S OK=1 N NMB S NMB=0 N J,SMB F J=1:1:$L(TXT) D Q:'OK .S SMB=$A(TXT,J) .I SMB<45 S OK=0 Q .I SMB>57&(SMB<65) S OK=0 Q .I SMB>47&(SMB<58) S NMB=1 .I SMB>90&(SMB<97) S OK=0 Q .I SMB>122 S OK=0 Q ; I 'NMB S OK=0 Q OK ; CLRCOUPLE(TXT,BG,FIN) N TX S POS=0,TX="" CCC S POS1=$F(TXT,BG,POS) I 'POS1 S TX=TX_$E(TXT,POS,800) G ECC S TX=TX_$E(TXT,POS,POS1-$L(BG)-1) S POS=POS1 S POS2=$F(TXT,FIN,POS) I 'POS2 S TX=TX_$E(TXT,POS,800) G ECC S POS=POS2 G CCC ECC Q TX ; NBSP(COL) N NBSP,%I S NBSP="" F %I=1:1:COL S NBSP=NBSP_" " Q NBSP ; SHOWCARD(CARD,FULL) ; N CARDV S CARDV="" I CARD["..." Q "..."_$P(CARD,"...",2,10) I CARD["***" Q "***"_$P(CARD,"***",2,10) SHOWCARD1 S CARD=$TR(CARD,"-","") S CARDV=$E(CARD,$L(CARD)-3,$L(CARD))_$S($L(CARDV):"-"_CARDV,1:"") I '$G(FULL) Q "..."_CARDV S CARD=$E(CARD,1,$L(CARD)-4) I $L(CARD)>3 G SHOWCARD1 I $L(CARD)>0 Q CARD_"-"_CARDV I $E(CARDV)="-" S CARDV=$E(CARDV,2,$L(CARDV)) Q CARDV ; ZPT(NUM) ; N R,R1 S R=$R ;;I $G(^P1PRM("NOZPT")) S:$D(@R) R1="" Q NUM I NUM'["." Q NUM N L S L=$L(NUM) S NUM=$$SPA(NUM) N A,A1,A2,B S A1="" S A=$P(NUM,".") S B=$P(NUM,".",2) ;;S:$D(@R) R1="" ZPT1 S A2=$E(A,$L(A)-2,$L(A)) S A1=$S(A1="":A2,A2:A2_","_A1,1:A2_A1) S A=$E(A,1,$L(A)-3) I '$L(A),$L(B) Q $J(A1_"."_B,L) I '$L(A),'$L(B) Q $J(A1,L) G ZPT1 ; ZPTN(NUM) ; S NUM=$G(NUM) Q $$ZPT($J(NUM,2,2)) ; WD(STAM) ; Q 39 ; TEL(TEL) ; I $G(TEL)="" Q TEL I TEL["-" Q TEL I $E(TEL,1,2)="05" Q $E(TEL,1,3)_"-"_$E(TEL,4,14) I $E(TEL)="+" Q $E(TEL,1,4)_"-"_$E(TEL,5,14) I $E(TEL)="1",$L(TEL)>7 Q $E(TEL)_"-"_$E(TEL,2,4)_"-"_$E(TEL,5,14) I $E(TEL)'=0 Q TEL Q $E(TEL,1,2)_"-"_$E(TEL,3,14) ; ARG(TX,DLM) ; I $G(DLM)="" S DLM="&" K %ARG N I,COUP,A,B F I=1:1:$L(TX,DLM) D .S COUP=$P(TX,DLM,I) .S A=$P(COUP,"=") .S B=$P(COUP,"=",2) .I $E(A)?1U S %ARG(A)=B Q ; UPDPRM(ST,PRM) ; S ST=$G(ST) S PRM=$G(PRM) I PRM="" Q ST S:$E(ST)'="&" ST="&"_ST N PRML S PRML=$P(PRM,"=")_"=" I $E(PRML)'="&" S PRML="&"_PRML N ST1,ST2 S ST1=$P(ST,PRML) S ST2=$P(ST,PRML,2) S ST2=$P(ST2,"&",2,200) I $L(ST1),$E(PRM)'="&" S PRM="&"_PRM I $L(ST2),$E(PRM,$L(PRM))'="&" S PRM=PRM_"&" ; S ST=ST1_PRM_ST2 S:$E(ST)="&" ST=$E(ST,2,255) I $E(ST,$L(ST))="&" S ST=$E(ST,1,$L(ST)-1) Q ST ; VWENG(TX) ; N TX2 S TX2="" N J F J=1:1:$L(TX," ") D .N WORD S WORD=$P(TX," ",J) .S WORD=$$FUNC^%UCASE($E(WORD))_$$FUNC^%LCASE($E(WORD,2,100)) .S TX2=TX2_WORD_" " Q $$SPA^%L1FRM(TX2) ; ABS(%VL) ; I $G(%VL)<0 Q -%VL Q $G(%VL) ; ISNUM(%VL,%ZN) ; S %VL=$$SPA(%VL) I $G(%ZN),%VL?."-"1N.N.".".N Q 1 I $G(%ZN),%VL?."-."1N.N Q 1 I %VL?1N.N.".".N.E Q 1 I %VL?1"."1N.N.E Q 1 Q 0 %L1FRM0 %L1FRM ; [ 23.04.02 12:15 PM ] [ 04.04.02 10:39 AM ] [ 29.03.02 1:59 PM ] PRS(%TXT,%MKT,%RZD) ; N %I,%NM F %I=1:1:$L(%MKT,%RZD) S %NM=$P(%MKT,%RZD,%I) I %NM'?.P S @%NM=$P(%TXT,%RZD,%I) Q SET1(%MKT,%VRB,%RZD) ; N %I,%NM F %I=1:1:$L(%MKT,%RZD) S %NM=$P(%MKT,%RZD,%I) I %NM'?.P,$D(@%NM) S $P(@%VRB,%RZD,%I)=@%NM Q SET(%VR1,%STR1,%RZD1,%VR2,%STR2,%RZD2) ; N %I,%NM,%L1FRM F %I=1:1:$L(%STR1,%RZD1) D .S %NM=$P(%STR1,%RZD1,%I) I %NM'?.P S %L1FRM("SET",%NM)=$P($G(%VR1),%RZD1,%I) F %I=1:1:$L(%STR2,%RZD2) D .S %NM=$P(%STR2,%RZD2,%I) I %NM'?.P,$D(%L1FRM("SET",%NM)) D ..S $P(@%VR2,%RZD2,%I)=%L1FRM("SET",%NM) Q HBR(TXT,LN) ; I $G(%ENGLISH),TXT'?.P.N1"."1N.N S TXT=$E(TXT,1,LN)_$J("",LN-$L(TXT)) Q TXT S TXT=$J($E(TXT,$L(TXT)-LN+1,$L(TXT)),LN) Q TXT ENG(TXT,LN) ; S TXT=$E(TXT,1,LN)_$J("",LN-$L(TXT)) Q TXT NULL(TXT) ; --------- DELETE LEADING ZEROES N I F I=1:1:$L(TXT)+1 Q:$E(TXT,I)'=0 S TXT=$E(TXT,I,255) Q TXT CENTR(TXT,LN) ; N RV S RV=LN-$L(TXT)\2+$L(TXT) S TXT=$J(TXT,RV)_$J("",LN-RV) Q TXT CENTRB(TXT,LN) ;---- CENTER FOR BIG LETEERS Q $J("",LN-($L(TXT)*2)\4)_TXT SPR(TXT) ; ---- CLEAR RIGHT SPACE N I F I=$L(TXT):-1:1 Q:$E(TXT,I)'=" " S TXT=$E(TXT,1,I) Q TXT SPL(TXT) ; ---- CLEAR LEFT SPACE N I F I=1:1:$L(TXT) Q:$E(TXT,I)'=" " S TXT=$E(TXT,I,$L(TXT)) Q TXT SPA(TXT) ; ---- CLEAR RIGHT & LEFT SPACE S TXT=$$SPL(TXT) S TXT=$$SPR(TXT) Q TXT SPC(TXT) ; TXT --> T X T N I,TXT1 S TXT1="" F I=1:1:$L(TXT) S TXT1=TXT1_$E(TXT,I)_" " S TXT=TXT1 Q TXT SP1(TXT) ;TXT TXT -> TXT TXT N I,TXT1,FL S TXT1="",FL=1 F I=1:1:$L(TXT) D .S FL=$S($E(TXT,I)=" ":FL-1,1:2) S:FL<0 FL=0 .I FL S TXT1=TXT1_$E(TXT,I) Q TXT1 L(ST,%D1,%D2) ;-- LENGTH OF LINE (B+N), %D1'=%D2 N L,N,%I,ST1 S L=0 I %D1=%D2 D Q L .F %I=1:1:$L(ST,%D1) S L=L+($L($P(ST,%D1,%I))*$S(%I#2:1,1:2)) S L=$L($P(ST,%D1)),%I=2,N="" L1 S ST1=$P(ST,%D1,%I) I $L(ST1)=0 Q L S ST1=$P(ST1,%D2) S L=L+($L(ST1)*2)+$L($P($P(ST,%D2,%I),%D1)) S %I=%I+1 G L1 RPL(TXT,%S1,%S2) ; --- %S1 --> %S2 N TXT1,I S TXT1="" I %S1="" Q TXT F I=1:1:$L(TXT,%S1) S TXT1=TXT1_$P(TXT,%S1,I)_$S($P(TXT,%S1,I,255)[%S1:%S2,1:"") Q TXT1 RPLA(%TXT,%ARR,%DLM1,%DLM2) ; %TXT[(DLM1+SUBSTR+DLM2) -->- %ARR() N TXT1,TXT2,TXT3,I,IND S TXT1=%TXT,I=1 I %TXT="" Q TXT1 I %TXT'[%DLM1!(%TXT'[%DLM2)!($D(@%ARR)<10) Q TXT1 S TXT1=$P(%TXT,%DLM1) RPLA1 S IND=$P($P(%TXT,%DLM1,I+1),%DLM2),TXT3=$P($P(%TXT,%DLM2,I+1),%DLM1) I IND'="",$D(@%ARR@(IND)) S TXT1=TXT1_@%ARR@(IND)_TXT3 E S TXT1=TXT1_%DLM1_IND I $L(%TXT,%DLM2)>I S TXT1=TXT1_%DLM2_TXT3 S I=I+1 I $L(%TXT,%DLM1)'>I Q TXT1 G RPLA1 ESC(TXT,ESCY) ; N TXT1,I,X S I=1,TXT1="",X=1,TXT=TXT_" " ESC1 F I=I:1:$L(TXT) Q:$E(TXT,I)'=" " I I=$L(TXT) Q TXT1 S TXT1=TXT1_$C(27,91)_ESCY_";"_I_"H" S X=I F I=I:1:$L(TXT) Q:$E(TXT,I)=" " D ESC2 I I=$L(TXT) Q TXT1 S X=I G ESC1 ESC2 S TXT1=TXT1_$E(TXT,X,I-($E(TXT,I)=" ")) Q INV(TXT) ; N TXT1,I S TXT1="" F I=1:1:$L(TXT) S TXT1=$E(TXT,I)_TXT1 Q TXT1 INVD(TXT,D1,D2) ; N TXT1,I S TXT1="" F I=1:1:$L(TXT,D1) S TXT1=$P(TXT,D1,I)_D2_TXT1 Q $E(TXT1,1,$L(TXT1)-1) INVH(TXT) ; N I,J,HB,W,TXT1 S TXT1="" N I F I=1:1:$L(TXT," ") D .S W=$P(TXT," ",I) .S HB=0 F J=1:1:$L(W) I $$INVHB($A($E(W,J))) S HB=1 Q .S TXT1=$S(HB:$$INV(W),1:W)_" "_TXT1 Q $$SPA(TXT1) INVHBW(TXT) ; N TXT1,TXT2,I,I1,A,B,TS0,TS1,TSS,HB,HB0 S HB=0,HB0=0 S TXT0="" F I=1:1:$L(TXT) Q:$A($E(TXT,I))>95 S TXT0=$E(TXT,1,I-1),TXT=$E(TXT,I,$L(TXT)) S I=0,TXT1="",TXT2="" D ^%L1TS INVHBW1 S I=I+1 I I>$L(TXT) D INVHBW2 G INVHBWE S A=$A($E(TXT,I)) ;I $$INVEN(A) S HB0=HB,HB=0 I '$$INVHB(A) S HB0=HB,HB=0 I $$INVHB(A) S HB0=HB,HB=1 I A>31&(A<48)!(A=58)!(A=124) D .F I1=I+1:1 Q:$E(TXT,I1)'=" " .;I $$INVEN($A($E(TXT,I1))) S HB=0 Q .I '$$INVHB($A($E(TXT,I1))) S HB=0 Q .I $$INVHB($A($E(TXT,I1))) S HB=1 I HB0'=HB,HB,$L(TXT2) S TXT1=$C(A)_TXT2_TXT1 S TXT2="" G INVHBW1 I HB0'=HB,'HB,$L(TXT2) S TXT1=$C(A)_TXT2_TXT1 S TXT2="" G INVHBW1 I HB S TXT2=$C(A)_TXT2 G INVHBW1 S TXT2=TXT2_$C(A) G INVHBW1 INVHBWE Q $TR(TXT1,TS0,TS1) ; INVHBW2 N I2 S HB=0 F I2=1:1:$L(TXT2) I $$INVHB($A($E(TXT2,I2))) S HB=1 Q I $L(TXT2),'HB S TXT1=TXT0_TXT1_TXT2 S TXT2="" Q I $L(TXT2),HB S TXT1=TXT0_TXT2_TXT1 S TXT2="" Q INVEN(A) ; I A>47&(A<58)!(A>64&(A<91))!(A=124) Q 1 Q 0 INVHB(A) I A>95&(A<123) Q 1 I A>127&(A<155) Q 1 I A>223&(A<251) Q 1 Q 0 INVEH(TXT) ; N A S A=$$SPL(TXT) Q A_$J("",$L(TXT)-$L(A)) CLST(ST,%B,%N) ; S %PRW1=0 I '$D(%LIGHT1) D ^%L1C I '$D(TSS)!'$D(TS0) D ^%L1TS I ST[%CLI S ST=$$RPL^%L1FRM(ST,%CLI,%B),%PRW1=1 I ST[($C(27,91,48,109)) S ST=$$RPL^%L1FRM(ST,$C(27,91,48,109),%N) S %PRW1=0 I ST[$TR($C(27,91,48,109),TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR($C(27,91,48,109),TS0,TSS),%N) S %PRW1=0 I ST[$TR(%CLI,TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR(%CLI,TS0,TSS),%B),%PRW1=1 I ST[$TR($C(27,91,48,109),TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR($C(27,91,48,109),TS0,TSS),%N) S %PRW1=0 I ST[%CL0,%CL0'="" S ST=$$RPL^%L1FRM(ST,%CL0,"") I ST[$TR(%CL0,TS0,TSS),%CL0'="" S ST=$$RPL^%L1FRM(ST,$TR(%CL0,TS0,TSS),"") I ST[%HBR S ST=$$RPL^%L1FRM(ST,%HBR,"") I ST[%ENG S ST=$$RPL^%L1FRM(ST,%ENG,"") I ST[%LIGHT1 S ST=$$RPL^%L1FRM(ST,%LIGHT1,"") I ST[$TR(%LIGHT1,TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR(%LIGHT1,TS0,TSS),"") I %PRW1 S ST=ST_%N S %PRW1=0 Q ST CLA(ST) ;--- >64,<122 N ST1,%I S ST1="" F %I=1:1:$L(ST) I $A($E(ST,%I))'<32,$A($E(ST,%I))'>122 S ST1=ST1_$E(ST,%I) Q ST1 MC(%ST1,%D1,%ST2,%D2) ;-- PECHAT LEFI MACKET N %MP,%I,%ST3 S %ST3=" " F %I=1:1:$L(%ST1,%D1) S %RV=$P(%ST1,%D1,%I) S %ST3=%ST3_$J(%RV,$L($P(%ST2,%D2,%I+1)))_" " Q $E(%ST3,1,$L(%ST3)-1) MCH(%ST1,%D1,%ST2,%D2) ; -- PECHAT LEFI MACKET (AFUH) N %MP,%I,%ST3 S %ST3=" " F %I=1:1:$L(%ST1,%D1) S %RV=$P(%ST1,%D1,$L(%ST1,%D1)-%I+1) S %ST3=%ST3_$$HBR^%L1FRM(%RV,$L($P(%ST2,%D2,%I+1)))_" " Q $E(%ST3,1,$L(%ST3)-1) FNDARR(%REF,%VL,%PR) ; S %IND="" N %N,%OK S %N="",%OK=0 F S %N=$O(@%REF@(%N)) Q:%N="" D Q:%OK .I '$G(%PR),@%REF@(%N)=%VL S %OK=1 Q .I '$G(%PR),@%REF@(%N)[%VL S %OK=1 Q I %OK S %IND=%N Q %OK_"\"_%IND %L1FTP %L1FTP(ADR,FL) ; [ 10.11.16 15:51 ] [ 06.08.15 13:55 ] [ 04.08.15 08:53 ] ;;N %ST S %ST="ncftpput -u lev -p 17101957 "_ADR_" /home/lev/ "_FL_" > /dev/null" N %ST S %ST="/pos/sbin/ftpsend.sh "_FL_" "_ADR ; -- /home/lev/upload ;;N %ST S %ST=$$WEBL^W3MAIN_"ftpsend.sh "_FL_" "_ADR S ^L1FTP(+$H,"CMD",$P($H,",",2))=%ST ZSY %ST S ^L1FTP(+$H,"ZSY",$P($H,",",2))=$ZSY Q ; ; TV(ADR,FL,USR,PSW) ; S PORT=44828 S ADR="ftp1.marketman.co.il" S USR="rashad" S PSW="d8fdfSDFew82k" D TV1(FL,ADR,USR,PSW,PORT) ; Q ; TV1(FL,ADR,USR,PSW,PORT) ; S %ST="/usr/bin/ncftpput -u "_USR_" -p "_PSW_" -P "_PORT_" "_ADR_" . "_FL_" > /dev/null" S ^L1FTP(+$H,"CMD",$P($H,",",2))=%ST ZSY %ST S ^L1FTP(+$H,"ZSY",$P($H,",",2))=$ZSY Q TV2(FL); S PORT=44828 S ADR="ftp1.marketman.co.il" S USR="rashad" S PSW="d8fdfSDFew82k" S %ST="/usr/bin/ncftpput -u "_USR_" -p "_PSW_" -P "_PORT_" "_ADR_" NewFormat "_FL_" > /dev/null" S ^L1FTP(+$H,"CMD",$P($H,",",2))=%ST ZSY %ST S ^L1FTP(+$H,"ZSY",$P($H,",",2))=$ZSY Q %L1G2F %L1G2F(GL,FL) ; [ 27.10.09 17:29 ] [ 30.04.07 12:48 ] [ 07.12.05 21:36 ] O FL::1 E Q 0 I $$EXIST^%L1ZOS(FL) C FL:DELETE O FL:(WRITE:NEWVERSION) U FL D WR(GL) ;ZWR @GL C FL Q 1 GR(FL) ; I $$^%L1ZOS(10,FL)<0 Q 0 O FL:(REWIND:READONLY:EXCEPT="G ER") U FL F R A Q:$ZEOF I $E(A)="^" D .N A2,A3 S J=$$FND(A) Q:'J .S A2=$E(A2,J+1,1200) .S A3=$E(A2,1,J-1) .S @A3=A2 EOF C FL Q 1 ER U $P I $P($ZS,",",3)["EOF" G EOF Q 0 WR(MAC) ; N %PR,%MAC1,%MAC2,%ORD S %ORD=1 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 S %MAC2=$E($R,1,$L($R)-1)_$S($E(MAC,$L(MAC))=")":",",1:"") I %PR W MAC_"="_@MAC,! S %MAC1=MAC I $E(%MAC1,$L(%MAC1))=")" S %MAC1=$E(%MAC1,1,$L(%MAC1)-1)_","""")" I $E(%MAC1,$L(%MAC1))'=")" S %MAC1=%MAC1_"("""")" S %MAC1=$Q(@%MAC1) I %MAC1="" Q F Q:%MAC1'[%MAC2 Q:%MAC1="" W %MAC1_"="_@%MAC1,! S %MAC1=$Q(@%MAC1) K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 Q ; FND(A) ; N J,FL S J=0,FL=0 FND1 S J=J+1 I J>$L(A) Q 0 I $E(A,J)="(" S FL=1 I $E(A,J)=")" S FL=0 I $E(A,J)="=",'FL Q J G FND1 %L1GATE %L1GATE(MDPHONE) ; [ 01.02.04 13:41 ] [ 06/20/2002 12:52 PM ] H 15 S PORTN=$G(^PL("MDPORT"),4) S MDMOD=1 I '$D(MDPHONE) S MDPHONE="086812270" S MDTON="T" S US="U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13,10))" S MDXON=$G(^PL("MDXON"),"&K4") D %L2MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,MDXON,$G(LKH1)) Q %L2MD(PORTN,USERMOD,NUMBER,MDTONE,US,XON,MDLKH) ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,JOB,PORTN,USERMOD,NUMBER,MDTONE,MDLKH,%L1MDOK,US,XON,%DELAY,%L2MD) D ^%L1C S %L1MDOK=0,%L2MD="",%L1RCV="",JOB=$J ;;S $ZT="ZG "_$ZL_":ERR^%L2MD" S PRT=$P K ^L1GATE(JOB,"MODEM") S ^L1GATE(JOB,"MODEM")="BEG" ;I $P=PORTN!'PORTN D MSG("CANNOT SELECT YOUR OWN DEVICE.") G EXIT U $P:(CENABLE:CTRAP=$C(3)) O PORTN::0 E D MSG("..LINE IN USE..WAITING..") O PORTN D MSG("READY") ;X US ;D HANGUP X US ;;I $ZB($ZA,2,1) D MSG("DEVICE "_PORTN_" IS AN OUTPUT ONLY DEVICE.") G EXIT INIT ; S %DC=0 S %DT=0,%Y="" P0 X US D CLPORT S %ST="AT&F"_$G(XON)_$C(13) D MSG(%ST) F %J=1:1:$L(%ST) W $E(%ST,%J) D DELAY P01 X US R *%Y1:1 E S %DC=%DC+1 G:%DC<12 P01:%DC#4,P0 D MSG("NO CARRIER") G EXIT G:%Y1=1 EXIT I %Y1'=13 S %Y=%Y_$C(%Y1) G P01 D MSG(%Y) S %DT=%DT+1 S ^L1GATE(JOB,"MODEM","ATZ",%DT)=%Y G:%Y1=1 EXIT I %Y'["OK" G:%DT<12 P01:%DT#4,P0 D MSG("NO CARRIER") G EXIT S %DT=0 I $G(NUMBER) D DELAY G TP1 TP1 X US S NUMBER=$TR(NUMBER,"-","") D CLPORT S ST="ATD"_$G(MDTONE,"P")_"W"_NUMBER_$C(13) W ST D MSG(ST) S TXT=%HBR_$$HBR^%L1FRM($G(MDLKH),30)_" "_$$HBR^%L1FRM(NUMBER,10)_%ENG D MSG(TXT) X US H 5 S OK=0 F I=1:1:60 R A:1 D Q:OK S ^L1GATE(JOB,"MODEM","CONN",I)=A D MSG(A) .I $F(A,"CONN") S OK=1 Q .I $F(A,"BUS") S OK=2 Q .I $F(A,"NO CAR") S OK=3 Q .I $F(A,"NO DIAL") S OK=4 Q I OK'=1 G EXIT I OK=1 K ^L1GATE(JOB,"MODEM") D MSG("MODEM IN USE !") S %L1MDOK=OK EXIT H 1 Q ERR S %L1MDOK=$ZS G EXIT HANGUP ; S %L1RCV="" D ^%L1DVRES(PORTN) X US D HNG^%L1HANG("ATH0ZS0=0") Q CLPORT X US ; F I=1:1:%DELAY R *A:0 I A>0 F R *A:1 E Q Q DELAY ; F %JJJ=1:1:%DELAY Q MSG(TXT) ; N IND S IND=$O(^L1GATE(JOB,"MSG",999999),-1)+1 S ^L1GATE(JOB,"MSG",IND)=TXT_" : "_$J_" %L1MODJ" Q:'$D(^L1GATE(JOB,"DISP")) D ZU D:'$D(%HBR) ^%L1C W *7,*27,7,$$DLY(),%HBR,$C(27,91)_"1;1H"_$$DLY()_%chists_$$DLY()_$$DLY()_$C(27,91)_"1;"_(80-$L(TXT)\2)_"H"_%LIGHT1_TXT_" ",$$DLY(),$$DLY(),$C(27,91,48,109),*27,8 Q DLY() ; N JJJJ S DLY="" F JJJJ=1:1:10000 Q DLY HANGJ(PORTN) ; S US="O PORTN U PORTN:(0::::#001001:#800040:8::$C(13))" D ^%L1DVRES(PORTN) O PORTN X US D HNG^%L1HANG("ATH0Z"_$G(^PL("MDRING"),1)_$G(^PL("MDXON"))_$S($G(^PL("MDLOW")):"L1",1:"")) Q ZU ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U ^[$$^%L1GLD]dev(1):(NOECHO:NOWRAP) Q %L1GCH %L1GCH ;MJ;GLOBAL CHARACTERISTICS %STAT -> %GLB [ 05/23/99 4:42 PM ] [ 10/20/97 4:50 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1990 ; INPUT %GLB - GLOBALS NAME, %STAT - LIST OF STATUS ; SHEER ; EXAMPLE : ; %STAT="1,2,3,4" --- NONE - System, R - World, RW - Group, RWD - User N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%GLB,%STAT,%L1GCHER) I $ZV[" 4." Q S $ZT="ZG "_$ZL_":ERROR^%L1GCH" S %L1GCHER=0 O 63::0 I '$T W !!,"View Buffer busy.. Please retry later" G EXIT D GETVG^%VGUTIL S:'$D(%MGR) %MGR=($ZU($P($$^%L1ZU(0),","),$P($$^%L1ZU(0),",",2))="1,0") ;W !?10,$P($P($ZV,","),"-")," - Global Characteristics Utility" %GLOBAL S %UCI="",%VGN=$P($$^%L1ZU(0),",",2) ; W !!,"Enter Global Name > " R %GLB G:%GLB=""!(%GLB="^")!(%GLB="^Q") EXIT S %QF=0,%EF=0 S %QF=0,%EF=0 ; I %GLB["?" S %HLP=1 D ^%GCH2 G %GLOBAL ; I %GLB["^D" D INT^%GD G %GLOBAL S:%GLB?1"^".E %GLB=$E(%GLB,2,99) I %GLB["[" S %UCI=$P(%GLB,"]"),%GLB=$P(%GLB,"]",2) %CHECK I %UCI["""" F %I=1:1:$L(%UCI) I $E(%UCI,%I)="""" S $E(%UCI,%I)="",%I=%I-1 I %UCI'="",%UCI'?1"["3U1","3U,%UCI'?1"["3U W *7," Invalid cross UCI notation " S %L1GCHER=1 G EXIT I %UCI'="" S:$L(%UCI)<5 %UCI=%UCI_","_%VGN ;S %GLB="["""_$P(%UCI,"[",2)_"""]"_$P(%GLB,"]",2) I %UCI'="" S %VGN=$P(%UCI,",",2) S %UCI=$E(%UCI,2,4) S %UI=$ZU(%UCI,%VGN) I %UI<1 W *7," Nonexistent UCI name" S %L1GCHER=1 G EXIT ;I (%UCI'="")&('%MGR) W !,*7,"Cross UCI is notation not available from non manager UCI" G %GLOBAL S %UI=$S(%UCI'="":+%UI,1:$V(2,$J,2)#32),(%VGI,VGI)=VG(%VGN),%VGSLOT="G"_%VGI D GETVOL^%VGUTIL I '(%GLB?1"%".AN!(%GLB?1A.AN)) W " Invalid global name ",*7 S %L1GCHER=1 G EXIT I $L(%GLB)>8 W " Global name must be 8 characters or less ",*7 S %L1GCHER=1 G EXIT S %PTRS=$V($V(44)+8,-3,2),%USZ=$V($V(44)+14,-3,2),%VGPTR=$V(40+%PTRS+$V(44)),%VGPTR1=$V(%VGI*4+%VGPTR),%UT=%UI-1*32+$V(%VGPTR1+20) UCINUM ; S %GBN=$V(%UT+4,-3,4),GN=%GLB,%GLB=%GLB_$C(0) %GDBLK V %GBN:%VGSLOT S OF=$V(1022,0),TYP=1,TFL=$E($V(1021,0,1,3)) S K="" K KEY S I=$S(TYP=1&TFL&($V(0,0,4)=0):13,1:0) F I=I:0:OF-1 S CC=$V(I,0,1),UC=$V(I+1,0,1),K=$E(K,1,CC)_$V(I+2,0,UC,1),KEY(I)=K,I=I+UC+2+$S(TYP=8:$V(I,0,1)+1,TYP=1&TFL:11,1:3) S %F=0,%X=-1 %GDENT S %X=$N(KEY(%X)) I %X'<0 G:$S(TFL:%GLB]KEY(%X),1:KEY(%X)]%GLB) %GDENT S:%GLB=KEY(%X) %F=1 I 'TFL,'%F S %GBN=$V(%X+2+$V(%X+1,0,1),0,3) G %GDBLK I TFL,'%F S %GBN=$ZB($V(1012,0,4),#FFFFFF,1) G:%GBN>0 %GDBLK I '%F&%EF W !!,"GLOBAL NOT FOUND IN DIRECTORY!!, CALL SYSTEM MANAGER" G EXIT I '%F W " does not exist.. ",*7 %GDENT1 S %HLP=2 I '%F S %RSP="Y" ; W !,"Do you want to create global ^",$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]"),GN," " R %RSP I (%RSP'="Y")&(%RSP'="N")&(%RSP'="")&(%RSP'="^")&(%RSP'="^Q")&(%RSP'="?") W " ?? ",*7 G %GDENT1 I '%F S:%RSP="" %RSP="Y" D ^%GCH2:%RSP["?" G %GDENT1:%RSP["?",EXIT:%RSP["^Q"!(%RSP["^")!($E(%RSP,1)="N") I '%F S:%UCI="" %UCI=$P($$^%L1ZU(0),",") J %L1GCH1(%UCI,%VGN,GN)[%UCI] S %EF=1 W !,"Global created" S %GLB=GN G UCINUM S %OF=%X+2+$V(%X+1,0,1)+4 S %USTS=(($V(%OF,0,1)#4)=3) G %OPT ERROR ; I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q EXIT ; I %L1GCHER=0 U 0 W " ------ DONE",! I $D(^ZZZZZZZZ)!($D(^UTILITY)) ; FLUSHES LOCAL COPY OF CHANGED GLOBAL C 63 K %,%ANS,%BLK,%DIV,%DN,%DR,%DT,%EF,%GBN,%GLB,%HLP,%I,%MF,%NB,%OPT,%PC,%PT,%QF,%QST,%QUE,%RSP,%RSPHLD,%T,%X,CLASS,GN,PRO,PROTECT,KEY,%OF,XEM,%F,%MAX,%UI,%USZ,%UT,CC,I,K,OF,TFL,TYP,UC,XE K %B,%DB,%GNUM,%GSN,%MGR,%NAM,%PR,%ST,%UCI,%USTS,COL,NEW,SEQ,%GVN,VG Q %OPT ; --- S %QUE=1,%HLP=3 D %SEL G EXIT:%QF=2,%GLOBAL:%QF ; --- G ^%GCH1:%OPT=1,%GRO^%GCH1:%OPT=2,%PRO:%OPT=3,%JRN^%GCH1:%OPT=4 S %NUM=1 %PRO ; I ('%MGR)&('%USTS) W !,*7,"Protection access denied to ^",GN G %OPT ;W !!,"Current Status -->" D %LST S PROTECT=$V(%OF,0,1) ; S %QUE=2,%HLP=4 D %SEL G EXIT:%QF>1,%OPT:%QF S %OPT=+$P(%STAT,",",%NUM) S PRO=$S(%OPT=1:0,%OPT=2:1,%OPT=3:2,%OPT=4:3,1:4) ; %CLASS S %QUE=3,%HLP=5 S %OPT=%NUM ; D %CLASS1 D %SEL G EXIT:%QF>1,%PRO:%QF ; %CLASS1 F %I=1:1 S XE=$P(%OPT,",",%I) Q:XE="" S %PT(XE)=PRO %UPDT S PROTECT=0,%DIV=256 F %X=1:1:4 S %DIV=%DIV\4,PROTECT=PROTECT+(2*%DIV*(%PT(%X)\2)+(%DIV*(%PT(%X)#2))) V %OF:0:PROTECT:1 ;W !!," New Status --> " D %LST D %LST V -%GBN:%VGSLOT B %AGAIN G:%NUM=4 EXIT S %NUM=%NUM+1 G %PRO %LST S %DIV=256 F %X=1:1:4 S %DIV=%DIV\4,%PC=$V(%OF,0,1)\%DIV#4,%PT(%X)=%PC ;W ?(%X-1*15+20),$P("System,World,Group,User",",",%X)," = ",$P("NONE,R,RW,RWD",",",%PC+1) Q %SEL ;OPTION DRIVER S %OPT=3 Q ; --- S %MF=0 W !!,"Select ",$P($T(@("MENU"_%QUE)),";",2,99) W !! F %I=1:1 S %T=$T(@("MENU"_%QUE)+%I) Q:$P(%T,";",2)="*" W !,?5,%I,?10,$P(%T,";",2) W !!,$P($T(@("MENU"_%QUE)+%I+1),";",2) %SEL1 W " ^",$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]"),GN," > " R %RSP S %QF=$S("^Q"=%RSP:2,"^"[%RSP:1,""=%RSP:1,1:0) Q:%QF I %RSP?1"?".E D ^%GCH2 G %SEL I %RSP["," D %SEL4 I %RSP'["," D %SEL2 G %SEL1:%QF>1,%SEL:'%QF S %QF=0 Q %SEL2 I %RSP?1N.N G %SEL3 ;SELECTION BY LEADING CHARACTER S %QF=0 F %I=1:1 S %T=$P($T(@("MENU"_%QUE)+%I),";",2) Q:%T="*" I %RSP=$E(%T,1,$L(%RSP)) S %QF=%QF+1,%OPT=%I Q:%QUE=2 I %QF=0 G %SEL5 I (%QF=1)&(%MF=1) W $E($P($T(@("MENU"_%QUE)+%OPT),";",2),1,255) Q E W $E($P($T(@("MENU"_%QUE)+%OPT),";",2),$L(%RSP)+1,255) Q W !!,*7,"Please be more specific ",! F %I=1:1 S %T=$P($T(@("MENU"_%QUE)+%I),";",2,99) Q:%T="*" I %RSP=$E(%T,1,$L(%RSP)) W !,?5,%I,?10,%T W !!,$P($T(@("MENU"_%QUE)+%I+1),";",2)," " Q %SEL3 I (%RSP<%I&%RSP>0) W " ",$P($T(@("MENU"_%QUE)+%RSP),";",2,99) S %QF=1,%OPT=%RSP Q E S %QF=0 G %SEL5 %SEL4 I %QUE'=3 W !!,*7,"Enter one choice only ",! S %QF=0 Q S %RSPHLD=%RSP,%MF=1 W " " F %X=1:1 S %RSP=$P(%RSPHLD,",",%X) Q:%RSP="" D %SEL2 Q:%QF'=1 S $P(%RSPHLD,",",%X)=%OPT W:$L(%RSPHLD,",")'=%X "," S %MF=0,%RSP=%RSPHLD Q:%QF'=1 S %OPT=%RSPHLD Q %SEL5 W !!,*7,"Invalid option selection, enter '?' for more help" Q %L1GCH1(%UCI,%VGN,GN) ; S @("^["""_%UCI_$S(%VGN="":"",1:""","""_%VGN_"""]")_GN_"(1)")=1 K ^(1) ZF Q MENU1 ;OPTION ;Collating Sequence ;Global Growth ;Protection ;Journaling ;* ;Enter option for MENU2 ;PROTECTION STATUS ;N - None ;R - Read ;RW - Read/Write ;RWD - Read/Write/Delete ;* ;Enter protection for MENU3 ;CLASS ;System ;World ;Group ;User ;* ;Enter class for %L1GCHM %L1GCHM ; GLOBAL CHARACTERISTICS %STAT (4,4,4,4) TO SET GLOBALS [ 05/23/99 4:43 PM ] [ 06/06/94 12:55 PM ] D ^%GSEL Q:'$D(^UTILITY($J)) S %GLB="" F S %GLB=$O(^UTILITY($J,%GLB)) Q:%GLB="" D .D ^%L1GCH Q %L1GDEL %L1GDEL ; n %ZG,n,yes u $p:(ECHO) d ^%GSEL Q:'$D(%ZG) ZS R !!,"Are Yoy shure ? (y/n) ",yes s yes=$$FUNC^%LCASE($E(yes)) i yes'="y",yes'="n" g ZS i yes'="y" q s n="" f s n=$o(%ZG(n)) q:n="" K @n u $p w !,n," -- deleted" q %L1GET %L1GET ;*** SCREEN INPUT ; [ 30.10.23 10:25 ] [ 15.03.19 14:43 ] [ 07.03.19 23:36 ] ;%GET="**SAY**++%YY,%XX{,SHRIFT1}{,I},{R}#**DEFAULT**++%LS,SHRIFT2{,I}{++CIST}<++HELP><++^FILE\FILE(1)\FILE(2)\FILE(3)\FILE(4)\FILE(5)\FILE(6)\/RZD><++%CMD> ; SHRIFT1=HH ! HE ! EH ! EE { E - ENGLISH, H - HEBREW ; SHRIFT2=H ! E ! D ! T ; I - INVERS LIGHT FLAG ; %LS - LENGTH OF ANSWER ; CIST - CHARACTERS AVALAIBLE SET ; FILE - GLOBAL NAME TO FIND %S ; FILE(1) - LENGTH OF GLOBAL INDEX ; FILE(2) - LENGTH OF TEXT ; FILE(3) - TOP BOUNDARY OF WINDOW ; FILE(4) - IF ["V" LOOK UP TEXT ; IF ["P" CHECK INTO TABLE ; IF ["C" CREAT INTO TABLE ; FILE(5) - HEAD OF CREAT TABLE ; %CMD - MUMPS STATEMENTS ;I %HELP="-" - NO SHOW HELP I '$D(%OPT) D ^%L1C O 0 U $P:(NOECHO:NOWRAP) N %FLINS Z0 N J,X1,X2,Y1,Y2,%ECHO,%SAY,%HH0,%LS,%LS0,%LS1,%INV,%RB,%GETOLD,%YYGET N %XX,%YY,%XX1,%HH,%L1DS,%S1,%SS,%L1RBCL,%L1GETR N FILE,RZD,%HELP,%XX0,%YY0,%XXX,%YYY N %ZMSFO,%ZMSLO,CIST S %ZMSFO=$G(%ZMSF,"%L1GET"),%ZMSLO=$G(%ZMSL) ; N %A S %A=$P(%GET,"#",2,100) S %A=$P(%A,"++",1,2) N %OK S %OK=0 N %J F %J=$L(%A):-1:2 I $E(%A,%J-1,%J)="++" S %OK=%J-1 Q S %S=%A I %OK S %S=$E(%A,1,%OK-1) S F7=0,%TO="" ; Z K %L1GTRPT S %SAY=$P(%GET,"#",1) S %L1GETR="" X %XCL X %XMSG ; S %ZMSL=%ZMSLO I %ZMSFO'="%L1GET" S %ZMSF=%ZMSFO S %LS0=$L($TR($P(%SAY,"++"),"{}","")) S %HH0=$P($P(%SAY,"++",2),",",3) ;;I %ENGLISH S %HH0="EE" S %XX0=$P($P(%SAY,"++",2),",",2) S %YY0=$P($P(%SAY,"++",2),",") S %RB=$P($P(%SAY,"++",2),",",5) ; S %SS=$P(%GET,"#",$L(%GET,"#")) I $E(%SS,1,3)="+++",$E(%SS,1,4)'="++++" S %S="+",%SS=$E(%SS,2,$L(%SS)) S CIST=$P(%SS,"++",3) I CIST="" K CIST S (%LS,%LS1)=$P($P(%SS,"++",2),",") S %LS=+%LS S %HH=$P($P(%SS,"++",2),",",2) S %INV=$P($P(%SS,"++",2),",",3) S %HELP=$P(%SS,"++",4) S FILE=$P($P(%SS,"++",5),"\",1) S FILE(1)=$P($P(%SS,"++",5),"\",2) I FILE'="",FILE(1)="" S FILE(1)=%LS S FILE(2)=$P($P(%SS,"++",5),"\",3) I FILE'="",FILE(2)="" S FILE(2)=20 S FILE(3)=$P($P(%SS,"++",5),"\",4) I FILE'="",FILE(3)="" S FILE(3)=+$P(%SAY,"++",2)+3 S FILE(4)=$P($P(%SS,"++",5),"\",5) S FILE(5)=$P($P($P(%SS,"++",5),"\",6),"/") S FILE(6)=$P($P(%SS,"++",5),"\",7) S RZD=$P($P(%SS,"\/",2),"++") I RZD="" S RZD="/\" ;"\/" I FILE'="",%HELP="" S %HELP=" - d`ivi , e` * - dbvd "_$S(FILE'["(":", e` ? - my zlgzd itl yetig ",1:"") I %HELP'="",'$D(%L1GET),%HELP'="-" D .N %SAY,%XX,%YY,%XX0,%YY0 S %SAY=%HELP X %XMSGN S %CMD=$P(%SS,"++",6) ; I %RB="R"!($G(FILE(4))["V") D .N %XXX,%YYY .S %XXX=%XX,%YYY=%YY .I $E(%HH0)="E" S X1=%XX-1,X2=%XX0+%LS0+%LS1+2 I $G(FILE(4))["V" S X2=X2+FILE(2)+2 .I $E(%HH0)="H" S X1=%XX0-%LS0-%LS1-2,X2=%XX0+2 I $G(FILE(4))["V" S X1=X1-FILE(2)-3 .I X1<1 S X1=1 .I X2>79 S X2=79 .S Y1=%YY,Y2=%YY+2 .S %XX=X1+1 X %POSIC W $J("",X2-X1-1) .S %XX=%XXX,%YY=%YYY .Q K:%INV'["I" %INV D VSV X %XCL X %XMSG I %RB="R" D ^%L1RBUA ;RBUA1^%L3MENU ;S %LS1=%LS I %HH="H"!(%HH="E"),$E(%HH0)="H",$D(%L1GET) K %XX1 S %S1=%S,%SAY=$J(%S,%LS)_"++"_%YY_","_$S(%HH="E":%XX-%LS-1,1:%XX-1)_","_%HH X %XMSG G EN I $E(%HH0)="E" S %XX=%XX+%LS0+1 S:%XX+%LS>79 %XX=79-%LS-1 S:%HH="H" %XX=%XX+%LS+1 I %HH="E" S:$E(%HH0)="H" %XX=%XX-%LS-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 S %XX1=%XX X %POSIC S $X=%XX,$Y=%YY D S %S1=%S G EN .N:$A(%S)<96&'$D(%GET("H")) %HBRY D ^%ZMSL I %HH="H" S $X=%XX-2,$Y=%YY S %XX1=%XX-%LS-1 D ^%L1ZMS S %S1=%S G EN I %HH="D" S %L1DS=%S S %XX=%XX-$S(%ENGLISH:-2,1:8)-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 X %POSIC S %XX1=%XX S $X=%XX-1,$Y=%YY D ^%L1DAT S %S1=%L1DAT1 G EN I %HH="T" S %L1TS=%S S %XX=%XX-$S(%ENGLISH:-2,1:8)-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 X %POSIC S %XX1=%XX S $X=%XX-1,$Y=%YY D ^%L1TIME S %S1=%L1TIME1 G EN EN G:$G(%TO)="END" END S:$G(%L1GET)="END" %TO="END" I $D(%L1GET) G END I %LS1[".",%HH="E",+%S S (%S,%S1)=$TR($J(%S,%LS1)," ",0) S %XX=%XX1 X %POSIC W %S1 I $G(%TO)="F6"!($G(%TO)="F7")!((%S="*")!(%S="?")&($G(%TO)="")),FILE'="" S %REST=1 D D:%REST PUT S:'$D(%L1GET)&($G(%S)'="") %L1GET="E" G Z .N %GET .N %XXX,%YYY S:%S="*"&($G(%TO)="") %TO="F7",%S="" S:%S="?"&($G(%TO)="") %TO="F6",%S="" .S %XXX=%XX0,%YYY=%YY0 .N STRING,FLAG,%CLEAR,%XX S %CLEAR=1,%YYGET=%YY S F7=1 .D GET S %REST=1 .D @$S($G(%TO)="F7":"DAFUS^%L3MBGS",1:"POISK^%L3MBGS") I $G(FLAG)'=""!'$D(STRING) S %S="",%XX=%XXX,%YY=%YYY Q .S %S=STRING S %XX=%XXX,%YY=%YYY I %CMD'="" X %CMD I $G(%L1GTRPT) G Z I FILE'="",FILE(4)["P",%S'="",'$D(@FILE@(%S)) S %GETOLD=%GET S %REST=0 D D:%REST PUT S %GET=%GETOLD X "I '$D(%L1GET),$G(%S)'="""",$D(@FILE@(%S))" S:$T %L1GET="E" G Z .I FILE(4)'["C" X %XMSGV("ER") S %S="" Q .S %YYGET=%YY D GET .N (%XMSG,%UPRCOD,%XMSGV,%XMSGN,%YY,%XX,FILE,%S,%REST,%TO,GVIDEO) D ^%L1C .S STRING=%S .S %GET="99 - miwdl . miiw `l" D N^%L1GET I %S'=99 X %XMSGV("ER") S %S="" Q .N GLOB S GLOB=$E(FILE,2,20) I $D(^TABLs(GLOB)) D G F ..I $D(^TABLs(GLOB,"PROG")) D Q ...S %PROG=^("PROG") ...N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG,GVIDEO,STRING,GLOB) D ^%L1C S:$L(STRING)&$D(^TABLs(GLOB,"KEY")) @^("KEY")=STRING N GLOB D @%PROG ..D I^%L1TABL .S NSNAME=$G(FILE(5)) D ^%L1SCS F .S %REST=1 S %S=STRING Q END I $D(%XX1),$G(%INV)'="II" S %XX=%XX1 X %XCL,%LIGHT,%POSIC W $S($G(%HH)="E":%S1_$J("",%LS1-$L(%S1)),1:$TR($TR($J(%S1,%LS1),%TES1,%TES2),%TEN,%THB)) X %XCL ;I '$G(F7) D VSV ;;I %ENGLISH S %S=$$CAPIT(%S) D VSV I %YY=24 S %SAY="" X %XMSGN I %YY=0 S %SAY="" X %XMSGV K %HH,%HH0,%SAY,CIST,%LS,%SAY,%INV,%RB,%GET,%GETIN,%GETHB,%FLINS,%ZMSF,%ZMSL I $G(%L1GET)="E" K %L1GET Q ;- N ; VNIZU N TOUCH S TOUCH=$$HZGTOUCH^%L2MOUSE&'$$KB^%L2MOUSE,%S="",%TO="" I TOUCH,%GET["",%GET'[",",%GET'[";" D D MSG^%L1GET K %GET,%GETIN Q .S %GET("ISY")=20 .S %GET=$P(%GET,"",2) I %GET="" S %GET=" ugl " I TOUCH,$TR(%GET," ","")="99-qitcdl"!($TR(%GET," ","")="-qitcdl") D K %GET,%GETIN Q .S %GET("DEF")=1 .S %GET("IS")="qitcdl",%S="" D IS .I YES S %S=99,%TO="F9" I TOUCH,$TR(%GET," <>-","")="99xy`l"!($TR(%GET," <>-","")="99xey`l")!($TR(%GET," <>-","")="F9xy`l")!($TR(%GET," <>-","")="F9xey`l") D K %GET,%GETIN Q .S %GET("IS")="xy`l",%S="" D IS^%L1GET .I YES S %S=99,%TO="F9" I TOUCH,$TR(%GET," ","")["(l/k)" D K %GET,%GETIN Q .S %GET("IS")="? "_$P(%GET,")",2,6),%S="" D IS^%L1GET .S %S=$S(YES:"k",1:"l"),%TO="" I TOUCH,%GET["-"&(%GET[",")!(%GET["{}") D G:$G(%TO)="VNIZE" N K %GET,%GETIN Q .N %SMB S %SMB=$S(%GET["{}":"{}",1:"") .I %GET'["zepey" S %GET=%SMB_"VNIZE"_%SMB_" - zepey ,"_%GET .I %GET'["ESC",'$D(%GET("NOESC")) S %GET=%SMB_"ESC"_%SMB_" - xefgl ,"_%GET .D HZG^P1HZGKEY(%GET) .I %TO?1N.N S %S=%TO,%TO="" .I %TO["ENTER" S %TO="" .I %TO["VNIZE",$G(^zms($P))?1"^"."%"1U.E W *27,7 K:%TYPCRT="PC" ^zms($P,"SCRN") D ^%L1ZMST Q .;;I $E(%TO)="F",%GET'[%TO S %S=$E(%TO,2,3)#10,%TO="" S:%S=9 %S=99 I TOUCH,$TR(%GET," ","")["99-"!($TR(%GET," ","")["F9"),%GET'[",",$P(%GET,"-",3)="" D K %GET,%GETIN Q .S %GET("IS")=%GET .S %GET("DEF")=1 .I %GET["-" S %GET("IS")=$P(%GET,"-",2) .I %GET("IS")[">" S %GET("IS")=$P(%GET("IS"),">",2) .S %GET("IS")=$$RPL^%L1FRM(%GET("IS"),"xey`l","xy`l") .D IS^%L1GET I YES S %TO="F9",%S=99 S %ZMSF="" I '$D(%POSIC)!'$D(%ENGLISH) D ^%L1C I %ENGLISH G NE N %ECHO O 0 U $P:(NOECHO:NOWRAP) X %XCL S %XX=0,%YY=24 X %POSIC W %chists N %SS S %SS=$P(%GET,"#",2),%GET=$P(%GET,"#",1) N %LS S %LS=+%SS I %LS'>0 S %LS=2 D HX I $D(^mbg1($P,"H")) S ^mbg1($P,"H")=0 ;-- LEADKEN HELP B- ^%L3MBG ;S %GET=$P($G(%GET),"++")_"++23,"_(80-%XXX)_",HH#"_$G(%GETIN)_"++"_%LS_",E,I" G %L1GET S %GET=$P($G(%GET),"++")_"++24,"_(80-%XXX)_",HH++MB,WF#"_$G(%GETIN)_"++"_%LS_","_$S($D(%GETHB):"H",1:"E")_",I" G Z0 ;%L1GET V ; VERHU S %ZMSF="" I '$D(%POSIC)!'$D(%ENGLISH) D ^%L1C I %ENGLISH G VE N %ECHO U $P:(NOECHO:NOWRAP) S %XX=0,%YY=0 X %POSIC W %chists N %SS S %SS=$P(%GET,"#",2) N %LS S %LS=+%SS I %LS'>0 S %LS=2 D HX S %GET=$P($G(%GET),"++")_"++0,"_(80-%XXX)_",HH++RB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET NE ; VNIZU ENG S %ZMSF="" I '$D(%POSIC) D ^%L1C N %ECHO U $P:(NOECHO:NOWRAP) S %XX=0,%YY=24 X %POSIC W %chists N %LS S %LS=+$P(%GET,"#",2) I %LS'>0 S %LS=2 S %GET=$P(%GET,"#") S %LT=$L($TR($P($G(%GET),"++"),"{}","")) S %GET=$P($G(%GET),"++")_"++24,"_(80-%LT-%LS-2\2)_",EE++MB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET VE ; VERHU ENG S %ZMSF="" I '$D(%POSIC) D ^%L1C N %ECHO U $P:(NOECHO:NOWRAP) S %XX=0,%YY=0 X %POSIC W %chists N %LS S %LS=+$P(%GET,"#",2) I %LS'>0 S %LS=2 S %GET=$P(%GET,"#") S %GET=$P($P($G(%GET),"++"),"#")_"++0,5,EE++RB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET Q VSV I $G(FILE(4))["V" D .N %XXX,%YYY,%TBL .S %XXX=%XX0,%YYY=%YY0 .N %SAY .I $E(%HH0)="E" S %XX=%XX0+%LS0+%LS1+5 .I $E(%HH0)="H" S %XX=%XX0-%LS0-%LS1-2 .I $L($G(FILE))>2,$D(^TABLs($E(FILE,2,20),"VSV")),$L(%S) S @("%TBL="_^TABLs($E(FILE,2,20),"VSV")) .I $E(%HH0)="E",%S'="" S %SAY=$E($P($G(@FILE@(%S)),RZD),1,FILE(2))_"++"_%YY_","_(%XX-2)_",EE++AA,YF L" X %XMSG D REST Q .I $E(%HH0)="H",%S'="",$D(%TBL) S %SAY=$$HBR^%L1FRM(%TBL,FILE(2))_"++"_%YY_","_(%XX-2)_",HH++AA,YF L" X %XMSG D REST Q .I $E(%HH0)="H",%S'="" S %SAY=$E($P($G(@FILE@(%S)),RZD),$L($P($G(@FILE@(%S)),RZD))-FILE(2)+1,255)_"++"_%YY_","_(%XX-2)_",HH++AA,YF L" X %XMSG D REST Q .I %S="" S $P(%SAY,"++")=$J("",FILE(2))_"++"_%YY_","_(%XX-2)_","_$S($E(%HH0)="E":"EE",1:"HH") X %XMSG D REST Q Q REST S %XX=%XXX,%YY=%YYY Q GET I %TYPCRT="PC",'$D(%GET("REST")),'$D(%GETREST) D GET^%VIDEO("GVIDEO",0,0,79,24,2) Q Q PUT I %TYPCRT="PC",'$D(%GET("REST")),'$D(%GETREST),$D(GVIDEO)!$D(^P1VIDEO($$POS^%L2MOUSE)) X %chista D PUT^%VIDEO("GVIDEO",0,0,79,24,2) Q X:%CMD'="" %CMD N %PUTS S %PUTS=%S I $D(%GET("REST")) X %GET("REST") I $D(%GETREST) X %GETREST S %S=%PUTS Q HX S %XXX=80-$L($TR($P(%GET,"++"),"{}",""))\2-5 I %XXX<1 S %XXX=1 Q IS I $$HZGTOUCH^%L2MOUSE D ^%L1YNT K %GET S YES=($G(%TO)="F2") Q S YES=0 N %S,%GETIN S %GET=" - xy`l " I $G(%ENGLISH) S %GET=" CONFIRM - " D N S:%TO="F9" %S=99 I %S=99 S YES=1 Q IS1 I $$HZGTOUCH^%L2MOUSE G IS N %HBRY,%FLINS S YES=0,%TO="" S %HBRY="",%GETHB="",%FLINS=0 I '$D(%ENGLISH) D ^%L1C N %S S %GET=" (l/k) - "_$G(%GET("IS")," xy`l ") I $G(%ENGLISH) S %GET=$G(%GET("IS")," CONFIRM")_" (Y/N) " I $G(%GETIN)="k",%ENGLISH S %GETIN="Y" N %ISGET I $D(%GET("IS")) S %ISGET=%GET("IS") D N S:%TO="END"&(%S'="l") %S="" K %GETIN S:$D(%ISGET) %GET("IS")=%ISGET I "klFKfNnYhy"'[%S!'$L(%S) W *7 G IS1 S YES=("kFfYhy")[$E(%S)&$L(%S) K %GET Q IS2 I $$HZGTOUCH^%L2MOUSE G IS S %GETIN="k" G IS1 IS3 S %GETIN=2,%GET="{}0{} - rval `l , {}2{} - rval , {}1{} - owzl " I %ENGLISH S %GET=" MODIFY - 1, PERFORM - 2 , CANCEL - 0 " I '$$HZGTOUCH^%L2MOUSE D N^%L1GET I $$HZGTOUCH^%L2MOUSE D .D HZG^P1HZGKEY(%GET) .S %S=%TO I %TO="END" G IS3 I %S'=0,%S'=1,%S'=2 W *7 G IS3 Q ; CAPIT(%ST) N J,%SMB N J F J=1:1:$L(%ST) S %SMB=$E(%ST,J) D .I $A(%SMB)<123,$A(%SMB)>96 S $E(%ST,J)=$C($A(%SMB)-32) Q %ST MSG ; I '$$HZGTOUCH^%L2MOUSE G N N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%GET) D ^%L1C D SAVE^%L3MBGG X %LIGHT N XX1,XX2,YY1,YY2 S XX1=20,YY1=8,XX2=XX1+40 I $L(%GET)>40 S XX1=78-$L(%GET)\2,XX2=XX1+$L(%GET)+2 I $D(%GET("ISY")) S YY1=%GET("ISY") S YY2=YY1+5 S %L1RBCL=%CV("MB") D TV^%L1RBUA(YY1,XX1,YY2,XX2) N TXT S TXT=%GET X %LIGHT S %SAY=TXT_"++"_YY1_","_(XX2-1-(XX2-XX1-$L(TXT)\2))_",HH++MB,YF" X %XMSG N MTXT,Y0,Y2,X0,X2,SH,COLX,COLY S MTXT("B")=%CV("MB") S MTXT(1,1)=" O K "_$J("",XX2-XX1-10\2) S MTXT(1,1,"TO")="" S Y0=YY1+2,Y2=YY2-1,X0=XX1+2,X2=XX2-2 S COLX=$O(MTXT(1,20),-1),COLY=1,SH=1 S STEPX=XX2-XX1-4,STEPY=2,%PREV="" D TV^P1RBUA S %S="" D REST^%L3MBGG Q %L1GET1 %L1GET ;*** SCREEN INPUT ; [ 04/19/99 9:15 AM ] [ 04/05/99 3:54 AM ] [ ;%GET="**SAY**++%YY,%XX{,SHRIFT1}{,I},{R}#**DEFAULT**++%LS,SHRIFT2{,I}{++CIST}<++HELP><++^FILE\FILE(1)\FILE(2)\FILE(3)\FILE(4)\FILE(5)\/RZD><++%CMD> ; SHRIFT1=HH ! HE ! EH ! EE { E - ENGLISH, H - HEBREW ; SHRIFT2=H ! E ! D ! T ; I - INVERS LIGHT FLAG ; %LS - LENGTH OF ANSWER ; CIST - CHARACTERS AVALAIBLE SET ; FILE - GLOBAL NAME TO FIND %S ; FILE(1) - LENGTH OF GLOBAL INDEX ; FILE(2) - LENGTH OF TEXT ; FILE(3) - TOP BOUNDARY OF WINDOW ; FILE(4) - IF ["V" LOOK UP TEXT ; IF ["P" CHECK INTO TABLE ; IF ["C" CREAT INTO TABLE ; FILE(5) - HEAD OF CREAT TABLE ; %CMD - MUMPS STATEMENTS ;I %HELP="-" - NO SHOW HELP I '$D(%OPT) D ^%L1C U $P:(NOECHO:NOWRAP) N %FLINS Z0 N J,X1,X2,Y1,Y2,%ECHO,%SAY,%HH0,%LS,%LS0,%LS1,%INV,%RB,%GETOLD,%YYGET N %XX,%YY,%XX1,%HH,%L1DS,%S1,%SS,%L1RBCL N FILE,RZD,%HELP,%XX0,%YY0,%XXX,%YYY N %ZMSFO,%ZMSLO,CIST S %ZMSFO=$G(%ZMSF,"%L1GET"),%ZMSLO=$G(%ZMSL) S %S=$P($P(%GET,"#",2,100),"++"),F7=0,%TO="" Z S %SAY=$P(%GET,"#",1) S %L1GETR="" X %XCL X %XMSG K %L1GETR ; S %ZMSL=%ZMSLO I %ZMSFO'="%L1GET" S %ZMSF=%ZMSFO S %LS0=$L($TR($P(%SAY,"++"),"{}","")) S %HH0=$P($P(%SAY,"++",2),",",3) ;;I %ENGLISH S %HH0="EE" S %XX0=$P($P(%SAY,"++",2),",",2) S %YY0=$P($P(%SAY,"++",2),",") S %RB=$P($P(%SAY,"++",2),",",5) ; S %SS=$P(%GET,"#",$L(%GET,"#")) I $E(%SS,1,3)="+++",$E(%SS,1,4)'="++++" S %S="+",%SS=$E(%SS,2,$L(%SS)) S CIST=$P(%SS,"++",3) I CIST="" K CIST S (%LS,%LS1)=$P($P(%SS,"++",2),",") S %LS=+%LS S %HH=$P($P(%SS,"++",2),",",2) S %INV=$P($P(%SS,"++",2),",",3) S %HELP=$P(%SS,"++",4) S FILE=$P($P(%SS,"++",5),"\",1) S FILE(1)=$P($P(%SS,"++",5),"\",2) I FILE'="",FILE(1)="" S FILE(1)=%LS S FILE(2)=$P($P(%SS,"++",5),"\",3) I FILE'="",FILE(2)="" S FILE(2)=20 S FILE(3)=$P($P(%SS,"++",5),"\",4) I FILE'="",FILE(3)="" S FILE(3)=+$P(%SAY,"++",2)+3 S FILE(4)=$P($P(%SS,"++",5),"\",5) S FILE(5)=$P($P($P(%SS,"++",5),"\",6),"/") S RZD=$P($P(%SS,"\/",2),"++") I RZD="" S RZD="/\" ;"\/" I FILE'="",%HELP="" S %HELP=" - d`ivi , e` * - dbvd "_$S(FILE'["(":", e` ? - my zlgzd itl yetig ",1:"") I %HELP'="",'$D(%L1GET),%HELP'="-" D .N %SAY,%XX,%YY,%XX0,%YY0 S %SAY=%HELP X %XMSGN S %CMD=$P(%SS,"++",6) I %RB="R"!($G(FILE(4))["V") D .N %XXX,%YYY .S %XXX=%XX,%YYY=%YY .I $E(%HH0)="E" S X1=%XX-1,X2=%XX0+%LS0+%LS1+2 I $G(FILE(4))["V" S X2=X2+FILE(2)+2 .I $E(%HH0)="H" S X1=%XX0-%LS0-%LS1-2,X2=%XX0+2 I $G(FILE(4))["V" S X1=X1-FILE(2)-3 .I X1<1 S X1=1 .I X2>79 S X2=79 .S Y1=%YY,Y2=%YY+2 .S %XX=X1+1 X %POSIC W $J("",X2-X1-1) .S %XX=%XXX,%YY=%YYY .Q K:%INV'["I" %INV D VSV X %XCL X %XMSG I %RB="R" D ^%L1RBUA ;RBUA1^%L3MENU ;S %LS1=%LS I %HH="H"!(%HH="E"),$E(%HH0)="H",$D(%L1GET) D G EN .K %XX1 S %S1=%S I %TYPCRT'["VT5" S %SAY=$J(%S,%LS)_"++"_%YY_","_$S(%HH="E":%XX-%LS-1,1:%XX-1)_","_%HH X %XMSG Q .W $C(27,91)_(%YY+1)_";"_(%XX-%LS)_"H" W $C(27,91)_(%YY+1)_";"_(%XX-%LS)_";"_(%YY+1)_";"_(%XX-%LS+(%LS-$L(%S)))_"$z" W:$L(%S) %S I $E(%HH0)="E" S %XX=%XX+%LS0+1 S:%XX+%LS>79 %XX=79-%LS-1 S:%HH="H" %XX=%XX+%LS+1 I %HH="E" S:$E(%HH0)="H" %XX=%XX-%LS-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 S %XX1=%XX X %POSIC S $X=%XX,$Y=%YY D S %S1=%S G EN .N:$A(%S)<96&'$D(%GET("H")) %HBRY D ^%ZMSL I %HH="H" S $X=%XX-2,$Y=%YY S %XX1=%XX-%LS-1 D ^%L1ZMS S %S1=%S G EN I %HH="D" S %L1DS=%S S %XX=%XX-$S(%ENGLISH:-2,1:8)-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 X %POSIC S %XX1=%XX S $X=%XX-1,$Y=%YY D ^%L1DAT S %S1=%L1DAT1 G EN I %HH="T" S %L1DS=%S S %XX=%XX-$S(%ENGLISH:-2,1:8)-1 S:%XX+%LS>79 %XX=79-%LS S:%XX<0 %XX=0 X %POSIC S %XX1=%XX S $X=%XX-1,$Y=%YY D ^%L1TIME S %S1=%L1TIME1 G EN EN G:$G(%TO)="END" END I $D(%L1GET) G END I %LS1[".",%HH="E",+%S S (%S,%S1)=$TR($J(%S,%LS1)," ",0) S %XX=%XX1 X %POSIC W %S1 I $G(%TO)="F6"!($G(%TO)="F7")!((%S="*")!(%S="?")&($G(%TO)="")),FILE'="" S %REST=1 D D:%REST PUT S:'$D(%L1GET)&($G(%S)'="") %L1GET="E" G Z .N %GET .N %XXX,%YYY S:%S="*"&($G(%TO)="") %TO="F7",%S="" S:%S="?"&($G(%TO)="") %TO="F6",%S="" .S %XXX=%XX0,%YYY=%YY0 .N STRING,FLAG,%CLEAR,%XX S %CLEAR=1,%YYGET=%YY S F7=1 .D GET S %REST=1 .D @$S($G(%TO)="F7":"DAFUS^%L3MBGS",1:"POISK^%L3MBGS") I $G(FLAG)'=""!'$D(STRING) S %S="",%XX=%XXX,%YY=%YYY Q .S %S=STRING S %XX=%XXX,%YY=%YYY I %CMD'="" X %CMD I FILE'="",FILE(4)["P",%S'="",'$D(@FILE@(%S)) S %GETOLD=%GET S %REST=0 D D:%REST PUT S %GET=%GETOLD X "I '$D(%L1GET),$G(%S)'="""",$D(@FILE@(%S))" S:$T %L1GET="E" G Z .I FILE(4)'["C" X %XMSGV("ER") S %S="" Q .S %YYGET=%YY D GET .N (%XMSG,%UPRCOD,%XMSGV,%XMSGN,%YY,%XX,FILE,%S,%REST,%TO,GVIDEO) D ^%L1C .S STRING=%S .S %GET="99 - miwdl . miiw `l" D N^%L1GET I %S'=99 X %XMSGV("ER") S %S="" Q .N GLOB S GLOB=$E(FILE,2,20) I $D(^TABLs(GLOB)) D G F ..I $D(^TABLs(GLOB,"PROG")) D Q ...S %PROG=^("PROG") ...N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG,GVIDEO,STRING,GLOB) D ^%L1C S:$L(STRING)&$D(^TABLs(GLOB,"KEY")) @^("KEY")=STRING N GLOB D @%PROG ..D I^%L1TABL .S NSNAME=$G(FILE(5)) D ^%L1SCS F .S %REST=1 S %S=STRING Q END I $D(%XX1),$G(%INV)'="II" S %XX=%XX1 X %XCL,%LIGHT,%POSIC W $S($G(%HH)="E":%S1_$J("",%LS1-$L(%S1)),1:$J(%S1,%LS1)) X %XCL ;I '$G(F7) D VSV ;;I %ENGLISH S %S=$$CAPIT(%S) D VSV K %HH,%HH0,%SAY,CIST,%LS,%SAY,%INV,%RB,%GET,%GETIN,%GETHB,%FLINS,%ZMSF,%ZMSL I $G(%L1GET)="E" K %L1GET Q ;- N ; VNIZU S %ZMSF="" I '$D(%POSIC)!'$D(%ENGLISH) D ^%L1C I %ENGLISH G NE N %ECHO U $P:(NOECHO:NOWRAP) X %XCL S %XX=0,%YY=24 X %POSIC W %chists N %SS S %SS=$P(%GET,"#",2),%GET=$P(%GET,"#",1) N %LS S %LS=+%SS I %LS'>0 S %LS=2 D HX I $D(^mbg1($P,"H")) S ^mbg1($P,"H")=0 ;-- LEADKEN HELP B- ^%L3MBG ;S %GET=$P($G(%GET),"++")_"++23,"_(80-%XXX)_",HH#"_$G(%GETIN)_"++"_%LS_",E,I" G %L1GET S %GET=$P($G(%GET),"++")_"++24,"_(80-%XXX)_",HH++MB,WF#"_$G(%GETIN)_"++"_%LS_","_$S($D(%GETHB):"H",1:"E")_",I" G Z0 ;%L1GET V ; VERHU S %ZMSF="" I '$D(%POSIC)!'$D(%ENGLISH) D ^%L1C I %ENGLISH G VE N %ECHO U $P:(NOECHO:NOWRAP) S %XX=0,%YY=0 X %POSIC W %chists N %SS S %SS=$P(%GET,"#",2) N %LS S %LS=+%SS I %LS'>0 S %LS=2 D HX S %GET=$P($G(%GET),"++")_"++0,"_(80-%XXX)_",HH++RB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET NE ; VNIZU ENG S %ZMSF="" I '$D(%POSIC) D ^%L1C N %ECHO,%HBRY U $P:(NOECHO:NOWRAP) S %XX=0,%YY=24 X %POSIC W %chists N %LS S %LS=+$P(%GET,"#",2) I %LS'>0 S %LS=2 S %GET=$P(%GET,"#") S %GET=$P($G(%GET),"++")_"++24,5,EE++MB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET VE ; VERHU ENG S %ZMSF="" I '$D(%POSIC) D ^%L1C N %ECHO,%HBRY U $P:(NOECHO:NOWRAP) S %XX=0,%YY=0 X %POSIC W %chists N %LS S %LS=+$P(%GET,"#",2) I %LS'>0 S %LS=2 S %GET=$P(%GET,"#") S %GET=$P($P($G(%GET),"++"),"#")_"++0,5,EE++RB,WF#"_$G(%GETIN)_"++"_%LS_",E,I" G Z0 ;%L1GET Q VSV I $G(FILE(4))["V" D .N %XXX,%YYY,%TBL .S %XXX=%XX0,%YYY=%YY0 .N %SAY .I $E(%HH0)="E" S %XX=%XX0+%LS0+%LS1+5 .I $E(%HH0)="H" S %XX=%XX0-%LS0-%LS1-2 .I $L($G(FILE))>2,$D(^TABLs($E(FILE,2,20),"VSV")),$L(%S) S @("%TBL="_^TABLs($E(FILE,2,20),"VSV")) .I $E(%HH0)="E",%S'="" S %SAY=$E($P($G(@FILE@(%S)),RZD),1,FILE(2))_"++"_%YY_","_(%XX-2)_",EE" X %XMSG D REST Q .I $E(%HH0)="H",%S'="",$D(%TBL) S %SAY=$$HBR^%L1FRM(%TBL,FILE(2))_"++"_%YY_","_(%XX-2)_",HH" X %XMSG D REST Q .I $E(%HH0)="H",%S'="" S %SAY=$E($P($G(@FILE@(%S)),RZD),$L($P($G(@FILE@(%S)),RZD))-FILE(2)+1,255)_"++"_%YY_","_(%XX-2)_",HH" X %XMSG D REST Q .I %S="" S $P(%SAY,"++")=$J("",FILE(2))_"++"_%YY_","_(%XX-2)_","_$S($E(%HH0)="E":"EE",1:"HH") X %XMSG D REST Q Q REST S %XX=%XXX,%YY=%YYY Q GET I %TYPCRT="PC",'$D(%GET("REST")),'$D(%GETREST) D GET^%VIDEO(.GVIDEO,0,0,79,24,2) Q Q PUT I %TYPCRT="PC",'$D(%GET("REST")),'$D(%GETREST),$D(GVIDEO) X %chista D PUT^%VIDEO(GVIDEO,0,0,79,24,2) Q X:%CMD'="" %CMD N %PUTS S %PUTS=%S I $D(%GET("REST")) X %GET("REST") I $D(%GETREST) X %GETREST S %S=%PUTS Q HX S %XXX=80-$L($TR($P(%GET,"++"),"{}",""))\2-5 I %XXX<1 S %XXX=1 Q IS S YES=0 N %S,%GETIN S %GET=" - xy`l " I $G(%ENGLISH) S %GET=" CONFIRM - " D N S:%TO="F9" %S=99 I %S=99 S YES=1 Q IS1 N %HBRY,%FLINS S YES=0,%TO="" S %HBRY="",%GETHB="",%FLINS=0 I '$D(%ENGLISH) D ^%L1C N %S S %GET=" (l/k) - "_$G(%GET("IS")," xy`l ") I $G(%ENGLISH) S %GET=$G(%GET("IS")," CONFIRM")_" (Y/N) " I $G(%GETIN)="k",%ENGLISH S %GETIN="Y" N %ISGET I $D(%GET("IS")) S %ISGET=%GET("IS") D N S:%TO="END"&(%S'="l") %S="" K %GETIN S:$D(%ISGET) %GET("IS")=%ISGET I "klFKfNnYhy"'[%S!'$L(%S) W *7 G IS1 S YES=("kFfYhy")[$E(%S)&$L(%S) K %GET Q IS2 S %GETIN="k" G IS1 IS3 S %GETIN=2,%GET=" 0 - rval `l , 2 - rval ,1 - owzl " I %ENGLISH S %GET=" MODIFY - 1, PERFORM - 2 , CANCEL - 0 " D N^%L1GET I %TO="END" G IS3 I %S'=0,%S'=1,%S'=2 W *7 G IS3 Q ; CAPIT(%ST) N J,%SMB N J F J=1:1:$L(%ST) S %SMB=$E(%ST,J) D .I $A(%SMB)<123,$A(%SMB)>96 S $E(%ST,J)=$C($A(%SMB)-32) Q %ST %L1GETMD %L1GETMD ;MODEM INITIALIZATION [ 31.01.06 20:08 ] [ 01.02.04 14:05 ] [ 16.01.02 11:31 AM ] BG N (%UPRCOD,%XMSG,USERPORT,USERMOD,NOCA,%L2MD) S $ZS="" U $P:(CENABLE:CTRAP=$C(3)) D ^%L1C I '$D(USERMOD) S USERMOD=1 I '$D(USERPORT) S USERPORT=$$MDPORT^%L1PORT I '$D(%L2MD) O 0 U 0 S PRT=$P N $ZT S $ZT="ZG "_$ZL_":END^%L1GETMD" S US="U DEV:(NOECHO:NOWRAP:TERM=$C(3,8,13,21,24,27,127))" I $D(%L2MD) D L2MD I '$D(NOCA)&'$D(%L2MD) X %chista S %SAY=" MODEM INITIALIZATION ( CTRL/C - CANCEL ) " X %XMSGV ZP S GLD=$$^%L1GLD I $G(USERPORT)>3 S DEV=^[GLD]dev(USERPORT) G IN ASK R !!,"I/O PORT? > ",DEV G:DEV="" END1 S DEV=^[GLD]dev(DEV) IN I $P=DEV D MSG("CANNOT SELECT YOUR OWN DEVICE.") G ASK U $P:(CENABLE:CTRAP=$C(3)) C DEV O DEV::0 E D MSG("..LINE IN USE..WAITING..") O DEV::10 I D MSG("READY") E G END2 U DEV ;;I $ZB($ZA,2,1) D MSG("DEVICE "_DEV_" IS AN OUTPUT ONLY DEVICE.") G ASK OP O DEV S %DT=0 D BEG PORT X US ;;F R *A:1 E Q W "ATS0="_$G(^PL("MDRING"),1)_$G(^PL("MDXON"))_$S($G(^PL("MDLOW")):"L1",1:"")_$C(13) R %Y:4 G:%Y[$C(1) END S %CR=$ZB X:'$T&$L(%Y) "U 0 W %Y" D:$T&$L(%Y) MSG(%Y) S %DT=%DT+1 PORT1 I %Y'["OK" H 1 G:%DT<6 PORT D MSG("NO CARRIER") G END C:$G(DEV)>3 DEV K NOCA Q END U $S($P["tty":$P,1:^[GLD]dev(1)) W:$ZS["CTRAP" !,*7,"INTRERUPT",! END1 D HANGUP END2 C:$G(DEV)>3 DEV K NOCA Q HANGUP ; Q BEG N PORTN S PORTN=DEV D BEG^%L1HANG Q TV(USERPORT,USERMOD) G BG MSG(TXT) ; U $S($P["tty":$P,1:^[GLD]dev(1)) I '$D(%L2MD) W *7,!!,TXT I $D(%L2MD) D MSG^%L2MD(TXT,"M") Q L2MD ; I '$D(%L2MD("M")) D .S %L2MD("M","VG")=3,%L2MD("M","NG")=17,%L2MD("M","LG")=5,%L2MD("M","RG")=25 Q %L1GI %L1GI(%ZD) ;service@greystone.com %GO;19920722 21:35;global input [ 21.07.26 14:11 ] [ 20.07.26 07:35 ] [ 18.01.26 00:40 ] ;Load globals into database ;possible enhancements: ;selection and/or exclusion by key list, range and/or wildcard ;optional confirmation by global name ;callable entry point ; I $G(%ZD)'="",%ZD'["/" S %ZD="/home/gtmuser/"_%ZD I $E($G(%ZD))="." S %ZD="/home/gtmuser/ppj-transfer/"_$E(%ZD,2,255) ; w !,"Global Input Utility",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%L1GI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%GI") n d,g,glg,n,rest,sav,sel,x,x0,y,fmt s (sel,rest,glg)="" ; N %NODIALOG S %NODIALOG=0 ; i $g(%ZD)'="" D . i $zparse(%ZD)="" w " no such file" s %ZD="" q . o %ZD:(readonly:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q .S %NODIALOG=1 I $G(%ZD)="" Q ; ZI I $G(%ZD)="" f d q:$l(%ZD) . r !,"Input file: ",%ZD,! . I $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/"_$E(%ZD,2,255) . i %ZD="^"!(%ZD="") q . i %ZD="?" d q . . w !!,"Select the file you want for input" . . w !,"If you wish to exit enter a carat (^)",! . i $e(%ZD)=">" S %ZD="/home/lev/"_$E(%ZD,2,255) . i $e(%ZD,1,3)="mu>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/"_$E(%ZD,4,255) . i $e(%ZD,1,3)="ml>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/mly/"_$E(%ZD,4,255) . i $e(%ZD,1,2)="a>"!($E(%ZD,1,2)="A:")!($E(%ZD,1,2)="a:") S %ZD="/mnt/floppy/"_$E(%ZD,3,255) . i %ZD["/mnt/floppy/" D ^%L1FLOP . i $zparse(%ZD)="" w " no such file" s %ZD="" q . o %ZD:(readonly:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" u %ZD:exception="g eof" r x,y u $p w !,x,!,y,!! u $p I $G(%NODIALOG) G ZS1 ZS r !,"Selective restore ? (y/n) ",sel i sel="^" g ZI ZS1 s sel=$e(sel) S:sel="" sel="n" s sel=$$FUNC^%LCASE(sel) i sel'="y",sel'="n" w *7 g ZS s sel=(sel="y") s rest="n" i 'sel s rest="y" ; s sav="",(g,n)=0 W !! ;;u %ZD:exception="g eof" ;;r x,y u $p w !,x,!,y,!! ;;u $p i $l(x),$e("NO",1,$l(x))=$tr(x,"no","NO") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q s fmt=y["ZWR" ; i (fmt) f u %ZD r x q:x="" i $e(x)="^",x["=" d ; --- ZWR . S x=$TR(x,$C(13),"") . s x0=$p($p(x,"="),"(") i x0'=sav,x0'="^" d . .i sel d . . .u $p w !,x0 . . .i (rest="c"!(rest="s"))&(x0=("^"_glg))!("cs"'[rest) d ZREST . . .I rest="c"!(rest="y") s g=g+1 . . .w " -- "_$s(rest="s"!(rest="n"):"Not ",1:"")_"restored" . . s sav=x0 . . i 'sel u $p w:$x>70 ! w x0,?$x\10+1*10 .I rest="c"!(rest="y") s @x ; i ('fmt) f u %ZD r x i $e(x)="^" r y d ; --- GO .s x=$TR(x,$c(13),""),y=$TR(y,$C(13),"") . s x0=$p(x,"(") i x0'=sav,x0'="^" d . .i sel d . . .u $p w !,x0 . . .i (rest="c"!(rest="s"))&(x0=("^"_glg))!("cs"'[rest) d ZREST . . .I rest="c"!(rest="y") s g=g+1 . . .w " -- "_$s(rest="s"!(rest="n"):"Not ",1:"")_"restored" . . s sav=x0 . . i 'sel u $p w:$x>70 ! w x0,?$x\10+1*10 s g=g+1 .i rest="c"!(rest="y"),$e(x)="^" s @x=y,n=n+1 ; eof u $p w !!,"Restored ",n," node",$s(n=1:"",1:"s") w " in ",g," global",$s(g=1:".",1:"s.") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR u $p w !,$p($zs,",",2,99),! ; Warning - Fall-though s $ec="" EXIT i $d(%ZD),%ZD'=$p c %ZD u $p:(ctrap="":exc="") q ZREST ; s glg="" u $p w ?10," -- restore ? (y/n/s/c) " r rest s rest=$e(rest) s:rest="" rest="n" i rest="^" s exit=1 q s rest=$$FUNC^%LCASE(rest) i "ynsc"'[rest w *7 w ! g ZREST I rest="s"!(rest="c") w " until ^" r glg i glg=""!(glg="^") w ! G ZREST q %L1GIEDH %L1GIEDH ; GLOBAL INDEX EDITOR - BLOCKNOT (HEBREW) ; %GIEDH - GLOBAL NAME [ 05/23/99 4:44 PM ] [ 10/04/95 10:13 AM ] L @%GIEDH:2 E S %SAY="! xg` seqnn uaew mr micaer" X %XMSGV Q N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%GIEDH) D ^%L1C S N="",I=0 K ^S000($P) F S N=$O(@%GIEDH@(N)) Q:N="" D S I=I+1,^S000($P,I)=SS,^S000($P,I,"%TOP")=TOP .S SS=$J(N,78) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S TOP=II-($E(SS,II)'=" ") S %PRHBR=1 D ^%S2ERG1 K %Q S %Q("Z")="xenyl",%Q("U")="k",%Q("X")=10,%Q("Y")=23 D ^%S2ASK I 'YES K ^S000($P) L Q K @%GIEDH F I=1:1 Q:'$D(^S000($P,I)) D I ^(I)'="" S @%GIEDH@(^S000($P,I))="" .S SS=^(I) F J=1:1 Q:$E(SS,J)'=" " .S ^(I)=$E(SS,J,255) L Q %L1GLD %L1GLD(STAM) ; Q $S($P["/vc/":^UCI("MGC"),1:^UCI("MGG")) %L1GM %L1GM ; ROUTINE MONITOR ;[ 10/23/95 6:57 PM ] [ 09.05.06 16:40 ] [ 10/23/95 6:57 PM ] [ 09.05.06 16:39 ] U $P:(NOECHO:NOWRAP) X %chista S %SAY=" GLOBALS MONITOR " X %XMSGV U $P:(ECHO:WRAP) D ^%GSEL U $P:(NOECHO:NOWRAP) G M1 M1 K ^L1ADR($J) S N="" F S N=$O(%ZG(N)) Q:N="" S ^L1ADR($J,$E(N,2,9))="" K %ZG S %L1GM="" D ^%L1RGR1 K %L1GM Q %L1GM0 %L1GM ; GLOBALS MONITOR [ 09.05.06 16:34 ] [ 05/23/99 4:46 PM ] [ 06/30/94 10:01 AM ] X %chista S %SAY=" GLOBALS MONITOR " X %XMSGN Z S %GET="GLOBAL'S SET ( GLOBAL DIRECTORY - ? OR ) :#8" D VE^%L1GET Q:($G(%TO)="END") I %S="?"!(%TO="F7") D ^%GD G Z Q:%S="" S %RS=%S D ^%L3GSEL K ^L1ADR($J) S N="" F S N=$O(^UTILITY($J,N)) Q:N="" S ^L1ADR($J,N)=^UTILITY($J,N) K ^UTILITY($J) S %L1GM="" D ^%L1RGR1 K %L1GM Q %L1GR %L1GR ;CDS;GLOBAL RESTORE [ 08/08/94 11:33 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1982 S $ZT="ZG "_$ZL_":ERR^%L1GR",NAME=" GLOBAL" W %ENG K ^L1ADR($J),PRIZ W !?10,$P($P($ZV,","),"-")," - Global Restore Utility" SDEV D IN^%SDEV G:$D(QUIT) EXIT S %TAP=%DEV>46&(%DEV<51) D:%TAP %SET^%MTCHK ;I %TAP U %DEV I @(%MTON_"=0") U 0 W !,"Tape is not ready" C %DEV G SDEV U %DEV R %TIME,%CMT I %TIME="" G BADSAVE U 0 S %S=0,%SEQ=1,%LG="",%POS=0 W !!,"Global(s) saved at ",%TIME,".",!,"Header comment is : ",%CMT,! L1 R !,"Selective restore (allows rename) : ",%SEL I %SEL="" W "NO" S %SEL=0,%ANS="Y" G START I $E("YES",1,$L(%SEL))=%SEL W $E("YES",$L(%SEL)+1,3) I $E("NO",1,$L(%SEL))=%SEL W $E("NO",$L(%SEL)+1,2) S %SEL=0,%ANS="Y" G START I $E("yes",1,$L(%SEL))=%SEL W $E("yes",$L(%SEL)+1,3) I $E("no",1,$L(%SEL))=%SEL W $E("no",$L(%SEL)+1,2) S %SEL=0,%ANS="Y" G START G:%SEL="^"!(%SEL="^Q") EXIT I %SEL="?" G HELP I "Yy?"'[$E(%SEL) W *7," ??" G L1 S %FNN=$P(%FN,".")_"."_$E($P(%FN,".",2),1,2)_"#" U %DEV D:$$^%L1ZOS(10,%FNN)'>0 DIR^%L1RGR1 G:$$^%L1ZOS(10,%FNN)>0 ZAP U 0 I $E("YES",1,$L(%SEL))=%SEL S %SEL=1 G START I $E("yes",1,$L(%SEL))=%SEL S %SEL=1 G START HELP ; W !,?5,"If you chose selective restore (reply YES), you will be prompted" W !,?5,"for each global. You must then respond to each prompt to restore" W !,?5,"the global, possibly with a different name." W !,?5,"Enter NO to restore all globals that were saved." W !,?5,"Enter ^ to exit without restoring any globals." G L1 START U 0 W !!,"Restoring..." NXTGBL K %GSEL S %POS=1 NG1 U %DEV R %GN,%GV I %GN="*E" D NEXTFILE G NG1:'QUIT,DONE2 G DONE:$E(%GN,1,2)="**",BADSAVE:%GN="",NXTGBL:%GN="*" I $E(%GN)="*" S %GSEL=$E(%GN,2,999) G NG1 ; --- 07.03.94 S %GNN=%GN,%GNL=$L(%GNN)+1 S:'$D(%GSEL) %GSEL=%GNN S %NAM=$G(%NAM) I %GN'="*",%GN'[%NAM S %GSEL=%NAM S %GNN=$P(%GN,"("),%GNL=$L(%GNN)+1 S:'$D(%GSEL) %GSEL=%GNN S %NAM=$G(%NAM) I %GN'="*",%GN'[%NAM S %GSEL=%NAM S %POS=2 ASK ; U 0 W !,"Global: ",%GSEL W:$X>17 " " W ?18 I %GN'="*",%GN'[%NAM U 0 W *7," ERROR ",*7 H 1 W *7 Q ; U 0 W !,"Global: ",%GN W:$X>17 " " W ?18 I %GN'="*",%GN'[%NAM U 0 W *7," ERROR ",*7 H 1 W *7 Q U 0 W !,"Global: ",%GSEL W:$L(%GSEL)'=$L(%GN) ?18,"first index : ",%GN W:$X>17 " " W ?18 I %GN'="*",%GN'[%NAM U 0 W *7," ERROR ",*7 H 1 W *7 Q G:'%SEL SET I %S G:%RC]%GNN SET S %S=0 R "Restore (Y/N/R/S/C/K) ? ",*%ANS S:%ANS>96&(%ANS<123) %ANS=%ANS-32 I %ANS=13 S %ANS=78 W "N" S %ANS=$C(%ANS) G SET:%ANS="Y",READ:%ANS="N",REN:%ANS="R",EXIT:%ANS="^",SKP:%ANS="S",CNT:%ANS="C" I %ANS="K",%GN[%NAM K @%GN S %ANS="Y" G SET I %ANS'="?" W *7," ??" G ASK W !,"Enter 'Y' to restore the global using the same name." W !,"Enter 'N' to bypass restoring this global." W !,"Enter 'R' to restore the global and rename it." W !,"Enter 'S' to skip without restoring up to a specified global." W !,"Enter 'C' to continue restoring without prompts up to a specified global." W !,"Enter '^' to end the entire restore process.",! G ASK READ U %DEV R %GN,%GV G:%GN="" BADSAVE I %GN="*E" D NEXTFILE G READ:'QUIT,DONE2 I %GN="*" U 0 W:%SEL&(%ANS="N") " ... Not Restored" W:'(%SEL&(%ANS="N")) " ... Restored" Q:$G(PRIZ) G NXTGBL SET S %LG=%GN G READ:%ANS="N",NXTGBL:%GN="*",DONE:$E(%GN,1,2)="**" S @(%GNN_$E(%GN,%GNL,255))=%GV G READ REN0 W !,?43,"R" REN R "ename to: ",%I I %I="?" W !,"Enter the new name for the global,",!,"or '^' to return to the previous question." G REN0 I %I="^" S %ANS="N" G ASK S:$E(%I,1)'="^" %I="^"_%I I $L(%I)<10,$L(%I)>1,%I?1"^"1A.AN!(%I?1"^%".AN) S %GNN=%I G SET W *7," Invalid" G REN0 SKP0 W !,?43,"S" SKP R "kip until: ",%RC I %RC="?" W !,"Enter the global name where skipping should stop,",!,"or '^' to return to the previous question." G SKP0 I %RC="^" G ASK S %RC="^"_%RC I $L(%RC)<10,%RC?1"^"1A.AN!(%RC?1"^%".AN) S %S=1,%ANS="N" G ASK W *7," Invalid" G SKP0 CNT0 W !,?43,"C" CNT R "ontinue until: ",%RC I %RC="?" W !,"Enter the global name where restoring should stop,",!,"or '^' to return to the previous question." G CNT0 I %RC="^" G ASK S %RC="^"_%RC I $L(%RC)<10,%RC?1"^"1A.AN!(%RC?1"^%".AN) S %S=1,%ANS="Y" G ASK W *7," Invalid" G CNT0 DONE I %TAP U %DEV I @(%MTTMK_"=0") W *12 DONE2 U 0 W !,"Restore Complete" EXIT U 0 I $D(%TAP) D:%TAP %KILL^%MTCHK C:$D(%DEV) %DEV K %GN,%GNL,%GNN,%GV,%SBP,%TIME,%CMT,%GSEL,%I,%SEQ,%SIZE,%X,%ZA,QUIT,%TAP,%POS,%LG ; --- C:$D(%DEV) %DEV K %GN,%GNL,%GNN,%GV,%DEV,%SBP,%SEL,%ANS,%TIME,%CMT,%GSEL,%RC,%S,%I,%FN,%SEQ,%SIZE,%X,%ZA,QUIT,%TAP,%POS,%LG Q BADSAVE U 0 W !,*7,"Invalid backup format...unable to restore." G EXIT ERR ; I $F($ZS,"") U 0 G ERRTAP I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q ERRTAP U %DEV ; I @%MTON,@%MTEOT G NEXTTAPE I @%MTTMK G NEXTTAPE ; U 0 W !,"Unexpected tape mark encountered. Last node processed was ",$G(%LG),! G EXIT U 0 W !,$ZS,!,"Tape status:" U %DEV D %ERR^%MTCHK Q NEXTTAPE ; S $ZT="ZG "_$ZL_":ERR^%L1GR" U 0 W !,"End of tape sequence number ",%SEQ," has been reached.",!,"Last node processed is ",%LG,"." W !,"After this tape rewinds, mount the next tape.",! S %SEQ=%SEQ+1 NT0 U %DEV W *16 U 0 NT1 W !,"Enter 'GO' when tape sequence number ",%SEQ R " is ready: ",%X I %X="?" W !,"Mount the next tape (sequence number ",%SEQ,") and enter 'GO' when it is ready.",!,"Or enter '^' to abort the restore.",! G NT1 I %X["^" G EXIT I %X'="GO",%X'="go" W *7," ??" G NT1 U %DEV W *10 I @(%MTON_"=0") U 0 W *7,!,"Tape is not ready" G NT1 R %GN,%GV S %X=$P(%GN,%TIME_" (sequence ",2) I %X'?1.N1")" U 0 W !,"This is not a correct tape:",!,%GN,!,%GV,! G NT0 I +%X=%SEQ G NT3 U 0 W !,"This is sequence number ",+%X,", not number ",%SEQ NT2 W !,"Do you want to proceed with number ",+%X R "? ",%GN S:%GN="" %GN="N" I %GN="?" W !,"Enter 'YES' to continue restoring with tape number ",+%X," instead of number ",%SEQ,!,"Enter 'NO' if you want to mount the correct tape number ",%SEQ,!,"Enter '^' to end the restore." G NT2 G:%GN["^" EXIT S %GN=$ZB(%GN,"_",1) I %GN=$E("NO",1,$L(%GN)) G NT0 I %GN'=$E("YES",1,$L(%GN)) W " ??" G NT2 S %SEQ=+%X NT3 I %POS=2 U 0 W !,"Restoring ",%GSEL," " G NG1:%POS=1,READ:%POS=2 S $ZS="" G ERR NEXTFILE ; U 0 W !,"Sequence #",%SEQ," restored",! U %DEV R %X U 0 I $E(%X,1,2)="**" S QUIT=1 Q W !,"Please put sequence #",%SEQ+1," into the drive and" S %SEQ=%SEQ+1 NEXTFIL1 R !,"Press when ready",%X I %X?1"?".E W !!,"Press to continue restoring from sequence #",%SEQ,!,"or abort the restore by entering 'control C'" G NEXTFIL1 C %DEV O %DEV:%FN U %DEV I '$ZA R %X I '$ZC U 0 E W !!,"Cannot access ",%FN,", please correct" G NEXTFIL1 I %X?2NP1":"2N1" ".E S %X=1 I %X'=%SEQ W !!,"Out of sequence, this file is #",%X,", please correct" G NEXTFIL1 S QUIT=0 Q ZAP ; O %DEV:(%FNN:"R") U %DEV F R STR Q:STR="" S ^L1ADR($J,$P(STR,"|",2))=$P(STR,"|") C %DEV U 0 S %SEL=1,PRIZ=1,NAME=" GLOBAL" ; W !?5,"Routine : " R %ROU Q:%ROU="" I '$D(^L1ADR($J,%ROU)) W " No Routine...",*7 G Z ; --- O %DEV:(%FN:"R":^L1ADR($J,%ROU)) S %GN=%ROU U %DEV R R D START G Z D ^%L1RGR1 Q:%NAM="" Z O %DEV:(%FN:"R":^L1ADR($J,%NAM)) U 0 D NXTGBL C %DEV U 0 I $G(%ANS)'="^" S %NAM=$O(^L1ADR($J,%NAM)) Q:%NAM="" G Z ; I $G(%ANS)'="^" S %NAM=$O(^L1ADR($J,%NAM)) S:%NAM="" %NAM=$O(^L1ADR($J,"")) G Z S GLO=%NAM D PROG^%L1RGR1 Q:%NAM="" G Z Q Z ; --- O %DEV:(%FN:"R":^L1ADR($J,%NAM)) U 0 D NXTGBL C %DEV U 0 W *27,"["_(LIN+2)_";"_(COL-1*10+1)_"H" D WRIN^%L1RGR1,MAIN^%L1RGR1 Q:%NAM="" G Z Q %L1GRAF GRAF ; GRAFIKA IN %S2ERG1 (CTRL+"<-" = ON ,CTRL+F6 - OFF) [ 05/23/99 4:58 PM ] [ 03/04/94 12:18 PM ] N %GR,%RR G S %GR(1)="`1234567890-=\" ; 14 S %GR(2)="QWERTYUIOP[]" ; 12 S %GR(3)="ASDFGHJKL;'" ; 11 S %GR(4)="ZXCVBNM,./" ; 10 ; S %GR(5)="~!@#$%^&*()_+|" ; 14 S %GR(6)="qwertyuiop{}" ; 12 S %GR(7)="asdfghjkl:""" ; 11 S %GR(8)="zxcvbnm<>?" ; 10 ; S %RR(1)="176,179,177,178,219,220,221,222,223,240,254,196,205,186" ; 14 S %RR(2)="218,194,191,174,175,241,242,243,246,201,203,187" ; 12 S %RR(3)="195,197,180,252,250,249,248,247,204,206,185" ; 11 S %RR(4)="192,193,217,171,172,251,253,200,202,188" ; 10 ; S %RR(5)="173,161,162,163,164,165,166,167,168,169,170,239,244,245" ; 14 S %RR(6)="214,210,183,224,225,226,227,228,229,213,209,184" ; 12 S %RR(7)="199,215,182,230,231,232,233,234,198,216,181" ; 11 S %RR(8)="211,208,189,235,236,237,238,212,207,190" ; 10 ; S %SYM="" F I=1:1:8 S %SYM=%SYM_%GR(I) S %GRA="" F I=1:1:8 F I2=1:1:$L(%RR(I),",") S %GRA=%GRA_$C($P(%RR(I),",",I2)) Q GRA(ARG) ; I $A(ARG)>32&($A(ARG)<127) S ARG=$TR(ARG,%SYM,%GRA) Q ARG HELP ; N %GR,%RR,LIN,KOD D G U $P:(NOECHO:NOWRAP) W #,%ENG F LIN=1:1:4 W !!?LIN>1*5+(LIN*3) D .F I=1:1:$L(%RR(LIN),",") S KOD=$P(%RR(LIN+4),",",I) W " ",$C(KOD)," " .; W !?LIN>1*5+(LIN*3) F I=1:1 S KOD=$P(%RR(LIN),",",I) Q:KOD="" W " " X %LIGHT W $C(KOD) X %XCL W " " .W !?LIN>1*5+(LIN*3) X %LIGHT F I=1:1 S KOD=$P(%RR(LIN),",",I) Q:KOD="" W " " W $C(KOD) W " " .X %XCL .W !?LIN>1*5+(LIN*3) F I=1:1:$L(%RR(LIN),",") W " " W $E(%GR(LIN),I) W " " Q %L1GS %L1GS ;service@greystone.com %GO;19920722 21:15;global output [ 20.07.26 07:36 ] [ 06.06.10 11:31 ] [ 03.08.05 11:01 ] ;Extracts global data to standard global output (GO) file ;Invoke ^%GO to get interaction ;possible enhancements: ;selection by key list, range and/or wildcard, rather than global name ;callable entry point ; w !,"Global Output Utility",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%GO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%GO") n g,gn,m,n,%ZD,%ZG,%ZH,fmt I $D(%L1GS("SV"))>9 D G M .D init^%L1GSEL .N N S N="" F S N=$O(%L1GS("SV",N)) Q:N="" S %ZG=N D BDK^%L1GSEL d ^%L1GSEL ;;S %ZG=0 ;;F R !!,"Global selector ^",GL Q:GL=""!(GL="^") S %ZG("^"_GL)="",%ZG=%ZG+1 M ; i %ZG=0 w !,"No globals selected" q S %ZH="" I '$D(%L1GS) r !,"Header Label: ",%ZH,! s fmt=0 f d q:$l(%ZD) .I $D(%L1GS("TO")) S %ZD=%L1GS("TO") K %L1GS("TO") .E r !,"Output device: : ",%ZD,! . D ZDV . q ; BGW K %L1GS ; TV : IN : %ZD (OUT FILE),%ZG() - GLOBALS LIST q:%ZD="^" w !! i '$l($G(%ZH)) s %ZH="%GO Global Output Utility" u %ZD w %ZH,!,"GT.M ",$zd($h,"DD-MON-YEAR 24:60:SS") w ! s gn="",(m,n)=0 f s gn=$o(%ZG(gn)) q:gn="" s g=gn d . u $p w gn,! u %ZD i $p=%ZD w ! . s m=m+1 .i $d(@g)'[0 w g d s n=n+1 . .w !,@g,! . i g'["(" d q ; whole globals . . f s g=$q(@g) q:g="" d . . . w g,!,@g,! . . . s n=n+1 .N MAC,%MAC2,%MAC1 S MAC=g .I $E(MAC,$L(MAC))["," S MAC=$E(MAC,1,$L(MAC)-1) .I MAC["(",$E(MAC,$L(MAC))'[")" S MAC=MAC_")" .I $D(@MAC) .S %MAC2=$E($R,1,$L($R)-1)_$S(MAC["(":",",1:"") .S %MAC1=$E(MAC,1,$L(MAC)-1)_","""")" .S %MAC1=$Q(@%MAC1) Q:%MAC1="" .F Q:%MAC1'[%MAC2 Q:%MAC1="" W %MAC1,!,@%MAC1,! S %MAC1=$Q(@%MAC1) u %ZD w !! u $p w !!,"Total of ",n," node",$s(n=1:"",1:"s") w " in ",m," global",$s(m=1:".",1:"s."),!! c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR u $p w !,$p($zs,",",2,99),! ; Warning - Fall-though s $ec="" EXIT i $d(%ZD),%ZD'=$p c %ZD u $p:(ctrap="":exc="") q TV ; IN : %ZD - OUT FILE, %ZG() - GLOBALS LIST S %ZH="" D ZDV G BGW Q ZDV ; i '$l(%ZD) s %ZD=$p q i $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/"_$E(%ZD,2,255) i %ZD="^" q i %ZD="?" d q . w !!,"Select the device you want for output" . w !,"If you wish to exit enter a carat (^)",! . s %ZD="" I %ZD["/mnt/floppy/" D ^%L1FLOP i $zparse(%ZD)="" w " no such device" s %ZD="" q o %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0 i '$t w !,%ZD," is not available" s %ZD="" q Q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q SVSHP(%ZD,CD) ; I '$D(^SHP(CD)) S %SAY=" ^SHP("_CD_") IS NOT EXIST ! " X %XMSGV(1) Q I $G(%ZD)="" S %SAY=" OUT FILE IS NOT DEFINED ! " X %XMSGV(1) Q K %ZG N N S N="" F S N=$O(^SHP(CD,N)) Q:N="" D .S %GN=$G(^(N)) Q:%GN="" I $E(%GN)'="^" S %GN="^"_%GN .S %ZG(%GN)="" G TV %L1GSEL %L1GSEL ;GT.M %GSEL utility - global select into a local array [ 26.05.03 08:44 ] [ ;invoke ^%L1GSEL to create %ZG - a local array of existing globals, interactively ; N (%ZG) n add,beg,cnt,end,g,gd,gdf,k,out,pat,stp i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%L1GSEL" u $p:(ctrap=$c(3):exc="zg "_$zl_":LOOP^%L1GSEL") D init D SEL W ! D cur W ! K SEL d main u $p:(ctrap="":exc="") q GD n add,beg,cnt,end,g,gd,gdf,k,out,pat,stp s cnt=0,(out,gd,gdf)=1 d main i gdf s %ZG="*" d setup,it w !,"Total of ",cnt," global",$s(cnt=1:".",1:"s."),! q CALL n add,beg,cnt,end,g,gd,gdf,k,out,pat,stp s (cnt,gd)=0 i $d(%ZG)>1 s g="" f s g=$o(%ZG(g)) q:'$l(g) s cnt=cnt+1 i $g(%ZG)'?.N s out=0 d setup,it s %ZG=cnt q s out=1 d main q init k %ZG s (cnt,gd)=0,out=1 u $p q main f d inter q:'$l(%ZG) s %ZG=cnt q inter r !,"Global ^",%ZG,! q:'$l(%ZG) i $e(%ZG)="?",$l(%ZG)=1 d help q i (%ZG="?D")!(%ZG="?d") d cur q BDK I %ZG["(" d q .I $E(%ZG,$L(%ZG))="," S %ZG=$E(%ZG,1,$L(%ZG)-1) .I %ZG["(",%ZG'[")" S %ZG=%ZG_")" .n $zt s $zt="zg "_$zl_":ERI^%L1GSEL" .i $E(%ZG)'="-",'$d(@("^"_%ZG)) W *7," -- not exist !!!" g ES .i $e(%ZG)="-" S g="^"_$e(%ZG,2,99),add=0 d save q .s g="^"_%ZG,add=1 d save ES .q ERI .w *7," -- wrong name !!!" G ES d setup,it I '$D(SEL) w !,$s(gd:"T",1:"Current t"),"otal of ",cnt," global",$s(cnt=1:".",1:"s."),! q setup i gd s add=1,cnt=0,g=%ZG k %ZG s %ZG=g e i "'-"[$e(%ZG) s add=0,g=$e(%ZG,2,999) e s add=1,g=%ZG s g=$tr(g,"? !""#$&'()+'-./;<=>@[]\^_`{}|~","%") s g=$tr(g,$c(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127)) s end=$p(g,":",2),beg=$p(g,":") i end=beg s end="" q it s gdf=0 i end'?."*",end']beg q s g=beg d pat i pat["""" d start f d search q:'$l(g) d save i pat["""",'$l(end) q s beg=stp i '$l(g) s g=stp s pat=".E",stp="^"_$e(end)_$tr($e(end,2,9999),"%","z") d start f d search q:'$l(g) d save s g=end d pat i pat["""" s:beg]g g=beg d start f d search q:'$l(g) d save q pat ;; i $e(g)="%" s g="!"_$e(g,2,9999) s pat=g f q:$l(g,"%")<2 s g=$p(g,"%",1)_"#"_$p(g,"%",2,999),pat=$p(pat,"%",1)_"""1E1"""_$p(pat,"%",2,999) f q:$l(g,"*")<2 s g=$p(g,"*",1)_"$"_$p(g,"*",2,999),pat=$p(pat,"*",1)_""".E1"""_$p(pat,"*",2,999) i $e(g)="!" s g="%"_$e(g,2,9999),pat="%"_$e(pat,2,9999) i pat["""" s pat="1""^"_pat_"""" s g="^"_$p($p(g,"#"),"$"),stp=g_$e("zzzzzzz",$l(g)-1,8) q start i g="^" s g="^%" i g?@pat,$d(@g) d save q search f s g=$o(@g) s:g]stp g="" q:g?@pat!'$l(g) q save i add,'$d(%ZG(g)) s %ZG(g)="",cnt=cnt+1,%ZG=cnt d prt:out i 'add,$d(%ZG(g)) k %ZG(g) s cnt=cnt-1 S %ZG=cnt d prt:out q prt w:$x>70 ! w g,?$x\10+1*10 q help ; w !,?2,"",?25,"to leave",!,?2,"""*""",?25,"for all" w !,?2,"global",?25,"for 1 global" w !,?2,"global1:global2",?25,"for a range" w !,?2,"""*"" as a wildcard",?25,"permitting any number of characters" w !,?2,"""%"" as a wildcard",?25,"for a single character in positions other than the first" w !,?2,"""?"" as a wildcard",?25,"for a single character in positions other than the first" i gd q w !,?2,"""'"" as the 1st character",!,?25,"to remove globals from the list" w !,?2,"?D",?25,"for the currently selected globals",! q cur w ! s g="" f s g=$o(%ZG(g)) q:'$l(g) w:$x>70 ! w g,?($x\10+1*10) q ERR u $p w !,$p($ZS,",",2,999),! u $p:(ctrap="":exc="") s $ec="" q LOOP d main u $p:(ctrap="":exc="") q SEL ; N ANS K %ZG S SEL="" n out s out=0 U $P R !!,"SAVE DATE - 1, SAVE SET - 2 , SAVE NORMAL - 3 : ",ANS Q:ANS="" I ANS'=1,ANS'=2,ANS'=3 W *7," ???" G SEL I ANS=3 K %ZG Q G:ANS=2 S2 ; F R !!,"HOW MANY DAYS:",NDAY Q:NDAY="" Q:NDAY?1N.N W *7," ???" G:NDAY="" SEL S N=$H-NDAY-1 K %ZG S cnt=0 F S N=$O(^%ERGS(N)) Q:N="" S N1="" F S N1=$O(^%ERGS(N,N1)) Q:N1="" I $E(N1)="^" D .D GLB(N1) .S %ZG(GLB)="",cnt=cnt+1 Q S2 K %ZG R !!," NAME :",NAME I NAME="?" D G S2 .S (N,N0)="%GS" F I=1:1 S N=$O(^SHP(N)) Q:N="" Q:N'[N0 W !,$P(N,N0,2)," ",$G(^(N)) I '(I#18) R "<>",Y Q:Y="." I '$D(^SHP("%GS"_NAME)) W *7," -- NOT EXIST !!! " G S2 S gd=0,cnt=0 S21 S N="" F S N=$O(^SHP("%GS"_NAME,N)) Q:N="" S %ZG=$G(^(N)) Q:%ZG="" D BDK Q GLB(GLOB) ; I $E(GLOB,$L(GLOB))="," S GLOB=$E(GLOB,$L(GLOB)-1) I GLOB["(",$E(GLOB,$L(GLOB))'=")" S GLOB=GLOB_")" S GLB=GLOB I GLOB["(" D .S GLB=$P(GLOB,"(")_"(" .N J F J=1:1:$L(GLOB,",") S GLB=GLB_""""_$$^%L1IND(GLOB,J)_"""," .S GLB=$E(GLB,1,$L(GLB)-1)_")" Q %L1GSEQ %L1GSEQ ;--- OPERATIONS WITH SEQ. GLOBALS (DEL,ADD) [ 18.11.16 15:27 ] [ 30.08.14 09:08 ] [ 23.01.01 11:47 AM ] DEL(%GLB,%SH) ; DELETE FROM SEQUENTIAL GLOBAL N %I I '$D(@%GLB@(%SH)) Q F %I=%SH:1 Q:'$D(@%GLB@(%I+1)) D .K @%GLB@(%I) S MAC2=$E(%GLB,1,$L(%GLB)-1)_",%I)" .S MAC1=$E(%GLB,1,$L(%GLB)-1)_",%I+1)" D ^%S1GC1 K @%GLB@(%I) Q ; ADD(%GLB,%SH,%VL,%OK) ; N %I,%LAST S %OK=0 ;;I '$D(@%GLB@(%SH-1)) Q F %I=%SH:1 Q:'$D(@%GLB@(%I)) S %LAST=%I-1 ;;S %LAST=$O(@%GLB@(999999999),-1) F %I=%LAST:-1:%SH D .K @%GLB@(%I+1) .I %GLB["(" D ..S MAC1=$E(%GLB,1,$L(%GLB)-1)_",%I)" ..S MAC2=$E(%GLB,1,$L(%GLB)-1)_",%I+1)" D ^%S1GC1 .I %GLB'["(" D ..S MAC1=%GLB_"(%I)" ..S MAC2=%GLB_"(%I+1)" D ^%S1GC1 ; K @%GLB@(%SH) S @%GLB@(%SH)=%VL Q %L1GTR %L1GTR ; SEND GLOBALS [ 03/10/98 5:18 PM ] [ 06/09/97 5:34 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,USERPHONE,USERPORT,USERGLOB,USERMOD,MDTONE,MDXON) S $ZS="" D ^%L1C I '$D(USERMOD) S USERMOD=1 U 0 S PRT=$P S ZT=$ZT S $ZT="ZG "_$ZL_":ZT^%L1GTR" S US="U PORTN:(0::::#800101::::$C(13))" ; S %HBR=$C(27,41,74) S %ENG=$C(27,41,76) S BUF=255 S SOT=$C(4),STX=$C(2),ETX=$C(3) X %chista I $D(^GTR000(PRT)) K %Q S %Q("Z")=" mcew wqtp didy xeciy jiyndl ",%Q("X")=10,%Q("Y")=4 D ^%S2ASK I YES G IN01 K ^GTR000(PRT) I $D(USERGLOB) G IN0 K ^UTILITY($J) D ^%GSEL IN0 S GNAME="" F S GNAME=$O(^UTILITY($J,GNAME)) Q:GNAME="" S MAC="^"_GNAME D GLSV IN01 I $D(^GTR000(PRT))<10 U 0 W !,"HASN'T GLOBALS FOR TRANSMISSION" Q S PORTN=USERPORT D ^%L1MD(USERPORT,USERMOD,USERPHONE,$G(MDTONE),US,$G(MDXON)) I %L1MDOK'=1 G EXIT M S ER=0 X US S GNAME="" F S GNAME=$O(^GTR000(PRT,GNAME)) Q:GNAME="" D Q:ER=10000 .U 0 W !,"--",GNAME,! S OKSND=0 D SETSTR I ER>999 D ERREND G EXIT U 0 W !!,"******** TRANSMISSION SUCCESFUL **********",!! ;;D PORT2^%L1GTR1 ;*** LEV 3/04/94 EXIT H 1 I $G(PORTN)>3,PORTN'=$P O PORTN::1 I X US D HANGUP C PORTN K USERPHONE,USERPORT,USERGLOB S $ZT=$G(ZT) Q ;- ERREND ; I $ZS'="" S ER=10000 U 0 W !!,"******** TRANSMISSION ERROR (ER=",ER,") **********",!! S ^%L1GTER=ER X US W $C(5)_"SOF",$C(13) I ER>1000 W !!,"*** END OF TRANSMISSION ***",! H 1 Q ;- SETSTR ; X US S ER=0 S N=-1 S N=$N(^GTR000(PRT,GNAME,N)) I N'=-1 D SET ;I ER=1000 K ^GTR000(PRT,GNAME) ;I ER=10000 K ^GTR000(PRT) I N>0,ER<1000 G SETSTR ENDP Q ;- SET S CNER=0,CNER1=0 S1 S STRG=^GTR000(PRT,GNAME,N) S OK=1,ER=0 ;S STROUT=SOT_GNAME_"*"_(OKSND+1)_"*"_$L(STRG)_"*"_$ZCR(STRG,1)_STX_STRG S STROUT=SOT_GNAME_"*"_N_"*"_$L(STRG)_"*"_$ZCR(STRG,1)_STX_STRG S BCC=$ZCR($E(STROUT,2,255),1) S STROUT=STROUT_ETX_BCC F JJ=1:1:BUF R *Z:0 W STROUT,$C(13) S2 R ANS1:6 E S OK=0 S ER=3,CNER=CNER+1 D ER G:CNER<5 S1 S ER=10000 Q S ER=0,CNER=0 I ANS1="OK" G S2 I BCC'=$P(ANS1,ETX,2) D S OK=0 G:ER=4 ENDST I ER>999 D ERREND G ENDST .I $P($P(ANS1,STX,2),ETX)=($C(5)_"DOUBLE") K ^GTR000(PRT,GNAME,N) S ER=4 Q .I $P($P(ANS1,STX,2),ETX)=($C(5)_"SEQ") S ER=10000 Q ; 1000 *** LEV .S ER=$P($P(ANS1,STX,2),ETX) I 'OK S CNER1=CNER1+1 D ER G:CNER1<6 S1 S ER=10000 Q S OK=1,OKSND=OKSND+1,CNER1=0 ;U 0 W GNAME_"*"_(OKSND+1)_"*"_STRG,! U PORTN U 0 W GNAME_"*"_N_"*"_STRG,! U PORTN K ^GTR000(PRT,GNAME,N) ENDST ; U PORTN Q ;- ER U 0 W !,"ERR: ",ER,! S ^%L1GTER=ER U PORTN Q ;- DEB U 0 F J=1:1:$L(SS) W $$^%L1ZH($A($E(SS,J)))_" " U 0 W ! U PORTN Q GLSV ; S %LENGTH=0 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 U 0 W !!,MAC S CHKS=0 S %MAC2=$R S:$R[")" %MAC2=$E($R,1,$L($R)-1) S II=0 I %PR S (GT1,^GTR000(PRT,GNAME,1))=MAC,(GT2,^GTR000(PRT,GNAME,2))=@MAC S II=2,CHKS=CHKS+$ZCR(GT1,1)+$ZCR(GT2,1) K GT1,GT2 S %MAC1=MAC S %MAC1=$Q(@%MAC1) I %MAC1="" W:%PR=0 *7,!?15,"*** ARRAY ",MAC," HASN'T NODES !" Q PR F Q:%MAC1'[%MAC2 Q:%MAC1="" Q:%LENGTH S II=II+1 S (GT,^GTR000(PRT,GNAME,II))=%MAC1,CHKS=CHKS+$ZCR(GT,1),II=II+1,(GT,^GTR000(PRT,GNAME,II))=$G(@%MAC1,$C(7)) S CHKS=CHKS+$ZCR(GT,1) S:$L(GT)>236 %LENGTH=1 S %MAC1=$Q(@%MAC1) I %LENGTH U 0 W *7,!!,"*** A NODE TOO LENGTH :",%MAC1,!!,GT,!! K ^GTR000(PRT,GNAME) G END S II=II+1 S ^GTR000(PRT,GNAME,II)=$C(5)_$S($O(^UTILITY($J,GNAME))="":"END",1:"ENDG")_"*"_GNAME_"*"_II_"*"_CHKS_$C(6) END K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 C:$D(PORTN) PORTN Q HANGUP D ^%L1HANG Q BEG D BEG^%L1HANG Q ZT D ERREND G EXIT %L1GTR1 %L1GTR1 ;RECEIVE GLOBALS VIA MODEM [ 10/21/2000 11:32 AM ] [ 05/23/99 5:07 PM ] [ 06/09/97 4:32 PM ] N (%UPRCOD,%XMSG,USERPORT,USERMOD) S $ZS="" U $P:(CENABLE) D ^%L1C I '$D(USERMOD) S USERMOD=1 U 0 S PRT=$P S ZT=$ZT W !?20,"CTRL/C - EXIT",! S US="DEV:(0::::#800101)" ZP I $G(USERPORT)>3 S DEV=USERPORT G IN ASK R !!,"I/O PORT? > ",DEV G:DEV="" END+1 IN I $P=DEV!'DEV W !!,"CANNOT SELECT YOUR OWN DEVICE.",*7 G ASK U $P:(CENABLE) O DEV::0 E U 0 W *7,"..LINE IN USE..WAITING.." O DEV W "READY" U DEV I $ZB($ZA,2,1) U 0 W !,"DEVICE ",DEV," IS AN OUTPUT ONLY DEVICE.",*7 G ASK OP O DEV S %DT=0 S $ZT="S zr=$R "_^ZT_"ZG "_$ZL_":END^%L1GTR1" D HANGUP,BEG PORT U @US H 1 W "ATS0=1"_$C(13) R %Y:4 G:%Y[$C(1) END S %CR=$ZB U 0 W:$L(%Y) %Y W:$T $C(%CR),! S %DT=%DT+1 PORT1 I %Y'["OK" H 2 G:%DT<8 PORT U 0 W *7,!!,"NO CARRIER" D HANGUP G END+1 S END=0,CNOLD=+$G(^L1G("CNOLD")),BCCSUM=+$G(^L1G("BCC")),GNAMEOLD=$G(^L1G("GNAME")),STROUT="" F U @US R *BG:0 Q:END X "I BG>0,BG'=4 U 0 W $C(BG) U DEV" I BG=4 D Q:STROUT[($C(5)_"SEQ") Q:STR=($C(5)_"SOF") .R STR Q:STR=$C(5)_"SOF" S ST1=$P(STR,$C(2)),STRG=$P($P(STR,$C(2),2),$C(3)) .B .S GNAME=$P(ST1,"*"),CN=$P(ST1,"*",2),DL=$P(ST1,"*",3) .I CN=1 S CNOLD=0,BCCSUM=0,GNAMEOLD="" .I GNAMEOLD="" S GNAMEOLD=GNAME .S BCC1=$P(ST1,"*",4) .S BCC2=$P(STR,$C(3),2) .I BCC2'=$ZCR($P(STR,$C(3)),1) S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"BCC2"_$C(3)_$C(13) W STROUT Q .I BCC1'=$ZCR(STRG,1) S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"BCC1"_$C(3)_$C(13) W STROUT Q .I STRG[$C(5),STRG[$C(6),STRG["END",GNAMEOLD=$P(STRG,"*",2) D Q ;*** END ROUT ..I $G(CNOLD)=($P(STRG,"*",3)-1),BCCSUM=+$P($P(STRG,"*",4),$C(6)) D Q ...D ZAP S STR=$C(5)_$S(STRG["ENDG":"SOFG",1:"SOF") ...S STROUT=$C(4)_GNAME_$C(2)_"OK"_$C(3)_BCC2_$C(13) W STROUT ...S END=0,CNOLD=0,BCCSUM=0,GNAMEOLD="" ..S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"SEQ"_$C(3)_$C(13) W STROUT Q .I CN=CNOLD S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"DOUBLE"_$C(3)_$C(13) W STROUT Q .I CN(CNOLD+1)) S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"SEQ"_$C(3)_$C(13) W STROUT Q .I $G(GNAMEOLD),GNAMEOLD'=GNAME S STROUT=$C(4)_GNAME_$C(2)_$C(5)_"SEQ"_$C(3)_$C(13) W STROUT Q .S CNOLD=CN,GNAMEOLD=GNAME,BCCSUM=BCCSUM+BCC1 .S ^L1G("CNOLD")=CN,^L1G("GNAME")=GNAME,^L1G("BCC")=BCCSUM .S ^GTR100(PRT,GNAME,CN)=$P($P(STR,$C(2),2),$C(3)) ZF .U 0 W ^(CN)," CN="_CN," BCC=",BCCSUM,! U DEV .S STROUT=$C(4)_GNAME_$C(2)_"OK"_$C(3)_BCC2_$C(13) W STROUT Q U DEV F I=1:1:10 R A:3 Q:A["ATH"!(A["NO CAR") END U 0 I $ZS["INRPT" W !,*7,"INTRERUPT",! D HANGUP C DEV S $ZT=$G(ZT) Q I $ZS'="" W !,$ZS D HANGUP C DEV Q GOTO OP ;U 0 Q ;- ZAP ; S J=0 F S J=J+1 Q:'$D(^GTR100(PRT,GNAME,J)) I ^(J)["^" S:$G(^(J+1))'=$C(7) @(^(J))=^GTR100(PRT,GNAME,J+1) S J=J+1 U DEV Q HANGUP ; N PORTN S PORTN=DEV D ^%L1HANG Q BEG N PORTN S PORTN=DEV D BEG^%L1HANG Q %L1HANG %L1HANG ;---INPUT: PORTN,USERMOD (TIP MOD) [ 08.02.06 12:07 ] [ 01.02.04 14:05 ] [ 26.06.02 12:39 PM ] ;INPUT: PORTN,USERMOD N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,USERMOD,%L2MD,%L1RCV) D ^%L1C I $D(%L2MD) D MSG^%L2MD("WAIT","M") I '$D(%L2MD),'$D(%L1RCV) D ZU(0) W !,"WAIT ...",! O PORTN::3 E Q TV U PORTN:(NOECHO:NOWRAP:PASTHRU:TERM=$C(13)) D HNG("ATH0ZS0=0") Q ; PNIMI Q HNG(ST) ; D CLPORT D ESC D CLPORT I $E(ST,$L(ST))'=$C(13) S ST=ST_$C(13) D WR(ST) D CLPORT Q ; BEG ; ;;I USERMOD=1!(USERMOD=3) D CLPORT D WR("ATZ") D CLPORT Q I USERMOD'=2 Q D CLPORT D WR("ATH0Z0&F") Q S ST="AT&F"_$C(13) H 1 D WR(ST) D CLPORT S ST="AT%C0X4"_$C(13) H 1 F I=1:1:$L(ST) W $E(ST,I) D DELAY D CLPORT Q CLPORT ; U PORTN F R A:1 E Q Q WR(ST) ; F I=1:1:$L(ST) W $E(ST,I) D DELAY Q DELAY F II=1:1:$G(%DELAY,10000) Q ESC ; ;H 1 N I F I=1:1:3 W $E("+++",I) D DELAY H 1 Q ZU(PORT) ; I $P["tty" U $P Q U ^[$$^%L1GLD]dev(1) Q %L1HB %L1HB(%ST) ; [ 15.03.19 11:10 ] [ 02.11.06 08:25 ] [ 18.01.06 17:55 ] [ I $G(%ENGLISH) Q %ST I '$D(%TES1)!'$D(%TES2)!'$D(%TEN)!'$D(%THB) D ^%L1C ;;Q $TR($TR(%ST,%TES1,%TES2),%TEN,%THB) Q $$W^%L1C(%ST) %L1HBR %L1HBR(%A) ; [ 15.03.19 07:10 ] [ S %A=$$RPL^%L1FRM(%A,%CLI,"<%CLI>") S %A=$$RPL^%L1FRM(%A,%CCL,"<%CCL>") ;;S %A=$TR($TR(%A,%TES1,%TES2),%TEN,%THB) S %A=$$W^%L1C(%A) S %A=$$RPL^%L1FRM(%A,"<%CLI>",%CLI) S %A=$$RPL^%L1FRM(%A,"<%CCL>",%CCL) Q %A %L1HEAD %L1HEAD(DUMP) ; RSD HEADER [ 04.03.07 13:22 ] [ 13.07.06 12:30 ] [ 15.02.06 12:42 ] I $ZGBLDIR=$G(^UCI("MGC")) Q " VC " N %AT S %AT="" N GLD S GLD=$$^%L1GLD I $L($G(^[GLD]PL("ESEK",1))),$G(^[GLD]PLUK)'["MLY" S %AT=" "_^[GLD]PL("ESEK",1)_" " I $G(^[GLD]PLUK)["MLY",$D(^UCI("MLG")),$P'["/dev/vc/2" S %AT=" "_$G(^[^UCI("MLG")]STAT("NAME")) I '$G(^P1PRM("NOMRKZN")) S %AT=%AT_" "_$G(^[^UCI("MLG")]STAT("MLY","EM","MRKZ"))_" " Q %AT %L1HFS %L1HFS ; DOS-FILE EDITOR [ 29.06.03 22:39 ] [ 13.04.01 1:54 PM ] [ 03.08.00 2:40 PM ] N (%NMF,%UPRCOD,%XMSG,%TIP) D ^%L1C ; [ 10/24/97 2:46 PM ] U 0 S PRT=$P S %S="" I $D(%NMF) S %NMF1="" G IN Z1 Q:$D(%NMF1) X %chista S %FL="" U 0 S %SAY="HFS-FILE EDITOR" X %XMSGV W !!,"FULL NAME OF HOST FILE (INPUT): " D ^%ZMSL I %S="?"!(%TO="F7") D O13^%L1OS S %S=$S($G(%PATH)'="":%PATH_"\",1:"")_$TR($E(%L2VNM,1,8)_"."_$E(%L2VNM,11,13)," ","") G Z1 G:%S=""!(%TO="END") END S %NMF=%S IN U 0 W !!?5,%NMF S %ER=$$^%L1ZOS(10,%NMF) I %ER<0 D ^%L1OS1 S %Q("Z")="ENTER DATA",%Q("U")="N" D ^%S1ASK G:'YES Z1 ZF S %GETIN=2,%GET="DOS FORMAT - 1, LINUX FORMAT - 2 :" D NE^%L1GET I %S=""!(%TO="END") G Z1 I %S'=1,%S'=2 W *7 G ZF S %DOS=2-%S O %NMF:(READONLY:REWIND:EXCEPTION="g TE^%L1HFS"):2 E U 0 W !,"*** DEVICE 51 IN USE !" G Z1 I $ZEOF D OE G Z1 C %NMF G:$$^%L1ZOS(10,%NMF)<0 Z11 O %NMF:(READONLY:REWIND) U %NMF:(TERM=$C(13,10,27)) K ^S000(PRT) F %I=1:1 R %STRING Q:$ZEOF D I '(%I#50) U 0 W "." U %NMF .S ^S000(PRT,%I)=$P($P($E(%STRING,1,255),$C(13)),$C(10)) .I $L(%STRING)>255 S %I=%I+1 S ^S000(PRT,%I)=$E(%STRING,256,512) C %NMF Z11 S U=1 K L,R,LR D ^%S2ERG Z2 U 0 X %chista S %S=%NMF W !!,"FULL NAME OF HOST FILE (OUTPUT): " D ^%ZMSL G:%S="" Z1 I %S="?" D DIR^%OS G Z2 I $$^%L1ZOS(10,%S)'<0 S %Q("Z")="FILE IN DIRECTORY! ARE YOU SURE",%Q("U")="N" D ^%S1ASK G:'YES Z2 S %M="D",%P=1,%EXIST=1 S %ER=$$^%L1ZOS(2,%S) I %ER<0 D ^%L1OS1 G Z2 O %S:(WRITE:NEWVERSION) ;I $ZC'=0 D OE G Z2 U %S F %I=1:1 Q:'$D(^S000(PRT,%I)) W ^(%I),! C %S I %DOS ZSY "unix2dos "_%S K ^S000(PRT) G Z1 END C 51 Q L N D ^%L1C S %LOOK="" G Z1 TE W *7,!,"READ ERROR $ZC=",$ZC Q OE W *7,"*** OPEN ERROR ! $ZC=",$ZC Q C Q %L1HOV %L1HOV(%DAT) ; HOV TISKORET [ 16.01.04 11:37 ] [ 24.06.03 1:45 PM ] [ 23.06.03 1:54 PM ] I '$D(^%HOV) Q 1 I $$^%L1DC(^%HOV,3)-7'>%DAT D Q $S($$^%L1DC(^%HOV,3)<%DAT:0,1:1) .S %GET="!!! dqxib oekcrl dpkez wtql xywzdl `p" .N %RZ S %RZ=$$^%L1DC(^%HOV,3)-%DAT .I %RZ>0 S %GET="( mini "_($$^%L1DC(^%HOV,3)-%DAT)_" cer ex`yp ) "_%GET .D N^%L1GET ;;I $$^%L1DC(^%HOV,3)'>%DAT I 1/0 Q Q 1 N %DT,%DT1,%GG,%MM,%DD,%OK S %DT=$ZD(%DAT,3),%GG=$P(%DT,"/",3),%MM=$P(%DT,"/",2),%DD=$P(%DT,"/") S %DT1=%GG+%MM S %OK=1 I %DD<20 K ^%HOV(1) Q:$P($H,",",2)<22000 1 I $D(^%HOV),$G(^%HOV)'=(%DT1\%MM) D I '%OK Q %OK .N %SH S %SH=0 Z .S %GET=" : "_%MM_"."_%GG_" ycegl `nqiq yiwdl `p #4" D N^%L1GET I %TO="END" S %OK=0 Q .I %S'=(%DT1\%MM) S %SH=%SH+1 S %SAY=" ! dieby `nqiq " X %XMSGV(1) G:%SH<3 Z S %OK=0 Q .S ^%HOV=%S I $D(^%HOV),'$D(^%HOV(1)),%DD>20 D .N %Q,YES .K %Q S %Q("Z")="`ad ycegl `nqiq jl reci m`d",%Q("X")=30,%Q("Y")=22 D ^%S2ASK .I YES S ^%HOV(1)="" Q .S %GET=" . `ad ycegl `nqiq xxale .c.y.xl xywzdl `p " D N^%L1GET Q %OK %L1IDK %L1IDK ; [ 28.11.01 6:08 AM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %SCRN="IDKUN" D GET D A^%L1SC S %SC("ENDS")="" S %SC("MOVE")="" S %SC("MIUN")="" SC D GETFG^%L1SC D IS3^%L1GET I %S=1 G SC I %S=2 D SAVE END K ^TEMP($P) Q ; GET K ^TEMP($P) M ^TEMP($P)=^IDKUN Q SAVE K ^IDKUN S J=0 F I=1:1 Q:'$D(^TEMP($P,I)) I $P(^(I),"\",3)'?.P S J=J+1,^IDKUN(J)=^TEMP($P,I) Q %L1IND %L1IND(GLOB,NI) ; (NI - IND NUMBER) [ 27.07.26 18:41 ] [ 14.04.22 17:52 ] [ 01.04.20 04:56 ] N I,I2,FLGRS,NIND,IND I $E(GLOB,1,2)="^[" S GLOB=$P(GLOB,"]",2,200) I $E(GLOB,1,2)="^|" S GLOB=$P(GLOB,"|",3,200) S IND="",FLGRS=0,NIND=1 F I=1:1:$L(GLOB) Q:$E(GLOB,I)="(" S I2=I IND2 S I2=I2+1 I I2>$L(GLOB) Q $S(NIND=NI:IND,1:"") I $E(GLOB,I2)="""" S FLGRS=1-FLGRS G IND2 I $E(GLOB,I2)=",",'FLGRS S NIND=NIND+1 Q:NIND>NI IND S IND="" G IND2 I $E(GLOB,I2)=")",'FLGRS Q $S(NIND=NI:IND,1:"") S IND=IND_$E(GLOB,I2) G IND2 Q "" ; GL(REF,NI) ; N GL,LEN S LEN=$L(REF,",") S GL=$P(REF,"(") I LEN<3 Q GL S GL=GL_"(" N I F I=1:1:NI I I'>LEN D .N IND S IND=$$%L1IND(REF,I) Q:IND="" .S GL=GL_""""_IND_"""," I $E(GL,$L(GL))="," S GL=$E(GL,1,$L(GL)-1) S GL=GL_")" Q GL %L1INDTC %L1INDTC(STAM) ; [ 15.10.06 14:34 ] [ 12.10.06 11:54 ] [ 09.10.06 19:21 ] ;Q $$TV^%L1DEFWS I $D(@$$^W4DEVI@($P)) Q +@$$^W4DEVI@($P) Q 0 IND(PORT) ; Q PORT P(STAM) ; N POS S POS=$$TV^%L1DEFWS I POS?.P,$D(devi($P)) Q @$$^W4DEVI@($P) I POS="" Q "" I $G(^devi3(POS))="",$D(@$$^W4DEVI@($P)) Q @$$^W4DEVI@($P) Q +$G(^devi3(POS)) %L1INS %L1INS ;CREATING CONFIGURATION ON NEW DISK (%LLL,^SYS,KUP,...); [ 05/23/99 5:11 PM ] [ 07/29/96 7:00 AM ] ; [ 05/23/99 5:11 PM ] K V 2:$J:1:2,108:$J:60000:4 ZP R !!,"PATH ",%PTH Q:%PTH="^" I %PTH="" S %PTH="A:\" I $P(%PTH,"\",2)="",%PTH'["\" S %PTH=%PTH_"\" I $P(%PTH,"\",2)'="",%PTH["\" S %PTH=$E(%PTH,1,$L(%PTH)-1) S %ER=$$^%L1ZOS(10,%PTH) I %ER<0 D ^%L1OS1 H 2 G ZP I $E(%PTH,$L(%PTH))'="\" S %PTH=%PTH_"\" U $P:(CENABLE:CTRAP=$C(3)) K ^%L3RR S ^%L3RR("FN")=%PTH_"%LLL" D ^%L3RR S ^%L3RR("FN")=%PTH_"%SSS" D ^%L3RR S ^%L3RR("FN")=%PTH_"%ZMSL" D ^%L3RR S ^%L3RR("FN")=%PTH_"STUSER3" D ^%L3RR S %GLB="SYS",%STAT="4,4,4,4" D ^%L1GCH S ^SYS("LOGON","P")="MER,"_$P($$^%L1ZU(0),",",2)_":PLMENU:96:" S ^SYS("LOGON","K")="MER,"_$P($$^%L1ZU(0),",",2)_":KUPM:96:" S ^SYS("LOGON","l")="MER,"_$P($$^%L1ZU(0),",",2)_":KUPM:96:" S ^SYS("LOGON","k")="MER,"_$P($$^%L1ZU(0),",",2)_":KUPM:96:" S ^SYS("LOGON","t")="MER,"_$P($$^%L1ZU(0),",",2)_":PLMENU:96:" S ^SYS("LOGON","p")="MER,"_$P($$^%L1ZU(0),",",2)_":PLMENU:96:" S ^SYS("LOGON","MG")="MGR,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","mg")="MGR,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","MR")="MER,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","mr")="MER,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","ML")="MLY,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","ml")="MLY,"_$P($$^%L1ZU(0),",",2)_":%L1X:96:" S ^SYS("LOGON","M")="MLY,"_$P($$^%L1ZU(0),",",2)_":BA:96:" S ^SYS("LOGON","m")="MLY,"_$P($$^%L1ZU(0),",",2)_":BA:96:" S ^SYS("LOGON","v")="MLY,"_$P($$^%L1ZU(0),",",2)_":BA:96:" S ^SYS("LOGON","MD")="MER,"_$P($$^%L1ZU(0),",",2)_":MODEM:24:" S ^SYS("LOGON","md")="MER,"_$P($$^%L1ZU(0),",",2)_":MODEM:24:" S ^SYS("LOGON","G")="MGR,"_$P($$^%L1ZU(0),",",2)_":%L1RPR:84:" S ^SYS("LOGON","g")="MGR,"_$P($$^%L1ZU(0),",",2)_":%L1RPR:84:" S ^SYS("LOGON","I")="MER,"_$P($$^%L1ZU(0),",",2)_":INS:50:" S ^SYS(0,"DDB",1)="PC/DOS,CON,0,,80,40004,,,,",^%TYPCRT(1)="PC" S PRCON=0,N="" F S N=$O(^SYS(0,"DDB",N)) Q:N="" I ^(N)["CON1" S PRCON=1 Q I 'PRCON S ^SYS(0,"DDB",17)="PC/DOS,CON1,0,,80,40004,,,,0",^%TYPCRT(17)="PC" S ^SYS(0,"DDB",3)="PC/DOS,LPT1,0,,132,840103,,,,0" S SGCNFG=0 D ^SGPART S ^SYS(0,"PROT")="255;255" S ^%TYPCRT(1)="PC" S ^%L3UA("UCI")="MER" D ^%L3UA S ^%L3UA("UCI")="ZIP" D ^%L3UA S ^%L3UA("UCI")="MLY" D ^%L3UA K ^%L3GR,^%L3RR S ^%L3GR("FN")=%PTH_"KUPA.G" S ^%L3RR("FN")=%PTH_"KUPA.NEW" ;S ^SYS(0,"JOB",1)="^PLUCOM[""MER""]" D ^%L1C X %chista K %Q S %Q("Z")=" 'dtew' zkxrn zniiw m`d",%Q("X")=20,%Q("Y")=4 D ^%S2ASK G:'YES I2 I V 2:$J:+$ZU("MER"):2,108:$J:60000:4 U 0 S %GET=" ugle opewl 'KUPA.NEW' uaew mr hwqic qipkz " D N^%L1GET D ^%L3RR U 0 S %GET=" ugle opewl 'KUPA.G' uaew mr hwqic qipkz " D N^%L1GET D ^%L3GR I1 D ^INS I '$D(^PL) G I1 X %chista I2 D ^%L1C K %Q S %Q("Z")=" 'i`ln' zkxrn zniiw m`d",%Q("X")=20,%Q("Y")=6 D ^%S2ASK G:'YES I31 V 2:$J:+$ZU("MLY"):2,108:$J:60000:4 S ^%L3GR("FN")=%PTH_"MLY.G" S ^%L3RR("FN")=%PTH_"MLY.R" U 0 S %GET=" ugle opewl 'MLY.R' uaew mr hwqic qipkz " D N^%L1GET D ^%L3RR U 0 S %GET=" ugle opewl 'MLY.G' uaew mr hwqic qipkz " D N^%L1GET D ^%L3GR I3 D ^MLNAME I31 V 2:$J:1:2 ;MGR W !!,"DEFINEDS PORTS FOR CASH REGISTER : " S N="" F S N=$O(^PLUK(N)) Q:N="" W N," " S (SGINDEX,SGINDEXOLD)=0 U $P:(ECHO:WRAP:WIDTH=80) Z W !!,"EXIST "_$S(SGINDEX:"MORE ",1:"")_" MULTI-PORT I/O CARD ? (Y/N) :" R ANS I ANS'="Y",ANS'="y" G PORT S SGSYSID="PC",SGCNFG=0 D DISPLAY^SGSPCOM S SGINDEXOLD=SGINDEXOLD+1 S SGINDEX=SGINDEXOLD M K SGNAME,SGADD,SGSHMEM,SGINT I $D(^SYS(SGCNFG,"SMARTCOM",SGINDEX)) S X=^(SGINDEX),SGNAME=$P(X,"^"),SGADD=$P(X,"^",2),SGSHMEM=$P(X,"^",3),SGINT=$P(X,"^",4) D BOARD^SGSPCOM S SGINDEX=SGINDEXOLD I '$D(^SYS(0,"SMARTCOM",SGINDEX)) G PORT ZP W !!,"ENTER PORTS FOR CASH REGISTERS THAT USE I/O CARD "_$P(^SYS(0,"SMARTCOM",SGINDEXOLD),"^")_" (EXAMPLE:11,12,13,14) :" R !,PORTS G:PORTS="" PORT S ER=0 F I=1:1:$L(PORTS,",") S PORT=$P(PORTS,",",I) I PORT'?1N.N W *7," ???" S ER=1 Q I ER G ZP F I=1:1:$L(PORTS,",") S PORT=$P(PORTS,",",I) I PORT?1N.N D ZA S ^SYS(0,"DDB",PORT)="PC/DOS,"_$P(^SYS(0,"SMARTCOM",SGINDEXOLD),"^")_ADR_",713,,0,840101,,,,0" G Z PORT W !!,"ENTER SERIAL PORTS FOR CASH REGISTERS (EXAMPLE:4,5) :" R !,PORTS G:PORTS="" C S ER=0 F I=1:1:$L(PORTS,",") S PORT=$P(PORTS,",",I) I PORT'?1N.N,PORT<4,PORT>7 W *7," ???" S ER=1 Q I ER G PORT F I=1:1:$L(PORTS,",") S PORT=$P(PORTS,",",I) I PORT?1N.N S ^SYS(0,"DDB",PORT)="PC/DOS,COM"_(PORT-3)_",713,,0,840101,,,,0" C S SGX="DFLT",CNFG="CONFIG",(SGCFNM,SGCNFG)="Q",SGCMNT="%L1INS",DLM=";" D GETDUP+2^SGCNFG I '$D(^PL("MDPORT")) G END S MDPORT=^PL("MDPORT") S NCNF=+^SYS("CONFIG","DFLT") I MDPORT<6,MDPORT>3 S ^SYS(NCNF,"DDB",MDPORT)="PC/DOS,COM"_(MDPORT-3)_",209,,0,101,,,,0" S NCNF=+^SYS("CONFIG","Q") I MDPORT<6,MDPORT>3 S ^SYS(NCNF,"DDB",MDPORT)="PC/DOS,COM"_(MDPORT-3)_",209,,80,4,,,,0" I MDPORT>5 D MDIO END W !!,*7," DO 'MGR:SSD' & RESET " H 5 Q ZA ; W !!,"PORT "_PORT_" ADDRESS: " R ADR I ADR'?1N.N W *7," ???" G ZA I $G(ADR(ADR))>0,ADR(ADR)'=PORT W *7,"THE ADDRESS FOR PORT "_ADR(ADR) G ZA S ADR(ADR)=PORT Q MDIO ; U $P:(ECHO:WRAP:WIDTH=80) Z W !!,"A MODEM USE MULTI-PORT I/O CARD ? (Y/N) :" R ANS I ANS'="Y",ANS'="y" Q S SGSYSID="PC",SGCNFG=NCNF D DISPLAY^SGSPCOM S (SGINDEX,SGINDEXOLD)=$ZP(^SYS(SGCNFG,"SMARTCOM",""))+1 M K SGNAME,SGADD,SGSHMEM,SGINT I $D(^SYS(SGCNFG,"SMARTCOM",SGINDEX)) S X=^(SGINDEX),SGNAME=$P(X,"^"),SGADD=$P(X,"^",2),SGSHMEM=$P(X,"^",3),SGINT=$P(X,"^",4) D BOARD^SGSPCOM S SGINDEX=SGINDEXOLD I '$D(^SYS(NCNF,"SMARTCOM",SGINDEX)) Q I '$D(^PL("MDPORT")) Q S MDPORT=^PL("MDPORT") S PORT=MDPORT D ZA S NCNF=+^SYS("CONFIG","DFLT") S ^SYS(0,"DDB",PORT)="PC/DOS,"_$P(^SYS(0,"SMARTCOM",SGINDEXOLD),"^")_ADR_",209,,0,800101,,,,0" S NCNF=+^SYS("CONFIG","Q") S ^SYS(0,"DDB",PORT)="PC/DOS,"_$P(^SYS(0,"SMARTCOM",SGINDEXOLD),"^")_ADR_",209,,0,800101,,,,0" Q %L1ISFTP %L1ISFTP(PROG) ; [ 01.02.06 17:39 ] [ N GLD S GLD=$$^%L1GLD I $G(^[GLD]PL("FTP")) Q 1 I $L($G(PROG)),$G(^[GLD]PL("FTP",PROG)) Q 1 Q 0 %L1JRST %L1JRST ; [ 09.05.06 06:53 ] [ 27.04.06 14:52 ] [ 20.11.05 16:45 ] I $V("JNLACTIVE","DEFAULT")=1 D .Q:$$^%L1ZOS(10,$$^%L1ENVAR("gtm_dist")_"/mumps.mjl")'<0 .ZSY "mupip SET -JOURNAL=ENABLE,BEFORE_IMAGES -FILE $gtm_dist/mumps.dat" Q TV Q:$$^%L1ZOS(10,$$^%L1ENVAR("gtm_dist")_"/mumps.mjl")'<0 ZSY "mupip SET -JOURNAL=ENABLE,BEFORE_IMAGES -FILE $gtm_dist/mumps.dat" Q DIS ; ZSY "mupip SET -JOURNAL=DISABLE -FILE $gtm_dist/mumps.dat" Q %L1JSON %L1JSON(FILE,GL,PR) ; [ 22.08.23 11:02 ] [ 21.08.23 15:04 ] [ 20.08.23 18:28 ] N (JB,%ARG,%REM,FILE,GL,PR) ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$$EXIST^%L1ZOS(FILE) Q "FILENOTEXIST" O FILE:(REWIND:READONLY) U FILE S RES=0 S H=+$H,H2=$P($H,",",2) ; K @GL S II=0,CHAPT=1 I $G(PR)="V" S CHAPT=0 F R A Q:$ZEOF D S RES=$$READ(A) Q:'RES .S II=II+1,^LV(H,H2,"RESPJSON",II)=$E(A,1,3000) ; C FILE Q RES ; ; READ(A) ; S J=0,UR=0,BU=0,OLDT="" CYC ; S J=J+1 I J>$L(A) G END ; I $E(A,J)="""" D G CYC .S NOM=$O(@GL@(CHAPT,""),-1)+1 .F J1=J:1 Q:J1>$L(A) Q:$E(A,J1)="," Q:$E(A,J1)="}" Q:$E(A,J1)="]" Q:$E(A,J1)="{" Q:$E(A,J1)="[" .S B=$E(A,J,J1-1) .S B=$$SPA^%L1FRM(B) .I $G(PR)="V",$TR($P(B,":"),"""","")="merchent_receipt" S CHAPT=CHAPT+1,J=J1 Q .I $G(PR)="V",$TR($P(B,":"),"""","")="customer_receipt" S CHAPT=CHAPT+1,J=J1 Q .I $G(PR)="V",CHAPT=2,$TR($P(B,":"),"""","")="Verified by device" S CHAPT=CHAPT+1,J=J1 Q .I B[":",$L($P(B,":",2)) S @GL@(CHAPT,NOM)=B .S J=J1 ; G CYC ; END Q 1 ; ; ER D SVER^%L1X Q 0 ; LAST(UR) ; Q $O(@GL@(UR,9999999),-1) ; CLRQ(VL) Q $$CLRQ^W3SORD(VL) %L1JSON0 %L1JSON(FILE,GL,PR) ; [ 21.08.23 10:16 ] [ 20.08.23 18:28 ] [ 09.12.21 22:00 ] N (JB,%ARG,%REM,FILE,GL,PR) ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" O FILE:(REWIND:READONLY) U FILE S RES=0 S H=+$H,H2=$P($H,",",2) ; K @GL S II=0 F R A Q:$ZEOF D S RES=$$READ Q:'RES .S II=II+1,^LV(H,H2,"RESPJSON",II)=$E(A,1,3000) ; I $G(PR)="" C FILE I $G(PR)="DEL" C FILE:(DELETE) Q RES ; ; READ(STAM) ; S J=0,UR=0,BU=0,OLDT="" CYC ; S J=J+1 I J>$L(A) G END ; I $E(A,J)="{"!($E(A,J)="[") D G CYC .S NOMSH=$O(@GL@(""),-1)+1 .S GL=$E(GL,1,$L(GL)-1)_","_NOMSH_")" .F J1=J-1:-1:0 Q:$E(A,J1)=":" Q:$E(A,J1)="," Q:$E(A,J1)="}" Q:$E(A,J1)="]" .I $E(A,J,J1)["vuid" B ; .I $E(A,J1)=":" D ..N T S T=$E(A,1,J1-1) ..I T["," S T=$P(T,",",$L(T,",")) ..I T["}" S T=$P(T,"}",2) ..I T["]" S T=$P(T,"]",2) ..I T[":" S T=$P(T,":",2) ..I $L(T) S @GL=$TR(T,"{[","")_"=" ; I $E(A,J)="}"!($E(A,J)="]") D G CYC .S GL=$P(GL,",",1,$L(GL,",")-1)_")",BU=1 ; S @GL=$G(@GL)_$S(BU&$L($G(@GL))&$L($E(A,J)):",",1:"")_$E(A,J),BU=0 G CYC ; END Q 1 ; ER D SVER^%L1X Q 0 ; LAST(UR) ; Q $O(@GL@(UR,9999999),-1) %L1JSS %L1JSS ; JOB EXAM ; [ 28.04.00 4:58 PM ] [ 07/28/99 8:08 AM ] [ D ^%SS D ^JOBEXAM Q %L1KILL %L1KILL(PROC) ; [ 28.05.04 12:54 ] [ 29.01.04 10:42 ] [ 04.01.04 12:03 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PROC) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" BG S %NMF="l1kill"_$J S %IO=$I I $$^%L1ZOS(2,%NMF) ZSY "ps -fC "_$$FUNC^%LCASE(PROC)_" > "_%NMF I $$^%L1ZOS(10,%NMF)<0 G S2V O %NMF:(REWIND:READONLY) K ^TMPS111($J) F U %NMF R A Q:$ZEOF D .S ^TMPS111($J,$O(^TMPS111($J,9999),-1)+1)=A C %NMF ; I $$^%L1ZOS(2,%NMF) S2V X %chista S %S2V("NOHB")="" S %S2V("PROG")="VIEW^%L1KILL" S %S2V("TXT1")=" TO KILL JOB PRESS " D ^%S2VIEW K ^TMPS111($J) Q ; VIEW N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,U,%MET,zl) D ^%L1C W %CLI D W^%S2VIEW(U,1,80) X %XCL ; S %S=0 I %S=0 D Q .N JOB S JOB=$TR($E(^TMPS111($J,U),16,20)," ","") Q:'JOB .S %Q("Z")="ARE YOU SURE YOU WANT TO KILL JOB WITH PPID="_JOB D N^%S1ASK Q:'YES .N A S A="kill "_JOB .ZSY A .I $G(zl) S $E(^S2VTMPS111($J,zl,U),66,79)="-- KILLED --" Q %L1KL %L1KLM ; [ 23.10.07 21:19 ] [ D ^%L1KILL("mumps") Q %L1KLM %L1KLM ; [ 23.10.07 21:23 ] [ D ^%L1KILL("mumps") %L1L2M %L1L2M ; [ 03.08.11 09:13 ] [ 13.12.07 10:57 ] [ W # R !!,"FILE : ",FL O FL:(rewind:readonly) S FL1=FL_".lin" O FL1:(NEWVERSION:WRITE) F U FL R *A Q:$ZEOF D .U 0 W $C(A) .I A=13 U FL R *B Q:$ZEOF I B=10 U FL1 W $C(B) Q .U FL1 W $C(A) C FL,FL1 %L1LB %L1LB(%TXT,%GLB,%PR,%PR2) ; AUTO FIND ; [ 27.11.03 09:57 ] [ 16.11.03 15:27 ] [ 24.08.00 1:02 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%TXT,%GLB,%PR,%L1LB,%L3VN) D ^%L1C I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE Q N %TXTI,%I,%N S %I=0 K %L1LB,%L3VN S %TXTI=$$INV^%L1FRM(%TXT) I $L($G(%TXT))=0 Q I $G(%PR)="" S %PR="C" I %PR="I" D .S %N="" F S %N=$O(@%GLB@(%N)) Q:%N="" D ..I $E(%N,1,$L(%TXTI))=%TXTI D ...S %I=%I+1,%L1LB(%I)=$$INV^%L1FRM(%N) ; I %PR="C" D .S %N="" F S %N=$O(@%GLB@(%N)) Q:%N="" S %A=$G(^(%N)) I $L(%A)'<$L(%TXT) D ..N %B,%JJ,%OK S %OK=0 F %JJ=1:1:$L(%A," ") S %B=$P(%A," ",%JJ) D Q:%OK ...I $E(%B,$L(%B)-$L(%TXT)+1,255)=%TXT D S %OK=1 ....S %I=%I+1,%L1LB(%I)=%A ; S %L1("VIEW")="" TV S %SMY=$Y+1,%SMX=$X N %L1LBO S MAC1="%L1LB",MAC2="%L1LBO" D ^%S1GC1 S %L3VMAC="%L1LB" S %SMY=8,%L1("NGR")=23,%SM=35 D ^%L3VIEW S MAC1="%L1LBO",MAC2="%L1LB" D ^%S1GC1 Q %L1LIST %L1LIST ;DJM;LIST HFS FILE; [ 11/10/91 2:53 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. (c) 1986 S %DEV="",%OFN="",%VM=$V($V(44),-3,2)#16=0,%PRM2="" I $D(%HBRY) W %HBR START ; S $ZT="ZG "_$ZL_":ERR^%L1LIST" ;W !?10,$P($P($ZV,","),"-")," - Host File Lister Utility",! FILE I $D(%FN),%FN'?.P G OPEN I $D(%FN),%FN="" G EXIT R !,"File Name: ",%FN I %FN="^L" D DIR^%SDEV U 0 W ! G FILE I %FN="." S %FN=%OFN W "..> ",%FN I %FN=""!(%FN="^")!(%FN="^Q")!(%FN="^q") G EXIT I %FN="?" W !!,%ENG,"Enter name of host file to be displayed.",!,"The default path name is the one from which MSM was started.",!,"Enter '^L' to list the contents of a directory." W:$D(%HBRY) %HBR I %FN="?" W:$ZV["PC" %ENG,!,"To list a file on drive A, enter 'A:FILENAME'." W:%OFN'="" !,"Enter '.' to redisplay file '",%OFN,"'" W ! G FILE W:$D(%HBRY) %HBR G OPEN VMFILE ; R !,"File identifier: ",%FN I %FN="." S %FN=%OFN W "..> ",%FN I %FN=""!(%FN="^")!(%FN="^Q")!(%FN="^q") G EXIT I %FN="?" W !!,"Enter file identifier (i.e., spool id) of the CMS file to be displayed." W:%OFN'="" !,"Enter '.' to redisplay file '",%OFN,"'." I W !,"The file must have been previously spooled to MUMPS from CMS." I W !,"Enter ^L to see a list of the CMS files that have been spooled.",! G VMFILE I %FN="^L" D INT^%RDRLIST G VMFILE I %FN'=+%FN W *7," ... must be numeric" G VMFILE G:'$ZB($V(0,-4,2),128,1) OPEN OPEN S %OFN=%FN F %DEV=54:-1:51 O %DEV:(%FN:%PRM2):0 G:$T GOTDEV W %ENG,!,*7,"*** All HFS devices (#51-54) are in use.. retry later ***",*7,! W:$D(%HBRY) %HBR G EXIT GOTDEV ; U %DEV I $ZA<0 U 0 C %DEV W %ENG,*7," ...File not found" W:$D(%HBRY) %HBR G FILE I %VM S %SIZE=0 U 0 G SCROLL U %DEV:(::0:2) S %SIZE=$ZB U %DEV:(::0:0),0 SCROLL ; S %LAST=1 W !," <"_$G(%LPP0,23)_">: dxey " R %LPP S:%LPP="" %LPP=$G(%LPP0,23) I %LPP="^" C %DEV G FILE I %LPP="^Q"!(%LPP="^q") C %DEV G EXIT I %LPP'?1.N W ! W:%LPP'="?" *7 W %ENG," Please enter number of lines per output page, 0 means no paging" W:$D(%HBRY) %HBR D RULES G SCROLL I %LPP>0 G PAGING W !!,"------Start of file: ",%FN," ----------------------------------" F %I=1:1 U %DEV R %LINE Q:$ZC U 0 W !,%LINE U 0 W !,"------End of file: ",%FN," ----------------------------------",! %EOF ; C %DEV S %FN="" G FILE PAGING ; K %LINES,%PG S %PG=%LPP+%LPP U 0 W !! S $Y=0 ;W "------Start of file: ",%FN," " F %I=$X:1:79 W "-" W ! S %EOF=0 F %I=1:1 D:$Y>(%LPP-1) PAGE G:%EOF=2 CLOSE Q:%EOF U %DEV S:+$E(%I,2,99)=0 %LINES(%I)=$ZB S %PG(%I)=$ZB K %PG(%I-%PG) R %LINE Q:$ZC U 0 W %LINE,! U 0 ;W "------End of file: ",%FN," " F %I=$X:1:79 W "-" W ! C %DEV S %FN="" G FILE PAGE ; U %DEV S %OFST=$ZB U 0 W "<",%FN,"> @line#",%I W:%SIZE " (",$J(%OFST/%SIZE*100,0,0),"%) " R %LINE S %X=$X W *13 F %J=0:1:%X W " " W $C(13) S $Y=0 I %LINE="" S %LAST=%I Q I %LINE="^" S %EOF=1 Q I %LINE=" " S $Y=%LPP-1 Q I %LINE="^Q"!(%LINE="^q") S %EOF=2 Q G:%LINE?1"-"1.N BACKUP I %LINE="?" D RULES W ! G PAGE I %LINE="-" S %LINE="-"_$G(%LPP0,23) G BACKUP I %LINE?1"+"1.N S $Y=$S(%LINE>%LPP:0,1:%LPP-%LINE) S %LAST=%LAST+%LPP-$Y Q I %LINE'?1.N D RULES W ! G PAGE W %ENG,"<...skipping ",%LINE," line",$S(%LINE=1:"",1:"s"),"...>",! W:$D(%HBRY) %HBR U %DEV F %I=%I+1:1:%I+%LINE S:+$E(%I,2,99)=0 %LINES(%I)=$ZB S %PG(%I)=$ZB K %PG(%I-%PG) R %LINE I $ZC S %EOF=1 Q S %LAST=%I Q BACKUP ; S %I=%LAST+%LINE,%LINE=%I I %I<1 S %I=1 W %ENG,!,"Resuming display at line #" W:$D(%HBRY) %HBR I $D(%PG(%I)) U %DEV:(::%PG(%I)) E S %J=+($E(%I)_$E("00000000",1,$L(%I)-1)) U %DEV:(::%LINES(%J)) F %J=%J:1:%I-1 R %X U 0 W %I,! S $Y=$Y-2 U %DEV S %LAST=%I F %J=0:0 S %J=$N(%PG(%I)) Q:%J<0 K %PG(%J) Q CLOSE C %DEV EXIT K %DEV,%EOF,%FLIST,%FN,%I,%J,%KN,%LINE,%LAST,%LINES,%LPP,%OFST,%OFN,%PG,%PRM2,%SIZE,%X,%VM Q ERR ; C:%DEV'="" %DEV U 0 I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q RULES ; W %ENG,!!,"At the end of every page, the file name will be displayed in angle brackets," W !,"the current line number in the file" W:'%VM " and the amount of data above the current",!,"line (expressed as a percentage of the file size)" W " will be displayed," W !,"and the output will pause.",! W !,"When the output pauses, choose one of the following:" W !,?5,"To proceed in the normal fashion press return." W !,?5,"To proceed after skipping a set number of lines enter the number." W !,?5,"To backup several lines, enter a '-' then the number of lines to backup" W !,?5,"To display several more lines, enter a '+' then the number of lines" W !,?5,"To choose another host file enter '^'." W !,?5,"To exit this routine enter '^Q'." W:$D(%HBRY) %HBR ;W !,"Hit any key to begin displaying ",%FN S %X=$X R *%LINE W *13 F %J=0:1:%X W " " Q %L1LJ %L1LJ ; [ 08.04.07 08:45 ] [ 28.11.05 09:31 ] [ 28.02.05 17:20 ] N %NMF,%XX,A,PID BG S %NMF="l1lj"_$J I $$^%L1ZOS(2,%NMF) ZSY "ps -fC mumps > "_%NMF I $$^%L1ZOS(10,%NMF)<0 G END O %NMF:(REWIND:READONLY) L ^listjob:1 K ^listjob F U %NMF R A Q:$ZEOF D .S PID=$TR($E(A,10,14)," ","") Q:'PID .S ^listjob(PID)="" C %NMF:(DELETE) END L Q %L1LNX %L1LNX ; D ^%L1C W %CV("GF"),!,">>" X %XCL R CMD ZSY CMD_" > a","vi a" Q %L1LOF %L1LOF(%X) ; DOS FILE ATTRIBUTES %LL^%DD^%TT [ 05/23/99 5:12 PM ] [ 02/27/99 7:06 AM ] [ 06/19/97 1:08 PM ] N A S A=$$^%L1FLP(%X) Q $P(A,"^",2)_"^"_$ZD($P(A,"^",3),"DD/MM/YEAR")_"^"_$P(A,"^",4) %L1LOG %LOGON ;MJ;LOGON ROUTINE; [ 8/20/90 3:15 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. 1990 O 0::0 E H U 0 U $P:(NOCENABLE) I $ZB($ZA,8,1) H 1 ; modem control timing S SV=$V(44),MU=$ZB($V(SV,-3,2),16,1),%PS=$S(MU:20480,1:51200) L ZD D EXPDATE S %RETRY=3,%PB=$V(SV+8,-3,2) S %UT=$V(SV+%PB+4) K BASELINE I $V(SV+2,-3,2)#2=0 D ^STU S SV=$V(44),MU=$ZB($V(SV,-3,2),16,1),%PS=$S(MU:20480,1:51200),%UI=1 S:$D(BASELINE) %VGI=0 G PGMR:$D(BASELINE),%LOGON ;AUTO STARTUP V 0:$J:$ZB($V(0,$J,2),250,1):2 LOGON ; S LOGON=$V(SV+4,-3,2)\64#2,CONSOLE=$V(SV+4,-3,2)\2048#2,SSD=$V(SV+4,-3,2)\32768#2 I LOGON!CONSOLE!SSD,$P'=1 W !,"Signon not allowed now." H V 2:$J:1:2 ;SWITCH TO MGR's uci S CNFG=0 I $D(^SYS("CONFIG"))#2 S CNFG=$P(^SYS("CONFIG"),";",2) I CNFG="" S CNFG=0 S CNFG=+^SYS("CONFIG",CNFG) U $P:(:::::1) I $D(^SYS(CNFG,"DDB",$P))#2 U $P:(:::::#FDFF) U $P:($P(^($P),",",5)::::$ZH($P(^($P),",",6))) I $ZB($ZA,258,1) HALT ; check for nolog and output only bits S:$D(^SYS(CNFG,"PSIZE")) %PS=^SYS(CNFG,"PSIZE") I %PS=20480 S:$ZV["MSM-PC"!($ZV["MUMPS L-PC")&'MU %PS=51200 G:'MU TTT S DDPBASE=$V($V(44)+388),VCNO=$V(DDPBASE+68,-3,2),SLNO1=$V(DDPBASE+72,-3,2),SLNO=SLNO1 I VCNO F I=1:1:$V(DDPBASE+70,-3,2) S SLNO=SLNO+1,SLNO=$S(SLNO=2:3,SLNO=20:64,SLNO=200:256,1:SLNO) I VCNO&($P'262144) %PS=$S($D(^SYS(CNFG,"PSIZE")):^("PSIZE"),1:20480) S %ID=$P(%ID,":",2) UCINUM S %OUI=$V(2,$J,2),%UI=+$ZU(%UCI,%VGNA),%VGI=+$P($ZU(%UCI,%VGNA),",",2) I %UI=0 W " ...UCI not found" G RETRY PGMTST ; S %VGTB=$V($V(40+%PB+SV)+(%VGI*4)) S %UCITB=%UI-1*32+$V(%VGTB+20) I $V(%UCITB+24,-3,3,1)'=$C(0,0,0) G:%ID=$V(%UCITB+24,-3,3,1) PGMR G:'$D(^SYS(CNFG,"PAC")) NOPAC I $V(%UCITB+24,-3,3,1)=$C(0,0,0) G:%ID=^SYS(CNFG,"PAC") PGMR I %ID="" W *7," ... invalid 'null' application id" G RETRY NOPAC ; I $D(^%) ;CLEAR NAKED I $D(^%E) ;CLEAR NAKED V 2:$J:%VGI*32+%UI:2,108:$J:%PS:4 ;SWITCH TO NEW UCI G:%ID="" PGMR I %ID'?1.AN,%ID'?1"%".AN,%ID'?1"^".AN,%ID'?1"^%".AN W *7," ..invalid application id" G RETRY S:'$F(%ID,"^") %ID="^"_%ID I $D(^ ($P(%ID,"^",2)))=0 W *7," ..invalid application id" G RETRY K (%,%ID) G @%ID PGMR ; I $D(^%) ;CLEAR NAKED V 0:$J:$V(0,$J,2)\2*2+1:2,2:$J:%VGI*32+%UI:2,108:$J:%PS:4 W:%INT " Job #",$J K X "ZR Q" Q TIEDTERM ;TIED TERMINAL I $G(TIED) ; from logon parms E S TIED="",%UCI=$P(^(TTT),",",2),%ID=$P(^(TTT),",",1),%PS=$P(^(TTT),",",3) V 108:$J:%PS:4 S %UI=$ZU($P(%UCI,":"),$P(%UCI,":",2)),%VGI=$P(%UI,",",2),%UI=+%UI G RETRY:%UI'>0,PROMPT:%UI=1&(%ID="%LOGON"),NOPAC TIEDLAT ;TIED TERMINAL FOR LAT S TIED="",SRVSTR=$P(SRVSTR,"`",4),%UCI=$P(SRVSTR,":",1),%ID=$P(SRVSTR,":",2),%PS=$S($P(SRVSTR,":",3)="":%PS,1:$P(SRVSTR,":",3)*1024) S %UCI=%UCI_","_$P($ZU(1,I),",",2) V 108:$J:%PS:4 S %UI=$ZU($P(%UCI,","),$P(%UCI,",",2)),%VGI=$P(%UI,",",2),%UI=+%UI G RETRY:%UI'>0,PROMPT:%UI=1&(%ID="%LOGON"),NOPAC INT ; S %INT=0,%UCI=%ID,%RETRY=0 G LOGON RETRY ; I $D(TIED) W !," ..logon aborted" H 2 Q V 2:$J:1:2 ;SWITCH TO MGR's uci S %RETRY=%RETRY-1 G:%RETRY PROMPT W !!,"Logon aborted.." H 2 I $D(%OUI) V 2:$J:%OUI:2 ;SWITCH back to original UCI ABORT Q %MGR ;Entry to put user back into MGR and goto error subrtn (VALIDATE) V 2:$J:1:2 I $D(%ZT) G:%ZT'="" @%ZT Q LOGPARMS(X) ; parse MSM logon parms ; TIED=1 -> UCI:PAC or UCI:RTN ; TIED=0 -> LABEL^RTN V 2:-4:$ZB($V(2,-4,2),#FDFF,1):2 ; turn off parms flag S X=$P(X," ",2,99) FOR Q:'($E(X)="-"!($E(X)="/")) DO ; strip out unwanted parms . S %ID=$P(X," ") . I $E(%ID)="/" S X=$P(X," ",2,99) Q ; /autoconfig . I %ID="-E"!(%ID="-e") S X=$P(X," ",2,99) Q ; EMS flag . I %ID="-P"!(%ID="-p"),$E(%ID,4)'?1N S X=$P(X," ",2,99) Q ; pause . S X=$P(X," ",3,99) Q ; all other parms are two part S X=$P(X," ") ; ignore extra '-' parms I X="" K %ID Q ; no signon specified I X?3U1":"1.ANP!(X?3U1","3U1":"1.ANP) S %ID=X,TIED=0,%INT=0 Q S %ID=$P(X,"["),%UCI=$P(X,"[",2) I %UCI="" S %UCI=$ZU(1,0) ; default to MGR E S %PS=$P(%UCI,":",2),%UCI=$P(%UCI,":") I $G(%PS)="" S %PS=^SYS(CNFG,"PSIZE") ; partsize not entered E S:%PS<1024 %PS=%PS*1024 S %UCI=$TR(%UCI,"""]","") ; strip out " and ] I %UCI?3U S %UCI=%UCI_":"_$P($$^%L1ZU(0),",",2) E S $E(%UCI,4)=":" ; for TIEDTERM subroutine S TIED=1,%INT=0 Q EXPDATE ; G:$V(176,-4,4)>94599 EXPIRED Q:$H<($V(176,-4,4)-10) I $H+1<$V(176,-4,4) W !!,*7,"WARNING: ***THIS COPY OF MSM WILL EXPIRE IN ",$V(176,-4,4)-$H," DAY(S)" Q I $H+1=$V(176,-4,4) W !!,*7,"WARNING: ***THIS COPY OF MSM WILL EXPIRE TOMORROW" Q EXPIRED ; W #,!,*7 W !,*7,"***************************************************************" W !,*7,"* *" W !,*7,"* ---- W A R N I N G ---- *" W !,*7,"* *" W !,*7,"* !!! THIS COPY OF MSM HAS EXPIRED !!! *" W !,*7,"* *" W !,*7,"* CONTINUED USE WILL CAUSE UNPREDICTABLE RESULTS *" W !,*7,"* *" W !,*7,"*..Please contact your MSM dealer for renewing this license...*" W !,*7,"* *" W !,*7,"***************************************************************" H %L1LPT %L1LPT ; PTIHAT MADPESET REHAVA [ 28.10.08 14:30 ] [ 30.07.08 16:26 ] [ 02.07.08 12:22 ] ; %L1LPT("FILE") - FILE NAME FOR PRINT (IF %DEV=54 ) . ; IF NOT DEFINED - #PRINT_$P ; %L1LPT("NODEL") - NO DELETE FILE %L1LPT("FILE") AFTER PRINT ; %L1LPT("DEV") - DEVICE FOR PRINT ; (IF YOU WANT TO PRINT TO DEVICE DIFFERENT FROM STANDART) ; %L1LPT("TO") - IF DEVICE FOR PRINT = (54>6) - PRINT TO PORT 6 ; %L1LPT("NOFF") - WITHOUT FORM FEED IN DEVICE CLOSING ;-------------------------------------------------------------------- I '$D(%POSIC) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $P($$^%L1ZU(0),",")="MLY" D OPEN G END S:'$D(%DEV) %DEV="USTR" D OPEN G END END Q ; OPEN ; I $P($$^%L1ZU(0),",")="MLY" S:'$D(%DEV) %DEV="DEV" S %EROP=0 D DEF I @(%DEV_"<0") U 0 S %SAY=" ! z`f dcnrn qitcdl ozip `l " X %XMSGV(1) S %EROP=2 Q OP1 S %EROP=0 D ODEV(%DEV) Q:%EROP I $$MDPNET(@%DEV) S @%DEV="SCK$"_$J D USE1 Q:%EROP W %L1OUT("MDP","NOCOND") I $D(%L1LPT("SMALL")) W %L1OUT("MDP","COND") I $G(^PL("2MG"))="?" D Q .F U 0 S %GET="2 - 2 dxibn ,1 - 1 dxibn" D N^%L1GET Q:%S=1!(%S=2) .D USE1 .I %S=1 W $C(27),"&l1H" Q .I %S=2 W $C(27),"&l5H" Q I $G(^PL("2MG")) D K %L1LPT("2MG"),%L1SCPC("2MG"),%L1OUT("2MG") .I $G(%L1LPT("2MG"))=2!($G(%L1SCPC("2MG"))=2)!($G(%L1OUT("2MG"))=2) W $C(27),"&l5H" Q .W $C(27),"&l1H" Q USE(%DEV) D USE1 Q USE1 N %DV S %DV=@%DEV USE2 I $$MDPNET(%DV) U "SCK$"_$J Q U %DV:(NOWRAP) Q UDEV(%DV) G USE2 CLOSE ; I '$D(%DEV) S %DEV="USTR" D DEF I $G(%EROP) G EC D USE1 I $G(%EROP) G EC N %DV S @("%DV="_%DEV) G CDEV1 ; -- ? CDEV(%DV) ; CDEV1 G:'$D(%DV) EC S:'$D(%DEV) %DEV="USTR" I '$D(%MDPSUG) D DEF D .I %MDPSUG=5!(%MDPSUG=7) W:'$D(%L1LPT("NOFF"))&(+$G(@%DEV)'=54) $C(13,12) Q .I %MDPSUG=6 W $C(10,10,10,10,10) I $D(%MDP("CUT")) W %MDP("CUT")_$C(10,10,10,10,10) .I %MDPSUG'=7 W $C(13,27),"@" .W $C(27),"E" ; I $$MDPNET(%DV) D CNET G EC ; C:%L3MYDV'=%DV %DV PRINT ; I $G(@%DEV)[".LP" D G EC .I $$^%L1ZOS(10,@%DEV)<0 Q .ZSY "unix2dos -q "_@%DEV .N %DVLPT S %DVLPT=$G(^DEV($$^%L3MYDVN,"LP")) .N %OK S %OK=0 .I %DVLPT D ..N N S N="" F S N=$O(^devi3(N)) Q:N="" D Q:%OK ...I ^(N)=%DVLPT,N["rempr" S %OK=1 .I %OK ZSY "lpr -P rempr "_@%DEV .I '%OK ZSY "lpr "_@%DEV .ZSY "rm -f "_@%DEV ; I +(@%DEV)=54 D .I '$D(%L1LPT("FILE")) S %L1LPT("FILE")="54#PRINT"_%L3MYDVN .I $$^%L1ZOS(10,%L1LPT("FILE"))<0 Q .C %L1LPT("FILE") O %L1LPT("FILE"):(READONLY:REWIND) .I $$CMDS^%L3MYLPT'="",$$^%L1T2P($$CMDS^%L3MYLPT) .N TS0,TSS,I,J,A,EOF D ^%L1TS .U 0 S %SAY=" CTRL/E - dqtcd wiqtdl " X %XMSGV .K ^print($J) N ZT S ZT=$ZT S I=0 .I $$^%L1ZOS(10,%L1LPT("FILE"))>0 F U %L1LPT("FILE") R A S EOF=$ZEOF Q:EOF D ..S I=I+1 ..S ^print($J,I)=$E($$TR(A),1,255) ..I EOF<0 S ^print($J,I)=$P(^print($J,I),$C(12)) Q ..I $E(A,256,512)'="" S I=I+1,^print($J,I)=$E($$TR(A),256,512) .C %L1LPT("FILE") I '$D(%L1LPT("NODEL")),$$^%L1ZOS(10,%L1LPT("FILE"))>0 O %L1LPT("FILE") C %L1LPT("FILE"):DELETE .I $D(%L1LPT("ARX")) D Q ..N MAC1,MAC2,%NMB,%MRK ..S %MRK=$$^%L1MRK("") ..S %NMB=$O(^SPOOL(%MRK,999999),-1)+1 ..S ^SPOOL(%MRK,%NMB)=$H_"\"_%L3MYDV_"\"_%L1LPT("ARX") ..N %ST,%N,I ..F I=1:1:10 Q:'$D(^print($J,I)) S %ST=$$CL($G(^(I))) S ^SPOOL(%MRK,%NMB,"KOT",I)=%ST ..S MAC1="^print($J)",MAC2="^SPOOL(%MRK,%NMB,""PC"")" D ^%S1GC1 ..K ^print($J) .; .I $G(%L1LPT("SND")) D Q ..N MAC1,MAC2,%NMB,%MRK ..S %MRK=$$^%L1MRK("") ..S %NMB=$O(^SPOOLSND(%L1LPT("SND"),%MRK,999999),-1)+1 ..S ^SPOOLSND(%L1LPT("SND"),%MRK,%NMB)=$H_"\"_%L3MYDV_"\"_%L1LPT("SND","ARX") ..N %ST,%N,I ..F I=1:1:10 Q:'$D(^print($J,I)) S %ST=$$CL($G(^(I))) S ^SPOOLSND(%L1LPT("SND"),%MRK,%NMB,"KOT",I)=%ST ..S MAC1="^print($J)",MAC2="^SPOOLSND(%L1LPT(""SND""),%MRK,%NMB,""PC"")" D ^%S1GC1 ..K ^print($J) .N %N S %L1LPT("TO")="" I $P(@%DEV,">",2) S %L1LPT("TO")=$P(@%DEV,">",2) .S I=0 P2 .S %N=$O(^print($J,"")),I=I+1 I $G(%L1LPT("DELAY"))=1 .I %N="" D K ^print($J) Q ..I '%L1LPT("TO") X "N %L1T2P S %L1T2P(""EOL"")="""" I '$D(%L1LPT(""NOFF"")),$$^%L1T2P($C(12,13,13),0)" Q ..I %L1LPT("TO") U %L1LPT("TO") W:'$D(%L1LPT("NOFF")) $C(12,13,13) C %L1LPT("TO") .;;I $P'=$G(^PL("MDPORT")),%N>60,'(%N#2) H 1 I '(%N#10) H 1 .I '%L1LPT("TO") I $$^%L1T2P(^print($J,%N)) K ^print($J,%N) D U 0 R *%A:0 K:%A=5 ^print($J) G P2 ..;;N %I,%OKMER S %OKMER=0 F %I=1:1 Q:$ZU(%I)="" I $P($ZU(%I),",")="MER" S %OKMER=1 Q ..I %L3MYDVN=$$MDPORT^%L1PORT H 1 .Q:'%L1LPT("TO") .U %L1LPT("TO") W !,^print($J,%N) K ^print($J,%N) U 0 R *%A:0 K:%A=5 ^print($J) G P2 I +@%DEV=54,$$CMDF^%L3MYLPT'="",$$^%L1T2P($$CMDF^%L3MYLPT) I +@%DEV=54 U 0 S %SAY="" X %XMSGV EC K %L1LPT Q ; CLOSE1 D DEF I $G(%EROP) G EC D NORM I $G(%EROP) G EC N %DV S @("%DV="_%DEV) C:%DV'=%L3MYDV @%DEV K %L1LPT Q DEF N %A I '$D(P1PC) U 0 I $G(%L1LPT("SUG")) S %MDPSUG=%L1LPT("SUG") E S @("%MDPSUG="_%L1SUG) K %L1OUT("MDP") D DEFMDP^%L1OUT(%MDPSUG) I $G(%L1LPT("DEV")),%L1LPT("DEV")=54 D DEF54 Q I $G(%L1LPT("DEV")) S @%DEV=^[$$^%L1GLD]dev(%L1LPT("DEV")) Q I $G(%L1OUT("PRINTER")) S %L1DEV=%L1OUT("PRINTER") S @("%A="_%L1DEV) I %A=54 D DEF54 Q S @%DEV=^[$$^%L1GLD]dev(%A) I @%DEV["/lp" S @%DEV=$TR(%L3MYDV,"/","")_".LP" I @%DEV["/LP" S @%DEV=$TR(%L3MYDV,"/","")_".LP" Q DEF54 ; D Q:%EROP S %EROP=0 S @%DEV=%L1LPT("FILE") .I '$D(%L1LPT("FILE")) S %L1LPT("FILE")="54#PRINT"_%L3MYDVN Q .Q:'$P(@%DEV,">",2) S %EROP=0 S %L1LPT("FILE")=$P(@%DEV,">",2) Q NORM W $G(^LPT($P,"N")) Q ER Q I $ZS["SYSTM" U 0 S %SAY=" dlerta `l zqtcn " X %XMSGV(1) G ERN S %SAY=$ZS U 0 X %XMSGV(1) ERN S %EROP=1 D CDEV(@%DEV) U 0 W ! Q Q S D S1 G %L1LPT S1 S %EROP=0 U 0 S %GET=" d`ivil e` ywde zqtcnd okd" D N^%L1GET I $G(%TO)="END" S %EROP=1 X "I 0" Q Q S2 U 0 S %GET=" ywde zqtcnd okd" D N^%L1GET Q S3 G S2 TR(A) ; I '$D(TS0) D ^%L1TS N T S T=TSS N TSS S TSS=T ;;I %TYPCRT="VT510" S TSS=TS1 I %MDPSUG'=7 Q $TR(A,TS0,TSS) S A=$$RPL^%L1FRM(A,%L1OUT("MDP","COND"),"<<<<<") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","NOCOND"),">>>>>") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","B"),"[[[[[") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","N"),"]]]]]") S A=$TR(A,TS0,TSS) S A=$$RPL^%L1FRM(A,"[[[[[",%L1OUT("MDP","B")) S A=$$RPL^%L1FRM(A,"]]]]]",%L1OUT("MDP","N")) S A=$$RPL^%L1FRM(A,"<<<<<",%L1OUT("MDP","COND")) S A=$$RPL^%L1FRM(A,">>>>>",%L1OUT("MDP","NOCOND")) Q A CL(%ST) ; N %N I $L($P(%ST,$C(13,12),2))>1 S %ST=$P(%ST,$C(13,12))_$C(10,10,10,10,10)_"#"_$P(%ST,$C(13,12),2) S %N="" F S %N=$O(%L1OUT("MDP",%N)) Q:%N="" I %N'="GWPC",%ST[%L1OUT("MDP",%N) D .I %N="B" S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP","B"),%LIGHT1) Q .I %N="N" S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP","N"),%CCL) Q .S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP",%N),"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_2,"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"CB","") I $L($P(%ST,$C(13),2))>1 S %ST=%LIGHT1_$P(%ST,$C(13))_%CCL I '$D(TSS) D ^%L1TS S %ST=$TR(%ST,TSS,TS0) Q %ST CL1(%ST) ; N %N S %ST=$TR(%ST,$C(13,10),"") S %ST=$TR(%ST,$C(12),"#") S %N="" F S %N=$O(%L1OUT("MDP",%N)) Q:%N="" I %N'="GWPC",%ST[%L1OUT("MDP",%N) D .S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP",%N),"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_2,"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"W1","") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"W0","") S %ST=$$RPL^%L1FRM(%ST,"W1","") S %ST=$$RPL^%L1FRM(%ST,"W0","") I '$D(TSS) D ^%L1TS S %ST=$TR(%ST,TSS,TS0) Q %ST ODEV(%DEV) ; S %EROP=0 N %DV,%ER S %DV=@%DEV I $$MDPNET(%DV) D Q .N PORT D CNET .F %J=1:1:5 S %ER=$$^%L2NALAN(%DV,9100) Q:'%ER H 1 .I %ER D G OPNE ..S %SAY=$J_": PRINT ERROR "_%DV_" "_$$FUNC^%UCASE(%ER) X %XMSGV(1) Q ; O %DV:(WRITE:NEWVERSION:EXCEPTION="G OPNE^%L1LPT"):2 E S %SAY=" ! dqetz zqtcn " X %XMSGV(1) G OPNE Q OPNE S %EROP=1 Q ; MDPNET(%DV) ; I %DV?1N.N1".".E Q 1 Q 0 CNET C "SCK$"_$J Q %L1LPT0 %L1LPT ; PTIHAT MADPESET REHAVA [ 23.10.06 19:51 ] [ 16.10.06 17:26 ] [ 12.10.06 18:00 ] ; %L1LPT("FILE") - FILE NAME FOR PRINT (IF %DEV=54 ) . ; IF NOT DEFINED - #PRINT_$P ; %L1LPT("NODEL") - NO DELETE FILE %L1LPT("FILE") AFTER PRINT ; %L1LPT("DEV") - DEVICE FOR PRINT ; (IF YOU WANT TO PRINT TO DEVICE DIFFERENT FROM STANDART) ; %L1LPT("TO") - IF DEVICE FOR PRINT = (54>6) - PRINT TO PORT 6 ; %L1LPT("NOFF") - WITHOUT FORM FEED IN DEVICE CLOSING ;-------------------------------------------------------------------- I '$D(%POSIC) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $P($$^%L1ZU(0),",")="MLY" D OPEN G END S:'$D(%DEV) %DEV="USTR" D OPEN G END END Q ; OPEN ; I $P($$^%L1ZU(0),",")="MLY" S:'$D(%DEV) %DEV="DEV" S %EROP=0 D DEF I @(%DEV_"<0") U 0 S %SAY=" ! z`f dcnrn qitcdl ozip `l " X %XMSGV(1) S %EROP=2 Q OP1 S %EROP=0 D ODEV(%DEV) Q:%EROP D USE1 Q:%EROP W %L1OUT("MDP","NOCOND") I $D(%L1LPT("SMALL")) W %L1OUT("MDP","COND") I $G(^PL("2MG"))="?" D Q .F U 0 S %GET="2 - 2 dxibn ,1 - 1 dxibn" D N^%L1GET Q:%S=1!(%S=2) .D USE1 .I %S=1 W $C(27),"&l1H" Q .I %S=2 W $C(27),"&l5H" Q I $G(^PL("2MG")) D K %L1LPT("2MG"),%L1SCPC("2MG"),%L1OUT("2MG") .I $G(%L1LPT("2MG"))=2!($G(%L1SCPC("2MG"))=2)!($G(%L1OUT("2MG"))=2) W $C(27),"&l5H" Q .W $C(27),"&l1H" Q USE(%DEV) D USE1 Q USE1 N %DV S %DV=@%DEV USE2 I $$MDPNET(%DV) U "SCK$"_$J Q U %DV:(NOWRAP) Q UDEV(%DV) G USE2 CLOSE ; I '$D(%DEV) S %DEV="USTR" D DEF I $G(%EROP) G EC D USE1 I $G(%EROP) G EC N %DV S @("%DV="_%DEV) G CDEV1 ; -- ? CDEV(%DV) ; CDEV1 G:'$D(%DV) EC S:'$D(%DEV) %DEV="USTR" I '$D(%MDPSUG) D DEF D .I %MDPSUG=5!(%MDPSUG=7) W:'$D(%L1LPT("NOFF")) $C(13,12) .I %MDPSUG=6 W $C(10,10,10,10,10) .I %MDPSUG'=7 W $C(13,27),"@" .W $C(27),"E" ; I $$MDPNET(%DV) D CNET G EC ; C:%L3MYDV'=%DV %DV PRINT ; I $G(@%DEV)[".LP" D G EC .I $$^%L1ZOS(10,@%DEV)<0 Q .ZSY "unix2dos "_@%DEV .ZSY "lpr "_@%DEV .ZSY "rm -f "_@%DEV ; I +@%DEV=54 D .I '$D(%L1LPT("FILE")) S %L1LPT("FILE")="54#PRINT"_%L3MYDVN .C %L1LPT("FILE") O %L1LPT("FILE"):(READONLY:REWIND) .I $$CMDS^%L3MYLPT'="",$$^%L1T2P($$CMDS^%L3MYLPT) .N TS0,TSS,I,J,A,EOF D ^%L1TS .U 0 S %SAY=" CTRL/E - dqtcd wiqtdl " X %XMSGV .K ^print($J) N ZT S ZT=$ZT S I=0 .I $$^%L1ZOS(10,%L1LPT("FILE"))>0 F U %L1LPT("FILE") R A S EOF=$ZEOF Q:EOF D ..S I=I+1 ..S ^print($J,I)=$E($$TR(A),1,255) ..I EOF<0 S ^print($J,I)=$P(^print($J,I),$C(12)) Q ..I $E(A,256,512)'="" S I=I+1,^print($J,I)=$E($$TR(A),256,512) .C %L1LPT("FILE") I '$D(%L1LPT("NODEL")),$$^%L1ZOS(10,%L1LPT("FILE"))>0 O %L1LPT("FILE") C %L1LPT("FILE"):DELETE .I $D(%L1LPT("ARX")) D Q ..N MAC1,MAC2,%NMB,%MRK ..S %MRK=$$^%L1MRK("") ..S %NMB=$O(^SPOOL(%MRK,999999),-1)+1 ..S ^SPOOL(%MRK,%NMB)=$H_"\"_%L3MYDV_"\"_%L1LPT("ARX") ..N %ST,%N,I ..F I=1:1:10 Q:'$D(^print($J,I)) S %ST=$$CL($G(^(I))) S ^SPOOL(%MRK,%NMB,"KOT",I)=%ST ..S MAC1="^print($J)",MAC2="^SPOOL(%MRK,%NMB,""PC"")" D ^%S1GC1 ..K ^print($J) .; .I $G(%L1LPT("SND")) D Q ..N MAC1,MAC2,%NMB,%MRK ..S %MRK=$$^%L1MRK("") ..S %NMB=$O(^SPOOLSND(%L1LPT("SND"),%MRK,999999),-1)+1 ..S ^SPOOLSND(%L1LPT("SND"),%MRK,%NMB)=$H_"\"_%L3MYDV_"\"_%L1LPT("SND","ARX") ..N %ST,%N,I ..F I=1:1:10 Q:'$D(^print($J,I)) S %ST=$$CL($G(^(I))) S ^SPOOLSND(%L1LPT("SND"),%MRK,%NMB,"KOT",I)=%ST ..S MAC1="^print($J)",MAC2="^SPOOLSND(%L1LPT(""SND""),%MRK,%NMB,""PC"")" D ^%S1GC1 ..K ^print($J) .N %N S %L1LPT("TO")="" I $P(@%DEV,">",2) S %L1LPT("TO")=$P(@%DEV,">",2) .S I=0 P2 .S %N=$O(^print($J,"")),I=I+1 .I %N="" D K ^print($J) Q ..I '%L1LPT("TO") X "N %L1T2P S %L1T2P(""EOL"")="""" I '$D(%L1LPT(""NOFF"")),$$^%L1T2P($C(12,13,13),1)" Q ..I %L1LPT("TO") U %L1LPT("TO") W:'$D(%L1LPT("NOFF")) $C(12,13,13) C %L1LPT("TO") .;;I $P'=$G(^PL("MDPORT")),%N>60,'(%N#2) H 1 I '(%N#10) H 1 .I '%L1LPT("TO") I $$^%L1T2P(^print($J,%N)) K ^print($J,%N) D U 0 R *%A:0 K:%A=5 ^print($J) G P2 ..;;N %I,%OKMER S %OKMER=0 F %I=1:1 Q:$ZU(%I)="" I $P($ZU(%I),",")="MER" S %OKMER=1 Q ..I %L3MYDVN=$$MDPORT^%L1PORT H 1 .Q:'%L1LPT("TO") .U %L1LPT("TO") W !,^print($J,%N) K ^print($J,%N) U 0 R *%A:0 K:%A=5 ^print($J) G P2 I +@%DEV=54,$$CMDF^%L3MYLPT'="",$$^%L1T2P($$CMDF^%L3MYLPT) I +@%DEV=54 U 0 S %SAY="" X %XMSGV EC K %L1LPT Q ; CLOSE1 D DEF I $G(%EROP) G EC D NORM I $G(%EROP) G EC N %DV S @("%DV="_%DEV) C:%DV'=%L3MYDV @%DEV K %L1LPT Q DEF N %A I '$D(P1PC) U 0 I $G(%L1LPT("SUG")) S %MDPSUG=%L1LPT("SUG") E S @("%MDPSUG="_%L1SUG) K %L1OUT("MDP") D DEFMDP^%L1OUT(%MDPSUG) I $G(%L1LPT("DEV")),%L1LPT("DEV")=54 D DEF54 Q I $G(%L1LPT("DEV")) S @%DEV=^[$$^%L1GLD]dev(%L1LPT("DEV")) Q S @("%A="_%L1DEV) I %A=54 D DEF54 Q S @%DEV=^[$$^%L1GLD]dev(%A) I @%DEV["/lp" S @%DEV=$TR(%L3MYDV,"/","")_".LP" I @%DEV["/LP" S @%DEV=$TR(%L3MYDV,"/","")_".LP" Q DEF54 ; D Q:%EROP S %EROP=0 S @%DEV=%L1LPT("FILE") .I '$D(%L1LPT("FILE")) S %L1LPT("FILE")="54#PRINT"_%L3MYDVN Q .Q:'$P(@%DEV,">",2) S %EROP=0 S %L1LPT("FILE")=$P(@%DEV,">",2) Q NORM W $G(^LPT($P,"N")) Q ER Q I $ZS["SYSTM" U 0 S %SAY=" dlerta `l zqtcn " X %XMSGV(1) G ERN S %SAY=$ZS U 0 X %XMSGV(1) ERN S %EROP=1 D CDEV(@%DEV) U 0 W ! Q Q S D S1 G %L1LPT S1 S %EROP=0 U 0 S %GET=" d`ivil e` ywde zqtcnd okd" D N^%L1GET I $G(%TO)="END" S %EROP=1 X "I 0" Q Q S2 U 0 S %GET=" ywde zqtcnd okd" D N^%L1GET Q S3 G S2 TR(A) ; I '$D(TS0) D ^%L1TS N T S T=TSS N TSS S TSS=T ;;I %TYPCRT="VT510" S TSS=TS1 I %MDPSUG'=7 Q $TR(A,TS0,TSS) S A=$$RPL^%L1FRM(A,%L1OUT("MDP","COND"),"<<<<<") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","NOCOND"),">>>>>") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","B"),"[[[[[") S A=$$RPL^%L1FRM(A,%L1OUT("MDP","N"),"]]]]]") S A=$TR(A,TS0,TSS) S A=$$RPL^%L1FRM(A,"[[[[[",%L1OUT("MDP","B")) S A=$$RPL^%L1FRM(A,"]]]]]",%L1OUT("MDP","N")) S A=$$RPL^%L1FRM(A,"<<<<<",%L1OUT("MDP","COND")) S A=$$RPL^%L1FRM(A,">>>>>",%L1OUT("MDP","NOCOND")) Q A CL(%ST) ; N %N I $L($P(%ST,$C(13,12),2))>1 S %ST=$P(%ST,$C(13,12))_$C(10,10,10,10,10)_"#"_$P(%ST,$C(13,12),2) S %N="" F S %N=$O(%L1OUT("MDP",%N)) Q:%N="" I %N'="GWPC",%ST[%L1OUT("MDP",%N) D .I %N="B" S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP","B"),%LIGHT1) Q .I %N="N" S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP","N"),%CCL) Q .S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP",%N),"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_2,"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"CB","") I $L($P(%ST,$C(13),2))>1 S %ST=%LIGHT1_$P(%ST,$C(13))_%CCL I '$D(TSS) D ^%L1TS S %ST=$TR(%ST,TSS,TS0) Q %ST CL1(%ST) ; N %N S %ST=$TR(%ST,$C(13,10),"") S %ST=$TR(%ST,$C(12),"#") S %N="" F S %N=$O(%L1OUT("MDP",%N)) Q:%N="" I %N'="GWPC",%ST[%L1OUT("MDP",%N) D .S %ST=$$RPL^%L1FRM(%ST,%L1OUT("MDP",%N),"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_2,"") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"W1","") S %ST=$$RPL^%L1FRM(%ST,$C(27)_"W0","") S %ST=$$RPL^%L1FRM(%ST,"W1","") S %ST=$$RPL^%L1FRM(%ST,"W0","") I '$D(TSS) D ^%L1TS S %ST=$TR(%ST,TSS,TS0) Q %ST ODEV(%DEV) ; S %EROP=0 N %DV,%ER S %DV=@%DEV I $$MDPNET(%DV) D Q .N PORT D CNET .F %J=1:1:5 S %ER=$$^%L2NALAN(%DV,9100) Q:'%ER H 1 .I %ER D G OPNE ..S %SAY="PRINT ERROR "_%DV_" "_$$FUNC^%UCASE(%ER) X %XMSGV(1) Q ; O %DV:(WRITE:NEWVERSION:EXCEPTION="G OPNE^%L1LPT"):2 E S %SAY=" ! dqetz zqtcn " X %XMSGV(1) G OPNE Q OPNE S %EROP=1 Q ; MDPNET(%DV) ; I %DV?1N.N1".".E Q 1 Q 0 CNET C "SCK$"_$J Q %L1LUAH %L1LUAH ; [ 01/02/2000 1:46 PM ] [ 07/15/98 6:53 PM ] [ 08/14/97 4:20 PM ] ;OUT : COLD - KAMUT JOM B HODESH ; COLDH - KAMUT HAGIM ; %OTM - DATE HAG ;; $$TV^%L1LUAH - VIBOR DNJA N (%UPRCOD,%XMSGV,COLD,COLDH,%OTM,%L1LUAH,YY,MM) I '$D(%POSIC) D ^%L1C B K %OTM,COLD,COLDH,YY,MM X %chista D ZAPR Q:%S=""!(%TO="END") D INIT D ^%L1RBUA D DEF D PR Q:$D(%L1LUAH)#2 O D OTM S %Q("Z")="xcqa lkd",%Q("X")=40,%Q("Y")=22 D ^%S2ASK G:YES END S %XX=0,%YY=24 X %POSIC W %chists S %GET="<0> 1 - gel owzl , 0 - dpye yceg owzl++24,60,HH#++1,E,I++01" D ^%L1GET G:0[%S B G O END S %N=-1,%JJ=0 F S %N=$N(%OTM(%N)) Q:%N=-1 S %JJ=%JJ+1 S COLDH=%JJ Q ;- ZAPR ; S %DAT=$ZD(+$H,"MM/DD/YEAR") S %GET="dpy++2,70,HH#"_$E($P(%DAT,"/",3),3,4)_"++2,E,I++1234567890" D ^%L1GET Q:%S=""!($G(%TO)="END") S YY=%S S %GET="yceg++2,50,HH#"_$P(%DAT,"/",1)_"++2,E,I++1234567890" D ^%L1GET G:%S=""!(%TO="END") ZAPR S MM=+$TR($J(%S,2)," ",0) Q ;- DEF ; S DEN=$$^%L1DC("01/"_MM_"/"_YY,8) S COLD=+MMM(+MM),NAMEM=$P(MMM(+MM),"\",2) Q PR ; F %I=1:1:COLD D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" S:'$D(%L1LUAH("TV"))&((DEN+%I-2)#7=6) %OTM(%I)="" S:$D(%OTM(%I)) %SAY=%SAY_",I" X %XMSG F %J=1:1:7 S %SAY=D(%J)_"++"_(%J-1*STEPY+NPY)_","_(NPX-4)_",HH" X %XMSG S %SAY=" "_YY_" "_NAMEM_"++"_(NPY-3)_","_(NPX+15)_",HH" X %XMSG S %SAY=" - `ad yceg , - mcew yceg " X %XMSGN Q POZ ; S %YY=(DEN+%I-2)#7*STEPY+NPY S %XX=STEPX*((DEN+%I-1-.1)\7)+NPX Q OTM ; S %SAY="( d`ivi - ) bg inei jxc onq " X %XMSGN PZ S %I=1 D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG CYC S (%A1,%B)=0 R *%A:0 I %A=13,$D(%OTM(%I)) K %OTM(%I) G CYC CYC13 I %A=13 S %OTM(%I)="" G:$D(%L1LUAH("TV")) ENDC G CYC I $L($ZB)=4,$D(%UPRCOD($ZB)),$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) I %A=27 X "F %JJ=1:1:200" R *%A1:0 X "F %JJ=1:1:200" G:%A1<0&$D(%L1LUAH("TV")) ESC G:%A1<0 ENDC R *%B:0 G:'$D(%UPRCOD(%A1_%B)) CYC G:$T(@%UPRCOD(%A1_%B))="" CYC G @%UPRCOD(%A1_%B) I %A=0 R *%A1:0 G SERV I %A=25 G ESC I %A>47,%A<58 D S %A=13 G CYC13 .S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,"_$S($D(%OTM(%I)):"I",1:"") X %XMSG .S %GETIN=$C(%A) S %BE="E",%GET=": mei#2" D N^%L1GET .S %I=%S S %SAY="" X %XMSGN D POZ .S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG G CYC SERV I %A=0,$G(%B)'>0,$G(%A1)>0,$D(%UPRCOD(%A_%A1)),$T(@%UPRCOD(%A_%A1))'="" G @%UPRCOD(%A_%A1) I %A=0 G CYC VVERX G:%I=1 CYC D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" X:'$D(%OTM(%I)) %XMSG S %I=%I-1 D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG G CYC VNIZ G:%I=COLD CYC D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" X:'$D(%OTM(%I)) %XMSG S %I=%I+1 D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG G CYC PRAVO G:%I+7>COLD CYC D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" X:'$D(%OTM(%I)) %XMSG S %I=%I+7 D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG G CYC LEVO G:%I-7<1 CYC D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" X:'$D(%OTM(%I)) %XMSG S %I=%I-7 D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG G CYC PGUP S MM=MM-1 I MM<1 S MM=12,YY=YY-1 S:YY<0 YY=99 K %OTM D HZG(YY,MM) G PZ PGDN S MM=MM+1 I MM>12 S MM=1,YY=YY+1 S:YY>99 YY=0 K %OTM D HZG(YY,MM) G PZ G CYC ESC I $D(%L1LUAH("TV")) K %OTM ENDC ; D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE" X:'$D(%OTM(%I)) %XMSG I $D(%L1LUAH("TV")),'$D(%OTM(%I)) Q 0 I $D(%L1LUAH("TV")) S:YY=0 YY=2000 Q $$^%L1DC(%I_"/"_MM_"/"_YY,3) Q ;- Q INIT ; S D(1)="`" S D(2)="a" S D(3)="b" S D(4)="c" S D(5)="d" S D(6)="e" S D(7)="y" S MMM(1)="31\x`epi" S MMM(2)=$S(YY#4:28,1:29)_"\x`exat" S MMM(3)="31\uxn" S MMM(4)="30\lixt`" S MMM(5)="31\i`n" S MMM(6)="30\ipei" S MMM(7)="31\ilei" S MMM(8)="31\hqebe`" S MMM(9)="30\xanhtq" S MMM(10)="31\xaehwe`" S MMM(11)="30\xanaep" S MMM(12)="31\xanvc" S STEPY=2,STEPX=4,NPY=6,NPX=28 S X1=NPX-2,X2=NPX+(6*STEPX) S Y1=NPY-1,Y2=NPY+(8*STEPY)-1 K %OTM Q TV(STAM) ;--- BHIRAT TAARIH N (%UPRCOD,%XMSGV,COLD,COLDH,%OTM,%L1LUAH) D ^%L1C X %chista S YY=$E($$YYMM^%L1DC($H),1,2) S MM=$E($$YYMM^%L1DC($H),3,4) D INIT D HZG(YY,MM) S %I=$P($$^%L1DC($H,1),"/",1) D POZ S %SAY=$J(%I,2)_"++"_%YY_","_%XX_",EE,I" X %XMSG S %L1LUAH("TV")="" G CYC Q HZG(YY,MM) D DEF S %L1RBCL="" D ^%L1RBUA K %L1RBCL D PR Q %L1M DBMAINT3 ;JWC;MOUNT VOLUME GROUPS [ 10/17/91 11:08 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1990 S OS=1 ZF D PTRS^%VGUTIL,OS^%VGUTIL,DSK^%VGUTIL1:'OS,GETVG^%VGUTIL K %DEV D VGSLOT I QF W !,"No room to mount another volume group" Q I OS D GETHFS^%SDEV I '%DEV W *7,!!,"No HFS devices available..." K %DEV Q RETRY D HNAME Q:QF D VGNAME I QF U 0 W !,"Volume is not initialized",*7 G RETRY I $D(VG(VGNAME)) D QAGN G:QF=1 RETRY Q:QF I VIN W !,*7,"This is not a volume 0" G RETRY W !,"Mounting." S %VGI=VGIN D START Q:QF D MOUNT^TRANSLA1 W:VGIN "done." ;D DBMAINT^%SP Q START D GETVOLS I QF W !,"Error in finding volumes for this volume group",*7 Q D CHKVOLS I QF W !,"mounting aborted." Q D MTVOLS^MOUNT,MOUNT,SETSAT^UMOUNT,SETUCI^MOUNT I $D(^ ("DDP")) D DBCHG^DDP Q STU ; STU ENTRY POINT D PTRS^%VGUTIL,OS^%VGUTIL,DSK^%VGUTIL1:'OS,GETVG^%VGUTIL S:OS %DEV=51 D CHKNAME Q:QF X "ZF" O 63 D VGNAME Q:QF I VGIN,$D(VG(VGNAME)) F X=65:1 S $E(VGALT,3)=$C(X) I '$D(VG(VGALT)) S X=VGALT D HASH^%VGUTIL S $P(LABEL(0),"^",5)=Y Q G START MOUNT S VGOF=$V(VGIN*4+VGTAB) V VGOF:-3:VGALT:3:1,VGOF+10:-3:VGMAP:2,VGOF+12:-3:VGBLK:4 V VGOF+30:-3:VOLS:2,VGOF+4:-3:$P(LABEL(0),"^",5):2 V VGOF+28:-3:0:2 ; ptr to 1st free bit in SAT Q CHKVOLS Q:VOLS<2 F I=1:1:VOLS-1 D CHKVOL Q CHKVOL ; S VIN=$P(LABEL(I),"^",7),VMAP=$P(LABEL(I),"^",6),VN=$P(LABEL(I),"^",1),VMAG=$P(LABEL(I),"^",3) U 0 S QF=0 I VIN'=I W !,"** WARNING ** volume ",I," has volume number ",VIN,*7 I VN'=VG0N(I) W !,"** WARNING ** volume ",I,"'s name is '",VN,"' but known to volume 0 as ",VG0N(I),*7 I VMAP'=VG0M(I) W !,"** WARNING ** volume ",I," has ",VMAP," map(s) but known to volume 0 as ",VG0M(I)," map(s)",*7 I VMAG'=MAGIC W !,"** WARNING ** volume ",I,"'s magic is",VMAG," but known to volume 0 as ",MAGIC,*7 Q GETVOLS S QF=0 Q:VOLS<2 D VOLNAME:OS,VOLDSK:'OS Q VOLNAME F I=1:1:VOLS-1 W:'$G(STUAUTO) "." S (HNAME,VOLNA(I))=$V(I*64,0,64,1) D CHKNAME G:QF VOLBAD F I=1:1:VOLD@FOOCBO@I#)*'"& "/&UNT C %DEV S LABEL(I)=LABEL VOLBAD Q VOLDSK ; GET OTHER VOLUMES ADDRESS FOR SA U 63:(:::"T") U 0 S DSK="" F I=1:1 S DSK=$O(%DSK(DSK)) W:'$G(STUAUTO) "." Q:DSK="" S HNAME=DSK D LABEL^MOUNT I $P(LABEL,"^",7),$P(LABEL,"^",3)=MAGIC,($P(LABEL,"^",2)=VGNAME) DO .NEW P7 S P7=$P(LABEL,"^",7) .I $D(LABEL(P7)) S QF=2_"^"_$P(LABEL(P7),"^",8)_"^"_$P(LABEL(P7),"^")_"^"_$P(LABEL,"^",8)_"^"_$P(LABEL,"^") Q .S LABEL(P7)=LABEL I +QF=2 W *7,!!,"Error: duplicate volumes",!?3,"disk address ",$P(QF,"^",2),", volume name=",$P(QF,"^",3),!?3,"disk address ",$P(QF,"^",4),", volume name=",$P(QF,"^",5) S QF=1 Q F I=1:1:VOLS-1 I '$D(LABEL(I)) W !,"Unable to locate volume number ",I," (",VG0N(I),") of volume group ",VGNAME S QF=1 U 63:(:::"C") U 0 Q VGNAME S QF=0 W:'$G(STUAUTO) "." K LABEL U 63:(:::"T") U 0 D LABEL^MOUNT U 63:(:::"C") U 0 I LABEL="" S QF=1 Q S LABEL(0)=LABEL,VIN=$P(LABEL,"^",7) S (VGALT,VGNAME)=$V(512+8,0,3,1),MAGIC=$V(512+16,0,4) I VGNAME'?3A!(MAGIC=0) S QF=1 Q S VGBLK=$V(512+36,0,4),VGMAP=$V(512+40,0,2),VGUCI=$V(512+32,0,4),VOLS=$V(512+42,0,2) I VOLS>1 F I=1:1:VOLS-1 S VF=I-1*12+512+44,VG0N(I)=$V(VF,0,8,1),VG0M(I)=$V(VF+8,0,2) C:$D(%DEV) %DEV Q HNAME ; S QF=0 S HNAME="C:\DATABASE2.MSM" G HNLEV W !!,"Enter ",$S(OS:"host file name",1:"disk address") R " for volume group: ",X S QF=0,HNAME=X I X="^Q"!(X="^q")!("^"[X) S QF=1 Q I HNAME?.E1C.E W !,"Invalid characters entered",*7 G HNAME I HNAME["?" W !!?3 W:'OS "Enter the 3 character hexadecimal address of the disk which" I W:OS "Enter the full name of the host operating system file which" I W !?3,"contains the first volume of the volume group to mount." I W:'OS !?3,"Enter '^L' for a list of accessible disks." I W !?3,"Enter '^' to return to the previous question." I W !?3,"Enter '^Q' to exit to the utility." G HNAME HNLEV D CHKNAME G:QF HNAME Q CHKNAME ; S QF=0 G:'OS CHKNAME1 O %DEV:(HNAME:"R") U %DEV S ZA=$ZA U 0 C %DEV I ZA<0 W !,"File name ",HNAME," does not exist." S QF=1 Q O 63 O %DEV:(HNAME:"CBR") Q CHKNAME1 I HNAME="^L" S X="" W !,"Accessible disks are:",! I F I=0:1 S X=$O(%DSK(X)) Q:X="" W ?(I#8*8),X W:$X>70 ! I S QF=1 Q I '$D(%DSK(HNAME)) W !,"Disk ",HNAME," not available" S QF=1 Q Q QAGN ; W !,"You have selected volume group '",VGNAME,"' which is already mounted" R !,"To continue mount, enter an alternate volume group name: ",X QAGNR ; I X="^L"!(X="^l") D VGLIST^%VGUTIL G QAGNX I X="^" S QF=1 Q I X="^Q" S QF=2 Q I X?3U S VGALT=X D HASH^%VGUTIL S $P(LABEL(0),"^",5)=Y,QF=0 Q W !," Each mounted volume group must have a unique 3 letter name." W !," Since the volume group you want to mount has the same name " W !," as one which is already mounted, you must give it a " W !," surrogate name which will be valid as long as it is mounted." W !," Enter '^L' to see a list of mounted volume groups." W !," Enter '^' to return to the previous question" W !," Enter '^Q' to exit the utility." QAGNX R !!,"Please enter an alternate volume group name: ",X G QAGNR VGSLOT S QF=1 F VGIN=1:1:7 S VGOF=$V(VGIN*4+VGTAB) Q:'VGOF I '$V(VGOF+4,-3,2) S QF=0 Q %L1MBG %L1MBG ; INPUT FROM DISPLAY [ 15.03.19 07:15 ] [ 15.01.06 20:02 ] [ 06.09.05 11:12 AM ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%MBG,%REFHS) D ^%L1C I '$D(%POSIC) D ^%L1C K %BE,%LS,%S,%L1DS,OLDDAT,YOLD,SHOLD,SCHOLD N COLG,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPG,NPGL,OTB,PG,%PRNEW,RKV,RSCR,RZD,%REFH1 N SHOLD,SCHOLD,STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2 ;SH,SCH N %HBRY S %HBRY="" I $D(%MBG("PAR"))>9 D ^%L1MBG1 S NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") BEG D INIT S %REFH1=$G(%MBG("REF"),"^MBG($P") D PS Q:$D(%L1MBG) L0 S:$D(YOLD) %YY=YOLD S:$D(SHOLD) SH=SHOLD S:$D(SCHOLD) SCH=SCHOLD LOOP ; -------------------------------------- NEW LINE K YOLD,SHOLD,SCHOLD,%MBG("TO") X %XCL K %INV S SH=SH+1,SCH=SCH+1 I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G ZP ;RSM S %YY=%YY+STEP,$Y=%YY,%YYYY=%YY K %MBG("NEW"),%PRPL F JJ=1:1:COLG S %MBG("O",JJ)="" K JJ ML ; F JJ=1:1 Q:'$D(%MBG("OU",JJ)) S %FIRST=JJ K JJ S J=0 I %YY>(STEP*COLS+VGR)!(%YY>23) S:%YY>23 %YY=23 G ZP S %XX=XX0-2 W %ENG X %POSIC W %CLI W SH+$G(%MBG("OFF")) X %XCL ; NUMBER OF SEQUENCE G INC ;------------------------------------------- NEW COLUMN LGR U $P:(NOECHO:NOWRAP) K %TO,%FLL,%S,%L1DS,%SC W %ENG S %TO="" S %MBG("O",J)=$P($G(@(%REFH1_",SH)")),RZD,J) ;I $G(%MBG("H",J))'?.P S %SAY=$G(%MBG("H",J)) X %XMSGN S %SAY=$G(%MBG("H",J)) X %XMSGN S RKV=$P($G(@(%REFH1_",SH)")),RZD,J) I RKV'?.P S %MBG("O",J)=RKV ;************** K RKV ;************** I $D(%MBG("DO",J)) X %MBG("DO",J) ;************** S %XX=%MBG("X",J) S %SAY=%MBG("Z",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH,I" X %XMSG S %XX=%MBG("X",J) S %YY=%YYYY,$Y=%YY I %XX["+" S %YY=%YY+1,$Y=$Y+1,%PRPL="" X %LIGHT X %POSIC S %LS=%MBG("D",J) S %S=%MBG("O",J) S %INV="" S CIST=$G(%MBG("S",J)) K:CIST="" CIST S %PRNEW=0 I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" I %MBG("RGS",J)="E" D I %S'["==",$D(%MBG("DR",J)),$L($P(%S,"."))>(%MBG("D",J)-%MBG("DR",J)-1) D ER G LGR .S %XX=%XX-%LS X %POSIC S $X=%XX .S %FL="" K %BE D ^%ZMSL K %INV,%FL S:$G(%TO)="=" %S="==" Q:%S["==" .I $D(%MBG("DR",J)),%S'["%" S %S=$J(%S,%MBG("DR",J)+1,%MBG("DR",J)) .I $E(%MBG("D",J),$L(%MBG("D",J)))="." S %S=$TR($J(%S,%MBG("D",J))," ",0) I %MBG("RGS",J)="H" S $X=%XX-1 D ^%L1ZMS I $G(%TO)="=" S %S="==" I %MBG("RGS",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q I %MBG("RGS",J)="D" S %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,".","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET I %MBG("RGS",J)="T" S %XX=%XX-8 S $X=%XX S %L1TS=$TR(%S,".","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) ;*** W %ENG S %XX=%MBG("X",J)-DL I $G(%TO)="DEL",'$D(%MBG("DELAS")) D DEL G:%TO'="PGUP" BEG G PGUP I %S["==",J=%FIRST,$O(^(SH))="" G RSM S %X000=%XX I %MBG("RGS",J)'="HH" X %POSIC X %XCL X:$D(%PRPL) %LIGHT W $J($$W^%L1C(%S),DL) X %XCL X:$D(%PRPL) %LIGHT S %SAY=%MBG("Z",J)_"++"_(VGR0+(%MBG("X",J)["+"))_","_%MBG("X",J)_",HH" X %XMSG S %XX=%X000,$X=%XX K %X000 S %MOLD=$P($G(@(%REFH1_",SH)")),RZD,J) S $P(@(%REFH1_",SH)"),RZD,J)=%S I $G(%MBG("GLOB",J))'?."^"1U.E,(%TO="F7")!(%TO="F6"),%S="" S %S=$S(%TO="F6":"?",1:"*"),%TO="" I %MBG("O",J)'=%S!$D(%MBG("NEW",J))!(%MBG("O",J)="?")!(%MBG("O",J)="*") S %PRNEW=1 S %MBG("O",J)=%S S %YY=%YYYY,$Y=%YY I $G(%MBG("GLOB",J))?."^"1U.E,(%TO="F7")!(%TO="F6") D S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD D VSV .N FILE S FILE=%MBG("GLOB",J) .I %TO="F7" D DAFUS^%L3MBGS Q:'$L($G(STRING)) S (%S,%MBG("O",J))=STRING Q .I %TO="F6" D POISK^%L3MBGS Q:'$L($G(STRING)) S (%S,%MBG("O",J))=STRING Q IBUD ; I $G(%TO)="",$D(%MBG("C",J)),%MBG("C",J)'?.P S JOLD=J D D:$G(%MBG("TO",J))="PL" PL G:$G(%MBG("TO",J))'="P" SET D PS G SET ;G BEG .I %OPT=1 D GET^%VIDEO("OLD",1,1,78,VGR0-1,2) .S JOLD=J,YOLD=%YY,SHOLD=SH,SCHOLD=SCH .N %FIRST X %MBG("C",J) .I %OPT=1 D PUT^%VIDEO("OLD",1,1,78,VGR0-1,2) .S J=JOLD,%YY=YOLD,SH=SHOLD,SCH=SCHOLD .Q SET ; I $D(%SC("ER")) S %MBG("O",J)=%MOLD W *7 G LGR I $D(%SC("ST")) W *7 G LGR NAZAD S:$G(%TO)="END"&(J>%FIRST) %TO="UP" I $D(%TO),%TO="UP",J>%FIRST S J=J-1 G:'$D(%MBG("OU",J)) LGR G NAZAD I $G(%TO)'="",'$D(%MBG("NEW")) G:J=%FIRST UP G LGR ; ----------------------------------------- END OF INPUT COLUMN UP ; I $G(%TO)="UP" G:SCH=1 ZP S %YY=%YY-(2*STEP),SH=SH-2,SCH=SCH-2 D CLOU G LOOP I $G(%TO)="DW" D CLOU G LOOP I $G(%TO)="END" G ZP ;G END PGUP ;I %TO="PGUP" G:NPG'>1 ML:'$D(%L1MBG),BEG:$D(%L1MBG) S NPG=NPG-1 G BEG ;I %TO="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) BEG:$D(%L1MBG),ML:'$D(%L1MBG) S NPG=NPG+1,PG(NPG)=SH-SCH+COLS G BEG I $G(%TO)="PGUP" G:NPG'>1 ML:'$D(%L1MBG),END S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG I $G(%TO)="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) ML:'$D(%L1MBG),END S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG INC S J=J+1 I J>COLG D CLOU G LOOP I $D(%MBG("OU",J)) G INC G LGR CLOU F JJ=1:1:COLG I $G(%MBG("OU",JJ))'="IN" K %MBG("OU",JJ) Q ZP D ZAPR G RSM:OTB=".",BEG ; PL S GG=$G(@(%REFH1_",SH)")),I=0 ; S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S %XX=X1 X %POSIC W $J("",X2-X1-1) D PG Q ;G INC ;L0 RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END Q PS N SH,SCH,%YY,J D CLEAR S %SAY=NPG_"++"_(VGR0-1)_","_(X1+2)_",EE" X %XMSG S %SAY=" cenr++"_(VGR0-1)_","_(X1+8)_",HH" X %XMSG S SCH=0,SH=PG(NPG),%OFF=0 F JJ=1:1:COLG D .I %MBG("X",JJ)["+" S %OFF=1 X %LIGHT .S %SAY=%MBG("Z",JJ)_"++"_(VGR0+%OFF)_","_%MBG("X",JJ)_",HH," X %XMSG ;.S %SAY=$E(%MBG("Z",JJ),$L(%MBG("Z",JJ)))_"++"_(VGR0+%OFF)_","_%MBG("X",JJ)_",HH,I" X %XMSG S %YY=VGR D P S %YY=VGR X %XCL Q P N I,%S,%L1DS,J ; F I=1:1:COLS Q:'$D(@(%REFH1_",SH+I)")) S %YY=%YY+STEP D PG ;S %SAY="PG-DW++"_(Y2-2)_",8,EE,I" X %XMSG S %SAY=" - d`ad cenr++"_(Y2-2)_",28,HH" X %XMSG ;S %SAY="PG-UP++"_(Y2-2)_",35,EE,I" X %XMSG S %SAY=" - mcew cenr++"_(Y2-2)_",53,HH" X %XMSG ;S %SAY="==,"_$S(%TYPCRT["VT":"",1:"")_"++"_(Y2-2)_",57,EE,I" X %XMSG S %SAY=" - meiq++"_(Y2-2)_",75,HH" X %XMSG I '$D(%MBG("DELAS")) S %SAY=" /E++"_(Y2-1)_",31,EE" X %XMSG S %SAY=" - lhal ++"_(Y2-1)_",48,HH" X %XMSG S %SAY=" - d`ad sc ; - mcew sc; ==,"_$S(%TYPCRT["VT":"",1:"")_" - meiq" X %XMSGN Q PG N RKV,J,DL X %XCL S %XX=XX0-2 W %ENG X %POSIC W %CLI W (SH+I)+$G(%MBG("OFF")) X %XCL F J=1:1:COLG S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) S %XX=%MBG("X",J)-DL X %POSIC D .W:$D(%MBG("INV",J)) %CLI .S RKV=$P($G(^(SH+I)),RZD,J) .I %MBG("X",J)["+" S %YY=%YY+1 X %POSIC S %YY=%YY-1 X %LIGHT .I %MBG("RGS",J)="HH" D Q ..N %X1,%Y1,%X2,%Y2 ..S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1,%S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S ..Q .S RKV=$E(RKV,1,DL) .W $S('$D(%MBG("DR",J)):$J($$W^%L1C(RKV),DL),1:$J(RKV,DL,%MBG("DR",J))) X %XCL Q CLEAR ; N %XX,%YY,I U $P:(NOECHO:NOWRAP) D ^%L1RBUA F I=Y1:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q ZAPR ; S %GET=" - `ad jqn , <.,ESC> - miiql , 1 - owzl, 0 - mcew jqn" D N^%L1GET S OTB=%S I OTB=0 Q:NPG'>1 S NPG=NPG-1 Q S:OTB="/"!($G(%TO)="END") OTB="." I OTB="",'$D(@(%REFH1_",SH-SCH+COLS)")) W *7 D ER G ZAPR I OTB="",$G(%MBG("GWUL"))>1,SH-SCH+COLS+1>%MBG("GWUL") W *7 D ER G ZAPR I OTB="",$G(%TO)="" S NPG=NPG+1,PG(NPG)=SH-SCH+COLS Q I OTB'="."&(OTB'=1) W *7,*7 H 1 G ZAPR Q ER ; W *7 S %SAY=" d`iby " X %XMSGV H 2 W *7 S %SAY=" " X %XMSGV Q DEL ; ; I $D(%MBG("DEL")) X %MBG("DEL") K YOLD,SHOLD,SCHOLD F %II=SH:1 Q:'$D(@(%REFH1_",%II+1)")) D .S MAC1=%REFH1_","_(%II+1)_")" .S MAC2=%REFH1_","_%II_")" .D ^%S1GC1 K @(%REFH1_",%II)"),%L1DS I $D(%MBG("DEL")) X %MBG("DEL") F %I1=1:1 Q:'$D(PG(%I1)) S NPGL=%I1 I PG(NPGL)=(%II-1),NPGL>1 K PG(NPGL) I %II=SH,SCH=1,SH>1 S SCHOLD=COLS-1,SHOLD=SH-2,YOLD=STEP*(COLS-1)+VGR S %TO="PGUP" Q I %II=SH,SCH>1 S SCHOLD=SCH-2,SHOLD=SH-2,YOLD=STEP*SCHOLD+VGR Q I SH>1 S SHOLD=SH-1 I SCH>1 S SCHOLD=SCH-1 I %YY+1>(VGR+STEP) S YOLD=%YY-STEP Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S RSCR=Y2-VGR-2,STEP=$G(%MBG("STEP"),2) S COLS=RSCR-STEP\STEP,SCH=0,%YY=VGR,SH=PG(NPG) Q VSV N %XX,%YY S %XX=%MBG("X",J)-DL,%YY=%YYYY X %POSIC X %XCL X:$D(%PRPL) %LIGHT W:$G(%NOMOD) %CLI W:$D(%MBGLIGHT) %LIGHT1 I $G(%MBG("DR",J)) W $J(%S,DL,%MBG("DR",J)) G EV I $G(%MBG("RGS",J))="H" W $$HBR^%L1FRM($$W^%L1C(%S),DL) G EV W $$W^%L1C($J(%S,DL)) EV X %XCL Q %L1MBG0 %L1MBG ; INPUT FROM DISPLAY [ 15.01.06 19:47 ] [ 16.12.03 10:21 ] [ 14.12.03 16:44 ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C K %BE,%LS,%S,%L1DS,OLDDAT,YOLD,SHOLD,SCHOLD N COLG,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPG,NPGL,OTB,PG,%PRNEW,RKV,RSCR,RZD,%REFH1 N SHOLD,SCHOLD,STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2 ;SH,SCH N %HBRY S %HBRY="" I $D(%MBG("PAR"))>9 D ^%L1MBG1 S NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") BEG D INIT S %REFH1=$G(%MBG("REF"),"^MBG($P") D PS Q:$D(%L1MBG) L0 S:$D(YOLD) %YY=YOLD S:$D(SHOLD) SH=SHOLD S:$D(SCHOLD) SCH=SCHOLD LOOP ; -------------------------------------- NEW LINE K YOLD,SHOLD,SCHOLD,%MBG("TO") X %XCL K %INV S SH=SH+1,SCH=SCH+1 I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G ZP ;RSM S %YY=%YY+STEP,$Y=%YY,%YYYY=%YY K %MBG("NEW"),%PRPL F JJ=1:1:COLG S %MBG("O",JJ)="" K JJ ML ; F JJ=1:1 Q:'$D(%MBG("OU",JJ)) S %FIRST=JJ K JJ S J=0 I %YY>(STEP*COLS+VGR)!(%YY>23) S:%YY>23 %YY=23 G ZP S %XX=XX0-2 W %ENG X %POSIC W %CLI W SH+$G(%MBG("OFF")) X %XCL ; NUMBER OF SEQUENCE G INC ;------------------------------------------- NEW COLUMN LGR U $P:(NOECHO:NOWRAP) K %TO,%FLL,%S,%L1DS W %ENG S %TO="" S %MBG("O",J)=$P($G(@(%REFH1_",SH)")),RZD,J) ;I $G(%MBG("H",J))'?.P S %SAY=$G(%MBG("H",J)) X %XMSGN S %SAY=$G(%MBG("H",J)) X %XMSGN S RKV=$P($G(@(%REFH1_",SH)")),RZD,J) I RKV'?.P S %MBG("O",J)=RKV ;************** K RKV ;************** I $D(%MBG("DO",J)) X %MBG("DO",J) ;************** S %XX=%MBG("X",J) S %SAY=%MBG("Z",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH,I" X %XMSG S %XX=%MBG("X",J) S %YY=%YYYY,$Y=%YY I %XX["+" S %YY=%YY+1,$Y=$Y+1,%PRPL="" X %LIGHT X %POSIC S %LS=%MBG("D",J) S %S=%MBG("O",J) S %INV="" S CIST=$G(%MBG("S",J)) K:CIST="" CIST S %PRNEW=0 I %MBG("RGS",J)="E" D I %S'["==",$D(%MBG("DR",J)),$L($P(%S,"."))>(%MBG("D",J)-%MBG("DR",J)-1) D ER G LGR .S %XX=%XX-%LS X %POSIC S $X=%XX .S %FL="" K %BE D ^%ZMSL K %INV,%FL Q:%S["==" .I $D(%MBG("DR",J)),%S'["%" S %S=$J(%S,%MBG("DR",J)+1,%MBG("DR",J)) I %MBG("RGS",J)="H" S $X=%XX-1 D ^%L1ZMS I %MBG("RGS",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q I %MBG("RGS",J)="D" S %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,".","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET I %MBG("RGS",J)="T" S %XX=%XX-8 S $X=%XX S %L1TS=$TR(%S,".","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) ;*** W %ENG S %XX=%MBG("X",J)-DL I $G(%TO)="DEL",'$D(%MBG("DELAS")) D DEL G:%TO'="PGUP" BEG G PGUP I %S["==",J=%FIRST,$O(^(SH))="" G ZP ;RSM S %X000=%XX I %MBG("RGS",J)'="HH" X %POSIC X %XCL X:$D(%PRPL) %LIGHT W $J(%S,DL) X %XCL X:$D(%PRPL) %LIGHT S %SAY=%MBG("Z",J)_"++"_(VGR0+(%MBG("X",J)["+"))_","_%MBG("X",J)_",HH" X %XMSG S %XX=%X000,$X=%XX K %X000 S %MOLD=$P($G(@(%REFH1_",SH)")),RZD,J) S $P(@(%REFH1_",SH)"),RZD,J)=%S I %MBG("O",J)'=%S!$D(%MBG("NEW",J))!(%MBG("O",J)="?")!(%MBG("O",J)="*") S %PRNEW=1 S %MBG("O",J)=%S S %YY=%YYYY,$Y=%YY IBUD ; I %PRNEW,$D(%MBG("C",J)),%MBG("C",J)'?.P S JOLD=J D D:$G(%MBG("TO",J))="PL" PL G:$G(%MBG("TO",J))'="P" SET D PS G SET ;G BEG .I %OPT=1 D GET^%VIDEO("OLD",1,1,78,VGR0-1,2) .S JOLD=J,YOLD=%YY,SHOLD=SH,SCHOLD=SCH .N %FIRST X %MBG("C",J) .I %OPT=1 D PUT^%VIDEO("OLD",1,1,78,VGR0-1,2) .S J=JOLD,%YY=YOLD,SH=SHOLD,SCH=SCHOLD .Q SET ; NAZAD S:$G(%TO)="END"&(J>%FIRST) %TO="UP" I $D(%TO),%TO="UP",J>%FIRST S J=J-1 G:'$D(%MBG("OU",J)) LGR G NAZAD I $G(%TO)'="",'$D(%MBG("NEW")) G:J=%FIRST UP G LGR ; ----------------------------------------- END OF INPUT COLUMN UP ; I $G(%TO)="UP" G:SCH=1 ZP S %YY=%YY-(2*STEP),SH=SH-2,SCH=SCH-2 D CLOU G LOOP I $G(%TO)="DW" D CLOU G LOOP I $G(%TO)="END" G ZP ;G END PGUP ;I %TO="PGUP" G:NPG'>1 ML:'$D(%L1MBG),BEG:$D(%L1MBG) S NPG=NPG-1 G BEG ;I %TO="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) BEG:$D(%L1MBG),ML:'$D(%L1MBG) S NPG=NPG+1,PG(NPG)=SH-SCH+COLS G BEG I $G(%TO)="PGUP" G:NPG'>1 ML:'$D(%L1MBG),END S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG I $G(%TO)="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) ML:'$D(%L1MBG),END S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG INC S J=J+1 I J>COLG D CLOU G LOOP I $D(%MBG("OU",J)) G INC G LGR CLOU F JJ=1:1:COLG I $G(%MBG("OU",JJ))'="IN" K %MBG("OU",JJ) Q ZP D ZAPR G RSM:OTB=".",BEG ; PL S GG=$G(@(%REFH1_",SH)")),I=0 ; S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S %XX=X1 X %POSIC W $J("",X2-X1-1) D PG Q ;G INC ;L0 RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END Q PS N SH,SCH,%YY,J D CLEAR S %SAY=NPG_"++"_(VGR0-1)_","_(X1+2)_",EE" X %XMSG S %SAY=" cenr++"_(VGR0-1)_","_(X1+8)_",HH" X %XMSG S SCH=0,SH=PG(NPG),%OFF=0 F JJ=1:1:COLG D .I %MBG("X",JJ)["+" S %OFF=1 X %LIGHT .S %SAY=%MBG("Z",JJ)_"++"_(VGR0+%OFF)_","_%MBG("X",JJ)_",HH," X %XMSG ;.S %SAY=$E(%MBG("Z",JJ),$L(%MBG("Z",JJ)))_"++"_(VGR0+%OFF)_","_%MBG("X",JJ)_",HH,I" X %XMSG S %YY=VGR D P S %YY=VGR X %XCL Q P N I,%S,%L1DS,J ; F I=1:1:COLS Q:'$D(@(%REFH1_",SH+I)")) S %YY=%YY+STEP D PG ;S %SAY="PG-DW++"_(Y2-2)_",8,EE,I" X %XMSG S %SAY=" - d`ad cenr++"_(Y2-2)_",28,HH" X %XMSG ;S %SAY="PG-UP++"_(Y2-2)_",35,EE,I" X %XMSG S %SAY=" - mcew cenr++"_(Y2-2)_",53,HH" X %XMSG ;S %SAY="==,"_$S(%OPT=65:"",1:"")_"++"_(Y2-2)_",57,EE,I" X %XMSG S %SAY=" - meiq++"_(Y2-2)_",75,HH" X %XMSG I '$D(%MBG("DELAS")) S %SAY=" /E++"_(Y2-1)_",31,EE" X %XMSG S %SAY=" - lhal ++"_(Y2-1)_",48,HH" X %XMSG S %SAY=" - d`ad sc ; - mcew sc; ==,"_$S(%OPT=65:"",1:"")_" - meiq" X %XMSGN Q PG N RKV,J,DL X %XCL S %XX=XX0-2 W %ENG X %POSIC W %CLI W (SH+I)+$G(%MBG("OFF")) X %XCL F J=1:1:COLG S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) S %XX=%MBG("X",J)-DL X %POSIC D .W:$D(%MBG("INV",J)) %CLI .S RKV=$P($G(^(SH+I)),RZD,J) .I %MBG("X",J)["+" S %YY=%YY+1 X %POSIC S %YY=%YY-1 X %LIGHT .I %MBG("RGS",J)="HH" D Q ..N %X1,%Y1,%X2,%Y2 ..S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1,%S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S ..Q .S RKV=$E(RKV,1,DL) .W $S('$D(%MBG("DR",J)):$J(RKV,DL),1:$J(RKV,DL,%MBG("DR",J))) X %XCL Q CLEAR ; N %XX,%YY,I D ^%L1RBUA F I=Y1:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q ZAPR ; S %GET=" - `ad jqn , <.,ESC> - miiql , 1 - owzl, 0 - mcew jqn" D N^%L1GET S OTB=%S I OTB=0 Q:NPG'>1 S NPG=NPG-1 Q S:OTB="/"!($G(%TO)="END") OTB="." I OTB="",'$D(@(%REFH1_",SH-SCH+COLS)")) W *7 D ER G ZAPR I OTB="",$G(%MBG("GWUL"))>1,SH-SCH+COLS+1>%MBG("GWUL") W *7 D ER G ZAPR I OTB="",$G(%TO)="" S NPG=NPG+1,PG(NPG)=SH-SCH+COLS Q I OTB'="."&(OTB'=1) W *7,*7 H 1 G ZAPR Q ER ; W *7 S %SAY=" d`iby " X %XMSGV H 2 W *7 S %SAY=" " X %XMSGV Q DEL ; ; I $D(%MBG("DEL")) X %MBG("DEL") K YOLD,SHOLD,SCHOLD F %II=SH:1 Q:'$D(@(%REFH1_",%II+1)")) D .S MAC1=%REFH1_","_(%II+1)_")" .S MAC2=%REFH1_","_%II_")" .D ^%S1GC1 K @(%REFH1_",%II)"),%L1DS I $D(%MBG("DEL")) X %MBG("DEL") F %I1=1:1 Q:'$D(PG(%I1)) S NPGL=%I1 I PG(NPGL)=(%II-1),NPGL>1 K PG(NPGL) I %II=SH,SCH=1,SH>1 S SCHOLD=COLS-1,SHOLD=SH-2,YOLD=STEP*(COLS-1)+VGR S %TO="PGUP" Q I %II=SH,SCH>1 S SCHOLD=SCH-2,SHOLD=SH-2,YOLD=STEP*SCHOLD+VGR Q I SH>1 S SHOLD=SH-1 I SCH>1 S SCHOLD=SCH-1 I %YY+1>(VGR+STEP) S YOLD=%YY-STEP Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S RSCR=Y2-VGR-2,STEP=$G(%MBG("STEP"),2) S COLS=RSCR-STEP\STEP,SCH=0,%YY=VGR,SH=PG(NPG) Q %L1MBG1 %L1MBG1 ; INIT07/14/91 12:05 PM ] [ 06.09.05 11:12 AM ] [ 18.08.04 11:17 AM ] [ 02.07.04 2:06 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%MBG) N J,ZAPR S %MBG("LL")=78,%MBG("LR")=0 F J=1:1 Q:'$D(%MBG("PAR",J)) S ZAPR=$P(%MBG("PAR",J),"#") D .S %MBG("F",$P(ZAPR," "))=J .S %MBG("Z",J)=$P(ZAPR,";",2) .S %MBG("X",J)=$P(ZAPR,";",3) .S %MBG("INV",J)=$P($P(ZAPR,";",3),",",3) .I %MBG("INV",J)'="I" K %MBG("INV",J) .I %MBG("X",J)>%MBG("LR") S %MBG("LR")=%MBG("X",J) .I %MBG("X",J)<%MBG("LL") S %MBG("LL")=%MBG("X",J) .S %MBG("D",J)=$P($P(ZAPR,";",4),",") .S %MBG("DR",J)=$P($P(ZAPR,";",4),",",2) .I %MBG("DR",J)="" K %MBG("DR",J) .S %MAXD=$S($L(%MBG("Z",J))>%MBG("D",J):$L(%MBG("Z",J)),1:%MBG("D",J)) .I %MBG("X",J)-%MAXD<%MBG("LL") S %MBG("LL")=%MBG("X",J)-%MAXD .S %MBG("RGS",J)=$P(ZAPR,";",5) .S %MBG("S",J)=$P(ZAPR,";",6) I %MBG("S",J)="" K %MBG("S",J) .S %MBG("H",J)=$P(%MBG("PAR",J),"#",4) I %MBG("H",J)="" K %MBG("H",J) .S %MBG("O",J)=$P(%MBG("PAR",J),"#",2) .S %MBG("C",J)=$P(%MBG("PAR",J),"#",3) I %MBG("C",J)="" K %MBG("C",J) .I $E(%MBG("O",J))="""" S %MBG("O",J)=$P(%MBG("O",J),"""",2),%MBG("OU",J)="IN" .I $E(%MBG("O",J))="@" S %MBG("DO",J)=$E(%MBG("O",J),2,255) K %MBG("O",J) S %MBG("COLG")=J-1 S:%MBG("LR")>78 %MBG("LR")=78 S:%MBG("LL")<0 %MBG("LL")=0 K %MBG("PAR") Q %L1MBG10 %L1MBG1 ; INIT07/14/91 12:05 PM ] [ 15.01.06 19:47 ] [ 07/14/92 6:04 PM ] N J,ZAPR S %MBG("LL")=78,%MBG("LR")=0 F J=1:1 Q:'$D(%MBG("PAR",J)) S ZAPR=$P(%MBG("PAR",J),"#") D .S %MBG("F",$P(ZAPR," "))=J .S %MBG("Z",J)=$P(ZAPR,";",2) .S %MBG("X",J)=$P(ZAPR,";",3) .S %MBG("INV",J)=$P($P(ZAPR,";",3),",",3) .I %MBG("INV",J)'="I" K %MBG("INV",J) .I %MBG("X",J)>%MBG("LR") S %MBG("LR")=%MBG("X",J) .I %MBG("X",J)<%MBG("LL") S %MBG("LL")=%MBG("X",J) .S %MBG("D",J)=$P($P(ZAPR,";",4),",") .S %MBG("DR",J)=$P($P(ZAPR,";",4),",",2) .I %MBG("DR",J)="" K %MBG("DR",J) .S %MAXD=$S($L(%MBG("Z",J))>%MBG("D",J):$L(%MBG("Z",J)),1:%MBG("D",J)) .I %MBG("X",J)-%MAXD<%MBG("LL") S %MBG("LL")=%MBG("X",J)-%MAXD .S %MBG("RGS",J)=$P(ZAPR,";",5) .S %MBG("S",J)=$P(ZAPR,";",6) I %MBG("S",J)="" K %MBG("S",J) .S %MBG("H",J)=$P(%MBG("PAR",J),"#",4) I %MBG("H",J)="" K %MBG("H",J) .S %MBG("O",J)=$P(%MBG("PAR",J),"#",2) .S %MBG("C",J)=$P(%MBG("PAR",J),"#",3) I %MBG("C",J)="" K %MBG("C",J) .I $E(%MBG("O",J))="""" S %MBG("O",J)=$P(%MBG("O",J),"""",2),%MBG("OU",J)="IN" .I $E(%MBG("O",J))="@" S %MBG("DO",J)=$E(%MBG("O",J),2,255) K %MBG("O",J) S %MBG("COLG")=J-1 S:%MBG("LR")>78 %MBG("LR")=78 S:%MBG("LL")<0 %MBG("LL")=0 K %MBG("PAR") Q %L1MBS %L1MBS ; DATA INPUT [ 15.03.19 08:19 ] [ 22.04.07 11:39 ] [ 09.11.01 9:59 AM ] ;;N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%MBS,LZ,LB,LR,LT,LX,LL,COLS,%L1MBS,%S,%TO) D ^%L1C INP ; ------------------- INPUT N CIST,I,OLD,IOLDD,Y1,Y2,X1,X2 N %FIRST,%ECHO,%HBRY,%XX,%XXOLD,%YY,%LS,%MOLD,%BE,%L1DS,%L1TS N %INV,%L1DAT,%L1DAT1,%L1TIME,%L1TIME1 D PC Q:$D(%L1MBS) I '$D(%FIRST) S %FIRST=1 S I=1 K %ECHO S %HBRY="" I $D(%MBS("OU",I)) G INC ;;F I=1:1 Q:'$D(%MBS("OU",I)) LOOP I $D(%MBS("DO",I)) X %MBS("DO",I) ;************** S %XX=0,%YY=24 X %POSIC W %chists I $D(%MBS("H",I)) S %SAY=%MBS("H",I)_"++24,78,HH,I" X %XMSG ;************** U $P:(NOECHO:NOWRAP) K %FLL W %ENG S %YY=%MBS("CY",I),%XX=%MBS("CX",I) S:%ENGLISH&(%XX>40) %XX=80-%XX X %POSIC S $Y=%YY S %LS=%MBS("D",I,1) K CIST S (%MOLD,%S)=%MBS("O",I) S %INV="" S CIST=%MBS("S",I) K:CIST="" CIST I %ENGLISH,%MBS("RGS",I)="H" S %MBS("RGS",I)="E" I %MBS("RGS",I)="B" S %LS=1,%HBRY="",CIST="kl" LE S %XXOLD=%XX I %MBS("RGS",I)="E"!(%MBS("RGS",I)="") S %XX=$S(%ENGLISH:%XX+2,1:%XX-%LS) X %POSIC S ($X,%XXOLD)=%XX S %FL="" D ^%ZMSL I %MBS("RGS",I)="H"!(%MBS("RGS",I)="B") S %XX=%XX-1,$X=%XX,%XXOLD=%MBS("CX",I)-%MBS("D",I,1) D ^%L1ZMS I %MBS("RGS",I)="D" S %XX=$S(%ENGLISH:%XX+2,1:%XX-8),($X,%XXOLD)=%XX S %L1DS=$TR(%S,".","") D ^%L1DAT S %S=$G(%L1DAT1) I %MBS("RGS",I)="T" S %XX=$S(%ENGLISH:%XX+2,1:%XX-8),($X,%XXOLD)=%XX S %L1TS=%S D ^%L1TIME S %S=$G(%L1TIME1) W %ENG S %XX=%XXOLD X %POSIC X %XCL W $S(%ENGLISH:%S_$J("",%MBS("D",I,1)-$L(%S)),1:$S($D(%MBS("DR",I)):$J(%S,%MBS("D",I,1),%MBS("DR",I)),1:$J($$WH(%S,%MBS("RGS",I)),%MBS("D",I,1)))) M I %MBS("O",I)'=%S!$D(%MBS("NEW",I))!($G(%TO)'="") S %MBS("O",I)=%S I $G(%MBS("C",I))'="" D .S IOLD=I,IOLDD=I .X %MBS("C",I) .D:%MBS("O",IOLDD)'=%MOLD!($G(%MBS("TO",IOLDD))="PC") PC S I=IOLD K IOLD,%MOLD,IOLDD NAZAD S:$G(%TO)="END" %TO="UP" I $D(%TO),%TO="UP",I>%FIRST S I=I-1 G:'$D(%MBS("OU",I)) LOOP G NAZAD I $D(%TO),%TO="UP",I=1 G END I $D(%TO),%TO="PGUP"!(%TO="PGDW") G END INC S I=I+1 G:$D(%MBS("OU",I)) INC I I>COLS G END G LOOP Q PC ; U $P:(NOECHO:NOWRAP) S Y1=LT+1,X1=LL-1,Y2=LB,X2=LR S %L1RBCL="" D ^%L1RBUA F I=1:1:COLS W %ENG D .S %YY=%MBS("CY",I),%XX=%MBS("CX",I) S:%ENGLISH %XX=80-%XX-LZ X %POSIC .I %ENGLISH W %ENG W %MBS("Z",I),$J("",LZ-$L(%MBS("Z",I))),":" S %XX=%XX+LZ+2 X %POSIC .I '%ENGLISH W %HBR W ":",$$W^%L1C($J(%MBS("Z",I),LZ)) S %XX=%XX-%MBS("D",I,1) X %POSIC .S:'$D(%MBS("O",I)) %MBS("O",I)="" .K %MBS("BAT",I) I $D(%MBS("DO",I)) X %MBS("DO",I) .I '%ENGLISH W $S($D(%MBS("DR",I)):$J(%MBS("O",I),%MBS("D",I,1),%MBS("DR",I)),1:$J($$WH(%MBS("O",I),%MBS("RGS",I)),%MBS("D",I,1))) .E W %MBS("O",I),$J("",%MBS("D",I,1)-$L(%MBS("O",I))) .I $D(%MBS("BAT",I)) S %SAY=$E(%MBS("BAT",I),$L(%MBS("BAT",I))-%XX+3+X1,$L(%MBS("BAT",I)))_"++"_%YY_","_(%XX-2)_",HH" X %XMSG K %MBS("BAT",I) Q WH(%S,%PR) ; I %ENGLISH Q %S Q $$W^%L1C($G(%S)) ;- END Q %L1MBS1 %L1MBS1 ; INIT07/14/91 12:05 PM ] [ 15.11.01 2:05 PM ] [ 07.11.01 4:42 PM ] [ 24.10.01 12:34 PM ] N ZAPR,I S LZ=0,LT=24,LB=0,LL=80,LR=0,LX=0 F I=1:1 Q:'$D(%MBS("PAR",I)) S ZAPR=%MBS("PAR",I) D .S %MBS("Z",I)=$P(ZAPR,";",2) I $L(%MBS("Z",I))>LZ S LZ=$L(%MBS("Z",I)) .S %MBS("CY",I)=$P($P(ZAPR,";",3),","),%MBS("CX",I)=$P($P(ZAPR,";",3),",",2) .S %MBS("INV",I)=$P($P(ZAPR,";",3),",",3) I %MBS("INV",I)'="I" K %MBS("INV",I) .I %MBS("CY",I)>LB S LB=%MBS("CY",I) .I %MBS("CY",I)LX S LX=%MBS("CX",I) .S %MBS("D",I,1)=$P($P(ZAPR,";",4),",") .S %MBS("DR",I)=$P($P(ZAPR,";",4),",",2) I +%MBS("DR",I)=0 K %MBS("DR",I) .I %MBS("CX",I)-%MBS("D",I,1)24 LB=24 S LT=LT-1 S:LT<0 LT=0 S:LZ>70 LZ=70 S LR=LX+LZ+3 S:LR>80 LR=80 S:LL<0 LL=0 I %ENGLISH S LL=80-LL+3,LR=80-LR+3 I LL>LR N LLL S LLL=LR,LR=LL,LL=LLL Q %L1MD %L1MD(PORTN,USERMOD,NUMBER,MDTONE,US,XON) ; [ 01.02.04 14:06 ] [ 14.11.03 09:53 ] [ 30.06.03 10:03 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,USERMOD,NUMBER,MDTONE,%L1MDOK,US,XON,%DELAY) D ^%L1C S %L1MDOK=0 D ZU W !!?20," CTRL/C - CANCEL ",! D ZU S PRT=%L3MYDVN N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":EXIT^%L1MD" K ^MODEM($P) S ^MODEM($P)="BEG" S US="U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13,10))" I $G(PORTN)>3 G ASK+1 ASK R !!,"I/O PORT? > ",PORTN G:PORTN="" EXIT I $P=PORTN!'PORTN D ZU W !!,"CANNOT SELECT YOUR OWN DEVICE.",*7 G ASK I '$$^%L1MDLCK(PORTN) S %GET="A PORT OF MODEM IS BUSY ! " D N^%L1GET G EXIT C PORTN U $P:(CENABLE:CTRAP=$C(3)) O PORTN::0 E D ZU W *7,"..LINE IN USE..WAITING.." O PORTN W "READY" D HANGUP X US ;;I $ZB($ZA,2,1) D ZU W !,"DEVICE ",PORTN," IS AN OUTPUT ONLY DEVICE.",*7 G ASK INIT X US D ZU W ! S %DC=0 S %DT=0,%Y="" P0 D CLPORT S %ST="AT&F"_$G(XON)_$C(13) F %J=1:1:$L(%ST) W $E(%ST,%J) D DELAY P01 X US R *%Y1:1 E S %DC=%DC+1 G:%DC<12 P01:%DC#4,P0 D ZU W *7,!!,"NO CARRIER" G EXIT G:%Y1=1 EXIT I %Y1'=13 S %Y=%Y_$C(%Y1) G P01 D ZU W %Y,! S %DT=%DT+1 S ^MODEM($P,"ATZ",%DT)=%Y I %Y'["OK" G:%DT<12 P01:%DT#4,P0 D ZU W *7,!!,"NO CARRIER" G EXIT S %DT=0 I $G(NUMBER) D DELAY G TP1 TP U $P:(CENABLE:CTRAP=$C(3)) U $P:(ECHO:WRAP) R !!,"PHONE NUMBER > ",NUMBER G:NUMBER="" EXIT W ! TP1 X US S NUMBER=$TR(NUMBER,"-","") D CLPORT S ST="ATD"_$G(MDTONE,"P")_"W"_NUMBER_$C(13) W ST H 5 S OK=0 F I=1:1:40 R A:1 D Q:OK S ^MODEM("CONN",I)=A D ZU W !,A X US .I $F(A,"CONN") S OK=1 Q .I $F(A,"BUS") S OK=2 Q .I $F(A,"NO CAR") S OK=3 Q .I $F(A,"NO DIAL") S OK=4 Q I OK'=1 D ZU W !,A G EXIT I OK=1 K ^MODEM($P) D ZU W !!,"MODEM IN USE ! " S %L1MDOK=OK EXIT H 1 Q HANGUP ; D ^%L1HANG Q CLPORT X US ; F I=1:1:%DELAY R *A:0 I A>0 F R *A:1 E Q Q DELAY ; F %JJJ=1:1:%DELAY Q ZU ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U ^[$$^%L1GLD]dev(1):(NOECHO:NOWRAP) Q %L1MDCON %L1MDCON(LAK) ; HIUG LE LAKUAH FROM ^P1TBLAK [ 31.01.06 20:10 ] [ 21.11.05 23:02 ] [ 04/24/2000 12:32 PM ] Q:$G(LAK)="" N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,LAK) D ^%L1C S GLD=$$^%L1GLD I $P($G(^LAK(LAK,1)),"\",7)'="k" S %SAY=" lexhpew mcen oi` " X %XMSGV(1) Q S PORTN=$$MDPORT^%L1PORT S XON=$$XON^%L1PORT S PHONE=$P($G(^[GLD]LAK(LAK,1)),"\",3) S US="U PORTN:(NOWRAP:NOECHO:NOCENABLE:TERM=$C(13,10))" ;;D ^%L1MD(PORTN,1,PHONE,"T",US,XON) ;;H 2 U 0 D ^%XMIT S TEL=PHONE D ^%L1XM Q %L1MDLCK %L1MDLCK(PORTN) ; [ 14.07.06 10:05 ] [ 17.02.04 16:41 ] [ 14.11.03 09:49 ] N MDLOCK,OK,A,%L1GET S OK=1 I $P["/vc" Q OK S MDLOCK="/var/lock/LCK.."_$zparse(PORTN,"NAME") I $$EXIST^%L1ZOS(MDLOCK) D I 'OK U $P Q 0 .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .I $TR(A," ","")'=$J S OK=0 O MDLOCK:(WRITE:NEWVERSION) U MDLOCK W $J($J,10) C MDLOCK S MDLOCK="/var/lock/LCK..."_$J I $$EXIST^%L1ZOS(MDLOCK) D I 'OK U $P Q 0 .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .I $TR(A," ","")'=$J S OK=0 O MDLOCK:(WRITE:NEWVERSION) U MDLOCK W $J($J,10) C MDLOCK Q 1 CLOSE(PORTN) ; N MDLOCK,OK S OK=1 S MDLOCK="/var/lock/LCK.."_$zparse(PORTN,"NAME") I $$EXIST^%L1ZOS(MDLOCK) D I OK O MDLOCK C MDLOCK:DELETE .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .I $TR(A," ","")'=$J S OK=0 S MDLOCK="/var/lock/LCK..."_$J I $$EXIST^%L1ZOS(MDLOCK) D I OK O MDLOCK C MDLOCK:DELETE .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .I $TR(A," ","")'=$J S OK=0 Q %L1MDPRG %L1MDPRG(PORTN,UCI,PROG) ; [ 04.06.07 14:42 ] [ 13.05.07 12:15 ] [ 08.08.06 13:36 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,UCI,PROG,%L1MDPRG,%L2NALAN) ;; ---> %L1MDPRG("ER"),%L1MDPRG("SYS") K ^L1MDPRG S %L1MDPRG("ER")=0 M ^L1MDPRG=%L2NALAN S ^L1MDPRG("PORTN")=PORTN S ^L1MDPRG("PROG")=PROG S ^L1MDPRG("UCI")=UCI ; I $D(%L2NALAN("DEV")) D Q .S ^L1MDPRG("DEV")=%L2NALAN("DEV") .S:$E(PROG)="^" PROG=$E(PROG,2,20) .U PORTN W $C(13),"cmd D ^"_PROG_$C(3)_$G(UCI)_$C(3,27,95) .S ^L1MDPRG("OU")="cmd D ^"_PROG_"(3)"_$G(UCI)_"(3,27,95)" .W $C(13) ; S SYS=0 F RD=1:1:20 D Q:SYS .H 1 W:RD>10 $C(13) D READ .S SYS=0 .M ^L1MDPRG("INP")=INP .S N="" F S N=$O(INP(N)) Q:N="" D Q:SYS ..I INP(N)["LOGON"!(INP(N)["UCI") S SYS=1 Q ;--------- MSM ..I INP(N)["login" S SYS=2 Q ;---------- LINUX ; I 'SYS S %L1MDPRG("ER")=1 Q S %L1MDPRG("SYS")=SYS S ^L1MDPRG("SYS")=SYS ; I SYS=1 U PORTN W $C(13) H 1 W UCI_":"_PROG_":180",$C(13) Q ; ; ---------------- LINUX ------------------ ; I SYS=2 D .H 1 U PORTN W "root",$C(10,13) H 1 .D READ .H 1 U PORTN W "17101957",$C(10,13) H 1 .D READ .H 1 D READ .S CMD=$S(UCI="MLY":"mly",1:"mumps")_":"_PROG .H 1 U PORTN W "mumps -r SERVMD """_CMD_"""",$C(10,13) H 1 Q READ N I,J K INP U PORTN S J=1 F I=1:1:1000 R *A:0 D .I A=10!(A=13)!(A=27) S J=J+1 Q .I A>0 S INP(J)=$G(INP(J))_$C(A) Q %L1MENU1 %L1MENU1 ; MENU GRAFI [ 30.06.03 16:26 ] [ 15.06.00 12:33 PM ] [ 09/25/2000 10:53 AM ] ; INPUT : MAC - LOKAL NAME WITH MENU @MAC@(0) - SHAPKA MENU ; [%L1M1("VRT")] - SMESHENIE OT BERXHEGO KRAIA { 2 } ; [%L1M1("DLST")] - KOL-VO V STROKE { 4 } ; [%L1M1("KOL")] - KOL-VO PUNKTOB MENU { %L1M1("DLST")*3 } ; [%L1M1("CEVA","F")] - COLOR OF FON { %CL0 } ; [%L1M1("CEVA","L")] - COLOR OF LINIY { %CV("WF") } ; [%L1M1("CEVA","IN")] - COLOR IN KBADTAT { %CV("WF")_%CV("BB") } ; [%L1M1("CEVA","5")] - COLOR IN TEKUSHI KBADTAT { %CV("RF")_%CV("WB") } ; [%L1M1("CEVA","K")] - COLOR OF KBADRATA { %CV("WF")_%CV("YB") } ; [%L1M1("CEVA","N")] - COLOR OF NUMBER { %CV("RF")_%CV("GB") } ; [%L1M1("CEVA","Z")] - COLOR OF ZAGALOVKA { %CV("GF")_%CV("WB") } ; I '$D(%L1M1("CEVA",9)) X %chista ; OUTPUT : %L1M1("MIS") - # PUNKTA MENU, %I=%L1M1("MIS")+1 ; %L1M1("NAM") - NAZVANIE PUNKTA MENU S %L1M1("CEVA",8)=0 N Q:$D(@MAC)<10 N (%HBR,%ENG,%UPRCOD,%chista,%chists,%POSIC,%POSIC1,%OPT,%UPRCOD,%XCL,%XMSGV,%XMSG,%XMSGN,%CL0,%CLI,%CV,%CVET,%TYPCRT,%L1M1,MAC,@MAC,%I) ; RAZD) D ^%L1C K ^VRM2($J) W %HBR INIT ; S MENU(90)=$S(%XMSG(0)>1:"EXIT",1:"d`ivi") S %L1M1("MIS")=0 S %L1M1("VRT")=$G(%L1M1("VRT"),2) I %L1M1("VRT")<1 S %L1M1("VRT")=1 S %L1M1("DLST")=$S('$D(%L1M1("DLST")):4,%L1M1("DLST")>7:8,%L1M1("DLST")>5:6,1:4) S %L1M1("KOL")=$G(%L1M1("KOL"),$ZP(@MAC@(""))) I %L1M1("KOL")>(%L1M1("DLST")*3) S %L1M1("KOL")=%L1M1("DLST")*3 I %L1M1("KOL")>$ZP(@MAC@("")) S %L1M1("KOL")=$ZP(@MAC@("")) I %L1M1("VRT")+3+(%L1M1("KOL")-1+%L1M1("DLST")\%L1M1("DLST")*6)>23 S %L1M1("VRT")=20-(%L1M1("KOL")-1+%L1M1("DLST")\%L1M1("DLST")*6) S %LL=$S(%L1M1("DLST")=8:7,%L1M1("DLST")=6:9,1:15) S (MENU(0),%L1M1("MENU"))=$G(@MAC@(0),"") S I=%L1M1("CEVA",8) F S I=$O(@MAC@(I)) Q:I>(%L1M1("KOL")+%L1M1("CEVA",8))!(I="") D .;;S MENU(I-%L1M1("CEVA",8))=$S(%XMSG(0)'>1:$E(@MAC@(I),$L(@MAC@(I))-%LL+1,$L(@MAC@(I))),1:$E(@MAC@(I),1,%LL)) .S MENU(I-%L1M1("CEVA",8))=@MAC@(I) S %L1M1("KOL")=$ZP(MENU(25)) S %L1M1("CEVA",0)=$G(%L1M1("CEVA","F"),%CL0) S %L1M1("CEVA",1)=$G(%L1M1("CEVA","L"),%CV("WF")_%CV("BB")) S %L1M1("CEVA",2)=$G(%L1M1("CEVA","K"),%CV("WF")_%CV("YB")) S %L1M1("CEVA",3)=$G(%L1M1("CEVA","IN"),%CV("RF")_%CV("CB")) S %L1M1("CEVA",4)=%L1M1("CEVA",2) S %L1M1("CEVA",5)=$G(%L1M1("CEVA",5),%CV("RF")_%CV("WB")) S %L1M1("CEVA",6)=$G(%L1M1("CEVA","N"),$C(27,91)_"30;47m") S %L1M1("CEVA",7)=$G(%L1M1("CEVA","Z"),%CLI) I %TYPCRT["VT" F %I=0:1:7 S %L1M1("CEVA",%I)="" S V1=$C(179),KR=$C(197),UL=$C(218),UP=$C(191),V21=$C(209),V11=$C(193) S V12=$C(207),G1=$C(196),VV=$C(194),(%L1M1("RAZD"),RAZD)=$C(186) I %OPT=65 D .S V1=$C(124),KR=$C(110),UL=$C(108),UP=$C(107),V21=$C(119),V11=$C(118) .S V12=$C(118),G1=$C(113),VV=$C(119),(%L1M1("RAZD"),RAZD)=$C(124) D ^%L1MENUF G MI T I $ZP(@MAC@(""))>13 D ^%L2MENU Q K @MAC@(1) S %L1M1("CEVA",8)=1 G N MAIN ; D ^%L1MSGBR W *27,7,$C(27,91,63,50,53,108) W *27,7 U $P:(NOECHO:NOWRAP) ; F R *R:0 Q:R=-1 R *%KOD S SYM=$C(%KOD) W *27,8 I SYM'?1N K SYSY I SYM="^"!(%KOD=13) G END S ZB=$ZB R *R1:%WAIT G:R1=-1&(%TYPCRT["PC") ESC I R1>0 S ZB=$S(%KOD=0:0_R1,1:R1) R *R1:%WAIT I R1>0 S ZB=ZB_R1 I $D(%UPRCOD(ZB)),"ESC,VVERX,VNIZ,PRAVO,LEVO"[%UPRCOD(ZB) G @%UPRCOD(ZB) I SYM?1N S SYSY=$G(SYSY)_SYM G:SYSY>%L1M1("KOL") MA S %L1M1("MIS")=SYSY D D WR G POZIC .S LIN=%L1M1("VRT")+2+(SYSY-1\%L1M1("DLST")+1*6),%COL=SYSY#%L1M1("DLST") I SYSY=0 S LIN=LIN-6,%COL=1 .S:'$G(%COL) %COL=%L1M1("DLST") S:%XMSG(0)'>1 %COL=$L(^VRM2($J,LIN),RAZD)-1\2-%COL+1 S %COL=%COL*2 .I $L(SYSY)=2!(SYSY_0>%L1M1("KOL"))!(SYSY=0) K SYSY MA W *7 K SYSY G MAIN WR ; W *27,7 W:%CVET %L1M1("CEVA",3) W %L1M1("NAM") W %CL0 W *27,8 Q WRIN ; W *27,7 W *27,"[7m" W:%CVET %L1M1("CEVA",5) W %L1M1("NAM") W *27,"[0m" W *27,8 Q SET ; S %STR=$G(^VRM2($J,LIN)) S %L1M1("NAM")=$P(%STR,RAZD,%COL) Q POZIC ; D SET S TUR=1 F I=1:1:%COL-1 S TUR=$F(%STR,RAZD,TUR) W *27,"["_LIN_";"_TUR_"H" D WRIN ;;N LIN1 S LIN1=LIN N LIN S LIN=LIN1+1 D SET W *27,"["_LIN_";"_TUR_"H" D WRIN Q:$G(%L1M1("Q"))="Q" G MAIN Q MISP ; I %L1M1("MIS")>%L1M1("KOL") W *7 G MAIN I %L1M1("MIS")=0 S LIN=%L1M1("VRT")+2,%COL=2 D WR G POZIC D WR MI S:$G(%L1M1("FL"))="PR" %L1M1("MIS")=$S(%XMSG(0)'>1:%L1M1("MIS")-1,1:%L1M1("MIS")+1) S:$G(%L1M1("FL"))="LE" %L1M1("MIS")=$S(%XMSG(0)'>1:%L1M1("MIS")+1,1:%L1M1("MIS")-1) K %L1M1("FL") I %L1M1("MIS")=0 S LIN=%L1M1("VRT")+2,%COL=2 G POZIC S LIN=%L1M1("VRT")+2+(%L1M1("MIS")-1\%L1M1("DLST")+1*6),%COL=%L1M1("MIS")#%L1M1("DLST") S:'%COL %COL=%L1M1("DLST") S:%XMSG(0)'>1 %COL=$L(^VRM2($J,LIN),RAZD)-1\2-%COL+1 S %COL=%COL*2 G POZIC VVERX ; I %L1M1("MIS")=0 W *7 G MAIN S %L1M1("MIS")=%L1M1("MIS")-%L1M1("DLST") I %L1M1("MIS")<0 S %L1M1("MIS")=0 G MISP S LSTR=$L(%STR,RAZD)-1/2 I LSTR<%L1M1("DLST") S %L1M1("MIS")=%L1M1("MIS")+(%L1M1("DLST")-LSTR\2) G MISP VNIZ ; I %L1M1("MIS")=0 S %L1M1("MIS")=1 G MISP I '$D(^VRM2($J,%L1M1("MIS")+%L1M1("DLST")-1\%L1M1("DLST")*6+%L1M1("VRT")+8)) W *7 G MAIN S %L1M1("MIS")=%L1M1("MIS")+%L1M1("DLST") S LIN=LIN+6 D SET S LSTR=$L(%STR,RAZD)-1/2 S LIN=LIN-6 D SET S %L1M1("MIS")=%L1M1("MIS")-(%L1M1("DLST")-LSTR\2) I %L1M1("MIS")<(%L1M1("DLST")*(LIN-%L1M1("VRT")-2/6)+1) S %L1M1("MIS")=%L1M1("DLST")*(LIN-%L1M1("VRT")-2/6)+1 S:%L1M1("MIS")>%L1M1("KOL") %L1M1("MIS")=%L1M1("KOL") G MISP PRAVO ; I %L1M1("MIS")=0 S %L1M1("MIS")=$S(%XMSG(0)'>1:1,1:%L1M1("KOL")) G MISP S:%XMSG(0)'>1 %L1M1("MIS")=%L1M1("MIS")-1 S:%XMSG(0)>1 %L1M1("MIS")=%L1M1("MIS")+1 G MISP LEVO ; I %L1M1("MIS")=0 S %L1M1("MIS")=$S(%XMSG(0)'>1:%L1M1("KOL"),1:1) G MISP I %XMSG(0)'>1 S %L1M1("MIS")=%L1M1("MIS")+1 I %L1M1("MIS")>%L1M1("KOL") W *7 S %L1M1("MIS")=%L1M1("KOL") I %XMSG(0)>1 S %L1M1("MIS")=%L1M1("MIS")-1 G MISP ESC S %L1M1("NAM")="",%L1M1("MIS")=0,%I=1 END ; ; I '$D(%L1M1("CEVA",9)) X %chista S %I=%L1M1("MIS")+1 I $D(%ECHO) U $P:(ECHO:WRAP) W *27,"[24;1H" W *27,"[0J",$C(27,91,63,50,53,104) I %TYPCRT["VT" W *27,"(B" K ^VRM2($J) Q %L1MENU6 %L1MENU6 ; SUBROUTINE ( 6 ) %L1MENU1 [ 04/17/94 1:05 PM ] S %S00="35,28,22,15,9,2",%LL=9 VRM ; S %STR(1)=MENU(90),%VERT=%L1M1("VRT"),%SM=35 D ^%L1SHA ; 01 S %VERT=%L1M1("VRT")+6,%SM0=$P(%S00,",",$S(%L1M1("KOL")<7:%L1M1("KOL"),1:6)) ; 02 F NUM=1:1:$S(%L1M1("KOL")<7:%L1M1("KOL"),1:6) S %STR(1)=MENU(NUM),%SM=NUM-1*13+%SM0 D ^%L1SHA S %SM0=$P(%S00,",",$S(%L1M1("KOL")<13:%L1M1("KOL")-6,1:6)) ; 03 I %L1M1("KOL")>6 S %VERT=%L1M1("VRT")+12 F NUM=7:1:$S(%L1M1("KOL")<13:%L1M1("KOL"),1:12) S %STR(1)=MENU(NUM),%SM=NUM-7*13+%SM0 D ^%L1SHA S %SM0=$P(%S00,",",%L1M1("KOL")-12) ; 04 I %L1M1("KOL")>12 S %VERT=%L1M1("VRT")+18 F NUM=13:1:%L1M1("KOL") S %STR(1)=MENU(NUM),%SM=NUM-13*13+%SM0 D ^%L1SHA LIN ; S %VERT=%L1M1("VRT")+3,$E(^VRM2($J,%VERT),40)=V21 F I=%VERT+1:1:%L1M1("KOL")-1\6*6+%VERT+3 S:$D(^(I)) ^(I)=$E(^(I),1,39)_V1_$E(^(I),40,80) S $E(^(I),40)=V1 I %L1M1("KOL")#2=0 F I=I+1:1:I+3 S ^(I)=$E(^(I),1,39)_" "_$E(^(I),40,80) I %L1M1("KOL")>6 S $E(^(%VERT+2),8,72)=$TR($J(" ",72-7)," ",G1) I %L1M1("KOL")>12 S $E(^(%VERT+8),8,72)=$TR($J(" ",72-7)," ",G1) I %L1M1("KOL")#6'=1 D .S STA=$S(%L1M1("KOL")#6=2:34,%L1M1("KOL")#6=3:28,%L1M1("KOL")#6=4:21,%L1M1("KOL")#6=5:15,1:8) .S $E(^(%VERT+2+(%L1M1("KOL")-1\6*6)),STA,80-STA)=$TR($J(" ",81-STA-STA)," ",G1) S STR=1,%LIN=%VERT+2 S %KKL=%L1M1("KOL") S:%L1M1("KOL")>6 %KKL=6 D 6 I %L1M1("KOL")>6 D S STR=2,%LIN=%VERT+2+6 S %KKL=%L1M1("KOL")-6 S:%L1M1("KOL")>12 %KKL=6 D 6 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 I %L1M1("KOL")>12 D S STR=3,%LIN=%VERT+2+12 S %KKL=%L1M1("KOL")-12 D 6 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 Q 6 I %KKL=6 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),7)=UL,$E(^(%LIN),73)=UP .F I=20,33,47,60 S $E(^(%LIN),I)=VV .F I=7,20,33,47,60,73 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 5 I %KKL=5 D .S $E(^(%LIN),40)=KR ; ,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),14)=UL,$E(^(%LIN),66)=UP .F I=27,53 S $E(^(%LIN),I)=VV .F I=14,27,40,53,66 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 4 I %KKL=4 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),20)=UL,$E(^(%LIN),60)=UP .S $E(^(%LIN),33)=VV,$E(^(%LIN),47)=VV .F I=20,33,47,60 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 3 I %KKL=3 D .S $E(^(%LIN),40)=KR .S $E(^(%LIN),27)=UL,$E(^(%LIN),53)=UP .F I=27,40,53 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 2 I %KKL=2 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),33)=UL,$E(^(%LIN),47)=UP .F I=33,47 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 1 I %KKL=1 D .S $E(^(%LIN),40)=V1 .S $E(^(%LIN+1),40)=V1,$E(^(%LIN+2),40)=V12 Q %L1MENU8 %L1MENU8 ; SUBROUTINE %L1MENU1 [ 04/17/94 1:05 PM ] S %S00="36,30,27,21,18,12,9,3",%LL=7 VRM ; S %STR(1)=MENU(90),%VERT=%L1M1("VRT"),%SM=36 D ^%L1SHA ; 01 S %VERT=%L1M1("VRT")+6,%SM0=$P(%S00,",",$S(%L1M1("KOL")<9:%L1M1("KOL"),1:8)) ; 02 F NUM=1:1:$S(%L1M1("KOL")<9:%L1M1("KOL"),1:8) S %STR(1)=MENU(NUM),%SM=NUM-1*9+%SM0 D ^%L1SHA S %SM0=$P(%S00,",",$S(%L1M1("KOL")<17:%L1M1("KOL")-8,1:8)) ; 03 I %L1M1("KOL")>8 S %VERT=%L1M1("VRT")+12 F NUM=9:1:$S(%L1M1("KOL")<17:%L1M1("KOL"),1:16) S %STR(1)=MENU(NUM),%SM=NUM-9*9+%SM0 D ^%L1SHA S %SM0=$P(%S00,",",%L1M1("KOL")-16) ; 04 I %L1M1("KOL")>16 S %VERT=%L1M1("VRT")+18 F NUM=17:1:%L1M1("KOL") S %STR(1)=MENU(NUM),%SM=NUM-17*9+%SM0 D ^%L1SHA LIN ; S %VERT=%L1M1("VRT")+3,$E(^VRM2($J,%VERT),40)=V21 F I=%VERT+1:1:%L1M1("KOL")-1\8*6+%VERT+3 S:$D(^(I)) ^(I)=$E(^(I),1,38)_" "_V1_" "_$E(^(I),39,80) S $E(^(I),39,41)=" "_V1_" " I %L1M1("KOL")#2=0 F I=I+1:1:I+3 I $D(^(I)) S ^(I)=$E(^(I),1,38)_" "_$E(^(I),39,80) I %L1M1("KOL")>8 S $E(^(%VERT+2),8,72)=$TR($J(" ",72-7)," ",G1) I %L1M1("KOL")>16 S $E(^(%VERT+8),8,72)=$TR($J(" ",72-7)," ",G1) I %L1M1("KOL")#8'=1 D .S STA=$S(%L1M1("KOL")#8=2:34,%L1M1("KOL")#8=3:31,%L1M1("KOL")#8=4:25,%L1M1("KOL")#8=5:22,%L1M1("KOL")#8=6:16,%L1M1("KOL")#8=7:13,1:7) .S $E(^(%VERT+2+(%L1M1("KOL")-1\8*6)),STA,80-STA)=$TR($J(" ",81-STA-STA)," ",G1) S STR=1,%LIN=%VERT+2 S %KKL=%L1M1("KOL") S:%L1M1("KOL")>8 %KKL=8 D 8 I %L1M1("KOL")>8 D S STR=2,%LIN=%VERT+2+6 S %KKL=%L1M1("KOL")-8 S:%L1M1("KOL")>16 %KKL=8 D 8 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 I %L1M1("KOL")>16 D S STR=3,%LIN=%VERT+2+12 S %KKL=%L1M1("KOL")-16 D 8 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 Q 8 I %KKL=8 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),7)=UL,$E(^(%LIN),73)=UP .F I=16,25,34,46,55,64 S $E(^(%LIN),I)=VV .F I=7,16,25,34,46,55,64,73 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 7 I %KKL=7 D .S $E(^(%LIN),13)=UL,$E(^(%LIN),67)=UP .F I=22:9:58 S $E(^(%LIN),I)=VV .S $E(^(%LIN),40)=KR .F I=13:9:67 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 6 I %KKL=6 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),16)=UL,$E(^(%LIN),64)=UP .F I=25,34,46,55 S $E(^(%LIN),I)=VV .F I=16,25,34,46,55,64 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 5 I %KKL=5 D .S $E(^(%LIN),40)=KR ; ,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),22)=UL,$E(^(%LIN),58)=UP .F I=31,49 S $E(^(%LIN),I)=VV .F I=22:9:58 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 4 I %KKL=4 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),25)=UL,$E(^(%LIN),55)=UP .S $E(^(%LIN),34)=VV,$E(^(%LIN),46)=VV .F I=25,34,46,55 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 3 I %KKL=3 D .S $E(^(%LIN),40)=KR .S $E(^(%LIN),31)=UL,$E(^(%LIN),49)=UP .F I=31,40,49 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 2 I %KKL=2 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),34)=UL,$E(^(%LIN),46)=UP .F I=34,46 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 1 I %KKL=1 D .S $E(^(%LIN),40)=V1 .S $E(^(%LIN+1),40)=V1,$E(^(%LIN+2),40)=V12 Q %L1MENUF %L1MENUF ; [ 16.12.03 10:22 ] [ 14.12.03 16:44 ] [ 10.06.03 23:11 ] I '$D(%L1M1("PROG")) G BG I '$D(^menu(%L1M1("PROG"))) G BG S %NEQ=0 D G:%NEQ BG .N I F I=1:1 Q:'$D(@MAC@(I)) I @MAC@(I)'=$G(^menu(%L1M1("PROG"),"MM",I)) S %NEQ=1 Q I $D(^menu(%L1M1("PROG"),"VD",1)),%TYPCRT="PC" D D PUT^%VIDEO("%VD",0,0,80,24,2) G M .N I S %VD="" F I=1:1 Q:'$D(^(I)) S %VD=%VD_^(I) N N S N="" F S N=$O(^menu(%L1M1("PROG"),N)) Q:N="" Q:N'?1N.N W ^(N),! M S N="" F S N=$O(^menu(%L1M1("PROG"),N)) Q:N="" Q:N'?1N.N S ^VRM2($J,N)=^(N) D HB1 G STA BG N %STRMAX S %STRMAX=1 N %N S %N="" F S %N=$O(MENU(%N)) Q:%N="" I $L(MENU(%N))>%LL S %STRMAX=2 Q I %L1M1("DLST")=6 D ^%L1MENU6 D HEBR G STA I %L1M1("DLST")=8 D ^%L1MENU8 D HEBR G STA S %S00="32,22,12,2",%LL=15 VRM ; S %STR(1)=MENU(90),%VERT=%L1M1("VRT"),%SM=32 D ^%L1SHA ; 01 S %VERT=%L1M1("VRT")+6,%SM0=$P(%S00,",",$S(%L1M1("KOL")<5:%L1M1("KOL"),1:4)) ; 02 F NUM=1:1:$S(%L1M1("KOL")<5:%L1M1("KOL"),1:4) D STR(NUM,1) S %SM0=$P(%S00,",",$S(%L1M1("KOL")<9:%L1M1("KOL")-4,1:4)) ; 03 I %L1M1("KOL")>4 S %VERT=%L1M1("VRT")+12 F NUM=5:1:$S(%L1M1("KOL")<9:%L1M1("KOL"),1:8) D STR(NUM,5) S %SM0=$P(%S00,",",%L1M1("KOL")-8) ; 04 I %L1M1("KOL")>8 S %VERT=%L1M1("VRT")+18 F NUM=9:1:%L1M1("KOL") D STR(NUM,9) LIN ; S %VERT=%L1M1("VRT")+3,$E(^VRM2($J,%VERT),40)=V21 F I=%VERT+1:1:%L1M1("KOL")-1\4*6+%VERT+3 S $E(^(I),40)=V1 I %L1M1("KOL")>1 F I=$S(%L1M1("KOL")=2:30,%L1M1("KOL")=3:20,1:11):1:$S(%L1M1("KOL")=2:50,%L1M1("KOL")=3:60,1:69) S $E(^(%VERT+2),I)=G1 I %L1M1("KOL")>5 F I=$S(%L1M1("KOL")=6:30,%L1M1("KOL")=7:20,1:11):1:$S(%L1M1("KOL")=6:50,%L1M1("KOL")=7:60,1:69) S $E(^(%VERT+8),I)=G1 I %L1M1("KOL")>9 F I=$S(%L1M1("KOL")=10:30,%L1M1("KOL")=11:20,1:11):1:$S(%L1M1("KOL")=10:50,%L1M1("KOL")=11:60,1:69) S $E(^(%VERT+14),I)=G1 S STR=1,%LIN=%VERT+2 S %KKL=%L1M1("KOL") S:%L1M1("KOL")>4 %KKL=4 D 4 I %L1M1("KOL")>4 D S STR=2,%LIN=%VERT+2+6 S %KKL=%L1M1("KOL")-4 S:%L1M1("KOL")>8 %KKL=4 D 4 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 I %L1M1("KOL")>8 D S STR=3,%LIN=%VERT+2+12 S %KKL=%L1M1("KOL")-8 D 4 .S $E(^(%LIN),40)=KR,$E(^(%LIN+1),40)=V1 D HEBR G STA HEBR ; I %XMSG(0)'>1 D .F I=%L1M1("VRT")+8:6 Q:'$D(^VRM2($J,I)) D ..I $E(^(I),40)=$C(124) S $E(^(I),40)=$C(125) ..I %STRMAX>1 I $E(^(I+1),40)=$C(124) S $E(^(I+1),40)=$C(125) ..S DL=$L(^(I),RAZD) ..F I1=2:2:DL\2 D ...S AAA=$P(^(I),RAZD,I1) ...S $P(^(I),RAZD,I1)=$P(^(I),RAZD,DL+1-I1) ...S $P(^(I),RAZD,DL+1-I1)=AAA ...I %STRMAX>1 D ....S AAA=$P(^VRM2($J,I+1),RAZD,I1) ....S $P(^(I+1),RAZD,I1)=$P(^(I+1),RAZD,DL+1-I1) ....S $P(^(I+1),RAZD,DL+1-I1)=AAA ..I $E(^(I),40)=$C(125) S $E(^(I),40)=$C(124) ..I %STRMAX>1 I $E(^(I+1),40)=$C(125) S $E(^(I+1),40)=$C(124) NUM ; S X="I $E(^(I),I1)=V1,$E(^(I+3),I1)=C(205) S NUM=NUM+1,$E(^(I+3),I1-1,I1)=$TR($J(NUM,2),"" "",C(205)) ; ,I1=I1-1" S NUM=0 F I=%L1M1("VRT")+6:6 Q:'$D(^VRM2($J,I)) D I %CVET F I2=NUM:-1:NUM-%L1M1("DLST")+1 S RRR=I2_C(205) Q:^(I+3)'[RRR S ^(I+3)=$P(^(I+3),RRR)_%L1M1("CEVA",6)_I2_%L1M1("CEVA",2)_C(205)_$P(^(I+3),RRR,2) ; O 17 U 17 W !,^(I+3) R R C 17 .I %XMSG(0)'>1 F I1=80:-1:1 X X .I %XMSG(0)>1 F I1=1:1:80 X X S %L1M1("MIS")=$G(%L1M1("MIS"),0) TYPE ; S RAZD=%L1M1("RAZD") I '$D(%L1M1("CEVA",9)) X %chista D .N %M,%L,%I,%NP S %TIM=$ZD($H,"24:60") .S %AT="" .S %SAY=%AT_"++25,"_(77-(80-$L(%AT)\2))_",H,I" X %XMSG X %XCL .;;S %SAY=" ["_$$^%L1DC($H,1)_" "_%TIM_"]++25,"_(79-(80-$L(%AT)\2))_",E" X %XMSG S ($Y,$X)=1 W *27,"["_(%L1M1("VRT")+1)_";1H" W %HBR ;W:$D(MENU(0)) $J(MENU(0),80-$L(MENU(0))\2+$L(MENU(0))) W ! S I="" F S I=$O(^VRM2($J,I)) Q:I="" D W ! .I %TYPCRT["VT" W *27,"(0" D S:$E($G(^(I)),40)=$C(124) $E(^(I),40)=" " Q ..I ^(I)'[RAZD W ^(I) Q ..F I1=1:1:$L(^(I),RAZD) D ...I $L(^(I),RAZD)>2 W:%TYPCRT["VT" *27,"(B" W $P(^(I),RAZD,I1) W:%TYPCRT["VT" *27,"(0" ...I I1'=$L(^(I),RAZD) W $C(120) .I %CVET S TO=0 W %L1M1("CEVA",0) D W %L1M1("CEVA",0),$J(" ",80-II) Q ..F II=1:1:$L(^(I)) D W EXT S TO=TT ...S TT=0 S EXT=$E(^(I),II) I $A(EXT)>178 S TT=2 ...I TT=0 I TO=2!(TO=3) S TT=3 ...I $A(EXT)>185,$A(EXT)<189 S TT=$S(TO=0:2,TO=4:2,1:4) ...;--- I EXT=RAZD S TT=$S(TO=0:2,TO=1:2,1:1) ...I ",179,191,193,194,196,197,218,"[(","_$A(EXT)_",") S TT=1 ...I TO'=TT W %L1M1("CEVA",TT) .W ^(I) HB1 W:%TYPCRT["VT" *27,"(B" S %HBRY=1 W *27,"["_(%L1M1("VRT")-2)_";1H" S $X=1 W ?(81-$L(%L1M1("MENU"))\2),%L1M1("CEVA",7),%L1M1("MENU") X %XCL W %CL0 Q STA W:%TYPCRT["VT" *27,"(B" I $D(%L1M1("PROG")) D .N I F I=1:1 Q:'$D(@MAC@(I)) S ^menu(%L1M1("PROG"),"MM",I)=@MAC@(I) .S MAC1="^VRM2($J)",MAC2="^menu(%L1M1(""PROG""))" D ^%S1GC1 I %TYPCRT="PC",$D(%L1M1("PROG")) D GET^%VIDEO("%VD",0,0,80,24,2) D .N %VD1,I S %VD1="" F I=1:1 S ^menu(%L1M1("PROG"),"VD",I)=$E(%VD,1,255) S %VD=$E(%VD,256,4096) Q:%VD="" Q 4 I %KKL=4 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),10)=UL,$E(^(%LIN),70)=UP .S $E(^(%LIN),30)=VV,$E(^(%LIN),50)=VV .F I=10,30,50,70 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 3 I %KKL=3 D .S $E(^(%LIN),40)=KR .S $E(^(%LIN),20)=UL,$E(^(%LIN),60)=UP .F I=20,40,60 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 2 I %KKL=2 D .S $E(^(%LIN),40)=V11,$E(^(%LIN+1),40)=" " .S $E(^(%LIN),30)=UL,$E(^(%LIN),50)=UP .F I=30,50 S $E(^(%LIN+1),I)=V1,$E(^(%LIN+2),I)=V12 1 I %KKL=1 D .S $E(^(%LIN),40)=V1 .S $E(^(%LIN+1),40)=V1,$E(^(%LIN+2),40)=V12 Q STR(NUM,BG) ; N %CHAST,%FRAZA,%DLG,%STR,%I S %FRAZA=MENU(NUM),%DLG=%LL D DELG^%L1SCPC F %I=1:1:2 Q:'$D(%CHAST(1,%I)) S %STR(%I)=%CHAST(1,%I) I '$D(%STR(2)),%STRMAX=2 S %STR(2)="" S %SM=NUM-BG*20+%SM0 D ^%L1SHA Q %L1MODJ %L1MODJ ; [ 03.02.06 13:38 ] [ 01.02.06 20:14 ] [ 09/09/05 12:09 PM ] ;------------ INPUT : ; ^L1TRPRM("JOB") - JOB NUMBER\$P\$H\S-P-O-N ; ; ^L1TRPRM(JOB,"SRC" - GLOBALS / ROUTINS LIST FOR TRANSFER ; ^L1TRPRM(JOB,"G") - SIGN OF GLOBALS TRANSFER ; ^L1TRPRM(JOB,"PORT") - PORT NUMBER ; ^L1TRPRM(JOB,"XON") - XON COMMAND ; ^L1TRPRM(JOB,"PHONE") - PHONE NUMBER ; ^L1TRPRM(JOB,"LKH") - CLIENT CODE ; ^L1TRPRM(JOB,"LKH1") - CLIENT NAME ; ^L1TRPRM(JOB,"UCI") - PORT NUMBER ; MODEM ; O 253::2 E Q S ^%L1MODJ=$P($ZG,"/",$L($ZG,"/")) F H 2 D SEND Q:$G(^L1TRPRM("JOB"))="END" K ^%L1MODJ Q SEND ; Q:$D(^L1TRPRM("JOB")) S JOB="" F S JOB=$O(^L1TRPRM(JOB),-1) Q:JOB="" I JOB Q:$P($G(^L1TRPRM(JOB,"STAT")),"\")'="O" Q:JOB="" G SND SENDJ(JOB) ; SND ; D ^%L1C I $D(^L1TRPRM(JOB,"DTIME")),^("DTIME")<+$H_$TR($J($P($H,",",2),5)," ",0) Q S ^L1TRPRM("JOB")=JOB_"\P\"_$P($G(^L1TRPRM(JOB,"STAT")),"\",2)_"\"_$H_"\"_$G(^L1TRPRM(JOB,"UCI")) S ^L1TRPRM("JOBLAST")=JOB_"\"_$P_"\"_$H_"\"_$G(^L1TRPRM(JOB,"UCI")) ; S %L1TRG=$D(^L1TRPRM(JOB,"G")) I '%L1TRG K %L1TRG ; I %L1TRG D ; ^L1TRPRM(JOB,"SRC" --> ^UTILITY .K ^UTILITY($J) .I $D(^L1TRPRM(JOB,"REF")) M ^UTILITY($J)=^L1TRPRM(JOB,"REF") Q .; .N GLB,GLB1 .S N1="" F S GLB="^UTILITY($J,""",N1=$O(^L1TRPRM(JOB,"SRC",N1)) Q:N1="" D I $E(GLB,$L(GLB))'=")" S GLB=GLB_""")",@GLB="" ..S GLB=GLB_N1,GLB1=GLB ..S N2="",N2O=N2 F S N2=$O(^L1TRPRM(JOB,"SRC",N1,N2)) Q:N2="" D ...S GLB=GLB1 ...S N3="" F S N3=$O(^L1TRPRM(JOB,"SRC",N1,N2,N3)) Q:N3="" I N3=1 D Q ....S GLB=GLB_"("""""_^L1TRPRM(JOB,"SRC",N1,N2,N3,2)_""""")"")" S @GLB="" ; ; S USERPORT=$G(^L1TRPRM(JOB,"PORT")),USERGLOB="",INTR=0 I 'USERPORT D MSG(" ! mcen liaya uexr xcbed `l ") S ^L1TRPRM(JOB,"ER")="PORT" D ER G ENDM ; S MDPHONE=$G(^L1TRPRM(JOB,"PHONE")) I MDPHONE="" D MSG(" ! oetlh 'qn xcbed `l ") S ^L1TRPRM(JOB,"ER")="PHONE" D ER G ENDM ; S LKH=$G(^L1TRPRM(JOB,"LKH")) S LKH1=$G(^L1TRPRM(JOB,"LKH1")) S UCI=$G(^L1TRPRM(JOB,"UCI")) S MDXON=$G(^L1TRPRM(JOB,"XON")) S USERMOD=1,MDTRANS="" S PROG="%L2GTR1" I $D(^L1TRPRM(JOB,"PROG")) S PROG=^L1TRPRM(JOB,"PROG") S $P(^L1TRPRM(JOB,"STAT"),"\")="M" ; MU ; ; K ^GTR000($J) S $P(^L1TRPRM(JOB,"STAT"),"\")="D" K %L1RCV I '$D(^L1TRPRM(JOB,"DISPMSG")) S %L1RCV="" ; D ^%L1RCV(MDPHONE,USERPORT,MDXON,UCI,PROG,LKH,"^UTILITY($J)","",$G(^L1TRPRM(JOB,"PROGRCV"))) ; S $P(^L1TRPRM(JOB,"STAT"),"\")=$S($G(%L1MDOK):"O",1:"N") S $P(^L1TRPRM(JOB,"END"),"\")=$H K ^L1TRPRM("JOB") ; CL K ^UTILITY($J) ; ENDM K ^L1TRPRM("JOB") Q ; MSG(TXT) ; N IND S IND=$O(^L1TRPRM(JOB,"MSG",999999),-1)+1 S ^L1TRPRM(JOB,"MSG",IND)=TXT_" : "_$J_" %L1MODJ" Q:'$D(^L1TRPRM(JOB,"DISP")) U 0:(NOECHO:NOWRAP) D:'$D(%chists) ^%L1C W *7,*27,7,$C(27,91)_"1;1H",%chists,$C(27,91)_"1;"_(80-$L(TXT)\2)_"H"_%LIGHT1_TXT_" ",$C(27,91,48,109),*27,8 Q ER ; S $P(^L1TRPRM(JOB,"STAT"),"\")="N" S $P(^L1TRPRM(JOB,"END"),"\")=$H K ^L1TRPRM("JOB") Q %L1MODJ0 %L1MODJ ; [ 01.02.06 13:37 ] [ 01.02.04 14:07 ] [ 06/20/2002 12:52 PM ] ;------------ INPUT : ; ^L1TRPRM("JOB") - JOB NUMBER\$P\$H\S-P-O-N ; ; ^L1TRPRM(JOB,"SRC" - GLOBALS / ROUTINS LIST FOR TRANSFER ; ^L1TRPRM(JOB,"G") - SIGN OF GLOBALS TRANSFER ; ^L1TRPRM(JOB,"PORT") - PORT NUMBER ; ^L1TRPRM(JOB,"XON") - XON COMMAND ; ^L1TRPRM(JOB,"PHONE") - PHONE NUMBER ; ^L1TRPRM(JOB,"LKH") - CLIENT CODE ; ^L1TRPRM(JOB,"LKH1") - CLIENT NAME ; ^L1TRPRM(JOB,"UCI") - PORT NUMBER ; MODEM ; O 253::2 E Q S ^%L1MODJ=$$^%L1ZU(0) F H 2 D SEND Q:$G(^L1TRPRM("JOB"))="END" K ^%L1MODJ Q SEND ; Q:$D(^L1TRPRM("JOB")) S JOB="" F S JOB=$O(^L1TRPRM(JOB),-1) Q:JOB="" I JOB Q:$P($G(^L1TRPRM(JOB,"STAT")),"\")'="O" Q:JOB="" G SND SENDJ(JOB) ; SND ; I $D(^L1TRPRM(JOB,"DTIME")),^("DTIME")<+$H_$TR($J($P($H,",",2),5)," ",0) Q S ^L1TRPRM("JOB")=JOB_"\P\"_$P($G(^L1TRPRM(JOB,"STAT")),"\",2)_"\"_$H_"\"_$G(^L1TRPRM(JOB,"UCI")) S ^L1TRPRM("JOBLAST")=JOB_"\"_$P_"\"_$H_"\"_$G(^L1TRPRM(JOB,"UCI")) S %L1TRG=$D(^L1TRPRM(JOB,"G")) I '%L1TRG K %L1TRG ; I $D(^L1TRPRM(JOB,"G")) D ; ^L1TRPRM(JOB,"SRC" --> ^UTILITY .K ^UTILITY($J) .I $D(^L1TRPRM(JOB,"REF")) M ^UTILITY($J)=^L1TRPRM(JOB,"REF") Q .; .N GLB,GLB1 .S N1="" F S GLB="^UTILITY($J,""",N1=$O(^L1TRPRM(JOB,"SRC",N1)) Q:N1="" D I $E(GLB,$L(GLB))'=")" S GLB=GLB_""")",@GLB="" ..S GLB=GLB_N1,GLB1=GLB ..S N2="",N2O=N2 F S N2=$O(^L1TRPRM(JOB,"SRC",N1,N2)) Q:N2="" D ...S GLB=GLB1 ...S N3="" F S N3=$O(^L1TRPRM(JOB,"SRC",N1,N2,N3)) Q:N3="" I N3=1 D Q ....S GLB=GLB_"("""""_^L1TRPRM(JOB,"SRC",N1,N2,N3,2)_""""")"")" S @GLB="" ; S USERPORT=$G(^L1TRPRM(JOB,"PORT")),USERGLOB="",INTR=0 I 'USERPORT D MSG(" ! mcen liaya uexr xcbed `l ") S ^L1TRPRM(JOB,"ER")="PORT" D ER G ENDM S MDPHONE=$G(^L1TRPRM(JOB,"PHONE")) I 'MDPHONE D MSG(" ! oetlh 'qn xcbed `l ") S ^L1TRPRM(JOB,"ER")="PHONE" D ER G ENDM S LKH=$G(^L1TRPRM(JOB,"LKH")) S LKH1=$G(^L1TRPRM(JOB,"LKH1")) S UCI=$G(^L1TRPRM(JOB,"UCI")) I UCI="" D MSG(" ! UCI xcbed `l ") S ^L1TRPRM(JOB,"ER")="UCI" D ER G ENDM S MDXON=$G(^L1TRPRM(JOB,"XON")) S USERMOD=1,MDTRANS="" I $D(^L1TRPRM(JOB,"PROG")) S PROG=^L1TRPRM(JOB,"PROG") E I $D(%L1TRG) S PROG="%L2GTR1" E S PROG="%L2RCPRG" S MDMOD=1 S PORTN=USERPORT S MDTON="T" O PORTN::20 E D MSG(" ! qetz "_PORTN_" hxet ") G ENDM S US="O PORTN U PORTN:(0::::#001001:#800040:8::$C(13))" S $P(^L1TRPRM(JOB,"STAT"),"\")="M" ; ;--------- INIT D %L2MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,MDXON,$G(LKH1)) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER1" I $G(%L1MDOK)["INTR" S INTR=1 S OK=$G(%L1MDOK) I $G(OK)'=1 S ^L1TRPRM(JOB,"ER")="MD "_%L1MDOK G ER ; ;--------- SEND RECEIVE PROGRAM D CLPORT S:$G(UCI)="MEZ" UCI="MER" S SNDPR=UCI_":"_PROG_":160" D MSG("SEND : "_SNDPR) H 1 W $C(13) H 1 W SNDPR,$C(13) H 1 F I=1:1:3 R A:1 D MSG(A) I A["UCI" W $C(13) H 3 W SNDPR,$C(13) D MSG("SEND : "_SNDPR) H 1 ; I '$D(%L1TRG) D .K ^l1trprg M ^l1trprg=^L1TRPRM(JOB,"SRC") .K ^UTILITY($J) .S ^UTILITY($J,"l1trprg")="" ; K ^GTR000($P) S $P(^L1TRPRM(JOB,"STAT"),"\")="D" S %L1RCV="" D ^%L2GTR ; I $D(^%L1GTER) D G CL .M ^L1TRPRM(JOB,"L2G")=^L2G .S ^L1TRPRM(JOB,"ER")=^%L1GTER D ER ; K ^L2G I $D(^L1TRPRM(JOB,"PROGRCV")) D .N R S R=^("PROGRCV") S:$E(R)'="^" R="^"_R .S USERPORT=$G(^L1TRPRM(JOB,"PORT")) .D @R S $P(^L1TRPRM(JOB,"STAT"),"\")="O" S $P(^L1TRPRM(JOB,"END"),"\")=$H K ^L1TRPRM("JOB") ; CL D HANGUP K ^UTILITY($J) C:PORTN>3&(PORTN'=$P) PORTN ENDM K ^L1TRPRM("JOB") Q ; ER ; S $P(^L1TRPRM(JOB,"STAT"),"\")="N" S $P(^L1TRPRM(JOB,"END"),"\")=$H K ^L1TRPRM("JOB") Q ER1 S ^L1TRPRM(JOB,"ER")=$ZS D ER I $G(PORTN) C:PORTN>3&(PORTN'=$P) PORTN G ENDM ; %L2MD(PORTN,USERMOD,NUMBER,MDTONE,US,XON,MDLKH) ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,JOB,PORTN,USERMOD,NUMBER,MDTONE,MDLKH,%L1MDOK,US,XON,%DELAY,%L2MD) D ^%L1C S %L1MDOK=0,%L2MD="",%L1RCV="" N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERR^%L2MD" S PRT=%L3MYDVN K ^L1TRPRM(JOB,"MODEM") S ^L1TRPRM(JOB,"MODEM")="BEG" I $P=PORTN!'PORTN D MSG("CANNOT SELECT YOUR OWN DEVICE.") G EXIT C PORTN U $P:(CENABLE:CTRAP=$C(3)) O PORTN::0 E D MSG("..LINE IN USE..WAITING..") O PORTN D MSG("READY") X US D HANGUP X US INIT ; S %DC=0 S %DT=0,%Y="" P0 X US D CLPORT S %ST="AT&F"_$G(XON)_$C(13) D MSG(%ST) F %J=1:1:$L(%ST) W $E(%ST,%J) D DELAY P01 X US R *%Y1:1 E S %DC=%DC+1 G:%DC<12 P01:%DC#4,P0 D MSG("NO CARRIER") G EXIT G:%Y1=1 EXIT I %Y1'=13 S %Y=%Y_$C(%Y1) G P01 D MSG(%Y) S %DT=%DT+1 S ^L1TRPRM(JOB,"MODEM","ATZ",%DT)=%Y G:%Y1=1 EXIT I %Y'["OK" G:%DT<12 P01:%DT#4,P0 D MSG("NO CARRIER") G EXIT S %DT=0 I $G(NUMBER) D DELAY G TP1 TP1 X US S NUMBER=$TR(NUMBER,"-","") D CLPORT S ST="ATD"_$G(MDTONE,"P")_"W"_NUMBER_$C(13) W ST D MSG(ST) S TXT=%HBR_$$HBR^%L1FRM($G(MDLKH),30)_" "_$$HBR^%L1FRM(NUMBER,10)_%ENG D MSG(TXT) X US H 5 S OK=0 F I=1:1:60 R A:1 D Q:OK S ^L1TRPRM(JOB,"MODEM","CONN",I)=A D MSG(A) .I $F(A,"CONN") S OK=1 Q .I $F(A,"BUS") S OK=2 Q .I $F(A,"NO CAR") S OK=3 Q .I $F(A,"NO DIAL") S OK=4 Q I OK'=1 G EXIT I OK=1 K ^L1TRPRM(JOB,"MODEM") D MSG("MODEM IN USE !") S %L1MDOK=OK EXIT H 1 Q ERR S %L1MDOK=$ZS G EXIT HANGUP ; S %L1RCV="" D ^%L1DVRES(PORTN) O PORTN X US D HNG^%L1HANG("ATH0ZS0=0") Q CLPORT X US ; F I=1:1:%DELAY R *A:0 I A>0 F R *A:1 E Q Q DELAY ; F %JJJ=1:1:%DELAY Q MSG(TXT) ; N IND S IND=$O(^L1TRPRM(JOB,"MSG",999999),-1)+1 S ^L1TRPRM(JOB,"MSG",IND)=TXT_" : "_$J_" %L1MODJ" Q:'$D(^L1TRPRM(JOB,"DISP")) D ZU D:'$D(%HBR) ^%L1C W *7,*27,7,$$DLY(),%HBR,$C(27,91)_"1;1H"_$$DLY()_%chists_$$DLY()_$$DLY()_$C(27,91)_"1;"_(80-$L(TXT)\2)_"H"_%LIGHT1_TXT_" ",$$DLY(),$$DLY(),$C(27,91,48,109),*27,8 Q DLY() ; N JJJJ S DLY="" F JJJJ=1:1:10000 Q DLY HANGJ(PORTN) ; S US="O PORTN U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13,10))" C PORTN O PORTN X US D HNG^%L1HANG("ATH0Z"_$G(^PL("MDRING"),1)_$G(^PL("MDXON"))_$S($G(^PL("MDLOW")):"L1",1:"")) C PORTN Q ZU ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U ^[$$^%L1GLD]dev(1):(NOECHO:NOWRAP) Q %L1MOUSE %L1MOUSE ; [ 11/005/99 2:41 PM ] I '$$INIT^%L2MOUSE Q S %CX=7.9,%CY=7.67 I $$LIMITS^%L2MOUSE(2*%CX,44*%CX,4*%CY,22*%CY) I '$$SHOW^%L2MOUSE Q S %COL=$X+1,%ROW=$Y+1 S %PREV="",%PRESS=0 F D Q:$ZB(%PRESS,1,1) .S %CRD=$$REPORT^%L2MOUSE .I %CRD'=%PREV D ..S %XX=$P(%CRD,",")\%CX,%YY=$P(%CRD,",",2)\%CY X %POSIC ..S %PREV=%CRD ..S %PRESS=+$P(%CRD,",",3) %L1MRK %L1MRK(DUMP) ; [ 18.06.15 16:44 ] [ 14.03.10 14:02 ] [ 29.10.06 18:40 ] I $ZGBLDIR["/client." Q 0 I $G(^MERKAZ) Q ^MERKAZ ;;I $G(^[$$^%L1GLD]PLUK)["MLY",$G(^[^UCI("MLG")]STAT("MLY","EM","MRKZ")) Q ^("MRKZ") Q +$E($G(@$$^W4PRM@("ASH","MASOF")),1,7) ; NAME(MRK) ; Q:$G(MRK)="" "" Q $G(^MRKZ(MRK)) %L1MSF %L1MSF ; [ 24.06.04 02:48 ] [ 23.06.04 22:37 ] [ 21.06.04 17:38 ] [ N FL,A,GLD,I,N,PSD,%S D ^%L1C S GLD=$$^%L1GLD S I=0 S N="" F S N=$O(^[GLD]devi3(N)) Q:N="" D .S I=I+1,^TEMP($P,I)=N_"\"_$G(^[GLD]devi3(N)) ; SC S %SCRN="L1MSF" D ^%L1SC D IS3^%L1GET I %S=1 G SC I %S=0 G END K ^[GLD]devi3 F I=1:1 Q:'$D(^TEMP($P,I)) D .S PSD=$P(^(I),"\") Q:PSD="" .S ^[GLD]devi3(PSD)=$P(^TEMP($P,I),"\",2) END K ^TEMP($P) Q %L1MSG %L1MSG ; [ 04/25/99 4:48 PM ] [ 09/13/97 9:02 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) BG K D ^%L1C I %XMSG(0)'>1 S %HBRY="" S J=0 F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4),MM2(J)=$P(T,";",5) S MM(0)=" zerceda letih " S MAC="MM" D ^%L2MENU I %I=1 G END D @MM1(%I) G BG END Q ; MENU ; ;1; d ` i v i ; ;1; zerced oekcr;3; ;1; zerced uaew xevii;1; ;1; zeipkeza zerced ztlgd;2; ;1; zerced uaew zpirh;4; ;1;zerced zbvd;5; Q ; 1 D ^%L1MSGCR Q 2 D ^%L1MSGUP Q 3 D ^%L1MSGED Q 4 D ^%L1MSGLD Q 5 D ^%L1MSGPC Q %L1MSGBR %L1MSGBR ; [ 07.03.19 21:32 ] [ 20.08.07 11:43 ] [ 20.01.07 10:57 ] Q N $ZT S $ZT="ZG "_$ZL_":E^%L1MSGBR" N %RF S %RF=$R I '$D(%chists) D ^%L1C I $D(^msgbrd($P))#2 D K ^msgbrd($P) .N %MSG S %MSG=^msgbrd($P) .D:'$D(%HBR) ^%L1C .U $P:(NOECHO:NOWRAP) .W *7,*27,7,$$DLY,$C(27,91)_"1;1H"_$$DLY()_%chists_$$DLY()_$$DLY()_$C(27,91)_"1;"_(80-$L(%MSG)\2)_"H"_%CLI_" "_$TR($TR(%MSG,%TES1,%TES2),%TEN,%THB)_" ",$$DLY(),$$DLY(),$C(27,91,48,109),*27,8 .I $D(^msgbrd($P,"DLY")) H ^msgbrd($P,"DLY") I $D(@%RF) E Q DLY() ; Q "" %L1MSGCR %L1MSGCR ; [ 31.05.04 18:02 ] [ 08/24/2000 7:25 PM ] [ 07/30/99 4:46 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S KV="""" ;;S X(1)="I T[""%SAY=""!(T[""%GET="") X X(2)" S X(1)="I T?.E1L.E X X(2)" ;;S X(2)="F I1=2:2:30 S TXT=$P(T,KV,I1) I $L(TXT),TXT?.E1A.A.E X:'$D(^msg(""T"",TXT)) X(4),X(3) X:$D(^msg(""T"",TXT)) X(5)" S X(2)="N J,FLKV,FLKV1,FLKV2 S FLKV=0,FLKV2=0,TXT="""" F J=1:1:$L(T) S J1=J,FLKV1=0 X:$E(T,J1)=KV&'FLKV X(10) I 'FLKV1 S:$E(T,J1)=KV&FLKV&($E(T,J1+1)=KV) J=J+1 X:$E(T,J1)=KV&($E(T,J1+1)'=KV)&FLKV X(11) X:FLKV X(12)" ;;S X(2)="N J,FLKV,FLKV1,FLKV2 S FLKV=0,FLKV2=0,TXT="""",J1=0 F S J1=J1+1 Q:J1>$L(T) S FLKV1=0 X:$E(T,J1)=KV&'FLKV X(10) X:$E(T,J1)=KV&($E(T,J1-1)'=KV)&FLKV X(11) X:FLKV X(12)" S X(3)="I OK S IND=$O(^msg(""I"",99999),-1)+1,^msg(""I"",IND,1)=TXT,^msg(""T"",TXT)=IND" S X(4)="S OK=0 F I2=1:1:$L(TXT) I $A($E(TXT,I2))>96 S OK=1 Q" S X(5)="S IND=^msg(""T"",TXT) S ^msg(""I"",IND,PROG)=KV_KV,^msg(""R"",PROG,IND)=KV_KV" S X(10)="S FLKV=1,FLKV1=1,J1=J1+1" S X(12)="S TXT=TXT_$E(T,J1)" S X(11)="S FLKV=0,FLKV2=0 X X(111) S TXT=""""" S X(111)="I $L(TXT),TXT?.E1A.A.E X:'$D(^msg(""T"",TXT)) X(4),X(3) X:$D(^msg(""T"",TXT)) X(5)" ; X %chista S %SAY=" MESSAGES FILE CREATING " X %XMSGV S %FLG=0 K %DEV W !! N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER" Z U 0 W %ENG U $P:(ECHO:WRAP) K QUIT D INT^%RSEL I $D(QUIT) W:'%FLG !,"NO ROUTINES SELECTED" G EXIT S PROG="" C F S PROG=$O(^UTILITY($J,PROG)) Q:PROG="" D .X "ZL @PROG F I=1:1 Q:$T(+I)="""" S T=$T(+I) X X(1)" .W !?20,$J(PROG,8)," - PROCESSED" G Z EXIT Q ; ER ; I $F($ZS,"") W !,"ROUTINE: ",PROG," NOT FOUND." G C G Z VID ; ;---- INPUT : T , OUTPUT - TXT S KV="""" S X(10)="S FLKV=1,FLKV1=1" S X(12)="S TXT=TXT_$E(T,J)" S X(11)="S FLKV=0,FLKV2=0 W !,TXT S TXT=""""" N J S FLKV=0,FLKV2=0,TXT="" F J=1:1:$L(T) S J1=J,FLKV1=0 X:$E(T,J1)=KV&'FLKV X(10) I 'FLKV1 D .S:$E(T,J1)=KV&FLKV&($E(T,J1+1)=KV) J=J+1 .X:$E(T,J1)=KV&($E(T,J1+1)'=KV)&FLKV X(11) .X:FLKV X(12) D DEB Q DEB W !,"J=",J," ",$E(T,J)," "," FLKV=",FLKV," TXT=",TXT," ----- ",T H 1 Q %L1MSGED %L1MSGED ; [ 09/16/97 10:47 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S STRING="" D KOT Z S %XX=0,%YY=4 X %POSIC X:$G(%TO)'="PGUP"&($G(%TO)'="PGDW") %chiste S KV="""" S %SAY=" F10 - mebxiz `ll oey`x ,F9 - dpkez itl, F8 - zilbp`a, F6- zixara yetig " X %XMSGN D ZNMB K %L1GET I %TO="END" D Q .S %GET=" 99 - zerced oerzl " D N^%L1GET Q:%S'=99 .D ^%L1MSGLD I %TO="F6" D G Z .S %GET=" my zlgzd ++23,60,HH,,,C#++15,H,I" D ^%L1GET I %S=""!($G(%TO)="END") Q .N N K ^TEMP($P) .S N="" F S N=$O(^msg("I",N)) Q:N="" I $G(^(N,1))[%S S ^TEMP($P,N)="" .K %L1 S MAC="^TEMP($P)",%L1("EU")=2,%L1("BE")=6 .S %L1("TXT1")="$G(^msg(""I"",%NXN,1))<>60H\/%NXN<>4" .D ^%L1NU I FLAG="" S STRING=INDEX I %TO="F7" D G Z .S MAC="^msg(""I"")" .N N K ^TEMP($P) .K %L1 S %L1("EU")=2,%L1("BE")=6 .S %L1("TXT1")="$G(^msg(""I"",%NXN,1))<>60H\/%NXN<>4" .D ^%L1NU I FLAG="" S STRING=INDEX I %TO="F8" D G Z .S %GET=" my zlgzd ++23,60,HH,,,C#++15,E,I" D ^%L1GET I %S=""!($G(%TO)="END") Q .N N K ^TEMP($P) .S N="" F S N=$O(^msg("I",N)) Q:N="" I $G(^(N,0))[%S S ^TEMP($P,N)="" .K %L1 S MAC="^TEMP($P)",%L1("EU")=2,%L1("BE")=6 .S %L1("TXT1")="$G(^msg(""I"",%NXN,0))<>60\/%NXN<>4" .D ^%L1NU I FLAG="" S STRING=INDEX I %TO="F9" D G Z .;;S %GET=" dpkez my ++23,60,HH,,,C#++8,E,I" D ^%L1GET I %S=""!($G(%TO)="END") Q .;;S PROG=%S .S MAC="^msg(""R"")" .K %L1 S %L1("EU")=3,%L1("BE")=4,%L1("BE",3)=8 .S %L1("TXT1",2)="%NXN<>8" .S %L1("TXT1",3)="$G(^msg(""I"",%NXN,%XMSG(0)))<>60\/%NXN<>4" .D ^%L1NU I FLAG="" S STRING=INDEX I %TO="F10" D G Z .N N S N=$G(STRING) F S N=$O(^msg("I",N)) Q:N="" I $D(^msg("I",N,1)),'$D(^msg("I",N,0)) S STRING=N Q PGDN I %TO="PGDW" S (STRING,NMB)=$O(^msg("I",STRING)) D VIEW S %L1GET="" G Z I %TO="PGUP" S (STRING,NMB)=$O(^msg("I",STRING),-1) D VIEW S %L1GET="" G Z I %S'?1N.N W *7 G Z S (NMB,STRING)=%S D VSV S %SAY=" - zeipkeza drced bivdl " X %XMSGN K M S M(0)=$G(^msg("I",NMB,0)) S M(1)=$G(^msg("I",NMB,1)) HB S %INV="" K %L1WH S %S=M(1) D VHB D G:%TO="F9" HB G:%TO="PGUP"!(%TO="PGDW") PGDN G:%TO="END"!(%TO="UP") Z .I %TO="F9" D HZGP .N %TO K %INV S %L1WH="" D VHB K %L1WH S %S=$G(^msg("I",NMB,0)) EN S %INV="" K %L1WE S %S=M(0) D VEN D G:%TO="F9" EN G:%TO="END"!(%TO="UP")!(%TO="PGUP") HB .I %TO="F9" D HZGP .N %TO K %INV S %L1WE="" D VEN K %L1WE K %L1GET D IS2^%L1GET I YES F I=0,1 I $L($G(M(I))) S ^msg("I",NMB,I)=M(I) G Z VHB ; S %X1=2,%X2=77,%Y1=7,%Y2=6 D ^%L1WH I '$D(%L1GET),$L(%S) S M(1)=%S Q VEN ; S %X1=2,%X2=77,%Y1=12,%Y2=6 D ^%L1WE I '$D(%L1GET),$L(%S) S M(0)=%S Q VIEW ; N %TO,%L1GET,%S S %L1GET="",STRING=NMB D KOT,ZNMB,VSV Q VSV ; Q:'$G(NMB) N %TO I $D(^msg("I",NMB)) D I $L(LISTP) S %SAY=LISTP_"++14,4,EE" X %XMSG .S LISTP="" S N="" F S N=$O(^msg("I",NMB,N)) Q:N="" I N'?1N.N S LISTP=LISTP_N_"," .I $E(LISTP,$L(LISTP))="," S LISTP=$E(LISTP,1,$L(LISTP)-1) S %SAY=" : drced++5,78,HH" X %XMSG S %SAY="MESSAGE : ++10,1,EE" X %XMSG D TV^%L1RBUA(7,1,9,79) D TV^%L1RBUA(12,1,14,79) S %L1WH="",%L1WE="" N %INV S %S=$G(^msg("I",NMB,1)) D VHB S %S=$G(^msg("I",NMB,0)) D VEN Q KOT N %INV X %chista S %SAY=" zerced oekcr / zbvd " X %XMSGV Q ZNMB S %GET=" drced xtqn++3,70,HH#"_$G(STRING)_"++4,E,I" D ^%L1GET Q HZGP ; K ^TMPS111($J) N I S I=0 N N,J S N="A" F S N=$O(^msg("I",NMB,N)) Q:N="" I N'?1N.N D .X "ZR ZL @N F J=1:1 Q:$T(+J)="""" I $T(+J)[(KV_^msg(""I"",NMB,1)_KV)!($T(+J)[(""^m(""_NMB_"")"")) S I=I+1,^TMPS111($J,I)=""<<""_N_""+""_J_"">>"",I=I+1,^TMPS111($J,I)=$T(+J)" S %S2V("VGR")=16,%S2V("TXT1")=" - z`vl ",%S2V("IND")=1 S %S2V("PROG")="ED^%L1MSGED" D ^%S2VIEW N %TO S %L1GET="",STRING=NMB D VIEW K %L1GET Q ED ; N INDEX S INDEX=$G(@$R) Q:$E(INDEX,1,2)'="<<" S %PR=$P($P(INDEX,"<<",2),"+"),U=+$P($P(INDEX,"<<",2),"+",2) S %L1ER="",%FLI=1 X ^%ERG(2) K %L1ER Q %L1MSGLD %L1MSGLD ; ^msg("I") --> ^m [ 09/17/97 10:07 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %SAY=" MESSAGE SET LOADING " X %XMSGV Z S %GET=" ENGLISH - 0, HEBREW -1 ++10,20,EE#++1,E,I++10" D ^%L1GET Q:%S=""!(%TO="END") D LD(%S) Q ; LD(%S) K ^m S N="" F S N=$O(^msg("I",N)) Q:N="" I N?1N.N S ^m(N)=$G(^msg("I",N,%S),"*** <"_N_">") S %GET=$S(%S=1:"HEBREW",1:"ENGLISH")_" MESSAGE SET LOAD... " D NE^%L1GET Q %L1MSGPC %L1MSGPC ; [ 04/25/99 4:41 PM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C D ^%L1C X %chista S %SAY=" WAIT ... ++10,35,EE" X %XMSG K ^TMPS111($J) S N="",I=0 F S N=$O(^msg("I",N)) Q:N="" D .S I=I+1,^TMPS111($J,I)=$J($G(^msg("I",N,1)),70)_"."_$J(N,3) .S ^TMPS111($J,I+1)=$J($G(^msg("I",N,0)),70) .S ^TMPS111($J,I+2)="" .s I=I+2 S %S2V("PRINT")="" D ^%S2VIEW %L1MSGUP %L1MSGUP ; HEBREW TEXT -> ^m [ 31.05.04 18:02 ] [ 08/24/2000 6:23 PM ] [ 07/30/99 4:55 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) ; Z D ^%L1C U 0 X %chista S %SAY=" PROGRAMM MESSAGES UPDATING " X %XMSGV W %ENG U $P:(ECHO:WRAP) S %FLG=0 K QUIT D INT^%RSEL I $D(QUIT) W:'%FLG !,"NO ROUTINES SELECTED" G EXIT S PROG="" C F S PROG=$O(^UTILITY($J,PROG)) Q:PROG="" D Q:END .S END=0 X "K ^S000($P) ZL @PROG F I=1:1 Q:$T(+I)="""" S T=$T(+I) S ^S000($P,I)=T" .F I=1:1 Q:'$D(^S000($P,I)) S A=^(I) D Q:END ..S N="",UPD=0 F S N=$O(^msg("R",PROG,N)) Q:N="" S T=$G(^msg("I",N,1)) I $L(T) D Q:END ...I $F(A,$$SOGR(T)) S UPD=1 D UPD ..I UPD W !,A,!,$TR($J("",60)," ","-") S ^S000($P,I)=A .Q:END .S PROG1=$C($A(PROG)+32)_$E(PROG,2,8) .W !,"SAVE "_PROG1_" ? (Y/N) " R SV Q:"YyFkh"'[SV .W " - SAVED",! .X "ZR X ""F I=1:1 Q:'$D(^S000($P,I)) ZI ^S000($P,I)"" ZS @PROG1" G Z EXIT K ^S000($P) Q ; UPD ; S P=0 UPDC ; S P=$F(A,""""_$$SOGR(T)_"""",P) I 'P Q S T1="^m("_N_")" S UPD=1 W !,"<< "_PROG_"+"_(I-1)_" >>",%HBR,!,A,! S B=$E(A,1,P-3-$L($$SOGR(T)))_T1_$E(A,P,255) W B R !,"UPDATE ? (Y/N/.) ",OTB S:OTB="" OTB="Y" I OTB="."!(OTB="Q")!(OTB="^")!(OTB="q")!(OTB="u") S END=1 Q I OTB'="Y",OTB'="y",OTB'="h",OTB'="k" G UPDC S A=B S P=P-$L($$SOGR(T))+$L(T1)+1 G UPDC Q SOGR(T) ; N J,T1 S T1="" F J=1:1:$L(T) D .I $E(T,J)="""" S T1=T1_"""""" Q .S T1=T1_$E(T,J) Q T1 %L1MSMOP %MSMOPS ;DJM;MSM EMULATED FUNCTIONS; [ 12/27/98 10:39 AM ] [ 12/16/98 9:22 AM ] [ 11/11/98 5:42 AM ] ;Copyright Micronetics Design Corp. @1992 ; LICINFO() S %AAA=$$^%L1ZOS(2,"LICENSE.MSM") Q "212134^4^8^16^57555^16^16^16^^MFTU^RESHED" ;;LICINFO() Q "1212^32^8^9^58012^0^2^1^^LEV^RESHED^" ; ZH(job) ;cputime^log DB reads^phys DB reads^logical DB writes^InChars^OutChars %L1MUMPS %L1MUMPS ; [ 04/20/92 4:46 PM ] [ O 51:("MSM0.EXE") O 54:("MSM1.EXE":"W") S I=0,J=0,OK=0,B="" F U 51 R *A Q:$ZC<0 D I OK,$L(B) U 54 W B S B="",OK=0,I=0 .I $C(A)'="M" S B=$C(A),OK=1,J=J+1 U 0 W:'(J#1000) "." Q .S B=$C(A) F I=1:1:9 U 51 R *A Q:$ZC<0 S B=B_$C(A),J=J+1 .I B="MSM-PC/386" S B="MUMPS L-PC" .S OK=1 U 0 I '(J#1000) W "." I $L(B) U 54 W B C 51,54 %L1MYADR %L1MYADR(STAM) ; [ 02.12.05 16:30 ] [ N ZR S ZR=$ZROU N ZG S ZG=$ZGBLDIR S $ZROU=^UCI("MLR") S $ZGBLDIR=^UCI("MLG") N ADDR S ADDR=$$IP^L2YZCH($$^%L1MRK) S $ZROU=ZR S $ZGBLDIR=ZG Q ADDR %L1N2W %L1N2W(%NMB) ; INTEGER NUMBER TO WORD [ 10.06.01 6:51 PM ] [ 30.05.01 2:16 PM ] [ 07.05.01 9:55 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%NMB) D ^%L1C F I=1:1 S T=$T(N1+I) Q:T="" Q:T["Q ;" S N1($P(T,";",2))=$P(T,";",3),N11($P(T,";",2))=$P(T,";",4) F I=1:1 S T=$T(N2+I) Q:T="" Q:T["Q ;" S N2($P(T,";",2))=$P(T,";",3) F I=1:1 S T=$T(N3+I) Q:T="" Q:T["Q ;" S N3($P(T,";",2))=$P(T,";",3) F I=1:1 S T=$T(N5+I) Q:T="" Q:T["Q ;" S N5($P(T,";",2))=$P(T,";",3) I $L(%NMB)=1 Q $G(N1(%NMB)) I $L(%NMB)=2 Q $$M2(%NMB) I $L(%NMB)=3 Q $$M2($E(%NMB,2,3))_" "_$$M3($E(%NMB)) I $L(%NMB)=4 Q $$M2($E(%NMB,3,4))_" "_$$M3($E(%NMB,2))_" "_$$M4($E(%NMB)) I $L(%NMB)=5 Q $$M2($E(%NMB,4,5))_" "_$$M3($E(%NMB,3))_" "_$S($E(%NMB,1,2)="10":"mitl` zxyr",1:"sl` "_$$M2($E(%NMB,1,2))) I $L(%NMB)=6 Q $$M2($E(%NMB,5,6))_" "_$$M3($E(%NMB,4))_" "_"sl` "_$$M2($E(%NMB,2,3))_$S($E(%NMB,2,3)=10:"e",1:"")_" "_$$M3($E(%NMB)) Q "" M2(%NMB) ; I $E(%NMB)=0 Q:$E(%NMB,2)=0 "" S %O=N1($E(%NMB,2))_"e" Q %O I $E(%NMB)=1 S %O=N2($E(%NMB,1,2)) Q %O I $E(%NMB,2)=0 S %O=N3($E(%NMB,1)) Q %O S %O=$G(N1($E(%NMB,2)))_"e "_$G(N3($E(%NMB))) Q %O M3(%NMB) ; I $E(%NMB)=0 Q "" I $E(%NMB)=1 Q "d`n" I $E(%NMB)=2 Q "miiz`n" Q "ze`n "_N11($E(%NMB)) M4(%NMB) ; Q N5($E(%NMB)) N1 ; ;1;cg`;zg` ;2;miipy;miizy; ;3;dyely;yely; ;4;drax`;rax`; ;5;dying;yng; ;6;dyy;yy; ;7;dray;ray; ;8;dpeny;dpeny; ;9;dryz;ryz; Q ; N2 ; ;10;dxyr;xyr; ;11;xyr cg`;dxyr cg`; ;12;xyr mipy;dxyr mizy; ;13;xyr dyely;dxyr yely; ;14;xyr drax`;dxyr rax`; ;15;xyr dying;dxyr yng; ;16;xyr dyy;dxyr yy; ;17;xyr dray;dxyr ray; ;18;xyr dpeny;dxyr dpeny; ;19;xyr dryz;dxyr ryz; Q ; N3 ; ;2;mixyr; ;3;miyely; ;4;mirax`; ;5;miying; ;6;miyiy ;7;miray; ;8;mipeny; ;9;miryz; Q ; N4 ; ;1;d`n; ;2;miiz`n; Q ; N5 ; ;1;sl`; ;2;miitl`; ;3;mitl` zyely; ;4;mitl` zrax`; ;5;mitl` zyng; ;6;mitl` zyy; ;7;mitl` zray; ;8;mitl` zpeny; ;9;mitl` zryz; Q ; %L1NH %L1NH ;HELP %L1NU [ 12/27/97 1:32 PM ] [ 07/05/96 4:59 AM ] ;INPUT PARAMETERS: NAME GLOBAL WITH INDEX (MAC) ; %L1("EU") - LAST LEVEL (DEFAULT - 99) ; = 98 ; %L1("REV") - SHOW INDEXES IN REVERS ; %L1("PRINT") - ASK : "PRINT - 99" ; %L1NPRNT("SM") - SHIFT FROM LEFT WHEN PRINT ; %L1("DO") - MUMPS COMMAND FOR EXECUTION AFTER CHOICE ; %L1("DO",VARIAB)=... - PARAMETERS FOR %L1("DO") ; %L1("IND") - CURSOR NA STROKE %L1("IND") ; ; %L1("BE",%UROV) - WINDOW TOP (DFLT - 0) ; %L1("LEFT") - WINDOW LEFT BOUNDARY (DFLT - CENTR) ; %L1("WD") - WINDOW WIDTH ; ; %L1("TX",%UROV)- TEXT IN BEG LINE( ---------- ) ; %L1("TXT1",%UROV)- TEXT OF LINE $P(...)<>4,1,H\/.... ; %L1("TXT",%UROV) - COMMAND MUMPS FOR TYPE TEXT ; ; %L1("T1",%UROV) - HEADER TEXT ; %L1("T2",%UROV) - COMMAND FOR TYPE HEADER ; %L1("T3",%UROV) - COMMAND FOR TYPE HEADER (PRINT) ; ; %L1("CD") - CODE TYPE FLAG (NO DEF-LAST. LEVEL.; "" - IND1+IND2+...," " - NO TYPE IND.,"I" - INDEX ONLY) ; %L1("SS",%UROV)- DELIMITER ; %L1("NR",%UROV) - NUMBER POLE SS ( ---""--- - 1) ; ; %L1("SET",%UROV) - COMMAND MUMPS FOR INIT VALUE ; %L1("US0",%UROV) - ---"--- ; %L1("US",%UROV) - ---"--- FOR CHOOSE MENU (%NXN - INDEX,%NXS - DATA ; %L1("US1",%UROV) - ---"---,AFTER INPUT NUMBER IN MENU ; %L1("FIRST",%UROV) - START VALUE FOR MENU ; %L1("LAST",%UROV) - USL END MENU ; ; %L1("BU",%UROV) - NUMBER START LEVEL ; %L1(1) - IF 1 NOAD IN MENU -> NEXT LEVEL ; %L1(",") - MUCH NUMBERS FOR CHOOSE ; %L1("NOM",%UROV) - IF DEF,NO TYPE LINES NUMBERS ; %L1("ND") - IF DEF - NO PRINT "NO DATA" ; %L1("LOOK") - VIEW ONLY ; %L1NPRNT("PORT") - PORT NUMBER FOR PRINTER ; ;OUTPUT - FULL REF (MAC) ; OR ARRAY INDEX %MM ; INDEX ( LAST IN MAC) ; FLAG (FLAG) %L1NMB %L1NMB(STAM) ; [ 27.03.08 07:53 ] [ 26.03.08 16:07 ] [ 21.08.07 07:54 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%NMB,%BEG,screen,%L1NMB,%MBG,%PRKB,%ZMSL) D ^%L1C U $P:(NOECHO:NOWRAP:CENABLE:CTRAP=$C(3)) K %ZMSL("NMB") S YY0=$G(%L1NMB("ZY"),$Y) S:'$D(%PRKB) %PRKB=0 S %W=0 I $G(%PRKB) S %W=.1 BG00 S (%C0,%C00)="" BG0 ; BG ;;R *%C:0 S %PRKB=1 G:$T 27 E H %W R *%C:0 S:$T %PRKB=1 G:$T 27 S %L1NMB("X0")=0,%L1NMB("Y0")=0,%L1NMB("X2")=80,%L1NMB("Y2")=25 I $G(%BEG)=1 D GET^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) S %BEG=2 I $D(^kb($P)),'$D(%L1NMB("MTXT")) D IN1 W $C(27,91),"?25l" D VIEWRB G READ D IN D VIEWRB S %TO="",%KB=0 S LINE=%NMB-.1\COLX+1,COL=%NMB-.1#COLX+.1 W $C(27,91),"?25l" I LINE,COL D TXT($G(MTXT(LINE,COL)),LINE,COL,1) READ0 S LINE1=LINE,COL1=COL READ ; ;;D ^%L1MSGBR I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %MOUSE S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I %CRD,%TO'="KB" D G:%KB=2 BG G:'$D(MTXT(LINE,COL)) READ1 G:$D(MTXT(LINE,COL,"DIS")) READ1 S %TO=$G(MTXT(LINE,COL,"C")) G END .S %PRKB=0 .S %XX=$P(%CRD,",",1),%YY=$P(%CRD,",",2) .S COL=%XX-X0+$G(^SMXX(%L3MYDVN))\STEPX+1,LINE=%YY-Y0+$G(^SMXY(%L3MYDVN))\STEPY+1 .I $D(MTXT(LINE,COL,"DIS")) Q .I '$D(MTXT(LINE,COL)),$D(^kb($P)) D Q ..S ^kb($P)=%XX_"\"_%YY,%KB=2 D PUT .I $G(COL1),$G(LINE1),$D(MTXT(LINE1,COL1)) D TXT($G(MTXT(LINE1,COL1)),LINE1,COL1,0) .I $G(LINE),$G(COL),$D(MTXT(LINE,COL)) D TXT($G(MTXT(LINE,COL)),LINE,COL,1) .S LINE1=LINE,COL1=COL READ1 I %TO="KB" S %TO="" I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 U $P:(NOECHO:NOWRAP) R *%C:0 E H .02 R *%C:0 G:'$T READ I %C'=13,%C'=10 S %PRKB=1 ;;I %C=32!(%C>47&(%C<58))!(%C>96&(%C<122)) S %PRKB=1 27 I %C=27 D DELAY R *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)) X "N %CC F R *%CC:0 E Q" G:$T(@%UPRCOD(C))="" TO K %FLL G @%UPRCOD(C) .S C="" Q:%C1=27 D DELAY R *%C2:%WAIT Q:%C2=27 S:%C2>0 C=%C1_%C2 Q:%C2<0 Q:$D(%UPRCOD(C)) .R *%C3:%WAIT Q:%C3=27 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) Q:%C3<0 .R *%C4:%WAIT Q:%C4=27 S:%C4>0 C=C_%C4 I $G(%C1)=27 S %C=27 K %C1 G 27 I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %C=27 G 27 ;;I %C=27 G ESC I %C=0 S %TO="" D DELAY R *%C1:%WAIT D DELAY R *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) I %C=13!(%C=10) S %TO=$G(MTXT(LINE,COL,"C"),"ENTER") G END I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) BD ; I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))="" S %TO=%UPRCOD(%C) G END I $C(%C)="=" S %TO=$C(%C) G END S %TO=$TR($C(%C),%TES2,%TES1) I $C(%C)="." S %TO=$C(%C) I $C(%C)="/" S %TO=$C(%C) G END TO K %FLL S %TO=%UPRCOD(C) G END TXT(%FRAZA,LINE,COL,INV) ; S:COL<1 COL=1 S:COL>COLX COL=COLX S:LINE<1 LINE=1 S:LINE>COLY LINE=COLY N %XX,%YY,%DLG,%I,%CHAST S %FRAZA=$TR($TR(%FRAZA,%TES1,%TES2),%TEN,%THB) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) S %DLG=STEPX-2 D DELG^%L1SCPC I '$G(INV) X %LIGHT I $G(INV),'$D(MTXT(LINE,COL,"DIS")) W %CV("WB"),%CV("RF") I '$G(INV) W %L1RBCL,%CV("YF") I $D(MTXT(LINE,COL,"DIS")) W %CV("RF") S %YY=Y0+(LINE-1*STEPY) S %XX=X0+(COL-1*STEPX)+1 I '$D(%L1NMB("HZM")),'$D(%L1NMB("LINE")),'$D(%L1NMB("HIST")) S:$L(%FRAZA)>4 %XX=%XX-1 X %POSIC W $S($L(%FRAZA)<3:" "_%FRAZA_" ",1:%FRAZA) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) N %I F %I=1:1 Q:'$D(%CHAST(1,%I)) D .I %I=2,$E(%CHAST(1,%I))=" ",$E(%CHAST(1,1),$L(%CHAST(1,1)))=" " S %CHAST(1,%I)=$E(%CHAST(1,%I),2,255)_" " .X %POSIC W %CHAST(1,%I) S %YY=%YY+1 X %XCL Q VNIZ ; D CLCDN S:'$D(COLY) COLY=1 I '$D(LINE) S %TO="VNIZ" G END I LINE+1>COLY S %TO="VNIZ" G END I COLY=1 S %TO="VNIZ" G END S %PRKB=0 I '$D(MTXT(LINE+1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 VVERX ; D CLCDN I '$D(COLY) S COLY=1 I '$D(LINE) S %TO="VVERX" G END I LINE<2 S %TO="VVERX" G END I COLY=1 S %TO="VVERX" G END S %PRKB=0 I '$D(MTXT(LINE-1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 PRAVO ; I '$D(COLX) S COLX=1 I COLX=1 S %TO="PRAVO" G END I '$D(COL) S %TO="PRAVO" G END I COL+1>COLX S %TO="PRAVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL+1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 LEVO ; I '$D(COLX) S COLX=1 I '$D(COL) S %TO="LEVO" G END I COL<2 S %TO="LEVO" G END I COLX=1 S %TO="LEVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL-1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 ;ENTER S %TO="" G END END ; I '$D(%TO) S %TO="" ; ;;I %TO="SHIFT" D G READ .x %chista D PUT .I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=1 D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q .K %L1NMB("ALB") D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q ; I %TO="KB" S %KB='%KB D G READ .I %KB D Q ..X %chista D PUT ..D IN1,VIEWRB ..S ^kb($P)="" .; - '%KB .x %chista D PUT .D IN,VIEWRB .K ^kb($P) ; I $G(%C2)=27!($G(%C3)=27)!($G(%C4)=27) S C2=27 K %C2,%C3,%C4 U $P:(NOECHO:NOWRAP) W $C(27,91),"?25h" I $D(LINE),$D(COLX),$D(COL) S %NMB=LINE-1*COLX+COL ;;,%ZMSL("NMB")=%NMB I $G(%L1NMB("ALB"))'=1,%TO="," Q %TO I $G(%L1NMB("ALB"))'=1,%TO="'" Q %TO I %TO'=".",%TO'="/" Q $TR(%TO,%TES1,%TES2) I %TO="." Q "." I %TO="/" Q "/" ESC S %TO="ESC" G END ; Q VIEWRB ; I $D(%L1NMB("MTXT")) D VIEWMTXT Q N I,J F I=Y0:STEPY:Y2-STEPY F J=X0:STEPX:X2-STEPX D D TV^%L1RBUA(I,J,I+STEPY,J+STEPX) .W %LIGHT1 W %CV("CF") S I=0 F I=1:1:COLY F J=1:1:COLX D .D TXT($G(MTXT(I,J)),I,J,0) .I $G(MTXT(I,J,"C"))=$G(MTXT(I+1,J,"C")) D ..W %CV("MB") W %LIGHT1 W %CV("CF") ..S %YY=Y0+(STEPY*I-1),%XX=X0+(STEPX*(J-1)-1) X %POSIC D VLIN W $J("",STEPX-1) D VLIN Q VLIN ; I %TYPCRT["PC" W $C(179) Q I %TYPCRT["VT5" W $C(27)_"(0"_$C(120)_$C(27),"(B" Q W "|" Q IN ; S %L1RBCL=%CV("MB") S %PREV="" S STEPY=2,STEPX=6 S COLY=3,COLX=10 I $D(%L1NMB("ALB")) S COLY=5,STEPY=2 I $D(%L1NMB("HZM")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("LINE")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("HIST")) S COLY=1,STEPX=10,STEPY=3 I $D(%L1NMB("VIEW")) S COLY=1,STEPX=12,STEPY=2 S:'$D(COL1) COL1=1 S:'$D(LINE1) LINE1=1 S:'$D(%NMB) %NMB=1 S Y0=$S($G(YY0)>12:2,1:14) I $D(%L1NMB("ALB")),$D(%L1NMB("ALB","Y0")) S Y0=%L1NMB("ALB","Y0") S X0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) N %L1INIT S %L1INIT="" S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE ; I $D(%L1NMB("VIEW")) K MTXT D Q .S Y0=23,X0=8 S MTXT("MIN")=1 .N I,J,T,T1 F I=1:1 S T=$T(TEXT6+I),T1=$T(TEXT7+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("HZM")) K MTXT D Q .S Y0=22,X0=0 S MTXT(1,1,"DEF")="" .N I,J,T,T1 F I=1:1 S T=$T(TEXT4+I),T1=$T(TEXT5+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("LINE")) K MTXT D Q .S Y0=21 .N I,J,T,T1 S I=1,T=$T(TEXT8+I),T1=$T(TEXT9+I) D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .I '$D(%MBG("MIUN")) S MTXT(1,8,"DIS")="" .I '$D(%MBG("MOVE")) S MTXT(1,9,"DIS")="" .I $D(%MBG("DELAS")) S MTXT(1,6,"DIS")="" .S I=2 .S X0=80-(($L(T,";")-2)*(STEPX))\2 .D PRMXY ; I $D(%L1NMB("HIST")) K MTXT D Q .S Y0=22,X0=5 .N I,J,T,T1 F I=1:1 S T=$T(TEXT10+I),T1=$T(TEXT11+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=1 K MTXT D S:'$D(%NMB)!($G(%NMB)=1)!$G(%PRKB) %NMB=12 Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT2+I),T1=$T(TEXT3+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=2 K MTXT D Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT12+I),T1=$T(TEXT13+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("MTXT")) K COLX,COLY,STEPX,STEPY Q ; --------------- NORMAL K MTXT D S %NMB=8 .N I,J,T,T1 F I=1:1 S T=$T(TEXT+I),T1=$T(TEXT1+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY I $D(%L1NMB("=")) S %NMB=1 K %L1NMB("=") Q IN1 ; S %PREV="",%TO="",%KB=1 S %L1RBCL=%CV("MB") N %L1INIT S %L1INIT="" S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE S STEPY=3,STEPX=6 S COLY=1,COLX=1,(COL,LINE,COL1,LINE1)=1,%NMB=1 S Y0=$S($Y>5:1,1:21),X0=1 I $P($G(^kb($P)),"\") S X0=$P($G(^kb($P)),"\")-2 S:X0<1 X0=1 S:X0>74 X0=74 I $P($G(^kb($P)),"\",2) S Y0=$P($G(^kb($P)),"\",2)-2 S:Y0>21 Y0=21 S:Y0<1 Y0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) K MTXT S MTXT(1,1)="KB",MTXT(1,1,"C")="KB" Q VIEWMTXT ; N I,J S I="" F S I=$O(MTXT(I)) Q:I="" I I?1N.N .S J="" F S J=$O(MTXT(I,J)) Q:J="" I J?1N.N D ..S %X1=MTXT(I,J,"X") ..S %Y1=MTXT(I,J,"Y") ..S %X2=%X1+MTXT(I,J,"SX") ..S %Y2=%Y1+MTXT(I,J,"SY") ..D TV^%L1RBUA(%Y1,%X1,%Y2,%X2) Q CLCDN Q DELAY Q TEXT ; ;;ESC;DEL;UP;DN;POPUP;F4;ENT; ;;1;2;3;F5;F6;F7;ER ; ;=;4;5;6;F8;F9;F10;DELL; ;;7;8;9;F1;F2;HOME;END; ;;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT1 ; ;=;ESC;DEL;VVERX;VNIZ;VNIZE;IND;ENTER; ;=;1;2;3;ADDL;DELL;COR;ENTER; ;=;4;5;6;FIND;SAVE;REST;MOD; ;=;7;8;9;CHISTS;CHISTE;HOME;ENDS; ;=;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT0 ; ;ESC;=;DEL;UP;DN;POPUP;ENT; ;1;2;3;F5;F6;F7;ENT; ;4;5;6;F8;F9;F10;DELL; ;7;8;9;F1;F2;HOME;END; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT01 ; ;ESC;=;DEL;VVERX;VNIZ;VNIZE;ENTER; ;1;2;3;ADDL;DELL;COR;ENTER; ;4;5;6;FIND;SAVE;REST;MOD; ;7;8;9;CHISTS;CHISTE;HOME;ENDS; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT2 ; ;ESC;f;e;d;c;b;a;`;UP;DN;POPUP;ENT; ;m;n;l;j;k;i;h;g;F6;F7;DELL;SHIFT; ;u;v;s;t;r;q;o;p;+;F9;<-;->; ;z;y;x;w;.;,; ;-;=;F10;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT3 ; ;ESC;f;e;d;c;b;a;`;VVERX;VNIZ;VNIZE;; ;m;n;l;j;k;i;h;g;DELL;COR;MOD;SHIFT; ;u;v;s;t;r;q;o;p;+;SAVE;LEVO;PRAVO; ;z;y;x;w;.;,; ;-;=;REST;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT4 ; ;dqtcde d`ivi;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;hixt yetig;dpnfd zbvd ;dxey lehia;zepey ;mihixt ztqed; Q ; TEXT5 ; ;=;VVERX;VNIZ;PGUP;PGDN;DELL;CHISTE;MOD;VNIZE;FIND; Q ; TEXT6 ; ; d`ivi;zncew dxey;d`ad dxey; mcew sc ; `ad sc; Q ; TEXT7 ; ;ESC;VVERX;VNIZ;PGUP;PGDN; Q ; TEXT8 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;dxey lehia;zepey ;oein ;dxey qpkd; Q ; TEXT9 ; ;=;VVERX;VNIZ;PGUP;PGDN;MOD;VNIZE;FIND;INS; Q ; TEXT10 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;zepey ; dpnfd zbvd ; Q ; TEXT11 ; ;=;VVERX;VNIZ;PGUP;PGDN;VNIZE;SAVE; Q ; TEXT12 ; ;ESC;A;B;C;D;E;F;G;UP;DN;POPUP;ENT; ;H;I;J;K;L;M;N;O;F6;F7;DELL;SHIFT; ;P;Q;R;S;T;U;V;W;F8;F9;<-;->; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT13 ; ;ESC;A;B;C;D;E;F;G;VVERX;VNIZ;VNIZE;; ;H;I;J;K;L;M;N;O;DELL;COR;MOD;SHIFT; ;P;Q;R;S;T;U;V;W;FIND;SAVE;LEVO;PRAVO; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; PUT ; I $D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) D .D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q PRMXY ; S COLX=J,COLY=I-1,X2=X0+(COLX*STEPX),Y2=Y0+(COLY*STEPY) Q %L1NMB0 %L1NMB(STAM) ; [ 05.10.06 19:30 ] [ 26.07.06 15:24 ] [ 16.05.06 08:28 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%NMB,%BEG,screen,%L1NMB,%MBG,%PRKB,%ZMSL) D ^%L1C U $P:(NOECHO:NOWRAP:CENABLE:CTRAP=$C(3)) K %ZMSL("NMB") S YY0=$G(%L1NMB("ZY"),$Y) S:'$D(%PRKB) %PRKB=0 S %W=0 I $G(%PRKB) S %W=.1 BG00 S (%C0,%C00)="" BG0 ; BG ;;R *%C:0 S %PRKB=1 G:$T 27 E H %W R *%C:0 S:$T %PRKB=1 G:$T 27 S %L1NMB("X0")=0,%L1NMB("Y0")=0,%L1NMB("X2")=80,%L1NMB("Y2")=25 I $G(%BEG)=1 D GET^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) S %BEG=2 I $D(^kb($P)) D IN1 W $C(27,91),"?25l" D VIEWRB G READ D IN D VIEWRB S %TO="",%KB=0 S LINE=%NMB-.1\COLX+1,COL=%NMB-.1#COLX+.1 W $C(27,91),"?25l" I LINE,COL D TXT($G(MTXT(LINE,COL)),LINE,COL,1) READ0 S LINE1=LINE,COL1=COL READ ; D ^%L1MSGBR I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %MOUSE S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I %CRD,%TO'="KB" D G:%KB=2 BG G:'$D(MTXT(LINE,COL)) READ1 G:$D(MTXT(LINE,COL,"DIS")) READ1 S %TO=$G(MTXT(LINE,COL,"C")) G END .S %PRKB=0 .S %XX=$P(%CRD,",",1),%YY=$P(%CRD,",",2) .S COL=%XX-X0\STEPX+1,LINE=%YY-Y0+$G(^SMXY(%L3MYDVN))\STEPY+1 .I $D(MTXT(LINE,COL,"DIS")) Q .I '$D(MTXT(LINE,COL)),$D(^kb($P)) D Q ..S ^kb($P)=%XX_"\"_%YY,%KB=2 D PUT .I $G(COL1),$G(LINE1),$D(MTXT(LINE1,COL1)) D TXT($G(MTXT(LINE1,COL1)),LINE1,COL1,0) .I $G(LINE),$G(COL),$D(MTXT(LINE,COL)) D TXT($G(MTXT(LINE,COL)),LINE,COL,1) .S LINE1=LINE,COL1=COL READ1 I %TO="KB" S %TO="" I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 U $P:(NOECHO:NOWRAP) R *%C:0 E H .02 R *%C:0 G:'$T READ ;;I $C(%C)="^" R *%C1:0 I F R *%C1 E Q I %C'=13,%C'=10 S %PRKB=1 27 I %C=27 D DELAY R *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)) X "N %CC F R *%CC:0 E Q" G:$T(@%UPRCOD(C))="" TO K %FLL G @%UPRCOD(C) .S C="" Q:%C1=27 D DELAY R *%C2:%WAIT Q:%C2=27 S:%C2>0 C=%C1_%C2 Q:%C2<0 Q:$D(%UPRCOD(C)) .R *%C3:%WAIT Q:%C3=27 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) Q:%C3<0 .R *%C4:%WAIT Q:%C4=27 S:%C4>0 C=C_%C4 I $G(%C1)=27 S %C=27 K %C1 G 27 I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %C=27 G 27 ;;I %C=27 G ESC I %C=0 S %TO="" D DELAY R *%C1:%WAIT D DELAY R *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) I %C=13!(%C=10) S %TO=$G(MTXT(LINE,COL,"C"),"ENTER") G END I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) BD ; I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))="" S %TO=%UPRCOD(%C) G END I $C(%C)="=" S %TO=$C(%C) G END S %TO=$TR($C(%C),%TES2,%TES1) I $C(%C)="." S %TO=$C(%C) I $C(%C)="/" S %TO=$C(%C) G END TO K %FLL S %TO=%UPRCOD(C) G END TXT(%FRAZA,LINE,COL,INV) ; S:COL<1 COL=1 S:COL>COLX COL=COLX S:LINE<1 LINE=1 S:LINE>COLY LINE=COLY N %XX,%YY,%DLG,%I,%CHAST S %FRAZA=$TR($TR(%FRAZA,%TES1,%TES2),%TEN,%THB) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) S %DLG=STEPX-2 D DELG^%L1SCPC I '$G(INV) X %LIGHT I $G(INV),'$D(MTXT(LINE,COL,"DIS")) W %CV("WB"),%CV("RF") I '$G(INV) W %L1RBCL,%CV("YF") I $D(MTXT(LINE,COL,"DIS")) W %CV("RF") S %YY=Y0+(LINE-1*STEPY) S %XX=X0+(COL-1*STEPX)+1 I '$D(%L1NMB("HZM")),'$D(%L1NMB("LINE")),'$D(%L1NMB("HIST")) S:$L(%FRAZA)>4 %XX=%XX-1 X %POSIC W $S($L(%FRAZA)<3:" "_%FRAZA_" ",1:%FRAZA) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) N %I F %I=1:1 Q:'$D(%CHAST(1,%I)) D .I %I=2,$E(%CHAST(1,%I))=" ",$E(%CHAST(1,1),$L(%CHAST(1,1)))=" " S %CHAST(1,%I)=$E(%CHAST(1,%I),2,255)_" " .X %POSIC W %CHAST(1,%I) S %YY=%YY+1 X %XCL Q VNIZ ; D CLCDN S:'$D(COLY) COLY=1 I '$D(LINE) S %TO="VNIZ" G END I LINE+1>COLY S %TO="VNIZ" G END I COLY=1 S %TO="VNIZ" G END S %PRKB=0 I '$D(MTXT(LINE+1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 VVERX ; D CLCDN I '$D(COLY) S COLY=1 I '$D(LINE) S %TO="VVERX" G END I LINE<2 S %TO="VVERX" G END I COLY=1 S %TO="VVERX" G END S %PRKB=0 I '$D(MTXT(LINE-1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 PRAVO ; I '$D(COLX) S COLX=1 I COLX=1 S %TO="PRAVO" G END I '$D(COL) S %TO="PRAVO" G END I COL+1>COLX S %TO="PRAVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL+1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 LEVO ; I '$D(COLX) S COLX=1 I '$D(COL) S %TO="LEVO" G END I COL<2 S %TO="LEVO" G END I COLX=1 S %TO="LEVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL-1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 ;ENTER S %TO="" G END END ; I '$D(%TO) S %TO="" ; ;;I %TO="SHIFT" D G READ .x %chista D PUT .I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=1 D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q .K %L1NMB("ALB") D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q ; I %TO="KB" S %KB='%KB D G READ .I %KB D Q ..X %chista D PUT ..D IN1,VIEWRB ..S ^kb($P)="" .; - '%KB .x %chista D PUT .D IN,VIEWRB .K ^kb($P) ; I $G(%C2)=27!($G(%C3)=27)!($G(%C4)=27) S C2=27 K %C2,%C3,%C4 U $P:(NOECHO:NOWRAP) W $C(27,91),"?25h" I $D(LINE),$D(COLX),$D(COL) S %NMB=LINE-1*COLX+COL ;;,%ZMSL("NMB")=%NMB I $G(%L1NMB("ALB"))'=1,%TO="," Q %TO I $G(%L1NMB("ALB"))'=1,%TO="'" Q %TO I %TO'=".",%TO'="/" Q $TR(%TO,%TES1,%TES2) I %TO="." Q "." I %TO="/" Q "/" ESC S %TO="ESC" G END ; Q VIEWRB ; N I,J F I=Y0:STEPY:Y2-STEPY F J=X0:STEPX:X2-STEPX D D TV^%L1RBUA(I,J,I+STEPY,J+STEPX) .W %LIGHT1 W %CV("CF") ; W %HBR S I=0 F I=1:1:COLY F J=1:1:COLX D TXT($G(MTXT(I,J)),I,J,0) Q IN ; S %L1RBCL=%CV("MB") S %PREV="" S STEPY=2,STEPX=6 S COLY=3,COLX=10 I $D(%L1NMB("ALB")) S COLY=5,STEPY=2 I $D(%L1NMB("HZM")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("LINE")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("HIST")) S COLY=1,STEPX=10,STEPY=3 I $D(%L1NMB("VIEW")) S COLY=1,STEPX=12,STEPY=2 S:'$D(COL1) COL1=1 S:'$D(LINE1) LINE1=1 S:'$D(%NMB) %NMB=1 S Y0=$S($G(YY0)>12:2,1:14) I $D(%L1NMB("ALB")),$D(%L1NMB("ALB","Y0")) S Y0=%L1NMB("ALB","Y0") S X0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE ; I $D(%L1NMB("VIEW")) K MTXT D Q .S Y0=23,X0=8 S MTXT("MIN")=1 .N I,J,T,T1 F I=1:1 S T=$T(TEXT6+I),T1=$T(TEXT7+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("HZM")) K MTXT D Q .S Y0=22,X0=0 S MTXT(1,1,"DEF")="" .N I,J,T,T1 F I=1:1 S T=$T(TEXT4+I),T1=$T(TEXT5+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("LINE")) K MTXT D Q .S Y0=21 .N I,J,T,T1 S I=1,T=$T(TEXT8+I),T1=$T(TEXT9+I) D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .I '$D(%MBG("MIUN")) S MTXT(1,8,"DIS")="" .I '$D(%MBG("MOVE")) S MTXT(1,9,"DIS")="" .I $D(%MBG("DELAS")) S MTXT(1,6,"DIS")="" .S I=2 .S X0=80-(($L(T,";")-2)*(STEPX))\2 .D PRMXY ; I $D(%L1NMB("HIST")) K MTXT D Q .S Y0=22,X0=5 .N I,J,T,T1 F I=1:1 S T=$T(TEXT10+I),T1=$T(TEXT11+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=1 K MTXT D S:'$D(%NMB)!($G(%NMB)=1)!$G(%PRKB) %NMB=12 Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT2+I),T1=$T(TEXT3+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=2 K MTXT D Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT12+I),T1=$T(TEXT13+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; --------------- NORMAL K MTXT D S %NMB=7 ;S:'$D(%NMB)!$G(%PRKB)!($G(%NMB)=1) %NMB=7 .N I,J,T,T1 F I=1:1 S T=$T(TEXT+I),T1=$T(TEXT1+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY I $D(%L1NMB("=")) S %NMB=2 K %L1NMB("=") Q IN1 ; S %PREV="",%TO="",%KB=1 S %L1RBCL=%CV("MB") S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE S STEPY=3,STEPX=6 S COLY=1,COLX=1,(COL,LINE,COL1,LINE1)=1,%NMB=1 S Y0=$S($Y>5:1,1:21),X0=1 I $P($G(^kb($P)),"\") S X0=$P($G(^kb($P)),"\")-2 S:X0<1 X0=1 S:X0>74 X0=74 I $P($G(^kb($P)),"\",2) S Y0=$P($G(^kb($P)),"\",2)-2 S:Y0>21 Y0=21 S:Y0<1 Y0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) K MTXT S MTXT(1,1)="KB",MTXT(1,1,"C")="KB" Q CLCDN Q DELAY Q TEXT ; ;ESC;=;DEL;UP;DN;POPUP;ENT; ;1;2;3;F5;F6;F7;SHIFT; ;4;5;6;F8;F9;F10;DELL; ;7;8;9;F1;F2;HOME;END; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT1 ; ;ESC;=;DEL;VVERX;VNIZ;VNIZE;ENTER; ;1;2;3;ADDL;DELL;COR;SHIFT; ;4;5;6;FIND;SAVE;REST;MOD; ;7;8;9;CHISTS;CHISTE;HOME;ENDS; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT2 ; ;ESC;f;e;d;c;b;a;`;UP;DN;POPUP;ENT; ;m;n;l;j;k;i;h;g;F6;F7;DELL;SHIFT; ;u;v;s;t;r;q;o;p;+;F9;<-;->; ;z;y;x;w;.;,; ;-;=;F10;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT3 ; ;ESC;f;e;d;c;b;a;`;VVERX;VNIZ;VNIZE;; ;m;n;l;j;k;i;h;g;DELL;COR;MOD;SHIFT; ;u;v;s;t;r;q;o;p;+;SAVE;LEVO;PRAVO; ;z;y;x;w;.;,; ;-;=;REST;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT4 ; ;dqtcde d`ivi;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;hixt yetig;dpnfd zbvd ;dxey lehia;zepey ;mihixt ztqed; Q ; TEXT5 ; ;=;VVERX;VNIZ;PGUP;PGDN;DELL;CHISTE;MOD;VNIZE;FIND; Q ; TEXT6 ; ; d`ivi;zncew dxey;d`ad dxey; mcew sc ; `ad sc; Q ; TEXT7 ; ;ESC;VVERX;VNIZ;PGUP;PGDN; Q ; TEXT8 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;dxey lehia;zepey ;oein ;dxey qpkd; Q ; TEXT9 ; ;=;VVERX;VNIZ;PGUP;PGDN;MOD;VNIZE;FIND;INS; Q ; TEXT10 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;zepey ; dpnfd zbvd ; Q ; TEXT11 ; ;=;VVERX;VNIZ;PGUP;PGDN;VNIZE;SAVE; Q ; TEXT12 ; ;ESC;A;B;C;D;E;F;G;UP;DN;POPUP;ENT; ;H;I;J;K;L;M;N;O;F6;F7;DELL;SHIFT; ;P;Q;R;S;T;U;V;W;F8;F9;<-;->; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT13 ; ;ESC;A;B;C;D;E;F;G;VVERX;VNIZ;VNIZE;; ;H;I;J;K;L;M;N;O;DELL;COR;MOD;SHIFT; ;P;Q;R;S;T;U;V;W;FIND;SAVE;LEVO;PRAVO; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; PUT ; I $D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) D .D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q PRMXY ; S COLX=J,COLY=I-1,X2=X0+(COLX*STEPX),Y2=Y0+(COLY*STEPY) Q %L1NMBN %L1NMB(STAM) ; [ 27.03.08 09:39 ] [ 26.03.08 22:44 ] [ 21.08.07 08:09 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%NMB,%BEG,screen,%L1NMB,%MBG,%PRKB,%ZMSL) D ^%L1C U $P:(NOECHO:NOWRAP:CENABLE:CTRAP=$C(3)) K %ZMSL("NMB") S YY0=$G(%L1NMB("ZY"),$Y) S:'$D(%PRKB) %PRKB=0 S %W=0 I $G(%PRKB) S %W=.1 BG00 S (%C0,%C00)="" BG0 ; BG ;;R *%C:0 S %PRKB=1 G:$T 27 E H %W R *%C:0 S:$T %PRKB=1 G:$T 27 S %L1NMB("X0")=0,%L1NMB("Y0")=0,%L1NMB("X2")=80,%L1NMB("Y2")=25 I $G(%BEG)=1 D GET^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) S %BEG=2 I $D(^kb($P)),'$D(%L1NMB("MTXT")) D IN1 W $C(27,91),"?25l" D VIEWRB G READ D IN D VIEWRB S %TO="",%KB=0 S LINE=%NMB-.1\COLX+1,COL=%NMB-.1#COLX+.1 W $C(27,91),"?25l" I LINE,COL D TXT($G(MTXT(LINE,COL)),LINE,COL,1) READ0 S LINE1=LINE,COL1=COL READ ; ;;D ^%L1MSGBR I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %MOUSE S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I %CRD,%TO'="KB" D G:%KB=2 BG G:'$D(MTXT(LINE,COL)) READ1 G:$D(MTXT(LINE,COL,"DIS")) READ1 S %TO=$G(MTXT(LINE,COL,"C")) G END .S %PRKB=0 .S %XX=$P(%CRD,",",1),%YY=$P(%CRD,",",2) .S COL=%XX-X0+$G(^SMXX(%L3MYDVN))\STEPX+1,LINE=%YY-Y0+$G(^SMXY(%L3MYDVN))\STEPY+1 .I $D(MTXT(LINE,COL,"DIS")) Q .I '$D(MTXT(LINE,COL)),$D(^kb($P)) D Q ..S ^kb($P)=%XX_"\"_%YY,%KB=2 D PUT .I $G(COL1),$G(LINE1),$D(MTXT(LINE1,COL1)) D TXT($G(MTXT(LINE1,COL1)),LINE1,COL1,0) .I $G(LINE),$G(COL),$D(MTXT(LINE,COL)) D TXT($G(MTXT(LINE,COL)),LINE,COL,1) .S LINE1=LINE,COL1=COL READ1 I %TO="KB" S %TO="" I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 U $P:(NOECHO:NOWRAP) R *%C:0 E H .02 R *%C:0 G:'$T READ I %C'=13,%C'=10 S %PRKB=1 ;;I %C=32!(%C>47&(%C<58))!(%C>96&(%C<122)) S %PRKB=1 27 I %C=27 D DELAY R *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)) X "N %CC F R *%CC:0 E Q" G:$T(@%UPRCOD(C))="" TO K %FLL G @%UPRCOD(C) .S C="" Q:%C1=27 D DELAY R *%C2:%WAIT Q:%C2=27 S:%C2>0 C=%C1_%C2 Q:%C2<0 Q:$D(%UPRCOD(C)) .R *%C3:%WAIT Q:%C3=27 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) Q:%C3<0 .R *%C4:%WAIT Q:%C4=27 S:%C4>0 C=C_%C4 I $G(%C1)=27 S %C=27 K %C1 G 27 I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %C=27 G 27 ;;I %C=27 G ESC I %C=0 S %TO="" D DELAY R *%C1:%WAIT D DELAY R *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) I %C=13!(%C=10) S %TO=$G(MTXT(LINE,COL,"C"),"ENTER") G END I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) BD ; I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))="" S %TO=%UPRCOD(%C) G END I $C(%C)="=" S %TO=$C(%C) G END S %TO=$TR($C(%C),%TES2,%TES1) I $C(%C)="." S %TO=$C(%C) I $C(%C)="/" S %TO=$C(%C) G END TO K %FLL S %TO=%UPRCOD(C) G END TXT(%FRAZA,LINE,COL,INV) ; S:COL<1 COL=1 S:COL>COLX COL=COLX S:LINE<1 LINE=1 S:LINE>COLY LINE=COLY N %XX,%YY,%DLG,%I,%CHAST S %FRAZA=$TR($TR(%FRAZA,%TES1,%TES2),%TEN,%THB) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) S %DLG=STEPX-2 D DELG^%L1SCPC I '$G(INV) X %LIGHT I $G(INV),'$D(MTXT(LINE,COL,"DIS")) W %CV("WB"),%CV("RF") I '$G(INV) W %L1RBCL,%CV("YF") I $D(MTXT(LINE,COL,"DIS")) W %CV("RF") S %YY=Y0+(LINE-1*STEPY) S %XX=X0+(COL-1*STEPX)+1 I '$D(%L1NMB("HZM")),'$D(%L1NMB("LINE")),'$D(%L1NMB("HIST")) S:$L(%FRAZA)>4 %XX=%XX-1 X %POSIC W $S($L(%FRAZA)<3:" "_%FRAZA_" ",1:%FRAZA) I $D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("HIST")) N %I F %I=1:1 Q:'$D(%CHAST(1,%I)) D .I %I=2,$E(%CHAST(1,%I))=" ",$E(%CHAST(1,1),$L(%CHAST(1,1)))=" " S %CHAST(1,%I)=$E(%CHAST(1,%I),2,255)_" " .X %POSIC W %CHAST(1,%I) S %YY=%YY+1 X %XCL Q VNIZ ; D CLCDN S:'$D(COLY) COLY=1 I '$D(LINE) S %TO="VNIZ" G END I LINE+1>COLY S %TO="VNIZ" G END I COLY=1 S %TO="VNIZ" G END S %PRKB=0 I '$D(MTXT(LINE+1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 VVERX ; D CLCDN I '$D(COLY) S COLY=1 I '$D(LINE) S %TO="VVERX" G END I LINE<2 S %TO="VVERX" G END I COLY=1 S %TO="VVERX" G END S %PRKB=0 I '$D(MTXT(LINE-1,COL)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S LINE=LINE-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; S LINE1=LINE,COL1=COL G READ1 PRAVO ; I '$D(COLX) S COLX=1 I COLX=1 S %TO="PRAVO" G END I '$D(COL) S %TO="PRAVO" G END I COL+1>COLX S %TO="PRAVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL+1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL+1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 LEVO ; I '$D(COLX) S COLX=1 I '$D(COL) S %TO="LEVO" G END I COL<2 S %TO="LEVO" G END I COLX=1 S %TO="LEVO" G END D CLCDN S %PRKB=0 I '$D(MTXT(LINE,COL-1)) G READ D TXT($G(MTXT(LINE,COL)),LINE,COL,0) ; S COL=COL-1 D TXT($G(MTXT(LINE,COL)),LINE,COL,1) ; G READ0 ;ENTER S %TO="" G END END ; I '$D(%TO) S %TO="" ; ;;I %TO="SHIFT" D G READ .x %chista D PUT .I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=1 D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q .K %L1NMB("ALB") D IN,VIEWRB S %XX=%L1NMB("ZX"),%YY=%L1NMB("ZY") X %POSIC D PC^%ZMSL Q ; I %TO="KB" S %KB='%KB D G READ .I %KB D Q ..X %chista D PUT ..D IN1,VIEWRB ..S ^kb($P)="" .; - '%KB .x %chista D PUT .D IN,VIEWRB .K ^kb($P) ; I $G(%C2)=27!($G(%C3)=27)!($G(%C4)=27) S C2=27 K %C2,%C3,%C4 U $P:(NOECHO:NOWRAP) W $C(27,91),"?25h" I $D(LINE),$D(COLX),$D(COL) S %NMB=LINE-1*COLX+COL ;;,%ZMSL("NMB")=%NMB I $G(%L1NMB("ALB"))'=1,%TO="," Q %TO I $G(%L1NMB("ALB"))'=1,%TO="'" Q %TO I %TO'=".",%TO'="/" Q $TR(%TO,%TES1,%TES2) I %TO="." Q "." I %TO="/" Q "/" ESC S %TO="ESC" G END ; Q VIEWRB ; I $D(%L1NMB("MTXT")) D VIEWMTXT Q N I,J F I=Y0:STEPY:Y2-STEPY F J=X0:STEPX:X2-STEPX D .W %LIGHT1 W %CV("CF") .D TV^%L1RBUA(I,J,I+STEPY,J+STEPX) ; W %HBR S I=0 F I=1:1:COLY F J=1:1:COLX D .D TXT($G(MTXT(I,J)),I,J,0) .I $G(MTXT(I,J,"C"))=$G(MTXT(I+1,J,"C")) D ..W %LIGHT1 W %CV("CF") ..S %YY=Y0+(STEPY*I-1),%XX=X0+(STEPX*(J-1)-1) X %POSIC D VLIN W $J("",STEPX-1) D VLIN Q VLIN ; I %TYPCRT["PC" W $C(179) Q I %TYPCRT["VT5" W $C(27)_"(0"_$C(120)_$C(27),"(B" Q W "|" Q IN ; S %L1RBCL=%CV("MB") S %PREV="" S STEPY=2,STEPX=6 S COLY=3,COLX=10 I $D(%L1NMB("ALB")) S COLY=5,STEPY=2 I $D(%L1NMB("HZM")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("LINE")) S COLY=1,STEPX=8,STEPY=3 I $D(%L1NMB("HIST")) S COLY=1,STEPX=10,STEPY=3 I $D(%L1NMB("VIEW")) S COLY=1,STEPX=12,STEPY=2 S:'$D(COL1) COL1=1 S:'$D(LINE1) LINE1=1 S:'$D(%NMB) %NMB=1 S Y0=$S($G(YY0)>12:2,1:14) I $D(%L1NMB("ALB")),$D(%L1NMB("ALB","Y0")) S Y0=%L1NMB("ALB","Y0") S X0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) N %L1INIT S %L1INIT="" S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE ; I $D(%L1NMB("VIEW")) K MTXT D Q .S Y0=23,X0=8 S MTXT("MIN")=1 .N I,J,T,T1 F I=1:1 S T=$T(TEXT6+I),T1=$T(TEXT7+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("HZM")) K MTXT D Q .S Y0=22,X0=0 S MTXT(1,1,"DEF")="" .N I,J,T,T1 F I=1:1 S T=$T(TEXT4+I),T1=$T(TEXT5+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("LINE")) K MTXT D Q .S Y0=21 .N I,J,T,T1 S I=1,T=$T(TEXT8+I),T1=$T(TEXT9+I) D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .I '$D(%MBG("MIUN")) S MTXT(1,8,"DIS")="" .I '$D(%MBG("MOVE")) S MTXT(1,9,"DIS")="" .I $D(%MBG("DELAS")) S MTXT(1,6,"DIS")="" .S I=2 .S X0=80-(($L(T,";")-2)*(STEPX))\2 .D PRMXY ; I $D(%L1NMB("HIST")) K MTXT D Q .S Y0=22,X0=5 .N I,J,T,T1 F I=1:1 S T=$T(TEXT10+I),T1=$T(TEXT11+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=1 K MTXT D S:'$D(%NMB)!($G(%NMB)=1)!$G(%PRKB) %NMB=12 Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT2+I),T1=$T(TEXT3+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $G(%L1NMB("ALB"))=2 K MTXT D Q .N I,J,T,T1 F I=1:1 S T=$T(TEXT12+I),T1=$T(TEXT13+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY ; I $D(%L1NMB("MTXT")) K COLX,COLY,STEPX,STEPY Q ; --------------- NORMAL K MTXT D S %NMB=7 ;S:'$D(%NMB)!$G(%PRKB)!($G(%NMB)=1) %NMB=7 .N I,J,T,T1 F I=1:1 S T=$T(TEXT+I),T1=$T(TEXT1+I) Q:T="" Q:T["Q ;" D ..F J=1:1:$L(T,";")-2 S MTXT(I,J)=$P(T,";",J+1),MTXT(I,J,"C")=$P(T1,";",J+1) .D PRMXY I $D(%L1NMB("=")) S %NMB=2 K %L1NMB("=") Q IN1 ; S %PREV="",%TO="",%KB=1 S %L1RBCL=%CV("MB") N %L1INIT S %L1INIT="" S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE S STEPY=3,STEPX=6 S COLY=1,COLX=1,(COL,LINE,COL1,LINE1)=1,%NMB=1 S Y0=$S($Y>5:1,1:21),X0=1 I $P($G(^kb($P)),"\") S X0=$P($G(^kb($P)),"\")-2 S:X0<1 X0=1 S:X0>74 X0=74 I $P($G(^kb($P)),"\",2) S Y0=$P($G(^kb($P)),"\",2)-2 S:Y0>21 Y0=21 S:Y0<1 Y0=1 S Y2=Y0+(STEPY*COLY),X2=X0+(STEPX*COLX) K MTXT S MTXT(1,1)="KB",MTXT(1,1,"C")="KB" Q VIEWMTXT ; N I,J S I="" F S I=$O(MTXT(I)) Q:I="" I I?1N.N .S J="" F S J=$O(MTXT(I,J)) Q:J="" I J?1N.N D ..S %X1=MTXT(I,J,"X") ..S %Y1=MTXT(I,J,"Y") ..S %X2=%X1+MTXT(I,J,"SX") ..S %Y2=%Y1+MTXT(I,J,"SY") ..D TV^%L1RBUA(%Y1,%X1,%Y2,%X2) Q CLCDN Q DELAY Q TEXT ; ;;ESC;DEL;UP;DN;POPUP;;ENT; ;;1;2;3;F5;F6;F7;ER ; ;=;4;5;6;F8;F9;F10;DELL; ;;7;8;9;F1;F2;HOME;END; ;;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT1 ; ;=;ESC;DEL;VVERX;VNIZ;VNIZE;ENTER;ENTER; ;=;1;2;3;ADDL;DELL;COR;ENTER; ;=;4;5;6;FIND;SAVE;REST;MOD; ;=;7;8;9;CHISTS;CHISTE;HOME;ENDS; ;=;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT0 ; ;ESC;=;DEL;UP;DN;POPUP;ENT; ;1;2;3;F5;F6;F7;ENT; ;4;5;6;F8;F9;F10;DELL; ;7;8;9;F1;F2;HOME;END; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT01 ; ;ESC;=;DEL;VVERX;VNIZ;VNIZE;ENTER; ;1;2;3;ADDL;DELL;COR;ENTER; ;4;5;6;FIND;SAVE;REST;MOD; ;7;8;9;CHISTS;CHISTE;HOME;ENDS; ;0;.;*;-;PGUP;PGDN;KB; Q ; TEXT2 ; ;ESC;f;e;d;c;b;a;`;UP;DN;POPUP;ENT; ;m;n;l;j;k;i;h;g;F6;F7;DELL;SHIFT; ;u;v;s;t;r;q;o;p;+;F9;<-;->; ;z;y;x;w;.;,; ;-;=;F10;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT3 ; ;ESC;f;e;d;c;b;a;`;VVERX;VNIZ;VNIZE;; ;m;n;l;j;k;i;h;g;DELL;COR;MOD;SHIFT; ;u;v;s;t;r;q;o;p;+;SAVE;LEVO;PRAVO; ;z;y;x;w;.;,; ;-;=;REST;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT4 ; ;dqtcde d`ivi;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;hixt yetig;dpnfd zbvd ;dxey lehia;zepey ;mihixt ztqed; Q ; TEXT5 ; ;=;VVERX;VNIZ;PGUP;PGDN;DELL;CHISTE;MOD;VNIZE;FIND; Q ; TEXT6 ; ; d`ivi;zncew dxey;d`ad dxey; mcew sc ; `ad sc; Q ; TEXT7 ; ;ESC;VVERX;VNIZ;PGUP;PGDN; Q ; TEXT8 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;dxey lehia;zepey ;oein ;dxey qpkd; Q ; TEXT9 ; ;=;VVERX;VNIZ;PGUP;PGDN;MOD;VNIZE;FIND;INS; Q ; TEXT10 ; ;d`ivi ;zncew dxey ;d`ad dxey ;mcew sc ;`ad sc ;zepey ; dpnfd zbvd ; Q ; TEXT11 ; ;=;VVERX;VNIZ;PGUP;PGDN;VNIZE;SAVE; Q ; TEXT12 ; ;ESC;A;B;C;D;E;F;G;UP;DN;POPUP;ENT; ;H;I;J;K;L;M;N;O;F6;F7;DELL;SHIFT; ;P;Q;R;S;T;U;V;W;F8;F9;<-;->; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; TEXT13 ; ;ESC;A;B;C;D;E;F;G;VVERX;VNIZ;VNIZE;; ;H;I;J;K;L;M;N;O;DELL;COR;MOD;SHIFT; ;P;Q;R;S;T;U;V;W;FIND;SAVE;LEVO;PRAVO; ;X;Y;Z;%;.;,; ;-;=;+;/;'; ;1;2;3;4;5;6;7;8;9;0;DEL;KB; Q ; PUT ; I $D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) D .D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q PRMXY ; S COLX=J,COLY=I-1,X2=X0+(COLX*STEPX),Y2=Y0+(COLY*STEPY) Q %L1NU %L1NU ; [ 15.03.19 12:30 ] [ 03.03.09 12:18 ] [ 04.02.09 14:10 ] ; %CLEAR= LESHAHZER MASAH BESOF ; %CLEAR=2 - LO LESHAHZER MASAH B SOF ; ^%L1NH - TEUD K INDEX N %STEC,KOD,%KODL1,%TOP,NOMER,%PRTCH,%SM,%SMY,%SMX,%SMI,%VETKA,%L1NSHL N %GLOB,%XF,%XL,%XU,%V,%K,%I,%I1,%L1I,%L1II,%INUR,%IND,%INDN,%L1NS,%LASTP,%SS,%NXS N %FLABC,%FIRST,%DRCT,%PRS,%PRV,%PREND,%PRFIN,%PRZPT,%RSTR,%LASTI N %L3VN,%L3VNM,%L3VTO,%L3VLL,%L3VMAC,%RST N %CHAST,%CHAST1L,%KODL1,%MAC1,%MAC11,%SSS,%L1OLD,%L3VLB N MACOLD S %SMI=1 S:$D(%L1("IND")) %SMI=%L1("IND") S:'$D(%L1("EU")) %L1("EU")=99 N %FIRST,%SS S:'$D(%L1("BE")) %L1("BE")=0 S:'($D(%L1("FIRST"))#2) %L1("FIRST")="" S:'($D(%L1("US"))#2) %L1("US")=1 S %NN1=0 ; -COUNTER LINES TO PRINTER K %L1("RB") I $$HZGTOUCH^%L2MOUSE,'$D(%L1("NORB")) S %L1("RB")="" S %L1NSHL=0 S %DRCT=1 I $D(%L1("REV")) S %DRCT=-1 K %MM S FLAG="",%UR=1,%PRZPT=0,%PRV=0,%PREND=0,INDEX="",NOMER="" S %VETKA=$P(MAC,"""",2),%RSTR=$G(%L1("HI")),%KAV="""""",%KAV1="""" S:%RSTR<1 %RSTR=16 S %GLOB=MAC D FKOD S %UROV=%I-1 S %XF="S %FIRST=%KAV1_$G(%L1(""FIRST""))_%KAV1" S %XL="S %LASTI=0 I $D(%L1(""LAST""))#2 I @%L1(""LAST"") S %LASTI=1" S %XU="X:$D(%L1(""US0""))#2 %L1(""US0"") S %USL=$S($D(%L1(""US""))#2:%L1(""US""),1:1)" S MAC1="%L1",MAC2="%L1OLD" D ^%S1GC1 G PROV CYC1 S %V=%MAC1,%V=$O(@%V),(%SS,%NXS)=$G(^(%NXN)),%V=%MAC1 I MAC["^vrm($J" N %NNXN S %NNXN=%NXN N %NXN,%NXS D .S %NXN=$G(^vrm($J,%NNXN),"?????"),%NXS="" .S %NXS=$G(@MACOLD@(%NXN)) I $D(%L1("SET"))#2 X %L1("SET") S %V=$O(@%V) S %V=%MAC1 X %XU I @%USL D .N %STEP S %STEP=$S($D(%L1("RB")):3,1:1) .S %V=$O(@%V) S %K=%K+1,%I=%I+1,%L=%L+%STEP D PSTR .I '%PRFIN S %IND(%K)=%NXN I MAC["^vrm($J" S %INDN(%K)=%NNXN S %V=%MAC1 S %V=$O(@%V) S %V=%MAC1 Q PSTR ; I %L'<%RSTR S %PRFIN=1 Q I $D(%L1("TXT"))#2 S %V=%MAC1 X %L1("TXT") Q I $D(%L1("TXT1")) D S %L1NS(%I)=$E(%L1NS(%I),1,$L(%L1NS(%I))-1) Q .N %L1NU .S %L1NS(%I)="" F %IJ=1:1:$L(%L1("TXT1"),"\/") S %L1NU=$P(%L1("TXT1"),"\/",%IJ) D S %L1NS(%I)=$S(%ENGLISH:%L1NU(9)_" "_%L1NS(%I),1:%L1NS(%I)_%L1NU(9)_" ") ..X "S %L1NU(1)="_$P(%L1NU,"<>",1) S %L1NU(2)=$P(%L1NU,"<>",2) ..I '%L1NU(2),$D(%L1("T1")) S %L1NU(2)=$L($P(%L1("T1"),"|",$S('%ENGLISH:%IJ,1:$L(%L1("T1"),"|")-%IJ+1)))_%L1NU(2) ..I %L1NU(2)["H" S %L1NU(9)=$$W^%L1C($$HBR^%L1FRM(%L1NU(1),+%L1NU(2))) Q ..I %L1NU(2)["," S %L1NU(9)=$J(%L1NU(1),+%L1NU(2),$P(%L1NU(2),",",2)) Q ..I '%ENGLISH S %L1NU(9)=$J(%L1NU(1),+%L1NU(2)) Q ..I %ENGLISH S %L1NU(9)=%L1NU(1)_$J("",%L1NU(2)-$L(%L1NU(1))) Q S %KODL1=$S($D(%L1("TX"))#2:%L1("TX"),1:"")_$S($D(%L1("CD"))#2:$S(%L1("CD")=" ":"",%L1("CD")="":KOD_%NXN,1:%NXN),1:%NXN) I $G(MAC)["^l2mn(" S %KODL1=%KODL1-1,%L3VLL=38 I '($D(^(%NXN))#2) S %L1NS(%I)=" <"_%NXN_"> " Q S %CHAST=$S($D(%L1("SS"))#2:$P(^(%NXN),%L1("SS"),$S($D(%L1("NR"))#2:%L1("NR"),1:1)),1:^(%NXN)) I $D(%L1("CD")),%L1("CD")="I" Q S %LASTP=75-$L(%KODL1)-1 S %L1NS(%I)=$E(%CHAST,1,%LASTP)_" "_%KODL1 Q PROV U $P:(NOECHO:NOWRAP:NOESC) I $G(%L1("SORT")) G SORT I %TYPCRT="PC" D GET^%VIDEO("%VD",0,0,80,25,2) I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;2$v" I $G(%L1("SORT")) G SORT S %SMY=$G(%L1("BE")) I %SMY<2 S %SMY=2 I %SMY>20 S %SMY=20 S %RSTR=22-%SMY N %SSS S %SSS="! mipezp oi` \\ NO DATA ! " I $D(%L1("NDMSG")) S %SSS=%L1("NDMSG") I $G(%ENGLISH),%SSS'["\\" S %SSS="\\"_%SSS I $D(@MAC)=0 X:'$D(%L1("ND")) "S %SAY=$P(%SSS,""\\"",1+%ENGLISH) X %XMSGV(1)" S FLAG="ND" G END1 S FLAG="" S %MAC1=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_",",1:MAC_"(") S %PRS=$F(%MAC1,",") BEGP ; K %L1 S MAC1="%L1OLD",MAC2="%L1" D ^%S1GC1 S %K=0 S %INUR=%UROV+(%PRS>0) X %XF S %MAC1=%MAC1_%FIRST_")" S %TOP(%UR)=1,%STEC(%UR,%TOP(%UR))=%MAC1_"!"_"0!"_$G(%SMI,1) CYC K %L1NS U $P D GETPAR I $D(%FLABC) K %FLABC S %PRS=(%MAC1[",") I %PRS S %MAC11=$P(%MAC1,",",1,%UROV),%L1("MAC")=$P(%MAC1,",",1,%UROV)_")" I '%PRS S %MAC11=MAC_"(",%L1("MAC")=MAC I $D(%L1("T1")) S %HEAD=%L1("T1") I $D(%L1("T2"))#2 X %L1("T2") S %PRFIN=0 S %NXN=$O(@%MAC1,%DRCT) K %IND,%INDN S %I=0,%L=0 F %I0=1:1 Q:%NXN="" X %XL Q:%LASTI D CYC1 Q:%PRFIN S %NXN=$O(^(%NXN),%DRCT) S %COLI=%I I %PRFIN S %L1("MENU")="" I %K=0 G:%L1("EU")=98 END U $P S FLAG="ND" X:'$D(%L1("ND")) "W *7 S %SAY=$P(%SSS,""\\"",1+%ENGLISH) X %XMSGV(1)" G:$D(%L1("US",%UROV)) END1 S FLAG="" G:%UR>1 VVERX S FLAG="ND" G END1 I %K=1,$D(%L1(1)),%L1("EU")'=%INUR!($G(%L1(1))=1) G:%PRV VVERX S %NOM=1 G NOM S %PRV=0 S %LAST=$S($D(%IND(%K-%PRFIN)):%IND(%K-%PRFIN),1:"") I MAC["^vrm($J" S %LAST=$S($D(%INDN(%K-%PRFIN)):%INDN(%K-%PRFIN),1:"") G ZN END S MAC=$P(%MAC1,",",1,%UROV)_")" I MAC["^vrm" D K ^vrm($J) .S MAC=$S($F(MACOLD,"("):$E(MACOLD,1,$L(MACOLD)-1)_",",1:MAC_"(")_$P(MAC,",",2,20) I $E(NOMER,$L(NOMER))="," S NOMER=$E(NOMER,1,$L(NOMER)-1) END1 U $P X %XCL K %GLOB,%L1I,%L1NS,%MAC1,%L1,%MACF,%K,%KOD,%I,%J,%IND,%INDN,%NXN,%NXS,%SIMB,%YES,%NOM,%SIMB,%SUB,%XF,%XL,%XU,%FIRST,%GLOB,%LASTI,%USL,%LAB,%LAST,%LASTP,%MAC11,%PRFIN,%PRS,%RSTR,%SHS,%VETKA,%KAV,%KAV1,%MACN K %L3VTO,%V3MAXY,%PRZPT,%PREND,%PRV,%INUR,%COLI,%HBR0,%L1XER,%L1NPRNT I $G(%CLEAR)=1 S %XX=0,%YY=%SMY-2 X %POSIC,%XCL,%chiste D REST G END2 I $G(%CLEAR),$G(%CLEAR)<3 G END2 I $G(%CLEAR)>2!'$G(%CLEAR) X %chista D REST I %RST G END2 END2 I $D(%ECHO) U $P:(ECHO:WRAP) K %SMY,%CLEAR Q ;- KOT ; S %NN1=0 S %L1NSHL=%L1NSHL+1 I $D(%L1NPRNT("BEG")) W # I '$D(TSS)!'$D(TS0) D ^%L1TS D UDEV^%L1LPT(%L1NUDEV) S %TIM=$ZD($H,"24:60") W !,%L1NSHL,$TR(" sc ",TS0,TSS),?20,%TIM_$TR(" :dry ",TS0,TSS)_$$^%L1DC($H,1)_$TR(" :g""ec zwtd jix`z",TS0,TSS),! S %AT=$$^%L1HEAD("") I $L(%AT) S %ST=%L1OUT("MDP","B")_$$CENTRB^%L1FRM($TR($TR(%AT,"#_",""),TS0,TSS),%L1OUT("MDP","GWPC"))_%L1OUT("MDP","N") W !,%ST,! I $D(%L1("T3")) X %L1("T3") I $D(%L1("T1")) D KAV W !?$G(%L1NPRNT("SM")),$TR(%L1("T1"),TS0,TSS) D KAV W ! Q ENDP I $D(%L3VTO("EXCEL")) D EXCEL G ENDP1 D UDEV^%L1LPT(%L1NUDEV) D:$D(%L1("T1")) KAV S %DEV="%L1NUDEV" D CLOSE^%L1LPT ENDP1 K ^L1NUPC($P),%GETIN U $P S %GET=" . dnlyed dlert " D N^%L1GET S FLAG="PC" G END1 ;* KAV ; W !?$G(%L1NPRNT("SM")),$TR($J("",$L(%L1("T1")))," ","-") Q FKOD ; S KOD="" S KOD1=$P($P(%GLOB,"(",2),")") S:$E(KOD1)="""" KOD1=$P(KOD1,"""",2) F %I=2:1 Q:$P(%GLOB,",",%I)="" S %KOD=$P(%GLOB,",",%I) S:%KOD["""" %KOD=$P(%KOD,"""",2) S KOD=KOD_%KOD S:%UR>1 INDEX=%KOD I $E(KOD,$L(KOD))=")" S KOD=$E(KOD,1,$L(KOD)-1) S KOD1=KOD1_KOD Q %PAR ; ;T1,T2,TXT,TXT1,FIRST,LAST,BU,TX,SS,NR,US,US0,US1,CD,BE,SET,NOM Q ZN ; K %P I $D(%L1NPRNT("ABC")) S %BS=0 D K %L1NS S FLAG="PC" G:$D(%FLABC) CYC G:%NXN=""!%LASTI ZNABC G PRAVO ; *** LEV 11.03 .S %SAY=" ... oeinl oznd `p` " X %XMSGN .I $D(%FLABC) K ^L1NUPC($P) .S %MAC1=$P(%STEC(%UR,1),"!",1) .S %NN="",%L1II=0 F S %NN=$O(%L1NS(%NN)) Q:%NN="" D S %L1II=%L1II+1,^L1NUPC($P,%ABC_$J(%L1II,5))=%L1NS(%NN) ..S %ABC=$TR($$INV^%L1FRM($E(%L1NS(%NN),1,$L(%L1NS(%NN))-%L1NPRNT("ABC")))," ","") ..S %ABC=$E(%ABC,1,10),%ABC=%ABC_$J("",10-$L(%ABC)) G ZN1 ZNABC I $D(%L3VTO("EXCEL")) G ENDP S %DEV="%L1NUDEV" D OPEN^%L1LPT G:%EROP END1 S %SAY=" ... dlerta zqtcn " X %XMSGN I '$D(TSS)!'$D(TS0) D ^%L1TS D KOT S %L1NPRNT("BEG")=2 S %NN="",%NN1=0 D UDEV^%L1LPT(%L1NUDEV) F S %NN=$O(^L1NUPC($P,%NN)) Q:%NN="" D .N %A S %A=$TR($G(^(%NN)),TS0,TSS) .W !?$G(%L1NPRNT("SM")),%A S %NN1=%NN1+1 I %NN1>%L1NPRNT D KOT G ENDP ; ZN1 ; I $D(%L3VTO("EXCEL")) D G:$G(%L1NPRNT("BEG"))=1 CYC K %L1NS U $P S FLAG="PC" G:%NXN=""!%LASTI ENDP G PRAVO .I '$D(%L1NPRNT("BEG")) K ^L1NUPC($P) S %L1NPRNT("BEG")=1,%NN1=1 Q .I $G(%L1NPRNT("BEG"))=1 S %L1NPRNT("BEG")=2 .S %NN="" F S %NN=$O(%L1NS(%NN)) Q:%NN="" S ^L1NUPC($P,%NN1)=%L1NS(%NN) S %NN1=%NN1+1 ; I $G(%L1NPRNT("BEG"))=1 S %L1NPRNT("BEG")=2 I $G(%L1NPRNT) S %BS=0 D G:$G(%BS) END1 G:$G(%L1NPRNT("BEG"))=1 CYC K %L1NS U $P S FLAG="PC" G:%NXN=""!%LASTI ENDP G PRAVO ; *** LEV 11.03 .I '$D(%L1NPRNT("BEG")) D S %L1NPRNT("BEG")=1 S:$G(%EROP) %BS=1 Q ..S %DEV="%L1NUDEV" D OPEN^%L1LPT Q:%EROP ..D KOT S %MAC1=$P(%STEC(%UR,1),"!",1) .D UDEV^%L1LPT(%L1NUDEV) S %NN="" F S %NN=$O(%L1NS(%NN)) Q:%NN="" W !?$G(%L1NPRNT("SM")),$TR(%L1NS(%NN),TS0,TSS) S %NN1=%NN1+1 I %NN1>%L1NPRNT D KOT ; S %L3VMAC="%L1NS",%L1NUV("UROV")=%UROV D ^%L3VIEW ;;D REST PP ; I $D(%L1("PRINT","ABC"))!($G(%L3VTO)="P") D G:$G(%TO)="END" END K %L1("PRINT") S %L1NPRNT=48,%NN1=0 D SM G ZN .N %GET,%GETIN,%S D ^%L1TS I $D(%L1("PRINT","NOZAPR"))!$G(%L1("SORT")) S %S=$S($D(%L1("PRINT","ABC")):2,1:1) G ZPP1 ZPP .S %GETIN=1,%GET=" 2 - iza`tl` xcq itl ,1 - ixnep xcq itl qitcdl" D N^%L1GET Q:%TO="END" ZPP1 .I %S'=1,%S'=2 W *7 G ZPP .I %S=2 S %L1NPRNT("ABC")=$G(%L1("PRINT","ABC"),8),%FLABC="" .I $D(%L1("T1")) S %GET=" - qitcdl , 97 - EXCEL-l uaew oikdl " D N^%L1GET D ^%L1TS S:%S=97 %L3VTO("EXCEL")="" I $D(%L1("PRINT")),%L3VTO="VVERX" S %GET=" 99 - qitcdl ,97 - EXCEL-l uaew oikdl " D N^%L1GET K %L1("PRINT") D ^%L1TS I %S=99!(%S=97) S %L3VTO="P" S:%S=97 %L3VTO("EXCEL")="" G PP K %L1("PRINT") I $G(%L3VTO)="TIME" S FLAG="TIME" G END1 I $G(%L3VTO)="F8" G SORT I $G(%L3VTO)'="" G %L1NU3 ; OBR NOMER ; S %NOM=%K+%L3VN-%COLI,%PREND=0 S $P(%STEC(%UR,%TOP(%UR)),"!",3)=%L3VN VVOD ; ; I %L3VTO="." S %PREND=1,%PRTCH="" ;I %NOM="" G AVAR ;I %NOM="." S FLAG="." S MAC=$S($P(%MAC11,"(",2)'="":%MAC11_")",1:MAC) G END1 NOM ; NOM1 S %UR=%UR+1 S:%PRS %UROV=%UROV+1 S:%UROV'<%L1("EU") %PREND=1 K %L3VLL S %NOMMENU="%IND(+%NOM)" K %SMI S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_@%NOMMENU_"""," S %PRS=1 S KOD=KOD_@%NOMMENU,INDEX=@%NOMMENU,INDEX("N")=+%NOM I $D(%L1("US1"))#2 X %L1("US1") G:'%PREND BEGP G END %L1NU3 ; [ 08/11/91 5:18 PM ] AVAR ; I "./u"'[%L3VTO G SERV S %GET="? (l/k) yetigd seq++0,40,HH,I#k++1,H,I++lk" D ^%L1GET S %YES=(%S="k") K %S I $G(%XMSG(0),1)>1 S %GET=" END OF SEARCH ? ++0,40,EE,I#Y++1,E,I++YN" D ^%L1GET S %YES=(%S="Y") K %S I %YES S FLAG="AB" X %XCL G END1 X %XCL G:'%YES CYC G AVAR SERV G LEVO:%L3VTO="PGUP",PRAVO:%L3VTO="PGDW",VVERX:%L3VTO="VVERX" G CYC LEVO ; S %SSS="! z`fd dnxa mipezp zligz \\ BEGINING OF DATA ! " I %TOP(%UR)=1 U $P W *7 S %SAY=$P(%SSS,"\\",1+%ENGLISH) X %XMSGV(1) G LV K %STEC(%UR,%TOP(%UR)) S %TOP(%UR)=%TOP(%UR)-1 LV S %MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC PRAVO ; S %SSS="! z`fd dnxa mipezpd seq \\ END OF DATA ! " I %NXN=""!%LASTI,$G(%L1NPRNT("BEG"))=2 G CYC I %NXN=""!%LASTI U $P W *7 S %SAY=$P(%SSS,"\\",1+%ENGLISH) X %XMSGV(1) G CYC S %TOP(%UR)=%TOP(%UR)+1 S %SMI=1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%LAST_""")" S %STEC(%UR,%TOP(%UR))=%MAC1_"!"_(%K-1)_"!"_$G(%L3VN,1) S %K=%K-1 G CYC VVERX ; I '$D(%L1("BU")),%UR=1 S FLAG="^" G END1 S %PRZPT=0 S %GLOB=%MAC1 D FKOD S %UROV=%I-1 K %L3VLL I %UROV=1 S FLAG="^" G END1 I $D(%L1("BU")) I %UROV-1=%L1("BU") S FLAG="^" G END1 K %STEC(%UR) S %UR=%UR-1,%UROV=%UROV-1,%INUR=%INUR-1 I %UROV>1 S %UROV=%UROV-1 S %MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2),%SMI=$P(%STEC(%UR,%TOP(%UR)),"!",3) D GETPAR,REST K %SM,%SMY G CYC Q GETPAR ; F %I=1:1 Q:$P($T(%PAR+1),",",%I)="" S %PAR=$P($T(%PAR+1)," ;",2),%L1I=$P(%PAR,",",%I) I $D(%L1(%L1I))>0 S %L1(%L1I)=$S($D(%L1(%L1I,%INUR)):%L1(%L1I,%INUR),1:%L1(%L1I)) S:$D(%L1("BE")) %SMY=%L1("BE") I $D(%L1("LEFT")) S %SM=%L1("LEFT") I $D(%L1("WD")) S %L3VLL=%L1("WD") Q REST ; S %RST=0 ;;I %TYPCRT="PC",$D(%VD)!$D(^P1VIDEO(%L3MYDVN)) D PUT^%VIDEO("%VD",0,0,80,25,2) S %RST=1 Q I %TYPCRT="PC" D PUT^%VIDEO("%VD",0,0,80,25,2) S %RST=1 Q I $E(%TYPCRT,1,3)="VT5",$P'["/pts" W $C(27,91),";;;;2;;;$v" S %RST=1 Q I $D(%SCRN) D A^%L1SC Q SM Q:'$D(%L1("TXT1")) Q:$D(%L1NPRNT("SM")) N %II,%L,%L2 S %L=0 F %II=1:1:$L(%L1("TXT1"),"\/") D .N %A S %A=$P(%L1("TXT1"),"\/",%II) .S %L2=$P(%A,"<>",2) I '%L2,$D(%L1("T1")) D ..S %L2=$L($P(%L1("T1"),"|",%II)) .S %L=%L+%L2+1 S %L1NPRNT("SM")=80-%L\2-1 I %L1NPRNT("SM")<0 S %L1NPRNT("SM")=0 Q SORT ; D SORT1 X %chista S %L1OLD("SORT")="",%L1("SORT")="" G PROV ; SORT1 N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MAC,%L1,MACOLD,%DRCT) D ^%L1C Q:'($D(%L1("SORT"))#2) I '$D(%L1("SORT","HEAD")),$D(%L1("T1")) S %L1("SORT","HEAD")=%L1("T1") I '$D(%L1("SORT","MASTER")) S %L1("SORT","MASTER")=1 S GLB=$S($D(MACOLD):MACOLD,1:MAC) Q:'$D(%L1("SORT","HEAD")) S N="" F S N=$O(%L1("DO",N)) Q:N="" I N?."%"1U.E S @N=%L1("DO",N) S STG=%L1("SORT","HEAD") I $G(%L1("SORT")) D G SORT2 .S %I=%L1("SORT") .I $G(%L1("SORT","MASTER")) D ..N A S A=%L1("SORT","MASTER") ..S %L1("SORT","MASTER")=%L1("SORT") ..S %L1("SORT")=A S M(0)=" : oeinl oezp xegal `p " S M(1)=" d ` i v i " S J=1 K MI F I=1:1:$L(STG,"|") D .S J=J+1 .S M(J)=$$SPA^%L1FRM($P(STG,"|",$L(STG,"|")-I+1)) D Q:%I=1 .N MAC .S MAC="M",%L2MN("NOCLB")=1 .S %L2MN("TOP")=$G(%L1("BE"),6)+4,%L2MN("TOP0")=%L2MN("TOP")-1 .S %L2MN("CVB")="BCB" .S %CLEAR="" .D ^%L2MENU S %I=%I-1 SORT2 ; S TYPS=$G(%L1("SORT",%I)) I TYPS="",$D(%L1("TXT1")) S TYPS=$P($P(%L1("TXT1"),"\/",$L(%L1("TXT1"),"\/")-%I+1),"<>",2) I TYPS="" S TYPS="E" K ^vrm($J) N %NXN,%NXS S N="" F J=1:1 S N=$O(@GLB@(N)) Q:N="" D .S A=$G(^(N)) S %NXN=N,%NXS=A .I $D(%L1("SET"))#2 X %L1("SET") .I $G(@GLB@(N)) .S TX=$$TXT(A) .S IND=$TR($$SPA^%L1FRM($P(TX,"|",$L(STG,"|")-%I+1)),"""","") .I TYPS["H" S IND=$$INV^%L1FRM($$HBR^%L1FRM(IND,10))_$TR($J(J,5)," ",0) .I TYPS="D"!(IND?2N1"."2N1"."2N)!(IND?2N1"."2N1"."4N)!(IND?2N1"/"2N1"/"2N)!(IND?2N1"/"2N1"/"4N) D G SORTV ..S IND=$J($$^%L1DC(IND,3),10)_$TR($J(J,5)," ",0) .I TYPS'["H",TYPS'["D" S IND=$J(IND,10)_$TR($J(J,5)," ",0) SORTV .S ^vrm($J,IND)=N S MACOLD=GLB,MAC="^vrm($J)" SORTD S %DRCT=1 I $G(%L1("SORT","DIR")) S %DRCT=%L1("SORT","DIR") Q I $G(%L1("SORT")),'$G(%L1("SORT","DIR")) S %DRCT=1 Q S %GETIN=1,%GET="2 - dlrnln ,1 - dhnln oiinl" D N^%L1GET I %S'=1,%S'=2 W *7 G SORTD S %DRCT=$S(%S=1:1,1:-1) Q TXT(TXT) ; I '$D(%L1("TXT1")) Q TXT N %TX D Q $E(%TX,1,$L(%TX)-1) .N %L1NU .S %TX="" F %IJ=1:1:$L(%L1("TXT1"),"\/") S %L1NU=$P(%L1("TXT1"),"\/",%IJ) D S %TX=$S(%ENGLISH:%L1NU(9)_"|"_%TX,1:%TX_%L1NU(9)_"|") ..X "S %L1NU(1)="_$P(%L1NU,"<>",1) S %L1NU(2)=$P(%L1NU,"<>",2) ..I '%L1NU(2),$D(%L1("T1")) S %L1NU(2)=$L($P(%L1("T1"),"|",$S('%ENGLISH:%IJ,1:$L(%L1("T1"),"|")-%IJ+1)))_%L1NU(2) ..I %L1NU(2)["H" S %L1NU(9)=$$HBR^%L1FRM(%L1NU(1),+%L1NU(2)) Q ..I %L1NU(2)["," S %L1NU(9)=$J(%L1NU(1),+%L1NU(2),$P(%L1NU(2),",",2)) Q ..I '%ENGLISH S %L1NU(9)=$J(%L1NU(1),+%L1NU(2)) Q ..I %ENGLISH S %L1NU(9)=%L1NU(1)_$J("",%L1NU(2)-$L(%L1NU(1))) Q Q EXCEL ; N I,J,N,PZ,MD,MP Q:'$D(%L1("T1")) I %L1("T1")[":",%L1("T1")'["|" S %L1("T1")=$TR(%L1("T1"),":","|") K ^TREPK($P) N N,I,J,MP,PZ,KOT S KOT(1)=$TR($S($E(%L1("T1"))="|":"",1:"|")_%L1("T1")_$S($E(%L1("T1"),$L(%L1("T1")))="|":"",1:"|"),"|","*") S J=0,PZ=0 F S PZ=$F(KOT(1),"*",PZ) Q:PZ'>0 D .S J=J+1,MP(J)=PZ-1 I J>1 S MD(J-1)=MP(J)-MP(J-1)-1 S N="",I=0 F S N=$O(^L1NUPC($P,N)) Q:N="" D .S I=I+1 S ^TREPK($P,I)=$$HBR^%L1FRM(^L1NUPC($P,N),$L(%L1("T1"))) .F J=2:1 Q:'$D(MP(J)) S $E(^TREPK($P,I),MP(J)+1)="*" .S ^TREPK($P,I)=$$INVD^%L1FRM(^TREPK($P,I),"*","*") ; S KOT(1)=$E($$INVD^%L1FRM(KOT(1),"*","*"),2,255) F I=1:1 Q:'$D(^TREPK($P,I)) S ^TREPK($P,I)=$E(^TREPK($P,I),2,255) S PRM(1)="~" F J=$O(MD(999),-1):-1:1 Q:'$D(MD(J)) S PRM(1)=PRM(1)_"H,"_MD(J)_",0*" S PRM(1)=$E(PRM(1),1,$L(PRM(1))-1) D ^%L1PCEX Q %L1NU3 %L1NU3 ; [ 08/11/91 5:18 PM ] AVAR ; I %L3VTO'="." G SERV S %Q("Z")=" END OF SEARCH ? ",%Q("U")="Y" D ^%S1ASK S %YES=YES I %YES S FLAG="AB" X %XCL G END1^%L1NU X %XCL G:%YES="N" CYC^%L1NU G AVAR SERV G LEVO:%L3VTO="PGUP",PRAVO:%L3VTO="PGDW",VVERX:%L3VTO="VVERX" G CYC^%L1NU LEVO ; I %TOP(%UR)=1 S %SAY="*** BEGIN OF LEVEL!" X %XMSG G CYC^%L1NU K %STEC(%UR,%TOP(%UR)) S %TOP(%UR)=%TOP(%UR)-1,%MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC^%L1NU PRAVO ; I %NXN=""!%LASTI S %SAY="*** END OF LEVEL !" X %XMSG G CYC^%L1NU X %chiste S %TOP(%UR)=%TOP(%UR)+1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%LAST_""")" S %STEC(%UR,%TOP(%UR))=%MAC1_"!"_(%K-1) S %K=%K-1 G CYC^%L1NU VVERX ; I '$D(L1("BU")),%UR=1 S FLAG="^" G END+1^%L1NU S %PRZPT=0 S %GLOB=%MAC1 D FKOD^%L1NU S %UROV=%I-1 I %UROV=1 S FLAG="^" G END1^%L1NU I $D(L1("BU")) I %UROV-1=L1("BU") S FLAG="^" G END1^%L1NU K %STEC(%UR) S %UR=%UR-1,%UROV=%UROV-2 S:%UROV=0 MAC=$P(MAC,"(",1),%PRS=0,KOD="" S %GLOB=$P(%MAC1,",",1,%UROV) D FKOD^%L1NU S %K=0 S:'%PRS %UROV=1 S:%PRS MAC=%GLOB_")" G PRV^%L1NU Q %L1NULL %L1NULL ; [ 15.03.04 11:08 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %NMF="l1null.bdk" ZSY "ls -l *.o > "_%NMF O %NMF:(REWIND:READONLY) F U %NMF R A Q:$ZEOF D .S A1=$$SP1^%L1FRM(A) .S SZ=$P(A1," ",5) .S NM=$P(A1," ",9) .S NM1=$P(NM,".")_".m" .I SZ,'$$SIZE^%L1ZOS(NM1) D ..S NM2=$P($TR(NM,"_","%"),".") I NM2="" Q ..S ^%L1NULL(NM2)="" END C %NMF Q %L1OPEN %L1OPEN(%PORT,%BIT,%PRTY,%SPEED) ; OPEN MODEM PORT [ 05/23/99 5:17 PM ] [ 04/02/98 2:40 PM ] [ 03/31/98 8:41 AM ] ;-- EXAMPLE: 4,N,8,9600 O %PORT S %EROPN=0 Q S %EROPN=0 I %SPEED=1200 S %SPEED=9 I %SPEED=2400 S %SPEED=11 I %SPEED=4800 S %SPEED=12 I %SPEED=9600 S %SPEED=13 I %SPEED=19200 S %SPEED=14 I %SPEED=38400 S %SPEED=15 I $G(%SPEED)<9!($G(%SPEED)>15) S %SPEED=13 S %PRT=$S(%PRTY="N":2,%PRTY="O":5,1:9) S %BIT=$S(%BIT="8":9,1:5) C %PORT O %PORT:(0::::8388608+256+1:8::(%PRT*4096)+(%BIT*16)+%SPEED):2 E S %EROPN=1 U %PORT Q %L1OPSCR %L1OPSCR(TXT) ; OPEN BEGIN SCREEN [ 12.06.03 09:58 ] [ 25.01.01 10:48 AM ] [ 05/23/99 5:18 PM ] N CV,%CVET D ^%L1C S CV=0 D ^%L1CH N %L1RBCL S %L1RBCL=%CV("BCB") I %CVET S %CVET=0 X %XCL S CV=1 D TV^%L1RBUA(3,6,22,72) ;;W $C(27),"[3;6;22;72W" X %LIGHT S %SAY=" n""ra zeipexhwl` zekxrn .c.y.x ++4,56,HH++AA,"_$S(%TYPCRT="PC":"BF",1:"CF")_" L" X %XMSG X %LIGHT S %SAY=" 03-5225075 'lh `""z 22 fed ac ++5,56,HH++AA,"_$S(%TYPCRT="PC":"BF",1:"CF")_" L" X %XMSG X %LIGHT S %SAY="oiihypiit al : zpkzn++7,50,HH++AA,"_$S(%TYPCRT="PC":"BF",1:"CF")_" L" X %XMSG S %L1BKV("MIL")=TXT I CV W %CV("MF") D 1^%L1BKV Q %L1OS %L1OS ;CLJ;PERFORM DOS FUCTIONS VIA $ZOS CALL [ 04.01.04 12:02 ] [ 21.08.03 11:42 ] [ 20.06.03 16:53 ] NEW (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%MSC,%MBG,%MBS) D ^%L1C S %L1OS="" S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERR^%L1OS" S %OSHEAD=" HOST SERVER: MASTER MENU " O D O13^%L1OS ;;O S MENU="TXT",PREV="EXIT" G MENU EXIT Q ; ERR I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT Q MENU ;DISPLAY MENU K MM S MM(1)="E X I T " F I=0:1 S T=$P($T(@MENU+I),";",2) Q:T="*" S MM(I+2)=T S MM(0)=%OSHEAD S MAC="MM" K %CLEAR S %L2MN("F10")=1 D ^%L2MENU OPT S OPT=%I-1 I OPT=0 G:MENU="TXT" EXIT S MENU="TXT",%OSHEAD=" HOST SERVER: MASTER MENU " G MENU S T=$T(@MENU+OPT-1) S:MENU="TXT" %OSHEAD=" "_$P(T,";",2)_" " I $P(T,";",4)="" D @($P(T,";",3)) G MENU S MENU=$P(T,";",4) G MENU TXT ;DIRECTORY FUNCTIONS;MENU;TXT1 ;SHOW DOS VERSION;O2 ;AVAILABLE DISK SPACE;O3 ;CHANGE DEFAULT DOS PATH;O4 ;FILE FUNCTIONS;MENU;TXT2 ;* TXT1 ;CREATE DIRECTORY;O11 ;DELETE DIRECTORY;O12 ;LIST DIRECTORY;O13 ;* TXT2 ;DELETE FILE;O51 ;RENAME FILE;O52 ;SET FILE ATTRIBUTES;O53 ;COPY FILE;O54 ;VIEW FILE;O55 ;FILE EDITOR;O56 ;ROUTINE RESTORE;O57 ;DIRECTORY LISTING;O13 ;* O2 W !!,"CURRENTLY RUNNING UNDER DOS VERSION ",$$^%L1ZOS(4) G HIT O3 S %SFLG=0 D SDRV Q:%X=-1 S %Y=$$^%L1ZOS(9,%X) F %I=1:1:4 S @("%"_$C(64+%I))=$P(%Y,"^",%I) W !!,"FREE SPACE ON DRIVE ",%X,":",?24,$J(%A*%B*%C,10)," BYTES (",%A*%B*%C\104857.6/10," MEGABYTES)" W !,"TOTAL SPACE ON DRIVE ",%X,":",?24,$J(%A*%C*%D,10)," BYTES (",%A*%C*%D\104857.6/10," MEGABYTES)" G HIT O4 S (%SFLG,%EXIST,%M)=1 D SDRV Q:%X=-1 S %DRV=%X D SDIR G O4:%X="^",HIT O11 S %DDRV=$$^%L1ZOS(14) D O11A S %A=$$^%L1ZOS(1,%DDRV) G HIT O11A S %EXIST=2,%SFLG=1,%M=0 D SDRV Q:%X=-1 S %DRV=%X,%SFLG=0 D SDIR G:%X="^" O11A Q:%X=-1 S %ER=$$^%L1ZOS(6,%X) I %ER'<0 W " ...CREATED." Q D ^%L1OS1 H 2 G O11A O12 S %DDRV=$$^%L1ZOS(14) D O12A S %A=$$^%L1ZOS(1,%DDRV) G HIT O12A S %EXIST=1,%SFLG=1,%M=1 D SDRV Q:%X=-1 S %DRV=%X,%SFLG=0 D SDIR G:%X="^" O12A Q:%X=-1 S %ER=$$^%L1ZOS(7,%X) I %ER'<0 W " ...DELETED." Q D ^%L1OS1 H 2 G O12A O13 S %D=$ZDIR I $D(^%L1OS("DIR"))#2 S %D=^("DIR") I $D(%O13X) S %X=%O13X K %O13X G O13M ZD U $P:(NOECHO:NOWRAP) S %FL="",%GET="ENTER DIRECTORY LISTING SPECIFIER++18,5,EE,,R#"_$G(%D)_"++38,E,I" D ^%L1GET S %X=%S G:%X="^"!(%X="^Q")!(%X="")!($G(%TO)="END") HIT I %X="?" W !!,"ENTER THE FULL PATH OF THE DIRECTORY THAT YOU WISH TO SPECIFY.",!,"IF THE DRIVE OR DIRECTORY IS OMITED, THE CURRENT DEFAULT WILL BE USED." I W !,"SPECIFY '*.*' TO LIST ALL FILES IN THAT DIRECTORY.",!,"ENTER TO SELECT THE CURRENT DEFAULT.",!,"ENTER '^' TO EXIT THIS OPTION." G O13 O13M N %A,%B,%C,%D,%E,%DOLD,%SH,MAC,%I,%J,%K,%Y,%HBRY K ^TEMPo($P) I $E(%X,$L(%X))'["/",%X'["*",%X'["." S %X=%X_"/" I $E(%X,$L(%X))="/" S %PATH=%X E S %PATH=$ZPARSE(%X,"DIR") I $ZPARSE(%X)="" Q:$D(%O13X) U $P S %SAY=" NOT FOUND ! " X %XMSGV(1) G ZD I '$D(%L1OS("NOVIEW")) U $P X %chista S $X=0 W ?24,%X_" DIRECTORY LISTING",! S $Y=1 S MAC="^TEMPo($P)" O13D ; o "l1os.0":(write:newversion) u "l1os.0" w "cd "_$zparse(%X,"dir"),! w "ls -l "_$zparse(%X,"name")_$zparse(%X,"type")_" > "_$ZDIR_"l1os.1" c "l1os.0" zsy "bash l1os.0" D GET("l1os.1") I $D(^TMPS111($J)) D .K ^TEMPo($P) N I,A,A1,%NM,%DT,%SZ,%TM .F I=1:1 Q:'$D(^TMPS111($J,I)) D ..S A=$G(^(I)) ..S A1=$$PRS^%L1FLP(A) Q:A1="" ..S ^TEMPo($P,I)=$$ENG^%L1FRM($P($P(A1,"^"),"."),15)_" "_$S($E(A)="d":"",1:$$ENG^%L1FRM($P($P(A1,"^"),".",2),5))_" "_$J($P(A1,"^",2),10)_" "_$J($ZD($P(A1,"^",3),"DD.MM.YY"),8)_" "_$J($P(A1,"^",4),5) K ^TMPS111($J) Q:$D(%L1OS("NOVIEW")) D SPACE S %L2VIEW("Y1")=4,%L2VIEW("NOHB")="" D ^%L2VIEW I $D(%O13Q) K %O13Q Q I $D(%PATH),$D(%L2VNM),$TR(%L2VNM," ","")[" TO CHOOSE THE DEFAULT DRIVE.",!,"ENTER '^' TO RETURN TO THE PREVIOUS QUESTION." G SDRV S:%X?1.A1":" %X=$P(%X,":",1) S %ER=$$^%L1ZOS(1,%X) I %ER<0 D ^%L1OS1 H 2 S %ER=$$^%L1ZOS(1,%T) G SDRV S %ER=$$^%L1ZOS(11,%X) I %ER<0 D ^%L1OS1 H 2 S %ER=$$^%L1ZOS(1,%T) G SDRV I %X'=$$^%L1ZOS(14) W " ...INVALID." S %X=$$^%L1ZOS(1,%T) G SDRV Q:%SFLG S %A=$$^%L1ZOS(1,%T) Q SDIR ;ASK DIRECTORY, RESET DEFAULT IF %SFLG, PASS IN %DRV (DRIVE) ;PASS IN %EXIST 1) MUST EXIST 2) MUST NOT EXIST S %T=$S(%M:$$^%L1ZOS(11,%DRV),1:"^") S %GET="ENTER DIRECTORY : ++22,30,EE,,R#"_$S(%M:%T,1:"")_"++28,E,I" D ^%L1GET S %X=%S S:%X="" %X="^Q" Q:%X="^" I %X="^Q" S %X=-1 Q I %X="?" W !!,"ENTER THE NAME OF A DIRECTORY ON DRIVE ",%DRV,".",!,"ENTER TO CHOOSE THE DEFAULT DIRECTORY.",!,"ENTER '^' TO RETURN TO THE PREVIOUS QUESTION." G SDIR S %ER=$S(%X'="\":$$^%L1ZOS(10,%X),1:16) I %EXIST=2,(%ER'<0) W " ...DIRECTORY ALREADY EXISTS." G SDIR I %EXIST=1,%ER<0 D ER H 2 G SDIR ;;I %EXIST=1,'$ZB(%ER,16,1) W " ...INVALID." G SDIR S:%SFLG %A=$$^%L1ZOS(8,%X) Q SFULL ;ASK FULL NAME (INCLUDE PATH), PASS IN %EXIST SAME AS ABOVE N (%UPRCOD,%XMSG,%X,%M) D ^%L1C ;D SFULL^%OS SF S %FL="" S:$G(%M)="T"&('$D(%S)) %S=$G(%X) U 0 W !!,"FULL NAME OF HOST FILE <"_$S($G(%M)="R":"OLD",$G(%M)="T":"NEW",1:"")_"> " D ^%ZMSL I %S="" S %X=-1 Q I %S="?" D O13 S %S=$$NM(%L2VNM) G SF S %X=%S Q SPACE Q N %I,%A,%B,%C,%D,%DISK,%Y S %DISK=$P(%PATH,"\") S:$E(%DISK,$L(%DISK))'=":" %DISK=$$^%L1ZOS(14) S:$E(%DISK,$L(%DISK))=":" %DISK=$P(%DISK,":") S %Y=$$^%L1ZOS(9,%DISK) F %I=1:1:4 S @("%"_$C(64+%I))=$P(%Y,"^",%I) S %YY=0,%XX=0 X %POSIC S $X=0,$Y=20 W !!,"FREE SPACE ON DRIVE ",%DISK,":",?24,$J(%A*%B*%C,10)," BYTES (",%A*%B*%C\104857.6/10," MEGABYTES)" W !,"TOTAL SPACE ON DRIVE ",%DISK,":",?24,$J(%A*%C*%D,10)," BYTES (",%A*%C*%D\104857.6/10," MEGABYTES)" Q ER S %SAY=$$FUNC^%UCASE($ZS) X %XMSGV(1) Q GET(%S) ; N %PR s %PR=%S K ^TMPS111($J) N $ZT S $ZT="g RNOOPEN" c %PR o %PR:(readonly:record=2048:rewind) S $ZT="g REOF" N I,X S I=0 f u %PR r X S I=I+1,^TMPS111($J,I)=$TR(X,$C(9)," ") REOF ; c %PR U $P Q RNOOPEN U $P W *7 W " ERROR !" Q NM(%ST) N %NM,%TP S %ST=$$SP1^%L1FRM($E(%ST,1,22)) S %NM=$G(%PATH)_$P($P(%ST,".")," ") S %TP=$P(%ST," ",2) I $L(%TP),%TP'["<" S %NM=%NM_"."_%TP Q %NM V S %L1OS="" D O13 W $C(27,91,48,109) W # Q %L1OS1 %L1OS1 ; U $P S %SAY="*** ERROR *** " X %XMSGV(1) Q %L1OUT %L1OUT ; ^TMPS111 --> PRINTER, DISKET, DISPLAY [ 10.12.08 14:23 ] [ 05.11.08 19:24 ] [ 28.10.08 13:32 ] ; INPUT : %L1OUT("PRINTER") - PORT FOR PRINTER (2 = 51) ; %L1OUT("SUG") - PRINTER GROUP ( 3 - 3540, 4 - SENOR,5 - CITIZEN-90, 6 - CITIZEN-230) ; %L1OUT("NOTST") - NO ASK IF PRINTER OR KONAN IS READY ; %L1OUT("WR") - "W" (WRITE) OR "A" (APPEND) ; %L1OUT("FILE") - FILE NAME ( OUTPUT TO DISKETT ) ; %L1OUT("DISK") - DISK NAME ( A,B,... ; $D(%L1OUT("DAF")) - PRINT PAGE NUMBER ; %L1OUT("SM") - LEFT PRINT SHIFT ; %L1OUT("IND") - GET LINE INDEX IN SCREEN VIEW (=2 - LINE:,POS:) ; %L1OUT("KOT")#2 - CENTER HEADER ; $D(%L1OUT("KOT",0)) -> %L1OUT -> %S2V ; %L1OUT("KOT",I) - HEADER'S LINES ; %L1OUT("KOTDN",I) - REPORT BOTTOM LINES ;------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGN,%XMSGV,%L1OUT,%S2V,%HBRY,USTR,P1PC,A2HZG) D ^%L1C I $D(^TMPS111($J))<10 S %SAY=" mipezp oi` " X %XMSGV(1) Q I $D(%L1OUT("FILE")) S %NMFOUT=%L1OUT("FILE") S %L1DISK="" I $D(%L1OUT("DISK")) S %L1DISK=%L1OUT("DISK") S:'$D(USTR) USTR=3 I $D(%L1OUT("PRINTER")) S USTR=%L1OUT("PRINTER") ; D TS S PRT=$J ; ZP C 51 G:$D(%L1OUT("PRINTER")) TP U 0 X %chista S %GET="3 - zqtcn , 2 - hwqic , 0 - jqn ++11,60,HH#0++1,E,I++023" D ^%L1GET G:%S=""!($G(%TO)="END") EP S USTR=%S I $G(A2HZG),'$G(^P1PRM("ASHMDPB")) D MDP^P1PC I $G(PRINT) S %L1OUT("PRINTER")=PRINT S:$G(%MDP("SUG")) %L1OUT("SUG")=%MDP("SUG") S A2HZG=2 G TP ; TP I $$^%L1DISP(USTR) U USTR X %chista S %HBRY="" D D ^%S2VIEW D RS2V G:$D(%L1OUT("PRINTER")) EP G ZP .I $D(%L1OUT("KOT",0))!$D(%L1OUT("S2V")) D ..N I2 S I2=0 ..I $D(%L1OUT("S2V")),$D(%L1OUT("KOT"))#2 S ST=$J("",78-$L(%L1OUT("KOT"))\2)_%CLI_%L1OUT("KOT")_%CCL D PC S ST="" D PC S I2=I2+2 ..I '$D(%L1OUT("S2V")),$D(%L1OUT("KOT"))#2 S ST=%L1OUT("KOT") D PC S ST="" D PC S I2=I2+2 ..N N S N=.1 F S N=$O(%L1OUT("KOT",N)) Q:N="" I N S ST=%L1OUT("KOT",N) D PC S I2=I2+1 ..I '$D(%S2V("VGR")) S %S2V("VGR")=I2+1 ..I '$D(%S2V("LEFT")),$D(%L1OUT("SM")) S %S2V("LEFT")=%L1OUT("SM") ..I '$D(%S2V("IND")),$D(%L1OUT("IND")) S %S2V("IND")=%L1OUT("IND") ..K %S2V0 S N="" F S N=$O(%S2V(N)) Q:N="" S %S2V0(N)=%S2V(N) ..S N=.1 F I=1:1 S N=$O(%L1OUT("KOTDN",N)) Q:N="" I N D ...S %XX=0,%YY=$G(%S2V("NGR"),24)+I ...I %YY<24 X %POSIC S $Y=%YY,$X=%XX S ST=%L1OUT("KOTDN",N) D PC ; S %BS=0 I USTR=2!(USTR=51) D SDRV D I %BS G:$D(%L1OUT("PRINTER")) EP G ZP .I '$D(%L1OUT("NOTST")) D I %TO="END" S %BS=1 Q Z ..S %GET=" yiwdle "_%L1DISK_" opekl hwqic qipkdl `p " D N^%L1GET Q:$G(%TO)="END" ..I $$^%L1ZOS(9,%L1DISK)<0 S %SAY=" ! opek jeza hwqic oi` " X %XMSGV G Z .D SFILE Q:%BS S USTR=51 D CUSTR(USTR) .O %NMFOUT::2 E S %SAY=" FILE "_%NMFOUT_" IN USE ! " X %XMSGV(1) K %L1OUT("PRINTER") S %BS=1 Q .D UUSTR(USTR) ; Z3 G:$D(USTR) Z31 S %GET=": zqtcn xtqn++6,70,HH#3++2,E,I" D ^%L1GET I %S=""!($G(%TO)="END") G ZP S USTR=%S Z31 D ^%L1TS I USTR'=0,USTR'=51,USTR'=$P D D ^%L1LPT Q:$G(%EROP)&$D(%L1OUT("PRINTER")) G:$G(%EROP) ZP .I $G(%L1OUT("SUG")) S %L1LPT("SUG")=%L1OUT("SUG"),%L1OUT("DELAY")=1 .I $G(%L1OUT("PRINTER1")) S %L1LPT("DEV")=%L1OUT("PRINTER1") Q .I $G(%L1OUT("PRINTER")) S USTR=%L1OUT("PRINTER"),%DEV="USTR" Q ; I '$D(%L1OUT("NOTST")),USTR'=2,USTR<51!(USTR>63) D I $G(%TO)="END" D CUSTR(USTR) S USTR=0 G:$D(%L1OUT("PRINTER")) EP G ZP .S %GET=" d`ivil e` ugl. dpken zqtcn m`d weca " D N^%L1GET ; ZP1 D UUSTR(USTR) I '$D(%L1OUT("SUG")) S @("%L1OUT(""SUG"")="_%L1SUG) I '$D(TS0) D ^%L1TS S:'$G(%L1OUT("SUG")) %L1OUT("SUG")=5 D DEFMDP(%L1OUT("SUG")) ;;I $G(%L1OUT("SUG"))=5 W $C(18) I $D(%L1OUT("PRINTER","SMALL")) W $C(15) W %L1OUT("MDP","NOCOND") I $D(%L1OUT("PRINTER","SMALL")) W %L1OUT("MDP","COND") N I,I1,I2 S I=0,I2=0,DAF=0 D SHAP F S I=I+1 Q:'$D(^TMPS111(PRT,I)) D .N ST S ST=^(I) S I1=I I $E(ST)="#" H 1 S I2=0 F I1=I+1:1 Q:'$D(^TMPS111(PRT,I1)) Q:^(I1)'?.P .Q:'$D(^TMPS111(PRT,I1)) S STOLD=^(I1) .S I=I1 S I2=I2+1 I '(I2#18) I USTR'=3,USTR<51!(USTR>63) H 1 ;;$S($D(%L1OUT("PRINTER","SMALL")):18,1:7) .I $E(ST)="#",USTR'=51 W %L1OUT("MDP","PG"),%L1OUT("MDP","CUT") D SHAP .S ST=$TR($TR(STOLD,TS0,TSS),TS1,TSS) D PC .Q S N=.1 F I=1:1 S N=$O(%L1OUT("KOTDN",N)) Q:N="" I N D .S ST=$TR($TR(%L1OUT("KOTDN",N),TS0,TSS),TS1,TSS) D PC I %L1OUT("SUG")'=5,'$G(A2HZG) W %L1OUT("MDP","PRG"),%L1OUT("MDP","CUT"),%L1OUT("MDP","PRG") I $G(USTR)'=0,$G(USTR)'=$P,$G(USTR)'=51 S %DEV="USTR" D CLOSE^%L1LPT C 51 G:$D(%L1OUT("PRINTER")) EP G ZP EP K %L1OUT,%S2V I '$$^%L1DISP($G(USTR)) D CUSTR(USTR) Q RS2V ; N N K %S2V S N="" F S N=$O(%S2V0(N)) Q:N="" S %S2V(N)=%S2V0(N) Q PC ; I $D(%L1OUT("SM")) S ST=$J("",%L1OUT("SM"))_ST S ST=$TR(ST,"#_","") I '$D(TS)!'$D(TS0) D TS I USTR=51 W $TR($TR(ST,TS0,TSS),TS1,TSS),! Q ;;I USTR D W $TR(ST,TS0,TSS),! Q I '$$^%L1DISP(USTR) D W ST,! Q .S ST=$$CLST^%L1FRM(ST,%L1OUT("MDP","B"),%L1OUT("MDP","N")) .N N S N="" F S N=$O(%CV(N)) Q:N="" S ST=$$RPL^%L1FRM(ST,%CV(N),"") .N N S N="" F S N=$O(%CV(N)) Q:N="" S ST=$$RPL^%L1FRM(ST,$TR(%CV(N),TS0,TSS),"") .N N S N="" F S N=$O(%CV(N)) Q:N="" S ST=$$RPL^%L1FRM(ST,$TR(%CV(N),TS1,TSS),"") W $TR($TR(ST,%TES1,%TES2),%TEN,%THB),! Q Q SDRV ;ASK DRIVE, RESET DEFAULT IF %SFLG ;-- OUT : %L1IDISK S %BS=0 U 0 Q:$D(%L1DISK) S %FL="",%GET=":(A,B,C,D) opek my++6,70,HH,,R#"_$G(%L1DISK,"A")_"++1,E,I" D ^%L1GET I %S=""!($G(%TO)="END") S %BS=1 Q S %L1DISK=%S I $$^%L1ZOS(9,%L1DISK)<0 S %SAY=" ! opek jeza hwqic oi` " X %XMSGV(1) K %L1DISK G SDRV Q SFILE ; ;-- OUT : %NMFOUT S %BS=0 U 0 Q:$D(%NMFOUT) S %GET=" :uaewd my++6,45,HH#++20,E,I,,R" D ^%L1GET I %S=""!($G(%TO)="END") S %BS=1 Q S %NMFOUT=%S Q:%NMFOUT'[":" I %L1DISK'=$P(%NMFOUT,":") S %SAY=" d ` i b y " X %XMSGV(1) K %NMFOUT G SFILE S %NMFOUT=$P(%NMFOUT,":",2) I %NMFOUT="" W *7 S %BS=1 Q SHAP ; N SM I $D(%L1OUT("SM")) S SM=%L1OUT("SM") K %L1OUT("SM") ;;I USTR,USTR<51!(USTR>53),'$D(%L1LPT("ARX")) H 3 D SHAP1 S I2=2 I $D(%L1OUT("DAF")) S DAF=DAF+1 S ST=$TR($TR(" "_DAF_" sc",TS0,TSS),TS1,TSS) D PC S I2=3 I $D(%L1OUT("KOT")) D .I $D(%L1OUT("KOT"))#2 D ..N ST,ST1 S ST1=$TR($J("",$L(%L1OUT("KOT")))," ","-") ..;S ST=%L1OUT("KOT") D:$D(%L1OUT("S2V")) D PC S I2=I2+1 ..S ST=%L1OUT("KOT") D D PC S I2=I2+1 ...I '$$^%L1DISP(USTR),$D(%L1OUT("MDP","B")) S ST=%L1OUT("MDP","B")_$TR($TR($$CENTRB^%L1FRM(ST,%L1OUT("MDP","GWPC")),TS0,TSS),TS1,TSS)_%L1OUT("MDP","N") Q ...S ST=%CLI_$$CENTR^%L1FRM(ST,%L1OUT("MDP","GWPC"))_%CCL .N N S N="" F S N=$O(%L1OUT("KOT",N)) Q:N="" S ST=$TR($TR(%L1OUT("KOT",N),TS0,TSS),TS1,TSS) D PC S I2=I2+1 I $D(SM) S %L1OUT("SM")=SM Q SHAP1 ; Q:$D(%L1OUT("ARX")) I $G(%L1OUT("LOGO")) D .N %I,ST F %I=1:1:%L1OUT("LOGO") S ST="" D PC N ST,%AT S %TIM=$ZD($H,"24:60") S ST=" "_$TR($TR($$^%L1DC($H,1)_" "_%TIM_" "_$$^%L1DC($H,9)_" mei : d`ved onf",TS0,TSS),TS1,TSS) D PC S %AT=$$^%L1HEAD("") I '$$^%L1DISP(USTR) S %AT=$TR($TR(%AT,TS0,TSS),TS1,TSS) I '$$^%L1DISP(USTR),$G(%L1OUT("SUG"))=7,$L(%AT) S ST=%CLI_$$CENTR^%L1FRM($TR($$SPC^%L1FRM(%AT),"#_",""),%L1OUT("MDP","GWPC"))_%CCL D PC S ST="" D PC Q I $L(%AT),USTR,USTR<51!(USTR>53),$D(%L1OUT("MDP","B")) S ST=%L1OUT("MDP","B")_$TR($TR($$CENTRB^%L1FRM($TR(%AT,"#_",""),%L1OUT("MDP","GWPC")),TS0,TSS),TS1,TSS)_%L1OUT("MDP","N") D PC S ST="" D PC Q I $L(%AT) S ST=%CLI_$$CENTRB^%L1FRM($TR(%AT,"#_",""),%L1OUT("MDP","GWPC"))_%CCL D PC S ST="" D PC Q TS ; S TS=$C(68) F J=69:1:94 S TS=TS_$C(J) S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) S TS1=$C(160) F J=161:1:186 S TS1=TS1_$C(J) S TSS=$C(128) F J=129:1:154 S TSS=TSS_$C(J) S TSE=$C(64) F J=65:1:90 S TSE=TSE_$C(J) Q DEFMDP(MDPS) K %L1OUT("MDP") S %L1OUT("MDP","BEEP")="" S MDPS=$TR(MDPS," ","") I MDPS=1 D .S %L1OUT("MDP","B")=$C(30),%L1OUT("MDP","N")=$C(31),%L1OUT("MDP","R")=$C(18) .S %L1OUT("MDP","RL")="",%L1OUT("MDP","P")=$C(7),%L1OUT("MDP","BEEP")="",%L1OUT("MDP","CUT")="",%L1OUT("MDP","GWPC")=40,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=%L1OUT("MDP","PRG") ; CITIZEN 3530 .S %L1OUT("MDP","COND")="",%L1OUT("MDP","NOCOND")="" I MDPS=2 D .S %L1OUT("MDP","B")=$C(14),%L1OUT("MDP","N")=$C(20),%L1OUT("MDP","R")=$C(27,52),%L1OUT("MDP","RL")=$C(27,53) .S %L1OUT("MDP","P")=$C(29),%L1OUT("MDP","BEEP")="",%L1OUT("MDP","CUT")="",%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=%L1OUT("MDP","PRG"),%L1OUT("MDP","GWPC")=22 ;-- STAR-24 .S %L1OUT("MDP","COND")="",%L1OUT("MDP","NOCOND")="" I MDPS=3 D .S %L1OUT("MDP","B")=$C(14),%L1OUT("MDP","N")=$C(15),%L1OUT("MDP","R")=$C(19),%L1OUT("MDP","RL")="" .S %L1OUT("MDP","P")=$C(7),%L1OUT("MDP","BEEP")=$C(30),%L1OUT("MDP","CUT")=$C(27,80,0),%L1OUT("MDP","GWPC")=40,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=%L1OUT("MDP","PRG") ;-- CITIZEN 3540,3541 .S %L1OUT("MDP","COND")="",%L1OUT("MDP","NOCOND")="" I MDPS=4 S %L1OUT("MDP","B")=$C(27,87,49),%L1OUT("MDP","N")=$C(27,87,48),%L1OUT("MDP","R")="" D .S %L1OUT("MDP","RL")="",%L1OUT("MDP","P")=$C(27,112,50,50),%L1OUT("MDP","CUT")=$C(27,105),%L1OUT("MDP","GWPC")=40,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=%L1OUT("MDP","PRG") ;-- CITIZEN 3540,3541 ;-- SENOR .S %L1OUT("MDP","COND")="",%L1OUT("MDP","NOCOND")="" I MDPS=5 S %L1OUT("MDP","B")=$C(27)_"W1",%L1OUT("MDP","N")=$C(27)_"W0",%L1OUT("MDP","R")="" D .S %L1OUT("MDP","RL")="",%L1OUT("MDP","P")="",%L1OUT("MDP","CUT")="",%L1OUT("MDP","GWPC")=80,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=$C(13,12) ;-- CITIZEN 3540,3541 ;-- CITIZEN 90,240 .I $D(%L1OUT("PRINTER","SMALL")) S %L1OUT("MDP","GWPC")=128 .S %L1OUT("MDP","COND")=$C(15),%L1OUT("MDP","NOCOND")=$C(18) I MDPS=6 S %L1OUT("MDP","B")=$C(27,33,40),%L1OUT("MDP","N")=$C(27,33,8),%L1OUT("MDP","R")="" D .S %L1OUT("MDP","RL")="",%L1OUT("MDP","P")=$C(27)_"p"_$C(0)_"14",%L1OUT("MDP","CUT")=$C(27)_"m",%L1OUT("MDP","GWPC")=40,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=%L1OUT("MDP","PRG") ;-- CITIZEN 3540,3541 .S %L1OUT("MDP","COND")="",%L1OUT("MDP","NOCOND")="" ;;I MDPS=7 S %L1OUT("MDP","B")=$C(27)_"(s3B",%L1OUT("MDP","N")=$C(27)_"(s0B",%L1OUT("MDP","R")="" D I MDPS=7 S %L1OUT("MDP","B")="",%L1OUT("MDP","N")="",%L1OUT("MDP","R")="" D .S %L1OUT("MDP","B")=$C(27)_"(s3B",%L1OUT("MDP","N")=$C(27)_"(s0B" .S %L1OUT("MDP","RL")="",%L1OUT("MDP","P")="",%L1OUT("MDP","CUT")="",%L1OUT("MDP","GWPC")=80,%L1OUT("MDP","PRG")=$C(10,10,10,10,10,10),%L1OUT("MDP","PG")=$C(12) .;;S %L1OUT("MDP","N")=$C(27)_"&k2S",%L1OUT("MDP","B")=$C(27)_"&k4S" .;;S %L1OUT("MDP","COND")=$C(27)_"(s17H",%L1OUT("MDP","NOCOND")=$C(27)_"(s12H" .S %L1OUT("MDP","COND")=$C(27)_"(s16H",%L1OUT("MDP","NOCOND")=$C(27)_"(s10H" Q UUSTR(N) ; I $$MDPNET(N) U "SCK$"_$J Q U N:(NOWRAP) Q MDPNET(N) ; I $G(N)?1N.N1"."1N.E Q 1 Q 0 CUSTR(N) ; I $$MDPNET(N) H 1 C "SCK$"_$J Q H 1 C N Q %L1OW %L1OW ;-- VARIABLES VALUE SHOW [ 05/23/99 5:21 PM ] [ U $P:(NOECHO:NOWRAP) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER" W !!,"-->" S %S="" D ^%ZMSL Q:%S="" D IN G %L1OW Q IN F %I=1:1:$L(%S,";") S %VAR=$P(%S,";",%I),%PR=0 W !,%VAR,"=" D .I $E(%VAR,$L(%VAR))=":" S %VAR=$E(%VAR,1,$L(%VAR)-1),%PR=1 .I $D(@%VAR)=0 W "" Q .I $D(@%VAR)=1 W @%VAR Q .I $D(@%VAR)>1 ZWR @%VAR ;I %PR W ! S MAC=%VAR N (MAC,@%VAR) D @$S($E(MAC)="^":"^%S1PCGL",1:"^%S1GLPCL") Q .W $S('($D(@%VAR)#2):"",1:@%VAR) Q ER W !,*7,"*** ERROR: ",$ZS W !,$G(%VAR) S $ZS="" G %L1OW %L1PC %L1PC ; [ 10.07.06 16:49 ] [ 07.02.06 08:15 ] [ 13.01.06 12:46 ] ;INPUT :%REPN - REPORT CODE ; %REPN(... - REPORT PARAMETERS ; ; %L1PC("SHEIL") - PROG FOR SHEILTA ; %L1PC("SHEIL1") - DOP. ZAPROSY ; ; ^rep(%REPN,"MIUN","PROG") - PROGR. VMESTO PROC. MIUN ( -> ^TREPK($P)) ; ^rep(%REPN,"SIX") - GORIZ. COMM. FOR SIKUMIM ; ; I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"M2")) X ^("M2") S OUTFL=@^rep(%REPN,0,A,"OUT") D SAVFL Q ; I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"FILE")) D Q ; .N FILE S FILE=^rep(%REPN,0,A,"FILE") S OUTFL=$G(@FILE@(INFL)) D SAVFL ;------------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%REPN,%L1PC,MAS,USTR) D ^%L1C I $E(%TYPCRT,1,3)="VT5" W $C(17,27,91)_"?108h",$C(27,91)_"?35h" ;-- NUM LOCK(DECNUMLK),HEB (DECHEBM) BG ; K (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%REPN,%L1PC,MAS,USTR) D ^%L1C I %REPN["m" S %REPN=$P(%REPN,"m") K ^L1PCSND($P) I $D(^rep(%REPN,"QUERY")),$O(^rep(%REPN,"QUERY",$O(^rep(%REPN,"QUERY",""))))'="" X %chista S %LAB="ENDPC" G QUERY G V0 QUERY I $D(^rep(%REPN,"QUERY")) D I $G(FLAG)'="" S:%LAB="ENDPC" %BS=1 G @%LAB .N %LAB,%L1,INDEX,MAC .S MAC="^rep(%REPN,""QUERY"")",%L1("EU")=3 .I $G(%OLDIND) S %L1("IND")=%OLDIND .S %L1("T1")=" g""ec zxevz xegal `p " .S %L1("TXT1")="%NXN" .S %L1("BE")=4 D ^%L1NU .Q:FLAG'="" Q:INDEX="" S QUERY=INDEX,%OLDIND=INDEX("N") .N I F I="MIUN","SIK0","CT","FLD0" S ^rep(%REPN,I)=$G(^rep(%REPN,"QUERY",QUERY,I)) ; V0 D ^%L1PCIN ; X %chista S %L1GET="" D SHEIL K %L1GET ; ----- VISV. SHEIL. ; Z I $D(%L1PC("SHEIL")) G ENDPC S %SAY="" I $L($G(QUERY)) S %SAY=" +E - """_$$SPA^%L1FRM($$HBR^%L1FRM(QUERY,40))_""" `zli`y lehia " S %SAY=%SAY_"++23,78,HH" X %XMSG S %ZMSF="",%GET=" - mixhnxt zxiny , - g""ecd akxda iepiy , - zezl`y zniyx " D N^%L1GET I %TO="F9" S %S=99 S FLMODIF=FLMODIF+1 I %TO="DEL",$L($G(QUERY)) K ^rep(%REPN,"QUERY",QUERY) S QUERY="" G BG S %SAY="++23,78,HH,,,C" X %XMSG I %TO="F7" S %LAB="V0" G QUERY I %TO="F10" D SAVE G Z ; I (%S=99) D S %LAB="V0" G V0 ;--- BITUL SADOT MEJUTAROT .S %HBRY="" N I,J,A,A1,O,%MBS F I=1:1:$L(^rep(%REPN,"FLD"),"*") D ..S A=$P(^("FLD"),"*",I),A1="" ..I $L(A) S A1=$P(^rep(%REPN,0,A),";") ..S %MBS("Z",I)=A1,%MBS("O",I)=$P($G(^rep(%REPN,"FLD0")),"*",I) ..S %MBS("D",I,1)=1 ..S %MBS("S",I)="-",%MBS("RGS",I)="E" .S %MBS("DZ")=14,%MBS("N")=" miievx `l zecy ""-""a onql `p " D ^%S3BST .S O="" F I=1:1 Q:'$D(%MBS("O",I)) S O=O_%MBS("O",I)_"*" .I $G(^rep(%REPN,"FLD0"))'=$E(O,1,$L(O)-1) S FLMODIF=FLMODIF+1 .S ^rep(%REPN,"FLD0")=$E(O,1,$L(O)-1) ; S D SHEIL1^%L1PCS K %L1GET ; ---- VERXN. SHEILTA I %BS,$O(^rep(%REPN,"QUERY",$O(^rep(%REPN,"QUERY",""))))'="" X %chista S %LAB="ENDPC" G QUERY ENDPC I %BS K %L1PC,MAS,%REPN Q ;----------------------- END ; S MM=0 F I=1:1:MAXMIUN I $G(MIUN(I))>MM,$G(MIUN(I))MAXMIUN S %SAY=" icn lecb oein 'qn " X %XMSGN(1) G S F I=1:1:MAXMIUN F J=I+1:1:MAXMIUN I +MIUN(I),+MIUN(I)=+MIUN(J) S %SAY=" ! miinrt ywed oein xtqn eze` " X %XMSGN(1) G S ; S3 D SHEIL31^%L1PCS I %BS G S ; --- NIJN. SHEILTA ; S31 S SIKUM="" I $G(%L1PC("SIK0"))[1!($G(%L1PC("SIK"))[1) S %GET=" - minekiq wx " D N^%L1GET G:$G(%TO)="END" S S:%TO="F9" %S=99 S SIKUM=%S S2 ; F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") D .S COD=$P(%L1PC("FLD"),"*",IJK) K @("ME"_COD),@("AD"_COD) ; S %SRKM=0 G:SIKUM M1 S %GET=" - mitqep mikezig zeyrl " D N^%L1GET G:%TO="END" S3 S:%TO="F9" %S=99 G:%S'=99 M1 ; ---------- HITUHIM NOSAFIM -------- S %L1GET="" D SHEIL2 K %L1GET D SHEIL2 I %BS D K %L1PC("SHP"),%L1PC("COD") G V0 .F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) K @("ME"_COD),@("AD"_COD) ; M1 ; S J=0 F I=1:1:MAXMIUN D .S J=J+1 M2 .I $P($G(^rep(%REPN,"FLD0")),"*",J)="-" S J=J+1 G M2 .N K F K="MIUN","SIK0","CT" D ..S:$P($G(^rep(%REPN,K)),"*",J)'=$S(K="SIK0":SIK(I),1:@K@(I)) FLMODIF=FLMODIF+1 ..S $P(^rep(%REPN,K),"*",J)=$S(K="SIK0":SIK(I),1:@K@(I)) ; ZU K %L1PC("L1PCPRM") I $$^%L1MRK=1000,$$ADSL^%L1PORT D ^%L1PCSND G:'$G(%L1PCOK) BG I %L1PCOK=1 S %L1PC("L1PCPRM")="" ; S %GETIN=0 S %GET=": - mixhnxt zxiny ,0 - jqn , 3 - zqtcn " D N^%L1GET K %GETIN I %TO="F10" D SAVE G ZU I %S=""!($G(%TO)="END") G S3 S USTR=%S I USTR D LPT G:%EROP ZU ; I '$D(%L1PC("L1PCPRM")) D ^%L1PCP ; S KOTNUM=1 I '$D(^TREPK($P)) W *7 S %GET=".jyndl ywd .dbvdl mipezp oi`" D N^%L1GET G END ; ALDSP S %L1PC("FILE")="TREPK" I '$$^%L1DISP(USTR) X %chista D ^%L1PC1 K ^TREP($J),^TREPK($P),^TREPK0($P) END ; G BG ; KAV S %STRING="" F JJ=1:1:3 S %STRING=%STRING_"-----------------------------------*" D SAVST S PRSUM=1 Q ; SHEIL D SHEIL^%L1PCS Q LPT ; S %EROP=0 I $$^%L1DISP(USTR) Q S %DEV="USTR" D ^%L1LPT Q SHEIL2 D SHEIL2^%L1PCS ; Q SHEIL3 D SHEIL3^%L1PCS Q SAVE ; S %GET=" `zli`yd my ++22,75,HH,,R#"_$G(QUERY)_"++60,H,I++++++^rep(%REPN,""QUERY"")\60\1\16" D ^%L1GET G:%S=""!(%TO="END") ESAVE S QUERY=$$SPA^%L1FRM(%S) D KOT I $D(^rep(%REPN,"QUERY",QUERY)) S %GET=" 99 - xey`l . zniiw xak `zli`y " D N^%L1GET G:%S'=99&(%TO'="F9") ESAVE N I F I="MIUN","SIK0","CT","FLD0" D .S ^rep(%REPN,"QUERY",QUERY,I)=$G(^rep(%REPN,I)) S %GET=" . dnlyed dxiny " D N^%L1GET ESAVE N %YY S %YY=21,%XX=0 X %POSIC X %chiste Q KOT U $P S %SAY=" "_$G(QUERY)_" : "_$G(^rep(%REPN)) X %XMSGV Q SAVST S MONE=$O(^TREPK($P,999999),-1)+1 S ^TREPK($P,MONE)=%STRING S ^TREPK($P)=MONE Q %L1PC0 %L1PC ; [ 26.12.04 17:47 ] [ 17.05.04 18:51 ] [ 17.02.04 09:06 ] ;INPUT :%REPN - REPORT CODE ; %REPN(... - REPORT PARAMETERS ; ; %L1PC("SHEIL") - PROG FOR SHEILTA ; %L1PC("SHEIL1") - DOP. ZAPROSY ; ; ^rep(%REPN,"MIUN","PROG") - PROGR. VMESTO PROC. MIUN ( -> ^TREPK($P)) ; ^rep(%REPN,"SIX") - GORIZ. COMM. FOR SIKUMIM ; ; I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"M2")) X ^("M2") S OUTFL=@^rep(%REPN,0,A,"OUT") D SAVFL Q ; I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"FILE")) D Q ; .N FILE S FILE=^rep(%REPN,0,A,"FILE") S OUTFL=$G(@FILE@(INFL)) D SAVFL ;------------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%REPN,%L1PC,MAS,USTR,%REPN) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" BG K (%REPN,USTR,MAS,QUERY,%SMI,%OLDIND) D ^%L1C S FLMODIF=0 S %ENGLISH=0 I $E(%TYPCRT,1,3)="VT5" W $C(17,27,91)_"?108h",$C(27,91)_"?35h" ;-- NUM LOCK(DECNUMLK),HEB (DECHEBM) S %N="" F S %N=$O(%REPN(%N)) Q:%N="" S @%N=%REPN(%N) I $D(^rep(%REPN,"QUERY")),$O(^rep(%REPN,"QUERY",$O(^rep(%REPN,"QUERY",""))))'="" X %chista S %LAB="ENDPC" G QUERY G V0 QUERY I $D(^rep(%REPN,"QUERY")) D I $G(FLAG)'="" S:%LAB="ENDPC" %BS=1 G @%LAB .N %LAB,%L1,INDEX,MAC .S MAC="^rep(%REPN,""QUERY"")",%L1("EU")=3 .I $G(%OLDIND) S %L1("IND")=%OLDIND .S %L1("T1")=" g""ec zxevz xegal `p " .S %L1("TXT1")="%NXN" .S %L1("BE")=6 D ^%L1NU Q:FLAG'="" Q:INDEX="" S QUERY=INDEX,%OLDIND=INDEX("N") .N I F I="MIUN","SIK0","CT","FLD0" S ^rep(%REPN,I)=$G(^rep(%REPN,"QUERY",QUERY,I)) ; V0 S %L1PC("FLD")="",%L1PC("MIUN")="",%L1PC("SIK0")="",%L1PC("CT")="" F %I=1:1:$L(^rep(%REPN,"FLD"),"*") D .N %FLD S %FLD=$P(^rep(%REPN,"FLD"),"*",%I) Q:%FLD="" .;;I $P($G(^rep(%REPN,"FLD0")),"*",%I)'="-",$G(^rep(%REPN,0,%FLD,"SH"))'=0 D .I $P($G(^rep(%REPN,"FLD0")),"*",%I)'="-" D ..S %L1PC("FLD")=%L1PC("FLD")_%FLD_"*" ..S %L1PC("MIUN")=%L1PC("MIUN")_$P($G(^rep(%REPN,"MIUN")),"*",%I)_"*" ..S %L1PC("SIK0")=%L1PC("SIK0")_$P($G(^rep(%REPN,"SIK0")),"*",%I)_"*" ..S %L1PC("CT")=%L1PC("CT")_$P($G(^rep(%REPN,"CT")),"*",%I)_"*" .I $P($G(^rep(%REPN,"FLD0")),"*",%I)="-" D ..N A S A=$P(^rep(%REPN,"FLD"),"*",%I) ..S @("ME"_A)="" ..S @("AD"_A)=$TR($J("",+$P(^rep(%REPN,0,A),";",2))," ",9) S %L1PC("FLD")=$E(%L1PC("FLD"),1,$L(%L1PC("FLD"))-1) S %L1PC("MIUN")=$E(%L1PC("MIUN"),1,$L(%L1PC("MIUN"))-1) S %L1PC("SIK0")=$E(%L1PC("SIK0"),1,$L(%L1PC("SIK0"))-1) S %L1PC("CT")=$E(%L1PC("CT"),1,$L(%L1PC("CT"))-1) S %L1PC("SIK")="" S %J=0 F %I=1:1:$L(^rep(%REPN,"FLD"),"*") D .S A=$P(^("FLD"),"*",%I) I $E(A)="x",$P($G(^("FLD0")),"*",%I)'="-" D ..S %L1PC("SIK")=%L1PC("SIK")_$P(^rep(%REPN,"SIK"),"*",$E(A,2,3))_"*" S %L1PC("SIK")=$E(%L1PC("SIK"),1,$L(%L1PC("SIK"))-1) S ONLYSIK=0,MONE=0 K ^TREP($P),^TREPK($P) F I=1:1:$L(%L1PC("FLD"),"*") S A=$P(%L1PC("FLD"),"*",I) Q:A["x" ;------------ MAXMIUN - SPISOK PRIZN.REKV, COLG - SPISOK KOL. REKV. S MAXMIUN=I-(%L1PC("FLD")["*x"),COLG=$L(%L1PC("FLD"),"*")-MAXMIUN S COLGM=$L($P(^rep(%REPN,"FLD"),"*x1*",2),"*")+1 X %chista S GLOB1=^rep(%REPN,"GLOB1"),GLOB2=^rep(%REPN,"GLOB2") S %BS=0,FRST=1 V ; K MIUN,SIK,CT F I=1:1:MAXMIUN D .S MIUN(I)=$S($P(%L1PC("MIUN"),"*",I)>MAXMIUN:"",1:$P(%L1PC("MIUN"),"*",I)) .S SIK(I)=$P(%L1PC("SIK0"),"*",I) .S CT(I)=$P(%L1PC("CT"),"*",I) ;-- KOTERET ;;G:$D(%L1PC("SHEIL")) S ;---------------- SVOJA PROC DLQ SHEILTY S %L1GET="" D SHEIL K %L1GET ; ----- VISV. SHEIL. ; Z I $D(%L1PC("SHEIL")) G ENDPC S %SAY="" I $L($G(QUERY)) S %SAY=" +E - """_$$SPA^%L1FRM($$HBR^%L1FRM(QUERY,40))_""" `zli`y lehia " S %SAY=%SAY_"++23,78,HH" X %XMSG S %ZMSF="",%GET=" - jiyndl, - g""ec ixhnxt zxiny , - g""ecd akxda iepiy " D N^%L1GET I %TO="F9" S %S=99 S FLMODIF=FLMODIF+1 I %TO="DEL",$L($G(QUERY)) K ^rep(%REPN,"QUERY",QUERY) S QUERY="" G BG S %SAY="++23,78,HH,,,C" X %XMSG I %TO="F7" S %LAB="V0" G QUERY I %TO="F10" D SAVE G Z I (%S=99) D S %LAB="V0" G V0 ;--- BITUL SADOT MEJUTAROT .S %HBRY="" N I,J,A,A1,O,%MBS F I=1:1:$L(^rep(%REPN,"FLD"),"*") D ..S A=$P(^("FLD"),"*",I),A1="" ..I $L(A) S A1=$P(^rep(%REPN,0,A),";") ..S %MBS("Z",I)=A1,%MBS("O",I)=$P($G(^rep(%REPN,"FLD0")),"*",I) ..S %MBS("D",I,1)=1 ..S %MBS("S",I)="-",%MBS("RGS",I)="E" .S %MBS("DZ")=14,%MBS("N")=" miievx `l zecy ""-""a onql `p " D ^%S3BST .S O="" F I=1:1 Q:'$D(%MBS("O",I)) S O=O_%MBS("O",I)_"*" .I $G(^rep(%REPN,"FLD0"))'=$E(O,1,$L(O)-1) S FLMODIF=FLMODIF+1 .S ^rep(%REPN,"FLD0")=$E(O,1,$L(O)-1) ; S D SHEIL1^%L1PCS K %L1GET I %BS,$O(^rep(%REPN,"QUERY",$O(^rep(%REPN,"QUERY",""))))'="" X %chista S %LAB="ENDPC" G QUERY ENDPC I %BS K %L1PC,MAS,%REPN Q ;----------------------- END ; S MM=0 F I=1:1:MAXMIUN I $G(MIUN(I))>MM,$G(MIUN(I))MAXMIUN S %SAY=" icn lecb oein 'qn " X %XMSGN(1) G S F I=1:1:MAXMIUN F J=I+1:1:MAXMIUN I +MIUN(I),+MIUN(I)=+MIUN(J) S %SAY=" ! miinrt ywed oein xtqn eze` " X %XMSGN(1) G S S3 D SHEIL31^%L1PCS I %BS G S S31 S SIKUM="" I $G(%L1PC("SIK0"))[1!($G(%L1PC("SIK"))[1) S %GET=" - minekiq wx " D N^%L1GET G:$G(%TO)="END" S S:%TO="F9" %S=99 S SIKUM=%S S2 ; F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) K @("ME"_COD),@("AD"_COD) S %SRKM=0 G:SIKUM M1 S %GET=" - mitqep mikezig zeyrl " D N^%L1GET G:%TO="END" S3 S:%TO="F9" %S=99 G:%S'=99 M1 S %L1GET="" D SHEIL2 K %L1GET D SHEIL2 I %BS D K %L1PC("SHP"),%L1PC("COD") G V0 .F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) K @("ME"_COD),@("AD"_COD) ; ; MIUN - SAVE PRIZN MIUN ; SIK0 - SAVE PRIZN SUMM ; CT - SAVE PRIZN KOT ; M1 K MIUN1 S J=0 F I=1:1:MAXMIUN D .S J=J+1 S MIUN1(+MIUN(I))=$G(MIUN(I)) M2 .I $P($G(^rep(%REPN,"FLD0")),"*",J)="-" S J=J+1 G M2 .N K F K="MIUN","SIK0","CT" D ..S:$P($G(^rep(%REPN,K)),"*",J)'=$S(K="SIK0":SIK(I),1:@K@(I)) FLMODIF=FLMODIF+1 ..S $P(^rep(%REPN,K),"*",J)=$S(K="SIK0":SIK(I),1:@K@(I)) ZU S %GETIN=0 S %GET=": 0,'ONLYSIK S SIK(MIUN(MAXMIUN))=0 ; ------------------------- SEDM - PERESORT SPISOK PR. REKV. ; ------------------------- SEDSM - PERESORT SPISOK PRIZ. SIK. S SEDM=%L1PC("FLD"),SEDSM="" F JJ=1:1:MAXMIUN D .S A=$P(%L1PC("FLD"),"*",JJ) .S $P(SEDM,"*",MIUN(JJ))=A .S $P(SEDSM,"*",MIUN(JJ))=$S(+SIK(JJ)=0:0,1:1) S N="" F S N=$O(CT(N)) Q:N="" D .I CT(N)=1 D Q ..S N1="" F S N1=$O(CT(N1)) Q:N1="" I MIUN(N1)@("AD"_IN(K)) S OK=$S(%NMB:2,1:0) Q .I $D(^rep(%REPN,"US",$L(GLOB,","))) D Q:OK'=1 ..N JJ F JJ=1:1:20 S @("x"_JJ)="" ..X ^rep(%REPN,"US",$L(GLOB,",")) .I $L(GLOB,",")=$L(GLOB2,",") D Q:OK'=1 ..N %IND ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" I $D(@%IND)#2 S %INDOLD(II)=@%IND ..S GLO="^TREP($P," ..;;N LL S LL=$P($G(^rep(%REPN,0,$P(SEDM,"*",II))),";",2) ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" D ...N LL S LL=$P($G(^rep(%REPN,0,$P(SEDM,"*",II))),";",2) ...S:$G(@%IND)="" @%IND=" - " S @%IND=$TR(@%IND,",*""()"," X'[]") ...I $L($P(SEDM,"*",II)),LL["D",@%IND["/"!(@%IND[".") S @%IND=$$^%L1DC(@%IND,3) ...F JJ=1:1 Q:'$D(MIUN(JJ)) Q:+MIUN(JJ)=II ...I $D(MIUN(JJ)),MIUN(JJ)["!",$D(^rep(%REPN,0,$P(SEDM,"*",II),"FILE")),$E(^("FILE"))'="+" D ....N A,A1,A2 S A2=$G(^("FILE")) Q:A2="" ....S A=$G(@A2@(@$P(SEDM,"*",II))) ....I A2="^PAR" S A=$P(A,"**") ....S A=$TR($E(A,$L(A)-9,$L(A)),",*""()"," X'[]") ....S A1="" F JJ=1:1:10 S A1=$E(A,JJ)_A1 ....S A1=A1_$J("",10-$L(A1))_$J(@$P(SEDM,"*",II),+LL) ....S @%IND=A1 S:@%IND="" @%IND=" " ...S GLO=GLO_%IND_"," ..S GLO=$E(GLO,1,$L(GLO)-1)_")" ..F JJ=1:1:COLGM I $G(@("MEx"_JJ))!$G(@("ADx"_JJ)) S %SRKM=1 Q ..S OK=1 I %SRKM D ;---------- HITUHIM NOSAFIM ...F JJ=1:1:COLGM S A1=$G(@("x"_JJ)) I $D(@("MEx"_JJ)),$D(@("ADx"_JJ)),A1<@("MEx"_JJ)!(A1>@("ADx"_JJ)) S OK=0 Q ..Q:'OK ..S ST="" S:'$D(@GLO) @GLO="" F JJ=1:1:COLG S A1=@$P(%L1PC("FLD"),"*",MAXMIUN+JJ) S $P(@GLO,"*",JJ)=$S($P(%L1PC("SIK"),"*",JJ):$P($G(@GLO),"*",JJ)+A1,1:A1) ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" I $D(%INDOLD(II))#2 S @%IND=%INDOLD(II) ..K %INDOLD I @IN(K)=""!(OK=2) S K=K-1 G:KK2 S K=K-1 G LP1 S GLOB=$E(GLOB,1,$L(GLOB)-1) G LP EMIUN ; Q FORM N I,IN,IND,K,K1,K2,LEVELBG,FIRSTS,GLOB,GLOBO,PRITOG,%STRING ; ;---- INPUT : GLOB (^TREP($P,...),SEDM - OTSORT. FILE ; OUTPUT: ^TREPK($P,... - VIX.FORMA S SIKUMIMAMI ; WORK : IN(I) - MAS.REKV-IND IN GLOB ( GLOB(@IN(1),@IN(2),...) ; K - LEVEL COUNTER ; K2 - MAX.COL. IND (PROST.STR) ; K1 - MIN.COL. IND ;--------------------------------------------------- S %SAY=" g""ec zwtdl oznd `p` " X %XMSGN F I=1:1:$L(SEDM,"*") S IN(I)=$P(SEDM,"*",I) S K=1,K1=1,K2=MAXMIUN+1,GLOB="^TREP($P",FIRSTS=0 K INO S PRITOG=0 ;;;;;; S GLOB=GLOB_","""")" S GLOB=$Q(@GLOB) Q:GLOB="" Q:$P(GLOB,",")'=("^TREP("""_$P_"""") D IND(GLOB) FRM1 F I=1:1:$L(IND,",") S INO(I)=$P(IND,",",I),@IN(I)=INO(I) D:FIRSTS STRSHP D:'ONLYSIK PROST S K=$L(IND,",") D SIK S FIRSTS=0 S GLOB=$Q(@GLOB) G:GLOB="" FORME G:$P(GLOB,",")'=("^TREP("""_$P_"""") FORME D IND(GLOB) F I=1:1:$L(IND,",") I $P(IND,",",I)'=INO(I) D Q .F K=$L(IND,","):-1:I D STRSIK .I I'>MCT S FIRSTS=1 F I=1:1:$L(IND,",") S @IN(I)=$P(IND,",",I) G FRM1 FORME F K=$L(IND,","):-1:0 D STRSIK Q IND(GLOB) S:GLOB["^[" GLOB=$P(GLOB,"]",2) S:GLOB["^|" GLOB=$P(GLOB,"|",3) S IND=$P($P(GLOB,"(",2),")") N IND1,IND2,I S IND1="" F I=2:1:$L(IND,",") S IND2=$P(IND,",",I) S:$E(IND2)="""" IND2=$P(IND2,"""",2) S IND1=IND1_IND2_"," S IND=$E(IND1,1,$L(IND1)-1) Q PROST ; Q:ONLYSIK N %STRING,A,INFL,JJ,JJ1 I PRITOG D S PRITOG=0 .N IND S IND=$O(^TREPK($P,99999),-1) I IND,^TREPK($P,IND)'?1"#"."#" S %STRING="" D SAVST PROST1 S %STRING="" F JJ=1:1:MAXMIUN S INFL=@IN(JJ),A=IN(JJ) D OUTFL S JJ1=0 S %STRING=%STRING_$G(@GLOB) D SAVST Q SAVST S MONE=$O(^TREPK($P,999999),-1)+1 S ^TREPK($P,MONE)=%STRING S ^TREPK($P)=MONE Q SIK ; K - UR, LASTFN - STR. KODOV DLQ PECH, SUMFL - STR. SUM N ST,KK S ST=@GLOB F KK=0:1:K F JJ=1:1:COLG I $P(%L1PC("SIK"),"*",JJ) S SUM(KK,JJ)=$G(SUM(KK,JJ))+$P(ST,"*",JJ) F KK=1:1:K S INO(KK)=@IN(KK) Q STRSHP ; N %STRING S %STRING="#############" D SAVST Q STRSIK ; ;------------------- FORM ITOG STROKI DLQ PECHATI ( FROM "K" UR). Q:($P(SEDSM,"*",K)'[1)&(K>0) ;-- NET PR. SIK N %STRING,INFL,A,I,J,JJ,JJ1,JJJ,IND S %STRING="" STRSIKA ; S JJ1=0 F JJ=K+1:1:$L(SEDSM,"*") I $P(SEDSM,"*",JJ)>0 S JJ1=JJ1+1 ;-- JJ1=0 -> POSL. ITOG I ONLYSIK,'JJ1,PRITOG D S PRITOG=0 S %STRING="" ;PUST STR. POSLE ITOGA (ONLYSIK) .N IND S IND=$O(^TREPK($P,99999),-1) I IND,^TREPK($P,IND)'?1"#"."#" S %STRING="" D SAVST S %STRING="" I 'ONLYSIK!(ONLYSIK&JJ1) D S PRITOG=1 ;-- PREDITOG. STR. .F SP=FLDNUM-COLG+1:1:FLDNUM S %STRING=%STRING_"===========*" .D SAVST S %STRING="" ;------ ITOG. STR F JJ=1:1:K S INFL=INO(JJ),A=IN(JJ) D OUTFL F JJ=$L(%STRING,"*"):1:FLDNUM-COLG S OUTFL=$TR($J("",16)," ","-") D SAVFL ;;I 'JJ1,ONLYSIK,$L(GLOB) G ESS I 'JJ1,ONLYSIK G ESS I $P(SEDM,"*",K)'="" D .S $P(%STRING,"*",FLDNUM-COLG-2)=$TR($J("",16)," ","-") .N A,D S A=$G(^rep(%REPN,0,$P(SEDM,"*",K))),D=$P(A,";",2) .S $P(%STRING,"*",FLDNUM-COLG-1)=$P(A,";") .S $P(%STRING,"*",FLDNUM-COLG)=$S(D["D":$$^%L1DC(INO(K),1),$G(MIUN1(K))["!":$$INV^%L1FRM(INO(K)),1:INO(K)) ESS ; I $D(^rep(%REPN,"SIX")) D ;-- PKUDA L SHURA SIKUMIM ( HORIZ ) .N JJ,JJ1,ER F JJ=1:1:$L(^rep(%REPN,"FLD"),"*") Q:$E($P(^("FLD"),"*",JJ))="x" .S ER=0 .F JJ1=JJ:1:$L(^rep(%REPN,"FLD"),"*") I $E($P($G(^("FLD0")),"*",JJ1))="-" S ER=1 Q .I 'ER,$D(^rep(%REPN,"SIX")) X ^("SIX") ;-- PKUDA L SHURA SIKUMIM ( HORIZ ) S JJ1=0 F JJ=FLDNUM-COLG+1:1:FLDNUM S JJ1=JJ1+1 S %STRING=%STRING_$J($G(SUM(K,JJ1)),2,2)_"*" D SAVST F J=K:1:MAXMIUN K SUM(J) Q ; OUTFL ;-- INFL --> OUTFL (FORM-E VIX. REKV IZ VX. V ZAVIS. OT ^rep(%REPN,0,A,..)) ; ^rep(%REPN,0,A,"OUT")=, -> INFL*F(INFL) ;; F(INFL)= X ^rep(%REPN,0,A,"M2") -> VRB ;----------------------------------------------------------------------- I INFL="" G OF1 Q:$G(A)="" ;;I $L(INFL)>10,INFL'?1N.N S INFL=$E(INFL,11,20) N LL S LL=+$P($G(^rep(%REPN,0,A)),";",2),INFL=$$SPA^%L1FRM($E(INFL,$L(INFL)-LL+1,255)) I $P($G(^rep(%REPN,0,A)),";",2)["D" D Q .S OUTFL=INFL .I INFL'["."&(INFL'["/"),$L(INFL)=6 S OUTFL=$E(INFL,5,6)_"/"_$E(INFL,3,4)_"/"_$E(INFL,1,2) .I INFL'["."&(INFL'["/"),$L(INFL)=8 S OUTFL=$E(INFL,7,8)_"/"_$E(INFL,3,4)_"/"_$E(INFL,1,2) .I INFL'["."&(INFL'["/"),$L(INFL)=5 S OUTFL=$$^%L1DC(INFL,1) .D SAVFL ;;I $G(^rep(%REPN,0,A,2))=2 S OUTFL=INFL D SAVFL X ^rep(%REPN,0,A,3) D SAVFL Q ;;I $G(^rep(%REPN,0,A,2))=3 X ^rep(%REPN,0,A,3) D SAVFL Q OF1 N DOT S DOT=$P($P($G(^rep(%REPN,0,A)),";",2),",",2) I DOT S OUTFL=$J(INFL,DOT,DOT) S OUTFL=INFL D SAVFL I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"M2")) X ^("M2") S OUTFL=$TR($G(@^rep(%REPN,0,A,"OUT")),"*""(),","X'[] ") D SAVFL Q I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"FILE")),$E(^("FILE"))'="+",INFL'="" D Q .N FILE S FILE=^rep(%REPN,0,A,"FILE") S OUTFL=$TR($G(@FILE@(INFL)),"*""(),","X'[] ") D SAVFL Q ; SAVFL S %STRING=%STRING_OUTFL_"*" Q ; INIT ; S %L1PC("COD")="" F JJ=1:1 S A=$P(SEDM,"*",JJ) Q:A="" S %L1PC("COD")=%L1PC("COD")_A_"*" I $D(^rep(%REPN,0,A,"OUT")) S %L1PC("COD")=%L1PC("COD")_^rep(%REPN,0,A,"OUT")_"*" S %L1PC("COD")=$E(%L1PC("COD"),1,$L(%L1PC("COD"))-1) S SEDFL=%L1PC("COD") ;---- SPISOK REKV DLQ PECH S FLDNUM=$L(%L1PC("COD"),"*") K SUM ; --- FLDNUM -- KOL REKV Q ; KAV S %STRING="" F JJ=1:1:3 S %STRING=%STRING_"-----------------------------------*" D SAVST S PRSUM=1 Q ; SHEIL D SHEIL^%L1PCS Q LPT ; S %EROP=0 I USTR=0!(USTR=$P) Q S %DEV="USTR" D ^%L1LPT ;U USTR W $C(27),"@",$C(15) Q SHEIL2 D SHEIL2^%L1PCS ; Q SHEIL3 D SHEIL3^%L1PCS Q SAVE ; S %GET=" `zli`yd my ++22,75,HH,,R#"_$G(QUERY)_"++60,H,I++++++^rep(%REPN,""QUERY"")\60\1\16" D ^%L1GET G:%S=""!(%TO="END") ESAVE S QUERY=$$SPA^%L1FRM(%S) D KOT I $D(^rep(%REPN,"QUERY",QUERY)) S %GET=" 99 - xey`l . zniiw xak `zli`y " D N^%L1GET G:%S'=99&(%TO'="F9") ESAVE N I F I="MIUN","SIK0","CT","FLD0" D .S ^rep(%REPN,"QUERY",QUERY,I)=$G(^rep(%REPN,I)) S %GET=" . dnlyed dxiny " D N^%L1GET ESAVE N %YY S %YY=21,%XX=0 X %POSIC X %chiste Q KOT S %SAY=" "_$G(QUERY)_" : "_$G(^rep(%REPN)) X %XMSGV Q %L1PC1 %L1PC1 ;NEW PROGRAM [ 20.09.07 15:17 ] [ 01.07.07 10:08 ] [ 12.06.07 12:12 ] ;INPUT: ---%L1PC("COD"),%L1PC("RZD"),%L1PC("FILE") ; %L1PC("F9"),%L1PC("F9","HELP") ;-------------------------------------- N A,COL1,COLRKV,DL,FLDNUM,FRSTFL,I,ID,LASTFL,POZ,TAB,TB0,TB,TB1,TB2,SMY,XX,XX0 N MK,MKIN1,MON,RR,RGS,RKV,PRITOG,SOF,VGR,RSTR,PRTN,FL,FLDNUM1,RKV1O,LASTRKV,LASTRKVN S PRTN=$P N GLOB,DLD S GLOB="^"_%L1PC("FILE")_"(PRTN,",%PG=1 K ^TREPK0(PRTN) S MAC1="^TREPK(PRTN)",MAC2="^TREPK0(PRTN)" D ^%S1GC1 A0 I $D(^rep(%REPN,"SHP","KOD")) S %L1PC("SHP","PAGE")=1,%L1PC("SHP","KOD")=^("KOD"),%L1PC("SHP","PROG")=$G(^("PROG")) S %L1PC("SHP","PRPC")=1 A S KOLM=1 S FLDNUM=$L(%L1PC("COD"),"*"),%HBRY="" S KOTNUM=1 S FRSTFL=1+$G(COL01) ;---- FORM. MAKETA S TAB="",RGS="",KOT(1)="",OK=1,DLD=0 F I=1:1:$L(%L1PC("COD"),"*") S ID=$P(%L1PC("COD"),"*",I) I ID'="" S:'$D(^rep(%REPN,0,ID)) OK=0 Q:'OK D .S DL=$P(^rep(%REPN,0,ID),";",2) .S TAB=TAB_DL_"*" I I'1 S LASTRKV=$P(%L1PC("FLD"),"*",I-1) Q I LASTRKV'="" F I=1:1:FLDNUM I LASTRKV=$P(%L1PC("COD"),"*",I) S LASTRKVN=I Q D MASAH S VGR=0 I $D(%L1PC("VGR")) S VGR=%L1PC("VGR") S SMY0=VGR+1 I $G(COL0) S VGR=VGR+3 S RSTR=21-VGR U 0 I '$$^%L1DISP(USTR) S RSTR=52-VGR I '$$^%L1DISP(USTR) S GW=$S(DLD>75:122,1:75) ;$$^%L1PCGW(%REPN) ;------------ OPR-E KOL REKV NA 1-J STR S MON=0 F I=FRSTFL:1:FLDNUM S A=$P(TAB,"*",I) Q:(MON+A+1>GW) S MON=MON+A+1,COL1=I ;I MON<75 S GW=75 I COLRKV0 .S %YY=(3+VGR),%XX=0 X %POSIC W %chists .K JJ S JJ=0 F I=FRSTFL:1:COL1 S A=$P(%L1PC("COD"),"*",I) I A?1U.U S JJ=JJ+1,JJ(JJ)=I D Q:I<0 ..S %GET="++"_(3+VGR)_","_POZ(I)_",HH#++"_$P(TAB,"*",I)_",E,I"_$S($D(^rep(%REPN,0,A,"FILE"))&($E($G(^("FILE")))'="+"):"++++ F6 - my yetig ,F7 - dbvd ++"_^rep(%REPN,0,A,"FILE")_"++"_$S(A="PRT":"S %S=$TR($J(%S,8),"" "",0)",1:""),1:"") ..S %GET("REST")="D 11^%L1PC1" D ^%L1GET I $G(%TO)="END" D Q ...I I=FRSTFL S I=-1 Q ...I $D(JJ(JJ-2)) S JJ=JJ-2,I=JJ(JJ) Q ...S I=FRSTFL-1,JJ=0 Q ..I %S S RKV(I)=%S .I I<0 G F8 .Q:'$D(RKV) S OK=0 F RR=%PG(%PG)+1:1 Q:'$D(@MKIN1) Q:OK S N="" F S N=$O(RKV(N)) S:N="" OK=1 Q:OK I RKV(N)'=$P(@MKIN1,"*",N) Q I $G(%TO)="F10",LASTRKVN D G A0 ;--- MIUN NOSAF .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,LASTRKVN,COLRKV,%REPN,%L1PC,COL0,COL01,PRTN) D ^%L1C .N %L1,MAC .K ^TREPK1(PRTN) S ^TREPK1(PRTN,1)=" iqiqa oein " S J=1 .F JJ=1:1:$L(%L1PC("FLD"),"*") I $P(%L1PC("FLD"),"*",JJ)?1"x"1N.N,$P($G(%L1PC("FLD0")),"*",JJ)'="-" S J=J+1,^TREPK1(PRTN,J)=$P(^rep(%REPN,0,$P(%L1PC("FLD"),"*",JJ)),";") .S MAC="^TREPK1(PRTN)" .S %L1("EU")=2,%L1("BE")=7,%L1("T1")=" : itl oein " .S %L1("TXT1")="%NXS<>16H" .D ^%L1NU K ^TREPK1(PRTN) I FLAG'="" Q .I INDEX=1 K ^TREPK(PRTN) S MAC1="^TREPK0(PRTN)",MAC2="^TREPK(PRTN)" D ^%S1GC1 Q .N I,I1,FL,A,IJ,IND S I=0,I1=0,FL=0 F101 .S I=I+1 I '$D(^TREPK(PRTN,I)) D VOZVR Q .S A=^TREPK(PRTN,I) .I A="" S I1=I,FL=0 G F101 .I A?1"#"."#" D VOZVR S FL=0,I1=I G F101 .I A?1"="."="1"*".E D VOZVR S FL=1 G F101 .I 'FL,$G(^TREPK(PRTN,I-1))'?.P,$G(^TREPK(PRTN,I))'?.P F IJ=COL01:-1:1 I $P(^TREPK(PRTN,I),"*",IJ)'=$P(^TREPK(PRTN,I-1),"*",IJ) D VOZVR S I1=I-1 Q .I 'FL D G F101 ..S IND=$P(A,"*",COLRKV+INDEX-1) ..;;S IND=$E($J(IND*100,12,0),1,12) ..I IND?.E1A.E S IND=$$INV^%L1FRM(IND),IND=$E(IND_$J("",12-$L(IND)),1,12) ..I IND'?.E1A.E S IND=$E($J(99999900000-$P(IND,"."),12,0),1,12) ..S IND=IND_$J(I,5) ;$P(A,"*",1,LASTRKVN) ..S ^TREPK1(PRTN,IND)=A .G F101 G 1 END I %TYPCRT["VT5" W %MODE80 ;$C(27),"[?3l" U 0 Q ; VOZVR N II,N S N="",II=I1 F S N=$O(^TREPK1(PRTN,N)) Q:N="" D .S II=II+1,^TREPK(PRTN,II)=$G(^TREPK1(PRTN,N)) K ^TREPK1(PRTN) Q UP I %PG(%PG)<2 S %SAY=" dligz " X %XMSGV(1) S MK=%PG(%PG) Q S XX=$G(@(GLOB_(%PG(%PG)-1)_")")) S MK=%PG(%PG)-1 I XX?."#",MK>1 S MK=MK-1 Q DW I MK'1 S MK=MK-1 Q PGDOWN ; ;;F RR=MK+1:+1:MK+LNT S XX=$G(@(GLOB_RR_")")) ;;S MK=RR+(XX?1"#"."#") S %PG=%PG+1 I MK>SOF S %SAY=" mipezp seq " X %XMSGV(1) G PGUP Q 11 ; -------------------- DAF U $P:(NOECHO:NOWRAP) N XX 111 S XX=$G(@(GLOB_MK_")")) I XX?."#" S MK=MK+1 K RKV1O D KOT W *27,"["_(KOTNUM+SMY)_";1H" S %COKR=0 S %PG(%PG)=MK F RR=MK:1 Q:RR>(MK+LNT-1-%COKR) S XX=$G(@(GLOB_RR_")")),XX0=$G(^(RR-1)) Q:XX?1"#"."#" S:XX0?.P&(XX0["==") PRITOG="" D:$G(COL01)>$G(COL0)&'$D(PRITOG) D PRT K PRITOG .Q:XX?.P .N %STR,%OKR,JJ S %OKR=0 S %STR="" .F JJ=COL01:-1:COL0+1 D VF D ;--- SHAPKA MEJDU STROK ..S %STR=%STR_RKV1_":"_$P(KOT(1),"*",JJ)_" " ..;;I RKV'?.P,RKV'?."0"1"."."0",RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV ..I RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV .I %OKR W !?(GW-$L(%STR)) W %CLI,$TR($TR(%STR,%TES1,%TES2),%TEN,%THB) S %COKR=%COKR+1 .X %XCL S MK=RR I XX?1"#"."#" D .F JJ=FRSTFL:1:COL1 S $P(XX,"*",JJ)="-----------------" .D PRT I $D(%L1PC("F9","HELP")) S %SAY=%L1PC("F9","HELP") X %XMSGV Q ;-------------------- LINE PRT ; U $P:(NOECHO:NOWRAP) X %XCL W !?TB I XX?.P&(LASTFLLASTFL W %LIGHT1 ;%CLI I RKV1?.P1"="."=".P!(RKV1?.P1"-"."-".P) D FG("CF") W $TR($TR(RKV1,%TES1,%TES2),%TEN,%THB) X %XCL W " " Q VF S RKV=$P(XX,"*",JJ) S RKV1=RKV N DL,DR,TB,SIGN S TB=$P(TAB,"*",JJ) S DL=+TB,DR=+$P(TB,",",2) S SIGN=TB["S"!(TB["+") ; I DR?1N.N,TB'[".",RKV?."+"."-"1N.N.".".N D Q .I 'DR,$P(RKV,".",2) S DR=2 .I 'SIGN S RKV1=$J(RKV,DL,DR) .I SIGN S RKV1=$J($FN(RKV,"+",DR),DL) .I $TR(RKV1," ","")="" S RKV1=$J($J("",DL\2)_"-",DL) ; S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) Q KOT ;-- INPUT: MK X %XCL N RR,JJ,XX,KOTFL W *27,"["_SMY0_";1H",*27,"[J" X %chiste S KOTFL="" I $G(COL0) D ;----------------- PECHAT SHAPKI .N XX .W *27,"["_SMY0_";1H" S XX=KOT(1) .W !?TB0 F JJ=COL0:-1:1 D FG("CF"),VSV .F JJ=1:1:COL0 S $P(XX,"*",JJ)="=================" .W !?TB0 F JJ=COL0:-1:1 D FG("CF"),VSV .S XX=$G(@(GLOB_MK_")")) .W !?TB0 F JJ=COL0:-1:1 X %LIGHT D FG("YF"),VSV S RR=$$^%L1HB("dxey") W *27,"["_(SMY-2+(COL1=FLDNUM))_";1H" S XX=KOT(1) D PRT S RR="-----" F JJ=FLDNUM:-1:FRSTFL S $P(XX,"*",JJ)="-----------------" I $$^%L1UCI="MLY",'$D(%L1PC("F9","HELP")) S %SAY=" F9 - "_$S('$D(PLSPK):"hixt qihxk bivdl ",1:" zipeayg bivdl ") X %XMSGV W *27,"["_SMY_";1H" D PRTK W *27,"["_(KOTNUM+SMY)_";1H" X %XCL Q FG(FG) I %CVET,$$^%L1DISP(USTR) W %LIGHT1,%CV(FG) Q PRTK ; I LASTFL'=FLDNUM G PRTK1 X %XCL W !?TB F JJ=LASTFL:-1:FRSTFL D:$D(KOTFL) FG("CF") D VSV I $$^%L1DISP(USTR) U $P:(NOECHO:NOWRAP) W $J($E(RR,$L(RR)-3,10),4) Q PRTK1 W !?TB2 F JJ=FLDNUM:-1:LASTFL+1 X %LIGHT D VSV X %XCL Q PG ; S MK=%PG(%PG) S XX=$G(@(GLOB_MK_")")) I XX?1"#"."#",MK>1 S MK=MK-1 Q MASAH I $$^%L1DISP(USTR) S GW=75 I $E(%TYPCRT,1,3)="VT5",DLD>GW,DLD<123 U $P:(NOECHO:NOWRAP) S GW=122 W %MODE132 S %L1PC("SHP","SM")=20 D SHAP Q SHAP I '$$^%L1DISP(USTR) S %L1PC("SHP","PRPC")=0,USTR=3 D ^%L3SHAP Q S USTR=0 D FG("YF") D ^%L3SHAP S %L1PC("VGR")=$G(%L1PC("SHP","SC"),1) X %XCL Q EX ; N PRM,I,DL,RGS,DOT,%S S PRM(1)="~" F I=1:1:$L(%L1PC("COD"),"*") S ID=$P(%L1PC("COD"),"*",I) I ID'="" I $D(^rep(%REPN,0,ID)) D .S DL=$P(^rep(%REPN,0,ID),";",2) .S RGS=$S(DL["H":"H",DL[",":"N",1:"E") .S DOT=$P(DL,",",2),DL=+DL .S PRM(1)=$G(PRM(1))_RGS_","_DL_","_DOT_"*" S PRM(1)=$E(PRM(1),1,$L(PRM(1))-1) S PRM(2)="!*"_$G(^rep(%REPN))_"*"_$S($G(^rep(%REPN,"LPT"))="S":"Y",1:"N") S PRM(3)="#*"_COL0_"*"_COL01_"*" N RR S RR=3 D .N I,A,ST,L,NM,R0,%ME,%AD,IND .F I=1:1:$L(^rep(%REPN,"FLD"),"*") S A=$P(^rep(%REPN,"FLD"),"*",I) I $L(A) D ..Q:'$D(@("ME"_A)) Q:'$D(@("AD"_A)) ..S %ME=$G(@("ME"_A)),%AD=$G(@("AD"_A)) ..Q:%ME?1"-9"."9"&(%AD?1"9"."9") ..Q:%ME=""&(%AD="") ..Q:+%ME=0&(%AD?1"9"."9") ..S R0=$G(^rep(%REPN,0,A)),NM=$P(R0,";"),L=$P(R0,";",2) ..I L["D" D ...I %ME?6N S %ME=$$^%L1DC(%ME,1),%AD=$$^%L1DC(%AD,1) Q ...I %ME?5N S %ME=$ZD(%ME,"DD/MM/YY"),%AD=$ZD(%AD,"DD/MM/YY") Q ..S %ME=%ME_" "_NM_"n",%AD=%AD_" "_NM_" cr" ..S ST=%AD_" "_%ME S RR=RR+1,PRM(RR)="?*"_ST D ^%L1PCEX Q %L1PC10 %L1PC1 ;NEW PROGRAM [ 17.05.04 18:59 ] [ 15.02.04 14:39 ] [ 05.05.02 7:53 AM ] ;INPUT: ---%L1PC("COD"),%L1PC("RZD"),%L1PC("FILE") ; %L1PC("F9"),%L1PC("F9","HELP") ;-------------------------------------- N A,COL1,COLRKV,DL,FLDNUM,FRSTFL,I,ID,LASTFL,POZ,TAB,TB0,TB,TB1,TB2,SMY,XX,XX0 N MK,MKIN1,MON,RR,RGS,RKV,PRITOG,SOF,VGR,RSTR,PRTN,FL,FLDNUM1,RKV1O,LASTRKV,LASTRKVN N GLOB,DLD S GLOB="^"_%L1PC("FILE")_"(PRTN,",%PG=1 K ^TREPK0($P) S MAC1="^TREPK($P)",MAC2="^TREPK0($P)" D ^%S1GC1 A0 I $D(^rep(%REPN,"SHP","KOD")) S %L1PC("SHP","PAGE")=1,%L1PC("SHP","KOD")=^("KOD"),%L1PC("SHP","PROG")=$G(^("PROG")) S %L1PC("SHP","PRPC")=1 A S KOLM=1 S FLDNUM=$L(%L1PC("COD"),"*"),%HBRY="" S KOTNUM=1 S FRSTFL=1+$G(COL01) ;---- FORM. MAKETA S TAB="",RGS="",KOT(1)="",OK=1,DLD=0 F I=1:1:$L(%L1PC("COD"),"*") S ID=$P(%L1PC("COD"),"*",I) I ID'="" S:'$D(^rep(%REPN,0,ID)) OK=0 Q:'OK D .S DL=$P(^rep(%REPN,0,ID),";",2) .S TAB=TAB_DL_"*" I I'1 S LASTRKV=$P(%L1PC("FLD"),"*",I-1) Q I LASTRKV'="" F I=1:1:FLDNUM I LASTRKV=$P(%L1PC("COD"),"*",I) S LASTRKVN=I Q D MASAH S VGR=0 I $D(%L1PC("VGR")) S VGR=%L1PC("VGR") S SMY0=VGR+1 I $G(COL0) S VGR=VGR+3 S RSTR=$S($$HZGTOUCH^%L2MOUSE:18-VGR,1:21-VGR) U 0 S PRTN=$P I USTR S RSTR=54-VGR I USTR S GW=$S(DLD>75:122,1:75) ;$$^%L1PCGW(%REPN) ;------------ OPR-E KOL REKV NA 1-J STR S MON=0 F I=FRSTFL:1:FLDNUM S A=$P(TAB,"*",I) Q:(MON+A+1>GW) S MON=MON+A+1,COL1=I ;I MON<75 S GW=75 I COLRKV0 .S %YY=(3+VGR),%XX=0 X %POSIC W %chists .K JJ S JJ=0 F I=FRSTFL:1:COL1 S A=$P(%L1PC("COD"),"*",I) I A?1U.U S JJ=JJ+1,JJ(JJ)=I D Q:I<0 ..S %GET="++"_(3+VGR)_","_POZ(I)_",HH#++"_$P(TAB,"*",I)_",E,I"_$S($D(^rep(%REPN,0,A,"FILE"))&($E($G(^("FILE")))'="+"):"++++ F6 - my yetig ,F7 - dbvd ++"_^rep(%REPN,0,A,"FILE")_"++"_$S(A="PRT":"S %S=$TR($J(%S,8),"" "",0)",1:""),1:"") ..S %GET("REST")="D 11^%L1PC1" D ^%L1GET I $G(%TO)="END" D Q ...I I=FRSTFL S I=-1 Q ...I $D(JJ(JJ-2)) S JJ=JJ-2,I=JJ(JJ) Q ...S I=FRSTFL-1,JJ=0 Q ..I %S S RKV(I)=%S .I I<0 G F8 .Q:'$D(RKV) S OK=0 F RR=%PG(%PG)+1:1 Q:'$D(@MKIN1) Q:OK S N="" F S N=$O(RKV(N)) S:N="" OK=1 Q:OK I RKV(N)'=$P(@MKIN1,"*",N) Q I $G(%TO)="F10",LASTRKVN D G A0 ;--- MIUN NOSAF .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,LASTRKVN,COLRKV,%REPN,%L1PC,COL0,COL01) D ^%L1C .N %L1,MAC .K ^TREPK1($P) S ^TREPK1($P,1)=" iqiqa oein " S J=1 .F JJ=1:1:$L(%L1PC("FLD"),"*") I $P(%L1PC("FLD"),"*",JJ)?1"x"1N.N,$P($G(%L1PC("FLD0")),"*",JJ)'="-" S J=J+1,^TREPK1($P,J)=$P(^rep(%REPN,0,$P(%L1PC("FLD"),"*",JJ)),";") .S MAC="^TREPK1($P)" .S %L1("EU")=2,%L1("BE")=7,%L1("T1")=" : itl oein " .S %L1("TXT1")="%NXS<>16H" .D ^%L1NU K ^TREPK1($P) I FLAG'="" Q .I INDEX=1 K ^TREPK($P) S MAC1="^TREPK0($P)",MAC2="^TREPK($P)" D ^%S1GC1 Q .N I,I1,FL,A,IJ,IND S I=0,I1=0,FL=0 F101 .S I=I+1 I '$D(^TREPK($P,I)) D VOZVR Q .S A=^TREPK($P,I) .I A="" S I1=I,FL=0 G F101 .I A?1"#"."#" D VOZVR S FL=0,I1=I G F101 .I A?1"="."="1"*".E D VOZVR S FL=1 G F101 .I 'FL,$G(^TREPK($P,I-1))'?.P,$G(^TREPK($P,I))'?.P F IJ=COL01:-1:1 I $P(^TREPK($P,I),"*",IJ)'=$P(^TREPK($P,I-1),"*",IJ) D VOZVR S I1=I-1 Q .I 'FL D G F101 ..S IND=$P(A,"*",COLRKV+INDEX-1) ..;;S IND=$E($J(IND*100,12,0),1,12) ..I IND?.E1A.E S IND=$$INV^%L1FRM(IND),IND=$E(IND_$J("",12-$L(IND)),1,12) ..I IND'?.E1A.E S IND=$E($J(99999900000-$P(IND,"."),12,0),1,12) ..S IND=IND_$J(I,5) ;$P(A,"*",1,LASTRKVN) ..S ^TREPK1($P,IND)=A .G F101 G 1 END I %TYPCRT["VT5" W %MODE80 ;$C(27),"[?3l" U 0 Q ; VOZVR N II,N S N="",II=I1 F S N=$O(^TREPK1($P,N)) Q:N="" D .S II=II+1,^TREPK($P,II)=$G(^TREPK1($P,N)) K ^TREPK1($P) Q UP I %PG(%PG)<2 S %SAY=" dligz " X %XMSGV(1) S MK=%PG(%PG) Q S XX=$G(@(GLOB_(%PG(%PG)-1)_")")) S MK=%PG(%PG)-1 I XX?."#",MK>1 S MK=MK-1 Q DW I MK'1 S MK=MK-1 Q PGDOWN ; ;;F RR=MK+1:+1:MK+LNT S XX=$G(@(GLOB_RR_")")) ;;S MK=RR+(XX?1"#"."#") S %PG=%PG+1 I MK>SOF S %SAY=" mipezp seq " X %XMSGV(1) G PGUP Q 11 ; -------------------- DAF U $P:(NOECHO:NOWRAP) N XX 111 S XX=$G(@(GLOB_MK_")")) I XX?."#" S MK=MK+1 K RKV1O D KOT W *27,"["_(KOTNUM+SMY)_";1H" S %COKR=0 S %PG(%PG)=MK F RR=MK:1 Q:RR>(MK+LNT-1-%COKR) S XX=$G(@(GLOB_RR_")")),XX0=$G(^(RR-1)) Q:XX?1"#"."#" S:XX0?.P&(XX0["==") PRITOG="" D:$G(COL01)>$G(COL0)&'$D(PRITOG) D PRT K PRITOG .Q:XX?.P .N %STR,%OKR,JJ S %OKR=0 S %STR="" .F JJ=COL01:-1:COL0+1 D VF D ;--- SHAPKA MEJDU STROK ..S %STR=%STR_RKV1_":"_$P(KOT(1),"*",JJ)_" " ..;;I RKV'?.P,RKV'?."0"1"."."0",RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV ..I RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV .I %OKR W !?(GW-$L(%STR)) W %CLI,$TR($TR(%STR,%TES1,%TES2),%TEN,%THB) S %COKR=%COKR+1 .X %XCL S MK=RR I XX?1"#"."#" D .F JJ=FRSTFL:1:COL1 S $P(XX,"*",JJ)="-----------------" .D PRT I $D(%L1PC("F9","HELP")) S %SAY=%L1PC("F9","HELP") X %XMSGV Q ;-------------------- LINE PRT ; U $P:(NOECHO:NOWRAP) X %XCL W !?TB I XX?.P&(LASTFLLASTFL W %CLI I RKV1?.P1"="."=".P!(RKV1?.P1"-"."-".P) D FG("CF") W RKV1 X %XCL W " " Q VF S RKV=$P(XX,"*",JJ) S RKV1=RKV N DL,DR,TB,SIGN S TB=$P(TAB,"*",JJ) S DL=+TB,DR=+$P(TB,",",2) S SIGN=TB["S"!(TB["+") ; I DR?1N.N,TB'[".",RKV?."+"."-"1N.N.".".N D Q .I 'DR,$P(RKV,".",2) S DR=2 .I 'SIGN S RKV1=$J(RKV,DL,DR) .I SIGN S RKV1=$J($FN(RKV,"+",DR),DL) .I $TR(RKV1," ","")="" S RKV1=$J($J("",DL\2)_"-",DL) ; S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) ;;I TB["H"!$D(KOTFL) S RKV1=$TR($TR(RKV1,%TES1,%TES2),%TEN,%THB) S RKV1=$TR($TR(RKV1,%TES1,%TES2),%TEN,%THB) Q KOT ;-- INPUT: MK X %XCL N RR,JJ,XX,KOTFL W *27,"["_SMY0_";1H",*27,"[J" X %chiste S KOTFL="" I $G(COL0) D ;----------------- PECHAT SHAPKI .N XX .W *27,"["_SMY0_";1H" S XX=KOT(1) .W !?TB0 F JJ=COL0:-1:1 D FG("CF"),VSV .F JJ=1:1:COL0 S $P(XX,"*",JJ)="=================" .W !?TB0 F JJ=COL0:-1:1 D FG("CF"),VSV .S XX=$G(@(GLOB_MK_")")) .W !?TB0 F JJ=COL0:-1:1 X %LIGHT D FG("YF"),VSV S RR=$TR($TR("dxey",%TES1,%TES2),%TEN,%THB) W *27,"["_(SMY-2+(COL1=FLDNUM))_";1H" S XX=KOT(1) D PRT S RR="-----" F JJ=FLDNUM:-1:FRSTFL S $P(XX,"*",JJ)="-----------------" I '$D(%L1PC("F9","HELP")) S %SAY=" F9 - "_$S('$D(PLSPK):"hixt qihxk bivdl ",1:" zipeayg bivdl ") X %XMSGV W *27,"["_SMY_";1H" D PRTK W *27,"["_(KOTNUM+SMY)_";1H" X %XCL Q FG(FG) I %CVET,USTR=0!(USTR=$P) W %LIGHT1,%CV(FG) Q PRTK ; I LASTFL'=FLDNUM G PRTK1 X %XCL W !?TB F JJ=LASTFL:-1:FRSTFL D:$D(KOTFL) FG("CF") D VSV I USTR=0!(USTR=$P) U $P:(NOECHO:NOWRAP) W $J($E(RR,$L(RR)-3,10),4) Q PRTK1 W !?TB2 F JJ=FLDNUM:-1:LASTFL+1 X %LIGHT D VSV X %XCL Q PG ; S MK=%PG(%PG) S XX=$G(@(GLOB_MK_")")) I XX?1"#"."#",MK>1 S MK=MK-1 Q MASAH I USTR=0!(USTR=$P) S GW=75 I $E(%TYPCRT,1,3)="VT5" U $P:(NOECHO:NOWRAP) S GW=122 W %MODE132 S %L1PC("SHP","SM")=20 D SHAP Q SHAP S:USTR %L1PC("SHP","PRPC")=0 D FG("YF") D ^%L3SHAP S %L1PC("VGR")=$G(%L1PC("SHP","SC"),1) I USTR=0!(USTR=$P) X %XCL Q EX ; N PRM,I,DL,RGS,DOT,%S S PRM(1)="~" F I=1:1:$L(%L1PC("COD"),"*") S ID=$P(%L1PC("COD"),"*",I) I ID'="" I $D(^rep(%REPN,0,ID)) D .S DL=$P(^rep(%REPN,0,ID),";",2) .S RGS=$S(DL["H":"H",DL[",":"N",1:"E") .S DOT=$P(DL,",",2),DL=+DL .S PRM(1)=$G(PRM(1))_RGS_","_DL_","_DOT_"*" S PRM(1)=$E(PRM(1),1,$L(PRM(1))-1) S PRM(2)="!*"_$G(^rep(%REPN))_"*"_$S($G(^rep(%REPN,"LPT"))="S":"Y",1:"N") S PRM(3)="#*"_COL0_"*"_COL01_"*" N RR S RR=3 D .N I,A,ST,L,NM,R0,%ME,%AD,IND .F I=1:1:$L(^rep(%REPN,"FLD"),"*") S A=$P(^rep(%REPN,"FLD"),"*",I) I $L(A) D ..Q:'$D(@("ME"_A)) Q:'$D(@("AD"_A)) ..S %ME=$G(@("ME"_A)),%AD=$G(@("AD"_A)) ..Q:%ME?1"-9"."9"&(%AD?1"9"."9") ..Q:%ME=""&(%AD="") ..Q:+%ME=0&(%AD?1"9"."9") ..S R0=$G(^rep(%REPN,0,A)),NM=$P(R0,";"),L=$P(R0,";",2) ..I L["D" D ...I %ME?6N S %ME=$$^%L1DC(%ME,1),%AD=$$^%L1DC(%AD,1) Q ...I %ME?5N S %ME=$ZD(%ME,"DD/MM/YY"),%AD=$ZD(%AD,"DD/MM/YY") Q ..S %ME=%ME_" "_NM_"n",%AD=%AD_" "_NM_" cr" ..S ST=%AD_" "_%ME S RR=RR+1,PRM(RR)="?*"_ST D ^%L1PCEX Q %L1PC2 %L1PC2 ; --- PRINTER [ 26.12.06 09:38 ] [ 18.09.06 12:47 ] [ 15.06.06 11:19 ] ;--- %L1PC("SHP","KOD") - CODE OF HEADER N FRST S FRST="" K %L1PC("SHP","PAGE") D ^%L1TS S %DEV="USTR" D OPEN^%L1LPT Q:%EROP ;;O USTR::2 E U 0 S %SAY=" dqetz zqtcn " X %XMSGV(1) Q D UDEV^%L1LPT(USTR) I $D(^L1PCSND($P))>9 D PC^%L1PCSNP 11 ; -------------------- DAF N XX,RR,RR1,PRKT S PRKT=0,RR1=0 K RKV1O F RR=1:1:SOF D .S XX=$G(@("^"_%L1PC("FILE")_"("""_PRTN_""","_RR_")")) .D:RR=1!PRKT!(RR1'COL0 D PRT S RR1=RR1+1 I XX?1"#"."#" S PRKT=1 ..N %STR,%OKR,JJ S %OKR=0 S %STR="" F JJ=COL01:-1:COL0+1 D VF S %STR=%STR_RKV1_" :"_$P(KOT(1),"*",JJ)_" " I RKV'?.P,RKV'?."0"1"."."0",RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV ..S %STR=$TR(%STR,TS0,TSS) ..I %OKR D ...W !!?(75-$L(%STR)),%STR,! S RR1=RR1+3 D CLOSE^%L1LPT ;; W # C USTR Q ;-------------------- LINE PRT ; W !?TB F JJ=LASTFL:-1:FRSTFL D VSV ;;I $D(PRITOG) W *13,?TB F JJ=LASTFL:-1:FRSTFL D VSV W $J($E(RR,$L(RR)-3,10),4) K PRITOG I LASTFL=FLDNUM G PRTE W !?TB2 F JJ=FLDNUM:-1:LASTFL+1 D VSV ;;W *13,?TB2 F JJ=FLDNUM:-1:LASTFL+1 D VSV PRTE ; I $D(PRIT0) S PRITOG="" K PRIT0 Q VSV N RKV1 D VF I RKV["===" S PRIT0="" W $TR(RKV1,TS0,TSS) W " " Q KOT ; N LNG,LPT80 K RKV1O ;S LPT80=1 I $G(DLD)'>75 S LNG=75 W %L1OUT("MDP","NOCOND") I $G(DLD)>75 D .W %L1OUT("MDP","COND") S LNG=122 KOT1 N XX0 S XX0=XX N XX ;;I '$D(FRST),$I'=3,$I<51 H $S(LASTFL=FLDNUM:14,1:20) W:'$D(FRST) # S %TIM=$ZD($H,"24:60") W " ",$$^%L1DC($H,1)," ",%TIM," "_$TR($$^%L1DC($H,9)_" mei : dwtd onf",TS0,TSS),! N %AT,ST S %AT=$$^%L1HEAD("") I $D(%L1PC("HEAD")) S %AT=%L1PC("HEAD") I $L(%AT) S ST=%L1OUT("MDP","B")_$TR($$CENTRB^%L1FRM($TR(%AT,"#_",""),%L1OUT("MDP","GWPC")),TS0,TSS)_%L1OUT("MDP","N") W ST W !,$TR($J("",LNG)," ","-") N KT S KT=$S($L($G(QUERY)):$G(QUERY)_" ",1:"")_$G(^rep(%REPN)) I $L(KT)*2'>LNG W !?(LNG-($L(KT)*2)\2),%L1OUT("MDP","B"),$TR(KT,TS0,TSS),%L1OUT("MDP","N") I $L(KT)*2>LNG W !?(LNG-$L(KT)\2),$TR(KT,TS0,TSS) N RR S RR2=0 I $L($G(%L1PC("SHP","KOD"))) D .S %L1PC("SHP","SC")=1 .S MAS(98)=$G(%L1PC("SHP","SL"),1),PRPC=1 D ^%L3SHAP K %L1PC("SHP","SC") I $G(DLD)>75 D .W %L1OUT("MDP","COND") S LNG=122 D .N I,A,ST,L,NM,R0,%ME,%AD,IND .F I=1:1:$L(^rep(%REPN,"FLD"),"*") S A=$P(^rep(%REPN,"FLD"),"*",I) I $L(A) D ..Q:'$D(@("ME"_A)) Q:'$D(@("AD"_A)) ..S %ME=$G(@("ME"_A)),%AD=$G(@("AD"_A)) ..Q:%ME?1"-9"."9"&(%AD?1"9"."9") ..Q:%ME=""&(%AD="") ..Q:+%ME=0&(%AD?1"9"."9") ..S R0=$G(^rep(%REPN,0,A)),NM=$P(R0,";"),L=$P(R0,";",2) ..I L["D" D ...I %ME?6N S %ME=$$^%L1DC(%ME,1),%AD=$$^%L1DC(%AD,1) Q ...I %ME?5N S %ME=$ZD(%ME,"DD/MM/YY"),%AD=$ZD(%AD,"DD/MM/YY") Q ..S %ME=%ME_" "_NM_"n",%AD=%AD_" "_NM_" cr" ..S ST=%AD_" "_%ME W !?(LNG-$L(ST)\2),$TR(ST,TS0,TSS) S RR2=RR2+1 .W ! S RR2=RR2+1 I $G(COL0) D .W !?TB0 S XX=KOT(1) F JJ=COL0:-1:1 D VSV .F JJ=1:1:COL0 S $P(XX,"*",JJ)="=================" .W !?TB0 F JJ=COL0:-1:1 D VSV .S XX=XX0 .W !?TB0 F JJ=COL0:-1:1 D VSV .;;W *13,?TB0 F JJ=COL0:-1:1 D VSV .W ! S RR=$TR("qn",TS0,TSS) S XX=KOT(1) D PRT K XX S RR="--" F JJ=1:1:LASTFL S $P(XX,"*",JJ)="-----------------" D PRT K FRST S RR1=RR2,PRKT=0 Q ;;VF S RKV=$P(XX,"*",JJ) ;;I $P(TAB,"*",JJ)'[","!(RKV'?."-+".N.".".N) S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) Q ;;S RKV1=$J(RKV,$P(TAB,"*",JJ),+$P($P(TAB,"*",JJ),",",2)) S:'$TR(RKV1," ","") RKV1=$J("",$P(TAB,"*",JJ)) Q VF S RKV=$P(XX,"*",JJ) S RKV1=RKV N DL,DR,TB,SIGN S TB=$P(TAB,"*",JJ) S DL=+TB,DR=+$P(TB,",",2) S SIGN=TB["S"!(TB["+") ; I DR?1N.N,RKV?."+"."-"1N.N.".".N D Q .I 'SIGN S RKV1=$J(RKV,DL,DR) .I SIGN S RKV1=$J($FN(RKV,"+",DR),DL) .I $TR(RKV1," ","")="" S RKV1=$J($J("",DL\2)_"-",DL) ; S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) Q %L1PC20 %L1PC2 ; --- PRINTER [ 18.05.04 08:15 ] [ 17.05.04 19:05 ] [ 10.06.03 23:12 ] ;--- %L1PC("SHP","KOD") - CODE OF HEADER N FRST S FRST="" K %L1PC("SHP","PAGE") D ^%L1TS ;;O USTR::2 E U 0 S %SAY=" dqetz zqtcn " X %XMSGV(1) Q N USTR0 S USTR0=USTR N USTR S USTR=USTR0 S %DEV="USTR" D ^%L1LPT U USTR 11 ; -------------------- DAF N XX,RR,RR1,PRKT S PRKT=0,RR1=0 K RKV1O F RR=1:1:SOF S XX=$G(@("^"_%L1PC("FILE")_"("""_PRTN_""","_RR_")")) D:RR=1!PRKT!(RR1'COL0 D PRT S RR1=RR1+1 I XX?1"#"."#" S PRKT=1 .N %STR,%OKR,JJ S %OKR=0 S %STR="" F JJ=COL01:-1:COL0+1 D VF S %STR=%STR_RKV1_" :"_$P(KOT(1),"*",JJ)_" " I RKV'?.P,RKV'?."0"1"."."0",RKV'=$G(RKV1O(JJ)) S %OKR=1,RKV1O(JJ)=RKV .S %STR=$TR(%STR,TS0,TSS) .;;I %OKR W !!?(75-$L(%STR)),%STR,*13,?(75-$L(%STR)),%STR,! S RR1=RR1+3 .I %OKR W !!?(75-$L(%STR)),%STR,! S RR1=RR1+3 D CLOSE^%L1LPT ;; W # C USTR Q ;-------------------- LINE PRT ; W !?TB F JJ=LASTFL:-1:FRSTFL D VSV ;;I $D(PRITOG) W *13,?TB F JJ=LASTFL:-1:FRSTFL D VSV W $J($E(RR,$L(RR)-3,10),4) K PRITOG I LASTFL=FLDNUM G PRTE W !?TB2 F JJ=FLDNUM:-1:LASTFL+1 D VSV ;;W *13,?TB2 F JJ=FLDNUM:-1:LASTFL+1 D VSV PRTE ; I $D(PRIT0) S PRITOG="" K PRIT0 Q VSV N RKV1 D VF I RKV["===" S PRIT0="" W $TR(RKV1,TS0,TSS) W " " Q KOT ; N LNG,LPT80 K RKV1O ;S LPT80=1 ;I $P($$^%L1ZU(0),",")="MLY",$G(^LPT($I,"N"))[$C(18) S LPT80=0 ;;I $G(^rep(%REPN,"LPT"))="S"!LPT80 W $C(13,13,15) S LNG=$S(LPT80:122,1:155) G KOT1 I $G(DLD)'>75 S LNG=75 W %L1OUT("MDP","NOCOND") ;;I $G(^rep(%REPN,"LPT"))="S"!($G(DLD)>75) D I $G(DLD)>75 D .W $C(13,13)_%L1OUT("MDP","COND") S LNG=122 .;;I %MDPSUG=7 S %GET=" ""CONDENSED"" zixep wlciy cr ""FONT"" ywn lr ugl " D N^%L1GET ;B I $G(^rep(%REPN,"LPT"))="B" W $C(18) ;;S LNG=$$^%L1PCGW(%REPN) KOT1 N XX0 S XX0=XX N XX ;;I '$D(FRST),$I'=3,$I<51 H $S(LASTFL=FLDNUM:14,1:20) ;;I $I=3 H 3 W:'$D(FRST) # S %TIM=$ZD($H,"24:60") W $$^%L1DC($H,1)," ",%TIM," "_$TR($$^%L1DC($H,9)_" mei : dwtd onf",TS0,TSS),! ;;I $D(^r($J)),$D(^PL("ESEK",1)) N ST S ST=$$CENTRB^%L1FRM($TR(^(1),"#_",""),LNG) W !,%L1OUT("MDP","B"),$TR(ST,TS0,TSS),%L1OUT("MDP","N"),! N %AT,ST S %AT=$$^%L1HEAD("") I $L(%AT) S ST=%L1OUT("MDP","B")_$TR($$CENTRB^%L1FRM($TR(%AT,"#_",""),%L1OUT("MDP","GWPC")),TS0,TSS)_%L1OUT("MDP","N") W ST W !,$TR($J("",LNG)," ","-") N KT S KT=$S($L($G(QUERY)):$G(QUERY)_" ",1:"")_$G(^rep(%REPN)) I $L(KT)*2'>LNG W !?(LNG-($L(KT)*2)\2),%L1OUT("MDP","B"),$TR(KT,TS0,TSS),%L1OUT("MDP","N") I $L(KT)*2>LNG W !?(LNG-$L(KT)\2),$TR(KT,TS0,TSS) N RR S RR2=0 I $L($G(%L1PC("SHP","KOD"))) D .S %L1PC("SHP","SC")=1 .S MAS(98)=$G(%L1PC("SHP","SL"),1),PRPC=1 D ^%L3SHAP K %L1PC("SHP","SC") I '$L($G(%L1PC("SHP","KOD"))) D .N I,A,ST,L,NM,R0,%ME,%AD,IND .F I=1:1:$L(^rep(%REPN,"FLD"),"*") S A=$P(^rep(%REPN,"FLD"),"*",I) I $L(A) D ..Q:'$D(@("ME"_A)) Q:'$D(@("AD"_A)) ..S %ME=$G(@("ME"_A)),%AD=$G(@("AD"_A)) ..Q:%ME?1"-9"."9"&(%AD?1"9"."9") ..Q:%ME=""&(%AD="") ..Q:+%ME=0&(%AD?1"9"."9") ..S R0=$G(^rep(%REPN,0,A)),NM=$P(R0,";"),L=$P(R0,";",2) ..I L["D" D ...I %ME?6N S %ME=$$^%L1DC(%ME,1),%AD=$$^%L1DC(%AD,1) Q ...I %ME?5N S %ME=$ZD(%ME,"DD/MM/YY"),%AD=$ZD(%AD,"DD/MM/YY") Q ..S %ME=%ME_" "_NM_"n",%AD=%AD_" "_NM_" cr" ..S ST=%AD_" "_%ME W !?(LNG-$L(ST)\2),$TR(ST,TS0,TSS) S RR2=RR2+1 .W ! S RR2=RR2+1 I $G(COL0) D .W !?TB0 S XX=KOT(1) F JJ=COL0:-1:1 D VSV .F JJ=1:1:COL0 S $P(XX,"*",JJ)="=================" .W !?TB0 F JJ=COL0:-1:1 D VSV .S XX=XX0 .W !?TB0 F JJ=COL0:-1:1 D VSV .;;W *13,?TB0 F JJ=COL0:-1:1 D VSV .W ! S RR=$TR("qn",TS0,TSS) S XX=KOT(1) D PRT K XX S RR="--" F JJ=1:1:LASTFL S $P(XX,"*",JJ)="-----------------" D PRT K FRST S RR1=RR2,PRKT=0 Q ;;VF S RKV=$P(XX,"*",JJ) ;;I $P(TAB,"*",JJ)'[","!(RKV'?."-+".N.".".N) S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) Q ;;S RKV1=$J(RKV,$P(TAB,"*",JJ),+$P($P(TAB,"*",JJ),",",2)) S:'$TR(RKV1," ","") RKV1=$J("",$P(TAB,"*",JJ)) Q VF S RKV=$P(XX,"*",JJ) S RKV1=RKV N DL,DR,TB,SIGN S TB=$P(TAB,"*",JJ) S DL=+TB,DR=+$P(TB,",",2) S SIGN=TB["S"!(TB["+") ; I DR?1N.N,RKV?."+"."-"1N.N.".".N D Q .I 'SIGN S RKV1=$J(RKV,DL,DR) .I SIGN S RKV1=$J($FN(RKV,"+",DR),DL) .I $TR(RKV1," ","")="" S RKV1=$J($J("",DL\2)_"-",DL) ; S RKV1=$J($E(RKV,$L(RKV)-$P(TAB,"*",JJ)+1,255),$P(TAB,"*",JJ)) Q %L1PC3 %L1PC3 ;-- POSTFORM - COMPRESS [ 19.03.02 11:06 AM ] [ 25.11.01 8:59 PM ] [ ;--- INPUT ^TREPK($P) ;--- OUTPUT ^TREPK BLI SIKUMIM MEUTARIM S SHG=0,I=0,IT=0,IT1=0 K ^TREPK1($P) S N="" F S N=$O(^TREPK($P,N)) Q:N="" D:N?1N.N Q:N="" .S A=$G(^(N)) I A=""!(A?1"#"."#") S IT=0 D Q ..;I 'IT1!(A'="") D SET ..D SET . .I $E(A,1,2)'="==",A'?.P,'IT D:IT1 S SHG=SHG+1,COLG=$L(A,"*") ..S IT1=0 ..Q ..S N1=$O(^TREPK($P,N)) Q:N1="" S A1=^(N1) ..I A1'?.P S I=I+1,^TREPK1($P,I)="" . .I $E(A,1,2)'="==" D SET Q . .I $E(A,1,2)="==" D S IT=1,SHG=0 ..I SHG=1 D S IT1=1 Q ...S N=$O(^TREPK($P,N)) Q:N="" .. ..S A1="" F J=1:1:COLG S A1=A1_"==========*" ..S I=I+1,^TREPK1($P,I)=A1 . K ^TREPK($P) M ^TREPK($P)=^TREPK1($P) K ^TREPK1($P) Q SET ; S I=I+1,^TREPK1($P,I)=^TREPK($P,N) Q %L1PCEX %L1PCEX ; [ 12.02.06 22:36 ] [ 04.01.04 12:02 ] [ 04.11.03 09:31 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,KOT,OUTLOOK,PRM,%REPN,%L1PC) D ^%L1C S YY1=8,YY2=14 S YR1=YY1,YR2=YY2 S:$D(OUTLOOK) YR1=15,YR2=22,YY1=16,YY2=18,YY3=20 ZD S %L1RBCL="" D TV^%L1RBUA(YR1,15,YR2,70) S %GET="2 - POWERTERM jxc xiardl ,1 - hwqicl uaew xenyl++"_YY1_",67,HH#++1,E,I++12" D ^%L1GET I %S=""!(%TO="END") Q S DRV=$S(%S=1:"/mnt/floppy/",1:"PT/") S:'$D(SIK) SIK=1 ZD01 S %GET=" ? ( `l - 0 , ok - 1 ) minekiq mb xiardl++"_(YY1+2)_",67,HH#"_$G(SIK)_"++1,E,I++10" D ^%L1GET I %S=""!(%TO="END") G ZD S SIK=%S ZD1 S %GET=": dxinyl uaew my++"_(YY1+4)_",67,HH#++15,E,I++++ (jxc `ll) cala my cilwdl `p" D ^%L1GET I %S=""!(%TO="END") G ZD S %SAY=$J($$FUNC^%UCASE(%S),15)_"++"_YY2_",49,HH" X %XMSG D FNAME D:$D(OUTLOOK) I %TO="END"!(%TO="UP") G ZD1 .S %GET=": dxrd++"_(YY1+6)_",67,HH#++43,H,I+" D ^%L1GET I %TO="UP"!(%TO="END") Q .S REM(1)=%S_" ;;;" ; ZI I FILE["/mnt/floppy/" S %GET=" - dlert lhal , - xy`l . opekl hwqic qipkdl `p " D N^%L1GET G:%TO="END" END I '$$KONANOK(FILE) G ZI D WFL(FILE,0) G END:'OK ARX ; I USTR,USTR'=$P S %GET=" "_$P(FILE,"/",1,$L(FILE,"/")-1)_" dvigna mwed "_$P(FILE,"/",$L(FILE,"/"))_" uaew " D N^%L1GET I 'USTR S %GET=" . dnlyed dlert " D N^%L1GET END K ^S222($J) Q ; KONANOK(FILE) ; D ^%L1FLOP Q '$ZSY ; N DEV,DER S DEV=$P(FILE,":") I DEV="" Q 0 S DER=$$^%L1ZOS(9,DEV) I DER<0 D MSGER Q 0 ;;S %X=DEV_":",%L1OS=345 D O13M^%L1OS Q 1 MSGER ; D X %XMSGV(1) .I ",15,20,257,"[(","_DER_",") S %SAY=" oekp `l opek my " Q .I ",19,256,"[(","_DER_",") S %SAY=" ! hwqicdn dpbd zwacn cixedl jixv " Q .S %SAY=" ! oken `l opek " Q WFL(FILE,PARAM) ; D ^%L1TS S USTR=51,OK=0 I FILE["PT/"!(FILE="PT")!(FILE="PTW") S USTR=0 I $P=1,'USTR S %GET=" POWER TERM jxc dlert rval `p " D N^%L1GET Q I USTR I $$^%L1ZOS(10,FILE)>0 S %GET=" 99 - ycgn daizk xey`l . miiw xak "_FILE_" uaew ++12,70,HH,I,R#++2,E,I" D N^%L1GET G:%S'=99 END I USTR O FILE:(NEWVERSION:WRITE):1 E S %SAY=" ! qetz "_FILE_" uaew" G EFL ;--------------------- PT -------- I 'USTR D G EFL .N N,I,I1 S I=0,N="" F S N=$O(KOT(N)) Q:N="" S I=I+1 .S N="" F S N=$O(^TREPK($P,N)) Q:N="" S I=I+1 .S N="" F S N=$O(PRM(N)) Q:N="" S I=I+1 .S MAX=I .S %VG=20,%NG=22,%LG=5,%RG=75 .S %L1RBCL=%CV("CF") .W %LIGHT1 D TV^%L1RBUA(%VG,%LG,%NG+2,%RG+1) X %XCL .D SCALE0^%L3GTR(70) .N FL S FL=$P(FILE,"/",$L(FILE,"/")),OK=1 .U 0 S I1=0 .F I=1:1 Q:'$D(KOT(I)) S I1=I1+1 D I '$$TV^%L1PTW(FL,"w+","!"_$$D2W(KOT(I)),1) S OK=0 Q ..I '(I1#10) D SCALE^%L3GTR(I1,MAX,70) .N A,FLSIK S FLSIK=0 .F I=1:1 Q:'$D(^TREPK($P,I)) S I1=I1+1 D Q:'OK ..S A=$G(^(I)) ..I '(I1#10) D SCALE^%L3GTR(I1,MAX,70) ..I 'SIK,A["===*",A?.P S FLSIK=1 Q ..I FLSIK S FLSIK=0 Q ..I 'SIK,A?.P Q ..I '$$TV^%L1PTW(FL,"a+",$$D2W(A),I+1) S OK=0 .Q:'OK ;---------------------- A: ------------- S %SAY=" ... oizndl `p " X %XMSGN U FILE F I=1:1 Q:'$D(KOT(I)) W "!"_$$D2W(KOT(I)),! I $D(REM(1)) W $$D2W(REM(1)),! N A,B,FLSIK S FLSIK=0 F I=1:1 Q:'$D(^TREPK($P,I)) D Q:$ZC<0 .N A S A=$G(^(I)) .I 'SIK,A["===*",A?.P S FLSIK=1 Q .I FLSIK S FLSIK=0 Q .I 'SIK,A?.P Q .U FILE W $$D2W(A),! Q:$ZC<0 I $ZC<0 D G EFL .W %ENG S %ER=$ZC D ^%OS1 S OK=1 I USTR C FILE EFL D PRM Q ; D2W(A) ; N B,J,J1,J2,OKH,RKV,RKV2,ID,DL S B="" ;I $D(%L1SCEX),$E(RKV)="?" Q S A=$TR(A,"""[]{}","'()()") F J=1:1:$L(A,"*") S RKV=$$SPA^%L1FRM($P(A,"*",J)) D .I RKV["E-MAIL:" S RKV=$$FUNC^%LCASE($P(RKV,"E-MAIL:",2)) G D2W1 .S OKH=0 F J1=1:1:$L(TS0) I RKV[$E(TS0,J1) S OKH=1 Q .I OKH D ..;S RKV=$TR($$INV^%L1FRM(RKV),TS0,TS1),RKV=$TR(RKV,"()",")(") ..S RKV=$$INVHBW^%L1FRM(RKV),RKV=$TR(RKV,"()",")(") D2W1 .S B=B_RKV_"*" ;$C(9) Q $TR(B,"#","-") ; FNAME S FILE=%S I FILE["/" S FILE=$P(FILE,"/",2) I FILE[":" S FILE=$P(FILE,":",2) I FILE'["." S FILE=FILE_".TXT" S FILE=DRV_FILE Q ; PRM ; N N S OK=0 S FILE=$P(FILE,".")_".PRM" ;I USTR I $ZOS(10,FILE)>0 S %GET=" 99 - ycgn daizk xey`l . miiw xak "_FILE_" uaew ++12,70,HH,I,R#++2,E,I" D N^%L1GET G:%S'=99 END I USTR O FILE:(NEWVERSION:WRITE):1 E S %SAY=" ! qetz "_FILE_" uaew " G EPR I 'USTR D G EPR .N FL S FL=FILE I FILE["/" S FL=$P(FILE,"/",$L(FILE,"/")) .S OK=1 .S N="" F II=1:1 S N=$O(PRM(N)) Q:N="" D ..S I1=$G(I1)+1 I '(I1#10) D SCALE^%L3GTR(I1,MAX,70) ..I $D(PRM(N)),'$$TV^%L1PTW(FL,$S(II=1:"w+",1:"a+"),$$D2W(PRM(N)),1) S OK=0 Q .Q:'OK .D SCALE^%L3GTR(70,70,70) .K %Q S %Q("Z")="PRTOT dpkez jxc mipezp bivdl" D N^%S2ASK Q:'YES .W $C(27)_"P$sprtot.psl "_$P(FL,".")_".txt"_$C(27)_"\" ; N A,B S N="" F S N=$O(PRM(N)) Q:N="" U FILE W $$D2W(PRM(N)),! Q:$ZC<0 I $ZC<0 D G EPR .W %ENG S %ER=$ZC D ^%OS1 S OK=1 I USTR'=$P C FILE ;D .N FL S FL=FILE .W $C(27)_"P$sexec prtot "_FL_$c(27)_"\" EPR Q %L1PCGW %L1PCGW(%REPN) ; SHIRINA DOCHA [ 05/23/99 5:23 PM ] [ 09/01/97 9:27 AM ] I $D(%L1PC("GW")) Q %L1PC("GW") I $G(^rep(%REPN,"LPT"))="B" Q 75 Q 122 %L1PCIN %L1PCIN ; [ 23.08.06 18:26 ] [ 20.08.06 10:32 AM ] [ 07.09.05 9:22 AM ] ; IN : %REPN ; OUT : %L1PC("FLD") ; %L1PC("MIUN") ; %L1PC("SIK0") ; %L1PC("FLD") ; %L1PC("SIK") ; %L1PC("CT") ; ; MIUN,SIK,CT,MAXMIUN ; COLG,COLGM,GLOB1,GLOB2 ; K (%REPN,USTR,MAS,QUERY,%SMI,%OLDIND,%L1PC) D ^%L1C ; S FLMODIF=0 S %ENGLISH=0 ; N %N,%I,%J,I S %N="" F S %N=$O(%REPN(%N)) Q:%N="" S @%N=%REPN(%N) S %L1PC("FLD")="",%L1PC("MIUN")="",%L1PC("SIK0")="",%L1PC("CT")="" S %L1PC("SIK")="" ; F %I=1:1:$L(^rep(%REPN,"FLD"),"*") D .N %FLD S %FLD=$P(^rep(%REPN,"FLD"),"*",%I) Q:%FLD="" .I $G(^rep(%REPN,0,%FLD,"SET")) S %L1PC("S0",%FLD)="" .I $P($G(^rep(%REPN,"FLD0")),"*",%I)'="-" D ..S %L1PC("FLD")=%L1PC("FLD")_%FLD_"*" ..S %L1PC("MIUN")=%L1PC("MIUN")_$P($G(^rep(%REPN,"MIUN")),"*",%I)_"*" ..S %L1PC("SIK0")=%L1PC("SIK0")_$P($G(^rep(%REPN,"SIK0")),"*",%I)_"*" ..S %L1PC("CT")=%L1PC("CT")_$P($G(^rep(%REPN,"CT")),"*",%I)_"*" .I $P($G(^rep(%REPN,"FLD0")),"*",%I)="-" D ..N A S A=$P(^rep(%REPN,"FLD"),"*",%I) Q:A?.P ..I '$D(%L1PC("VAL",A))!'$D(@("ME"_A)) S @("ME"_A)="" ..I '$D(%L1PC("VAL",A))!'$D(@("AD"_A)) S @("AD"_A)=$TR($J("",+$P(^rep(%REPN,0,A),";",2))," ",9) ; S %L1PC("FLD")=$E(%L1PC("FLD"),1,$L(%L1PC("FLD"))-1) S %L1PC("MIUN")=$E(%L1PC("MIUN"),1,$L(%L1PC("MIUN"))-1) S %L1PC("SIK0")=$E(%L1PC("SIK0"),1,$L(%L1PC("SIK0"))-1) S %L1PC("CT")=$E(%L1PC("CT"),1,$L(%L1PC("CT"))-1) ; S %L1PC("SIK")="" S %J=0 F %I=1:1:$L(^rep(%REPN,"FLD"),"*") D .S A=$P(^("FLD"),"*",%I) I $E(A)="x",$P($G(^("FLD0")),"*",%I)'="-" D ..S %L1PC("SIK")=%L1PC("SIK")_$P(^rep(%REPN,"SIK"),"*",$E(A,2,3))_"*" S %L1PC("SIK")=$E(%L1PC("SIK"),1,$L(%L1PC("SIK"))-1) ; S ONLYSIK=0,MONE=0 K ^TREP($J) ; F I=1:1:$L(%L1PC("FLD"),"*") S A=$P(%L1PC("FLD"),"*",I) Q:A["x" ;------------ MAXMIUN - SPISOK PRIZN.REKV, COLG - SPISOK KOL. REKV. S MAXMIUN=I-(%L1PC("FLD")["*x") S COLG=$L(%L1PC("FLD"),"*")-MAXMIUN S COLGM=$L($P(^rep(%REPN,"FLD"),"*x1*",2),"*")+1 S GLOB1=^rep(%REPN,"GLOB1"),GLOB2=^rep(%REPN,"GLOB2") S %BS=0,FRST=1 V ; K MIUN,SIK,CT F I=1:1:MAXMIUN D .S MIUN(I)=$S($P(%L1PC("MIUN"),"*",I)>MAXMIUN:"",1:$P(%L1PC("MIUN"),"*",I)) .S SIK(I)=$P(%L1PC("SIK0"),"*",I) .S CT(I)=$P(%L1PC("CT"),"*",I) ;-- KOTERET Q %L1PCL %L1PCL ; PRINT TAVLAOT [ 18.01.06 18:08 ] [ 03.11.02 2:36 PM ] [ 10/24/2002 12:04 PM ] ;INP - %MBP("PAR"),%MBP("VGR"),%MBP("NGR"),%MBP("LG"),%MBP("PG") ; %MBP("REF"),COLG ; %L1PCL("TOT") - SIKUMIM BILVAD ; %L1PCL("KOTNO") - LELO KOTERET ; %L1PCL("PCNO") - LELO HADPASA ; I '$D(%POSIC) D ^%L1C N JJ,NPG,PG,%PROV,%GR,XX0,X1,X2,Y1,Y2 N %HBRY S %HBRY="" S NPG=1,PG(1)=0 ;W %HBR ; BEG D INIT D PS END Q ; PS ; S %PROV=X1,%II=1 K %GR F JJ=1:1:COLG D .S %MBP("DL",JJ)=$S(%MBP("D",JJ)>$L(%MBP("Z",JJ)):%MBP("D",JJ),1:$L(%MBP("Z",JJ))) .I %PROV+%MBP("DL",JJ)>X2 S %GR(%II)=JJ-1,%II=%II+1,%PROV=X1 .S %PROV=%PROV+%MBP("DL",JJ)+1 .Q I '$D(%GR(1)) S %GR(1)=COLG,%II=1 I %II>1 I %GR(%II-1)",A I A="."!(A="u") S END=1 I EOP S I=0 Q Q P ; N %NODOLD I '$D(%L1PCL("USL")) S %L1PCL("USL")=1 S BEG=1,EOP=0 F S %NODOLD=$G(NOD) S NOD=$O(@%MBP("REF")) Q:NOD="" D Q:EOP .X:$D(%L1PCL("DO")) %L1PCL("DO") .I @%L1PCL("USL") S:'$D(%L1PCL("TOT")) I=I+1 X:$D(MRKV("KOT"))&BEG MRKV("KOT") S:BEG BEG=0 W:'$D(%L1PCL("TOT")) !?X1 D PG .I @%L1PCL("USL") I I+%II+1>COLS S EOP=1 Q PG ; F %II=1:1 Q:'$D(%GR(%II)) D W:'$D(%L1PCL("TOT")) !?X1 S I=I+1 .F J=%GR(%II):-1:$G(%GR(%II-1))+1 D ..X MRKV(J) Q:$D(%L1PCL("TOT")) ..S RKV=$TR($E(RKV,1,%MBP("DL",J)),TS0,TSS) ..W $S('$D(%MBP("DR",J)):$J($$^%L1HB(RKV),%MBP("DL",J)),1:$J(RKV,%MBP("DL",J),%MBP("DR",J)))," " Q ;- INIT S RZD=$G(%MBP("RZD"),"\") D ^%L1TS I '$G(USTR) S TSS=TS0 S X1=$G(%MBP("LG"),5) S X2=$G(%MBP("PG"),78) S Y1=$G(%MBP("VGR"),0) S Y2=$G(%MBP("NGR"),22) S RSCR=Y2-Y1 S %SHL=$G(%SHL,1),SH=0 S NOD="" Q %L1PCP %L1PCP ; [ 02.07.07 11:12 ] [ 01.07.07 11:29 ] [ 07.02.06 09:46 ] ; ; IN : MIUN(IND) (%L1PCIN) + SHEILTA ; IND LEFI %L1PC("FLD") ; SIK (IND) (---""--) + SHEILTA ; CT (IND) (---""--) + SHEILTA ; ; MAXMIUN ; (%L1PCIN) ; ME... - AD...; (%L1PCIN) + SHEILTA ; ; %REPN ; SIKUM ; ; FLMODIF (---""--) ; %L1PC("FLD") ; (%L1PCIN) ; GLOB1 ; (%L1PCIN) ; GLOB2 ; (%L1PCIN) ; COLG ; (%L1PCIN) ; ; MIUN - SAVE PRIZN MIUN ; SIK0 - SAVE PRIZN SUMM ; CT - SAVE PRIZN KOT ; N USERPORT,PORTN,USERGLOB,USERMOD,%SCKPORT,%L2NALAN I '$D(%GLOU) S %GLOU="^TREPK($P)" K @%GLOU Q:'$G(MAXMIUN) M1 K MIUN1 S J=0 F I=1:1:MAXMIUN D .S J=J+1 S MIUN1(+MIUN(I))=$G(MIUN(I)) M2 .I $P($G(^rep(%REPN,"FLD0")),"*",J)="-" S J=J+1 G M2 ; I $G(SIKUM)=99 S ONLYSIK=1 F I=1:1:MAXMIUN S A=$P(%L1PC("FLD"),"*",I) S:$G(@("ME"_A))?.P @("ME"_A_"=0") S:$G(@("AD"_A))?.P @("AD"_A_"=$TR($J("""",$P($G(^rep(%REPN,0,A)),"";"",2)),"" "",9)") 11 ; ; --------------- CHECK FOR DFLT ( MIUN - POSLEDN ) ;;S N="" F S N=$O(SIK(N)) Q:N="" I SIK(N),$G(MIUN(N)) S SIK(N)=MIUN(N) ; ; ------------------------- SEDM - PERESORT SPISOK PR. REKV. ; ------------------------- SEDSM - PERESORT SPISOK PRIZ. SIK. S SEDM=%L1PC("FLD"),SEDSM="" F JJ=1:1:MAXMIUN D .S A=$P(%L1PC("FLD"),"*",JJ) .S $P(SEDM,"*",MIUN(JJ))=A .S $P(SEDSM,"*",MIUN(JJ))=+SIK(JJ) ; S N="" F S N=$O(CT(N)) Q:N="" D .I CT(N)=1 D Q ..S N1="" F S N1=$O(CT(N1)) Q:N1="" I MIUN(N1)9,'$D(@("ME"_IN(K))@("SET",A1)) S OK=0 Q .I $L(A1),$D(@("ME"_IN(K))@("SET"))>9,$D(@("ME"_IN(K))@("SET",A1)) G LP2 .I $G(@("ME"_IN(K)))'="" I A<@("ME"_IN(K)) S OK=0 Q ;02.05.00 *** LEV .I $G(@("AD"_IN(K)))'="" I A>@("AD"_IN(K)) S OK=$S(%NMB:2,1:0) Q LP2 .I $D(^rep(%REPN,"US",$L(GLOB,","))) D Q:OK'=1 ..N JJ F JJ=1:1:20 S @("x"_JJ)="" ..X ^rep(%REPN,"US",$L(GLOB,",")) .I $L(GLOB,",")=$L(GLOB2,",") D Q:OK'=1 ..N %IND ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" I $D(@%IND)#2 S %INDOLD(II)=@%IND ..S GLO="^TREP($J," ..;;N LL S LL=$P($G(^rep(%REPN,0,$P(SEDM,"*",II))),";",2) ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" D ...N LL S LL=$P($G(^rep(%REPN,0,$P(SEDM,"*",II))),";",2) ...S:$G(@%IND)="" @%IND=" - " S @%IND=$TR(@%IND,",*""()"," X'[]") ...S @%IND=$E(@%IND,1,128) ...I $L($P(SEDM,"*",II)),LL["D",@%IND["/"!(@%IND[".") S @%IND=$$^%L1DC(@%IND,3) ...F JJ=1:1 Q:'$D(MIUN(JJ)) Q:+MIUN(JJ)=II ...I $D(MIUN(JJ)),MIUN(JJ)["!",$D(^rep(%REPN,0,$P(SEDM,"*",II),"FILE")),$E(^("FILE"))'="+" D ....N A,A1,A2 S A2=$G(^("FILE")) Q:A2="" ....S A=$G(@A2@(@$P(SEDM,"*",II))) ....I A2="^PAR" S A=$P(A,"**") ....S A=$TR($E(A,$L(A)-9,$L(A)),",*""()"," X'[]") ....S A1="" F JJ=1:1:10 S A1=$E(A,JJ)_A1 ....S A1=A1_$J("",10-$L(A1))_$J(@$P(SEDM,"*",II),+LL) ....S @%IND=A1 S:@%IND="" @%IND=" " ...S GLO=GLO_%IND_"," ..S GLO=$E(GLO,1,$L(GLO)-1)_")" ..S %SRKM=0 F JJ=1:1:COLGM I $G(@("MEx"_JJ))!$G(@("ADx"_JJ)) S %SRKM=1 Q ..S OK=1 I %SRKM D ;---------- HITUHIM NOSAFIM ...F JJ=1:1:COLGM S A1=$G(@("x"_JJ)) I $D(@("MEx"_JJ)),$D(@("ADx"_JJ)),A1<@("MEx"_JJ)!(A1>@("ADx"_JJ)) S OK=0 Q ..Q:'OK ..S ST="" S:'$D(@GLO) @GLO="" F JJ=1:1:COLG S A1=$G(@$P(%L1PC("FLD"),"*",MAXMIUN+JJ)) S $P(@GLO,"*",JJ)=$S($P(%L1PC("SIK"),"*",JJ):$P($G(@GLO),"*",JJ)+A1,1:A1) ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" I $D(%INDOLD(II))#2 S @%IND=%INDOLD(II) ..K %INDOLD I @IN(K)=""!(OK=2) S K=$O(IN(K),-1) G:KMCT S FIRSTS=1 F I=1:1:$L(IND,",") S @IN(I)=$P(IND,",",I) G FRM1 FORME F K=$L(IND,","):-1:0 D STRSIK Q IND(GLOB) S IND=$P($P(GLOB,"(",2),")") N IND1,IND2,I S IND1="" F I=2:1:$L(IND,",") S IND2=$P(IND,",",I) S:$E(IND2)="""" IND2=$P(IND2,"""",2) S IND1=IND1_IND2_"," S IND=$E(IND1,1,$L(IND1)-1) Q PROST ; Q:ONLYSIK N %STRING,A,INFL,JJ,JJ1 I PRITOG D S PRITOG=0 .N IND S IND=$O(@%GLOU@(99999),-1) I IND,@%GLOU@(IND)'?1"#"."#" S %STRING="" D SAVST PROST1 S %STRING="" F JJ=1:1:MAXMIUN S INFL=@IN(JJ),A=IN(JJ) D OUTFL S JJ1=0 S %STRING=%STRING_$G(@GLOB) D SAVST Q SAVST S MONE=$O(@%GLOU@(999999),-1)+1 S @%GLOU@(MONE)=%STRING S ^TREPK($P)=MONE Q SIK ; K - UR, LASTFN - STR. KODOV DLQ PECH, SUMFL - STR. SUM N ST,KK S ST=$G(@GLOB) F KK=0:1:K F JJ=1:1:COLG D .I $P(%L1PC("SIK"),"*",JJ) D ..S SUM(KK,JJ)=$G(SUM(KK,JJ))+$P(ST,"*",JJ) ..S SUM(KK,JJ,1)=$G(SUM(KK,JJ,1))+1 F KK=1:1:K S INO(KK)=@IN(KK) Q STRSHP ; N %STRING S %STRING="#############" D SAVST Q STRSIK ; ;------------------- FORM ITOG STROKI DLQ PECHATI ( FROM "K" UR). Q:($P(SEDSM,"*",K)<1)&(K>0) ;-- NET PR. SIK N %STRING,INFL,A,I,J,JJ,JJ1,JJJ,IND S %STRING="" STRSIKA ; S JJ1=0 F JJ=K+1:1:$L(SEDSM,"*") I $P(SEDSM,"*",JJ)>0 S JJ1=JJ1+1 ;-- JJ1=0 -> POSL. ITOG I ONLYSIK,'JJ1,PRITOG D S PRITOG=0 S %STRING="" ;PUST STR. POSLE ITOGA (ONLYSIK) .N IND S IND=$O(@%GLOU@(99999),-1) I IND,@%GLOU@(IND)'?1"#"."#" S %STRING="" D SAVST S %STRING="" I 'ONLYSIK!(ONLYSIK&JJ1) D S PRITOG=1 ;-- PREDITOG. STR. .F SP=1:1:FLDNUM S %STRING=%STRING_"===========*" .S %STRING=$E(%STRING,1,$L(%STRING)-1) .D SAVST ; S %STRING="" ;------ ITOG. STR F JJ=1:1:K S INFL=INO(JJ),A=IN(JJ) D OUTFL F JJ=$L(%STRING,"*"):1:FLDNUM-COLG S OUTFL=$TR($J("",16)," ","-") D SAVFL ;;I 'JJ1,ONLYSIK,$L(GLOB) G ESS I 'JJ1,ONLYSIK G ESS I $P(SEDM,"*",K)'="" D .S $P(%STRING,"*",FLDNUM-COLG-2)=$TR($J("",16)," ","-") .N A,D S A=$G(^rep(%REPN,0,$P(SEDM,"*",K))),D=$P(A,";",2) .S $P(%STRING,"*",FLDNUM-COLG-1)=$P(A,";") .S $P(%STRING,"*",FLDNUM-COLG)=$S(D["D"&($TR(INO(K),"./","")?5N.E):$$^%L1DC(INO(K),1),$G(MIUN1(K))["!":$$INV^%L1FRM(INO(K)),1:INO(K)) ESS ; I $D(^rep(%REPN,"SIX")) D ;-- PKUDA L SHURA SIKUMIM ( HORIZ ) .N JJ,JJ1,ER F JJ=1:1:$L(^rep(%REPN,"FLD"),"*") Q:$E($P(^("FLD"),"*",JJ))="x" .S ER=0 .F JJ1=JJ:1:$L(^rep(%REPN,"FLD"),"*") I $E($P($G(^("FLD0")),"*",JJ1))="-" S ER=1 Q .I 'ER,$D(^rep(%REPN,"SIX")) X ^("SIX") ;-- PKUDA L SHURA SIKUMIM ( HORIZ ) ; N %STRING0 S %STRING0=%STRING S JJ1=0 F JJ=FLDNUM-COLG+1:1:FLDNUM D .S JJ1=JJ1+1 .S %STRING=%STRING_$J($G(SUM(K,JJ1)),2,2)_"*" D SAVST ; I $P(SEDSM,"*",K)=2!($P(SEDSM,"*",K)=3) D ;--- AVERAGE .S %STRING=%STRING0 .S $P(%STRING,"*",FLDNUM-COLG-1)="rvenn" .S JJ1=0 F JJ=FLDNUM-COLG+1:1:FLDNUM D ..S JJ1=JJ1+1 ..N COL S COL=1 I $G(SUM(K,JJ1,1)) S COL=SUM(K,JJ1,1) ..S %STRING=%STRING_$J($G(SUM(K,JJ1))/COL,2,2)_"*" .D SAVST ; F J=K:1:MAXMIUN K SUM(J) Q ; OUTFL ;-- INFL --> OUTFL (FORM-E VIX. REKV IZ VX. V ZAVIS. OT ^rep(%REPN,0,A,..)) ; ^rep(%REPN,0,A,"OUT")=, -> INFL*F(INFL) ;; F(INFL)= X ^rep(%REPN,0,A,"M2") -> VRB ;----------------------------------------------------------------------- I INFL="" G OF1 ;;I $L(INFL)>10,INFL'?1N.N S INFL=$E(INFL,11,20) N LL S LL=+$P($G(^rep(%REPN,0,A)),";",2),INFL=$$SPA^%L1FRM($E(INFL,$L(INFL)-LL+1,255)) I $P($G(^rep(%REPN,0,A)),";",2)["D" D Q .S OUTFL=INFL .I $TR(INFL,"/.","")?5N.E D ..I INFL'["."&(INFL'["/"),$L(INFL)=6 S OUTFL=$E(INFL,5,6)_"/"_$E(INFL,3,4)_"/"_$E(INFL,1,2) ..I INFL'["."&(INFL'["/"),$L(INFL)=8 S OUTFL=$E(INFL,7,8)_"/"_$E(INFL,3,4)_"/"_$E(INFL,1,2) ..I INFL'["."&(INFL'["/"),$L(INFL)=5 S OUTFL=$$^%L1DC(INFL,1) .D SAVFL ; OF1 N DOT S DOT=$P($P($G(^rep(%REPN,0,A)),";",2),",",2) I DOT S OUTFL=$J(INFL,DOT,DOT) S OUTFL=INFL D SAVFL I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"M2")) X ^("M2") S OUTFL=$TR($G(@^rep(%REPN,0,A,"OUT")),"*""(),","X'[] ") D SAVFL Q I $D(^rep(%REPN,0,A,"OUT")),$D(^rep(%REPN,0,A,"FILE")),$E(^("FILE"))'="+",INFL'="" D Q .N FILE S FILE=^rep(%REPN,0,A,"FILE") S OUTFL=$TR($G(@FILE@(INFL)),"*""(),","X'[] ") D SAVFL Q ; SAVFL S %STRING=%STRING_OUTFL_"*" Q ; INIT ; S %L1PC("COD")="" F JJ=1:1 S A=$P(SEDM,"*",JJ) Q:A="" S %L1PC("COD")=%L1PC("COD")_A_"*" I $D(^rep(%REPN,0,A,"OUT")) S %L1PC("COD")=%L1PC("COD")_^rep(%REPN,0,A,"OUT")_"*" S %L1PC("COD")=$E(%L1PC("COD"),1,$L(%L1PC("COD"))-1) S SEDFL=%L1PC("COD") ;---- SPISOK REKV DLQ PECH S FLDNUM=$L(%L1PC("COD"),"*") K SUM ; --- FLDNUM -- KOL REKV Q ; %L1PCPRM L1PCPRM ; [ 07.02.06 10:25 ] [ 05.02.06 10:06 ] [ 03.02.06 11:55 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,JOB,%L2NALAN,%SCKPORT) D ^%L1C S ZT=$ZT S $ZT="G SVER^%L1X" ;;M ^A("SCKPORT")=%SCKPORT S %L1PCOK=1 I $D(^L1PCPRM) D G:'%L1PCOK SENDE .N %A S %A=$G(^L1PCPRM) Q:%A="" .S %H=$P(%A,"*",3) .I $H-%H>1 Q .I $P($H,",",2)-$P(%H,",",2)>1000 Q .S ^L1PCPRM("ER")="BUSY" .S %L1PCOK=0 ; S %L2G1("NOCLOSE")="" K ^L1PCPRM ; D ^%L2GTR1 I '$D(^L2G1($J,"OK")) S ^L1PCPRM("ER")="NOK" G SENDE S %REPN=$G(^L1PCPRM("REPN")) I %REPN="" S ^L1PCPRM("ER")="NOREPN" G SENDE ; I $D(^L1PCPRM("QUERY"))#2 D .S QUERY=^("QUERY") .I QUERY?1N.N D Q:QUERY="" ..N N,I S N="" F I=1:1:QUERY S N=$O(^rep(%REPN,"QUERY",N)) Q:N="" ..I N'="" S QUERY=N .Q:$D(^rep(%REPN,"QUERY",QUERY))<10 .N I F I="MIUN","SIK0","CT","FLD0" S ^rep(%REPN,I)=$G(^rep(%REPN,"QUERY",QUERY,I)) ; D .N %L2NALAN,USERMOD,USERPHONE,USERPORT,USERGLOB,%SCKPORT D ^%L1PCIN ; I $D(^L1PCPRM("SHEIL")) S %L1PC("SHEIL")=$G(^("SHEIL")) ; I $D(^L1PCPRM("VAL"))>9 D .S N="" F S N=$O(^L1PCPRM("VAL",N)) Q:N="" D ..S @N=$G(^L1PCPRM("VAL",N)) ; I $D(^L1PCPRM("MIUN"))>9 D .S N="" F S N=$O(^L1PCPRM("MIUN",N)) Q:N="" D ..S MIUN(N)=$G(^L1PCPRM("MIUN",N)) ; I $D(^L1PCPRM("SIK"))>9 D .S N="" F S N=$O(^L1PCPRM("SIK",N)) Q:N="" D ..S SIK(N)=$G(^L1PCPRM("SIK",N)) ; I $D(^L1PCPRM("SIK0"))>9 D .S N="" F S N=$O(^L1PCPRM("SIK0",N)) Q:N="" D ..S SIK0(N)=$G(^L1PCPRM("SIK0",N)) ; I $D(^L1PCPRM("CT"))>9 D .S N="" F S N=$O(^L1PCPRM("CT",N)) Q:N="" D ..S CT(N)=$G(^L1PCPRM("CT",N)) ; S %GLOU="^L1PCPRM(""GLOU"")" D ^%L1PCP ; SENDE K ^UTILITY($J) S ^UTILITY($J,"L1PCPRM")="" S USERGLOB="" K ^GTR000($J) S USERPORT=$P I $D(%SCKPORT) S USERPORT=%SCKPORT M ^L1PCPRM("SCKPORT")=%SCKPORT S ^L1PCPRM("USERPORT")=USERPORT S %L1RCV="" D ^%L2GTR K ^L1PCPRM0 M ^L1PCPRM0=^L1PCPRM END K ^L1PCPRM S $ZT=$G(ZT) Q %L1PCQ %L1PCQ(QUERY) ; [ 08.04.05 4:44 PM ] [ ; IN: QUERY - NAME OF QUESTION ; N I F I="MIUN","SIK0","CT","FLD0" D .S ^rep(%REPN,I)=$G(^rep(%REPN,"QUERY",QUERY,I)) Q %L1PCS SHEIL N %L1PCER ; [ 01.07.07 11:15 ] [ 23.08.06 2:43 PM ] [ 21.08.06 2:55 PM ] F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" SHEIL1 N COD,IJK,TYP,%GETREST S %BS=0,%TO="" I $D(%L1PC("SHEIL")) X %L1PC("SHEIL") Q N %HBRY S %HBRY="" I $D(%L1GET) S Y1=4,Y2=Y1+MAXMIUN+1,X1=3,X2=79 D ^%L1RBUA D KOT S %SAY="{} zxzek | mekiq | oein {} (.) - zezli`y blcl ++2,45,HH" X %XMSG F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D Q:%BS .Q:$G(^rep(%REPN,0,COD,"SH"))=0 K %RNG ZSH .S %RNG=^rep(%REPN,0,COD) S DL=$P(%RNG,";",2),TYP=$TR($P(%RNG,";",2),"0123456789,","") S:TYP?.P TYP="E" .S %SAY=$P($P(%RNG,";"),"++")_"++"_(3+IJK)_",77,HH" .D S0 .X %XMSG .S %RNG="++"_(3+IJK)_",60,HH#++"_DL_","_TYP_",I",%L1PCER=0 .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL1^%L1PCS K %L1GET" .S %RNG=%RNG_"++++"_$G(^rep(%REPN,0,COD,"HELP")) .I $D(^rep(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++"_^rep(%REPN,0,COD,"FILE") .S %RNG("V")=COD .I TYP="D" K:$G(%L1GET)="END1"&'$D(%L1PC("VAL",COD)) %L1GET .I $D(%L1PC("VAL",COD)),'$D(%L1GET) S %L1GET="V" .D RR^%L1RNG I $G(%L1GET)="V" K %L1GET .I $D(%L1GET) G ZSHM .I $G(%TO)="END"!($G(%TO)="UP") D S IJK=IJK-1 S:IJK<0 %BS=1 Q ..N IJKOK S IJKOK=0 ..F IJK=IJK-1:-1:1 S COD=$P(%L1PC("FLD"),"*",IJK) I $L(COD) D Q:IJKOK ...I $D(%L1PC("VAL",COD)) Q ...I $G(^rep(%REPN,0,COD,"SH"))'=0 S IJKOK=1 Q .I $G(%TO)="END1" S %L1GET="END1" ;------- <.> --> %TO="END1" .;;I $D(^rep(%REPN,0,COD,"M2")),'$D(%L1GET) X ^("M2") I %L1PCER W *7 G ZSH .I TYP="D",@("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) .I TYP="D",@("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) .I TYP="D",'$G(@("AD"_COD))!'$G(@("ME"_COD)),'$D(%L1PC("VAL",COD)) W *7 G ZSH .I $G(%TO)="DW" S %TO="" Q ZSHM .S %GET="++"_(3+IJK)_",25,H#"_$S($G(MIUN(IJK)):$G(MIUN(IJK)),1:"")_"++2,E,I++++(oein 'qn ixg` ""!"" siqedl `p a""` itl oeinl) 'eke 2- dpyn oein ,1- deab ikd oein" .D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") S:$D(%L1PC("VAL",COD)) IJK=IJK-1 S:IJK<1 %BS=1 Q:%BS G ZSH .S MIUN(IJK)=%S ZSHM1 .S %GET="++"_(3+IJK)_",15,H#"_$S($G(SIK(IJK)):$G(SIK(IJK)),1:"")_"++1,E,I++3210++ 0 - zxg` ,2 - rvenn, 1 - dcy itl mekiq lawl " D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") G ZSHM .S SIK(IJK)=+%S .S %GET="++"_(3+IJK)_",7,H#"_$S($G(CT(IJK)):$G(CT(IJK)),1:"")_"++1,E,I++012++oeniq `ll e` 0 - izxbiy dcy ,2 -zexeyd oia zxzek,1 - g""ec zxzeka dcy" D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") G ZSHM1 .S CT(IJK)=+%S Q:%BS I $D(%L1PC("SHEIL1")) X %L1PC("SHEIL1") K:$G(%L1GET)="END1" %L1GET I $D(%L1GET) D SHEIL3 Q ; SHEIL2 ;---------------- HITUHIM NOSAFIM I $D(%L1PC("SHEIL")) Q N JJ,OLDCOD S JJ=0 F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" SHEIL21 N COD,IJK,TYP,%GETREST S %BS=0 N %HBRY S %HBRY="",%TO="" I $D(%L1GET) S Y1=14,Y2=Y1+$L(%L1PC("FLD"),"*")-MAXMIUN+1,X1=3,X2=79,%L1RBCL="" D ^%L1RBUA F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) I COD'?.P D Q:%BS .K %RNG .S IJK1=IJK-MAXMIUN+13 .S %RNG=^rep(%REPN,0,COD) S DL=+$P(%RNG,";",2),TYP="E" ZSH2 .S %SAY=$P($P(%RNG,";"),"++")_"++"_IJK1_",77,HH" .D S0 .X %XMSG .S %RNG="++"_IJK1_",60,HH#++"_DL_","_TYP_",I" .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL21^%L1PCS K %L1GET" .S %RNG("V")=COD ;S %RNG("DAT")="" .I '$D(%L1GET),$D(%L1PC("VAL",COD)) S %L1GET="V" .D RR^%L1RNG I $G(%L1GET)="V" K %L1GET .Q:$D(%L1GET) .I $G(%TO)="END"!($G(%TO)="UP") S IJK=IJK-2 S:IJK --> %TO="END1" S %SRKM=1 K:$G(%L1GET)="END1" %L1GET Q ; SHEIL3 ; N %L1PCER,IJK,COD,Y1,Y2,CMIN,%I ; --> %FLDMIN (-) S %FLDMIN="",%BS=0,%TO="" F %I=1:1:$L(^rep(%REPN,"FLD"),"*") I $P($G(^rep(%REPN,"FLD0")),"*",%I)="-" D .K %RNG .S COD=$P(^rep(%REPN,"FLD"),"*",%I) .Q:$G(^rep(%REPN,0,COD,"SH"))=0 .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" ;;99999999 .S %FLDMIN=%FLDMIN_COD_"*" Q:%FLDMIN="" S %FLDMIN=$E(%FLDMIN,1,$L(%FLDMIN)-1) SHEIL31 I $D(%L1PC("SHEIL")) Q S CMIN=$L(%FLDMIN,"*") N %HBRY S %HBRY="" S Y1=4+MAXMIUN+3,Y2=Y1+CMIN+1,X1=3,X2=79 I $D(%L1GET) D ^%L1RBUA D KOT S Y1=Y1-1 S %SAY="(.) - zezli`y blcl ++"_(Y1-1)_",45,HH" X %XMSG F IJK=1:1:$L(%FLDMIN,"*") D Q:%BS ZSH3 .S COD=$P(%FLDMIN,"*",IJK) Q:COD="" I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" .S %RNG=^rep(%REPN,0,COD) S DL=+$P(%RNG,";",2),TYP=$TR($P(%RNG,";",2),"0123456789,","") S:TYP?.P TYP="E" .S %SAY=$P($P(%RNG,";"),"++")_"++"_(Y1+IJK)_",77,HH" .D S0 .X %XMSG .S %RNG="++"_(Y1+IJK)_",60,HH#++"_DL_","_TYP_",I",%L1PCER=0 .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL31^%L1PCS K %L1GET" .I $D(^rep(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++++++"_^rep(%REPN,0,COD,"FILE") .S %RNG("V")=COD .I TYP="D" K:$G(%L1GET)="END1" %L1GET .I $D(%L1PC("VAL",COD)),'$D(%L1GET) S %L1GET="V" .D RR^%L1RNG I $G(%L1GET)="V" K %L1GET .Q:$D(%L1GET) .I $G(%TO)="END"!($G(%TO)="UP") S IJK=IJK-2 S:IJK<0 %BS=1 Q .I $G(%TO)="END1" S %L1GET="END1" Q ;------- <.> --> %TO="END1" .Q:$D(%L1GET) .I TYP="D",@("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) .I TYP="D",@("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) .;;I $D(^rep(%REPN,0,COD,"M2")) X ^("M2") I %L1PCER W *7 G ZSH3 .I TYP="D",'$G(@("AD"_COD))!'$G(@("ME"_COD)),'$D(%L1PC("VAL",COD)) W *7 G ZSH3 .I $G(%TO)="DW" S %TO="" Q K:$G(%L1GET)="END1" %L1GET I '$D(%L1GET) F I=1:1:$L(%FLDMIN,"*") S A=$P(%FLDMIN,"*",I) I A'?.P D .S:$G(@("ME"_A))?.P @("ME"_A_"=-99999999") .I $G(@("AD"_A))?.P S @("AD"_A)=$TR($J("",$P($G(^rep(%REPN,0,A)),";",2))," ",9) Q KOT S %SAY=" "_$G(QUERY)_" : "_$G(^rep(%REPN)) X %XMSGV Q S0 ; I ","_$P($P($G(GLOB2),"(",2),")")_","[(","_COD_",")!$D(%L1PC("S0",COD)) S %RNG("S0")=1 S %SAY="*"_%SAY Q %L1PCS0 SHEIL N %L1PCER ; [ 20.08.06 13:47 ] [ 14.01.06 17:30 ] [ 26.12.04 1:36 PM ] F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) S @("ME"_COD)="",@("AD"_COD)="" SHEIL1 N COD,IJK,TYP,%GETREST S %BS=0,%TO="" I $D(%L1PC("SHEIL")) X %L1PC("SHEIL") Q N %HBRY S %HBRY="" I $D(%L1GET) S Y1=4,Y2=Y1+MAXMIUN+1,X1=3,X2=79 D ^%L1RBUA D KOT S %SAY="{} zxzek | mekiq | oein {} (.) - zezli`y blcl ++2,45,HH" X %XMSG F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D Q:%BS .Q:$G(^rep(%REPN,0,COD,"SH"))=0 K %RNG ZSH .S %RNG=^rep(%REPN,0,COD) S DL=$P(%RNG,";",2),TYP=$TR($P(%RNG,";",2),"0123456789,","") S:TYP?.P TYP="E" .S %SAY=$P($P(%RNG,";"),"++")_"++"_(3+IJK)_",77,HH" .D S0 .X %XMSG .S %RNG="++"_(3+IJK)_",60,HH#++"_DL_","_TYP_",I",%L1PCER=0 .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL1^%L1PCS K %L1GET" .S %RNG=%RNG_"++++"_$G(^rep(%REPN,0,COD,"HELP")) .I $D(^rep(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++"_^rep(%REPN,0,COD,"FILE") .S %RNG("V")=COD .I TYP="D" K:$G(%L1GET)="END1" %L1GET .D RR^%L1RNG .I $D(%L1GET) G ZSHM .I $G(%TO)="END"!($G(%TO)="UP") D S IJK=IJK-1 S:IJK<0 %BS=1 Q ..F IJK=IJK-1:-1:1 S COD=$P(%L1PC("FLD"),"*",IJK) I $L(COD) Q:$G(^rep(%REPN,0,COD,"SH"))'=0 .I $G(%TO)="END1" S %L1GET="END1" ;------- <.> --> %TO="END1" .;;I $D(^rep(%REPN,0,COD,"M2")),'$D(%L1GET) X ^("M2") I %L1PCER W *7 G ZSH .I TYP="D",@("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) .I TYP="D",@("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) .I TYP="D",'$G(@("AD"_COD))!'$G(@("ME"_COD)) W *7 G ZSH .I $G(%TO)="DW" S %TO="" Q ZSHM .S %GET="++"_(3+IJK)_",25,H#"_$S($G(MIUN(IJK)):$G(MIUN(IJK)),1:"")_"++2,E,I++++(oein 'qn ixg` ""!"" siqedl `p a""` itl oeinl) 'eke 2- dpyn oein ,1- deab ikd oein" D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") G ZSH .S MIUN(IJK)=%S ZSHM1 .S %GET="++"_(3+IJK)_",15,H#"_$S($G(SIK(IJK)):$G(SIK(IJK)),1:"")_"++1,E,I++10++ 0 - zxg` ,1 - dcy itl mekiq lawl " D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") G ZSHM .S SIK(IJK)=+%S .S %GET="++"_(3+IJK)_",7,H#"_$S($G(CT(IJK)):$G(CT(IJK)),1:"")_"++1,E,I++012++oeniq `ll e` 0 - izxbiy dcy ,2 -zexeyd oia zxzek,1 - g""ec zxzeka dcy" D ^%L1GET I $G(%TO)="END"!($G(%TO)="UP") G ZSHM1 .S CT(IJK)=+%S Q:%BS I $D(%L1PC("SHEIL1")) X %L1PC("SHEIL1") K:$G(%L1GET)="END1" %L1GET I $D(%L1GET) D SHEIL3 Q ; SHEIL2 ;---------------- HITUHIM NOSAFIM I $D(%L1PC("SHEIL")) Q N JJ,OLDCOD S JJ=0 F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) S @("ME"_COD)="",@("AD"_COD)="" SHEIL21 N COD,IJK,TYP,%GETREST S %BS=0 N %HBRY S %HBRY="",%TO="" I $D(%L1GET) S Y1=14,Y2=Y1+$L(%L1PC("FLD"),"*")-MAXMIUN+1,X1=3,X2=79,%L1RBCL="" D ^%L1RBUA F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) I COD'?.P D Q:%BS .K %RNG .S IJK1=IJK-MAXMIUN+13 .S %RNG=^rep(%REPN,0,COD) S DL=+$P(%RNG,";",2),TYP="E" ZSH2 .S %SAY=$P($P(%RNG,";"),"++")_"++"_IJK1_",77,HH" .D S0 .X %XMSG .S %RNG="++"_IJK1_",60,HH#++"_DL_","_TYP_",I" .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL21^%L1PCS K %L1GET" .S %RNG("V")=COD ;S %RNG("DAT")="" .D RR^%L1RNG Q:$D(%L1GET) .I $G(%TO)="END"!($G(%TO)="UP") S IJK=IJK-2 S:IJK --> %TO="END1" S %SRKM=1 K:$G(%L1GET)="END1" %L1GET Q ; SHEIL3 ; N %L1PCER,IJK,COD,Y1,Y2,CMIN,%I ; --> %FLDMIN (-) S %FLDMIN="",%BS=0,%TO="" F %I=1:1:$L(^rep(%REPN,"FLD"),"*") I $P($G(^rep(%REPN,"FLD0")),"*",%I)="-" D .K %RNG .S COD=$P(^rep(%REPN,"FLD"),"*",%I) .Q:$G(^rep(%REPN,0,COD,"SH"))=0 .S @("ME"_COD)="",@("AD"_COD)="" ;;99999999 .S %FLDMIN=%FLDMIN_COD_"*" Q:%FLDMIN="" S %FLDMIN=$E(%FLDMIN,1,$L(%FLDMIN)-1) SHEIL31 I $D(%L1PC("SHEIL")) Q S CMIN=$L(%FLDMIN,"*") N %HBRY S %HBRY="" S Y1=4+MAXMIUN+3,Y2=Y1+CMIN+1,X1=3,X2=79 I $D(%L1GET) D ^%L1RBUA D KOT S Y1=Y1-1 S %SAY="(.) - zezli`y blcl ++"_(Y1-1)_",45,HH" X %XMSG F IJK=1:1:$L(%FLDMIN,"*") D Q:%BS ZSH3 .S COD=$P(%FLDMIN,"*",IJK) Q:COD="" S @("ME"_COD)="",@("AD"_COD)="" .S %RNG=^rep(%REPN,0,COD) S DL=+$P(%RNG,";",2),TYP=$TR($P(%RNG,";",2),"0123456789,","") S:TYP?.P TYP="E" .S %SAY=$P($P(%RNG,";"),"++")_"++"_(Y1+IJK)_",77,HH" .D S0 .X %XMSG .S %RNG="++"_(Y1+IJK)_",60,HH#++"_DL_","_TYP_",I",%L1PCER=0 .I %TYPCRT'="PC"&(%TYPCRT'["VT5") S %GETREST="N %GET,%XX,%YY,IJK,%RNG,%S S %L1GET="""" D SHEIL31^%L1PCS K %L1GET" .I $D(^rep(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++++++"_^rep(%REPN,0,COD,"FILE") .S %RNG("V")=COD .I TYP="D" K:$G(%L1GET)="END1" %L1GET .D RR^%L1RNG Q:$D(%L1GET) .I $G(%TO)="END"!($G(%TO)="UP") S IJK=IJK-2 S:IJK<0 %BS=1 Q .I $G(%TO)="END1" S %L1GET="END1" Q ;------- <.> --> %TO="END1" .Q:$D(%L1GET) .I TYP="D",@("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) .I TYP="D",@("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) .;;I $D(^rep(%REPN,0,COD,"M2")) X ^("M2") I %L1PCER W *7 G ZSH3 .I TYP="D",'$G(@("AD"_COD))!'$G(@("ME"_COD)) W *7 G ZSH3 .I $G(%TO)="DW" S %TO="" Q K:$G(%L1GET)="END1" %L1GET I '$D(%L1GET) F I=1:1:$L(%FLDMIN,"*") S A=$P(%FLDMIN,"*",I) I A'?.P D .S:$G(@("ME"_A))?.P @("ME"_A_"=-99999999") .I $G(@("AD"_A))?.P S @("AD"_A)=$TR($J("",$P($G(^rep(%REPN,0,A)),";",2))," ",9) Q KOT U $P S %SAY=" "_$G(QUERY)_" : "_$G(^rep(%REPN)) X %XMSGV Q S0 ; I ","_$P($P($G(GLOB2),"(",2),")")_","[(","_COD_",")!$D(%L1PC("S0",COD)) S %RNG("S0")=1 S %SAY="*"_%SAY Q %L1PCSND %L1PCSND ; [ 29.10.06 18:41 ] [ 10.10.06 18:21 ] [ 15.02.06 16:36 ] S %L1PCOK=2 K ^TREPK($P),^L1PCSND($P) ZM K %L1PC("HEAD") S %GET=" : (':' - mixgap , ** - mlek ) rcin xewn - fkxn++23,70,HH#"_$G(MRKZ)_"++4,E,I++++++^MRKZ\\\8\V" D ^%L1GET Q:%S=""!(%TO="END") Q:%S=$$^%L1MRK K MRKZ S N="" F S N=$O(^MRKZ(N)) Q:N="" S MRKZ(N)=$G(^(N)) S %ALL=0 I %S="**" S %ALL=1 I %S=":" D VIB S %ALL=.5 I %ALL G BG ; I $$^%L1ZU("0")="MLY" Q:$D(^[^UCI("MLG")]MRKZNO(%S)) I '$D(^MRKZ(%S)) S %SAY=" ! zkxrna miiw `l fkxn " X %XMSGV(1) G ZM I '$D(^MRKZ(%S,"MD")),'$D(^MRKZ(%S,"ADDR")) S %SAY=" ! zkxrna excbed `l fkxn ly IP zaezk e` mcen xtqn " X %XMSGV(1) G ZM S MRKZ=%S BG ; N %FRST S %L1PCOK=1,%FRST=1 I $D(^L1PCPRM) D Q:'%L1PCOK .N %A S %A=$G(^L1PCPRM) Q:%A="" .S %JOB=$P(%A,"*") .S %PRT=$P(%A,"*",2) .I %JOB=$J,%PRT=$P Q .S %H=$P(%A,"*",3) .I $H-%H>1 Q .I $P($H,",",2)-$P(%H,",",2)>2000 Q .I $P($H,",",2)-$P(%H,",",2)<0,$P($H,",",2)-$P(%H,",",2)+84600>2000 Q .S %L1PCOK=0 .S %GET="("_%JOB_" dniyn ) "_%PRT_" dcnrn wgexn aygnn zeg""ec zlaw zpkezd mr micaer " D N^%L1GET ; K ^L1PCPRM ; S ^L1PCPRM=$J_"*"_$P_"*"_$H S ^L1PCPRM("REPN")=%REPN D .N N S N="" F S N=$O(%REPN(N)) Q:N="" S ^L1PCPRM("VAL",N)=%REPN(N) ; N %J,%FLD,%MIUN,%CT,%SIK,%SIK0 F %J=1:1:$L(^rep(%REPN,"FLD"),"*") D .S %FLD=$P(^rep(%REPN,"FLD"),"*",%J) .I $D(@("ME"_%FLD)) S ^L1PCPRM("VAL","ME"_%FLD)=@("ME"_%FLD) .I '$D(@("ME"_%FLD)) S ^L1PCPRM("VAL","ME"_%FLD)=$S($E(%FLD)="x":-99999999,1:"") .I $D(@("AD"_%FLD)) S ^L1PCPRM("VAL","AD"_%FLD)=@("AD"_%FLD) .I $G(@("AD"_%FLD))="" S ^L1PCPRM("VAL","AD"_%FLD)=$TR($J("",+$P(^rep(%REPN,0,%FLD),";",2))," ",9) ; S %N="" F S %N=$O(MIUN(%N)) Q:%N="" D .S ^L1PCPRM("MIUN",%N)=$G(MIUN(%N)) ; S %N="" F S %N=$O(CT(%N)) Q:%N="" D .S ^L1PCPRM("CT",%N)=$G(CT(%N)) ; S %N="" F S %N=$O(SIK(%N)) Q:%N="" D .S ^L1PCPRM("SIK",%N)=$G(SIK(%N)) ; S %N="" F S %N=$O(SIK0(%N)) Q:%N="" D .S ^L1PCPRM("SIK0",%N)=$G(SIK0(%N)) ; S ^L1PCPRM("QUERY")=$G(QUERY) ; I '%ALL D SNDMRK(MRKZ) I %ALL D .S MRKZ="" F S MRKZ=$O(MRKZ(MRKZ)) Q:MRKZ="" D ..D SNDMRK(MRKZ) .Q:$D(^TREPK($P))<10 .I %REPN'["m" S %REPN=%REPN_"m" .k ^rep(%REPN) M ^rep(%REPN)=^rep($E(%REPN,1,$L(%REPN)-1)) .Q:$D(^rep(%REPN,0,"MRKZ")) .S ^rep(%REPN,0,"MRKZ")="fkxn;4" .S ^rep(%REPN,0,"MRKZ","FILE")="^MRKZ" .S ^rep(%REPN,0,"MRKZ","OUT")="MRKZ1" .S ^rep(%REPN,0,"MRKZ","SET")=0 .S ^rep(%REPN,0,"MRKZ1")="fkxn my;12H" .S ^rep(%REPN,0,"MRKZ","SH")=1 .S ^rep(%REPN,0,"MRKZ","SET")=0 .S ^rep(%REPN,"COD")="MRKZ*MRKZ1*"_^rep(%REPN,"COD") .I $D(%L1PC("COD")) S %L1PC("COD")="MRKZ*MRKZ1*"_%L1PC("COD") .S ^rep(%REPN,"FLD")="MRKZ*"_^rep(%REPN,"FLD") .I $D(%L1PC("FLD")) S %L1PC("FLD")="MRKZ*"_%L1PC("FLD") .I $D(^rep(%REPN,"FLD0")) S ^rep(%REPN,"FLD0")="MRKZ*"_^rep(%REPN,"FLD0") .I $D(%L1PC("FLD0")) I $D(%L1PC("FLD0")) S %L1PC("FLD0")="MRKZ*"_%L1PC("FLD0") .;S ^rep(%REPN,"CT")="1*1*"_^rep(%REPN,"CT") .;S %L1PC("CT")="1*1"_%L1PC("CT") .;S ^rep(%REPN,"SIK")="1*"_^rep(%REPN,"SIK") .;S %L1PC("SIK")="1*"_%L1PC("SIK") .;S ^rep(%REPN,"SIK0")="1*"_^rep(%REPN,"SIK0") .;I $D(%L1PC("SIK0")) S %L1PC("SIK0")="1*"_%L1PC("SIK0") . .S COL0=COL0+2 .S COL01=COL01+2 .S MAXMIUN=MAXMIUN+1 .S SEDM="MRKZ*"_SEDM .S SEDSM="1*"_SEDSM ; END K ^L1PCPRM I $D(^L1PCSND($P))>9 D ^%L1PCSNP Q SND(PHONE) ; S JOB=$O(^L1TRPRM(999999),-1)+1 I JOB>1000 K ^L1TRPRM(JOB-1000) M ^L1TRPRM(JOB,"REF")=^UTILITY($J) S ^L1TRPRM(JOB,"G")=1 S ^L1TRPRM(JOB,"XON")="&K4" S ^L1TRPRM(JOB,"PHONE")=PHONE S ^L1TRPRM(JOB,"PORT")=$$^%L1PORT S ^L1TRPRM(JOB,"STAT")="S\"_$P_"\"_$H ; S ^L1TRPRM(JOB,"LKH")=2 S ^L1TRPRM(JOB,"LKH1")="fkxn" S ^L1TRPRM(JOB,"UCI")=$$^%L1UCI ;S ^L1TRPRM(JOB,"DISPMSG")=1 S ^L1TRPRM(JOB,"PROG")="%L1PCPRM" S ^L1TRPRM(JOB,"PROGRCV")="%L2GTR1" ; S %L2G1("TIME")=180 S %SAY=" ... "_MRKZ_" fkxn ly aygnn g""ec ipezp zlawe zexywzdl oznd `p` " X %XMSGN D SENDJ^%L1MODJ(JOB) D ENDSEND(JOB) K ^UTILITY($J) Q ENDSEND(JOB) ; H 1 Q:$G(JOB)="" Q ; CLR ; Q ; MDPORT(STAM) Q $$MDPORT^%L1PORT ; PHONE(LEAN) ; I $G(^MRKZ(LEAN,"ADDR")) Q $G(^MRKZ(LEAN,"ADDR")) Q $G(^MRKZ(LEAN,"MD")) SNDMRK(MRKZ) ; I $$^%L1ZU("0")="MLY",$D(^MRKZNO(MRKZ)) Q K ^UTILITY($J) S ^UTILITY($J,"L1PCPRM")="" I '$D(^L1PCPRM("REPN")) S ^L1PCPRM("REPN")=%REPN D SND($$PHONE(MRKZ)) S ^L1PCSND($P,MRKZ)="NOK"_"~"_$H_"~"_%REPN I $P($G(^L1TRPRM(JOB,"STAT")),"\")'="O" S %GET("TIME")=10,%GET=" ugl .xywzdl gilvd `l " D N^%L1GET G ENDS I $G(^L1PCPRM("ER"))="BUSY" S %GET=" ugl ! qetz wgexn aygn " D N^%L1GET G ENDS I $G(^L1PCPRM("ER"))="NODATA" S %SAY=" ! mipezp oi` " X %XMSGV(1) G ENDS S ^L1PCSND($P,MRKZ)="OK"_"~"_$H_"~"_%REPN K %GLOU N %L1PCSND S %L1PCSND="" D M1^%L1PCP I '%ALL K ^TREPK($P) M ^TREPK($P)=^L1PCPRM("GLOU") I %ALL D .I '%FRST D ..S NL=$O(^TREPK($P,999999),-1)+1 ..S ^TREPK($P,NL)="#######" .N N S N="" F S N=$O(^L1PCPRM("GLOU",N)) Q:N="" D ..N %ST S %ST=$G(^(N)) ..S NL=$O(^TREPK($P,999999),-1)+1 ..N %FLD1 S %FLD1=$P(^L1PCPRM("GLOU",N),"*") ..I $E(%FLD1,1,2)="##"!(%ST="") D Q ...S ^TREPK($P,NL)=^L1PCPRM("GLOU",N) ..I %FLD1?.P,$E(%FLD1,1,2)="--" D Q ...S ^TREPK($P,NL)="-------*-------*"_^L1PCPRM("GLOU",N) ..I %FLD1?.P,$E(%FLD1,1,2)="==" D Q ...S ^TREPK($P,NL)="=========*==========*"_^L1PCPRM("GLOU",N) ..S ^TREPK($P,NL)=MRKZ_"*"_$G(^MRKZ(MRKZ))_"*"_^L1PCPRM("GLOU",N) I $D(^TREPK($P))>10,'%ALL S %L1PC("HEAD")=$G(^MRKZ(MRKZ)) I %FRST S %FRST=0 ENDS K ^L1PCPRM("GLOU"),^L1PCPRM("ER") Q VIB ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MRKZ) D ^%L1C S I=0 K ^TMP($P) S N="" F S N=$O(^MRKZ(N)) Q:N="" D .S ADR=$S($G(^MRKZ(N,"ADDR")):^("ADDR"),$G(^("MD")):^("MD"),1:"") .Q:ADR="" .S I=I+1,^TMP($P,I)=$J(ADR,18)_" | "_$$HBR^%L1FRM($G(^MRKZ(N)),22)_" | "_$J(N,5) ; S MAC="^TMP($P)" S %L2VIEW("T1")=": miyexc mifkxn , 'geex' ywn zxfra ,oiivl `p" S %L2VIEW("Y1")=6 S %L2VIEW("H")=14 S %L2VIEW("FIND")=2 S %L2VIEW("SORT")=2 S %L2VIEW("SORT",2)="H" S %L2VIEW("SORT","MASTER")=1 S %L2VIEW("SORT","HEAD")="IP zaezk e` mcen 'qn| fkxn my | fkxn " D ^%L2VIEW I $L($G(%L2VIN)),'$D(^L2VMM($J,%L2VIN)),%L2VIN,$G(%I) S ^L2VMM($J,%L2VIN)=%L2VNM I '$D(^L2VMM($J)) D A^%L1SC S %SC("ST")=1 Q K MRKZ S N="",I=0 F S N=$O(^L2VMM($J,N)) Q:N="" D .N LKH,MODEM,SHEM .S LKH=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",3)) .S MRKZ(LKH)=$G(^MRKZ(LKH)) K ^TMP($P) Q %L1PCSNP %L1PCSNP ; [ 23.12.05 1:50 PM ] [ 22.12.05 11:05 AM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C Q:'$D(^L1PCSND($P)) D FORM Q:'$D(^TMPS111($J)) ; S %S2V("TXT")=" mifkxnn zegec zxardd lewehext " D ^%S2VIEW K ^TMPS111($J) Q ; S1(TXT) ; S ^TMPS111($J,$O(^TMPS111($J,999999),-1)+1)=$J("",SM)_TXT Q FORM ; Q:'$D(^L1PCSND($P)) K ^TMPS111($J) S SM=5 S ^TMPS111($J,1)=$J("",SM)_"-------------------------------------------------------------" S ^TMPS111($J,2)=$J("",SM)_": d`vez : zxeywz onf : fkxn my : fkxn :" S ^TMPS111($J,3)=$J("",SM)_"-------------------------------------------------------------" S N="" F S N=$O(^L1PCSND($P,N)) Q:N="" S A=$G(^(N)) D .S TXT=" "_$J($P(A,"~"),3)_" :" .S TXT=TXT_$$^%L1DC($P(A,"~",2),1)_" "_$$T^%L1TIME($P($P(A,"~",2),",",2))_":" .S TXT=TXT_$$HBR^%L1FRM($G(^YZRN(N)),28)_" :" .S TXT=TXT_$J(N,5) .D S1(TXT) Q PC D FORM S:'$D(USTR) USTR=3 S %L1OUT("NOTST")="" D Z31^%L1OUT Q %L1PCT %L1PCT ; PRINT/TYPE TAVLAOT [ 09/29/96 12:50 PM ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C N %BE,%LS,%S,%L1DS,OLDDAT,YOLD,SHOLD,SCHOLD N COLG,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPG,NPGL,OTB,PG,%PRNEW,RKV,RSCR,RZD,%REFH1 N SHOLD,SCHOLD,STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2 ;SH,SCH ; N %HBRY S %HBRY="" I $D(%MBG("PAR"))>9 D ^%L1MBG1 S NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") ; BEG D INIT S %REFH1=$G(%MBG("REF"),"^MBG($P") D PS ZB S %GET="<<" D N^%L1GET I %TO="END"!(%TO=""&(%S="")) G END PGUP ; I %TO="PGUP" G:NPG'>1 ZB S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG I %TO="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) ZB S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG G ZB ;- END S %YY=24,%XX=1 X %POSIC W %ENG,%chists,%HBR Q ;- PS D PS^%L1MBG Q CLEAR ; N %XX,%YY,I U $P:(NOECHO:NOWRAP) D ^%L1RBUA F I=Y1:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q ;- ZAPR ; S %XX=X1,%YY=Y2-2 X %POSIC W $J("",X2-X1-1) S %GET=" - jiyndl , <.> - miiql , 1 - owzl, 0 - mcew jqn ++"_(Y2-2)_",75,HH#++1,E,I++10.u" D ^%L1GET S OTB=%S I OTB=0 Q:NPG'>1 S NPG=NPG-1 Q I OTB="" S NPG=NPG+1,PG(NPG)=SH-SCH+COLS Q I OTB'="."&(OTB'=1) W *7,*7 H 1 G ZAPR Q ER ; S %XXX=%XX,%YYY=%YY,$X=%XX,$Y=%YY W *7 S %SAY=" d`iby ++0,40,HH,I" X %XMSG H 2 S %SAY=" ++0,40,HH,I" X %XMSG S %XX=%XXX,%YY=%YYY X %POSIC Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S RSCR=Y2-VGR-2,STEP=$G(%MBG("STEP"),2) S COLS=RSCR-STEP\STEP,SCH=0,%YY=VGR,SH=PG(NPG) Q %L1PCZ %L1PCZ ; [ 10.09.09 22:33 ] [ 06.09.09 06:57 ] [ 09.06.09 12:38 ] N COD,COLPR,A,FLD,OUT I '$D(%POSIC) D ^%L1C X %chista N %ECHO S %HBRY="" S %SAY=" zegec llegn " X %XMSGV ZD S %GET=" g""ec cew ++2,70,HH#"_$G(%REPN)_"++6,E,I++++++^rep" D ^%L1GET Q:%S=""!($G(%TO)="END") S %REPN=%S I $D(^rep(%REPN))=11 G ZN K %Q S %Q("Z")=" xg` gecn wizrdl ",%Q("X")=10,%Q("Y")=3 D ^%S2ASK I YES D .S %GET=" dwzrdl gec cew ++3,34,HH,,,C#++6,E,I++++++^rep" D ^%L1GET Q:%S=""!(%TO="END") .N %REPN1 S %REPN1=%S .S MAC1="^rep(%REPN1)",MAC2="^rep(%REPN)" D ^%S1GC1 ZN S %RNAME=$G(^rep(%REPN)) S %GET=" g""ec xe`z ++2,50,HH#"_%RNAME_"++30,H,I" D ^%L1GET G:$G(%TO)="END" ZD S (%RNAME,^rep(%REPN))=%S S %GLOB1=$G(^rep(%REPN,"GLOB1")) Z1 S %GET="GLOBAL START:++3,1,EE#"_%GLOB1_"++40,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") ZN S %GLOB1=%S I $E(%GLOB1)'="^" S %GLOB1="^"_%GLOB1 S ^rep(%REPN,"GLOB1")=%GLOB1 S %GLOB2=$G(^rep(%REPN,"GLOB2")) Z2 S %GET="GLOBAL FINISH:++4,1,EE#"_%GLOB2_"++60,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") Z1 S %GLOB2=%S I $E(%GLOB2)'="^" S %GLOB2="^"_%GLOB2 I %GLOB2'[$E(%GLOB1,1,$L(%GLOB1)-1) X %XMSGV("ER") G Z2 S ^rep(%REPN,"GLOB2")=%GLOB2 S (%S,COD)=$G(^rep(%REPN,"COD")) Z3 S %SAY="VARIABLE LIST:++5,1,EE#" X %XMSG N %X1,%X2,%Y1,%Y2 S %X1=5,%X2=75,%Y1=6,%Y2=7 D ^%L1WE Q:$D(%L1GET) K ^MBG($P) N A,FLD S COD=%S,^rep(%REPN,"COD")=COD I $D(^rep(%REPN,0))<10 D 1,2,3,4 G %L1PCZ D 1 S COD=^rep(%REPN,"COD") Z4 D G:%S=""!($G(%TO)="END") Z5 D @%S G Z4 .F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" Q:$E(A)="x" S COLPR=I .S %XX=0,%YY=8 X %POSIC,%chiste .S %GET=" 4 - zexcbd , 3 - dpeilr zxzek , 2 - miizenk mipezp , 1 - micew ++8,70,HH#++1,E,I" .D ^%L1GET Q Z5 S %Q("Z")=" CONDENSED ",%Q("U")=$S($G(^rep(%REPN,"LPT"))="S":"Y",1:"N") D ^%S1ASK S ^rep(%REPN,"LPT")=$S(YES:"S",1:"B") G ZD 1 N COD,GLOB2,I,A S COD=^rep(%REPN,"COD") K ^MBG($P) S GLOB2=^rep(%REPN,"GLOB2") F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" Q:$E(A)="x" S COLPR=I D .N PRM .S PRM=$G(^rep(%REPN,0,A)) .;COD\SHEM\DL\SUG .S ^MBG($P,I)=A_"\"_$P(PRM,";")_"\"_+$P(PRM,";",2)_$S($P(PRM,";",2)[".":".",1:"")_"\"_$S($P(PRM,";",2)["H":"H",$P(PRM,";",2)["D":"D",1:"E") .;FILE\OUT\DL\MUMPS\SHEIL\SET .I ","_$P($P(GLOB2,")"),"(",2)_","[(","_A_",") S ^rep(%REPN,0,A,"SET")=1 .S ^MBG($P,I)=^MBG($P,I)_"\"_$G(^rep(%REPN,0,A,"FILE"))_"\"_$G(^rep(%REPN,0,A,"OUT"))_"\"_$S($D(^("M2")):^("M2"),1:"")_"\"_$G(^("SH"),1)_"\"_+$G(^("SET")) S %SAY=" g""eca micew xe`z ++9,50,HH,I,,C" X %XMSG D INIT D ^%L1MBG S %GETIN="k" D IS1^%L1GET I 'YES K ^MBG($P) Q ;G 2 K OUT F I=1:1 Q:'$D(^MBG($P,I)) D .S ST=^(I),A=$P(ST,"\") Q:A="" K ^rep(%REPN,0,A) .S ^rep(%REPN,0,A)=$P(ST,"\",2)_";"_$P(ST,"\",3)_$S($P(ST,"\",4)="H":"H",$P(ST,"\",4)="D":"D",1:"") .I $P(ST,"\",5)'="" S ^rep(%REPN,0,A,"FILE")=$S($P(ST,"\",5)'["^"&($E($P(ST,"\",5))'="+"):"^",1:"")_$P(ST,"\",5) .I $P(ST,"\",6)'="" D S:$P(ST,"\",7)'="" ^rep(%REPN,0,A,"M2")=$P(ST,"\",7) S:$P(ST,"\",9)'="" ^rep(%REPN,0,A,"SET")=$P(ST,"\",9) Q ..S ^rep(%REPN,0,A,"OUT")=$P(ST,"\",6) ..S OUT($P(ST,"\",6))="" .I $P(ST,"\",7)'="" S ^rep(%REPN,0,A,"M2")=$P(ST,"\",7) .I $P(ST,"\",8)'="" S ^rep(%REPN,0,A,"SH")=$P(ST,"\",8) .I $P(ST,"\",9)'="" S ^rep(%REPN,0,A,"SET")=$P(ST,"\",9) K ^MBG($P) S FLD="" F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) I A'="",'$D(OUT(A)) S FLD=FLD_A_"*" S ^rep(%REPN,"FLD")=$E(FLD,1,$L(FLD)-1) Q 2 S COD=^rep(%REPN,"COD") K ^MBG($P) F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" Q:$E(A)="x" S COLPR=I Q:COLPR'<$L(COD,"*") S JJ=0 F I=COLPR+1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" D .N PRM .S PRM=$G(^rep(%REPN,0,A)) .S JJ=JJ+1 S ^MBG($P,JJ)=$P(PRM,";")_"\"_$P($P(PRM,";",2),",")_"\"_+$P($P(PRM,";",2),",",2)_"\"_$P($G(^rep(%REPN,"SIK")),"*",JJ) S %SAY=" g""eca miizenk mipezp xe`z ++8,50,HH,I,,C" X %XMSG D INIT1 S %YY=%MBG("VGR0")-1,%XX=0 X %POSIC,%chiste D ^%L1MBG S %GETIN="k" D IS1^%L1GET I 'YES Q ;G %L1PCZ F I=1:1 Q:'$D(^MBG($P,I)) D .S ST=^(I) S A="x"_I K ^rep(%REPN,0,A) .S ^rep(%REPN,0,A)=$P(ST,"\")_";"_$P(ST,"\",2)_","_$P(ST,"\",3) .S $P(^rep(%REPN,"SIK"),"*",I)=$P(ST,"\",4) D GET Q 3 ; S SHP=$G(^rep(%REPN,"SHP","KOD")) K %L1GET S %GET=" dpeilr zxzek cew++8,60,HH,,,C#"_SHP_"++8,E,I" D ^%L1GET Q:($G(%TO)="END") I '$D(^rep(%REPN,"SHP")),%S="" Q I %S="" S %GET=" 99 - lehial " D N^%L1GET G:%S'=99 3 K ^rep(%REPN,"SHP") Q N SHP S SHP=%S K ^S000($P) S ^rep(%REPN,"SHP","KOD")=SHP F I=1:1 Q:'$D(^SHP(SHP,I)) S ^S000($P,I)=^SHP(SHP,I) K U,R,L,Y1,X1,U1 S %RMAX=79,%PRHBR=1,RL=79 D RSHP D ^%S2ERG1 S %GETIN="k" D IS1^%L1GET I 'YES K ^S000($P) G E3 S %GET=" ycg zxzek cew ++23,24,HH#"_SHP_"++8,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") E3 S SHP=%S K ^SHP(SHP) F I=1:1 Q:'$D(^S000($P,I)) S ^SHP(SHP,I)=^S000($P,I) S %SAY=" zxzek mixhnxt zexcbdl MUMPS zcewt qipkdl `p ++12,70,HH,I" X %XMSG S %Y1=13,%Y2=15,%X1=5,%X2=75,%S=$G(^rep(%REPN,"SHP","PROG")) D ^%L1WE I %S'="" S ^rep(%REPN,"SHP","PROG")=%S E3 X %chista S %L1GET="" D ZD K %L1GET Q INIT S NPG=1,PG(1)=0,RZD="\" K %MBG S %MBG("VGR0")=10,%MBG("VGR")=11 F J=1:1 Q:$E($T(SCREEN+J),2)="Q" S %MBG("PAR",J)=$T(SCREEN+J) S %MBG("REF")="^MBG($P" S %REFH1=%MBG("REF") S %REFHS="^MBG($P,SH)" S %MBG("STEP")=2 Q INIT1 S NPG=1,PG(1)=0,RZD="\" K %MBG S %MBG("VGR0")=10,%MBG("VGR")=11 F J=1:1 Q:$E($T(SCREEN1+J),2)="Q" S %MBG("PAR",J)=$T(SCREEN1+J) S %MBG("REF")="^MBG($P" S %REFH1=%MBG("REF") S %REFHS="^MBG($P,SH)" S %MBG("STEP")=1 Q 4 ; GET ; S %XX=0,%YY=8 X %POSIC,%chiste S %SAY=" :mipzynl aly lka zexcbd qipkdl `p ++8,50,HH,I" X %XMSG N GLOB S %BS=0 K %L1GET F II=1:1:$L(%GLOB2,",") S GLOB=$P(%GLOB2,",",1,II) S:GLOB'[")" GLOB=GLOB_")" D Q:%BS .S %SAY=GLOB_":++"_(10+(II-1*2))_",10,EE,I" X %XMSG .S %S="" S %GET="++"_(11+(II-1*2))_",3,EE#"_$G(^rep(%REPN,"US",II))_"++70,E,I" D ^%L1GET .I $G(%TO)="END"!($G(%TO)="UP") S II=II-2 I II<0 S %BS=1 .I %S?.P K ^rep(%REPN,"US",II) Q .I %S'?.P S ^rep(%REPN,"US",II)=%S .F J=1:1:$L(%S,"=") S SET=$P(%S,"=",J) S:SET[" " SET=$P(SET," ",$L(SET," ")) S:SET["," SET=$P(SET,",",$L(SET,",")) I SET'="" S SET(SET)="" N A1 S A1="" F J=1:1:$L(COD,"*") S A=$P(COD,"*",J) I ","_$P($P(%GLOB2,$P(%GLOB1,")"),2),")")_","'[(","_A_","),'$D(OUT(A)),'$D(SET(A)) S A1=A1_A_" , " I A1'="" W *7,!,$E(A1,1,$L(A1)-2)," : xcben `l " S %GETIN="k" D IS1^%L1GET I 'YES G GET Q RSHP K ^S000($P) F I=1:1 Q:'$D(^SHP(SHP,I)) D:'+$G(^SHP(SHP,I,"%TOP")) S ^S000($P,I)=^SHP(SHP,I),^S000($P,I,"%TOP")=$G(^SHP(SHP,I,"%TOP")) .S SS=^SHP(SHP,I) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S ^SHP(SHP,I,"%TOP")=II-($E(SS,II)'=" ") Q SCREEN ; KOD ;(lbp`)cew;72;8;E;#@S %MBG("NEW",%MBG("F","KOD"))=1## - d`ivi SHEM ;(zixar) my;62;16;H;#@S %MBG("NEW",%MBG("F","SHEM"))=1## DL ;jxe`;44;4;E;#@S %MBG("NEW",%MBG("F","DL"))=1## TYP ;beq;38;1;E;#@S %MBG("NEW",%MBG("F","TYP"))=1## D - jix`z , H - ixar , E - ixnep FILE ;uaew;33;18;E;### oezp xe`z `vnp dti` ,zilbp`a uaew my BEN ; dpyin ;13;8;E;#@S %MBG("NEW",J)=1##(zilbp`) oezp xe`zl dpzyn my SUG ; `zli`y zwical e` dpyn zxcbdl MUMPS zcewt ;+75;60;E;### SH ;`zli`y;+14;1;E;### 0 - `l , 1 - `zli`y SET ;hq;+6;1;E### 0 - zxg` ,1 - mipezp hq cilwdl ixyt` m`d Q SCREEN1 ; SHEM1 ;(zixar) my;72;20;H;#@S %MBG("NEW",%MBG("F","SHEM1"))=1## DL1 ;jxe`;50;4;E;#@S %MBG("NEW",%MBG("F","DL1"))=1## DL2 ;dcewp ixg`;40;4;E;### SIK ;mekiq oniq;20;1;E;#@S %MBG("NEW",%MBG("F","SIK"))=1## 0 - zxg` , 1 - mekiq lawl zexyt` Q %L1PNU %L1PNU ; [ 11/18/92 7:50 AM ] I '$D(MAC) W *7,!,"*** HASN'T GLOBAL !" Q K STEC S FLAG="",%UR=1 S GLOB=MAC D FKOD S UROV=%I-1 S %VETKA=$P(MAC,"""",2),RSTR=20 G PROV PSTR ; I %SHS+2>RSTR S %PRFIN=1 Q I '($D(^(%NXN))#2) W !?3,%NXN,?5," ",?9,"<",%MAC11_$S(%PRS:",""",1:"""")_%NXN_""") >" S %SHS=%SHS+1 Q S %CHAST=^(%NXN) S %LASTP=60-$L(%MAC11)-$L(%NXN) W !?3,%NXN,?5," ",?9,%MAC11_$S(%PRS:",""",1:"""")_%NXN_""") ",$E(%CHAST,1,%LASTP) S %SHS=%SHS+1 S %CHAST=$E(%CHAST,%LASTP+1,255) F I=0:1 S %CH1=$E(%CHAST,I*60+1,(I+1)*60) Q:%CH1="" W !?19,%CH1 S %SHS=%SHS+1 K %CHAST,%CH1 Q PROV ; I $D(@MAC)=0 W !,*7,"*** HASN'T DATA !" S FLAG="ND" H 2 Q S %MAC1=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_","""")",1:MAC_"("""")"),FLAG="",%PRS=$F(%MAC1,",") BEGP ; S %K=0,TOP(%UR)=1,STEC(%UR,TOP(%UR))=%MAC1_"!"_"0" CYC S %SHS=0 S %MAC11=$S(%PRS:$P(%MAC1,",",1,UROV),1:MAC_"(") W # S %PRFIN=0 S %NXN=$O(@%MAC1) F %I=1:1 S %K=%K+1 Q:%NXN="" D PSTR Q:%PRFIN S %IND(%I)=%NXN S %NXN=$O(^(%NXN)) I %I=1&(%NXN="") W !," *** LAST LEVEL !" H 2 Q ZN K %P G:'%PRFIN&(TOP(%UR)=1) END D .N (%UPRCOD,%XMSG,%XMSGV,%TO) S %GET="NEXT SCREEN- , PREVIOS SCREEN - , EXIT - ++23,3,EE,,,C#++1,E,I" D ^%L1GET I $G(%TO)="PGDW" G PRAVO I $G(%TO)="PGUP" G LEVO I $G(%TO)="END" G END W *7 G ZN END ; I $D(%ECHO) U $P:(ECHO:WRAP) K %MAC1,%MACF,%K,%I,%J,%IND,%NXN,%SIMB,%YES,%NOM,%SIMB,%SUB Q LEVO ; I TOP(%UR)=1 W *7 S %SAY="*** BEGIN OF LEVEL !" X %XMSGV H 1 G ZN K STEC(%UR,TOP(%UR)) S TOP(%UR)=TOP(%UR)-1,%MAC1=$P(STEC(%UR,TOP(%UR)),"!",1) S %K=$P(STEC(%UR,TOP(%UR)),"!",2) G CYC PRAVO ; I %NXN="" W *7 S %SAY="*** END OF LEVEL !" X %XMSGV H 1 G ZN X %chiste S TOP(%UR)=TOP(%UR)+1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%IND(%I-1)_""")" S STEC(%UR,TOP(%UR))=%MAC1_"!"_(%K-1) S %K=%K-1 G CYC FKOD ; F %I=2:1 Q:$P(GLOB,",",%I)="" Q %L1PORT %L1PORT(STAM) ; [ 05.02.06 10:15 ] [ 31.01.06 20:10 ] [ N ADSL S ADSL=$$ADSL I ADSL Q ADSL Q $$MDPORT MDPORT(STAM) ; Q $G(^[$$^%L1GLD]PL("MDPORT"),4) XON(STAM) ; Q $G(^[$$^%L1GLD]PL("MDXON"),"&K4") ADSL(STAM) Q $G(^[$$^%L1GLD]PL("ADSL")) %L1PR %L1PR ; PRINT PO KOMANDAM REDAKTIPOBANIA ; SHEER ; 17.02.94 [ 05/25/94 4:52 PM ] ; STR --- INPUT LINE S STR=$C(217)_"CEN"_$C(215)_"TR"_$C(215)_"OBKA "_$C(189) S STR=$C(217)_"CEN"_$C(215)_"TR"_$C(215)_"OBKA " S STR=$C(172)_"qkl`" S (CENT,SPACE,BRI,LINE,BOL)=0 W !,STR,! Q INP ; %GLO,%LL ; S IND="" F S IND=$O(@%GLO@(IND)) Q:IND="" S STR=^(IND) W $L(STR),! D 0 O 3 U 3 S IND="" F S IND=$O(@%GLO@(IND)) Q:IND="" S STR=^(IND) D 0 C 3 Q Q 0 S %LL=80,STR1="" S (CENT,SPACE,BRI,LINE,BOL,DBA,POD)=0 I STR[$C(172)!(STR[$C(236)) G B I STR[$C(250)!(STR[$C(231)) G G I STR[$C(189)!(STR[$C(217)) G C I STR[$C(162)!(STR[$C(177)) G 2 I STR[$C(196)!(STR[$C(239)) G POD FOR ; F %EE=1:1:$L(STR) S %SYM=$E(STR,%EE) D .I $A(%SYM)=197!($A(%SYM)=215) S SPACE='SPACE Q ; _" "_ .I $A(%SYM)=172!($A(%SYM)=236) S BOL='BOL Q .I $A(%SYM)=241!($A(%SYM)=226) D Y Q .I $A(%SYM)=178!($A(%SYM)=163) W # Q .I $A(%SYM)=179!($A(%SYM)=161) S LINE='LINE Q ; CHEREZ STROKU .I 'CENT W %SYM I SPACE W " " .I CENT S STR1=STR1_%SYM I SPACE S STR1=STR1_" " .Q I CENT W $J(STR1,$L(STR1)+(%LL-$L(STR1)\2)),! W ! I LINE W ! Q 2 W $TR(STR,$C(162)_$C(177),"") W *13 F I=1:1:$L(STR) D .I $A(STR,I)=162!($A(STR,I)=177) S DBA='DBA .E W $S(DBA:$E(STR,I),1:" ") Q POD W $TR(STR,$C(196)_$C(239),"") W *13 F I=1:1:$L(STR) D .I $A(STR,I)=196!($A(STR,I)=239) S POD='POD .E W $S(POD:"_",1:" ") Q C ; S CENT=1 S STR=$P(STR,$C(189),1)_$P(STR,$C(189),2)_$P(STR,$C(189),3)_$P(STR,$C(189),4) S STR=$P(STR,$C(217),1)_$P(STR,$C(217),2)_$P(STR,$C(217),3)_$P(STR,$C(217),4) D FOR S CENT=0 Q G ; S STR=$TR($$AA(STR),$C(250)_$C(231),"") W *27,"W1",$TR(STR,$C(231),""),*27,"W0",! Q B ; S STR=$TR(STR,$C(172)_$C(236),"") S %L1BKV("MIL")=STR D 1^%L1BKV Q Y ; ; ; ; ; Q PERE ; K STR,XBOST,STR1,KOLPR,BSTAV,BST,DOP S %LL=79 ; %GLO - GLOBAL %NS - # STROKI, %NP - # POZICII, %LL - DLINA STROKI S STR=@%GLO@(%NS) S XBOST=" "_$$AA($E(STR,1,%NP)),STR=$E(STR,%NP+1,255) S @%GLO@(%NS)=$J(STR,%LL) F S %NS=$O(@%GLO@(%NS)) Q:XBOST?." " Q:%NS="" S STR=^(%NS) Q:$E(STR,%LL-1,%LL)[" " D .S STR=STR_XBOST S %NP=$L(STR)-%LL F %NP=%NP:1:79 Q:$E(STR,%NP)=" " .S XBOST=" "_$$AA($E(STR,1,%NP)),STR=$E(STR,%NP+1,255) .S @%GLO@(%NS)=$J(STR,%LL) I XBOST'?." " S POSL="" D S ^(%NS)=$J(XBOST,%LL) .F S POSL=$ZP(@%GLO@(POSL)) Q:POSL=%NS S ^(POSL+1)=^(POSL) Q ; ---- 25.05.94 ; O 10 U 10 W !,%NP U 0 S STR=@%GLO@(%NS) F %NP=%NP:1:79 Q:$E(STR,%NP)=" " ; U 10 W !,%NP R R C 10 ; STR,$J($L(STR),5) S XBOST=" "_$$AA($E(STR,1,%NP)),STR=$E(STR,%NP+1,255) ;W !,XBOST,$J($L(XBOST),5) W !,STR,$J($L(STR),5) R R C 17 LAB ; S STR1="",KOLPR=$L(STR," ")-1 G:'KOLPR LA S BSTAV=%LL-$L(STR),BST=BSTAV\KOLPR,DOP=BSTAV#KOLPR F I=1:1:KOLPR+1 S STR1=STR1_$P(STR," ",I)_$E($J("",30),1,BST)_$S(DOP>0:" ",1:" ") S DOP=DOP-1 S @%GLO@(%NS)=$E(STR1,1,%LL),@%GLO@(%NS,"%TOP")=0 ; LA S %NS=%NS+1,@%GLO@(%NS)=$J($$AA($G(@%GLO@(%NS)))_XBOST,79) S @%GLO@(%NS,"%TOP")=79-$L(@%GLO@(%NS)) I $L(@%GLO@(%NS))>%LL S %NP=$L(@%GLO@(%NS))-%LL G PERE Q G:$O(@%GLO@(%NS))="" END S %NS=$O(@%GLO@(%NS)),STR=^(%NS) S STR=$$AA(STR) I $E(STR,$L(STR))=" " D S @%GLO@(%NS)=$J(XBOST,%LL) G END .F IND=$ZP(@%GLO@("")):-1:%NS S @%GLO@(IND+1)=@%GLO@(IND) I $D(@%GLO@(IND,"%TOP")) S @%GLO@(IND+1,"%TOP")=@%GLO@(IND,"%TOP") S STR=STR_XBOST G:$L(STR)'>%LL END F I=2:1 Q:$L($P(STR," ",I,255))'>%LL S XBOST=" "_$P(STR," ",1,I-1),STR=$P(STR," ",I,255) G LAB Q END ; ; S IND="" F S IND=$O(@%GLO@(IND)) Q:IND="" W !,^(IND) Q PROBA ; S %LL=80 N STR1,CENT,SPACE,BRI,LINE,BOL S %GLO="^SC(""SASA"")" W %HBR S IND="" F S IND=$O(@%GLO@(IND)) Q:IND="" S STR=$$AA(^(IND)) D 0 Q AA(INP) ; 1 I $E(INP)=" " S INP=$E(INP,2,$L(INP)) G 1 2 ; I $E(INP,$L(INP))=" " S INP=$E(INP,1,$L(INP)-1) G 2 Q INP AAA ; F I=1:1:$L(STR) W $A(STR,I)," " Q SCEP ; S %GLO="^SC(""SAS"")",%NS=7,%LL=80 S %LL=79,Q=0 S %NS=%NS-1 F S %NS=$O(@%GLO@(%NS)) Q:'%NS D Q:Q="Q" .Q:'$O(@%GLO@(%NS)) .I $O(@%GLO@(%NS+2)) S %SL=@%GLO@(%NS+2) I $E(%SL,$L(%SL)-1,$L(%SL))=" " S Q="Q" .S STR=$$AA(@%GLO@(%NS)) S STR=$$UDA(STR) .S %SLED=$$AA(^(%NS+1)) S %SLED=$$UDA(%SLED) D ..F II=$L(%SLED," "):-1 S PIC=$P(%SLED," ",II) Q:$L(PIC_" "_STR)>%LL D ...S STR=PIC_" "_STR ..D RASH S STR=$P(%SLED," ",1,II) .S @%GLO@(%NS)=STR1,@%GLO@(%NS+1)=$J(STR,79) .S @%GLO@(%NS,"%TOP")=0,@%GLO@(%NS+1,"%TOP")=79-$L(STR) Q S STR=$$AA(@%GLO@(%NS)) S STR=$$UDA(STR) ; DELETE LISHNIX PROBELOV F I=%NS+1:1 Q:$G(@%GLO@(I))="" S %SLED=$$AA(^(I)) S %SLED=$$UDA(%SLED) D .F II=$L(%SLED," "):-1 S PIC=$P(%SLED," ",II) Q:$L(PIC_" "_STR)>%LL D ..S STR=PIC_" "_STR .D RASH S STR=$P(%SLED," ",1,II) .S @%GLO@(I-1)=STR1 Q UDA(ARG) ; N PIC S ARG1="" F PIC=1:1:$L(ARG," ") I $P(ARG," ",PIC)'="" S ARG1=ARG1_$P(ARG," ",PIC)_" " I $E(ARG,$L(ARG))'=" " S ARG1=$E(ARG1,1,$L(ARG1)-1) Q ARG1 RASH ; N I S STR1="",KOLPR=$L(STR," ")-1,BSTAV=%LL-$L(STR),BST=BSTAV\KOLPR,DOP=BSTAV#KOLPR F I=1:1:KOLPR+1 S STR1=STR1_$P(STR," ",I)_$E($J("",30),1,BST)_$S(DOP>0:" ",1:" ") S DOP=DOP-1 ; W !,STR1 Q %L1PRESS %L1PRESS(TXT,Y0,X0,Y2,X2) ; [ 28.03.04 12:54 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,TXT,Y0,Y2,X0,X2) D ^%L1C Q:'$$HZGTOUCH^%L2MOUSE Q:'$L($G(TXT)) S:'$D(Y0) Y0=23 S:'$D(Y2) Y2=Y0+1 S:'$D(X0) X0=(80-$L(TXT))\2 S:'$D(X2) X2=X0+$L(TXT) S MTXT("B")=%CV("MB") S MTXT(1,1)=TXT S MTXT(1,1,"TO")="END" S COLX=$O(MTXT(1,20),-1),COLY=1,SH=1 S STEPX=X2-X0+1,STEPY=Y2-Y0+1,%PREV="" D TV^P1RBUA S %S="" Q %L1PROT %L1PROT ; [ 03/15/92 4:34 PM ] N D ^%L1C D ^%RSEL S N="",STOP=0 F S N=$O(^UTILITY($J,N)) Q:N="" Q:STOP D .K %Q S %Q("B")="" S %Q("Z")="SOURCE TEXT OF ROUTINE "_N_" ... DELETE" D ^%S1ASK S:YES="^"!(YES=".") STOP=1 Q:'(+YES) .X "ZL @N ZS @N:1" M D ^%RSEL S N="",STOP=0 F S N=$O(^UTILITY($J,N)) Q:N="" X "ZL @N ZS @N:1" %L1PRSC %L1PRSC ; [ 10.12.06 17:02 ] [ 08.11.06 16:58 ] [ 24.10.06 17:25 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C D GET^%VIDEO("scr",0,0,80,25,0) S USTR=3 S %DEV="USTR" D ^%L1LPT Q:$G(%EROP) Q:'$D(scr) U USTR S %END=0 S I=1 F D Q:%END .N A S A=$E(scr,I,I+79) .W A,! .I $L(scr)'>(I+79) S %END=1 Q .S I=I+80 D CLOSE^%L1LPT Q %L1PTW %L1PTW(GLOB,FL) ; HAAVARAT KVAZIM DEREH POWERTERM [ 23.11.05 13:15 ] [ 16.06.03 9:26 AM ] [ 15.06.03 12:38 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,GLOB,DIR,FL) D ^%L1C X %chista S %SAY=" "_FL_" uaewl mipezp zxard " S I=1,N="",J=0 C ; j S N=$O(@GLOB@(N)) Q:N="" S ST=$$PRST($G(^(N))) S TYP=$S('I:"w+",1:"a+") I '$$TV(FL,TYP,ST,I) Q S I=I+1,J=0 G C Q TV(FL,TYP,ST,I) ; N J,OK S J=0 N FLRCV S FLRCV="tranas.psl" G TV1 TV0(STAM) ; TV1 S ST=$$PRST(ST) U 0 W $C(27)_"P$s"_FLRCV_" "_FL_" "_TYP_" """_ST_""""_$c(27)_"\" R OK:10 I OK="NOKI=" U 0 W "--- DOUBLE I="_I,! Q 1 I OK'="OK" U 0 W "--- ERROR ! ",! S J=J+1 G:J<8 TV1 Q 0 Q 1 ; TVB(FL,ST,I) ; N J,OK,TYP S J=0 I I=0 S TYP="w+" E S TYP="a+" S FLRCV="tranb.psl" TVB1 Q $$TV0 ; PRST(ST) ; S ST=$TR(ST,""";","',") Q ST S ST=$$RPL^%L1FRM(ST,"[","\[") S ST=$$RPL^%L1FRM(ST,"]","\]") S ST=$$RPL^%L1FRM(ST,"{","\{") S ST=$$RPL^%L1FRM(ST,"}","\}") S ST=$$RPL^%L1FRM(ST,"$","\$") S ST=$$RPL^%L1FRM(ST,"$","\$") Q %L1PZ %L1PCZ ; [ 08/03/93 1:31 PM ] I '$D(%POSIC) D ^%L1C X %chista N %ECHO S %HBRY="" S %SAY=" zegec llegn " X %XMSGV ZD S %GET=" gec xtqn ++3,70,HH#++4,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S %REPN=%S S %RNAME=$G(^rep(%REPN)) ZN S %GET=" gec xe`z ++3,50,HH#"_%RNAME_"++30,H,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S %RNAME=%S S %GLOB1=$G(^rep(%REPN,"GLOB1")) Z1 S %GET="GLOBAL START :++5,1,EE#"_%GLOB1_"++40,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") ZN S %GLOB1=%S I $E(%GLOB1)'="^" S %GLOB1="^"_%GLOB1 S %GLOB2=$G(^rep(%REPN,"GLOB2")) Z2 S %GET="GLOBAL FINISH :++6,1,EE#"_%GLOB2_"++64,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") Z1 S %GLOB2=%S I $E(%GLOB2)'="^" S %GLOB2="^"_%GLOB2 I %GLOB2'[$E(%GLOB1,$L(%GLOB1-1)) X %XMSG("ER") G Z2 %L1RB %L1RB(X1,X2,Y1,Y2) ; [ 09.06.03 08:48 ] [ 10/23/99 6:40 AM ] I $G(%XMSG(0))>1 S X1=X1-1,X2=X2-1 RBUA1 N I,J W %ENG U $P:(NOECHO:NOWRAP) I $D(%L1RBCL) D .I %TYPCRT["VT5",'%CVET W $C(27,91),Y1,";",X1,";",Y2,";",X2,"$z" Q .I $G(%CVET),$L($G(%L1RBCL)) N %N S %N="" F S %N=$O(%CV(%N)) Q:%N="" I %L1RBCL=%CV(%N) W %L1RBCL Q .F I=Y1:1:Y2-1 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) ;I %TYPCRT["PC" W $C(27,91),Y1,";",X1,";",Y2,";",X2,"b" Q ;I %TYPCRT["VT5" W $C(27,91),Y1,";",X1,";",Y2,";",X2,"b" Q ;;W *27,"(0" ;;W *27,")0" I %TYPCRT="VT100" W *27,"["_Y1_";"_X1_"H",$C(104) F I=X1+1:1:X2-1 W $C(116) E W *27,"["_Y1_";"_X1_"H",$C(108) F I=X1+1:1:X2-1 W $C(113) W *27,"["_Y1_";"_X2_"H" W $C(107) I %TYPCRT="VT100" F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(112) E F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(120) I %TYPCRT="VT100" W *27,"["_Y2_";"_X1_"H",$C(105) F I=X1+1:1:X2-1 W $C(116) E W *27,"["_Y2_";"_X1_"H",$C(109) F I=X1+1:1:X2-1 W $C(113) W *27,"["_Y2_";"_X2_"H" W $C(106) ;;W *27,"(B" ;;W *27,")B" W %HBR Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q %L1RBUA %L1RBUA ; INPUT X1,X2,Y1,Y2 [ 15.03.19 12:22 ] [ 26.04.07 21:42 ] [ 12.12.06 23:06 ] RBUA ; INPUT X1,X2,Y1,Y2 RBUA1 N I,J,%YY,%XX W %ENG U $P:(NOECHO:NOWRAP) ; I $D(%L1RBCL) D CLEAR(Y1,X1,Y2,X2) ; I %TYPCRT["PC",%XMSG(0)'<0 D G END .W *27,"["_Y1_";"_X1_"H" W $S($G(%L1RBCL)=%CV("MB"):%CV("MB"),1:%CV("CB")) .F I=X1:1:X2 W " " .F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H"," " .W *27,"["_Y2_";"_X1_"H" F I=X1:1:X2 W " " .X %XCL ; I %TYPCRT["PC",%XMSG(0)<0 D G END .W *27,"["_Y1_";"_X1_"H" .D LVUG F I=X1+1:1:X2-1 D GLIN .D PVUG .F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H" D VLIN .W *27,"["_Y2_";"_X1_"H" D LNUG F I=X1+1:1:X2-1 D GLIN .D PNUG .X %XCL ; I %TYPCRT["-" D TV1(Y1-1,X1-1,Y2-1,X2-1) G END I %TYPCRT["VT" W *27,"(0" I %TYPCRT="VT100" W *27,"["_Y1_";"_X1_"H",$C(104) F I=X1+1:1:X2-1 W $C(116) E D .W *27,"["_Y1_";"_X1_"H",$C(108) .N I F I=X1+1:1:X2-1 W *27,"["_Y1_";"_I_"H",$C(113) ; W *27,"["_Y1_";"_X2_"H" W $C(107) I %TYPCRT="VT100" F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(112) E F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(120) I %TYPCRT="VT100" W *27,"["_Y2_";"_X1_"H",$C(105) F I=X1+1:1:X2-1 W $C(116) E W *27,"["_Y2_";"_X1_"H",$C(109) W $TR($J("",X2-X1-1)," ",$C(113)) ; F I=X1+1:1:X2-1 W $C(113) W *27,"["_Y2_";"_X2_"H" W $C(106) I %TYPCRT["?",'$D(%MENU) H 1 I %TYPCRT["VT" W *27,"(B" END ;;K %L1RBUA,%L1RBCL Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q TV(Y1,X1,Y2,X2) ; N P F P="Y1","X1","Y2","X2" S @P=$J(@P,0,0) I Y1=Y2 D Q ;-- LINE .N %XX,%YY .I $E(%TYPCRT,1,2)["PC" D Q ..S %XX=X1,%YY=Y1 X %POSIC N %I F %I=X1:1:X2 W $C(196) .W $C(27),"(0" S %XX=X1,%YY=Y1 X %POSIC N %I F %I=X1:1:X2 W $C(113) .W $C(27),"(B" D BDK ; G RBUA TV1(Y1,X1,Y2,X2) ; N %XX,%YY,%I S %XX=X1,%YY=Y1 X %POSIC F %I=X1:1:X2 W "-" F %I=Y1+1:1:Y2-1 S %XX=X1,%YY=%I X %POSIC W "|" S %XX=X2,%YY=%I X %POSIC W "|" S %XX=X1,%YY=Y2 X %POSIC F %I=X1:1:X2 W "-" Q CLEAR(Y1,X1,Y2,X2) ; D BDK N %XX,%YY,I I %TYPCRT["VT5",%L1RBCL=%CV("BB")!'%CVET W $C(27,91),Y1+1,";",X1+1,";",Y2,";",X2-1,"$z" Q I $G(%CVET),$L($G(%L1RBCL)) N %N S %N="" F S %N=$O(%CV(%N)) Q:%N="" I %L1RBCL=%CV(%N) W %L1RBCL Q U $P:(NOECHO:NOWRAP) F I=Y1:1:Y2-1 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q BDK ; I X1<0,X2>0 D .N R S R=X2-X1,X1=X2,X2=X2+R I X1>X2 D .N X0 S X0=X1,X1=X2,X2=X0 Q LVUG ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(201) Q W $C(218) Q PVUG ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(187) Q W $C(191) Q GLIN ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(205) Q W $C(196) Q VLIN ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(186) Q W $C(179) Q LNUG ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(200) Q W $C(192) Q PNUG ; I $D(%L1RBUA("DOUBLE")),%TYPCRT="PC" W $C(188) Q W $C(217) Q %L1RCDOS %L1RCDOS ; [ 11/01/99 7:37 PM ] [ L ^L1TRDOS K ^L1TRDOS D ^%L2GTR1 I $G(^L1TRDOS)="" G END N FILE S FILE=^L1TRDOS O FILE:(WRITE:NEWVERSION):1 S N="" F S N=$O(^L1TRDOS(N)) Q:N="" D .U FILE W ^(N) .I $D(^L1TRDOS(N,"BK")) W $C(13) K ^L1TRDOS END C FILE L Q %L1RCE %L1RCE ;GT.M %RCE utility - change every occurrence of a string in one or more routines [ 29.12.16 18:40 ] [ 20.06.07 08:18 ] [ 19.11.05 18:47 ] ;invoke ^%L1RCE to get interaction ;invoke CALL^%L1RCE with %ZF - string to find, %ZN - new string, %ZR - routine array or name, ; %ZD an optional device to receive a trail ; n cnt1,cnt2,cnt3,fnd,h,i,o,out,outd,r,tf,x,xn,%ZC,%ZD,%ZF,%ZN,%ZR i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%L1RCE" u $p:(ctrap=$c(3):exc="zg "_$zl_":LOOP^%L1RCE") d init,MAIN u $p:(ctrap="":exc="") q CALL i '$l($g(%ZF)) q n %ZC,cnt1,cnt2,cnt3,fnd,h,i,o,out,outd,r,tf,x,xn n:'$d(%ZD) %ZD s %ZC=1,%ZD=$g(%ZD),%ZN=$g(%ZN),(cnt1,cnt2,cnt3,out)=0,outd=$l(%ZD),tf=$j_"rce.tmp" s:'outd %ZD=$p i $d(%ZR)<10 D ^%L1RSEL ;; d CALL^%RSEL d work q init s %ZC=1,(cnt1,cnt2,cnt3)=0,out=1,tf=$j_"rce.tmp" w !,"Routine Change Every occurrence",! q MAIN s %ZR="" d ^%L1RSEL ;CALL^%RSEL i %ZR=0 w !,"No routines selected" q w !,$s(%ZC:"Old",1:"Find")," string: " S %S="" K %LS D ^%ZMSL S %ZF=%S ;r %ZF i '$l(%ZF) w !,"No search string to find - no search performed",! q i %ZF?.E1C.E w !,"The find string contains control characters" i %ZC w !,"New string: " S %S="" K %LS D ^%ZMSL S %ZN=%S ;r %ZF i %ZC,%ZN?.E1C.E w !,"The New string contains control characters" w !,$s(%ZC:"Replace",1:"Find")," all occurrences of:",!,">",%ZF,"<",! i %ZC w "With: ",!,">",%ZN,"<",! i %ZC f r !,"Show changed lines ?: ",x,! q:$e(x)'="?" d help i %ZC,$l(x) q:"\QUIT"[("\"_$tr(x,"quit","QUIT")) s outd=$e("NO",1,$l(x))'=$e($tr(x,"no","NO"),1,2) e s outd=1 i outd f d q:$l(%ZD) . r !,"Output device: : ",%ZD,! . i '$l(%ZD) s %ZD=$S(%ZC:$p,1:"aaaaa") q:%ZD=$p . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for output" . . w !,"If you wish to exit enter a carat (^)",! . i $zparse(%ZD)="" w " no such device" s %ZD="" q . c %ZD:DELETE . o %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" w ! d work q work s %ZR="",r=$zsearch("__") i outd,%ZD'=$p u %ZD w $zd($h,"DD-MON-YEAR 24:60:SS"),! i w "Routine ",$s(%ZC:"Change",1:"Search for")," Every occurrence of:",!,">",%ZF,"<",! i %ZC w "To:",!,">",%ZN,"<",! i '%ZC d . s gtmvt=$$GTMVT^%GSE . i gtmvt s sx=$c(27)_"[7m"_%ZF_$c(27)_"[0m" . e s sx=%ZF,flen=$l(%ZF),tics=$tr($j("",flen)," ","^") ; K ^RSEWORD f s %ZR=$o(%ZR(%ZR)) q:'$l(%ZR) d scan q:'out u %ZD w !!,"Total of ",cnt1," routine",$s(cnt1=1:"",1:"s")," parsed.",! w cnt2," occurrence",$s(cnt2=1:" ",1:"s "),$s(%ZC:"changed",1:"found")," in ",cnt3," routine",$s(cnt3=1:".",1:"s."),! c %ZD I %ZD="aaaaa" D .S %NMF=%ZD_">",%S2V("NOHB")="",%S2V("TXT")=" LOOKING FOR : "_%ZF_" " .I $D(%JSP) S %S2V("JSP")=%JSP .S %S2V("PROG")="viewpr^%L1RCE" .D ^%S2V O %ZD C %ZD:(DELETE) q viewpr ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,U,%JSP) D ^%L1C s %st=$g(^TMPS111($J,U)) I $E(%st,1,2)'="<<",$E(%st,$L(%st)-1,$L(%st))'=">>" q s %ind="+"_+$p(%st,"+",2)_"^"_$p($p(%st,"<<",2),"+") d POISK^%L1ER(%ind) q scan s r=%ZR(%ZR)_$tr($e(%ZR),"%","_")_$e(%ZR,2,9999)_$S($D(%JSP):".jsp",1:".m"),o=$zsearch(r),fnd=0 u $p i out,%ZD'=$p!'outd w:$x>70 ! w %ZR,?$x\10+1*10 ;;i outd,%ZC u %ZD w !!,r o:%ZC tf:(newversion:exception="s fnd=0 g reof") o o:(readonly:record=2048:rewind:exception="g rnoopen") u o:(exception="g reof") s cnt1=cnt1+1 s cntr=0,yes="" f u o:TERM=$C(13) r x s h=$l(x,%ZF) d .s cntr=cntr+1 . i h=1 d:%ZC q . . u tf w x,! . ;----------------- F O U N D . i outd,'fnd u %ZD w !!,r . s fnd=fnd+h-1 . i %ZC d q . . i outd u %ZD w !,$c(27),"[1m",%ZR,"+",cntr,">>",$c(27),"[0m" . . s xn="" . . f i=1:1:h-1 d . . .d:yes'="."&(yes'=2) ask(i) i 'yes s xn=xn_$p(x,%ZF,i)_%ZF q . . .s xn=xn_$p(x,%ZF,i)_%ZN . .s xn=xn_$p(x,%ZF,h) . . i outd w !,"Now: ",xn . . u tf w xn,! q . ; -------------------- S H O W O N L Y . u %ZD w ! s rl="" . w "<<",%ZR,"+",cntr,">>" w ! . N POS S POS=0 . f i=1:1:h-1 D .. N WORD S POS=$F(x,%ZF,POS)-$L(%ZF) .. S WORD=$P($P($E(x,POS,1000)," "),",") .. ; .. S WORD=$P(WORD,"(") .. S WORD=$P(WORD,"]") .. I WORD'="" S ^RSEWORD(WORD)=%ZR .. s p=$tr($p(x,%ZF,i),$c(9)," ") .. w p,sx .. i 'gtmvt s rl=rl_$j(tics,$l(p)+flen) . . w $p(x,%ZF,h) . i 'gtmvt w !,rl q reof i fnd s cnt2=cnt2+fnd,cnt3=cnt3+1 i %ZC c:$zver'["VMS" o:(DELETE) c tf:(RENAME=r) e c o i %ZC c tf:(DELETE) ; warning - fall-through rnoopen i $zs'["EOF" w !,$p($zs,",",2,999),! q help i "Dd"[$e(x,2),$l(%x)=2 d cur q i %ZC w !,"Answer No to this prompt if you do not wish a trail of the changes" w !,"Enter Q to exit",! w !,"?D for the current routine selection" q cur w ! s r="" f s r=$o(%ZR(r)) q:'$l(r) w:$x>70 ! w r,?$x\10+1*10 q ERR i $d(tf) c tf:(DELETE) i $d(o) c o i $d(%ZD),%ZD'=$p c %ZD u $p w !,$p($ZS,",",2,999),! u $p:(ctrap="":exception="") s $ec="" q LOOP i $d(tf) c tf:delete i $d(o) c o i $d(%ZD),%ZD'=$p c %ZD d MAIN u $p:(ctrap="":exception="") q ask(i) ; w !,xn_$p(x,%ZF,i)_$c(27)_"[7m"_%ZF_$c(27)_"[0m"_$p(x,%ZF,i+1,255) f r !,"Change (y,yy,n,.) : ",yes i $l(yes),"YyNn."[$e(yes) q i yes'="." s yes=$s(yes="yy"!(yes="YY"):2,"Yy"[$E(yes):1,1:0) q %L1RCMP %RCMP ;JWC;COMPARE ROUNTINES {BETWEEN UCI'S} [ 09/16/93 3:16 PM ] ;Copyright Micronetics Design Corp. @1986 U 0 N $ZT S $ZT="" ;;S $ZT="G ERR^%RCMP" U 0 W !?10,$P($P($ZV,","),"-")," - ","Routine Compare Utility" DOIT D SET,BG D COMP U 0 W !!,"**** DONE ****" G EXIT SET S:'$D(%SP) %SP=.55 S %SCR="Y",%SEL="Y" Q ERR ; I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT Q EXIT ;I $D(%HI) V 2:$J:%HI:2 I $D(%DEV),%DEV'=$I C %DEV K %LCT,%LPP,%SCR,%WH,%DAT,%DAT1,%LY,%N,%TIM,%V,%ZA,%LD,%LF,%DN,%HI,%LD,%LF,%LM,%LX,%Q,%RUM,%SP,%UCI,%UI,%,%D,%S,%ED,%ES,%DD,%T,%X,%Y,%TTL,%TAD,%TMD,%TDL,%TSM,%I,%LL,%SEL,%TIM1,%DAY1,%YY,%TY,%DEV,%FN,%TP,%P,%CL,QUIT,VIEW K ^UTILITY($J,1),^(2) Q BG S %SEL="Y" GDEV2 R !!,"Line per page <16>: ",%LPP S:%LPP="" %LPP=16 I %LPP="?" W !!,"Enter a positive integer for line per page",!,"Enter '^' for Scroll question" G GDEV2 I %LPP'>0 W "Must be a positive interger" G GDEV2 ; GDEV3 W !!,"Line width <80> :" R %WH S:%WH="" %WH=80 I %WH="^" G GDEV2 I %WH="?" W !!,"Enter number of characters per line" G GDEV3 I %WH'>0 W "Must be a positive integer" G GDEV3 S %WH=%WH-20\2 ; GLST R !!,"Listing level (S/D/B) : ",%LL S:%LL="" %LL="B" S:$A(%LL)>96 %LL=$C($A(%LL)-32) S %Q=$S(%LL="^":-1,%LL="^Q":1,1:0) I %Q Q I %LL="?" D GLST1 G GLST G:%LL'="D"&(%LL'="S")&(%LL'="B") GLST QUIT GLST1 W !!,"Enter 'B' for a brief listing (identical code is not listed).",! W " 'D' for a detailed listing (all source code is listed).",!," 'S' for a statistics listing (counts only).",!,"Enter '^' return to previous question",!,"Enter '^Q' to exit the utility." QUIT HIUI W !!," Enter the name of the routine to be compared, or" W !," to accept the default routine name" W !," '-' to skip the compare of this routine.",!," '^' or '^Q' to exit the utility." QUIT ; COMP U 0 W !!,"Compare : " R %N Q:%N="" D RED1^%L1ED(%N) I '$D(^S000($P)) W !,%N," ... Routine not found",! G COMP S %ES=$O(^S000($P,99999),-1) M ^UTILITY($J,1,%N)=^S000($P) W " To : " R %DN Q:%DN="" S:%DN="" %DN=%N I %N=%DN W *7," ... same routine" G COMP D RED1^%L1ED(%DN) I '$D(^S000($P)) W !,%N," ... Routine not found",! G COMP S %ED=$O(^S000($P,99999),-1) M ^UTILITY($J,2,%DN)=^S000($P) NOE ; S %DEV=$P U %DEV ;;W !!,"REPORT AT: ",%TIM1," ",%DAT1 W !!,"= STATUS = === LINES FROM ",%N," ===",?%WH+14,"=== LINES FROM ",%DN," ===",! S (%Q,%LCT,%TTL,%TAD,%TSM,%TMD,%TDL)=0,%D=1 F %S=1:1:%ES S %DD=%D D RATE,FRMT Q:%Q Q:%Q G:%D>%ED STA S %DD=%D,%D=%ED+1 D DLT Q:%Q STA U %DEV W !!,"STATISTICS: ",$S(%TSM:%TSM,1:"Zero"),?16," LINE",$S(%TSM'=1:"S ARE",1:" IS")," THE SAME" W !?12,$S(%TMD:%TMD,1:"Zero"),?16," LINE",$S(%TMD'=1:"S",1:"")," MODIFIED IN SOURCE ROUTINE" W !?12,$S(%TAD:%TAD,1:"Zero"),?16," LINE",$S(%TAD'=1:"S",1:"")," ADDED TO SOURCE ROUTINE" W !?12,$S(%TDL:%TDL,1:"Zero"),?16," LINE",$S(%TDL'=1:"S",1:"")," DELETED FROM SOURCE ROUTINE",! K ^UTILITY($J,1),^(2) Q ; RATE S %X=^UTILITY($J,1,%N,%S) I %D>%ED S %P=0 Q D LRT Q:%P>%SP K %T S %TP=0 F %=2:1:$L(%X," ") S %LX=$P(%X," ",%) D:(%LX'="") RAT1 RAT0 I %TP>2 X "F %=1:1:%TP S %P=%P+(%Y[%T(%))" S %P=%P/%TP Q:%P>%SP!(%D=%ED)!(%D=(%DD+7)) S %D=%D+1 D LRT Q:%P>%SP G RAT0 RAT1 I %LX'="" S %TP=%TP+1,%T(%TP)=" "_%LX Q:%T(%TP)'["," S %T=%T(%TP),%TP=%TP-1 F %I=1:1:$L(%T,",") S %TP=%TP+1,%T(%TP)=$P(%T,",",%I) Q LRT S %Y=^UTILITY($J,2,%DN,%D) I %X=%Y S %P=2 QUIT S %LX=$P(%X," ",1),%LY=$P(%Y," ",1) S %P=(%LX'="")&(%LY'="")&(%LX=%LY) Q FRMT G:%P>%SP FMT1 S %Y="" D DSP S %D=%DD Q FMT1 G:%D=%DD FMT2 S %T=%X,%TY=%Y D DLT S %X=%T,%Y=%TY FMT2 D DSP S %D=%D+1 Q DLT S %X="" F %DD=%DD:1:%D-1 S %Y=^UTILITY($J,2,%DN,%DD) D DSP Q:%Q Q DSP S %V=$S(%X="":"%TDL",%Y="":"%TAD",%P=2:"%TSM",1:"%TMD") S @%V=@%V+1,%Q=0,%TTL=%TTL+1 Q:(%LL="B"&(%P=2))!(%LL="S") U %DEV W !,"[",$S(%X="":"DELETED ",%Y="":" ADDED ",%P=2:" SAME ",1:"MODIFIED"),"]",$E(%X,1,%WH+2),?%WH+12," <> ",$E(%Y,1,%WH+2) D PSS Q:%Q S %LX=$L(%X),%LY=$L(%Y),%LM=$S(%LX>%LY:%LX,1:%LY) F %=%WH+3:%WH:%LM D .W !,?12,$E(%X,%,%+%WH-1),?%WH+12," <> ",$E(%Y,%,%+%WH-1) D PSS Q:%Q Q PSS Q:%SCR="N"!(%SCR="n") S %LCT=%LCT+1 Q:%LCT<%LPP PSS1 U 0 R !,"<>",%Q#1 I %Q="?" W !,"Enter to display next page",!," ^ to quit the process" G PSS1 I %Q="^"!(%Q="") S %LCT=1,%Q=(%Q="^") Q %L1RCNV %L1RCNV ;GT.M %RCE utility - change every occurrence of a string in one or more routines [ 07.02.06 09:07 ] [ 22.01.06 15:32 ] [ 18.01.06 18:24 ] ;invoke ^%RCE to get interaction ;invoke CALL^%RCE with %ZF - string to find, %ZN - new string, %ZR - routine array or name, ; %ZD an optional device to receive a trail ; n cnt1,cnt2,cnt3,fnd,h,i,o,out,outd,r,tf,x,xn,%ZC,%ZD,%ZF,%ZN,%ZR i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RCE" u $p:(ctrap=$c(3):exc="zg "_$zl_":LOOP^%RCE") d init,MAIN u $p:(ctrap="":exc="") q CALL i '$l($g(%ZF)) q n %ZC,cnt1,cnt2,cnt3,fnd,h,i,o,out,outd,r,tf,x,xn n:'$d(%ZD) %ZD s %ZC=1,%ZD=$g(%ZD),%ZN=$g(%ZN),(cnt1,cnt2,cnt3,out)=0,outd=$l(%ZD),tf=$j_"rce.tmp" s:'outd %ZD=$p i $d(%ZR)<10 d CALL^%RSEL d work q init s %ZC=1,(cnt1,cnt2,cnt3)=0,out=1,tf=$j_"rce.tmp" w !,"Routine Change Every occurrence",! q MAIN s %ZR="" d CALL^%RSEL S %NR=0 i %ZR=0 w !,"No routines selected" q S %ZF(1)="O 0:(0::::%OPT)",%ZN(1)="U $P:(NOECHO:NOWRAP)" S %ZF(2)="O 0:(::::%OPT)",%ZN(2)="U $P:(NOECHO:NOWRAP)" S %ZF(3)="U 0:(0::::%OPT)",%ZN(3)="U $P:(NOECHO:NOWRAP)" S %ZF(4)="U 0:(::::%OPT)",%ZN(4)="U $P:(NOECHO:NOWRAP)" S %ZF(5)="O 0:(::::1)",%ZN(5)="U $P:(NOECHO:NOWRAP)" S %ZF(6)="U 0:(::::1)",%ZN(6)="U $P:(NOECHO:NOWRAP)" S %ZF(7)="O 0:(0::::1)",%ZN(7)="U $P:(NOECHO:NOWRAP)" S %ZF(8)="U 0:(0::::1)",%ZN(8)="U $P:(NOECHO:NOWRAP)" ; S %ZF(9)="O 0:(:::::%OPT)",%ZN(9)="U $P:(ECHO:WRAP)" S %ZF(10)="O 0:(0:::::%OPT)",%ZN(10)="U $P:(ECHO:WRAP)" S %ZF(11)="O 0:(80:::::%OPT)",%ZN(11)="U $P:(ECHO:WRAP)" S %ZF(12)="U 0:(:::::%OPT)",%ZN(12)="U $P:(ECHO:WRAP)" S %ZF(13)="U 0:(0:::::%OPT)",%ZN(13)="U $P:(ECHO:WRAP)" S %ZF(14)="U 0:(80:::::%OPT)",%ZN(14)="U $P:(ECHO:WRAP)" S %ZF(15)="O 0:(:::::1)",%ZN(15)="U $P:(ECHO:WRAP)" S %ZF(16)="O 0:(0:::::1)",%ZN(16)="U $P:(ECHO:WRAP)" S %ZF(17)="O 0:(80:::::1)",%ZN(17)="U $P:(ECHO:WRAP)" S %ZF(18)="U 0:(:::::1)",%ZN(18)="U $P:(ECHO:WRAP)" S %ZF(19)="U 0:(0:::::1)",%ZN(19)="U $P:(ECHO:WRAP)" S %ZF(20)="U 0:(80:::::1)",%ZN(20)="U $P:(ECHO:WRAP)" ; ;;S %ZF(21)="$ZT=""",%ZN(21)="$ZT=""ZG ""_$ZL_"":" S %ZF(21)="$ZT=""",%ZN(21)="$ZT=""" S %ZF(22)=" B 0",%ZN(22)=" U $P:(NOCENABLE)" S %ZF(23)=" B 1",%ZN(23)=" U $P:(CENABLE:CTRAP=$C(3))" S %ZF(24)=" ZQ",%ZN(24)=" Q" S %ZF(25)="$P(ZU(0),"","")",%ZN(25)="$$^%L1UCI" S %ZF(26)="$P(ZU(0),"","",1)",%ZN(26)="$$^%L1UCI" S %ZF(27)="$ZU(0)",%ZN(27)="$$^%L1UCI" S %ZF(28)="$ZR",%ZN(28)="$R" S %ZF(29)="$ZD($H,3)",%ZN(29)="$$^%L1DC($H,1)" S %ZF(30)="$ZD(P1DZ,3)",%ZN(30)="$$^%L1DC(P1DZ,1)" S %ZF(31)="$ZD(DT,3)",%ZN(31)="$$^%L1DC(DT,1)" S %ZF(32)="ZU 0",%ZN(32)="U $P" S %ZF(33)="[""MER""]",%ZN(33)="[^UCI(""MGG"")]" S %ZF(34)=" B ",%ZN(34)=" " S %ZF(35)=".B ",%ZN(35)="." S %ZF(36)="$ZO(",%ZN(36)="$Q(" S %ZF(37)="$ZE",%ZN(37)="$P($ZS,"","",3)" S %ZF(38)="^[UCI]LKH",%ZN(38)="^LKH" S %ZF(39)="'USTR",%ZN(39)="USTR=0!(USTR=$P)" S %ZF(40)="$ZOS(",%ZN(40)="$$^%L1ZOS(" S %ZF(41)="$ZU(0)",%ZN(41)="$$^%L1UCI" S %ZF(42)="$ZCRC",%ZN(42)="$$^%L1ZCRC" S %ZF(43)="%OPT=65",%ZN(43)="%TYPCRT[""VT""" S %ZF(44)="$ZU(""MLY"")",%ZN(44)="$$^%L1ZU(""MLY"")" S %ZF(45)=".B 0",%ZN(45)=".U $P:(NOCENABLE)" S %ZF(46)=".B 1",%ZN(46)=".U $P:(CENABLE:CTRAP=$C(3))" S %ZF(47)="",%ZN(47)="" S %ZF(48)="""INRPT""",%ZN(48)="""CTRAP""" S %ZF(49)="^THZ1($P",%ZN(49)="^THZ1(%L3MYDVN" S %ZF(50)="^THZ($P",%ZN(50)="^THZ(%L3MYDVN" S %ZF(51)="^DEV($P",%ZN(51)="^DEV(%L3MYDVN" S %ZF(52)=" I USTR ",%ZN(52)=" I '$$^%L1DISP(USTR) " S %ZF(53)=" I 'USTR ",%ZN(53)=" I $$^%L1DISP(USTR) " S %ZF(54)="[""MLY""]",%ZN(54)="^[^UCI(""MLG"")]" S %ZF(55)="$ZCR",%ZN(55)="$$^%L1ZCRC" S %ZF(56)="$ZH",%ZN(56)="$$^%L1ZH" ; CYC ;w !,$s(%ZC:"Old",1:"Find")," string: " r %ZF ;i '$l(%ZF) w !,"No search string to find - no search performed",! q ;i %ZF?.E1C.E w !,"The find string contains control characters" ;i %ZC r !,"New string: ",%ZN S %NR=%NR+1 I '$D(%ZF(%NR)) G END S %ZF=%ZF(%NR),%ZN=%ZN(%NR) i %ZC,%ZN?.E1C.E w !,"The New string contains control characters" w !,$s(%ZC:"Replace",1:"Find")," all occurrences of:",!,">",%ZF,"<",! i %ZC w "With: ",!,">",%ZN,"<",! S x="Y" ;i %ZC f r !,"Show changed lines ?: ",x,! q:$e(x)'="?" d help i %ZC,$l(x) q:"\QUIT"[("\"_$tr(x,"quit","QUIT")) s outd=$e("NO",1,$l(x))'=$e($tr(x,"no","NO"),1,2) e s outd=1 i outd f d q:$l(%ZD) . S %ZD="" ;r !,"Output device: : ",%ZD,! . i '$l(%ZD) s %ZD=$p q . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for output" . . w !,"If you wish to exit enter a carat (^)",! . i $zparse(%ZD)="" w " no such device" s %ZD="" q . o %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" w ! d work G CYC END q work s %ZR="",r=$zsearch("__") i outd,%ZD'=$p u %ZD w $zd($h,"DD-MON-YEAR 24:60:SS"),! i w "Routine ",$s(%ZC:"Change",1:"Search for")," Every occurrence of:",!,">",%ZF,"<",! i %ZC w "To:",!,">",%ZN,"<",! i '%ZC d . s gtmvt=$$GTMVT^%GSE . i gtmvt s sx=$c(27)_"[7m"_%ZF_$c(27)_"[0m" . e s sx=%ZF,flen=$l(%ZF),tics=$tr($j("",flen)," ","^") f s %ZR=$o(%ZR(%ZR)) q:'$l(%ZR) d scan q:'out u %ZD w !!,"Total of ",cnt1," routine",$s(cnt1=1:"",1:"s")," parsed.",! w cnt2," occurrence",$s(cnt2=1:" ",1:"s "),$s(%ZC:"changed",1:"found")," in ",cnt3," routine",$s(cnt3=1:".",1:"s."),! c %ZD q scan s r=%ZR(%ZR)_$tr($e(%ZR),"%","_")_$e(%ZR,2,9999)_".m",o=$zsearch(r),fnd=0 u $p i out,%ZD'=$p!'outd w:$x>70 ! w %ZR,?$x\10+1*10 i outd u %ZD w !!,r o:%ZC tf:(newversion:exception="s fnd=0 g reof") o o:(readonly:record=2048:rewind:exception="g rnoopen") u o:exception="g reof" s cnt1=cnt1+1 s cntr=0,yes="" f u o r x s h=$l(x,%ZF) d .s cntr=cntr+1 . i h=1 d:%ZC q . . u tf w x,! . s fnd=fnd+h-1 . i %ZC d q . . i outd u %ZD w !,$c(27),"[1m",%ZR,"+",cntr,">>",$c(27),"[0m" . . s xn="" . . f i=1:1:h-1 d . . .d:yes'="." ask(i) . . .i 'yes s xn=xn_$p(x,%ZF,i)_%ZF q . . .s xn=xn_$p(x,%ZF,i)_%ZN . .s xn=xn_$p(x,%ZF,h) . . i outd w !,"Now: ",xn . . u tf w xn,! q . u %ZD w ! s rl="" . f i=1:1:h-1 s p=$tr($p(x,%ZF,i),$c(9)," ") w p,sx i 'gtmvt s rl=rl_$j(tics,$l(p)+flen) . w $p(x,%ZF,h) . i 'gtmvt w !,rl q reof i fnd s cnt2=cnt2+fnd,cnt3=cnt3+1 i %ZC c:$zver'["VMS" o:(DELETE) c tf:(RENAME=r) e c o i %ZC c tf:(DELETE) ; warning - fall-through rnoopen i $zs'["EOF" w !,$p($zs,",",2,999),! q help i "Dd"[$e(x,2),$l(%x)=2 d cur q i %ZC w !,"Answer No to this prompt if you do not wish a trail of the changes" w !,"Enter Q to exit",! w !,"?D for the current routine selection" q cur w ! s r="" f s r=$o(%ZR(r)) q:'$l(r) w:$x>70 ! w r,?$x\10+1*10 q ERR i $d(tf) c tf:(DELETE) i $d(o) c o i $d(%ZD),%ZD'=$p c %ZD u $p w !,$p($ZS,",",2,999),! u $p:(ctrap="":exception="") s $ec="" q LOOP i $d(tf) c tf:delete i $d(o) c o i $d(%ZD),%ZD'=$p c %ZD d MAIN u $p:(ctrap="":exception="") q ask(i) ; w !,xn_$p(x,%ZF,i)_$c(27)_"[7m"_%ZF_$c(27)_"[0m"_$p(x,%ZF,i+1,255) s yes=1 q f r !,"Change (y,n,.) : ",yes i $l(yes),"YyNn."[$e(yes) q i yes'="." s yes="Yy"[$E(yes) q %L1RCPRG %L1RCPRG ; [ 01/04/2000 3:33 PM ] [ K ^L1TRPRG D ^%L2GTR1 S N="" F S N=$O(^L1TRPRG(N)) Q:N="" D .X "X ""ZR F I=1:1 Q:'$D(^L1TRPRG(N,I)) ZI ^(I)"" ZS @N" Q %L1RCV %L1RCV(USERPHON,USERPORT,MDXON,UCI,PROG,MDLKH,GLOB,FL,PROGRCV) ; [ 14.05.07 21:39 ] [ 13.05.07 11:59 ] [ 02.01.07 03:52 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,USERPHONE,USERPORT,MDXON,UCI,PROG,MDLKH,GLOB,PROGRCV,%L1MDOK,%L1RCV,FL) D ^%L1C S ZT=$ZT,$ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1RCV" ; K %L1MDOK I $$FTP D .S ^L1RCV("FTP")=1,%L2MODEM("FTP")="" ; K %L2MODEM("OK") I $D(%L1RCV) S %L2MODEM("NODISP")="" S %L2MODEM("ADDR")=USERPHON S %L2MODEM("MDPORT")=USERPORT S %L2MODEM("NAMETO")=MDLKH S %L2MODEM("GLOB")=$S($G(GLOB)="":"^L1RCV",1:GLOB) S %L2MODEM("FL")=$S($G(FL)="":$P($E(%L2MODEM("GLOB"),2,9),"("),1:FL) S %L2MODEM("PROG")=$S($G(PROG)="":"%L2GTR1",1:PROG) S %L2MODEM("PROGRCV")=$S($G(PROGRCV)="":"%L2GTR1",$G(PROGRCV)="-":"",1:PROGRCV) S %L2MODEM("XON")=MDXON S %L2MODEM("UCI")=$S($G(UCI)="":"MGR",1:UCI) S %L2MODEM("NOCLOSE")="" ; D ^%L2MODEM ; S %L1MDOK=$G(%L2MODEM("OK")) I '$G(%L1MDOK) G END ; I $$DISPMSG D .S %L2G1("DISP")="" .S %L2G1("DISP","Y")=20 .S %L2G1("DISP","X")=6 .S %L2G1("DISP","L")=60 ; I USERPHON[".",'$$FTP S USERPORT="SCK$"_$J ; I '$$FTP,$L($G(%L2MODEM("PROGRCV"))) D @("^"_%L2MODEM("PROGRCV")) I $G(^L2G1($J,"OK")) S %L1MDOK=1 ; C USERPORT ; END K ^L1RCV L U $P:(CENABLE) Q ; ER D SVER^%L1X G END ; DISPMSG(STAM) ; I '$D(%L1RCV) Q 1 Q 0 ; FTP(STAM) ; I USERPHON[".",$$^%L1ISFTP("L1RCV") Q 1 Q 0 %L1RCV1 %L1RCV1(GLOB) ; [ 04.08.00 7:08 PM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,GLOB) D ^%L1C,^%L1TS K ^UTILITY($J) S ^UTILITY($J,GLOB)="" S USERPORT=0,USERGLOB="" K ^GTR000($P) S $ZS="",%L1RCV="" D ^%L2GTR Q %L1RD %RD ;DJM;DISPLAY ROUTINE DIRECTORY; [ 12/31/87 10:36 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 W #,?20,"ROUTINE DIRECTORY " D ^%D W !,?25,"OF ",$$^%L1ZU(0),?38 D ^%T INT D ZE K %REF INT1 ; S (%RNUM,%PCT)=0,%NAM="" I $D(%REF) K ^UTILITY("%RD") S ^UTILITY("%RD")=$H %GO S %NAM=$O(^ (%NAM)) G:%NAM="" TOTAL S %PCT=%PCT+1 I '$D(%REF) W:'(%PCT-1#8) ! R:($Y#24)=21 !,"PRESS ",YES,! W ?(%PCT-1)#8*10,%NAM I $D(%REF) S ^UTILITY("%RD",%NAM)="" W:'$D(%ROU)&(%PCT#5=0) "." S %RNUM=%RNUM+1 G %GO TOTAL G:$D(%ROU) EXIT W:'$D(%REF) !,?5,%PCT," Routine",$S(%PCT=1:".",1:"s.") W:$D(%REF) " ",%PCT," Routine",$S(%PCT=1:".",1:"s.") EXIT ; K %I,%REF,%NAM,%PT,%BLK,%PCT,%ST,%,%A S $ZT=%ZE("%RD") K %ZE("%RD") Q ERROR U 0 I $P($ZS,">")="31,FUNCT SETCHAR ;I $F(%TY,"MENU") G WALK S %=$C(%C),$E(%DIN,(%XX-%X+1))=% W % G:SRL 8 21 S %XX=%XX+1 S:%XX>LX %XX=LX G WALK 8 S %XX=%XX-1 S:%XX<%X %XX=%X G WALK VTF D TM R *B:0 D TM R *E:0 G:B=54 DOWN G:B=53 UP S %TO="PF"_$S(B=55:6,B=56:5,B=57:8,B=48:9,B=49:10,1:"ERROR") G @%TO; VTF1 D TM R *B:0 D TM R *E:0 S %TO="PF"_$S(B=51:3,B=55:6,B=56:5,B=57:8,B=48:9,B=49:10,1:"ERROR") G @%TO; ; B=51 IS F3 BUT FOR VT100 IS NOW F10 . GIORA 31/10/90 FUNCT G BACK:%C=8,ENT:%C=13,TAB:%C=9,PF PF R *A:0 E S %TO="PF3" G PF3 I %C=0 G PGUP:A=73,PGDOWN:A=81,SELECT:A=82,PFERROR R *B:0 E G PF3 I B=68 G 8 I B=67 G 21 I B=65 G ARRUP I B=66 G ARRDOWN I B=50,CRT="VT" G VTF1 I B=49,CRT="VT" G VTF I B=54,CRT="VT" R *E:0 G PGDOWN I B=52,CRT="VT" R *E:0 G SELECT I B=53,CRT="VT" R *E:0 G PGUP I B<80!(B>89) G PFERROR S %TO="PF"_(B-79) S:%TO="PF3" %TO="PF10" G @%TO UP S %PGUP=1 G ENT DOWN S %PGDN=1 G ENT TAB S %TO="PF2" G PF2 ENT S %TO="ENT" Q BACK F %JJ=1:1:%FL Q:$E(%DIN,%JJ)'=" " I %XX-%X+1<%JJ G 21 I %XX-%X+1=%JJ W " " S %DIN=$J($E(%DIN,%XX-%X+2,$L(%DIN)),%FL),%XX=%XX+1 G WALK BACK1 S %DIN=$J("",%JJ)_$E(%DIN,%JJ+1,%XX-%X)_$E(%DIN,(%XX-%X+2),$L(%DIN)) W @%AXY1,%DIN G WALK PF1 W *27,"[24;1H",$J(^MSG(+$P(%HLP,"^",1)),30) G WALK PF4 S %PF="PF4",%TO="PF4" Q PF2 PF3 Q PF8 S %PF="PF8" G PASS Q PF9 S %PF="PF9" G PASS Q PF10 S %PF="PF10" G PASS Q PF7 S %TO="PF5" PF5 PF6 G:NOPF PFERROR D ^RDF1 S NOPF=0 Q PFRT G 21 PFLF G 8 PGUP S %PGUP=1 G ENT SELECT S %PF="SELECT" G ENT PGDOWN S %PGDN=1 G ENT PFERROR W *7 G WALK ARRUP S %TO="ARRUP" Q ARRDOWN S %TO="ARRDOWN" Q PASS I $TR(%DIN," ","")="" S %DIN=%DOUT I %DIN="" S %DIN=0 G ENT JUMP F %JJ=1:1:$L(%DIN) I $E(%DIN,%JJ)'=" " Q S %XX=%X+%JJ-2 G WALK PRINT D ^PRTSC G WALK PRINT1 S %MSG="WAIT..." D MSG^SD D ^PRTSC1 S %MSG="FINISHED" D MSG^SD G WALK VT105 S %TO="PF5" G PF5 VT106 S %TO="PF6" G PF6 VT107 G PGUP VT108 G PGDOWN TM F UU=1:1:1100 Q %L1READ %L1READ(%PORT,%ESC) ; [ 18.05.04 09:38 ] [ 19.09.00 3:31 PM ] [ 07/21/97 8:54 AM ] D ^%L1C X %chista I '$D(%PORT) S %PORT=$P S %SAY=" TEST "_$$FUNC^%UCASE(%PORT) I $G(%ESC) S %SAY=%SAY_" ( ESCAPE MODE ) " X %XMSGV W !! N A,A1,ZB I '$D(%PORT) S %PORT=$P RE O:%PORT'=$P %PORT I '$D(%ZB) U %PORT I $G(%ESC) U %PORT:(NOWRAP:NOECHO:ESC) I '$G(%ESC) U %PORT:(NOWRAP:NOECHO) F R *A:0 Q:'$T ;---CLEAR PORT S A1="" L F I=1:1 R *A:1 Q:'$T Q:A=13 S A1=A1_$C(A) I I=1 S ZB=$ZB G:A=13 EXIT I '$L(A1) G L L1 U 0 W !,A1 W !,"$ZB=" F I=1:1:$L(ZB) W $A(ZB,I)," " W !,"<16>:" F I=1:1:$L(A1) W $$^%L1ZH($A($E(A1,I)))," " W !,"<10>:" F I=1:1:$L(A1) W $A($E(A1,I))," " W !! G RE EXIT ; I %PORT'=$P C %PORT Q %L1READY %L1READY(%PORT) ; [ 16.06.10 09:53 ] [ I $G(%PORT)="" Q "?" Q 250 Q $&libserial.getdsr(%PORT) %L1REF %L1REF(GLB) ; [ 06.07.01 1:35 PM ] [ K %L1REF N GLB1,N1,N2,N3 S N1="" F S N1=$O(@GLB@(N1)) Q:N1="" D .I $O(@GLB@(N1,""))="" S %L1REF("^"_N1)="" .S N2="" F S GLB1="^"_N1_"(""" S N2=$O(@GLB@(N1,N2)) Q:N2="" D S GLB1=$E(GLB1,1,$L(GLB1)-2)_")",%L1REF(GLB1)="" ..S N3="" F S N3=$O(@GLB@(N1,N2,N3)) Q:N3="" D ...I $D(^(N3,2)) S GLB1=GLB1_^(2)_""",""" Q %L1REN %L1REN ; RENAME ROUTINES [ 28.04.00 5:25 PM ] [ 11/12/91 11:49 AM ] K ^UTILITY($J) D ^%RSEL Z W !!,"FROM:" K CIST,%S D ^%ZMSL Q:%S="" S %FROM=%S W !,"TO:" K %S D ^%ZMSL G:%S="" Z S %TO=%S W !! S N="" F S N=$O(^UTILITY($J,N)) Q:N="" S N1=$P(N,%FROM,1)_%TO_$P(N,%FROM,2,10) X "ZL @N ZS @N1" U 0 W N," -RENAME TO: ",N1,! Q %L1REP %L1REP ;-- ARHEON DOHOT [ 22.05.03 16:21 ] [ 25.07.01 5:56 PM ] [ 30.04.01 6:58 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) ZD K D ^%L1C X %chista S %SAY=" zeg""ec oeikx` " X %XMSGV S %YY=3 D ^%L1RNG Q:'$D(%L1D1) S MAC="^SPOOL" S %L1("BE",1)=6,%L1("BE",2)=8,%L1("EU")=2 S %L1("US",1)=1 S %L1("US",2)="$P(%NXS,""\"")'<%L1D1&($P(%NXS,""\"")'>%L1D2)" S %L1("T1",1)=" fkxn my | fkxn 'qn " S %L1("T1",2)=" dxrd | g""ec xe`z | jix`z " S %L1("TXT1",1)="$$NAME^%L1MRK(%NXN)<>\/%NXN" S %L1("TXT1",2)="$P(%NXS,""\"",5)<>,H\/$P(%NXS,""\"",3)<>,H\/$$^%L1DC($P(%NXS,""\""),1)" S %L1("T2")="D T2^%L1REP" D ^%L1NU G ZD Q Z(GLB) ; S %GETIN=1 Z1 X %chista D ^%L1TS S MRK=$$^%L1IND(%L1("MAC"),1) Q:MRK="" Q:$G(INDEX)="" I '$D(@GLB@(MRK,INDEX)) S %SAY=" ! lhea " X %XMSGV(1) Q S %SAY=" "_$P(@GLB@(MRK,INDEX),"\",3)_" " X %XMSGV W !! F I=1:1 Q:'$D(@GLB@(MRK,INDEX,"KOT",I)) D .I $G(%XMSG(0))<0 W $TR(^(I),TS0,TSS),! Q .W ^(I),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! Z11 ;;S %GETIN=1,%GET=" 0 - lhal , 4 - xeciyl oikdl, 3 - zqtcnl , 2- hwqicl , 1 - jqnl g""ec bivdl " D N^%L1GET Q:%S=""!(%TO="END") S %GET="0- lhal, 5 - xeciyl oikdl, 4 - uaew, 3 - zqtcn, 2 - hwqic, 1 - jqn " D N^%L1GET Q:%S=""!(%TO="END") S %GETIN="" ; I %S=0 D IS1^%L1GET G:'YES Z11 D Q .K @GLB@(MRK,INDEX) I %S=1 D G Z1 .N MDPS,MXLEN,%L1OUT,A,%N,I,PRT .S MDPS=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPS S MDPS=5 .D DEFMDP^%L1OUT(MDPS) .K ^TMPS111($J) S MXLEN=0 .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..S I=I+1 ..S ^TMPS111($J,I)=$$CL^%L1LPT(A) ..I $L(^TMPS111($J,I))>MXLEN S MXLEN=$L(^(I)) .X %chista .I MXLEN>80 D ..I %TYPCRT["VT5" S %S2V("SMALL")="" Q ..S %S2V("HBR")="" .D ^%S2VIEW K ^TMPS111($J) ; Z23 I %S=3!(%S=2) D G Z1 .S OTB=%S .N MDPSO,%L1OUT,A,%N,I,PRT .S MDPSO=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPSO S MDPSO=5 .D DEFMDP^%L1OUT(MDPSO) .K MDPO S MAC1="%L1OUT(""MDP"")",MAC2="MDPO" D ^%S1GC1 .K %L1OUT .I OTB=3 D ^%L1LPT Q:$G(%EROP) .I OTB=2 D KONAN Q:DEV=""&'$D(FILEDOS) D Q:FL="" ..S FL="" ZK ..S %GET=": uaewd my++20,60,HH,,R#++30,E,I" D ^%L1GET S:%TO="END" %S="" S FL=%S Q:FL="" ..S FILE=$S('$D(FILEDOS):DEV_":\",1:"")_$TR(FL," ","") ..I $$^%L1ZOS(10,FILE)>0 S %GET=" - xey`l . miiw xak dfd uaew" D N^%L1GET S:%TO="F9" %S=99 I %S'=99 S FL="" Q ..S %GET="2 - HP ,1 - OKI e` CITIZEN/90-240 ly hnxeta uaew xenyl " ..D N^%L1GET I %S=""!(%TO="END") G ZK ..S %MDPSUG=$S(%S=1:5,1:7) D DEFMDP^%L1OUT(%MDPSUG) ..C FILE:DELETE O FILE:(WRITE:NEWVERSION):2 E S FL="",%SAY=" ! qetz 54 hxet " X %XMSGV(1) Q ..U FILE .K ^TMPS111($J) .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..I %MDPSUG'=MDPSO S %N="" F S %N=$O(MDPO(%N)) Q:%N="" I %N'="GWPC",A[MDPO(%N) D ...I $D(%L1OUT("MDP",%N)) S A=$$RPL^%L1FRM(A,MDPO(%N),%L1OUT("MDP",%N)) ..W A,! .I OTB=3 D CLOSE^%L1LPT .I OTB=2 W # C FILE ZSY "unix2dos "_FILE .K ^TMPS111($J) ; I %S=4 D G:$D(FILEDOS) Z23 G Z1 .N M,MAC,%L2MN,%I K FILEDOS .S M(1)=" d ` i v i" .S M(2)="DOS uaew" .S M(3)="WINDOWS uaew" .S M(4)="POWER TERM" .S %L2MN("NOCLB")="" .S MAC="M" D ^%L2MENU Q:%I=1 .I %I=2 S FILEDOS="",%S=2 Q .K ^TMPS111($J) S MXLEN=0 .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..S A=$$CL^%L1LPT(A) ..S A=$$CLST^%L1FRM(A) ..S I=I+1 S A=$J(A,79) ..S ^TMPS111($J,I)=$S(%I=3:$$INVHBW^%L1FRM(A),1:A) ZK4 .S %GET=": uaewd my++20,60,HH,,R#++30,E,I" D ^%L1GET S:%TO="END" %S="" S FL=%S Q:FL="" .S FILE=$TR(FL," ","") .I $$^%L1ZOS(10,FILE)>0 S %GET=" - xy`l . miiw xak dfd uaew" D N^%L1GET S:%TO="F9" %S=99 I %S'=99 S FL="" Q .C FILE O FILE:(WRITE:NEWVERSION):2 E S %SAY=" ! yeniya"_FILE_" uaew " X %XMSGV(1) Q .U FILE F I=1:1 Q:'$D(^TMPS111($J,I)) D ..I %XMSG(0)<0 W $TR(^(I),TS0,TSS),! Q ..I %XMSG(0)'>1 W $TR(^(I),TS1,TSS),! Q .C FILE ; I %S=5 D G Z1 ZM .S %GET=": fkxnl xeciyl jnqn oikdl ++13,60,HH,,R#++4,E,I++++++^MRKZ\\\\VP" D ^%L1GET Q:%S=""!(%TO="END") .S MRKN=%S I MRKN=MRK S %SAY=" ! jnvrl xcyl mrh oi` " X %XMSGV(1) G ZM .S MAC1=GLB_"(MRK,INDEX)",MAC2="^SPOOLSND(MRKN,MRK,INDEX)" .D ^%S1GC1 .S %GET=" . dnlyed dlert " D N^%L1GET Q DO ; I $$^%L1IND(%L1("MAC"),1) D Z^%L1REP("^SPOOL") Q S %L1OLD("DO")="Q" Q T2 ; N A S A=" "_$$NAME^%L1MRK(INDEX)_" "_INDEX_" " I $G(INDEX) S %SAY=A_" ++2,"_(80-(80-$L(A)\2))_",HH,I" X %XMSG S %L1("DO")="D DO^%L1REP" Q KONAN ; S DEV="" Q:$D(FILEDOS) X %chista S ERR=0 S %GET=": opekd my++3,60,HH,,R#A++1,E,I++AB++ - z`vl , - hwqic okez bivdl , B e` A laewn opew my " D ^%L1GET S DEV=%S I $G(%TO)="F7" S %X=DEV_":",%L1OS=345 D O13M^%L1OS G KONAN S:$G(%TO)="END" DEV="" Q:DEV="" K1 S ERR=0 U 0 W ! S DER=$$^%L1ZOS(9,DEV) I DER<0 D MSGER G KONAN Q MSGER ; D X %XMSGN(1) .I ",15,20,257,"[(","_DER_",") S %SAY=" oekp `l opek my " Q .I ",19,256,"[(","_DER_",") S %SAY=" ! hwqicdn dpbd zwacn cixedl jixv " Q .S %SAY=" oken `l opek " X %XMSGN(1) Q %L1REPR %L1REPR ; [ 23.08.00 1:50 PM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) ZD K D ^%L1C X %chista S %SAY=" ehlwpy zeg""ec zniyx " X %XMSGV K ^VRM($J) S MRKTO=$$^%L1MRK S MRKFROM="" F S MRKFROM=$O(^SPOOLSND(MRKTO,MRKFROM)) Q:MRKFROM="" D .S MAC2="^VRM($J,MRKFROM)",MAC1="^SPOOLSND(MRKTO,MRKFROM)" D ^%S1GC1 ; S MAC="^VRM($J)" S %L1("BE",2)=6,%L1("BE",3)=8,%L1("EU")=3 S %L1("T1",2)=" fkxn my | fkxn 'qn " S %L1("T1",1)=" fkxn my | fkxn 'qn " S %L1("T1",3)=" dxrd | g""ec xe`z | jix`z " S %L1("TXT1",2)="$$NAME^%L1MRK(%NXN)<>\/%NXN" S %L1("TXT1",3)="$P(%NXS,""\"",5)\/$P(%NXS,""\"",3)\/$$^%L1DC($P(%NXS,""\""),1)" S %L1("T2")="D T2^%L1REPR" D ^%L1NU K ^VRM($J) Q Z(GLB) ; Z1 X %chista S MRK=$$^%L1IND(%L1("MAC"),2) Q:MRK="" Q:$G(INDEX)="" I '$D(@GLB@(MRK,INDEX)) S %SAY=" ! lhea " X %XMSGV(1) Q S %SAY=" "_$P(@GLB@(MRK,INDEX),"\",3)_" " X %XMSGV W !! F I=1:1 Q:'$D(@GLB@(MRK,INDEX,"KOT",I)) W ^(I),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! Z11 S %GETIN=1,%GET=" 0 - lhal , 3 - zqtcnl , 2- hwqicl , 1 - jqnl g""ec bivdl " D N^%L1GET Q:%S=""!(%TO="END") ; I %S=0 D IS1^%L1GET G:'YES Z11 D Q .K @GLB@(MRK,INDEX) I %S=1 D G Z1 .N MDPS,MXLEN,%L1OUT,A,%N,I,PRT .S MDPS=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPS S MDPS=5 .D DEFMDP^%L1OUT(MDPS) .K ^TMPS111($J) S MXLEN=0 .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..S I=I+1 ..S ^TMPS111($J,I)=$$CL^%L1LPT(A) ..I $L(^TMPS111($J,I))>MXLEN S MXLEN=$L(^(I)) .X %chista .I MXLEN>80 D ..I %TYPCRT["VT5" S %S2V("SMALL")="" Q ..S %S2V("HBR")="" .D ^%S2VIEW K ^TMPS111($J) ; I %S=3!(%S=2) D G Z1 .S OTB=%S .N MDPSO,%L1OUT,A,%N,I,PRT .S MDPSO=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPSO S MDPSO=5 .D DEFMDP^%L1OUT(MDPSO) .K MDPO S MAC1="%L1OUT(""MDP"")",MAC2="MDPO" D ^%S1GC1 .K %L1OUT .I OTB=3 D ^%L1LPT Q:$G(%EROP) .I OTB=2 D KONAN Q:DEV="" D Q:FL="" ..S FL="" ZK ..S %GET=": uaewd my++20,60,HH,,R#++30,E,I" D ^%L1GET S:%TO="END" %S="" S FL=%S Q:FL="" ..S FILE=DEV_":\"_$TR(FL," ","") ..I $$^%L1ZOS(10,FILE)>0 S %GET=" - xey`l . miiw xak dfd uaew" D N^%L1GET S:%TO="F9" %S=99 I %S'=99 S FL="" Q ..S %GET="2 - HP ,1 - OKI e` CITIZEN/90-240 ly hnxeta uaew xenyl " ..D N^%L1GET I %S=""!(%TO="END") G ZK ..S %MDPSUG=$S(%S=1:5,1:7) D DEFMDP^%L1OUT(%MDPSUG) ..O 54:(FILE:"W"):2 E S %SAY=" ! qetz 54 hxet " X %XMSGV(1) Q ..U 54 .K ^TMPS111($J) .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..I %MDPSUG'=MDPSO S %N="" F S %N=$O(MDPO(%N)) Q:%N="" I %N'="GWPC",A[MDPO(%N) D ...I $D(%L1OUT("MDP",%N)) S A=$$RPL^%L1FRM(A,MDPO(%N),%L1OUT("MDP",%N)) ..W A,! .I OTB=3 D CLOSE^%L1LPT .I OTB=2 W # C 54 .K ^TMPS111($J) ; Q DO ; I $$^%L1IND(%L1("MAC"),2) D Z^%L1REPR("^VRM($J)") Q S %L1OLD("DO")="Q" Q T2 ; I '$G(INDEX) S %SAY=" : mi`ad mifkxndn ehlwpy zeg""ec ++2,60,HH,I" X %XMSG Q N A S A=" : "_$$NAME^%L1MRK(INDEX)_" "_INDEX_" fkxndn ehlwpy ze""ec zniyx" I $G(INDEX) S %SAY=A_" ++2,"_(80-(80-$L(A)\2))_",HH,I" X %XMSG S %L1("DO")="D DO^%L1REPR" Q KONAN ; X %chista S ERR=0 S %GET=": opekd my++3,60,HH,,R#A++1,E,I++AB++ - z`vl , - hwqic okez bivdl , B e` A laewn opew my " D ^%L1GET S DEV=%S I $G(%TO)="F7" S %X=DEV_":",%L1OS=345 D O13M^%L1OS G KONAN S:$G(%TO)="END" DEV="" Q:DEV="" K1 S ERR=0 U 0 W ! S DER=$$^%L1ZOS(9,DEV) I DER<0 D MSGER G KONAN Q MSGER ; D X %XMSGN(1) .I ",15,20,257,"[(","_DER_",") S %SAY=" oekp `l opek my " Q .I ",19,256,"[(","_DER_",") S %SAY=" ! hwqicdn dpbd zwacn cixedl jixv " Q .S %SAY=" oken `l opek " X %XMSGN(1) Q %L1REPS %L1REPS ; [ 23.08.00 1:50 PM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) ZD K D ^%L1C X %chista S %SAY=" xeciyl mipken zeg""ec zniyx " X %XMSGV K ^VRM($J) S MRKTO="" F S MRKTO=$O(^SPOOLSND(MRKTO)) Q:MRKTO="" D .S MRKFROM="" F S MRKFROM=$O(^SPOOLSND(MRKTO,MRKFROM)) Q:MRKFROM="" D ..S MAC2="^VRM($J,MRKTO)",MAC1="^SPOOLSND(MRKTO,MRKFROM)" D ^%S1GC1 ; S MAC="^VRM($J)" S %L1("BE",2)=6,%L1("BE",3)=8,%L1("EU")=3 S %L1("T1",2)=" fkxn my | fkxn 'qn " S %L1("T1",1)=" fkxn my | fkxn 'qn " S %L1("T1",3)=" dxrd | g""ec xe`z | jix`z " S %L1("TXT1",2)="$$NAME^%L1MRK(%NXN)<>\/%NXN" S %L1("TXT1",3)="$P(%NXS,""\"",5)\/$P(%NXS,""\"",3)\/$$^%L1DC($P(%NXS,""\""),1)" S %L1("T2")="D T2^%L1REPS" D ^%L1NU K ^VRM($J) Q Z(GLB) ; Z1 X %chista S MRK=$$^%L1IND(%L1("MAC"),2) Q:MRK="" Q:$G(INDEX)="" I '$D(@GLB@(MRK,INDEX)) S %SAY=" ! lhea " X %XMSGV(1) Q S %SAY=" "_$P(@GLB@(MRK,INDEX),"\",3)_" " X %XMSGV W !! F I=1:1 Q:'$D(@GLB@(MRK,INDEX,"KOT",I)) W ^(I),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! W $TR($J("",78)," ","."),! Z11 S %GETIN=1,%GET=" 0 - lhal , 3 - zqtcnl , 2- hwqicl , 1 - jqnl g""ec bivdl " D N^%L1GET Q:%S=""!(%TO="END") ; I %S=0 D IS1^%L1GET G:'YES Z11 D Q .K @GLB@(MRK,INDEX) I %S=1 D G Z1 .N MDPS,MXLEN,%L1OUT,A,%N,I,PRT .S MDPS=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPS S MDPS=5 .D DEFMDP^%L1OUT(MDPS) .K ^TMPS111($J) S MXLEN=0 .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..S I=I+1 ..S ^TMPS111($J,I)=$$CL^%L1LPT(A) ..I $L(^TMPS111($J,I))>MXLEN S MXLEN=$L(^(I)) .X %chista .I MXLEN>80 D ..I %TYPCRT["VT5" S %S2V("SMALL")="" Q ..S %S2V("HBR")="" .D ^%S2VIEW K ^TMPS111($J) ; I %S=3!(%S=2) D G Z1 .S OTB=%S .N MDPSO,%L1OUT,A,%N,I,PRT .S MDPSO=$P(@GLB@(MRK,INDEX),"\",4) I 'MDPSO S MDPSO=5 .D DEFMDP^%L1OUT(MDPSO) .K MDPO S MAC1="%L1OUT(""MDP"")",MAC2="MDPO" D ^%S1GC1 .K %L1OUT .I OTB=3 D ^%L1LPT Q:$G(%EROP) .I OTB=2 D KONAN Q:DEV="" D Q:FL="" ..S FL="" ZK ..S %GET=": uaewd my++20,60,HH,,R#++30,E,I" D ^%L1GET S:%TO="END" %S="" S FL=%S Q:FL="" ..S FILE=DEV_":\"_$TR(FL," ","") ..I $$^%L1ZOS(10,FILE)>0 S %GET=" - xey`l . miiw xak dfd uaew" D N^%L1GET S:%TO="F9" %S=99 I %S'=99 S FL="" Q ..S %GET="2 - HP ,1 - OKI e` CITIZEN/90-240 ly hnxeta uaew xenyl " ..D N^%L1GET I %S=""!(%TO="END") G ZK ..S %MDPSUG=$S(%S=1:5,1:7) D DEFMDP^%L1OUT(%MDPSUG) ..O 54:(FILE:"W"):2 E S %SAY=" ! qetz 54 hxet " X %XMSGV(1) Q ..U 54 .K ^TMPS111($J) .S N="",I=0 F S N=$O(@GLB@(MRK,INDEX,"PC",N)) Q:N="" D ..S A=$G(^(N)) ..I %MDPSUG'=MDPSO S %N="" F S %N=$O(MDPO(%N)) Q:%N="" I %N'="GWPC",A[MDPO(%N) D ...I $D(%L1OUT("MDP",%N)) S A=$$RPL^%L1FRM(A,MDPO(%N),%L1OUT("MDP",%N)) ..W A,! .I OTB=3 D CLOSE^%L1LPT .I OTB=2 W # C 54 .K ^TMPS111($J) ; Q DO ; I $$^%L1IND(%L1("MAC"),2) D Z^%L1REPS("^VRM($J)") Q S %L1OLD("DO")="Q" Q T2 ; I '$G(INDEX) S %SAY=" : mi`ad mifkxnl xeciyl mipken zeg""ec ++2,60,HH,I" X %XMSG Q N A S A=" : "_$$NAME^%L1MRK(INDEX)_" "_INDEX_" fkxnl xeciyl mipken ze""ec zniyx" I $G(INDEX) S %SAY=A_" ++2,"_(80-(80-$L(A)\2))_",HH,I" X %XMSG S %L1("DO")="D DO^%L1REPS" Q KONAN ; X %chista S ERR=0 S %GET=": opekd my++3,60,HH,,R#A++1,E,I++AB++ - z`vl , - hwqic okez bivdl , B e` A laewn opew my " D ^%L1GET S DEV=%S I $G(%TO)="F7" S %X=DEV_":",%L1OS=345 D O13M^%L1OS G KONAN S:$G(%TO)="END" DEV="" Q:DEV="" K1 S ERR=0 U 0 W ! S DER=$$^%L1ZOS(9,DEV) I DER<0 D MSGER G KONAN Q MSGER ; D X %XMSGN(1) .I ",15,20,257,"[(","_DER_",") S %SAY=" oekp `l opek my " Q .I ",19,256,"[(","_DER_",") S %SAY=" ! hwqicdn dpbd zwacn cixedl jixv " Q .S %SAY=" oken `l opek " X %XMSGN(1) Q %L1RESET %L1RESET(%P) ; [ 06/07/99 8:49 AM ] [ ; S %P=$P to avoid OPEN and CLOSE on device to reset modem cntrl flag NEW (%P) I $V(0,-4,2)#16'=8 S %P=$P Q ; turn off modem control S DDB=$V(4*%P+$V(7,-5),-3,0) I $ZB($V(DDB+20,-3,4),#10000000,1) S %P=$P Q ; LAT device S X=$V(DDB+12,-3,4) S X=$ZB(X,#208,2) V DDB+12:-3:X:4 ; reset xoff flag S PORT=%P D LOOKUP^DEVRESET Q:QF D RESET^DEVRESET Q %L1REST %L1REST ; RESTOR GLOBAL MI DOS ( BLOCKS ) SHEER 26.04.94 [ 04/28/94 2:58 PM ] X %chista S %NMF="#GLOBAL.RES" S %SAY=" lhean vaew xefgye zbvd " X %XMSGV S %GET=" : e` - d`ivi, 2 - vaew xefgy, 1 - vaew zbvd++5,70,H#++1,E,I" D ^%L1GET Q:%S=""!(%TO="END") D VIEW:%S=1,REST:%S=2 W *7 G %L1REST VIEW ; X %chista N (%NMF) D ^%S2V Q REST ; U 0 W !!?5,%NMF S %ER=$$^%L1ZOS(10,%NMF) I %ER<0 D ^%L1OS1 H 3 Q O 54:(%NMF:"R") U 54 F U 54 R %GLOB Q:%GLOB="" R %ZNACH S %GLOB="^"_%GLOB D .S @%GLOB=%ZNACH U 0 W !,%GLOB," = ",%ZNACH C 54 Q %L1RGR1 %L1RGR1 ; HELP FOR ^RR,^GR ; SHEER ; 08.08.93 [ 10.12.09 06:57 ] [ 28.09.05 09:12 ] [ 18.05.04 09:41 ] ;**********************************************; ; INPUT: ^L1ADR($J, ; OUTPUT : %NAM ;************************************************ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%NAM,%L1RM,%L1GM) D ^%L1C S NAME=$G(NAME),%NAM="" N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1RGR1" K ^VRM($J) D PG S PAGE=1 D READ 0 D P ; HAZAGA S LIN=1,COL=1 S %NAM=$P(LIN(1),";"),$Y=1,$X=1 W *27,"[3;1H" D WRIN MAIN K %HBRY ; U $P:(NOECHO:NOWRAP:ESCAPE) W *27,7 W *27,"[23;1H" W *27,"[2K" W !,NAME," ( ^ - EXIT ) : " K PRPRAVO,PRVNIZ,PRLEVO,PRPRAVO RD R *KOD S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 S SYM=$C(KOD) W *27,8 I SYM="^"!(SYM=$C(25)) G ESC ; I KOD=13 G:'$D(%L1RM)&'$D(%L1GM) END I KOD=13,$D(%L1GM("VIEW")) D G END .S MAC=%NAM .S:$E(%NAM)'="^" MAC="^"_%NAM N %NAM S USTR=0 X %chista D ^%S1GLPC I KOD=13,$D(%L1RM("VIEW")) D G END .S USTR=0 X %chista S %RNAME=%NAM N %NAM D M1^%L1RV I KOD=13 D .S %LAB="" .S %GET=" "_%NAM_": EDIT - 1, VIEW - 2,"_$S($D(%L1RM):" DO - 3 ,",1:"")_" DELETE - 0 #1" .D NE^%L1GET S GLO=%NAM I %TO="END"!(%S'=1&(%S'=2)&(%S'=0)&(%S'=3)) S %LAB="PROG" Q .I %S=3 D Q ..N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%NAM) D ^%L1C X %chista U $P:(ECHO:WRAP:WIDTH=80) D @("^"_%NAM) S %GET="<>" D N^%L1GET .S KOD=$S(%S=1:$S($D(%L1RM):18,1:7),%S=2:22,%S=0:4) S %LAB="RO" ; I $L(ZB),$D(%UPRCOD(ZB)),"ESC,TAB,VVERX,VNIZ,PRAVO,LEVO,PGUP,PGDN"[%UPRCOD(ZB) G @%UPRCOD(ZB) I $L(ZB)>3,'$D(%UPRCOD(ZB)) G MAIN ; RO I $D(%L1RM),KOD<32 D S GLO=%NAM G PROG .N (%UPRCOD,%XMSG,%XMSGN,%XMSGV,LIN,KOD,%NAM) D ^%L1C .I KOD=22 S %RNAME=%NAM N %NAM D M1^%L1RV Q ; ----- VIEW PROG .I KOD=18 D ^%L1ED Q ; ----- EDIT .I KOD=4 D Q:'YES S %NAMF=$TR(%NAM,"%","_")_".m" O %NAMF C %NAMF:delete K ^L1ADR($J,%NAM) D PG Q ;---- DELETE ..W *27,7 S %Q("Z")=" ARE YOU SHURE ?",%Q("U")="N",%Q("X")=1,%Q("Y")=23 D ^%S1ASK W *27,8 ; I $D(%L1GM),KOD<32 D S GLO=%NAM G PROG .N (%UPRCOD,%XMSG,%XMSGN,%XMSGV,LIN,KOD,%NAM) D ^%L1C .I KOD=22 S %S=%NAM N %NAM S USTR=0 X %chista D M0^%S1GL Q ;--- VIEW .I KOD=7 S MAC="^"_%NAM N %NAM X %chista D KOD^%S3GLKR Q ;--- EDIT .I KOD=4 D Q:'YES K @%NAM K ^L1ADR($J,%NAM) D PG Q ; DELETE ..W *27,7 S %Q("Z")=" ARE YOU SHURE ?",%Q("U")="N",%Q("X")=1,%Q("Y")=23 D ^%S1ASK W *27,8 ; D WR W *27,"[24;1H",*27,"[2K" W NAME," : "_SYM U $P:(WRAP:ECHO) R GLO W *27,"[2K" U $P:(NOECHO:NOWRAP) S GLO=SYM_GLO,YES=0 PROG S PROG="" ; --- FIND PROG F %SHP=1:1 S PROG=$O(^L1ADR($J,PROG)) Q:PROG="" I PROG=GLO!(PROG]GLO) D POZIC Q D:PROG="" Q S YES=0 G MAIN Q Q ; S I=I-1,PROG=$O(^L1ADR($J,PROG),-1) POZIC ; S YES=1,PAGE=%SHP-1\160+1 D READ,P S LIN=%SHP-1#20+1,COL=%SHP-1#160\20+1,%NAM=PROG S:LIN=0 LIN=20 S ($Y,%YY)=(LIN+1),($X,%XX)=(COL-1*10) X %POSIC D WRIN Q WR ; W *27,7 W $E(%NAM,1,8) W *27,8 Q WRIN ; W *27,7 W %CLI W $E(%NAM,1,8) W *27,"[0m" S %SAY=$S($L(%NAM)>8:%NAM,1:"") X %XMSGN W *27,8 ; --- W *27,7 W *27,"[7m" W $E(%NAM,1,8) W *27,"[0m" W *27,8 Q SET ; S %NAM=$P($G(LIN(LIN)),";",COL) Q VVERX ; D WR S LIN=LIN-1 D SET I LIN=0 S PRVVERX="" D W *27,"["_LIN_"B",*27,"[A" G:'$D(PRLEVO) LEVO K PRLEVO,PRVVERX D WRIN G MAIN .F LIN=20:-1:1 D SET Q:%NAM'="" W *27,"[A" D WRIN G MAIN VNIZ ; D WR S LIN=LIN+1 D SET I %NAM="" S PRVNIZ="" W *27,"["_(LIN-1)_"A" S LIN=1 D SET W *27,"[B" G:'$D(PRPRAVO) PRAVO K PRPRAVO,PRVNIZ D WRIN G MAIN W *27,"[B" D WRIN G MAIN PRAVO ; D WR S COL=COL+1 D SET I %NAM="" W *27,"["_(LIN+2)_";1H" S COL=1 D SET S:'$D(LIN(LIN+1))&(PAGE=PAGES) PAGE=PAGES-1 G:'$D(LIN(LIN+1)) PGDN S PRPRAVO="" G:'$D(PRVNIZ) VNIZ K PRPRAVO,PRVNIZ D WRIN G MAIN W:COL>1 *27,"[10C" D WRIN G MAIN LEVO ; D WR S COL=COL-1 D SET I %NAM="" D W *27,"["_(LIN+2)_";"_(COL-1*10+1)_"H" G:'$D(LIN(LIN-1))&(PAGE>1) PGUP S PRLEVO="" G:'$D(PRVVERX) VVERX K PRVVERX,PRLEVO D WRIN G MAIN .F COL=8:-1:1 D SET Q:%NAM'="" W *27,"[10D" D WRIN G MAIN TAB ; D WR S COL=COL+1 D SET I %NAM="" W *27,"["_(LIN+2)_";1H" S COL=1 D SET W:COL>1 *27,"[10C" D WRIN G MAIN PGUP ; I PAGE=1 W *7 G MAIN S PAGE=PAGE-1 D READ X %chista G 0 PGDN ; I PAGE=PAGES W *7 G MAIN S PAGE=PAGE+1 D READ X %chista G 0 READ ; F LIN=1:1:20 S LIN(LIN)=$G(^VRM($J,PAGE,LIN)) Q ESC S %NAM="" ; END ; W *27,"[23;1H" W *27,"[0J",$C(27,91,63,50,53,104) K ^VRM($J) Q DIR ; --- S %FN="B",%DEV=51,NAME="GLOBAL" ; N %S,%C,%RC U 0 S %GET=" CREATE CATALOG - 99 ? " D NE^%L1GET G:%S'=99 END K ^L1ADR($J) O %FN:(REWIND:READONLY) U %FN I NAME["ROU" F I=1:1 R STR Q:$ZC I STR=""!(I=2) S ZB=$ZB R STR Q:$ZC!(STR="") S ^L1ADR($J,STR)=ZB I NAME["GLO" F I=1:1 R STR Q:$ZC!(STR="**") S ZV=0 D Q:STR="**" .I I=2 S ZB=$ZB R STR Q:STR="**" S ZV=2 .I STR="*" F ZV=1:1 S ZB=$ZB R STR Q:STR'="*" .Q:STR="**" .S:ZV>1 ^L1ADR($J,$P($P(STR,"("),"^",2))=ZB C %DEV S %FNN=$P(%FN,".")_"."_$E($P(%FN,".",2),1,2)_"#" O %FNN:WRITE U %DEV S IND="" F S IND=$O(^L1ADR($J,IND)) Q:IND="" W ^L1ADR($J,IND)_"|"_IND,! C %DEV Q P U $P:(NOECHO:NOWRAP) X %chista I '$D(%L1RM),'$D(%L1GM) W *27,"[1;1H" W "UCI : ",$$ZU($ZG) I '$D(%L1RM) W:NAME'="" ?31,"RESTORE ",NAME W ?60 D ^%D W " " D ^%T W ! I $D(%L1RM)!$D(%L1GM) S %SAY=" ["_$$ZU($ZG)_"] VIEW - V, EDIT - "_$S($D(%L1RM):"R",1:"G")_", DELETE - D, EXIT - Y " X %XMSGV W ! F LIN=1:1:20 W ! D .F COL=1:1:8 S PIC=$E($P($G(LIN(LIN)),";",COL),1,8) W PIC_$J("",10-$L(PIC)) Q PG K ^VRM($J) N PAGE,%NAM,%NAM1 S %NAM="" F PAGE=1:1 D Q:%NAM="" .F I=1:1:8 D Q:%NAM="" ..F LIN=1:1:20 S %NAM=$O(^L1ADR($J,%NAM)) Q:%NAM="" S ^VRM($J,PAGE,LIN)=$G(^VRM($J,PAGE,LIN))_%NAM_";" S PAGES=PAGE Q ER ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1RGR1" S %SAY=$ZS X %XMSGV(1) I $D(GLO) G PROG I $D(%NAM) S GLO=%NAM G PROG G 0 ZU(ZG) ; Q $$FUNC^%UCASE($P(ZG,"/",$L(ZG,"/"))) %L1RGR2 %L1RGR2 ; HELP FOR LIST ; SHEER ; 18.05.94 [ 05/23/94 2:49 PM ] S %NAM="" K LIN,^VRM($J),^LIST($J) D ^%L1C F PAGE=1:1 D Q:%NAM="" .F I=1:1:8 D Q:%NAM="" ..F LIN=1:1:20 S %NAM=$O(^L1ADR($J,%NAM)) Q:%NAM="" S ^VRM($J,PAGE,LIN)=$G(^VRM($J,PAGE,LIN))_%NAM_";" I PAGE=1 S LIN(LIN)=$G(LIN(LIN))_%NAM_";" S PAGES=PAGE,PAGE=1 0 X %chista W *27,"[1;1H" W "UCI : ",$$^%L1ZU(0),?31,$G(NAME)," LIST" W ?60 D ^%D W " " D ^%T W ! F F LIN=1:1:20 W ! D ; :%TYPCRT="PC" ! D W:%TYPCRT["VT" ! .F COL=1:1:8 S PIC=$E($P($G(LIN(LIN)),";",COL),1,8) Q:PIC="" D ..W:$D(^LIST($J,PIC)) *27,"[7m" W PIC W:$D(^LIST($J,PIC)) *27,"[0m" W $J("",10-$L(PIC)) Q:$G(YES) S LIN=1,COL=1 S %NAM=$P(LIN(1),";"),$Y=1,$X=1 W *27,"[3;1H" W *27,7 ; D WRIN MAIN ; F R *R:0 Q:R=-1 W *27,7 ; W *27,"[23;1H" W *27,"[2K" W !,"NAME : " W *27,8 ;,$C(27,91,63,50,53,108) ; R *KOD S SYM=$C(KOD) W *27,8 1 F D RGR R *KOD:0 Q:KOD'=-1 ; D 2^RGR2 S SYM=$C(KOD) W *27,8 I SYM="^" S %NAM="" G END I KOD=13 G LIST ;I $ZB=4379 G VVERX ;I $ZB=4635 G VNIZ ;I $ZB=4891 G PRAVO ;I $ZB=5147 G LEVO ; S ZB=$ZB R *R1:0 I R1>0 S ZB=0_R1 S ZB=$ZB R *R1:0 I R1>0 S ZB=$S(ZB=0:0_R1,1:R1) R *R1:0 I R1>0 S ZB=ZB_R1 ; O 9 U 9 W ZB R R C 9 I $D(%UPRCOD(ZB)),"TAB,VVERX,VNIZ,PRAVO,LEVO,PGUP,PGDN,ESC,END"[%UPRCOD(ZB) G @%UPRCOD(ZB) ; D WR W *27,"[24;1H",*27,"[2K" W NAME," : "_SYM U $P:(ECHO:WRAP) R GLO W *27,"[2K" S %GET="NAME : ++24,1,EE#"_SYM_"++8,E,I",%BE="E" D ^%L1GET I %TO="END"!(%S="") W *27,8 G MAIN S GLO=%S,YES=0 ; S GLO=SYM_GLO,YES=0 PROG S PROG="" F I=1:1 S PROG=$O(^L1ADR($J,PROG)) Q:PROG="" I PROG=GLO!(PROG]GLO) D POZIC Q D:PROG="" Q S YES=0 G MAIN Q Q ; S I=I-1,PROG=$ZPR(^L1ADR($J,PROG)) POZIC ; S YES=1,PAGE=I-1\160+1 D READ,0 S LIN=I-1#20+1,COL=I-1#160\20+1,%NAM=PROG S:LIN=0 LIN=20 W *27,"["_(LIN+2)_";"_(COL-1*10+1)_"H" D WRIN Q WR ; ; W *27,7 W $E(%NAM,1,8) W *27,8 Q WRIN ; ; W *27,7 W *27,"[7m" W $E(%NAM,1) W *27,"[0m" W *27,8 ; S %SAY=$S($L(%NAM)>8:%NAM,1:"") X %XMSGN W *27,8 ; --- W *27,7 W *27,"[7m" W $E(%NAM,1,8) W *27,"[0m" W *27,8 Q SET ; S %NAM=$P($G(LIN(LIN)),";",COL) Q VVERX ; D WR S LIN=LIN-1 D SET I LIN=0 D W *27,"["_(LIN-1)_"B" G LEVO .F LIN=20:-1:1 D SET Q:%NAM'="" W *27,"[A" D WRIN G MAIN VNIZ D WR; BN S LIN=LIN+1 D SET I %NAM="" W *27,"["_(LIN-2)_"A" S LIN=1 G PRAVO ; SET W *27,"[B" D WRIN G MAIN PRAVO ; D WR S COL=COL+1 D SET I %NAM="" W *27,"["_(LIN+2)_";1H" S COL=1 D SET W:COL>1 *27,"[10C" D WRIN G MAIN LEVO ; D WR S COL=COL-1 D SET I %NAM="" D W *27,"["_(LIN+2)_";"_(COL-1*10+1)_"H" D WRIN G MAIN .F COL=8:-1:1 D SET Q:%NAM'="" W *27,"[10D" D WRIN G MAIN TAB ; D WR S COL=COL+1 D SET I %NAM="" W *27,"["_(LIN+2)_";1H" S COL=1 D SET W:COL>1 *27,"[10C" D WRIN G MAIN PGUP ; I PAGE=1 W *7 G MAIN S PAGE=PAGE-1 D READ X %chista G 0 PGDN ; I PAGE=PAGES W *7 G MAIN S PAGE=PAGE+1 D READ X %chista G 0 READ ; F LIN=1:1:20 S LIN(LIN)=$G(^VRM($J,PAGE,LIN)) Q ESC ; END ; U $P:(ECHO:WRAP) W *27,"[23;1H" W *27,"[0J",$C(27,91,63,50,53,104) Q LIST ; I '$D(^LIST($J,%NAM)) S ^LIST($J,%NAM)="" D IN G BN I $D(^LIST($J,%NAM)) K ^LIST($J,%NAM) D WR1 G BN IN ; W *27,7 W *27,"[7m" W $E(%NAM,1,8) W *27,"[0m" W *27,8 Q WR1 ; W *27,7 W $E(%NAM,1,8) W *27,8 Q RGR ; ; W *27,7,$J("",9),*27,8 W *27,7,%NAM,*27,8 W *27,7,$J("",9),*27,8 S F=20000 D FOR W *27,7,%NAM,*27,8 D:$D(^LIST($J,%NAM)) IN S F=20000 D FOR Q FOR ; F I=1:1:F %L1RI %L1RI ;service@greystone.com %RI;19920722 07:40;routine input [ 09.05.06 06:55 ] [ 26.04.06 12:55 ] [ 22.09.03 09:23 ] ;Converts mumps routines from a standard routine output (RO) ;file to individual *.m files. ;possible enhancements: ;selection and/or exclusion by list, range and/or wildcard ;optional confirmation by routine name ;callable entry point ; w !,"Routine Input Utility - Converts MSM files to *.m files.",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI") n d,dir,ff,l,r,x,y,%ZD,ff s ff=$c(13,12) f d q:$l(%ZD) . r !,"Input file: ",%ZD,! . I %ZD="" S %ZD="^" . i %ZD="^" q . i $e(%ZD)=">" S %ZD="/home/lev/"_$E(%ZD,2,255) . i $e(%ZD,1,3)="mu>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/"_$E(%ZD,4,255) . i $e(%ZD,1,3)="ml>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/mly/"_$E(%ZD,4,255) . i $e(%ZD,1,2)="a>"!($E(%ZD,1,2)="A:")!($E(%ZD,1,2)="a:") S %ZD="/mnt/floppy/"_$E(%ZD,3,255) . I %ZD["/mnt/floppy/" D ^%L1FLOP . i $zparse(%ZD)="" w " no such file" s %ZD="" q . o %ZD:(readonly:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^"!(%ZD="") u %ZD:exception="zg "_$zl_":eof" r x0,y0 u $p w "x0=",x0," y0=",y0 s dir="" ;;r !,"Output directory : ",dir w !! i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q s (l,r)=0 u $p w # S ENDR=0,YES=0 cyc u %ZD r x2 i $l(x2),$e(x2)?1a!($e(x2)="%") d G:ENDR eof . ;warning - loop terminated by exception . u $p w !,x2 . S YES=1 ;R " >",Y S YES=(Y="Y"!(Y="y")) I Y="."!(Y="^") S ENDR=1 Q . s x=$tr($e(x2),"%","_")_$p($e(x2,2,8),$c(13))_".m",r=r+1 ;convert % to _ . ;u $p w !,"x=",x,! h 1 . I YES o x:(newversion:noreadonly:blocksize=2048:recordsize=2044) . f u %ZD r y q:y=ff!(y=$c(13)) d:YES ..s l=l+1 u x w $p(y,$c(13)),! . I YES c x i $G(yy)'=ff g cyc eof u $p i $l(x),YES c x w !!,"Restored ",l," line",$s(l=1:"",1:"s") w " in ",r," routine",$s(r=1:".",1:"s.") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR u $p w !,$p($zs,",",2,99),! s $ec="" ; Warning - Fall-though EXIT i $d(%ZD),%ZD'=$p c %ZD u $p:(ctrap="":exc="") q %L1RL %L1RL K %L1RL ; LIST ROUTINE [ 01/26/92 3:13 PM ] S $ZT="S zr=$R "_^ZT_"ZG "_$ZL_":ER^%L1RL" W !!,"ROUTINE NAME : " S %LS=8,%S="" D ^%ZMSL S %NAME=%S G:%NAME="" END X "ZL @%NAME S %I=0 F S YYY="""" S %I=%I+1 Q:$T(+%I)="""" W !,$T(+%I) R:'(%I#16) !!,""<>"",*YYY S:YYY=30 %I=%I-32 X:YYY=30 %chista S:%I<0 %I=0 Q:$C(YYY)="".""!($C(YYY)=""/"")" G %L1RL ER W !,*7,$P($ZS,">") S %L1XER="" G %L1RL+1 END I $D(^ZE($P,"%ERG")),$D(%L1XER) D ^%L1C S %TIP=^ZE($P,"%ERG") G 241^%S2ERG Q %L1RM %L1RM ; ROUTINE MONITOR ;[ 10/23/95 6:57 PM ] [ 05/23/99 5:29 PM ] [ 10/23/95 6:57 PM ] U $P:(NOECHO:NOWRAP) X %chista S %SAY=" ROUTINE MONITOR " X %XMSGV U $P:(ECHO:WRAP) D ^%RSEL U $P:(NOECHO:NOWRAP) G M1 M1 K ^L1ADR($J) S N="" F S N=$O(%ZR(N)) Q:N="" S ^L1ADR($J,N)=%ZR(N) K %ZR S %L1RM="" D ^%L1RGR1 K %L1RM Q %L1RNG %L1RNG ; [ 15.01.06 19:34 ] [ 08.04.05 12:40 PM ] [ 20.11.04 3:55 PM ] ; D ^%L1RNG ---- FROM DATE TO DATE ; D YM^%L1RNG --- FROM YEAR, MONTH TO YEAR, MONTH ; D RR^%L1RNG --- FROM "ME" TO "AD" D ; INPUT : %YY ; OUTPUT : %L1DAT01,%L1DAT02 (YYMMDD) ; %L1DAT11,%L1DAT12 (DD.MM.YY) ; %L1D1,%L1D2 ($H) K %L1DAT01,%L1DAT02 I '$D(%L1DAT11) S %L1DAT11=$ZD($H,"DD/MM/YY") N %YYDAT S:'$D(%YY) %YY=3 S %YYDAT=%YY Z1 U 0 S %GET=$G(%RNG("DAT"),"jix`z")_"n++"_%YYDAT_",70,HH#"_$TR($G(%L1DAT11),"./","")_"++8,D,I" I %ENGLISH S %GET="FROM DATE++"_%YYDAT_",10,EE#"_$TR($G(%L1DAT11),"./","")_"++8,D,I" D ^%L1GET I %S=""!($G(%TO)="END")!($G(%TO)="UP") K %L1DAT01,%L1DAT02,%L1DAT11,%L1DAT12,%L1D1,%L1D2,%L1CALL Q I %TO="F7",$D(%L1CALL("PROG")) D ^%L1CALL(%L1CALL("PROG"),$G(%SCRN),$G(%L1CALL("VRB"))_",%L1CALL(""OUT"")") S %L1DAT11=$G(%L1CALL("OUT")) G Z1 S %L1D1=$$^%L1DC(%L1DAT1,3) I $E(%L1D1)="?" S %SAY=" ! d`iby " X %XMSGV(1) G Z1 S %L1DAT01=%L1DAT,%L1DAT11=%L1DAT1 Z2 U 0 S %GET=$G(%RNG("DAT"),"jix`z")_" cr++"_%YYDAT_",45,HH#"_$TR($G(%L1DAT12,%L1DAT11),"./","")_"++8,D,I" I %ENGLISH S %GET="TO DATE++"_%YYDAT_",45,EE#"_$TR($G(%L1DAT12,%L1DAT11),"./","")_"++8,D,I" D ^%L1GET G:%S=""!($G(%TO)="END")!($G(%TO)="UP") Z1 I %TO="F7",$D(%L1CALL("PROG")) D ^%L1CALL(%L1CALL("PROG"),$G(%SCRN),$G(%L1CALL("VRB"))_",%L1CALL(""OUT"")") S %L1DAT12=$G(%L1CALL("OUT")) G Z2 S %L1D2=$$^%L1DC(%L1DAT1,3) I $E(%L1D2)="?" S %SAY="! d`iby " X %XMSGV(1) G Z2 S %L1DAT02=%L1DAT,%L1DAT12=%L1DAT1 I %L1D2<%L1D1 N %YY0 S %YY0=%YY S %SAY=" ! d`iby " W *7 X %XMSGV H 2 S %SAY=" " W *7 X %XMSGV S %YY=%YY0 G D K %L1CALL,%RNG Q YM K YYMM N YY,MM S YY=$P($$^%L1DC($H,1),".",3),MM=$P($ZD($H,"DD/MM/YY"),"/",2) I $D(%RNG("YMPREV")),MM=1 S YY=YY-1,MM=12 I $D(%RNG("YMPREV")),MM>1 S MM=MM-1 S %GET=":dpy++"_%YY_",70,HH#"_YY_"++2,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S YY=%S I YY<80,YY>50 W *7 G YM YM1 S %GET=":yceg++"_%YY_",60,HH#"_MM_"++2,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") YM S MM=$TR($J(%S,2)," ",0) I MM>12!(MM<1) W *7 G YM1 S YY=$TR($J(YY,2)," ",0) S YYMM=YY_MM K %RNG Q R N %RNGZ,%RNGX ; R1 S %RNGZ=%RNG("Z")_"n" S %RNGX=$G(%RNG("X"),70) D RG D ^%L1GET Q:$G(%TO)="END"!($G(%TO)="UP") S @("ME"_$G(%RNG("V"))_"=%S") S %RNG("O")=%S S %RNGZ=%RNG("Z")_" cr" S %RNGX=%RNGX-$L(%RNGZ)-$G(%RNG("PAR"),2)-11 D RG D ^%L1GET G:$G(%TO)="END"!($G(%TO)="UP") R1 S @("AD"_$G(%RNG("V"))_"=%S") K %RNG Q RG ; S %GET=%RNGZ_"++"_$G(%RNG("Y"),%YY)_","_$G(%RNGX,70)_",HH,,"_$G(%RNG("RB"))_"#" S %GET=%GET_$G(%RNG("O"))_"++"_$G(%RNG("PAR"),"2,E,I") S %GET=%GET_"++"_$G(%RNG("CIST"))_"++"_$G(%RNG("HELP")) S %GET=%GET_"++"_$G(%RNG("FILE"))_"++"_$G(%RNG("C")) Q RR S %FL=1,%TO="" N TYP,%RNGX,%RNGY,%RNGO,%MERNGV,%RNGER,%MER,%ADR S %MER="ME"_$G(%RNG("V")),%ADR="AD"_$G(%RNG("V")) S %SAY="" X %XMSGN S:'$D(@%MER) @%MER="" S:'$D(@%ADR) @%ADR="" R0 S TYP=$P($P($P(%RNG,"#",2),"++",2),",",2) I $P($P($P(%RNG,"++",2),",",3),"#")="HH",%ENGLISH D .N CRD S CRD=$P($P(%RNG,"++",2),"#") .S CRD=$P(CRD,",")_","_(80-$P(CRD,",",2))_",EE"_$P(CRD,",",4,24) .S %RNG=$P(%RNG,"++")_"++"_CRD_"#"_$P(%RNG,"#",2,25) S %MERNGV=$G(@%MER) ; -------- %RNG("V") - VALUE NAME I TYP="D",$TR(%MERNGV,"./","")?6N S %MERNGV=$E(%MERNGV,5,6)_$E(%MERNGV,3,4)_$E(%MERNGV,1,2) I TYP="D",$TR(%MERNGV,"/.","")?8N S %MERNGV=$E(%MERNGV,7,8)_$E(%MERNGV,3,4)_$E(%MERNGV,1,2) I TYP="D",%MERNGV?.P,'$D(%L1GET) S %MERNGV=" "_$$MMGG($H) I TYP="D",%MERNGV?5N S %MERNGV=$ZD(%MERNGV,"DD/MM/YY") I %MERNGV?.P S %MERNGV=" "_$$MMGG($H) I TYP="T",$G(%ADRNGV)>24 S %ADRNGV=%ADRNGV-24 S %GET=$P(%RNG,"++")_"n++"_$P($P(%RNG,"++",2,20),"#")_"#"_$G(%MERNGV)_$P(%RNG,"#",2,20) I %ENGLISH S %GET=" FROM "_$P(%RNG,"++")_"++"_$P($P(%RNG,"++",2,20),"#")_"#"_$G(%MERNGV)_$P(%RNG,"#",2,20) I $D(%RNG("S0")),'$D(%L1GET) D .S %SAY="(S0-ycg, mihq zniyx) hq 'qne ""S"" ze` cilwdl `p ""*"" mr zecya mipezp hq zclwdl++22,79,HH,I" X %XMSG D ^%L1GET Q:$G(%TO)="END"!($G(%TO)="UP") ;I "/.>u"[%S,$L(%S) S %TO="END1" Q I $D(%L1GET) G RR1 I TYP="D" S @%MER=%L1DAT E S @%MER=%S ; I $D(%RNG("S0")),%TO="F8" D G R0 .S MAC="^RNGSET(%RNG(""V""))" .S %L1("EU")=2,%L1("BE")=6 D ^%L1NU Q:FLAG'="" .S @(%MER_"=""S"_INDEX_"""") . I @%MER?1"S"1N.N,'$D(%RNG("S0")) W *7 G R0 I @%MER?1"S"1N.N,$D(%RNG("S0")),$D(%RNG("V")),'$D(%L1GET) D S @%ADR="" K %RNG Q .D SAVE^%L3MBGG .K ^MBG($P) .N %NSET,%SSET S %NSET=$E(@%MER,2,3) .I %NSET,$D(^RNGSET(%RNG("V"),%NSET)) M ^MBG($P)=^RNGSET(%RNG("V"),%NSET) .N %GL S %GL=$P($P(%RNG,"#",2),"++",5) .S %MBG("PAR",1)=";oezp qn;60;10;E;" .S %MBG("PAR",2)=";my;48;20;E;#""""" .I $E(%GL)="^" S %MBG("GLOB",1)=%GL,%MBG("PAR",1)=%MBG("PAR",1)_"##D CMD^%L1RNG" .S %MBG("VGR0")=$P(%RNG,"++",2)+1 .S %MBG("VGR")=%MBG("VGR0")+1 .S %MBG("STEP")=1 .D ^%L1MBG1 .I $G(%MBG("GLOB",1))="^PARIT" S %MBG("D",1)="8." .S %MBG("=")="" .D ^%L1MBG .N %I F %I=1:1 Q:'$D(^MBG($P,%I)) I $G(^(%I))'="" S %ITEM=$P(^(%I),"\") I %ITEM'="" S @%MER@("SET",%ITEM)="" .K %Q S %Q("Z")="hq xenyl" S:'%NSET %Q("U")="l" D N^%S2ASK I YES D ..I '%NSET S %NSET=$O(^RNGSET(%RNG("V"),9999),-1)+1 ZR ..S %GET="(F8 - dniyx) hq 'qn++24,78,HH,,,C#"_%NSET_"++2,E,I" D ^%L1GET ..Q:%TO="END" ..I %TO="F8" D G:FLAG'="" ZR ...S MAC="^RNGSET(%RNG(""V""))" ...S %L1("EU")=2,%L1("BE")=6 D ^%L1NU ...S %NSET=INDEX ..Q:%S="" ..S %NSET=%S ..S %SSET=$G(^RNGSET(%RNG("V"),%NSET)) ..I $D(^RNGSET(%RNG("V"),%NSET)) D Q:%S'=99 ...S %GET=" ugl xeyi`l . miiw xak "_%NSET_" hq++24,65,HH#++1,E,I" D ^%L1GET S:%TO="F9" %S=99 ..S %GET=": hq my ++24,65,HH#"_%SSET_"++30,H,I" D ^%L1GET S %SSET=%S ..M ^RNGSET(%RNG("V"),%NSET)=^MBG($P) ..S ^RNGSET(%RNG("V"),%NSET)=%SSET .K ^MBG($P) .I %TYPCRT="PC" D REST^%L3MBGG Q .I $D(%L1PC),$D(%REPN),'$D(%L1GET) D ..N IJK,COD,%RNG,%RNGO,%MER,%ADR,%L1GET,TYP,%TO X %chista ..S %L1GET="",%L1RNG="" D SHEIL1^%L1PCS ; I TYP="D",%L1DAT?.P,'$D(%L1GET),$D(%RNG("DAT")) W *7,*7,*7 G RR I $D(%RNG("ME")) X %RNG("ME") I %TO="DW" Q I $G(%RNGER) S %RNGER=0 G R0 S %TO="" ;I $D(%RNGREST) X %RNGREST RR1 S %RNGX=$P($P(%RNG,"++",2),",",2)-$L($P(%RNG,"++"))-$P($P(%RNG,"#",2),"++",2)-4 I %ENGLISH S %RNGX=$P($P(%RNG,"++",2),",",2)+$L($P(%RNG,"++"))+$P($P(%RNG,"#",2),"++",2)+7 I %RNGX>45,'%ENGLISH S %RNGX=45 I $D(%L1GET) S %RNGO=$G(@%ADR) D G RR2 .I TYP="D",%RNGO?5N S %RNGO=$ZD(%RNGO,"DD/MM/YY") I $G(@%ADR)="" S %RNGO=$S(TYP="D":$$^%L1DC(@%MER,1),1:%S) E S %RNGO=$G(@%ADR) ;I TYP="D",%RNGO?6N S %RNGO=$E(%RNGO,5,6)_$E(%RNGO,3,4)_$E(%RNGO,1,2) I TYP="D" I %RNGO?5N S %RNGO=$ZD(%RNGO,"DD/MM/YY") I "/.>u"[%S,$L(%S) S %TO="END1" Q RR2 I $P($P(%RNG,"#"),",",6)="C" S $P(%RNG,",",6)=$E($P(%RNG,",",6),2,255) S %FL=1 S %GET=$P(%RNG,"++")_" cr++"_$P($P(%RNG,"++",2),",")_","_%RNGX_","_$P($P($P(%RNG,"#"),"++",2),",",3,20)_"#"_%RNGO_"++"_$P($P(%RNG,"#",2),"++",2,25) I %ENGLISH S %GET=" TO "_$P(%RNG,"++")_"++"_$P($P(%RNG,"++",2),",")_","_%RNGX_","_$TR($P($P($P(%RNG,"#"),"++",2),",",3,20),"H","E")_"#"_%RNGO_"++"_$P($P(%RNG,"#",2),"++",2,25) D ^%L1GET Q:$D(%L1GET) G:$G(%TO)="END"!($G(%TO)="UP") RR I TYP="D" S @%ADR=%L1DAT E S @%ADR=%S I TYP="D",%L1DAT?.P,'$D(%L1GET),$D(%RNG("DAT")) W *7,*7,*7 G RR1 I $D(%RNG("AD")) X %RNG("AD") I TYP="T" D .I @%ADR?4N S @%ADR=$E(@%ADR,1,2)_":"_$E(@%ADR,3,4) .I @%MER?4N S @%MER=$E(@%MER,1,2)_":"_$E(@%MER,3,4) .S @%MER=$$TDEC^%L1TIME(@%MER) .S @%ADR=$$TDEC^%L1TIME(@%ADR) .I @%ADR<@%MER S @%ADR=@%ADR+24 I TYP="D",$$^%L1DC(@%ADR,4)<$$^%L1DC(@%MER,4) W *7 G RR I TYP'="D",@%ADR<@%MER W *7 G RR I $G(%RNGER) S %RNGER=0 G RR1 K %RNG ;I $D(%RNGREST) X %RNGREST Q MMGG(H) ; Q $E($TR($$^%L1DC($H,1),"/.",""),3,6) CMD ; I $L(%MBG("O",1)),'$D(@%MBG("GLOB",1)@(%MBG("O",1))) S %SC("ST")=1 Q S %MBG("O",2)="" I $L(%MBG("O",1)) S %MBG("O",2)=$TR($P($G(@%MBG("GLOB",1)@(%MBG("O",1))),"**"),"\","/") S ^MBG($P,SH)=%MBG("O",1)_"\"_%MBG("O",2) S %MBG("TO",1)="PL" Q %L1RNG0 %L1RNG ; [ 15.01.06 19:31 ] [ 08.07.01 4:21 PM ] [ 06.05.01 1:13 PM ] ; D ^%L1RNG ---- FROM DATE TO DATE ; D YM^%L1RNG --- FROM YEAR, MONTH TO YEAR, MONTH ; D RR^%L1RNG --- FROM "ME" TO "AD" D ; INPUT : %YY ; OUTPUT : %L1DAT01,%L1DAT02 (YYMMDD) ; %L1DAT11,%L1DAT12 (DD.MM.YY) ; %L1D1,%L1D2 ($H) K %L1DAT01,%L1DAT02 I '$D(%L1DAT11) S %L1DAT11=$$^%L1DC($H,1) N %YYDAT S:'$D(%YY) %YY=3 S %YYDAT=%YY Z1 U 0 S %GET="jix`zn++"_%YYDAT_",70,HH#"_$TR($G(%L1DAT11),"./","")_"++8,D,I" I %ENGLISH S %GET="FROM DATE++"_%YYDAT_",10,EE#"_$TR($G(%L1DAT11),"./","")_"++8,D,I" D ^%L1GET I %S=""!($G(%TO)="END")!($G(%TO)="UP") K %L1DAT01,%L1DAT02,%L1DAT11,%L1DAT12,%L1D1,%L1D2,%L1CALL Q I %TO="F7",$D(%L1CALL("PROG")) D ^%L1CALL(%L1CALL("PROG"),$G(%SCRN),$G(%L1CALL("VRB"))_",%L1CALL(""OUT"")") S %L1DAT11=$G(%L1CALL("OUT")) G Z1 S %L1D1=$$^%L1DC(%L1DAT1,3) I $E(%L1D1)="?" S %SAY=" ! d`iby " X %XMSGV(1) G Z1 S %L1DAT01=%L1DAT,%L1DAT11=%L1DAT1 Z2 U 0 S %GET="jix`z cr++"_%YYDAT_",45,HH#"_$TR($G(%L1DAT12,%L1DAT11),"./","")_"++8,D,I" I %ENGLISH S %GET="TO DATE++"_%YYDAT_",45,EE#"_$TR($G(%L1DAT12,%L1DAT11),"./","")_"++8,D,I" D ^%L1GET G:%S=""!($G(%TO)="END")!($G(%TO)="UP") Z1 I %TO="F7",$D(%L1CALL("PROG")) D ^%L1CALL(%L1CALL("PROG"),$G(%SCRN),$G(%L1CALL("VRB"))_",%L1CALL(""OUT"")") S %L1DAT12=$G(%L1CALL("OUT")) G Z2 S %L1D2=$$^%L1DC(%L1DAT1,3) I $E(%L1D2)="?" S %SAY="! d`iby " X %XMSGV(1) G Z2 S %L1DAT02=%L1DAT,%L1DAT12=%L1DAT1 I %L1D2<%L1D1 N %YY0 S %YY0=%YY S %SAY=" ! d`iby " W *7 X %XMSGV H 2 S %SAY=" " W *7 X %XMSGV S %YY=%YY0 G D K %L1CALL Q YM K YYMM N YY,MM S YY=$P($$^%L1DC($H,1),".",3),MM=$P($$^%L1DC($H,1),".",2) I $D(%RNG("YMPREV")),MM=1 S YY=YY-1,MM=12 I $D(%RNG("YMPREV")),MM>1 S MM=MM-1 S %GET=":dpy++"_%YY_",70,HH#"_YY_"++2,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S YY=%S I YY<80,YY>50 W *7 G YM YM1 S %GET=":yceg++"_%YY_",60,HH#"_MM_"++2,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") YM S MM=$TR($J(%S,2)," ",0) I MM>12!(MM<1) W *7 G YM1 S YY=$TR($J(YY,2)," ",0) S YYMM=YY_MM K %RNG Q R N %RNGZ,%RNGX ; R1 S %RNGZ=%RNG("Z")_"n" S %RNGX=$G(%RNG("X"),70) D RG D ^%L1GET Q:$G(%TO)="END"!($G(%TO)="UP") S @("ME"_$G(%RNG("V"))_"=%S") S %RNG("O")=%S S %RNGZ=%RNG("Z")_" cr" S %RNGX=%RNGX-$L(%RNGZ)-$G(%RNG("PAR"),2)-11 D RG D ^%L1GET G:$G(%TO)="END"!($G(%TO)="UP") R1 S @("AD"_$G(%RNG("V"))_"=%S") K %RNG Q RG ; S %GET=%RNGZ_"++"_$G(%RNG("Y"),%YY)_","_$G(%RNGX,70)_",HH,,"_$G(%RNG("RB"))_"#" S %GET=%GET_$G(%RNG("O"))_"++"_$G(%RNG("PAR"),"2,E,I") S %GET=%GET_"++"_$G(%RNG("CIST"))_"++"_$G(%RNG("HELP")) S %GET=%GET_"++"_$G(%RNG("FILE"))_"++"_$G(%RNG("C")) Q RR S %FL=1,%TO="" N TYP,%RNGX,%RNGY,%RNGO,%MERNGV,%RNGER,%MER,%ADR S %MER="ME"_$G(%RNG("V")),%ADR="AD"_$G(%RNG("V")) S %SAY="" X %XMSGN S:'$D(@%MER) @%MER="" S:'$D(@%ADR) @%ADR="" R0 S TYP=$P($P($P(%RNG,"#",2),"++",2),",",2) I $P($P($P(%RNG,"++",2),",",3),"#")="HH",%ENGLISH D .N CRD S CRD=$P($P(%RNG,"++",2),"#") .S CRD=$P(CRD,",")_","_(80-$P(CRD,",",2))_",EE"_$P(CRD,",",4,24) .S %RNG=$P(%RNG,"++")_"++"_CRD_"#"_$P(%RNG,"#",2,25) S %MERNGV=$G(@%MER) ; -------- %RNG("V") - VALUE NAME I TYP="D",$TR(%MERNGV,"./","")?6N S %MERNGV=$E(%MERNGV,5,6)_$E(%MERNGV,3,4)_$E(%MERNGV,1,2) I TYP="D",$TR(%MERNGV,"/.","")?8N S %MERNGV=$E(%MERNGV,7,8)_$E(%MERNGV,3,4)_$E(%MERNGV,1,2) I TYP="D",%MERNGV?.P,'$D(%L1GET) S %MERNGV=" "_$$MMGG($H) I TYP="D",%MERNGV?5N S %MERNGV=$$^%L1DC(%MERNGV,1) I %MERNGV?.P S %MERNGV=" "_$$MMGG($H) I TYP="T",$G(%ADRNGV)>24 S %ADRNGV=%ADRNGV-24 S %GET=$P(%RNG,"++")_"n++"_$P($P(%RNG,"++",2,20),"#")_"#"_$G(%MERNGV)_$P(%RNG,"#",2,20) I %ENGLISH S %GET=" FROM "_$P(%RNG,"++")_"++"_$P($P(%RNG,"++",2,20),"#")_"#"_$G(%MERNGV)_$P(%RNG,"#",2,20) D ^%L1GET Q:$G(%TO)="END"!($G(%TO)="UP") ;I "/.>u"[%S,$L(%S) S %TO="END1" Q I TYP="D" S @%MER=%L1DAT E S @%MER=%S I TYP="D",%L1DAT?.P,'$D(%L1GET),$D(%RNG("DAT")) W *7,*7,*7 G RR I $D(%RNG("ME")) X %RNG("ME") I %TO="DW" Q I $G(%RNGER) S %RNGER=0 G R0 S %TO="" ;I $D(%RNGREST) X %RNGREST RR1 S %RNGX=$P($P(%RNG,"++",2),",",2)-$L($P(%RNG,"++"))-$P($P(%RNG,"#",2),"++",2)-4 I %ENGLISH S %RNGX=$P($P(%RNG,"++",2),",",2)+$L($P(%RNG,"++"))+$P($P(%RNG,"#",2),"++",2)+7 I %RNGX>45,'%ENGLISH S %RNGX=45 I $D(%L1GET) S %RNGO="" G RR2 I $G(@%ADR)="" S %RNGO=$S(TYP="D":$$^%L1DC(@%MER,1),1:%S) E S %RNGO=$G(@%ADR) ;I TYP="D",%RNGO?6N S %RNGO=$E(%RNGO,5,6)_$E(%RNGO,3,4)_$E(%RNGO,1,2) I TYP="D",%RNGO?5N S %RNGO=$$^%L1DC(%RNGO,1) I "/.>u"[%S,$L(%S) S %TO="END1" Q RR2 I $P($P(%RNG,"#"),",",6)="C" S $P(%RNG,",",6)=$E($P(%RNG,",",6),2,255) S %FL=1 S %GET=$P(%RNG,"++")_" cr++"_$P($P(%RNG,"++",2),",")_","_%RNGX_","_$P($P($P(%RNG,"#"),"++",2),",",3,20)_"#"_%RNGO_"++"_$P($P(%RNG,"#",2),"++",2,25) I %ENGLISH S %GET=" TO "_$P(%RNG,"++")_"++"_$P($P(%RNG,"++",2),",")_","_%RNGX_","_$TR($P($P($P(%RNG,"#"),"++",2),",",3,20),"H","E")_"#"_%RNGO_"++"_$P($P(%RNG,"#",2),"++",2,25) D ^%L1GET G:$G(%TO)="END"!($G(%TO)="UP") RR I TYP="D" S @%ADR=%L1DAT E S @%ADR=%S I TYP="D",%L1DAT?.P,'$D(%L1GET),$D(%RNG("DAT")) W *7,*7,*7 G RR1 I $D(%RNG("AD")) X %RNG("AD") I TYP="T" D .I @%ADR?4N S @%ADR=$E(@%ADR,1,2)_":"_$E(@%ADR,3,4) .I @%MER?4N S @%MER=$E(@%MER,1,2)_":"_$E(@%MER,3,4) .S @%MER=$$TDEC^%L1TIME(@%MER) .S @%ADR=$$TDEC^%L1TIME(@%ADR) .I @%ADR<@%MER S @%ADR=@%ADR+24 I TYP="D",$$^%L1DC(@%ADR,4)<$$^%L1DC(@%MER,4) W *7 G RR I TYP'="D",@%ADR<@%MER W *7 G RR I $G(%RNGER) S %RNGER=0 G RR1 K %RNG ;I $D(%RNGREST) X %RNGREST Q MMGG(H) ; Q $E($TR($$^%L1DC($H,1),"/.",""),3,6) %L1RPR %L1RPR ; REPARATION [ 11.06.02 9:11 AM ] [ 01/15/97 12:36 PM ] K I '$D(%POSIC) D ^%L1C K MM S MM(0)="oewiz zeipkez" S MM(1)=" d ` i v i " S MM(2)="DDP - zyx zxivre zlrtd" S MM(3)="GBMAINT - mivaw oewiz" S MM(4)="RECOVER - miwela xefgiy" S MM(5)="zkxrn avn" S MM(6)="KILLJOB - miae'b zwqtd" S MM(7)="VALIDATE - DATABASE zwica" S MM(8)="UCIMGR - zevign zldpd" S MM(9)="DBFIX - DATABASE oewiz" S MM(10)="INS - zetew zkx`n mixhnxt" S MM(11)="VERIFY - miwela zwica" S MM(12)="%L1DIR - zevign belhw zxiny" S MM(13)="mivaw belhw zxiny" S MM(14)="ltp mipezp qiqa m` mivaw xefgy" S MM(15)="miwelaa lhean vaew yetig" ; S MM(17)="lhean vaew zbvd" S MM(16)="(14 divte` ixg` ) lhean vaew xefgy" S MM(17)="SYSGEN - MUMPS zkxrn zxcbd" S MM(18)="KILL GLOBAL PROTECTION" S MM(19)="RESET DEVICE" S MAC="MM" D ^%L2MENU Q:%I=1 D U $P:(NOECHO:NOWRAP) R !!,"<>",Y W %HBR G %L1RPR .W %ENG N (%I) U $P:(ECHO:WRAP) .I %I=2 D ^DDP Q .I %I=3 D ^GBMAINT Q .I %I=4 D ^RECOVER Q .I %I=5 D ^%SS Q .I %I=6 D ^%SS,^KILLJOB Q .I %I=7 D ^VALIDATE Q .I %I=8 D ^UCIMGR Q .I %I=9 D ^DBFIX Q .I %I=10 V 2:$J:+$ZU("MER"):2 D ^INS V 2:$J:1:2 .I %I=11 D ^VERIFY Q .I %I=12 D ^%L1C S %SAY="... oznd `p` " X %XMSGV(1) D ^%L1DIR S %SAY=" #DIR uaewa xnyp belhw " X %XMSGV Q .I %I=13 D ^%L1C S %SAY=" ... oznd `p` " D I^%L1DIR S %SAY=" #DIR1 uaewa xnyp belhw " X %XMSGV Q .I %I=14 V 2:$J:+$ZU("MER"):2 D V 2:$J:1:2 ..D ^PLREST .I %I=15 D ^%L1SGK Q .; I %I=17 D ^%L1C,VIEW^%L1REST Q .I %I=16 D ^%L1C,^%L1REST Q .I %I=17 D ^SYSGEN Q .I %I=18 D ^%L1DPRO Q .I %I=19 D DVR Q .Q Q DVR D ^%L1C X %chista S %GET="uexr xtqn++8,63,HH#++2,E,I" D ^%L1GET Q:%S=""!(%TO="END") N PORT S PORT=%S S %Q("Z")="df uexra miynzynd zeniynd lk cixedl" S %Q("X")=20,%Q("Y")=10 D ^%S2ASK I 'YES G DVR1 D ^%L1DV8 I $G(%DV(PORT)) D .I $ZV["4.0." D KILL^%L1KLJ8(+%DV(PORT),1) Q .I $ZV["4.4." D KILL^%L1KLJ16(+%DV(PORT),1,2) Q DVR1 D ^%L1DVRES(PORT) S %SAY="" X %XMSGN Q %L1RPRTC %L1RPRTC(%PORT) ; [ 20.08.07 14:46 ] [ 13.08.07 13:35 ] [ 04.04.07 10:45 ] N %PRT,%TYPCRT S %PRT="",%TYPCRT="PC" D WAIT U %PORT:(NOWRAP:NOECHO:NOESC:NOTERM:NOCENABLE:NOFILTER) ;N I F I=1:1:1000 R *A:1 Q:'$T W $C(0,0,0,0,0,0,0,0,0) W "UM"_$C(0,4,0,0,0,0,0,0) ;-- UNTOUCH ;;S ^A=$G(^A)+1,^A(^A)=$$POS^P1CRDTCH I POS="?" D .U %PRT D REST^%L3MBGG Q WAIT ; S POS=$$POS^P1CRDTCH I POS="?" D Q .S %PRT=$P U %PRT .D SAVE^%L3MBGG .W #!!!!!!!!!!!?36,"WAIT ..." ; Q %L1RR %L1RR ;DJM;MSM: ROUTINE RESTORE; [ 11/01/93 1:23 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. (c) 1985 S $ZT="S zr=$R "_^ZT_"ZG "_$ZL_":ERR^%L1RR",NAME=" ROUTINE ",ZAP=0 W %ENG ; --- W !?10,$C(27,91,55,109)," ",$$^%L1ZU(0)," ",$C(27,91,48,109)," ",$P($P($ZV,","),"-")," - Routine Restore Utility " D IN^%SDEV Q:$D(QUIT) INT ; Bypass device selection, %DEV=input dev, must be already open S %TAP=%DEV>46&(%DEV<51) S (%RNUM,%C,%S,QUIT)=0,%SEQ=1 D:%TAP %SET^%MTCHK U %DEV R %TIME,%CMT G:%TIME="" L4 I %TIME?1"DISK#"1N.N S %TIME=%CMT R %CMT U 0 W !,"Routine(s) saved at ",%TIME,!,"Header comment is: ",%CMT L1 U 0 R !,"Selective restore? (allows rename) : ",%RT I %RT="" W "NO" S %RT=1 G L2 ; --- S %FNN=$P(%FN,".")_"."_$E($P(%FN,".",2),1,2)_"#" U %DEV D:$$^%L1ZOS(10,%FNN)'>0 DIR^%L1RGR1 G:$$^%L1ZOS(10,%FNN)>0 ZAP U 0 ; --- I $E("YES",1,$L(%RT))=%RT W $E("YES",$L(%RT)+1,3) S %RT=0 G L2 I $E("NO",1,$L(%RT))=%RT W $E("NO",$L(%RT)+1,2) S %RT=1 G L2 I $E("yes",1,$L(%RT))=%RT W $E("yes",$L(%RT)+1,3) S %RT=0 G L2 I $E("no",1,$L(%RT))=%RT W $E("no",$L(%RT)+1,2) S %RT=1 G L2 G:%RT="^"!(%RT="^Q") EXIT I %RT'="?" W *7," ??" G L1 W !,?5,"If you chose selective restore (reply YES), you will be prompted" W !,?5,"for each routine. You must then respond to each prompt to restore" W !,?5,"the routine, possibly with a different name." W !,?5,"Enter NO to restore all routines that were saved." W !,?5,"Enter ^ to exit without restoring any routines.",! G L1 L2 I %RT U 0 W !,"Restoring...",! S $ZT="S zr=$R "_^ZT_"ZG "_$ZL_":ERR1^%L1RR" F %I=1:1 U %DEV R %RN Q:%RN="" D:%RN="*EOF*" NEXTFILE Q:QUIT D RESTORE Q:QUIT I 'QUIT,%TAP U %DEV I @(%MTTMK_"=0") W *12 L4 U 0 W !!,%RNUM," Routine",$S(%RNUM=1:"",1:"s")," restored." I $D(%DEV),%DEV>58,%DEV<63 U %DEV S %RN=$ZA U 0 W !,"Last block read in: ",%RN EXIT ; I $D(%DEV) I %DEV'=$P C %DEV C 63 I $D(%TAP) D:%TAP %KILL^%MTCHK K %DEV,%I,%RN,%RNN,%RR,%RNUM,%RT,%PCODE,%SBP,%S,%C,%RC,%FN,%SEQ,%SIZE,%X,%ZA,QUIT,%TAP,%TIME,%CMT Q RESTORE ; I %RT S %RNN=%RN G R1 U 0 W !,"Routine: ",$P(%RN,":"),?19 S %RNN=%RN I ZAP,R'[%RN U 0 W *7," ERROR !!! ",*7 H 1 W *7 Q ; --- I %S G:%RC]%RN R0 S %S=0 I %C G:%RC]%RN R1 S %C=0 R "Restore (Y/N/R/S/C) ? ",*%RR S:%RR>96&(%RR<123) %RR=%RR-32 I %RR=13 S %RR=78 W "N" G R1:%RR=89,R0:%RR=78,R3:%RR=82,R5:%RR=83,R7:%RR=67 I %RR=94 S QUIT=1 Q I %RR'=63 W *7," ??" G RESTORE W !!,"Enter 'Y' to restore the routine using the same name." W !,"Enter 'N' to bypass restoring this routine." W !,"Enter 'R' to restore the routine and rename it." W !,"Enter 'S' to skip without restoring up to a specified routine." W !,"Enter 'C' to continue restoring without prompts up to a specified routine." W !,"Enter '^' to end the entire restore process.",! G RESTORE R0 D PCSKIP I %PCODE U %DEV F R %I Q:%I=""!$ZC U 0 W " --Not restored" W:%RT ! Q R1 ; I $ZN=$P(%RNN,":") U 0 W !," *** ",$ZN," cannot restore over itself" G R0 D PCZLOAD I %PCODE U %DEV X "ZL ZS @%RNN" S %RNUM=%RNUM+1 U 0 I %RT W:'(%RNUM-1#8) ! W ?%RNUM-1#8*10,%RNN Q W " --Restored" Q PCZLOAD I $P(%RN,":",2)="" S %PCODE=1 Q D ZLOAD Q R2 W !,?44,"R" R3 R "ename to: ",%RNN I %RNN=$ZN W !," *** Cannot restore ",$ZN," over itself",*7 G R2 I %RNN="?" W !,"Enter the new name under which to restore the routine,",!,"or '^' to return to the previous question." G R2 I $L(%RNN)<9,%RNN?1A.AN!(%RNN?1"%".AN) G R1 I %RNN="^" G RESTORE W *7," Invalid" G R2 R4 W !,?44,"S" R5 R "kip until: ",%RC I %RC="?" W !,"Enter the routine name where the skipping should stop,",!,"or '^' to return to the previous question" G R4 I $L(%RC)<9,%RC?1A.AN!(%RC?1"%".AN) S %S=1 G RESTORE I %RC="^" G RESTORE W *7," Invalid" G R4 R6 W !,?44,"C" R7 R "ontinue until: ",%RC I %RC="?" W !,"Enter the routine name where restoring should stop,",!,"or '*' to restore all remaining routines,",!,"or '^' to return to the previous question" G R6 I $L(%RC)<9,%RC?1A.AN!(%RC?1"%".AN) S %C=1 G RESTORE I %RC="^" G RESTORE I %RC="*" S %RT=1 W !,"Restoring...",! G RESTORE W *7," Invalid" G R6 ERR ; I $F($ZS,"") U 0 W !!,"...Aborted." G L4 Q ERR1 ; I $F($ZS,"") G ERRTAP I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q PCSKIP ; I $P(%RN,":",2)="" S %PCODE=1 Q N (%DEV,%RNN,%PCODE) S %ZERO=$C(0,0,0,0) I %DEV>50,%DEV<55 D SKIPHFS S %PCODE=0 Q I %DEV>58,%DEV<64 D SKIPSBP S %PCODE=0 Q I %DEV>46,%DEV<51 D SKIPTAP S %PCODE=0 Q U 0 W !!,"*** Cannot restore compiled routines through device #",%DEV,!,*7 W 1/0 Q SKIPHFS S %DLMS=24 D GETDLM U %DEV:(:::::"") D SKIPRTN U %DEV:(:::::%DLMS) Q SKIPSBP S %DLMS=20 D GETDLM U %DEV:(:::"":"V") D SKIPRTN U %DEV:(:::%DLMS:"S") Q SKIPTAP S %DLMS=44 D GETDLM U %DEV:("N":::"") D SKIPRTN U %DEV:(:::%DLMS) Q SKIPRTN F %X=1:1 R %BLK#1024 Q:$E(%BLK,1013,1016)=%ZERO Q:$ZC S %PCODE=0 Q ZLOAD N (%DEV,%RNN,%PCODE) S %RNN=$P(%RNN,":") X "ZR ZI %RNN_"" "" ZS @%RNN" ;create dummy routine S %BN=$ZBN(^ (%RNN)),%BNHDR=%BN,%PTR=#1000000 S %UI=$$^%L1ZU(0),%UI=$ZU($P(%UI,","),$P(%UI,",",2)),%VGI=$P(%UI,",",2),%UI=+%UI,UCITAB=$V($V($V(10,-5)+(%VGI*4))+20) S RP=$V(UCITAB+(%UI-1*32)+20,-3,2)*512 K UCITAB,%UI,%VGI O 63::0 E U 0 W !,"Waiting for device 63" O 63 G LOADHFS:%DEV>50&(%DEV<55),LOADSBP:%DEV>58&(%DEV<64),LOADTAP:%DEV>46&(%DEV<51) U 0 W !!,"*** Cannot restore compiled routines through device #",%DEV,!,*7 C 63 S %PCODE=1 Q LOADHFS S %DLMS=24 D GETDLM U %DEV:(:::::"") D XFER U %DEV:(:::::%DLMS) Q LOADSBP S %DLMS=20 D GETDLM U %DEV:(:::"":"V") D XFER U %DEV:(:::%DLMS:"S") Q LOADTAP S %DLMS=44 D GETDLM U %DEV:("N":::"") D XFER U %DEV:(:::%DLMS) Q XFER R %BLK#1024 XFER10 V 0:0:%BLK:1024:1 G:'$ZC XFER20:$V(1012,0,4) ;continuation block present S %BNTAB($V(1016,0,4))=%BN V 1016:0:%BN:4,-%BN,%BNHDR F %Z=18,24 S %X=$V(%Z,0,4),%Y=%X#%PTR,%X=%X\%PTR,%Y=%X*%PTR+%BNTAB(%Y) V %Z:0:%Y:4 V -%BNHDR C 63 S %PCODE=0 Q XFER20 ;there will be a continuation block S %BNX=$ZBN("",RP),%BNTAB($V(1016,0,4))=%BN V 1016:0:%BN:4,1012:0:%BNX:4,-%BN S %BN=%BNX G XFER GETDLM S %SV=$V(44),%SVA=%SV+$V(%SV+8,-3,2),%DDBTB=$V(%SVA+28),%DDB=$V(%DEV*4+%DDBTB) S %DLMS=$V(%DDB+%DLMS+1,-3,$V(%DDB+%DLMS,-3,1),1) Q ERRTAP U %DEV I @%MTTMK U 0 W !,"Unexpected tape mark encountered.",! G L4 U 0 W !,$ZS,!,"Tape status:" D %ERR^%MTCHK Q NEXTFILE ; G:%TAP NEXTTAPE C %DEV U 0 W !,"Sequence #",%SEQ," restored" W !,"Please put sequence #",%SEQ+1," into the drive and" S %SEQ=%SEQ+1 NEXTFIL1 R !,"Press when ready",%X I %X?1"?".E W !!,"Press to continue restoring from sequence #",%SEQ,!,"or abort the restore by entering 'control C'" G NEXTFIL1 O %DEV:%FN U %DEV I '$ZA R %X I '$ZC U 0 E W !!,"Cannot access ",%FN,", please correct" G NEXTFIL1 I %X?2NP1":"2N1" ".E S %X=1 I %X?1"DISK#"1N.N S %X=$P(%X,"#",2) I %X'=%SEQ W !!,"Out of sequence, this file is #",%X,", please correct" G NEXTFIL1 I %RT U 0 W !,"Restoring...",! U %DEV R %RN S QUIT=0 Q NEXTTAPE ; U 0 W !,"End of tape sequence number ",%SEQ," has been reached." W !,"After this tape rewinds, mount the next tape.",! S %SEQ=%SEQ+1 NT0 U %DEV W *16 U 0 NT1 W !,"Enter 'GO' when tape sequence number ",%SEQ R " is ready: ",%X I %X="?" W !,"Mount the next tape (sequence number ",%SEQ,") and enter 'GO' when it is ready.",!,"Or enter '^' to abort the restore.",! G NT1 I %X["^" S QUIT=1 Q I %X'="GO",%X'="go" W *7," ??" G NT1 U %DEV W *10 I @(%MTON_"=0") U 0 W *7,!,"Tape is not ready" G NT1 R %I,%RR S %X=$P(%I,%TIME_" (sequence ",2) I %X'?1.N1")" U 0 W !,"This is not a correct tape:",!,%I,!,%RR,! G NT0 G:+%X=%SEQ NT4 U 0 W !,"This is sequence number ",+%X,", not number ",%SEQ NT2 W !,"Do you want to proceed with number ",+%X R "? ",%I S:%I="" %I="N" I %I="?" W !,"Enter 'YES' to continue restoring with tape number ",+%X," instead of number ",%SEQ,!,"Enter 'NO' if you want to mount the correct tape",!,"Enter '^' to end the restore." G NT2 I %I["^" S QUIT=1 Q S %I=$ZB(%I,"_",1) I %I=$E("NO",1,$L(%I)) G NT0 I %I'=$E("YES",1,$L(%I)) W " ??" G NT2 S %SEQ=+%X NT4 I %RT U 0 W !,"Restoring...",! U %DEV R %RN S QUIT=0 Q Q ZAP ; K ^L1ADR($J) S ZAP=1 O %DEV:(%FNN:"R") U %DEV F R STR Q:STR="" S ^L1ADR($J,$P(STR,"|",2))=$P(STR,"|") C %DEV U 0 S %RT=0 S NAME=" ROUTINE " ; W !?5,"Routine : " R %ROU Q:%ROU="" I '$D(^L1ADR($J,%ROU)) W " No Routine...",*7 G Z D ^%L1RGR1 Q:%NAM="" Z S %RN=%NAM O %DEV:(%FN:"R":^L1ADR($J,%RN)) U %DEV R R ; I R'[%RN U 0 W *7," ERROR ",*7 H 1 W *7 D RESTORE I %RR'=94 S %NAM=$O(^L1ADR($J,%RN)) Q:%NAM="" G Z ; D RESTORE I %RR'=94 S %NAM=$O(^L1ADR($J,%RN)) S:%NAM="" %NAM=$O(^L1ADR($J,"")) G Z ; --- E D RESTORE I %RR'=94 S %NAM=$O(^L1ADR($J,%RN)) Q:%NAM="" G Z S GLO=%NAM D PROG^%L1RGR1 Q:%NAM="" G Z W *27,"["_(LIN+2)_";"_(COL-1*10+1)_"H" D WRIN^%L1RGR1,MAIN^%L1RGR1 Q:%NAM="" G Z Q %L1RS %L1RS ;DJM;ROUTINE SAVE; [ 20.07.26 18:07 ] [ 05.03.21 12:43 ] [ 21.05.03 17:01 ] SELECT ; I $D(^%L1SAVE($J,"NAME")) S NAME=^("NAME"),ANS=2 K %ZR G S21 U $P R !!,"SAVE DATE - 1, SAVE SET - 2 , SAVE NORMAL - 3 : ",ANS Q:ANS="" I ANS'=1,ANS'=2,ANS'=3 W *7," ???" G SELECT I ANS=3 K %ZR G RO1 G:ANS=2 S2 ; F R !!,"HOW MANY DAYS:",NDAY Q:NDAY="" Q:NDAY?1N.N W *7," ???" G:NDAY="" SELECT S N=$H-NDAY-1 K %ZR S %ZR=0 F S N=$O(^%ERGS(N)) Q:N="" S N1="" F S N1=$O(^%ERGS(N,N1)) Q:N1="" D .I $E(N1)'="^",N1'["." S %ZR(N1)="" RO S N1="" F S N1=$O(%ZR(N1)) Q:N1="" S %ZR=%ZR+1 U $P W !!?30,$$^%L1ZU(0),!! I $D(%ZR)>9 S %ZR0=$G(%ZR) S %ZR="?D" D help^%RSEL W ! S %ZR=%ZR0 Q:'$D(%ZR) RO1 U $P W ! D . n ctrap,exp s ctrap=$C(3),exc="zg "_$zl_":EXIT^%RO" . i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RO") . n ename,fl,l,lc,out,r,rn,rf,src,x,y,t1,%ZC,%ZD,%ZH . s (fl,lc,r)=0,out=1 . d main Q ; S2 K %ZR R !!," NAME :",NAME S %ZE=".m" D init^%RSEL I NAME="?" D G S2 .S (N,N0)="%RS" F I=1:1 S N=$O(^SHP(N)) Q:N="" Q:N'[N0 W !,$P(N,N0,2)," ",$G(^(N)) I '(I#18) R "<>",Y Q:Y="." I '$D(^SHP("%RS"_NAME)) W *7," -- NOT EXIST !!! " G S2 S21 S N="" F S N=$O(^SHP("%RS"_NAME,N)) Q:N="" S %ZR=$G(^(N)) Q:%ZR="" S rd=0 D work^%RSEL G RO ; main s %ZR="" d CALL^%RSEL i %ZR=0 w !,"No routines selected" q f d q:$l(%ZD) . r !,"Output device: : ",%ZD,! . i '$l(%ZD) s %ZD=$p q . i $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/"_$E(%ZD,2,255) . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for output" . . w !,"If you wish to exit enter a carat (^)",! . . s %ZD="" . W "%ZD="_%ZD,! . i $zparse(%ZD)="" w " no such device" s %ZD="" q . o %ZD:(newversion:recordsize=2**20:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" i 'fl d . r !,"Header Label: ",%ZH . r !,"Strip comments ?: ",%ZC . i $l(%ZC),"\YES"[("\"_$tr(%ZC,"yes","YES")) s %ZC=0 . e s %ZC=1 w ! d work^%RO q %L1RSAND %L1RSAND ;CDS;ROUTINE SEARCH; [ 05/06/99 8:54 AM ] [ 11/18/92 10:00 AM ] ;Copyright Micronetics Design Corp. @1984 ;ONE OR MORE STRINGS MAY BE SELECTED ;A PROGRAM IS NOTED IF ANY OF THE STRINGS ARE FOUND IN IT N (%LF) S %LF=0 ; DON'T USE LABELS IN DISPLAY INT ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERROR^%L1RSAND" W !?10,$P($P($ZV,","),"-")," - ","Routine Search Utility",!?16,$ZD($H,"DD/MM/YY") S %FLG=0 K %DEV ASK1 U 0 K QUIT D INT^%RSEL I $D(QUIT) W:'%FLG !,"No routines selected" G EXIT S %FLG=1,%ST=0 ASK2 U 0 W !!,"Search for any of the following..." ASK3 R !,"Search string: ",%X I %X="",'$D(%SE(1)) G ASK1 I %X'="" S %ST=%ST+1,%SE(%ST)=%X G ASK3 I $D(%DEV) C:%DEV'=$I %DEV D CRT^%SDEV G:$D(QUIT) EXIT W !! U 0 I %DEV'=$I U %DEV W:$Y # U %DEV W !,?22,"Routine search " D ^%D W !,?24,"of ",$$^%L1ZU(0),?38 D ^%T W !,?18,"search for any of the following:",! F %I=1:1:%ST W ?(33-($L(%SE(%I))\2)),%SE(%I),! S %LK="F %I=1:1 S %T=$T(+%I) Q:%T="""" S:$A(%T)'=32 %LA=$P($P(%T,"" ""),""(""),%LI=-1 S %LI=%LI+1 X %LK1 I %OK X %WR S %F=%F+1" S %LK1="S %OK=1 F %J=1:1:%ST I %T'[%SE(%J) S %OK=0 Q" I '%LF S %WR="W !,%CC,""+"",%I-1,"": "",%T" I %LF S %WR="W:'%F !!,%CC W !,%LA W:%LI ""+"",%LI W "": "",%T" S %ZL="ZL @%CC U 0 X:%DEV'=$I ""W:'(%K-1#8) ! W ?(%K-1)#8*10,%CC,"""" """""" U %DEV S %LI=0,%LA="""" X %LK" RSEL ; S %CC="",%PCT=0,%FND=0,%F=0 RSEL1 ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":RSEL2^%L1RSAND" F %K=1:1 S %CC=$O(^UTILITY($J,%CC)) Q:%CC="" X %ZL S %PCT=%PCT+1 S:%F %FND=%FND+1,%F=0 W !!,?5,%PCT," Routine",$S(%PCT=1:"",1:"s")," processed, string(s) found in ",$S('%FND:"none",1:%FND)," of them." U 0 I %DEV'=$I U %DEV W !# K %SE S %ST=0 G ASK2 RSEL2 ; I $F($ZS,"") W !,"Routine: ",%CC," not found." G RSEL1 G ERROR EXIT ; U 0 I $D(%DEV),%DEV'=$I C %DEV K %,%BLK,%CC,%DEV,%F,%FLG,%FND,%LK,%I,%J,%K,%PCT,%SE,%ST,%T,%X,QUIT Q ERROR ; I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT Q L S %LF=1 ; USE LABEL+OFFSET IN DISPLAY G INT %L1RSDOS %L1RSDOS ;service@greystone.com ESM %RO;19920722 07:40;routine output [ 20.07.26 07:36 ] [ ;last modified by R. Partridge ;invoke ^%RO to get interaction ;invoke CALL^%RO with %ZR - routine array, ;%ZC - strip comments, %ZD - device, %ZH - header label ; w !,"Routine Output - Save selected routines into RO file.",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RO") n ename,fl,l,lc,out,r,rn,rf,src,x,y,t1,%ZC,%ZD,%ZH,%ZR s (fl,lc,r)=0,out=1 d main q ; CALL n ename,fl,l,lc,out,r,rn,rf,src,x,y,t1 n:'$d(%ZC) %ZC n:'$d(%ZD) %ZD n:'$d(%ZH) %ZH s %ZC=$g(%ZC,1),%ZD=$g(%ZD,$p),%ZH=$g(%ZH),(fl,lc,r,out)=0 o %ZD:(newversion):0 e q i $d(%ZR)<10 d CALL^%RSEL q:$d(%ZR)<10 d work q ; FL w !,"First Line Lister",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RO") n ename,fl,l,lc,out,r,rf,rn,src,x,y,t1,%ZC,%ZD,%ZH,%ZR s (lc,r)=0,(%ZC,fl,out)=1,%ZH="Routine First Line Lister Utility" d main q ; main s %ZR="" d CALL^%RSEL i %ZR=0 w !,"No routines selected" q f d q:$l(%ZD) . r !,"Output device: : ",%ZD,! . i '$l(%ZD) s %ZD=$p q . i $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/"_$E(%ZD,2,255) . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for output" . . w !,"If you wish to exit enter a carat (^)",! . i $zparse(%ZD)="" w " no such device" s %ZD="" q . o %ZD:(newversion:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" i 'fl d . r !,"Header Label: ",%ZH . r !,"Strip comments ?: ",%ZC . i $l(%ZC),"\YES"[("\"_$tr(%ZC,"yes","YES")) s %ZC=0 . e s %ZC=1 w ! d work q ; work i '$l(%ZH) s %ZH="%RO Routine Output Utility" u %ZD w $zd($h,"12:60 DD-MON-YEAR"),$C(13,10),$C(13,10) u $p s %ZR="" f s %ZR=$o(%ZR(%ZR)) q:'$l(%ZR) d out i 'fl u %ZD w $C(13,10) u $p i out d . w !!,"Total of ",lc," line",$s(lc=1:"",1:"s") . w " in ",r," routine",$s(r=1:".",1:"s."),!! c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; out s rf=%ZR(%ZR)_$tr($e(%ZR),"%","_")_$e(%ZR,2,9999)_".m" o rf:(readonly:rewind:exception="g rnoopen") u rf:exception="g reof" r x s rn=$p($p($p(x,$c(9))," "),"(") d frmt i $tr(rn,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")'=%ZR s rn=%ZR i %ZD'=$p u $p w:$x>70 ! w %ZR,?$x\10+1*10 s r=r+1,lc=lc+1 s:x="" x=rn u %ZD w rn,$C(13,10),x,$C(13,10) ; warning - loop terminated by an execption i 'fl f u rf r x d frmt i $l(x) u %ZD w x,$C(13,10) s lc=lc+1 f u rf r x d frmt q:x'?.E1";".E1.A.E u %ZD w x,$C(13,10) s lc=lc+1 u %ZD w $C(13,10) c rf q ; reof u %ZD w $C(13,10) c rf rnoopen i $zs'["EOF" w !,$p($zs,",",2,999),! q frmt i '%ZC s t1=0 d ;strip comments . f s t1=$f(x,";",t1) q:'t1 i $l($e(x,1,t1),"""")#2 d q . . i $e(x,t1)'=";" s x=$e(x,1,t1-2) i '$l(x) s x=" " q i $e(x)=";" s x=" "_x ;if lonely comment, provide ls s t1=0 f s t1=$f(x,$c(9),t1) q:'t1 d ;convert s to spaces . s x=$e(x,1,t1-2)_$j("",8-(t1-2#8))_$e(x,t1,9999) f t1=$l(x):-1:0 q:$e(x,t1)'=" " ;strip trailing spaces s x=$e(x,1,t1) q ; ERR u $p w !,$p($zs,",",2,99),! s $ec="" ; Warning - Fall-though EXIT i $d(%ZD),%ZD'=$p c %ZD i $d(rf) c rf u $p:(ctrap="":exc="") q %L1RSE %L1RSE ;GT.M %RSE utility - find every occurrence of a string in one or more routines [ 10.09.07 16:31 ] [ 20.06.07 08:36 ] [ 19.11.05 18:47 ] [ ;invoke ^%L1RSE to get interaction ;invoke CALL^%L1RSE with %ZF - string to find, %ZR - routine array or name, %ZD a device to receive a trail ; n cnt1,cnt2,cnt3,flen,fnd,gtmvt,h,i,o,out,outd,p,r,rl,sx,tics,x,xn,%ZC,%ZD,%ZF,%ZR w !,"Routine Search for Every occurrence",! s %ZC=0,(cnt1,cnt2,cnt3)=0,(out,outd)=1 i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%L1RCE" u $p:(ctrap=$c(3):exc="zg "_$zl_":LOOP^%L1RCE") d MAIN^%L1RCE u $p:(ctrap="":exc="") q CALL i '$l($g(%ZF)) q n %ZC,cnt1,cnt2,cnt3,flen,fnd,gtmvt,h,i,o,out,outd,p,r,rl,sx,tics,x,xn n:'$d(%ZD) %ZD s %ZD=$g(%ZD),(%ZC,cnt1,cnt2,cnt3,out)=0,outd=$l(%ZD) i $d(%ZR)<10 d ^%L1RSEL ; CALL^%RSEL d WORK^%L1RCE q JSP N %JSP D JSPDIR G %L1RSE JSPDIR S %JSP=$$WEBL^W3MAIN Q %L1RSE0 %L1RSE ;CDS;ROUTINE SEARCH; [ 02/11/99 10:40 PM ] [ 11/18/92 10:00 AM ] ;Copyright Micronetics Design Corp. @1984 ;ONE OR MORE STRINGS MAY BE SELECTED ;A PROGRAM IS NOTED IF ANY OF THE STRINGS ARE FOUND IN IT ;------------------------------------------------------- ; INPUT: ^UTILITY($J, - PROGRAM LIST ; ^L1RSE($P, - FIND LIST ;------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1RSENP) S %LF=0 ; DON'T USE LABELS IN DISPLAY INT ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERROR^%L1RSE" I '$D(%L1RSENP) W !?10,$P($P($ZV,","),"-")," - ","Routine Search Utility",!?16,$ZHL(1,"dd-MON-yy")," ",$ZHL(2,"bh:mm P") S %FLG=0 K %DEV ASK1 I '$D(^UTILITY($J)),'$D(%L1RSENP) U 0 W !,"No routines selected" G EXIT S %FLG=1,%ST=0 K %SE N %N S %N="" F S %N=$O(^L1RSE($P,"F",%N)) Q:%N="" S %ST=%ST+1,%SE(%ST)=^(%N) I '$D(%SE) G EXIT I $D(%DEV) C:%DEV'=$I %DEV ;;D CRT^%SDEV G:$D(QUIT) EXIT S %DEV=$G(^L1RSE($P,"DEV")) I '$G(%DEV) S %DEV=$P I '$D(%L1RSENP) D .W !! U 0 I %DEV'=$I U %DEV W:$Y # .U %DEV W !,?22,"Routine search " D ^%D .W !,?24,"of ",$$^%L1ZU(0),?38 D ^%T .W !,?18,"search for any of the following:",! .F %I=1:1:%ST W ?(33-($L(%SE(%I))\2)),%SE(%I),! S %LK="F %I=1:1 S %T=$T(+%I) Q:%T="""" S:$A(%T)'=32 %LA=$P($P(%T,"" ""),""(""),%LI=-1 S %LI=%LI+1 F %J=1:1:%ST I %T[%SE(%J) X:'$D(%L1RSENP) %WR S %F=%F+1 Q" I '%LF S %WR="W !,%CC,""+"",%I-1,"": "",%T" I %LF S %WR="W:'%F !!,%CC W !,%LA W:%LI ""+"",%LI W "": "",%T" S %ZL="ZL @%CC U 0 X:%DEV'=$I&'$D(%L1RSENP) ""W:'(%K-1#8) ! W ?(%K-1)#8*10,%CC,"""" """""" U %DEV S %LI=0,%LA="""" X %LK" RSEL ; S %CC="",%PCT=0,%FND=0,%F=0 RSEL1 ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":RSEL2^%L1RSE" F %K=1:1 S %CC=$O(^UTILITY($J,%CC)) Q:%CC="" X %ZL S %PCT=%PCT+1 S:%F %FND=%FND+1,%F=0,^L1RSE($P,"O",%CC)="" S ^L1RSE($P,"FC")=%FND I '$D(%L1RSENP) D .W !!,?5,%PCT," Routine",$S(%PCT=1:"",1:"s")," processed, string(s) found in ",$S('%FND:"none",1:%FND)," of them." .I %DEV'=$I U %DEV W !# K %SE,%L1RSENP S %ST=0 U 0 Q RSEL2 ; I $F($ZS,"") W !,"Routine: ",%CC," not found." G RSEL1 G ERROR EXIT ; U 0 I $D(%DEV),%DEV'=$I C %DEV K %,%BLK,%CC,%DEV,%F,%FLG,%FND,%LK,%I,%J,%K,%PCT,%SE,%ST,%T,%X,QUIT Q ERROR ; I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q L S %LF=1 ; USE LABEL+OFFSET IN DISPLAY G INT %L1RSEL %L1RSEL ; [ 09.11.07 19:17 ] [ 08.11.07 13:16 ] [ 20.06.07 08:24 ] N A,I,N K ^l1rsel($J),%ZR F U $P W !!,$S($D(%JSP):"JSP FILE",1:"ROUTINE")_" SELECTOR : " R A Q:A="" D .I $D(%JSP) S A=$$FUNC^%LCASE(A) .I A="^D" D ^%RD Q .I A="?"!(A="^L") D Q ..W ! ..N N,I S N="" F I=1:1 S N=$O(%ZR(N)) Q:N="" D ...W N_$J("",8-$L(N))," " I '(I#8) W ! . .D SEL(A) Q ; S N="",I=0 F S N=$O(%ZR(N)) Q:N="" S I=I+1 S %ZR=I ;;W # ZWR %ZR k ^l1rsel($J) Q ; SEL(A) ; N DIR,A1,A2,D,I,N,%PR,%SH ; I A'["*",A'["-",A'[":" S DIR=$$EXIST(A) D:$L(DIR) Q .Q:A="" .S %ZR(A)=DIR_"/" U $P W " -- 1 ROUTINE SELECTED" Q ; I A["*",A'["-" D U $P W " -- "_%SH_" ROUTINES SELECTED" Q .S A1=A,%SH=0 .I $E(A1)="%" S $E(A1)="_" .I A1'["." S A1=A1_$S($D(%JSP):".jsp",1:".m") .S ZROU=$ZROUTINE I $D(%JSP) S ZROU=%JSP .F D=1:1:$L(ZROU," ") S DIR=$P(ZROU," ",D) D HIP ; I $E(A)="-" D .N A1 S %SH=0 .S A1=$E(A,2,200) . .I A1'="",$D(%ZR(A1)) K %ZR(A1) U $P W " -- 1 ROUTINE DE-SELECTED" Q . .I A1["*" D ..N A2 S A2="" .. ..I A1?1"*".E D Q ...S A2=$P(A1,"*",2) ...I A2="" K %ZR D Q ....U $P W " -- ALL ROUTINES DE-SELECTED" Q ...S N="" F S N=$O(%ZR(N)) Q:N="" I $E(N,$L(N)-$L(A2)+1,$L(N))=A2 K %ZR(N) S %SH=%SH+1 ...U $P W " -- "_%SH_" ROUTINES DE-SELECTED" Q .. ..I A1?.E1"*" D Q ...S A2=$P(A1,"*") ...I A2="" K %ZR D Q ....U $P W " -- ALL ROUTINES DE-SELECTED" Q ...S N="" F S N=$O(%ZR(N)) Q:N="" I $E(N,1,$L(A2))=A2 K %ZR(N) S %SH=%SH+1 ...U $P W " -- "_%SH_" ROUTINES DE-SELECTED" Q Q ; HIP ; N FLRS S FLRS="l1rsel."_$J I $$^%L1ZOS(10,FLRS)'<0 C FLRS:(DELETE) I A1="" Q ZSY "ls "_DIR_"/"_A1_" > "_FLRS D ^%L1F2G(FLRS,"^l1rsel($J)") S N="" F S N=$O(^l1rsel($J,N)) Q:N="" D .S %PR=$G(^(N)) .I %PR["/" S %PR=$P(%PR,"/",$L(%PR,"/")) .S %PR=$TR($P(%PR,$S($D(%JSP):".jsp",1:".m")),"_","%") .I $L(%PR) S %ZR(%PR)=DIR_"/",%SH=%SH+1 C FLRS:(DELETE) Q ; EXIST(%RO) ; N ZROU,D,OK S OK="" S ZROU=$ZROUTINE I $D(%JSP) S ZROU=%JSP I $E(%RO)="%" S $E(%RO)="_" I %RO'["." S %RO=%RO_$S($D(%JSP):".jsp",1:".m") F D=1:1:$L(ZROU," ") S DIR=$P(ZROU," ",D) D Q:OK .I $$^%L1ZOS(10,DIR_"/"_%RO)'<0 S OK=DIR Q OK %L1RSIS %L1RSIS(TIME) ; [ 02.01.08 12:09 ] [ 29.10.06 18:42 ] [ 31.05.06 14:59 ] N MAX,%WT S %WT=0 S MAX=19 S CARDONLY=+$G(^[^UCI("MGG")]PL("PSWCARD")) I $$^%L1ZU(0)="MLY" S CARDONLY=0 S SIS=$$READ(MAX,$G(^[^UCI("MGG")]PL("PSWCARD"))) I $L(SIS)=12 S SIS=+$E(SIS,3,10) I $L(SIS)=18 S SIS=+$E(SIS,6,13) Q SIS READ(MAX,CARDONLY) ; N %pn,J,S,TSTART,SIS S SIS="" S %pn=MAX X %levon U $P:(NOWRAP:NOECHO) S SIS="",%BEG=1 F J=1:1:MAX D READS Q:S=13!(S=27)!(S=0) D .I J=1 S TSTART=$P($H,",",2) .I S=8!(S=127),$L(SIS)>0 S SIS=$E(SIS,1,$L(SIS)-1) W $C(8)," ",$C(8) S J=J-2 Q .I S=8!(S=127),'$L(SIS) Q .S SIS=SIS_$C(S) W "*" ; I $$TCHONLY D .D PUT^%L1NMB .S %SAY="" X %XMSGN ; I $G(CARDONLY),$D(TSTART),$P($H,",",2)-TSTART>+$G(TIME),$E(SIS,$L(SIS))'="!" S %SAY=" ! cala qihxk " X %XMSGV(1) Q 0 I $E(SIS,$L(SIS))="!" S SIS=$E(SIS,1,$L(SIS)-1) I S=27!(S=0) D Q 0 .F R *S:0 Q:S=-1 ; I $ZB=27!(SIS="") Q "" I $E(SIS)=";"!($E(SIS)="s") S SIS=$E(SIS,2,255) I $P($G(^[^UCI("MGG")]PL("BF")),"<>")=$E(SIS) S SIS=$E(SIS,2,20) I $P($G(^[^UCI("MGG")]PL("BF")),"<>",2)=$E(SIS,$L(SIS)) S SIS=$E(SIS,1,$L(SIS)-1) Q SIS READS ; N %C I '$D(%WT) S %WT=.5 RS0 R *%C:%WT I %C>0 S S=%C,%WT=1 Q I $$TCHONLY D S:'$D(S) S=0 Q .K %L1NMB("ALB") S %L1NMB("ZY")=$G(%YY,23) .W *27,7 RS1 .S %NMB=7,S=$$^%L1NMB("") S %WT=$S($G(%PRKB):1,1:.1) K %PRKB .I S="ENTER" S S=13 G ERS1 .I S="ESC" S S=27 G ERS1 .I S="DEL" S S=8 G ERS1 .I $L(S)>1 G RS1 .S S=$A(S) ERS1 . .W *27,8 ; R *S S %WT=1 Q TCHONLY(STAM) ; I $$TCHONLY^%L2MOUSE&$G(^P1PRM("SISTCH")) Q 1 Q 0 %L1RTR %L1RTR ; SEND ROUTINES [ 10/22/92 6:31 AM ] N U 0 S PRT=$P ;S %HBR=$C(27,41,74) S %ENG=$C(27,41,76) S BUF=255 S SOT=$C(4),STX=$C(2),ETX=$C(3) S X1="S %LENGTH=1 U 0 W *7,!!,""*** A NODE TOO LENGTH :"",$R,!!,RT,!! K ^RTR000(PRT,RNAME)" K ^RTR000(PRT),^UTILITY($J) D ^%RSEL S RNAME="" F S RNAME=$O(^UTILITY($J,RNAME)) Q:RNAME="" D .S CHKS=0,%LENGTH=0 X "ZL @RNAME F II=1:1 S RT=$T(+II) Q:RT="""" X:$L(RT)>236 X1 Q:%LENGTH S CHKS=CHKS+$ZCR(RT,1) S ^RTR000(PRT,RNAME,II)=RT" .Q:%LENGTH S ^RTR000(PRT,RNAME,II)=$C(5)_$S($O(^UTILITY($J,RNAME))="":"END",1:"ENDR")_"*"_RNAME_"*"_II_"*"_CHKS_$C(6) I $D(^RTR000(PRT))<10 U 0 W !,"HASN'T ROUTINES FOR TRANSMISSION" Q ASK R !!,"I/O PORT? > ",PORTN G:PORTN="" EXIT I $P=PORTN!'PORTN W !!,"CANNOT SELECT YOUR OWN DEVICE.",*7 G ASK U $P:(CENABLE) O PORTN::0 E W *7,"..LINE IN USE..WAITING.." O PORTN W "READY" U PORTN I $ZB($ZA,2,1) U 0 W !,"DEVICE ",PORTN," IS AN OUTPUT ONLY DEVICE.",*7 G ASK INIT U PORTN:(0::::257) U 0 W ! ;B 0 S %DC=0 S %DT=0 P0 U PORTN W "AT"_$C(13) U PORTN R %Y:6 G:%Y[$C(1) EXIT S %CR=$ZB U 0 W:$L(%Y) %Y W:$T $C(%CR),! S %DT=%DT+1 I %Y'["OK" H 2 G:%DT<12 P0 U 0 W *7,!!,"NO CARRIER" G EXIT S %DT=0 P1 U PORTN W "ATS0=2"_$C(13) R %Y:6 G:%Y[$C(1) EXIT S %CR=$ZB U 0 W:$L(%Y) %Y W:$T $C(%CR),! S %DT=%DT+1 I %Y'["OK" H 2 G:%DT<12 P1 U 0 W *7,!!,"NO CARRIER" G EXIT U 0 R !!,"TELEFON NUMBER > ",NUMBER G:NUMBER="" EXIT W ! U PORTN S ST="ATDP"_NUMBER_$C(13) F I=1:1:$L(ST) W $E(ST,I) H 10 S OK=0 F I=1:1:20 R A:5 D Q:OK S ^A(I)=A U 0 W !,A U PORTN .I $F(A,"CONN") S OK=1 Q .I $F(A,"BUS") S OK=2 Q .I $F(A,"BUS") S OK=2 Q .I $F(A,"NO CAR") S OK=3 Q .I $F(A,"NO DIAL") S OK=4 Q I OK'=1 U 0 W !,A G EXIT I OK=1 K ^A U 0 W !!,"MODEM IN USE ! " S ER=0 U PORTN S RNAME="" F S RNAME=$O(^RTR000(PRT,RNAME)) Q:RNAME="" D Q:ER=10000 .U 0 W !,"--",RNAME,! S OKSND=0 D SETSTR G:ER>999 ERREND U 0 W !!,"******** TRANSMISSION SUCCESFUL **********",!! EXIT H 1 U PORTN W "ATH",$C(13) H 1 W "ATZ",$C(13) H 1 U PORTN I $D(PORTN),PORTN?1N.N C PORTN Q ;- ERREND ; U 0 W !!,"******** TRANSMISSION ERROR **********",!! I ER>1000 W !!,"*** END OF TRANSMISSION ***",! H 1 U PORTN W "+++",$C(13) H 1 C PORTN Q ;- SETSTR ; U PORTN:(0::::257) S ER=0 S N=-1 S N=$N(^RTR000(PRT,RNAME,N)) I N'=-1 D SET I ER=1000 K ^RTR000(PRT,RNAME) X "F III=1:1:200" I N>0,ER<1000 G SETSTR ENDP Q ;- SET S ER=0,CNER=0,CNER1=0,OK=1 S1 S STRR=^RTR000(PRT,RNAME,N) S STROUT=SOT_RNAME_"*"_(OKSND+1)_"*"_$L(STRR)_"*"_$ZCR(STRR,1)_STX_STRR S BCC=$ZCR($E(STROUT,2,255),1) S STROUT=STROUT_ETX_BCC F JJ=1:1:BUF R *Z:0 E Q W STROUT,$C(13) R ANS1:6 E S OK=0 S ER=3,CNER=CNER+1 D ER G:CNER<5 S1 S ER=10000 Q I BCC'=$P(ANS1,ETX,2) D S OK=0 G:ER=4 ENDST I ER=1000 D ERREND G ENDST .I $P($P(ANS1,STX,2),ETX)=($C(5)_"DOUBLE") K ^RTR000(PRT,RNAME,N) S ER=4 Q .I $P($P(ANS1,STX,2),ETX)=($C(5)_"SEQ") S ER=1000 Q .S ER=$P($P(ANS1,STX,2),ETX) I 'OK S CNER1=CNER1+1 D ER G:CNER1<20 S1 S ER=10000 Q S OK=1,OKSND=OKSND+1 U 0 W RNAME_"*"_(OKSND+1)_"*"_STRR,! U PORTN K ^RTR000(PRT,RNAME,N) ENDST ; U PORTN Q ;- ER U 0 W !,"ERR: ",ER,! U PORTN Q ;- DEB ZU 0 F J=1:1:$L(SS) W $$^%L1ZH($A($E(SS,J)))_" " ZU 0 W ! U PORTN Q %L1RTR1 %L1RTR1 ;RECEIVE PROGRAMMS VIA MODEM [ 05/23/99 5:29 PM ] [ 12/30/93 5:05 PM ] %L1RV %L1RV ; VIEW ROUTINES [ 20.04.07 13:44 ] [ 18.05.05 10:51 ] [ 08.08.03 11:06 ] N (%RNAME,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%Z,%S2V,%HBRY) D ^%L1C S $ZT="ZG "_$ZL_":ER" Z ;;W !,"UCI:" S (%S,%UCIOLD)=$$^%L1ZU(0),%LS=7 N L1RVZDIR S L1RVZDIR=$ZDIR M I '$D(%RNAME) D G:%RNAME="" END .I '$D(%W1JSP) W !!,"ROUTINES NAME : " .E W !!,"JSP FILE NAME : " .S %LS=20,%S="" D ^%ZMSL S %RNAME=%S D M1 G:'$D(%RNAME) M END K %RNAME S $ZDIR=L1RVZDIR Q ER U 0 W *7,$ZS," ???" G END ; M1 I '$D(%W1JSP),%RNAME'["." D GETS1(%RNAME) I $D(%W1JSP)!(%RNAME[".") D VW^%W1JSP(%RNAME) ERG u $P K U,L,R N $ZT s $ZT="" S %TIP="R" S %S2V("NOHB")="" d ^%S2VIEW Q RNOOPEN U $P W *7 W " ERROR !" Q ; GETS1(%RNAME) ; N (%RNAME,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%Z,%S2V,%FLI,TXT1,%HBRY) D ^%L1C s %R=$TR(%RNAME,"%","_")_".m" S %L1DIR=$$DIR^%L1ED(%R) I $L(%L1DIR),$E(%L1DIR,$L(%L1DIR))'="/" S %L1DIR=%L1DIR_"/" S %R=%L1DIR_%R ; o %R:(readonly:record=2048:rewind) S $ZT="G REOF" k ^TMPS111($J) S I=0 f u %R r X S I=I+1,^TMPS111($J,I)=X REOF ; c %R Q %L1SAVE %L1SAVE ; [ 10/23/95 8:13 PM ] U 0 W !!?30,"MADE INSTALL",! O 51:("CONFIG.MS_":"W") U 51 W "c:\msm\database.msm",! W "120 10 9 20 20 16",! W "CONFIBM.EXE",! W "ZCALL386.EXE",! C 51 K ^UTILITY($J),^%L1SAVE($J) U 0 W !!,"SAVE %L1INS...",! S ^%L1SAVE($J,"NAME")="IN",^%L1SAVE($J,"FN")="%L1INS" D ^%L1RS K ^UTILITY($J),^%L1SAVE($J) U 0 W !!,"SAVE %LLL...",! S ^%L1SAVE($J,"NAME")="L",^%L1SAVE($J,"FN")="%LLL" D ^%L1RS K ^UTILITY($J),^%L1SAVE($J) U 0 W !!,"SAVE %SSS..." S ^%L1SAVE($J,"NAME")="S",^%L1SAVE($J,"FN")="%SSS" D ^%L1RS Q %L1SAY %L1SAY ; [ 02/24/93 11:31 AM ] ER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 S %SAY=" " X %XMSGV Q %L1SC %L1SC ; [ 06.09.21 11:02 ] [ 15.03.19 12:52 ] [ 18.01.14 13:44 ] ; PARAMETRIM: ; %SCVA - ; %SCVG - ; %SCNC - ; %SC("OUT"),%SCO ; %SC("NOUT"),%SCN ; %SC("A") - ^%L1SC+VIEW ; %SCREF N %FNAME,%FNAMEOLD,NPG,PG,%FLINS ;;N $ZT S ZT=$ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ZT^%L1SC" S %L1SCBEG=1,%BS=0 S %FNAME="" S:'$D(FRST) FRST=1 S %FNAMEOLD=%FNAME N %MBG,%MSC S %MBG("OU")="" D SC2MBG ; N %HBRY S %HBRY="" N %L1SC S %L1SC=$G(^SCR(%SCRN)) I '$D(%SC("A")) S (%SCVA,%SCVG)=1 D A K %SCVA,%SCVG G F D A F K %SC("A") S %FNAME=%FNAMEOLD GF ;N %SCO,%SCN I $D(%SC("OUT")) S %SCO=%SC("OUT") ;I $D(%SC("NOUT")) S %SCN=%SC("NOUT") D GETF G:%BS!'$G(FRST) END ; ;I $D(%SCO) S %SC("OUT")=%SCO ;I $D(%SCN) S %SC("NOUT")=%SCN D GETFG S %TO="" G:%BS END ;GF END K %MSC,%MBG,%SC Q ; A Q:'$D(%SCRN) D .N N,N1 S N="" F S N=$O(^SCR(%SCRN,"P","NAME",N)) S N1=$TR(N,"""","") Q:N="" I $L(N1),$E(N1)?1A!($E(N1)="%"),$D(@N1)#2 S %L1SCA(N1)=@N1 N (%L1SCA,%SCRN,%SCNC,%SCVA,%SCVG,%SC,%L1SCBEG,%L1SCRG,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PG,NPG) D ^%L1C S HB=($G(^SCR(%SCRN))="H") N %L1SC S %L1SC=$G(^SCR(%SCRN)) S N="" F S N=$O(%L1SCA(N)) Q:N="" S @N=%L1SCA(N) ;;I %TYPCRT["VT" W $C(27,91),"1U" S %AI=$S(%TYPCRT["PC":"A",1:"AV") U $P:(NOECHO:NOWRAP) W *27,"[1;24r" W %vverxe ;;I $D(%SCNC),%TYPCRT["VT" W # D CLEAR I $D(%SCNC) N %L1RBCL S %L1RBCL="" D RBG K %L1RBCL W %vverxe X:'$D(%SCNC) %chista S %HBRY="" W %HBR F %I=1:1 Q:'$D(^SCR(%SCRN,%AI,%I)) D W ;;F %I=1:1 Q:'$D(^SCR(%SCRN,%I)) D W D:'$D(%SCVA) VA D RB I $D(^SCR(%SCRN,"G"))>9,'$D(%SCVG) D VG K %L1SCBEG,%L1SCA I $G(%SCRN)="P1HZ",$$^P1DELIS S %SAY="oiipa++3,13,HH" X %XMSG Q W I ^(%I)?." " W:'$D(%SCNC) %chists Q W $G(^(%I)) Q VG N %NMOLD,YOLD,SH,SHOLD,SCH,SCHOLD N Y1,X1,Y2,X2,XX0,RZD,COLG,VGR0,VGR2,RSCR,STEP,COLS,%S,%REFH1 S %L3MBG="" D GETFG K %L3MBG Q CLEAR N %PAR,N,%XX,%YY S %PAR="P" S N="" F S N=$O(^SCR(%SCRN,%PAR,"RB",N)) Q:N="" D .N Y1,Y2,X1,X2,I,J,I1 .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^(N),",",J) ;I %TYPCRT="VT220",I["Y" S @I=@I-1 .I $D(%SCNC) F I1=Y1:1:Y2 S %YY=I1-1,%XX=X1 X %POSIC W $J("",X2-X1-1) .Q Q RB N %PAR,N S %PAR="P" ; S N="" F S N=$O(^SCR(%SCRN,%PAR,"RB",N)) Q:N="" D .N Y1,Y2,X1,X2,I,J .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^(N),",",J) ;I %TYPCRT="VT220",I["Y" S @I=@I-1 .D RBUA .Q RBG I $D(^SCR(%SCRN,"G"))'>9 Q N %PAR S %PAR="G" ; N Y1,Y2,X1,X2,I,J S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^SCR(%SCRN,%PAR,"RB"),",",J) ;I %TYPCRT="VT220",I["Y" S @I=@I-1 D RBUA Q VA N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D SAY Q V Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) D:%NN'="" SAY F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D SAY Q V1 Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) D:%NN'="" SAY Q VP Q:%FNAME="" N %FNAME1,%I F %I=1:1:$L(%FNAME,",") S %FNAME1=$P(%FNAME,",",%I) I %FNAME1?."%"1U.E D .N %FNAME S %FNAME=%FNAME1 D V1 Q CA N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D C1,SAY Q C Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D C1,SAY Q:%NN="" Q C1 ; N %FNAME S %FNAME=^SCR(%SCRN,"P","NM",%NN) S @%FNAME="" I $D(%SCREF) D REF1^%L1SCR Q CANV N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D C1 Q:%NN="" Q CNV Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D C1 ;S @(^(%NN))="" Q KA N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" K @(^(%NN)) Q K Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) K:%NN'="" @(^SCR(%SCRN,"P","NM",%NN)) F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" K @(^(%NN)) Q NA N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" N @(^(%NN)) Q N Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) N:%NN'="" @(^SCR(%SCRN,"P","NM",%NN)) F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" N @(^(%NN)) Q GETF ; N END,NNN,NNN1,ISCR,OUT,%NM,%SCO,%SCN,%MOUSE S %TO="" I $D(%SC("OUT")) S %SCO=%SC("OUT") I $D(%SC("NOUT")) S %SCN=%SC("NOUT") S %BS=0,%ZMSF="" X %XCL I '$G(FRST),%FNAME'["," D ^%L1SCR S:$G(%TO)="END"!($G(%TO)="UP")!(%TO="HOME") %BS=1 K %L1GET Q U $P:(NOECHO:NOWRAP) I %FNAME["," N %FN S %FN=%FNAME N %FNAME D Q .F ISCR=1:1:$L(%FN,",") X %XCL K %TO S %FNAME=$P(%FN,",",ISCR),%FNAMEL=%FNAME,%ZMSF="" D ^%L1SCR D K %L1GET Q:%BS ..I $G(%TO)="HOME",ISCR'>1 S %TO="END" ..I $G(%TO)="HOME" S ISCR=0 Q ..I $G(%TO)="END"!($G(%TO)="UP") X "F ISCR=ISCR-1:-1:0 I ISCR>0 S %FNAME=$P(%FN,"","",ISCR),%FNAMEL=%FNAME D OUT Q:'OUT" S:ISCR'>0 %BS=1 Q:%BS S ISCR=ISCR-1 Q N %FNAMEND S:$D(%FNAME("END")) %FNAMEND=%FNAME("END") S NNN=$G(%FNAME),NNN1=0 I NNN'="" S NNN=^SCR(%SCRN,"P","NAME",NNN) S NNN1=NNN I NNN'="" S NNN=$O(^SCR(%SCRN,"P","NM",NNN),-1) N %FNAME F S NNN=$O(^SCR(%SCRN,"P","NM",NNN)) Q:NNN="" X %XCL S %FNAME=^(NNN),%FNAMEL=%FNAME,%ZMSF="" D ^%L1SCR D K %SC,%L1GET Q:%BS I $D(%FNAMEND) Q:%FNAME=%FNAMEND .I $G(%TO)="HOME",NNN=NNN1 S %TO="END" .I $G(%TO)="END"!($G(%TO)="UP") X "F S NNN=$O(^SCR(%SCRN,""P"",""NM"",NNN),-1) Q:NNN9 S %MBG("GWUL")=^SCR(%SCRN,"G","MAX"),%MBG("NOZAPR")=$G(^SCR(%SCRN,"G","NOZAPR")) G MBG S %MBG("=")="" I $D(%SC("NOEQ")) K %MBG("=") D SC2MBG S %MBG("STEP")=^SCR(%SCRN,"G","STEP") S %MBG("GWUL")=^SCR(%SCRN,"G","MAX") S %MBG("REF")=^SCR(%SCRN,"G","REF") S %MBG("RZD")=$G(^SCR(%SCRN,"G","RZD"),"\") S %MBG("VGR0")=$P(^SCR(%SCRN,"G","RB"),",") S %MBG("NGR")=$P(^SCR(%SCRN,"G","RB"),",",3) S %MBG("VGR")=^SCR(%SCRN,"G","VG") S %MBG("NOZAPR")=$G(^SCR(%SCRN,"G","NOZAPR")) I $D(^SCR(%SCRN,"G","RB")) D .N Y1,Y2,X1,X2,I,J .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^("RB"),",",J) .S %MBG("LL")=X1,%MBG("LR")=X2-1 .Q N II F II="GLOB","NLN","TOPB","VRB","CREAT","CHECK","NEW","DO","NS","RZDF","FNC" S %MBG(II)="" S %MBG("DELAS")="" I $D(^SCR(%SCRN,"G","DEL")) K %MBG("DELAS") N N F N=1:1 Q:'$D(^SCR(%SCRN,"G",N)) D .S %MBG("PAR",N)=^SCR(%SCRN,"G","NM",N)_" ;"_^SCR(%SCRN,"G",N,"SHEM")_";" .S $P(%MBG("O"),"\",N)=^SCR(%SCRN,"G","NM",N) .S CRD=^SCR(%SCRN,"G",N,"CRD"),TYP=^("TYP") .S %MBG("PAR",N)=%MBG("PAR",N)_$P(CRD,",",2)_";"_$S(+$P(CRD,",",5):$P(CRD,",",4,5),1:$P(CRD,",",4))_";"_$S(TYP["N":"E",1:TYP)_";"_$S(TYP="N":"0123456789.-+",1:"") .S %MBG("PAR",N)=%MBG("PAR",N)_"#@"_^SCR(%SCRN,"G",N,"MUMPS1")_"#"_^("MUMPS2")_"#"_$G(^("HELP")) .I $D(^SCR(%SCRN,"G",N,"OUTPUT")) S $P(%MBG("OU"),"\",N)="IN" .I $D(^SCR(%SCRN,"G",N,"MUST")) S $P(%MBG("NEW"),"\",N)="Y" .S:$G(^SCR(%SCRN,"G",N,"FNC"))?1U.E $P(%MBG("FNC"),"\",N)=^("FNC") .I $G(^SCR(%SCRN,"G",N,"GLOB"))'?.P S $P(%MBG("GLOB"),"\",N)=^("GLOB") D ..S:$G(^("NLN"))?1N.N $P(%MBG("NLN"),"\",N)=^("NLN") ..S:$G(^("TOPB"))?1N.N $P(%MBG("TOPB"),"\",N)=^("TOPB") ..S:$G(^("VRB"))?1U.E $P(%MBG("VRB"),"\",N)=^("VRB") ..S:$D(^("CREAT")) $P(%MBG("CREAT"),"\",N)="Y" ..S:$D(^("CHECK")) $P(%MBG("CHECK"),"\",N)=^("CHECK") ..S:$G(^("NS"))?1A.E $P(%MBG("NS"),"\",N)=^("NS") ..S:$D(^("RZD")) $P(%MBG("RZDF"),"\/",N)=^("RZD") .Q MBG ; S %MBG("LINE")="" K:$D(%SC("NOLINE")) %MBG("LINE") ;;S:$D(%SC("LINE")) %MBG("LINE")="" I $D(%L1SCBEG) D ^%L3MBG G MBG1 I '$D(%L1SCBEG) D BEG^%L3MBG MBG1 I $G(%TO)="END"!($G(%TO)="UP") S %BS=1 Q SAY D ^%L1SCSAY Q ZT D ^%ET K D ^%L1C Q RBUA ; INPUT X1,X2,Y1,Y2 ;;I %CVET W %LIGHT1,%CV("CF") D ^%L1RBUA X %XCL Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q SC2MBG ; I $D(%SC("UPDOWN")) S %MBG("UPDOWN")="" I $D(%SC("MOVE")) S %MBG("MOVE")="" I $D(%SC("DEL")) S %MBG("DEL")=%SC("DEL") I $D(%SC("LINE")) S %MBG("LINE")="" I $D(%SC("MIUN")) S %MBG("MIUN")="" I $D(%SC("OUG")) F II=1:1:$L(%SC("OUG"),",") I $P(%SC("OUG"),",",II)'="" S $P(%MBG("OU"),"\",^SCR(%SCRN,"G","NAME",$P(%SC("OUG"),",",II)))="IN" Q %L1SCA %L1SCA ; [ 15.03.19 11:21 ] [ 09/16/97 5:35 PM ] A I '$D(^SCR(%SCRN)) Q N HB S HB=0 S %AI=$S(%TYPCRT["PC":"A",1:"AV") X %chista,%XCL I $G(^SCR(%SCRN))="H" S HB=1 K ^SCR(%SCRN,%AI) N ST,ST1,SMB1,SMB2 F %I=1:1 Q:'$D(^SCR(%SCRN,%I)) D .;;S ST=$S(HB:$TR($TR(^(%I),%TES1,%TES2),%TEN,%THB),1:^(%I)) .S ST=$S(HB:$$W^%L1C(^(%I)),1:^(%I)) .I ST'["{",ST'["}",ST'["[",ST'["]",ST'["#" D W Q .S SMB1="{",SMB2="}" D FIG S SMB1="[",SMB2="]" D FIG .I ST["#" S %W1=0,ST1=$P(ST,"#") D S ST=ST1 ..F %II=2:1:$L(ST,"#") S %W1='%W1 S:%W1 ST1=ST1_%CLI_" "_$P(ST,"#",%II) S:'%W1 ST1=ST1_" "_$C(27,91,48,109)_$S($D(%CL0):%CL0,1:"")_$P(ST,"#",%II) .D W I $D(^SCR(%SCRN,"G","RB")) D .N Y1,Y2,X1,X2,I,J .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^("RB"),",",J) .I X2X2 S %ST2=%ST2_%A_" " .S $E(^SCR(%SCRN,%AI,^SCR(%SCRN,"G","VG")-1),X1,X2)=$S(%ST2'="":$E(%ST2,X1,X2),1:$TR($J("",X2-X1+1)," ","-")) .F %I=Y1+1:1:Y2-1 S $E(^SCR(%SCRN,%AI,%I-1),X1,X2)=$TR($E($G(^SCR(%SCRN,%AI,%I-1)),X1,X2),"\:"," ") .Q F %I=1:1 Q:'$D(^SCR(%SCRN,%AI,%I)) S ^SCR(%SCRN,%AI,%I)=$$ESC^%L1FRM(^SCR(%SCRN,%AI,%I),%I+1) Q W S ^SCR(%SCRN,%AI,%I)=ST Q FIG N P1,P2 F S P1=$F(ST,SMB1) S:'P1 P1=1000 S P2=$F(ST,SMB2) S:'P2 P2=1000 Q:P1+P2=2000 D .I P12):"N",1:"E") .S DL=$S($P(A,",",2)[":":$P($P(A,":",2),",",1,2),1:$P(A,",",2)_",0") .S PRM(I1)=PRM(I1)_TYP_","_DL_"*" I $L(PRM(I1))>1 S PRM(I1)=$E(PRM(I1),1,$L(PRM(I1))-1) S I1=2 S PRM(I1)="!*"_$G(%L1SCPC("EXCEL")) S I2=0,FLI=0,I3=0 S N="" F S N=$O(@GLOB@(N)) Q:N="" D .S A=$G(^(N)),SMB=$E(A,$L(A)),A1=$E(A,1,$L(A)-1) .I SMB="^" D Q ;-- TOP HEADER ..I '$D(%L1SCPC("EXCEL","NOSP1")) S A="?"_$$SP1^%L1FRM($$INVHBW^%L1FRM(A1)) ..I $D(%L1SCPC("EXCEL","NOSP1")) S A="?"_$$INVHBW^%L1FRM(A1) ..D SV1(A) . .I SMB="=" D Q ;-- BOTTOM HEADER ..I A1?.P1"-"."-".P S FLI=1-FLI Q ..S A2=$$SPA^%L1FRM($$INVHBW^%L1FRM(A1)) ..S A="&"_A2 ..I FLI,A1?.P1":".E1":".P S A="&&"_$TR(A1,":","*") ..D SV1(A) . .I SMB="!" D ;-- GROUP HEADER ..S I3=I3+1 ..S KOT(I3)="" S A2=$$SPA^%L1FRM(A) ..F J=2:1:$L(A2,":")-1 S KOT(I3)=$P(A2,":",J)_"*"_KOT(I3) . .I SMB="@" D SV2(A1) ; -- NORMAL LINE ; S %L1SCEX="" D ^%L1PCEX Q SV1(A) ; S I1=I1+1,PRM(I1)=A Q SV2(A) ; S I2=I2+1 S A2="" F J=1:1:$L(A,"*") S A2=$$SPA^%L1FRM($P(A,"*",J))_"*"_A2 S ^TREPK($P,I2)=$E(A2,1,$L(A2)-1) Q FRM ; N FLSHP,N,NEXT,A,A1,SMB S FLSHP=0 S N="" F S N=$O(@GLOB@(N)) Q:N="" D .S NEXT=$O(@GLOB@(N)) I NEXT'="" S NEXT=$G(^(NEXT)) .I $E(NEXT,1,$L(NEXT))="^" S NEXT=$E(NEXT,1,$L(NEXT)-1) .S A=$G(^(N)),SMB=$E(A,$L(A)),A1=$E(A,1,$L(A)-1) .I SMB="^" D Q ;-- TOP HEADER ..I A1?.P1"-".P,NEXT[%L1SCPC("EXCEL","DLM") S FLSHP=FLSHP+1 I FLSHP<3 K @GLOB@(N) Q ..I FLSHP=1 S @GLOB@(N)=$TR(A1,%L1SCPC("EXCEL","DLM"),":")_"!" ..I FLSHP=2 S @GLOB@(N)=$TR(A1,%L1SCPC("EXCEL","DLM"),"*")_"@" ..I FLSHP=3 S @GLOB@(N)=$TR(A1,%L1SCPC("EXCEL","DLM"),":")_"=" I $D(%L1SCPC("EXCEL","FF")) M %L2("FF",1)=%L1SCPC("EXCEL","FF") Q %L1SCH %L1SCH ; [ 08/20/93 1:05 PM ] ; T. VHODA: ; A - VISVETKA VSEGO ; IF '$D(%SCVA) - S VISV. PEREM ; ELSE - BEZ NIH ; IF '$D(%SCVG) - S VISV. GR. PEREM ; ELSE - BEZ NIH ; IF '$D(%SCNC) - CLEAR MASAH ; ELSE - NO CLEAR ; ; GF - VVOD VSEH PEREM BEZ PEREVISV. VSEGO EKRANA ; ; GETF - VVOD VSEH NEGRUP. PEREM BEZ PEREVISV. VSEGO EKRANA ; ; GETFG - VVOD VSEH GRUP. PEREM BEZ PEREVISV. VSEGO EKRANA ; ; VA - VISV VSEH NEGRUP. PEREM BEZ PEREVISV. VSEGO EKRANA ; ; VG - VISV VSEH GRUP. PEREM BEZ PEREVISV. VSEGO EKRANA ; ; V - VISV NEGRUP. PEREM NATH. S %FNAME BEZ PEREVISV. VSEGO EKRANA ; ; CA - CLEAR (="") VSEH NEGRUP. PEREM S VISV POLEJ ; ; C - CLEAR (="") NEGRUP. PEREM NATH. S %FNAME S VISV. POLEI ; ; CANV - CLEAR (="") NEGRUP. VSEH PEREM BEZ VISV. POLEI ; ; CNV - CLEAR (="") NEGRUP. PEREM NATH. S %FNAME BEZ VISV. POLEI ; ; KA - KILL NEGRUP. VSEH PEREM BEZ VISV. POLEI ; ; K - KILL NEGRUP. PEREM NATH. S %FNAME BEZ VISV. POLEI ;--------------------------------------------- ; VARIABLES: ; ; %MOLD : STAROE. ZNACENIE ; %SC("OUT") - SPISOK PEREM. CHEREZ (,) TOLKO DLQ VIVODA ; %SC("NOUT") - SPISOK PEREM. CHEREZ (,) - OTMENQET %SC("OUT") ;%SC("VIEW") - PRIZNAK PROSMOTRA ( VIZOV D A^%L1SC) ; $D(%L1SCBEG) - VISV 1-J STR. GRUP. VVODA ; %MBG: PERED VISV GRUP. POLEJ V SLUCHAE 2-H EKRANOV SDELAT K %MBG ; ; GLOBALS: ; ; ^TABLs(,"PROG") - PROGRAMM NAME , KOT. SOZDAET FILE ) %L1SCPC %L1SCPC ; [ 05.06.08 13:16 ] [ 27.04.08 12:49 ] [ 04.12.06 09:36 ] ; INPUT : 1) %SHP=%SCRN - SCREEN CODE or 2) %SCRN("SHP") or 3) %L1SCPC("SHP") ; %L1SCPC("MDP","B"), "N"), "R"), "PG") ,"GWPC") ; %L1SCPC("USTR") IF =2 - WRITE TO FILE =$S($D(%L1SCPC("FILE)):%L1SCPC("FILE"),1:"LEVPC") ; %L1SCPC("GLOB") - GLOBAL TO PRINT ; %L1SCPC("NOKDM") - BLI KIDUM NEJAR ; %L1SCPC("NIZ") - COMMAND BEFORE BOTTOM PARTITION PRINT ; %L1SCPC("ZLIST") IF $D - ASK FOR BEG. & END PAGE NUMBER ; %L1SCPC(1),...,%L1SCPC(97) <=> MAS(1) - MAS(97) ;--------------------------------------------------------------- ; PARAMETERS FOR ^%L2SHAP: ; INP: ; %L2("U") - $S($D(%L1SCPC("USTR)):%L1SCPC("USTR),1:%L1DEV) ; %L2("COD") - CODE OF HEADER FROM ^SHP ; %L2("SM") - LEFT OFFSET ; %L2("PC") - SIMAN OF PRINT ; %L2("RZ") - ":" - DELIMITER FOR GROUP MACKET ; %L2("!") - BLI FORM FEED LIFNEJ HADPASA ; OUT: ; %L2("RL") - PAGE SIZE ; %L2("PG1") - RIGHT MARGINE FOR GROUP REKVIZITS ; %L2("MP") - MACKET POSITIONS ;------------------------------------------------------- N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N LL,RR,%VAR,MAS,%POZ,%SUM,%M1,%M1,%M2,%STR,%PRPER,%PEND1,%ST,TS0,TSS,%L1LPT N %KNS,%SHL,%FF,%DLG,%DROB,%VV,%RZD,%RZ0,%VAR,%CHAST,%NR,%FRAZA N %K,%COLI,%IND,ZT,%USP,L1I,USTR,MAX,%L2,%I I $D(%L1SCPC("FILE")) S %NMF=%L1SCPC("FILE") I $D(%L1SCPC("ARX")) S %L1LPT("ARX")=%L1SCPC("ARX") I $D(%L1SCPC("SND")) S MAC1="%L1SCPC(""SND"")",MAC2="%L1LPT(""SND"")" D ^%S1GC1 I $D(%L1SCPC("EXCEL")),'$D(%L1SCPC("GLOB")) S %L1SCPC("GLOB")="^L1SCEX($P)" K @%L1SCPC("GLOB") ;I $D(%L1SCPC("GLOB")) K @%L1SCPC("GLOB") ;S %L1SCPC("NODT")="" N %RZD S %HBRY="" S %PRPER=0 S %RZD="&",%RZ0="\" D ^%L1TS S %USP="%SHL'<%BEGS&(%SHL'>%ENDS)" S %KNS=0,%SHS=1,MAS(98)=1,%SHL=1 F %I=1:1:97 I $D(%L1SCPC(%I)) S MAS(%I)=%L1SCPC(%I) G BEG ; X1 S LL=$E(^SHP(%L2("COD"),%SHS+%L2("VG")-1),1,%L2("LG2")),%POZ=0,%JJ=0 S %VV=LL ;D CX1 S RR=$E(^(%SHS+%L2("VG")-1),%L2("PG1")+1,%L2("PG2")) S %VV=RR ;D CX1 K %VV,%M1,%JJ Q ; CX1 S %POZ=$F(%VV,"&",%POZ) I %POZ S %JJ=%JJ+1 D G CX1 .S %VAR=$S($D(%M1)=0:$S($D(%M2(%JJ)):%M2(%JJ),1:" "),1:$S($D(%M1(%JJ)):%M1(%JJ),1:" ")) .S %VV=$E(%VV,1,%POZ-2)_%VAR_$E(%VV,%POZ+$L(%VAR)-1,255) Q ; PC ; ________________ N MAX,%J,%FF,%FRAZA,%DLG,%NR,%KSS,%KG ;---------------- FORMAT OF PRINT LINE S MAX=1 F %J=1:1 Q:'$D(%L2("FF",%NT,%J)) S:'$D(%M(%J)) %M(%J)="" D .S %FF=%L2("FF",%NT,%J) .I %FF["TP" S %FRAZA=%M(%J),%DLG=$P(%FF,",",2),%NR=%J K %CHAST(%J) D DELG S %M(%J)=%CHAST(%J,1) S:%KSS>MAX MAX=%KSS Q .I $P(%FF,",")="T",'%ENGLISH S %DLG=$P(%FF,",",2),%M(%J)=$J($E(%M(%J),$L(%M(%J))-%DLG+1,$L(%M(%J))),%DLG) S:'$D(MAX) MAX=1 Q .I $P(%FF,",")="T",%ENGLISH S %DLG=$P(%FF,",",2) D S %M(%J)=%MT_$J("",%DLG-$L(%MT)) S:'$D(MAX) MAX=1 Q ..S %MT=$E($$SPA^%L1FRM(%M(%J)),1,%DLG) .I $P(%FF,",")=9,$P(%FF,",",3)?1N S %DROB=$P(%FF,",",3) S %M(%J)=$S($P(%FF,",",$L(%FF,","))="S":$S(%M(%J)>0:"+",%M(%J)<0:"-",1:""),1:"")_$J(%M(%J),%DROB+1,%DROB) S:+%M(%J)=0 %M(%J)="-"_$J("",$P(%FF,",",2)\2-1) S %M(%J)=$J(%M(%J),$P(%FF,",",2)) Q .I $P(%FF,",")=9 S %M(%J)=$J(%M(%J),$P(%FF,",",2)) Q .Q S %KG=%J-1 ; I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D G ENDPC .S %ST="" F %J=1:1:%KG S %ST=%ST_$G(%M(%J))_"*" .S %ST=$E(%ST,1,$L(%ST)-1)_"@" .N IND S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 .S @%L1SCPC("GLOB")@(IND)=%ST ; S %KS=MAX I $G(%L2("RL")),%SHS+%KS+($D(%L2("MP",2))'=0)>%L2("RL") D PEREXL Q:'%PRPER I %SHL<%BEGS!(%SHL>%ENDS) S:%SHS %SHS=%SHS+%KS+($D(%L2("MP",2))'=0) G ENDPC ;------------------ PRINT LINE ---------------- S %SHS=%SHS+1 D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$J("",%L2("MP",%NT,1)-$L(%ST)-$L($G(%M(1)))-1) ;-- LEFT SPACE F %J=1:1:%KG S %ST=%ST_$G(%M(%J))_$J("",%L2("MP",%NT,%J)-$L(%ST)-$L($G(%M(%J)))) S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC ;----------------- PRINT WRAP LINES ------------ F I=2:1:%KS S %SHS=%SHS+1 D X1 S %ST=$J("",%L2("SM"))_LL D S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC .S %ST=%ST_$J("",%L2("MP",%NT,1)-$L(%M(1))-$L(%ST)-1) .F %J=1:1:%KG S %M(%J)="" S:$D(%CHAST(%J,I))#2 %M(%J)=%CHAST(%J,I) S %ST=%ST_%M(%J)_$J("",%L2("MP",%NT,%J)-$L(%ST)-$L(%M(%J))) .Q ENDPC K %CHAST,LL,RR,%KG,%KS,%NR,%DROB,M Q ;- PCPUST S %SHS=%SHS+1 I @%USP D PCPUST1 Q PCPUST1 ; D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC Q KAV ; D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$TR($J("",%PEND1-$L(%ST))," ","-")_RR D STPC Q STPC ; I $D(%L1SCPC("GLOB")) D D ^%L1STPC(%ST,%L1SCPC("GLOB"),"%L1SCPC(""MDP"")") Q .I $L(%ST)<79,$A($E(%ST))'<$A(" ") S %ST=%ST_$J("",79-$L(%ST)) D UDEV^%L1LPT(USTR) W $TR($TR(%ST,TS0,TSS),TS1,TSS) ;;I %ST["------" W *13,$TR($TR(%ST,TS0,TSS),TS1,TSS) I %ST'=%L1SCPC("MDP","PG") W ! Q ;- DELG ;------------ %FRAZA --> %CHAST(1-%KSS) LEFI %DLG N %I,%POZ I '$D(%NR) S %NR=1 S %I=0 G DELGEND1:$L(%FRAZA)'>%DLG DELGC F %POZ=$L(%FRAZA)-%DLG+1:1:$L(%FRAZA) G DLG1:".,:;?!- "[$E(%FRAZA,%POZ) S %I=%I+1,%CHAST(%NR,%I)="-"_$E(%FRAZA,$L(%FRAZA)-%DLG+2,$L(%FRAZA)),%FRAZA=$E(%FRAZA,1,$L(%FRAZA)-%DLG+1) G DELGEND1 DLG1 S %I=%I+1,%CHAST(%NR,%I)=$J($E(%FRAZA,%POZ,$L(%FRAZA)),%DLG) S %FRAZA=$E(%FRAZA,1,%POZ-1) DELGEND1 G:$L(%FRAZA)>%DLG DELGC S %KSS=%I+1,%CHAST(%NR,%KSS)=$J(%FRAZA,%DLG) Q ;- PEREXL ; I %SHL<%BEGS!(%SHL>%ENDS) G PRXL1 S %SHS1=%SHS+1 I $D(%L2("RL")) F %SHS=%SHS1:1:%SHS1+3 Q:%SHS'<%L2("RL") D PCPUST1 K %SHS1 D PPNS I '%PRPER S %L2("PC")="1N" D NSHAP^%L2SHAP I $$^%L1DISP(USTR),'$D(%L1SCPC("EXCEL")) R !," - jyndl, <.> - d`ivi",YYY#1 S:"./u?>"[YYY&$L(YYY) YYY="." X %chista S:YYY="." %PRPER=0 PRXL1 S %SHS=1 I '$$^%L1DISP(USTR),USTR'[".LP",USTR<51,'$D(%L1SCPC("GLOB")) H 10 I USTR[".LP" H 3 Q:'%PRPER I %SHL>%ENDS S %PRPER=0 Q I @%USLVIX Q D KAV S %ST=$J("`ad sca jynd",%PEND1) D STPC S %SHL=%SHL+1 S MAS(98)=%SHL S %NEXTS=$G(^SHP(%L2("COD"),1)) D PSHAP K %NEXTS,I Q ; KILL K %KODS,%PEND1,SHO,%NEXTS,PER,%POZ,LENGTH,%USLVIX,%SHPC K %L2,MAS,%KNS,%KSS,SSTR,L1I,%SHL,%BEGS,%ENDS,%SHS,TIPS,%STR,%CHAST K %L1SCPC I $G(USTR)=51 S USTR=2 Q ;- BEG ;----------------------- BODY -------------------------------- I $D(%L1SCPC("MDP","DAF")) S %ST=%L1SCPC("MDP","DAF") D STPC K L1I D IP I %PRVIX G ENMK ;-- %PRVIX - ERROR S %L2("U")=$S(USTR=$P:0,1:3) S %TIM=$ZD($H,"24:60") I '$D(%L1SCPC("NODT")) S %ST=" "_$$^%L1DC($H,1)_" "_%TIM_" "_$$^%L1DC($H,9)_" mei : dwtd zrye jix`z" D STPC S %KNS=0,%SHS=1 S %L2("PC")=0 D ^%L2SHAP I $$^%L1DISP(USTR),'$D(%L1SCPC("EXCEL")) S %L2("RL")=22 ;-- PARAMETERS DEFINING S %L2("!")=1 ;-- FIRST HEADER WITHOUT PROGON I $D(%L2("PG1")),$D(%L2("SM")) D ;--------- GROUP LINES .S %PEND1=%L2("PG1")-1+%L2("SM") S %PRPER=1 D PSHAP K %L2("!") D PCKBL I $D(%L2("PG1")) D PEREXL ;-- IF GROUP LINES FORM FEED IN PRINT FINISH ENMK ; I $D(%L1SCPC("NIZ")) X %L1SCPC("NIZ") I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D ^%L1SCEX(%L1SCPC("GLOB")) G ENDPROG I $D(%L1SCPC("GLOB")) D G ENDPROG .N IND S IND=$O(@%L1SCPC("GLOB")@(999999),-1)+1 .S @%L1SCPC("GLOB")@(IND)=$G(%L1SCPC("MDP","PG"))_$G(%L1SCPC("MDP","CUT"))_$G(%L1SCPC("MDP","PG")) I '$$^%L1DISP(USTR),$L($G(%L1SCPC("MDP","CUT"))) W %L1SCPC("MDP","PRG"),%L1SCPC("MDP","CUT") ;;I '$$^%L1DISP(USTR) S %ST=%L1SCPC("MDP","PG") D STPC D CDEV^%L1LPT(USTR) I '$D(%L1SCPC("GLOB")) S %DEV="USTR" S:$D(%L1SCPC("NOKDM")) %L1LPT("NOFF")="" D PRINT^%L1LPT I '$$^%L1DISP(USTR) D CDEV^%L1LPT(USTR) I '$D(%L1SCPC("GLOB")) S %DEV="USTR" S:$D(%L1SCPC("NOKDM")) %L1LPT("NOFF")="" D PRINT^%L1LPT I $$^%L1DISP(USTR),'$D(%L2("PG1")),'$D(%L1SCPC("EXCEL")) S %GET="<<" D N^%L1GET X %chista ENDPROG D KILL S:$D(ZT) $ZT=ZT Q ;-------------------------- END OF BODY ------------------------ ; IP ;---> %L2("RZ"),%L2("COD"), L1I("ZS") S %PRVIX=0 S %L2("RZ")=":" S @("L1I(""ZU"")="_%L1DEV) I $D(%L1SCPC("SMALL")) S %L1LPT("SMALL")="" I $D(%L1SCPC("SM")) S %L2("SM")=%L1SCPC("SM") K %L1LPT("DEV") I $D(%L1SCPC("USTR")) S L1I("ZU")=%L1SCPC("USTR") S %L1LPT("DEV")=%L1SCPC("USTR") S L1I("ZS")="" ;-------- WITHOUT QUESTION "FROM PAGE - TO PAGE" I $D(%L1SCPC("ZLIST")) K L1I("ZS") ;--- ASK "FROM PAGE TO PAGE" I $D(%SCRN) S %L2("COD")=%SCRN_"s" I $D(%SCRN("SHP")) S %L2("COD")=%SCRN("SHP")_"s" I $D(%L1SCPC("SHP")) S %L2("COD")=%L1SCPC("SHP")_"s" ;--- CODE FROM ^SHP D L1PCIN I $G(%MDPSUG) D .N %L1OUT D DEFMDP^%L1OUT(%MDPSUG) .N MAC1,MAC2 S MAC1="%L1OUT",MAC2="%L1SCPC" D ^%S1GC1 .I $G(%L1SCPC("MDP","GWPC")),%L1SCPC("MDP","GWPC")<80 S %L2("SM")=0 I '$D(%L1SCPC("MDP","B")) S %L1SCPC("MDP","B")=$C(27)_"W1" I '$D(%L1SCPC("MDP","N")) S %L1SCPC("MDP","N")=$C(27)_"W0" I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(13,12) ;;I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(12) I '$D(%L1SCPC("MDP","GWPC")) S %L1SCPC("MDP","GWPC")=80 I $D(%L1SCPC("NOKDM")),$G(%L1SCPC("MDP","PG"))[$C(12) S %L1SCPC("MDP","PG")=$C(10,10,10) S %USLVIX="%PRPER=0" Q ;- PSHAP ; S %L2("PC")="1V" PSHAP1 ; N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D .S MAS(%NN)=$G(@^(%NN)) .I $D(%L1SCPC(%NN))#2 S MAS(%NN)=%L1SCPC(%NN) .S CRD=$G(^SCR(%SCRN,"P",%NN,"CRD")) .I $P(CRD,",",3)["H" S MAS(%NN)=$E(MAS(%NN),$L(MAS(%NN))-$P(CRD,",",4)+1,255) .I $P(CRD,",",3)["E",%ENGLISH S MAS(%NN)=$E(MAS(%NN),1,$P(CRD,",",4)) S MAS(%NN)=MAS(%NN)_$J("",$P(CRD,",",4)-$L(MAS(%NN))) .I $P(CRD,",",3)="N",$P(CRD,",",5),'$D(%L1SCPC(%NN)) S MAS(%NN)=$J(MAS(%NN),2,$P(CRD,",",5)) D FSHAP Q FSHAP ; S %L2("PC")=$S(%SHL'<%BEGS&(%SHL'>%ENDS):"1V",1:0) D ^%L2SHAP S %NEXTS=$G(^SHP(%L2("COD"),1)) K PER Q Q SAY ; S V=^SCR(%SCRN,"P","NM",%NN) S CRD=^SCR(%SCRN,"P",%NN,"CRD") S TYP=^("TYP") I TYP="N" S VL=$G(@V) I $P(CRD,",",5)'>0 S VL=$J(VL,+$P(CRD,",",4)) ;- PCKBL ; ------------------------------------- K %SUM S %PRPER=1 Q:$D(^SCR(%SCRN,"G"))<10 S %REFG=$G(^SCR(%SCRN,"G","REF")) Q:%REFG="" S %RZDG=$G(^SCR(%SCRN,"G","RZD")) Q:%RZD="" I $E(%REFG)'="^" S %REFG="^"_%REFG I %REFG["(",%REFG'[")" S %REFG=%REFG_")" F %SHPC=1:1 Q:'$D(@%REFG@(%SHPC)) D .N %REFST S %REFST=^(%SHPC) .K %M ;;S %COLGG=$L(%REFST,%RZDG) .S %SCPCOK=1 I $D(%L1SCPC("USL")) X %L1SCPC("USL") Q:%SCPCOK=0 .I '%ENGLISH F %JII=1:1:$G(%L2("MP",1)) S %M(%L2("MP",1)-%JII+1)=$P(%REFST,%RZDG,%JII) .I %ENGLISH F %JII=1:1:$G(%L2("MP",1)) S %M(%JII)=$P(%REFST,%RZDG,%JII) .S %NT=1 D PC .I $D(%L2("MP",2)),$D(@%REFG@(%SHPC)) D ..S %COLGG=%L2("MP",1)+%L2("MP",2) ..I '%ENGLISH K %M F %JII=$G(%L2("MP",1))+1:1:%COLGG S %M(%COLGG-%JII+1)=$P(%REFST,%RZDG,%JII) ..I %ENGLISH K %M F %JII=$G(%L2("MP",1))+1:1:%COLGG S %M(%JII)=$P(%REFST,%RZDG,%JII) ..S %NT=2 D PC K %M D PCPUST S %PRPER=0 Q PPNS ; Q ; L1PCIN ; [ 05/28/92 2:43 PM ] ;L1I("ZU") ---> USTR,'$D(L1I("ZS")) --> %BEGS,%ENDS ; O USTR, U USTR I $D(%L1SCPC("EXCEL")) S USTR=0,%BEGS=1,%ENDS=999 G END I $D(%L1SCPC("GLOB")) S USTR=+$G(L1I("ZU")) G ZS ZU N $ZT S %PRVIX=0,$ZT="G M1^%L1SCPC" I '$D(L1I("ZU")) X %chista S %GET="3 - zqtcn , 0 - jqn ++1,60,HH#++1,E,I++03" D ^%L1GET S USTR=%S I "^."[USTR S %PRVIX=1,%EROP=1 G END I $D(L1I("ZU")) S USTR=L1I("ZU") S:$G(L1I("ZU"))=2 USTR=51 I $G(L1I("ZU"))>50,$G(L1I("ZU"))<54 O $S($D(%NMF):%NMF,1:"LEVPC"):APPEND G ZF I '$$^%L1DISP(USTR) S %DEV="USTR" D ^%L1LPT I %EROP K L1I("ZU"),%L1GET G ZU ZF N OTBS ; ZS S %BEGS=1,%ENDS=999 G:$D(L1I("ZS")) END U 0 W ! S %GET=":<1,999> sc cr,scn#8" D N^%L1GET S OTBS=%S S:OTBS="" OTBS="1,999" S %BEGS=$P(OTBS,","),%ENDS=$P(OTBS,",",2) G:%BEGS="." ZU S:%ENDS="" %ENDS=%BEGS I %BEGS'?1N.N!(%ENDS'?1N.N)!(%BEGS>%ENDS) W *7," *** ERROR !" G ZS D UDEV^%L1LPT(USTR) END ; Q M S %GET="3 - zqtcn , 0 - jqn ++1,60,HH#++1,E,I++03" D ^%L1GET S USTR=%S I "^."[USTR S %PRVIX=1 G END Q M1 U 0 W *7 S %SAY="! dpken `l zqtcn++0,50,HH,I" X %XMSG H 2 I '$$^%L1DISP($G(USTR)) D CDEV^%L1LPT K L1I("ZU") G ZU ER Q %L1SCPC0 %L1SCPC ; [ 04.05.08 12:27 ] [ 04.12.06 09:36 ] [ 09.11.06 14:06 ] ; INPUT : 1) %SHP=%SCRN - SCREEN CODE or 2) %SCRN("SHP") or 3) %L1SCPC("SHP") ; %L1SCPC("MDP","B"), "N"), "R"), "PG") ,"GWPC") ; %L1SCPC("USTR") IF =2 - WRITE TO FILE =$S($D(%L1SCPC("FILE)):%L1SCPC("FILE"),1:"LEVPC") ; %L1SCPC("GLOB") - GLOBAL TO PRINT ; %L1SCPC("NOKDM") - BLI KIDUM NEJAR ; %L1SCPC("NIZ") - COMMAND BEFORE BOTTOM PARTITION PRINT ; %L1SCPC("ZLIST") IF $D - ASK FOR BEG. & END PAGE NUMBER ; %L1SCPC(1),...,%L1SCPC(97) <=> MAS(1) - MAS(97) ;--------------------------------------------------------------- ; PARAMETERS FOR ^%L2SHAP: ; INP: ; %L2("U") - $S($D(%L1SCPC("USTR)):%L1SCPC("USTR),1:%L1DEV) ; %L2("COD") - CODE OF HEADER FROM ^SHP ; %L2("SM") - LEFT OFFSET ; %L2("PC") - SIMAN OF PRINT ; %L2("RZ") - ":" - DELIMITER FOR GROUP MACKET ; %L2("!") - BLI FORM FEED LIFNEJ HADPASA ; OUT: ; %L2("RL") - PAGE SIZE ; %L2("PG1") - RIGHT MARGINE FOR GROUP REKVIZITS ; %L2("MP") - MACKET POSITIONS ;------------------------------------------------------- N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N LL,RR,%VAR,MAS,%POZ,%SUM,%M1,%M1,%M2,%STR,%PRPER,%PEND1,%ST,TS0,TSS,%L1LPT N %KNS,%SHL,%FF,%DLG,%DROB,%VV,%RZD,%RZ0,%VAR,%CHAST,%NR,%FRAZA N %K,%COLI,%IND,ZT,%USP,L1I,USTR,MAX,%L2,%I I $D(%L1SCPC("FILE")) S %NMF=%L1SCPC("FILE") I $D(%L1SCPC("ARX")) S %L1LPT("ARX")=%L1SCPC("ARX") I $D(%L1SCPC("SND")) S MAC1="%L1SCPC(""SND"")",MAC2="%L1LPT(""SND"")" D ^%S1GC1 I $D(%L1SCPC("EXCEL")),'$D(%L1SCPC("GLOB")) S %L1SCPC("GLOB")="^L1SCEX($P)" K @%L1SCPC("GLOB") ;I $D(%L1SCPC("GLOB")) K @%L1SCPC("GLOB") ;S %L1SCPC("NODT")="" N %RZD S %HBRY="" S %PRPER=0 S %RZD="&",%RZ0="\" D ^%L1TS S %USP="%SHL'<%BEGS&(%SHL'>%ENDS)" S %KNS=0,%SHS=1,MAS(98)=1,%SHL=1 F %I=1:1:97 I $D(%L1SCPC(%I)) S MAS(%I)=%L1SCPC(%I) G BEG ; X1 S LL=$E(^SHP(%L2("COD"),%SHS+%L2("VG")-1),1,%L2("LG2")),%POZ=0,%JJ=0 S %VV=LL ;D CX1 S RR=$E(^(%SHS+%L2("VG")-1),%L2("PG1")+1,%L2("PG2")) S %VV=RR ;D CX1 K %VV,%M1,%JJ Q ; CX1 S %POZ=$F(%VV,"&",%POZ) I %POZ S %JJ=%JJ+1 D G CX1 .S %VAR=$S($D(%M1)=0:$S($D(%M2(%JJ)):%M2(%JJ),1:" "),1:$S($D(%M1(%JJ)):%M1(%JJ),1:" ")) .S %VV=$E(%VV,1,%POZ-2)_%VAR_$E(%VV,%POZ+$L(%VAR)-1,255) Q ; PC ; ________________ N MAX,%J,%FF,%FRAZA,%DLG,%NR,%KSS,%KG ;---------------- FORMAT OF PRINT LINE S MAX=1 F %J=1:1 Q:'$D(%L2("FF",%NT,%J)) S:'$D(%M(%J)) %M(%J)="" D .S %FF=%L2("FF",%NT,%J) .I %FF["TP" S %FRAZA=%M(%J),%DLG=$P(%FF,",",2),%NR=%J K %CHAST(%J) D DELG S %M(%J)=%CHAST(%J,1) S:%KSS>MAX MAX=%KSS Q .I $P(%FF,",")="T",'%ENGLISH S %DLG=$P(%FF,",",2),%M(%J)=$J($E(%M(%J),$L(%M(%J))-%DLG+1,$L(%M(%J))),%DLG) S:'$D(MAX) MAX=1 Q .I $P(%FF,",")="T",%ENGLISH S %DLG=$P(%FF,",",2) D S %M(%J)=%MT_$J("",%DLG-$L(%MT)) S:'$D(MAX) MAX=1 Q ..S %MT=$E($$SPA^%L1FRM(%M(%J)),1,%DLG) .I $P(%FF,",")=9,$P(%FF,",",3)?1N S %DROB=$P(%FF,",",3) S %M(%J)=$S($P(%FF,",",$L(%FF,","))="S":$S(%M(%J)>0:"+",%M(%J)<0:"-",1:""),1:"")_$J(%M(%J),%DROB+1,%DROB) S:+%M(%J)=0 %M(%J)="-"_$J("",$P(%FF,",",2)\2-1) S %M(%J)=$J(%M(%J),$P(%FF,",",2)) Q .I $P(%FF,",")=9 S %M(%J)=$J(%M(%J),$P(%FF,",",2)) Q .Q S %KG=%J-1 ; I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D G ENDPC .S %ST="" F %J=1:1:%KG S %ST=%ST_$G(%M(%J))_"*" .S %ST=$E(%ST,1,$L(%ST)-1)_"@" .N IND S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 .S @%L1SCPC("GLOB")@(IND)=%ST ; S %KS=MAX I $G(%L2("RL")),%SHS+%KS+($D(%L2("MP",2))'=0)>%L2("RL") D PEREXL Q:'%PRPER I %SHL<%BEGS!(%SHL>%ENDS) S:%SHS %SHS=%SHS+%KS+($D(%L2("MP",2))'=0) G ENDPC ;------------------ PRINT LINE ---------------- S %SHS=%SHS+1 D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$J("",%L2("MP",%NT,1)-$L(%ST)-$L($G(%M(1)))-1) ;-- LEFT SPACE F %J=1:1:%KG S %ST=%ST_$G(%M(%J))_$J("",%L2("MP",%NT,%J)-$L(%ST)-$L($G(%M(%J)))) S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC ;----------------- PRINT WRAP LINES ------------ F I=2:1:%KS S %SHS=%SHS+1 D X1 S %ST=$J("",%L2("SM"))_LL D S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC .S %ST=%ST_$J("",%L2("MP",%NT,1)-$L(%M(1))-$L(%ST)-1) .F %J=1:1:%KG S %M(%J)="" S:$D(%CHAST(%J,I))#2 %M(%J)=%CHAST(%J,I) S %ST=%ST_%M(%J)_$J("",%L2("MP",%NT,%J)-$L(%ST)-$L(%M(%J))) .Q ENDPC K %CHAST,LL,RR,%KG,%KS,%NR,%DROB,M Q ;- PCPUST S %SHS=%SHS+1 I @%USP D PCPUST1 Q PCPUST1 ; D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$J("",%PEND1-$L(%ST))_RR D STPC Q KAV ; D X1 S %ST=$J("",%L2("SM"))_LL S %ST=%ST_$TR($J("",%PEND1-$L(%ST))," ","-")_RR D STPC Q STPC ; I $D(%L1SCPC("GLOB")) D D ^%L1STPC(%ST,%L1SCPC("GLOB"),"%L1SCPC(""MDP"")") Q .I $L(%ST)<79,$A($E(%ST))'<$A(" ") S %ST=%ST_$J("",79-$L(%ST)) D UDEV^%L1LPT(USTR) W $TR($TR(%ST,TS0,TSS),TS1,TSS) ;;I %ST["------" W *13,$TR($TR(%ST,TS0,TSS),TS1,TSS) I %ST'=%L1SCPC("MDP","PG") W ! Q ;- DELG ;------------ %FRAZA --> %CHAST(1-%KSS) LEFI %DLG N %I,%POZ I '$D(%NR) S %NR=1 S %I=0 G DELGEND1:$L(%FRAZA)'>%DLG DELGC F %POZ=$L(%FRAZA)-%DLG+1:1:$L(%FRAZA) G DLG1:".,:;?!- "[$E(%FRAZA,%POZ) S %I=%I+1,%CHAST(%NR,%I)="-"_$E(%FRAZA,$L(%FRAZA)-%DLG+2,$L(%FRAZA)),%FRAZA=$E(%FRAZA,1,$L(%FRAZA)-%DLG+1) G DELGEND1 DLG1 S %I=%I+1,%CHAST(%NR,%I)=$J($E(%FRAZA,%POZ,$L(%FRAZA)),%DLG) S %FRAZA=$E(%FRAZA,1,%POZ-1) DELGEND1 G:$L(%FRAZA)>%DLG DELGC S %KSS=%I+1,%CHAST(%NR,%KSS)=$J(%FRAZA,%DLG) Q ;- PEREXL ; I %SHL<%BEGS!(%SHL>%ENDS) G PRXL1 S %SHS1=%SHS+1 I $D(%L2("RL")) F %SHS=%SHS1:1:%SHS1+3 Q:%SHS'<%L2("RL") D PCPUST1 K %SHS1 D PPNS I '%PRPER S %L2("PC")="1N" D NSHAP^%L2SHAP I $$^%L1DISP(USTR),'$D(%L1SCPC("EXCEL")) R !," - jyndl, <.> - d`ivi",YYY#1 S:"./u?>"[YYY&$L(YYY) YYY="." X %chista S:YYY="." %PRPER=0 PRXL1 S %SHS=1 I '$$^%L1DISP(USTR),USTR'[".LP",USTR<51,'$D(%L1SCPC("GLOB")) H 10 I USTR[".LP" H 3 Q:'%PRPER I %SHL>%ENDS S %PRPER=0 Q I @%USLVIX Q D KAV S %ST=$J("`ad sca jynd",%PEND1) D STPC S %SHL=%SHL+1 S MAS(98)=%SHL S %NEXTS=$G(^SHP(%L2("COD"),1)) D PSHAP K %NEXTS,I Q ; KILL K %KODS,%PEND1,SHO,%NEXTS,PER,%POZ,LENGTH,%USLVIX,%SHPC K %L2,MAS,%KNS,%KSS,SSTR,L1I,%SHL,%BEGS,%ENDS,%SHS,TIPS,%STR,%CHAST K %L1SCPC I $G(USTR)=51 S USTR=2 Q ;- BEG ;----------------------- BODY -------------------------------- I $D(%L1SCPC("MDP","DAF")) S %ST=%L1SCPC("MDP","DAF") D STPC K L1I D IP I %PRVIX G ENMK ;-- %PRVIX - ERROR S %L2("U")=$S(USTR=$P:0,1:3) S %TIM=$ZD($H,"24:60") I '$D(%L1SCPC("NODT")) S %ST=" "_$$^%L1DC($H,1)_" "_%TIM_" "_$$^%L1DC($H,9)_" mei : dwtd zrye jix`z" D STPC S %KNS=0,%SHS=1 S %L2("PC")=0 D ^%L2SHAP I $$^%L1DISP(USTR),'$D(%L1SCPC("EXCEL")) S %L2("RL")=22 ;-- PARAMETERS DEFINING S %L2("!")=1 ;-- FIRST HEADER WITHOUT PROGON I $D(%L2("PG1")),$D(%L2("SM")) D ;--------- GROUP LINES .S %PEND1=%L2("PG1")-1+%L2("SM") S %PRPER=1 D PSHAP K %L2("!") D PCKBL I $D(%L2("PG1")) D PEREXL ;-- IF GROUP LINES FORM FEED IN PRINT FINISH ENMK ; I $D(%L1SCPC("NIZ")) X %L1SCPC("NIZ") I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D ^%L1SCEX(%L1SCPC("GLOB")) G ENDPROG I '$$^%L1DISP(USTR),$L($G(%L1SCPC("MDP","CUT"))) W %L1SCPC("MDP","PRG"),%L1SCPC("MDP","CUT") ;;I '$$^%L1DISP(USTR) S %ST=%L1SCPC("MDP","PG") D STPC D CDEV^%L1LPT(USTR) I '$D(%L1SCPC("GLOB")) S %DEV="USTR" S:$D(%L1SCPC("NOKDM")) %L1LPT("NOFF")="" D PRINT^%L1LPT I '$$^%L1DISP(USTR) D CDEV^%L1LPT(USTR) I '$D(%L1SCPC("GLOB")) S %DEV="USTR" S:$D(%L1SCPC("NOKDM")) %L1LPT("NOFF")="" D PRINT^%L1LPT I $$^%L1DISP(USTR),'$D(%L2("PG1")),'$D(%L1SCPC("EXCEL")) S %GET="<<" D N^%L1GET X %chista ENDPROG D KILL S:$D(ZT) $ZT=ZT Q ;-------------------------- END OF BODY ------------------------ ; IP ;---> %L2("RZ"),%L2("COD"), L1I("ZS") S %PRVIX=0 S %L2("RZ")=":" S @("L1I(""ZU"")="_%L1DEV) I $D(%L1SCPC("SMALL")) S %L1LPT("SMALL")="" I $D(%L1SCPC("SM")) S %L2("SM")=%L1SCPC("SM") K %L1LPT("DEV") I $D(%L1SCPC("USTR")) S L1I("ZU")=%L1SCPC("USTR") S %L1LPT("DEV")=%L1SCPC("USTR") S L1I("ZS")="" ;-------- WITHOUT QUESTION "FROM PAGE - TO PAGE" I $D(%L1SCPC("ZLIST")) K L1I("ZS") ;--- ASK "FROM PAGE TO PAGE" I $D(%SCRN) S %L2("COD")=%SCRN_"s" I $D(%SCRN("SHP")) S %L2("COD")=%SCRN("SHP")_"s" I $D(%L1SCPC("SHP")) S %L2("COD")=%L1SCPC("SHP")_"s" ;--- CODE FROM ^SHP D L1PCIN I $G(%MDPSUG) D .N %L1OUT D DEFMDP^%L1OUT(%MDPSUG) .N MAC1,MAC2 S MAC1="%L1OUT",MAC2="%L1SCPC" D ^%S1GC1 .I $G(%L1SCPC("MDP","GWPC")),%L1SCPC("MDP","GWPC")<80 S %L2("SM")=0 I '$D(%L1SCPC("MDP","B")) S %L1SCPC("MDP","B")=$C(27)_"W1" I '$D(%L1SCPC("MDP","N")) S %L1SCPC("MDP","N")=$C(27)_"W0" I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(13,12) ;;I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(12) I '$D(%L1SCPC("MDP","GWPC")) S %L1SCPC("MDP","GWPC")=80 I $D(%L1SCPC("NOKDM")),$G(%L1SCPC("MDP","PG"))[$C(12) S %L1SCPC("MDP","PG")=$C(10,10,10) S %USLVIX="%PRPER=0" Q ;- PSHAP ; S %L2("PC")="1V" PSHAP1 ; N %NN S %NN="" F S %NN=$O(^SCR(%SCRN,"P","NM",%NN)) Q:%NN="" D .S MAS(%NN)=$G(@^(%NN)) .I $D(%L1SCPC(%NN))#2 S MAS(%NN)=%L1SCPC(%NN) .S CRD=$G(^SCR(%SCRN,"P",%NN,"CRD")) .I $P(CRD,",",3)["H" S MAS(%NN)=$E(MAS(%NN),$L(MAS(%NN))-$P(CRD,",",4)+1,255) .I $P(CRD,",",3)["E",%ENGLISH S MAS(%NN)=$E(MAS(%NN),1,$P(CRD,",",4)) S MAS(%NN)=MAS(%NN)_$J("",$P(CRD,",",4)-$L(MAS(%NN))) .I $P(CRD,",",3)="N",$P(CRD,",",5),'$D(%L1SCPC(%NN)) S MAS(%NN)=$J(MAS(%NN),2,$P(CRD,",",5)) D FSHAP Q FSHAP ; S %L2("PC")=$S(%SHL'<%BEGS&(%SHL'>%ENDS):"1V",1:0) D ^%L2SHAP S %NEXTS=$G(^SHP(%L2("COD"),1)) K PER Q Q SAY ; S V=^SCR(%SCRN,"P","NM",%NN) S CRD=^SCR(%SCRN,"P",%NN,"CRD") S TYP=^("TYP") I TYP="N" S VL=$G(@V) I $P(CRD,",",5)'>0 S VL=$J(VL,+$P(CRD,",",4)) ;- PCKBL ; ------------------------------------- K %SUM S %PRPER=1 Q:$D(^SCR(%SCRN,"G"))<10 S %REFG=$G(^SCR(%SCRN,"G","REF")) Q:%REFG="" S %RZDG=$G(^SCR(%SCRN,"G","RZD")) Q:%RZD="" I $E(%REFG)'="^" S %REFG="^"_%REFG I %REFG["(",%REFG'[")" S %REFG=%REFG_")" F %SHPC=1:1 Q:'$D(@%REFG@(%SHPC)) D .N %REFST S %REFST=^(%SHPC) .K %M ;;S %COLGG=$L(%REFST,%RZDG) .S %SCPCOK=1 I $D(%L1SCPC("USL")) X %L1SCPC("USL") Q:%SCPCOK=0 .I '%ENGLISH F %JII=1:1:$G(%L2("MP",1)) S %M(%L2("MP",1)-%JII+1)=$P(%REFST,%RZDG,%JII) .I %ENGLISH F %JII=1:1:$G(%L2("MP",1)) S %M(%JII)=$P(%REFST,%RZDG,%JII) .S %NT=1 D PC .I $D(%L2("MP",2)),$D(@%REFG@(%SHPC)) D ..S %COLGG=%L2("MP",1)+%L2("MP",2) ..I '%ENGLISH K %M F %JII=$G(%L2("MP",1))+1:1:%COLGG S %M(%COLGG-%JII+1)=$P(%REFST,%RZDG,%JII) ..I %ENGLISH K %M F %JII=$G(%L2("MP",1))+1:1:%COLGG S %M(%JII)=$P(%REFST,%RZDG,%JII) ..S %NT=2 D PC K %M D PCPUST S %PRPER=0 Q PPNS ; Q ; L1PCIN ; [ 05/28/92 2:43 PM ] ;L1I("ZU") ---> USTR,'$D(L1I("ZS")) --> %BEGS,%ENDS ; O USTR, U USTR I $D(%L1SCPC("EXCEL")) S USTR=0,%BEGS=1,%ENDS=999 G END I $D(%L1SCPC("GLOB")) S USTR=+$G(L1I("ZU")) G ZS ZU N $ZT S %PRVIX=0,$ZT="G M1^%L1SCPC" I '$D(L1I("ZU")) X %chista S %GET="3 - zqtcn , 0 - jqn ++1,60,HH#++1,E,I++03" D ^%L1GET S USTR=%S I "^."[USTR S %PRVIX=1,%EROP=1 G END I $D(L1I("ZU")) S USTR=L1I("ZU") S:$G(L1I("ZU"))=2 USTR=51 I $G(L1I("ZU"))>50,$G(L1I("ZU"))<54 O $S($D(%NMF):%NMF,1:"LEVPC"):APPEND G ZF I '$$^%L1DISP(USTR) S %DEV="USTR" D ^%L1LPT I %EROP K L1I("ZU"),%L1GET G ZU ZF N OTBS ; ZS S %BEGS=1,%ENDS=999 G:$D(L1I("ZS")) END U 0 W ! S %GET=":<1,999> sc cr,scn#8" D N^%L1GET S OTBS=%S S:OTBS="" OTBS="1,999" S %BEGS=$P(OTBS,","),%ENDS=$P(OTBS,",",2) G:%BEGS="." ZU S:%ENDS="" %ENDS=%BEGS I %BEGS'?1N.N!(%ENDS'?1N.N)!(%BEGS>%ENDS) W *7," *** ERROR !" G ZS D UDEV^%L1LPT(USTR) END ; Q M S %GET="3 - zqtcn , 0 - jqn ++1,60,HH#++1,E,I++03" D ^%L1GET S USTR=%S I "^."[USTR S %PRVIX=1 G END Q M1 U 0 W *7 S %SAY="! dpken `l zqtcn++0,50,HH,I" X %XMSG H 2 I '$$^%L1DISP($G(USTR)) D CDEV^%L1LPT K L1I("ZU") G ZU ER Q %L1SCR %L1SCR ; INPUT - %FNAME [ 06.09.21 11:04 ] [ 15.03.19 11:57 ] [ 03.04.08 12:48 ] N %XX,%YY,%XXXX,%YYYY,%SAY,%INV,%S,CIST,%LS,DL,%MOLD,%BE,%C,%GET,%L1NMB0,%HBRY GETF Q:'$D(%FNAME) Q:%FNAME="" Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME)) S %NM=^SCR(%SCRN,"P","NAME",%FNAME) N %ECHO K %SCER D INIT I $D(%SCO) I (","_%SCO_",")[(","_%FNAME_",") S %MSC("OUT")="" I $D(%SCN) I (","_%SCN_",")[(","_%FNAME_",") K %MSC("OUT") K %L1GET I $D(%MSC("OUT")) S %L1GET="" LGR U $P:(NOECHO:NOWRAP) K %TO,%FLL,%S,%L1DS,%SC S %TO="" ; W %ENG I '$D(%L1NMB),$D(%L1NMB0) M %L1NMB=%L1NMB0 S %SAY=$G(%MSC("H")) X %XMSGN ; I '$D(%MSC("H")),$G(%MSC("GLOB"))?."^"1U.E D .N GLOB S GLOB=%MSC("GLOB") S:$E(GLOB)="^" GLOB=$E(GLOB,2,255) .I GLOB["]" S GLOB=$P(GLOB,"]",2,20) .I GLOB["|" S GLOB=$P(GLOB,"|",2,20) .;;S %SAY="" I '$D(^TABLs(GLOB,"NOPROG",%SCRN)) S %SAY=" - dlaha mipezp oekcr," .S %SAY="" I $D(%MSC("CREAT")) S %SAY=$S(%ENGLISH:" UPDATE TABLE - ,",1:" - dlaha mipezp oekcr,") .S %SAY=%SAY_$S(%ENGLISH:" SEARCH BY NAME - , DISPLAY ALL - ",1:" - dbvd , - my zlgzd itl yetig ") X %XMSGN ; I $D(%MSC("DO")) X %MSC("DO") Q:$G(%BS) S (%DIN,%MOLD)=$G(@%FNAME) S %XX=%MSC("X"),%YY=%MSC("Y") I '$D(%L1GET) S %INV="" X %POSIC S $Y=%YY,$X=%XX S %FL="" S %LS=%MSC("D") S %S=%DIN I $D(%L1SC(%SCRN,%FNAME)) S %S=%L1SC(%SCRN,%FNAME) I $G(%SCN)'[%FNAME S %L1GET="" I %MSC("RGS")="D" S %S=$TR(%S,"./","") I %MSC("RGS")="H",%MSC("D")'["/" S %S=$E(%S,$L(%S)-%LS+1,255) I %MSC("RGS")="H",%MSC("D")["/" G CIST I %MSC("RGS")="HH" S %S=$E(%S,$L(%S)-(%LS*%MSC("Y2"))+1,255) E S %S=$E(%S,1,%LS) CIST S CIST=$G(%MSC("S")) K:CIST="" CIST S %PRNEW=0 M %L1NMB0=%L1NMB ; I %MSC("RGS")="E"!(%MSC("RGS")="N")!(%MSC("RGS")="EE") D I '$D(%L1GET),%S'["==",$G(%MSC("DR")),$L($P(%S,"."))>(%MSC("D")-%MSC("DR")-1) D ER G LGR .S $X=%XX-1 I %MSC("RGS")="N" S CIST="0123456789+-.u*?" .K %BE,%FLINS N %HBRY S:%MSC("D")[">"!$D(%L1SCR(">")) %BE="E" .D D ^%ZMSL K %INV,%FL,CIST ..S %XX=%MSC("X"),%YY=%MSC("Y") ..X %POSIC S $Y=%YY,$X=%XX .I $G(%MSC("DR"))>0,%S'["%" S %S=$J(%S,%MSC("DR")+1,%MSC("DR")) I %MSC("RGS")="H" S $X=%XX-1 K %FLINS D D ^%L1ZMS K %INV,%FL,CIST .S:%MSC("D")[">"!$D(%L1SCR(">")) %BE="E" ; I %MSC("RGS")="HH" D HH ; I %MSC("RGS")="D" S $X=%XX S %L1DS=$TR(%S,"./:","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET ; I %MSC("RGS")="T" S $X=%XX S %L1TS=$TR(%S,"./:","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET ;-------- Q:$D(%L1GET) S DL=%MSC("D") S DL=%MSC("D") I %MSC("RGS")="H" S %XX=%MSC("X")-DL S %XXXX=%XX,%YYYY=%YY X %XCL S:%TO="UP" %TO="END" I %TO="END" D VSV Q I $D(%L1SC(%SCRN,%FNAME)) S %S=%L1SC(%SCRN,%FNAME) K %L1GET,%L1SC(%SCRN,%FNAME) S %TO="" I ($D(%L1GET)) D VSV D REF,REF1 Q I %MSC("RGS")="N" S %S=+$TR(%S," ","") S @%FNAME=%S ;I ($D(%L1GET)) D VSV D REF,REF1 Q I DL[".",+%S,%MSC("RGS")="E"!(%MSC("RGS")="EE") S (%S,@%FNAME)=$TR($J(%S,+DL)," ",0) D VSV S %OLDTO=%TO ;I %TO="F9",$G(%MSC("C"))'?.P G IBUD I $G(%MSC("FNC"))[%TO,%TO'="",$G(%MSC("C"))'?.P G IBUD I $G(%MSC("GLOB"))?."^"1U.E D ^%L1SCRG I $D(%SC) D:$D(%SC("ER")) ER K %SC G LGR I $D(%MSC("NEW")),@%FNAME="",'$D(%L1GET),"PGDW"[%TO D ER K %SC G LGR IBUD ; I $D(%MSC("C")),%MSC("C")'?.P S %NMOLD=%NM D D:$G(%MSC("TO"))="PL" PL G:$G(%MSC("TO"))'="P" END D PS G END .S %NMOLD=%NM,YOLD=%YY .X %MSC("C") .S %NM=$G(%NMOLD),%YY=$G(YOLD) .Q END ; I $D(%MSC("NEW")),$G(%FNAME)'="",$G(@%FNAME)="",'$D(%L1GET) D ER K %SC G LGR S %TO=$G(%OLDTO) ;;N %JJ,%A F %JJ=1:1:10 R *%A:0 I $L($G(%FNAME)),$G(@%FNAME)="",$D(^SCR(%SCRN,"P","NAME",%FNAME,"KEY")) S %SC("ER")=1 ;; W %ENG K %ECHO U $P:(NOECHO:NOWRAP) S %XX=%XXXX,%YY=%YYYY X %POSIC S $X=%XX,$Y=%YY D VSV I $D(%SC("ST"))!$D(%SC("ER")) D:$D(%SC("ER")) ER K %SC S:$G(%SC("ST"))="ER" @%FNAME=%MOLD G LGR S %DIN=$G(@%FNAME) D REF,REF1 X %XCL K %MSC,%L1SCR Q ; ER ; X %XMSGV("ER") S @%FNAME=%MOLD Q ; VSV U 0:(NOECHO:NOWRAP) X %POSIC,%XCL,%LIGHT S $X=%XX,$Y=%YY N VSV S VSV=$TR($G(@%FNAME),$C(10),"") I %MSC("RGS")="HH" D G EV .N %L1GET,%TO,%OLDTO,%L1WH .W:%CVET %CV("YF") .S %L1GET="" D HH1(VSV) ; I %MSC("RGS")="H"!($$HBR(VSV)&($E(%MSC("RGS"))'="E")) S VSV=$$^%L1HB($$HBR^%L1FRM(VSV,DL)) I '(%MSC("RGS")="H"!($$HBR(VSV)&($E(%MSC("RGS"))'="E"))) S VSV=$E(VSV,1,DL) I %CVET W %CV("YF") I DL["!",$L(VSV) W %CLI ; X %POSIC ;--- I $G(%MSC("DR")) W $J(VSV,DL,%MSC("DR")) G EV I '$$ENG W $J(VSV,DL) I $$ENG W VSV_$J("",DL-$L(VSV)) EV X %XCL Q ; PS ; D ^%L1SCA Q ; PL ; Q ; REF ; F %IR=1:1 Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME,"KEY",%IR)) D .N VRB1,VRB2,REF1,REF2,I,ER S REF1=$P(^(%IR),"/\"),VRB1=$P(^(%IR),"/\",2) .S ER=0 .F I=1:1:$L(REF1,",") S REF2=$P(REF1,",",I) I REF2?1U.E D ..I '$D(@REF2) S ER=1 Q ..I REF2="" S ER=1 Q .Q:ER .F I=1:1:$L(VRB1,",") S VRB2=$P(VRB1,",",I) I VRB2'="",$D(^SCR(%SCRN,"P","NAME",VRB2,"REF")) X:'$D(@VRB2)!'$D(%L1SCVRB) "S @VRB2="_$G(^SCR(%SCRN,"P","NAME",VRB2,"REF")) S %NN=$G(^SCR(%SCRN,"P","NAME",VRB2)) ;D ^%L1SCSAY .Q Q REF1 ; Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME,"REF1")) X "S "_^("REF1")_"=$G(@%FNAME)" Q INIT ; K %MSC S %MSC("Y")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",") S %MSC("X")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",2) S %MSC("RGS")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",3) S %MSC("D")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",4) S %MSC("DR")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",5) S %MSC("Y2")=$P($P(^SCR(%SCRN,"P",%NM,"CRD"),",",4),"*",2) S:%MSC("Y2")'>1 %MSC("Y2",%NM)=1 ;I +%MSC("DR")=0 K %MSC("DR",%NM) S %MSC("RGS")=^SCR(%SCRN,"P",%NM,"TYP") S %MSC("S")=$G(^SCR(%SCRN,"P",%NM,"RANGE")) I %MSC("S")="" K %MSC("S") S %MSC("H")=$G(^SCR(%SCRN,"P",%NM,"HELP")) I %MSC("H")="" K %MSC("H") S %MSC("C")=$G(^SCR(%SCRN,"P",%NM,"MUMPS2")) I %MSC("C")="" K %MSC("C") S %MSC("DO")=$G(^SCR(%SCRN,"P",%NM,"MUMPS1")) I %MSC("DO")="" K %MSC("DO") I $D(^SCR(%SCRN,"P",%NM,"MUST")) S %MSC("NEW")="Y" S:$G(^SCR(%SCRN,"P",%NM,"FNC"))?1U.E %MSC("FNC")=^("FNC") I $G(^SCR(%SCRN,"P",%NM,"GLOB"))'?.P S %MSC("GLOB")=^("GLOB") D .S:$G(^("NLN"))?1N.N %MSC("NLN")=^("NLN") .S:$G(^("TOPB"))?1N.N %MSC("TOPB")=^("TOPB") .S:$G(^("VRB"))?1U.E %MSC("VRB")=^("VRB") .S:$D(^("CREAT")) %MSC("CREAT")=^("CREAT") .S:$D(^("NS")) %MSC("NS")=$G(^("NS")) .S:$D(^("CHECK")) %MSC("CH")=$G(^("CHECK")) .S:$D(^("RZD")) %MSC("RZD")=$G(^("RZD")) I $D(^SCR(%SCRN,"P",%NM,"OUTPUT")) S %MSC("OUT")="" Q HH1(%S) ; HH ; N %X1,%Y1,%X2,%Y2,%OLDTO,%LS I $D(%L1GET) S %L1WH="" S %LS=%MSC("D") S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+%MSC("Y2")-1 S %LS=%LS*%MSC("Y2") D ^%L1WH S %OLDTO=%TO HH2 S %L1WH="" K %INV D ^%L1WH K %L1WH S %TO=%OLDTO Q HBR(%TX) N %JJ,%OK S %OK=0 F %JJ=1:1:$L(%TX) I $A(%TX,%JJ)>95,$A(%TX,%JJ)<123 S %OK=1 Q Q %OK ; ENG(STAM) ; I $G(%ENGLISH) Q 1 I $G(%L1SC)="E" Q 1 Q 0 %L1SCR0 %L1SCR ; INPUT - %FNAME [ 20.01.07 10:51 ] [ 19.01.07 13:25 ] [ 14.01.07 17:23 ] N %XX,%YY,%XXXX,%YYYY,%SAY,%INV,%S,CIST,%LS,DL,%MOLD,%BE,%C,%GET,%L1NMB0,%HBRY GETF Q:'$D(%FNAME) Q:%FNAME="" Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME)) S %NM=^SCR(%SCRN,"P","NAME",%FNAME) N %ECHO K %SCER D INIT I $D(%SCO) I (","_%SCO_",")[(","_%FNAME_",") S %MSC("OUT")="" I $D(%SCN) I (","_%SCN_",")[(","_%FNAME_",") K %MSC("OUT") K %L1GET I $D(%MSC("OUT")) S %L1GET="" LGR U $P:(NOECHO:NOWRAP) K %TO,%FLL,%S,%L1DS,%SC S %TO="" ; W %ENG I '$D(%L1NMB),$D(%L1NMB0) M %L1NMB=%L1NMB0 S %SAY=$G(%MSC("H")) X %XMSGN I '$D(%MSC("H")),$G(%MSC("GLOB"))?."^"1U.E D .N GLOB S GLOB=%MSC("GLOB") S:$E(GLOB)="^" GLOB=$E(GLOB,2,255) .I GLOB["]" S GLOB=$P(GLOB,"]",2,20) .I GLOB["|" S GLOB=$P(GLOB,"|",2,20) .;;S %SAY="" I '$D(^TABLs(GLOB,"NOPROG",%SCRN)) S %SAY=" - dlaha mipezp oekcr," .S %SAY="" I $D(%MSC("CREAT")) S %SAY=$S(%ENGLISH:" UPDATE TABLE - ,",1:" - dlaha mipezp oekcr,") .S %SAY=%SAY_$S(%ENGLISH:" SEARCH BY NAME - , DISPLAY ALL - ",1:" - dbvd , - my zlgzd itl yetig ") X %XMSGN I $D(%MSC("DO")) X %MSC("DO") Q:$G(%BS) S (%DIN,%MOLD)=$G(@%FNAME) S %XX=%MSC("X"),%YY=%MSC("Y") I '$D(%L1GET) S %INV="" X %POSIC S $Y=%YY,$X=%XX S %FL="" S %LS=%MSC("D") S %S=%DIN I $D(%L1SC(%SCRN,%FNAME)) S %S=%L1SC(%SCRN,%FNAME) I $G(%SCN)'[%FNAME S %L1GET="" I %MSC("RGS")="D" S %S=$TR(%S,"./","") I %MSC("RGS")="H",%MSC("D")'["/" S %S=$E(%S,$L(%S)-%LS+1,255) I %MSC("RGS")="H",%MSC("D")["/" G CIST I %MSC("RGS")="HH" S %S=$E(%S,$L(%S)-(%LS*%MSC("Y2"))+1,255) E S %S=$E(%S,1,%LS) CIST S CIST=$G(%MSC("S")) K:CIST="" CIST S %PRNEW=0 M %L1NMB0=%L1NMB I %MSC("RGS")="E"!(%MSC("RGS")="N")!(%MSC("RGS")="EE") D I '$D(%L1GET),%S'["==",$G(%MSC("DR")),$L($P(%S,"."))>(%MSC("D")-%MSC("DR")-1) D ER G LGR .S $X=%XX-1 I %MSC("RGS")="N" S CIST="0123456789+-.u*?" .K %BE,%FLINS N %HBRY S:%MSC("D")[">"!$D(%L1SCR(">")) %BE="E" .;D S:'$G(%ENGLISH)&(%MSC("RGS")'="N") %HBRY="" D ^%ZMSL K %INV,%FL,CIST .D D ^%ZMSL K %INV,%FL,CIST ..S %XX=%MSC("X"),%YY=%MSC("Y") ..X %POSIC S $Y=%YY,$X=%XX .I $G(%MSC("DR"))>0,%S'["%" S %S=$J(%S,%MSC("DR")+1,%MSC("DR")) I %MSC("RGS")="H" S $X=%XX-1 K %FLINS D D ^%L1ZMS K %INV,%FL,CIST .S:%MSC("D")[">"!$D(%L1SCR(">")) %BE="E" I %MSC("RGS")="HH" D HH I %MSC("RGS")="D" S $X=%XX S %L1DS=$TR(%S,"./:","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET I %MSC("RGS")="T" S $X=%XX S %L1TS=$TR(%S,"./:","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET ;-------- Q:$D(%L1GET) S DL=%MSC("D") S DL=%MSC("D") ;;W %ENG S:%MSC("RGS")="H" %XX=%MSC("X")-DL S %XXXX=%XX,%YYYY=%YY X %XCL S:%TO="UP" %TO="END" I %TO="END" D VSV Q I $D(%L1SC(%SCRN,%FNAME)) S %S=%L1SC(%SCRN,%FNAME) K %L1GET,%L1SC(%SCRN,%FNAME) S %TO="" I ($D(%L1GET)) D VSV D REF,REF1 Q I %MSC("RGS")="N" S %S=+$TR(%S," ","") S @%FNAME=%S ;I ($D(%L1GET)) D VSV D REF,REF1 Q I DL[".",+%S,%MSC("RGS")="E"!(%MSC("RGS")="EE") S (%S,@%FNAME)=$TR($J(%S,+DL)," ",0) D VSV S %OLDTO=%TO ;I %TO="F9",$G(%MSC("C"))'?.P G IBUD I $G(%MSC("FNC"))[%TO,%TO'="",$G(%MSC("C"))'?.P G IBUD I $G(%MSC("GLOB"))?."^"1U.E D ^%L1SCRG I $D(%SC) D:$D(%SC("ER")) ER K %SC G LGR I $D(%MSC("NEW")),@%FNAME="",'$D(%L1GET),"PGDW"[%TO D ER K %SC G LGR IBUD ; I $D(%MSC("C")),%MSC("C")'?.P S %NMOLD=%NM D D:$G(%MSC("TO"))="PL" PL G:$G(%MSC("TO"))'="P" END D PS G END .S %NMOLD=%NM,YOLD=%YY .X %MSC("C") .S %NM=$G(%NMOLD),%YY=$G(YOLD) .Q END ; I $D(%MSC("NEW")),$G(%FNAME)'="",$G(@%FNAME)="",'$D(%L1GET) D ER K %SC G LGR S %TO=$G(%OLDTO) ;;N %JJ,%A F %JJ=1:1:10 R *%A:0 I $L($G(%FNAME)),$G(@%FNAME)="",$D(^SCR(%SCRN,"P","NAME",%FNAME,"KEY")) S %SC("ER")=1 ;; W %ENG K %ECHO U $P:(NOECHO:NOWRAP) S %XX=%XXXX,%YY=%YYYY X %POSIC S $X=%XX,$Y=%YY D VSV I $D(%SC("ST"))!$D(%SC("ER")) D:$D(%SC("ER")) ER K %SC S:$G(%SC("ST"))="ER" @%FNAME=%MOLD G LGR S %DIN=$G(@%FNAME) D REF,REF1 X %XCL K %MSC,%L1SCR Q ER ; X %XMSGV("ER") S @%FNAME=%MOLD Q VSV X %POSIC,%XCL,%LIGHT S $X=%XX,$Y=%YY N VSV S VSV=$TR($G(@%FNAME),$C(10),"") I %MSC("RGS")="HH" D G EV .N %L1GET,%TO,%OLDTO,%L1WH .W:%CVET %CV("YF") .S %L1GET="" D HH1(VSV) ; I %MSC("RGS")="H"!($$HBR(VSV)&(%MSC("RGS")'="EE")) S VSV=$TR($TR($E(VSV,$L(VSV)-DL+1,255),%TES1,%TES2),%TEN,%THB) E S VSV=$E(VSV,1,DL) I %CVET W %CV("YF") I DL["!",$L(VSV) W %CLI X %POSIC ;--- I $G(%MSC("DR")) W $J(VSV,DL,%MSC("DR")) G EV I '%ENGLISH W $J(VSV,DL) I %ENGLISH W VSV_$J("",DL-$L(VSV)) EV X %XCL Q PS ; D ^%L1SCA Q PL ; Q REF ; F %IR=1:1 Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME,"KEY",%IR)) D .N VRB1,VRB2,REF1,REF2,I,ER S REF1=$P(^(%IR),"/\"),VRB1=$P(^(%IR),"/\",2) .S ER=0 .F I=1:1:$L(REF1,",") S REF2=$P(REF1,",",I) I REF2?1U.E D ..I '$D(@REF2) S ER=1 Q ..I REF2="" S ER=1 Q .Q:ER .F I=1:1:$L(VRB1,",") S VRB2=$P(VRB1,",",I) I VRB2'="",$D(^SCR(%SCRN,"P","NAME",VRB2,"REF")) X:'$D(@VRB2)!'$D(%L1SCVRB) "S @VRB2="_$G(^SCR(%SCRN,"P","NAME",VRB2,"REF")) S %NN=$G(^SCR(%SCRN,"P","NAME",VRB2)) ;D ^%L1SCSAY .Q Q REF1 ; Q:'$D(^SCR(%SCRN,"P","NAME",%FNAME,"REF1")) X "S "_^("REF1")_"=$G(@%FNAME)" Q INIT ; K %MSC S %MSC("Y")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",") S %MSC("X")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",2) S %MSC("RGS")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",3) S %MSC("D")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",4) S %MSC("DR")=$P(^SCR(%SCRN,"P",%NM,"CRD"),",",5) S %MSC("Y2")=$P($P(^SCR(%SCRN,"P",%NM,"CRD"),",",4),"*",2) S:%MSC("Y2")'>1 %MSC("Y2",%NM)=1 ;I +%MSC("DR")=0 K %MSC("DR",%NM) S %MSC("RGS")=^SCR(%SCRN,"P",%NM,"TYP") S %MSC("S")=$G(^SCR(%SCRN,"P",%NM,"RANGE")) I %MSC("S")="" K %MSC("S") S %MSC("H")=$G(^SCR(%SCRN,"P",%NM,"HELP")) I %MSC("H")="" K %MSC("H") S %MSC("C")=$G(^SCR(%SCRN,"P",%NM,"MUMPS2")) I %MSC("C")="" K %MSC("C") S %MSC("DO")=$G(^SCR(%SCRN,"P",%NM,"MUMPS1")) I %MSC("DO")="" K %MSC("DO") I $D(^SCR(%SCRN,"P",%NM,"MUST")) S %MSC("NEW")="Y" S:$G(^SCR(%SCRN,"P",%NM,"FNC"))?1U.E %MSC("FNC")=^("FNC") I $G(^SCR(%SCRN,"P",%NM,"GLOB"))'?.P S %MSC("GLOB")=^("GLOB") D .S:$G(^("NLN"))?1N.N %MSC("NLN")=^("NLN") .S:$G(^("TOPB"))?1N.N %MSC("TOPB")=^("TOPB") .S:$G(^("VRB"))?1U.E %MSC("VRB")=^("VRB") .S:$D(^("CREAT")) %MSC("CREAT")=^("CREAT") .S:$D(^("NS")) %MSC("NS")=$G(^("NS")) .S:$D(^("CHECK")) %MSC("CH")=$G(^("CHECK")) .S:$D(^("RZD")) %MSC("RZD")=$G(^("RZD")) I $D(^SCR(%SCRN,"P",%NM,"OUTPUT")) S %MSC("OUT")="" Q HH1(%S) ; HH ; N %X1,%Y1,%X2,%Y2,%OLDTO,%LS I $D(%L1GET) S %L1WH="" S %LS=%MSC("D") S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+%MSC("Y2")-1 S %LS=%LS*%MSC("Y2") D ^%L1WH S %OLDTO=%TO HH2 S %L1WH="" K %INV D ^%L1WH K %L1WH S %TO=%OLDTO Q HBR(%TX) N %JJ,%OK S %OK=0 F %JJ=1:1:$L(%TX) I $A(%TX,%JJ)>95,$A(%TX,%JJ)<123 S %OK=1 Q Q %OK %L1SCREF %L1SCREF ; [ 10.12.03 18:18 ] [ 15.02.02 11:39 AM ] [ 14.11.01 2:34 PM ] GET ; N %R,%MKT,%V,%I S %MKT=^SCR(%SCRN,"P","REF",%L1SCREF("N"),"STR") S %R=^("RZD") F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) I %V?."%"1U.E S @%V=$P(%L1SCREF("S"),%R,%I) Q GETALL G GA1 ; ; INPUT - %L1SCREF - GLOBAL REFERENCE , %SCRN - SCREEN NAME ; OUTPUT - ALL VARIABLES GA(%SCRN,%L1SCREF,%GLB1) ; I %L1SCREF["\V" S %L1SCREF("SCV")="",%L1SCREF=$P(%L1SCREF,"\") GA1 N %GLB,%GLBO,%OST,%MKT,%R,%II,%V,%I I '$D(%GLB1) S %GLB1=$G(^SCR(%SCRN,"P","REF",1)) I %L1SCREF["=" S %GLB1=$P(%L1SCREF,"=",2),%L1SCREF=$P(%L1SCREF,"=") I $E(%GLB1,$L(%GLB1))=")" S %GLB1=$E(%GLB1,1,$L(%GLB1)-1)_"," S:%GLB1'["(" %GLB1=%GLB1_"(" F %II=1:1 Q:'$D(^SCR(%SCRN,"P","REF",%II,"STR")) D .N %R,%MKT,%V,%I,%GLB .S %MKT=^("STR"),%R=^("RZD"),%GLB=^SCR(%SCRN,"P","REF",%II) Q:%GLB'[%GLB1&(%II>1) .S %OST=$P(%GLB,%GLB1,2,10) .I '$L(%OST) S %GLBO=$G(@%L1SCREF) .I $L(%OST),$E(%L1SCREF,$L(%L1SCREF))=")" S %GLBO=$G(@($E(%L1SCREF,1,$L(%L1SCREF)-1)_","_%OST)) .I $L(%OST),%L1SCREF'["(" S %GLBO=$G(@(%L1SCREF_"("_%OST)) .F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) D ..I $D(%L1SCREF("SCV")),%V?."%"1U.E S %SCV("MS",%V)=$P(%GLBO,%R,%I) Q ..I %V?."%"1U.E S @%V=$P(%GLBO,%R,%I) Q GET1(%REF,%SCRN,%NMB,%NAME) ; N %R,%MKT,%V,%I,%OK S %MKT=^SCR(%SCRN,"P","REF",%NMB,"STR") S %R=^("RZD"),%OK=0 F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) I $L(%V),%V=%NAME S %OK=1 Q I %OK Q $P(%REF,%R,%I) Q "?????" Q PUT(%REF,%SCRN,%NMB,%NAME) ; ; %REF - GLOBAL REFERENCE, %NMB - MACKET NUMBER, %NAME - LIST VARIABLE NAMES("%NM1,%NM2,... N %R,%MKT,%V,%I S %MKT=^SCR(%SCRN,"P","REF",%NMB,"STR") S %R=^("RZD") N %N,%NM F %N=1:1:$L(%NAME,",") D .S %NM=$P(%NAME,",",%N) .F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) I %V=%NM S $P(@%REF,%R,%I)=$G(@%NM) Q Q PUT1(%SCRN,%FNAME) ; Q:$G(%FNAME)="" Q:$G(%SCRN)="" N %F,%FN F %F=1:1:$L(%FNAME,",") D .S %FN=$P(%FNAME,",",%F) .Q:'$D(^SCR(%SCRN,"P","NAME",%FN,"REF1")) .X "S "_^("REF1")_"=$G(@%FN)" Q PUTALL(%REF,%SCRN,%NMB) ; ; %NMB - MACKET NUMBER (IF %NMB="A" - ALL MACKETS, %REF=^SCR(%SCRN,"P","REF",%NMB) I %NMB="A" D Q .F %NMB=1:1 Q:'$D(^SCR(%SCRN,"P","REF",%NMB)) S %REF=^(%NMB) D PA PA S %MKT=^SCR(%SCRN,"P","REF",%NMB,"STR") S %R=^("RZD") F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) I %V?1U.E,$D(@%V) D .S $P(@%REF,%R,%I)=@%V Q %L1SCRG %L1SCRG ; [ 15.03.19 12:28 ] [ 20.01.07 12:11 ] [ 16.12.03 10:27 ] S %NMOLD=%NM N FILE,SH,SCH,%YYYY,X1,X2,Y1,Y2,%L1SCS,%PROG,%SCRNOLD,%L1SCRG S %L1SCS="",%SCRNOLD=$G(%SCRN) S STRING=%S,FILE=%MSC("GLOB") S:$E(FILE)'="^" FILE="^"_FILE D UCI^%L3MBGS I %TO="PGUP" S @%FNAME=$O(@FILE@(STRING),-1) S %TO="" Q I %TO="PGDW" S @%FNAME=$O(@FILE@(STRING)) S %TO="" Q S FILE(1)=%MSC("D"),FILE(2)=$G(%MSC("NLN"),30),FILE(3)=$G(%MSC("TOPB"),8) S RZD=$G(%MSC("RZD"),"*") I $G(%TO)="",'$D(%MSC("CH")) S @%FNAME=STRING D VRB G GETV ; END ; I $G(%TO)="F6"!($G(%TO)="F7")!((%S="*")!(%S="?")&($G(%TO)="")) D SAVE D D REST G END .S:STRING="*"&($G(%TO)="") %TO="F7",%S="" S:STRING="?"&($G(%TO)="") %TO="F6",%S="" .D @$S($G(%TO)="F7":"DAFUS^%L3MBGS",1:"POISK^%L3MBGS") .I $G(FLAG)'=""!'$D(STRING) S %SC("ST")="" Q .S @%FNAME=STRING D VRB ; I $G(%TO)="F9",$D(%MSC("CREAT")) D TBL,VRB G END GETV ; I @%FNAME="",$G(%MSC("NEW"))="Y",$G(%MSC("FNC"))'[%TO!(%TO="") S %SC("ER")="" G END I @%FNAME="",$G(%MSC("VRB"))?1U.E S @%MSC("VRB")="" G END I FILE["(" G END ; I @%FNAME'="" D G:$D(%SC) END D VRB G END .I '($D(@(FILE_"(STRING)")))#2,$D(%MSC("CH")) D ..I '$D(%MSC("CREAT")) S %SC("ER")="" Q ..S %GET="99 - miwdl . miiw `l" D N^%L1GET I %S'=99 D Q ...I $G(%MSC("NEW"))="Y" S %SC("ER")="" Q ...S %SC("ST")="" D VRB Q ..D TBL END S %NM=%NMOLD S %TO="" Q ; PROGSET ; N N S N="" F S N=$O(%L1SCRG("SET",N)) Q:N="" S @N=%L1SCRG("SET",N) Q SAVE I %TYPCRT="PC" D GET^%VIDEO("oldg",0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;3$v" Q Q REST ; X %XCL I %TYPCRT="PC" D PUT^%VIDEO("oldg",0,0,80,24,2) K oldg Q I $E(%TYPCRT,1,3)="VT5",%CVET W $C(27,91),";;;;3;;;$v" Q S %SCRN=%SCRNOLD D A^%L1SC Q VRB ; Q:$G(%MSC("VRB"))'?1U.E Q:'$D(STRING) I @%FNAME="" S @%MSC("VRB")="" Q N %A S %A=$P($G(@(FILE_"(STRING)")),RZD) I %MSC("VRB")=%FNAME,%A="" Q S @%MSC("VRB")=%A Q TBL ; N GLOB,REST S GLOB=$E(FILE,2,20) S %SC("ST")="" S REST=1 I GLOB["]" S GLOB=$P(GLOB,"]",2,20) I GLOB["|" S GLOB=$P(GLOB,"|",2,20) I $D(^TABLs(GLOB)) D SAVE D D:REST REST Q .;;I $G(%SCRN)'="",$D(^TABLs(GLOB,"PROG",%SCRN)) S %PROG=^(%SCRN),%L1SCRG("STRING")=STRING N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG) D ^%L1C D PROGSET,@%PROG Q .;;I $D(^TABLs(GLOB,"PROG")) S %PROG=^("PROG"),%PROG("STRING")=STRING Q:$D(^TABLs(GLOB,"NOPROG",%SCRN)) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG) D ^%L1C D PROGSET,@%PROG Q .I $G(%SCRN)'="",$D(^TABLs(GLOB,"PROG",%SCRN)) S %PROG=^(%SCRN) D CALL S REST=0 Q .I $D(^TABLs(GLOB,"PROG"))#2 S %PROG=^("PROG"),%L1SCRG("STRING")=STRING Q:$D(^TABLs(GLOB,"NOPROG",%SCRN)) D CALL S REST=0 Q .D I^%L1TABL S NSNAME=$G(%MSC("NS")) D SAVE D ^%L1SCS S @%FNAME=STRING D REST Q CALL ; N KEY S KEY="STRING" I $G(^TABLs(GLOB,"UCI"))?3U S %PROG=%PROG_"["_^("UCI")_"]" I $G(^TABLs(GLOB,"KEY"))?."%"1U.E S KEY=^("KEY") N @KEY S @KEY=STRING D ^%L1CALL(%PROG,%SCRN,KEY) Q %L1SCRG0 %L1SCRG ; [ 22.06.03 17:28 ] [ 04.11.01 6:43 PM ] [ 03.05.01 11:50 AM ] S %NMOLD=%NM N FILE,SH,SCH,%YYYY,X1,X2,Y1,Y2,%L1SCS,%PROG,%SCRNOLD,%L1SCRG S %L1SCS="",%SCRNOLD=$G(%SCRN) S STRING=%S,FILE=%MSC("GLOB") S:$E(FILE)'="^" FILE="^"_FILE D UCI^%L3MBGS I %TO="PGUP" S @%FNAME=$O(@FILE@(STRING),-1) S %TO="" Q I %TO="PGDW" S @%FNAME=$O(@FILE@(STRING)) S %TO="" Q S FILE(1)=%MSC("D"),FILE(2)=$G(%MSC("NLN"),30),FILE(3)=$G(%MSC("TOPB"),8) S RZD=$G(%MSC("RZD"),"*") I $G(%TO)="",'$D(%MSC("CH")) S @%FNAME=STRING D VRB G GETV ; END I $G(%TO)="F6"!($G(%TO)="F7")!((%S="*")!(%S="?")&($G(%TO)="")) D SAVE D D REST G END .S:STRING="*"&($G(%TO)="") %TO="F7",%S="" S:STRING="?"&($G(%TO)="") %TO="F6",%S="" .D @$S($G(%TO)="F7":"DAFUS^%L3MBGS",1:"POISK^%L3MBGS") .I $G(FLAG)'=""!'$D(STRING) S %SC("ST")="" Q .S @%FNAME=STRING D VRB I $G(%TO)="F9",$D(%MSC("CREAT")) D TBL,VRB G END GETV ; I @%FNAME="",$G(%MSC("NEW"))="Y",$G(%MSC("FNC"))'[%TO!(%TO="") S %SC("ER")="" G END I @%FNAME="",$G(%MSC("VRB"))?1U.E S @%MSC("VRB")="" G END I FILE["(" G END ; I @%FNAME'="" D G:$D(%SC) END D VRB G END .I '($D(@(FILE_"(STRING)")))#2,$D(%MSC("CH")) D ..I '$D(%MSC("CREAT")) S %SC("ER")="" Q ..S %GET="99 - miwdl . miiw `l" D N^%L1GET I %S'=99 D Q ...I $G(%MSC("NEW"))="Y" S %SC("ER")="" Q ...S %SC("ST")="" D VRB Q ..D TBL END S %NM=%NMOLD S %TO="" Q ; PROGSET ; N N S N="" F S N=$O(%L1SCRG("SET",N)) Q:N="" S @N=%L1SCRG("SET",N) Q SAVE I %TYPCRT="PC" D GET^%VIDEO(.oldg,0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;3$v" Q Q REST ; X %XCL I %TYPCRT="PC" D PUT^%VIDEO(oldg,0,0,80,24,2) K oldg Q I $E(%TYPCRT,1,3)="VT5",%CVET W $C(27,91),";;;;3;;;$v" Q S %SCRN=%SCRNOLD D A^%L1SC Q VRB ; Q:$G(%MSC("VRB"))'?1U.E Q:'$D(STRING) I @%FNAME="" S @%MSC("VRB")="" Q S @%MSC("VRB")=$P($G(@(FILE_"(STRING)")),RZD) Q TBL ; N GLOB,REST S GLOB=$E(FILE,2,20) S %SC("ST")="" S REST=1 I GLOB["]" S GLOB=$P(GLOB,"]",2,20) I GLOB["|" S GLOB=$P(GLOB,"|",2,20) I $D(^TABLs(GLOB)) D SAVE D D:REST REST Q .I $G(%SCRN)'="",$D(^TABLs(GLOB,"PROG",%SCRN)) S %PROG=^(%SCRN) D CALL S REST=0 Q .I $D(^TABLs(GLOB,"PROG"))#2 S %PROG=^("PROG"),%L1SCRG("STRING")=STRING Q:$D(^TABLs(GLOB,"NOPROG",%SCRN)) D CALL S REST=0 Q .D I^%L1TABL S NSNAME=$G(%MSC("NS")) D SAVE D ^%L1SCS S @%FNAME=STRING D REST Q CALL ; N KEY S KEY="STRING" ;;I $G(^TABLs(GLOB,"UCI"))?3U S %PROG=%PROG_"["_^("UCI")_"]" I $G(^TABLs(GLOB,"KEY"))?."%"1U.E S KEY=^("KEY") N @KEY S @KEY=STRING D ^%L1CALL(%PROG,%SCRN,KEY) Q %L1SCS %L1SCS ; INPUT TABLE PROVIDED [ 21.11.05 21:56 ] [ 13.02.02 12:25 PM ] [ 28.11.01 8:58 AM ] ; INPUT: FILE,FILE(1),FILE(2),NSNAME ;- ZAPR3 ; I '$D(%POSIC) D ^%L1C ;I $E(FILE,$L(FILE))=")" S FILE=$E(FILE,1,$L(FILE)-1)_"," ;I FILE'["(" S FILE=FILE_"(" ;I $E(FILE,$L(FILE))'="(",$E(FILE,$L(FILE))'="," S FILE=FILE_"," S:'$D(RZD) RZD="*" N %MBS,VGR0,J,SH,SCH S %MBS("PAR",1)=" ;oezp xe`z;8,50;20;H;" I S %SCSFIN=0 D ^%L1MBS1 K %L1SCSZ ;-------------- PR NE OCHISTKI EKR D ^%L1SCSZ ;------------- ASK NUMBER ; OUTPUT - STRING K %L1SCSZ I %S=""!($G(%TO)="END") S %SCSFIN=1 G E3 D VVSP I '$D(%L1SCS) G I E3 Q:$D(%L1SCS) S %GET="<99> - "_NSNAME_" qitcdl" D N^%L1GET I %S=99 S %UNIT=3 D ^%L1SCSP U 0 S %GET=" ugl" D N^%L1GET Q ;- VVSP ; I $D(@(FILE_"(STRING)"))=0 K %MBS("O") G INP D PCT S %GET=" - d`ivi, 0 - leha, 3 - dqtcd ,2 - xtqn iepiy, 1 - mipezp oekcr++5,75,HH#1++1,E,I++01234" I %ENGLISH S %GET="MODIFY -1, CHANGE NUMBER - 2, PRINT - 3, ERASE - 0 , EXIT - ESC++5,7,EE#1++1,E,I++01234" D ^%L1GET Q:%S=""!(%TO="END") I %S=0 K %Q S %Q("Z")=$S(%ENGLISH:"ARE YOU SHURE",1:"geha"),%Q("X")=3,%Q("Y")=22 D ^%S2ASK I YES D KF^%L1SCSV K @FILE@(STRING) S STRING="" Q I %S=1 G INP I %S=2 D Q .S %GET=": ycg xtqn++2,34,HH#++"_$G(FILE(1),10)_",E,I" D ^%L1GET Q:%S=""!(%TO="END") .N NEW S NEW=%S I $D(@FILE@(NEW)) S %SAY=" ! miiw xak xtqnd " X %XMSGV(1) Q .S MAC1=FILE_"(STRING)",MAC2=FILE_"(NEW)" D ^%S1GC1 .D KF^%L1SCSV .K @FILE@(STRING) S STRING=NEW D SF^%L1SCSV I %S=3 D .D ^%L1LPT Q:$G(%EROP) .S %GETIN=1 D ^%L1TS .S %GET=" miwzrd zenk " .I %ENGLISH S %GET="COPIES NUMBER :" .D N^%L1GET K %GETIN Q:%TO="END" S %EKZ=%S .N JJJ F JJJ=1:1:%EKZ+1 D ..U USTR W $C(18) W $J("",70-($L(%MBS("O",1))+$L(STRING)*2)\2),%L1OUT("MDP","B"),$TR(%MBS("O",1)_" "_STRING,TS0,TSS),%L1OUT("MDP","N"),!!?10,$TR($J("",60)," ","-") ..F I=2:1:COLS W !,$TR($J(%MBS("O",I),40)_" : "_$J(%MBS("Z",I),LZ),TS0,TSS) ..W !?10,$TR($J("",60)," ","-"),# .D CLOSE^%L1LPT U 0 I %S=4,FILE="^LAK",$G(STRING)'="" D .N MODEM S MODEM=$P($G(^LAK(STRING,1)),"\",3) .;;U 0 W $C(27)_"P$scomm1.psl "_MODEM_$c(27)_"\" .;;S %GET="" D N^%L1GET .D ^%L1MDCON(STRING) Q INP D ^%L1SCSV Q PCT ; Q:STRING="" S %MBS("O",1)=$G(@(FILE_"(STRING)")) F I=2:1:COLS S %MBS("O",I)=$P($G(@(FILE_"(STRING,1)")),RZD,I-1) S %L1MBS="" D ^%L1MBS K %L1MBS Q %L1SCS0 %L1SCS ; INPUT TABLE PROVIDED [ 21.11.05 21:55 ] [ 13.02.02 12:25 PM ] [ 28.11.01 8:58 AM ] ; INPUT: FILE,FILE(1),FILE(2),NSNAME ;- ZAPR3 ; I '$D(%POSIC) D ^%L1C ;I $E(FILE,$L(FILE))=")" S FILE=$E(FILE,1,$L(FILE)-1)_"," ;I FILE'["(" S FILE=FILE_"(" ;I $E(FILE,$L(FILE))'="(",$E(FILE,$L(FILE))'="," S FILE=FILE_"," S:'$D(RZD) RZD="*" N %MBS,VGR0,J,SH,SCH S %MBS("PAR",1)=" ;oezp xe`z;8,50;20;H;" I S %SCSFIN=0 D ^%L1MBS1 K %L1SCSZ ;-------------- PR NE OCHISTKI EKR D ^%L1SCSZ ;------------- ASK NUMBER ; OUTPUT - STRING K %L1SCSZ I %S=""!($G(%TO)="END") S %SCSFIN=1 G E3 D VVSP I '$D(%L1SCS) G I E3 Q:$D(%L1SCS) S %GET="<99> - "_NSNAME_" qitcdl" D N^%L1GET I %S=99 S %UNIT=3 D ^%L1SCSP U 0 S %GET=" ugl" D N^%L1GET Q ;- VVSP ; I $D(@(FILE_"(STRING)"))=0 K %MBS("O") G INP D PCT S %GET=" - d`ivi, 0 - leha, 3 - dqtcd ,2 - xtqn iepiy, 1 - mipezp oekcr++5,75,HH#1++1,E,I++01234" I %ENGLISH S %GET="MODIFY -1, CHANGE NUMBER - 2, PRINT - 3, ERASE - 0 , EXIT - ESC++5,7,EE#1++1,E,I++01234" D ^%L1GET Q:%S=""!(%TO="END") I %S=0 K %Q S %Q("Z")=$S(%ENGLISH:"ARE YOU SHURE",1:"geha"),%Q("X")=3,%Q("Y")=22 D ^%S2ASK I YES D KF^%L1SCSV K @FILE@(STRING) S STRING="" Q I %S=1 G INP I %S=2 D Q .S %GET=": ycg xtqn++2,34,HH#++"_$G(FILE(1),10)_",E,I" D ^%L1GET Q:%S=""!(%TO="END") .N NEW S NEW=%S I $D(@FILE@(NEW)) S %SAY=" ! miiw xak xtqnd " X %XMSGV(1) Q .S MAC1=FILE_"(STRING)",MAC2=FILE_"(NEW)" D ^%S1GC1 .D KF^%L1SCSV .K @FILE@(STRING) S STRING=NEW D SF^%L1SCSV I %S=3 D .D ^%L1LPT Q:$G(%EROP) .S %GETIN=1 D ^%L1TS .S %GET=" miwzrd zenk " .I %ENGLISH S %GET="COPIES NUMBER :" .D N^%L1GET K %GETIN Q:%TO="END" S %EKZ=%S .N JJJ F JJJ=1:1:%EKZ+1 D ..U USTR W $C(18) W $J("",70-($L(%MBS("O",1))+$L(STRING)*2)\2),%L1OUT("MDP","B"),$TR(%MBS("O",1)_" "_STRING,TS0,TSS),%L1OUT("MDP","N"),!!?10,$TR($J("",60)," ","-") ..F I=2:1:COLS W !,$TR($J(%MBS("O",I),40)_" : "_$J(%MBS("Z",I),LZ),TS0,TSS) ..W !?10,$TR($J("",60)," ","-"),# .D CLOSE^%L1LPT U 0 I %S=4,FILE="^LAK",$G(STRING)'="" D ^%L1MDCON(STRING) Q INP D ^%L1SCSV Q PCT ; Q:STRING="" S %MBS("O",1)=$G(@(FILE_"(STRING)")) F I=2:1:COLS S %MBS("O",I)=$P($G(@(FILE_"(STRING,1)")),RZD,I-1) S %L1MBS="" D ^%L1MBS K %L1MBS Q %L1SCSA0 %L1SCSAY ; [ 20.01.07 11:26 ] [ 19.01.07 14:59 ] [ 06.12.06 14:42 ] SAY ; N V,CRD,TYP,VL,%XX,%YY,%INV,%X1,%X2,%Y1,%Y2,%LS,%L1WH S V=^SCR(%SCRN,"P","NM",%NN) S CRD=^SCR(%SCRN,"P",%NN,"CRD") S TYP=^("TYP") U $P:(NOECHO:NOWRAP:NOESC) I %TYPCRT["VT5" W $C(27,91),$P(CRD,",")+1,";",$P(CRD,",",2)+1-$S($E(TYP)'="H":0,1:($P(CRD,",",4))),";",$P(CRD,",")+1,";",$P(CRD,",",2)+1+$S($E(TYP)="H":0,1:$P(CRD,",",4)),"${" ;I %TYPCRT["VT5",%ENGLISH W $C(27,91),$P(CRD,",")+2,";",$P(CRD,",",2)+1-$S($E(TYP)'="H":0,1:($P(CRD,",",4))),";",$P(CRD,",")+1,";",$P(CRD,",",2)+2+$S($E(TYP)="H":0,1:$P(CRD,",",4)),"${" S VL=$G(@V) Q:VL?." "&(%TYPCRT["VT5") Q:+VL=0&(TYP="N")&(%TYPCRT["VT5") I $P(CRD,",",5)'>0,'%ENGLISH S VL=$J(VL,+$P(CRD,",",4)) ;;I $P(CRD,",",5)'>0,%ENGLISH S VL=" "_VL_$J("",$P(CRD,",",4)-$L(VL)-1) I $P(CRD,",",5)'>0,%ENGLISH S VL=VL_$J("",$P(CRD,",",4)-$L(VL)) I TYP="N",$P(CRD,",",5)>0 S VL=$J(VL,$P(CRD,",",4),$P(CRD,",",5)) I +$TR(VL," ","")=0 S VL=$J("",$P(CRD,",",4)) I TYP="D",VL?6N S VL=$E(VL,1,2)_"."_$E(VL,3,4)_"."_$E(VL,5,6) I TYP="T",VL?6N S VL=$E(VL,1,2)_":"_$E(VL,3,4)_":"_$E(VL,5,6) I TYP'="HH" D G END .I TYP'="N",TYP'="EE" S %SAY=$$^%L1HB($E(VL,$L(VL)-$P(CRD,",",4)+1,$L(VL)))_"++"_$P(CRD,",")_","_$P(CRD,",",2)_","_$S(TYP="H":"HH",1:"EE") .I TYP="N" S %SAY=VL_"++"_$P(CRD,",")_","_$P(CRD,",",2)_","_$S(TYP="H":"HH",1:"EE") .I $P(CRD,",",4)["/",$L(VL)>$P(CRD,",",4) D ..S $P(%SAY,"++")="..."_$E(VL,$L(VL)-$P(CRD,",",4)+4,$L(VL)) .S $Y=$P(CRD,","),$X=$P(CRD,",",2) .I $P(CRD,",",4)["!",VL'?.P S %SAY=%SAY_",I" .E X %LIGHT .I %CVET W $S($D(%L1SCSAY("CV")):%L1SCSAY("CV"),1:%CV("YF")) .X %XMSG,%XCL N %X1,%Y1,%X2,%Y2 S %L1WH="" S %X1=$P(CRD,",",2)-$P(CRD,",",4),%X2=$P(CRD,",",2)-1 S %Y1=$P(CRD,","),%Y2=%Y1+$P($P(CRD,",",4),"*",2)-1 K %LS K %INV I $P(CRD,",",4)["!",$L(VL) S %INV="" S %S=VL D ^%L1WH K %L1WH,%INV END K %L1SCSAY X %XCL Q ; P Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) Q:%NN="" G SAY Q P1(%FIELD) ; Q:$G(%FIELD)="" Q:$G(%SCRN)="" Q:'$D(^SCR(%SCRN)) N %I,%FLD F %I=1:1:$L(%FIELD,",") S %FLD=$P(%FIELD,",",%I) Q:%FLD="" D .I %FLD["=" D ..I $E($P(%FLD,"=",2))'="""" S @($P(%FLD,"=")_"="""_$P(%FLD,"=",2)_""""),%FLD=$P(%FLD,"=") Q ..S @($P(%FLD,"=")_"="_$P(%FLD,"=",2)),%FLD=$P(%FLD,"=") Q .Q:$G(%FLD)="" .N %NN,%I S %NN=$G(^SCR(%SCRN,"P","NAME",%FLD)) Q:%NN="" D SAY %L1SCSAY %L1SCSAY ; [ 15.03.19 13:34 ] [ 01.02.07 15:57 ] [ 20.01.07 13:52 ] SAY ; N V,CRD,TYP,VL,%XX,%YY,%INV,%X1,%X2,%Y1,%Y2,%LS,%L1WH S V=^SCR(%SCRN,"P","NM",%NN) S CRD=^SCR(%SCRN,"P",%NN,"CRD") S TYP=^("TYP") U $P:(NOECHO:NOWRAP) ;:ESC) ;;I %TYPCRT["VT5" W $C(27,91),$P(CRD,",")+1,";",$P(CRD,",",2)+1-$S($E(TYP)'="H":0,1:($P(CRD,",",4))),";",$P(CRD,",")+1,";",$P(CRD,",",2)+1+$S($E(TYP)="H":0,1:$P(CRD,",",4)),"${" S VL=$G(@V) Q:VL?." "&(%TYPCRT["VT5") Q:+VL=0&(TYP="N")&(%TYPCRT["VT5") I $P(CRD,",",5)'>0,'%ENGLISH S VL=$J(VL,+$P(CRD,",",4)) I $P(CRD,",",5)'>0,%ENGLISH S VL=VL_$J("",$P(CRD,",",4)-$L(VL)) I TYP="N",$P(CRD,",",5)>0 S VL=$J(VL,$P(CRD,",",4),$P(CRD,",",5)) I +$TR(VL," ","")=0 S VL=$J("",$P(CRD,",",4)) I TYP="D",VL?6N S VL=$E(VL,1,2)_"."_$E(VL,3,4)_"."_$E(VL,5,6) I TYP="T",VL?6N S VL=$E(VL,1,2)_":"_$E(VL,3,4)_":"_$E(VL,5,6) ; I TYP'="HH" D G END .I TYP'="N",TYP'="EE" S %SAY=$$^%L1HB($E(VL,$L(VL)-$P(CRD,",",4)+1,$L(VL)))_"++"_$P(CRD,",")_","_$P(CRD,",",2)_","_$S(TYP="H":"HH",1:"EE") .I TYP="N" S %SAY=VL_"++"_$P(CRD,",")_","_$P(CRD,",",2)_","_$S(TYP="H":"HH",1:"EE") .I $P(CRD,",",4)["/",$L(VL)>$P(CRD,",",4) D ..S $P(%SAY,"++")="..."_$E(VL,$L(VL)-$P(CRD,",",4)+4,$L(VL)) .S $Y=$P(CRD,","),$X=$P(CRD,",",2) .I $P(CRD,",",4)["!",VL'?.P S %SAY=%SAY_",I" .E X %LIGHT .I %CVET W $S($D(%L1SCSAY("CV")):%L1SCSAY("CV"),1:%CV("YF")) .X %XMSG,%XCL ; N %X1,%Y1,%X2,%Y2 S %L1WH="" S %X1=$P(CRD,",",2)-$P(CRD,",",4),%X2=$P(CRD,",",2)-1 S %Y1=$P(CRD,","),%Y2=%Y1+$P($P(CRD,",",4),"*",2)-1 K %LS K %INV I $P(CRD,",",4)["!",$L(VL) S %INV="" S %S=VL D ^%L1WH K %L1WH,%INV END K %L1SCSAY X %XCL Q ; P Q:$G(%FNAME)="" N %NN S %NN=$G(^SCR(%SCRN,"P","NAME",%FNAME)) Q:%NN="" G SAY Q P1(%FIELD) ; Q:$G(%FIELD)="" Q:$G(%SCRN)="" Q:'$D(^SCR(%SCRN)) N %I,%FLD F %I=1:1:$L(%FIELD,",") S %FLD=$P(%FIELD,",",%I) Q:%FLD="" D .I %FLD["=" D ..I $E($P(%FLD,"=",2))'="""" S @($P(%FLD,"=")_"="""_$P(%FLD,"=",2)_""""),%FLD=$P(%FLD,"=") Q ..S @($P(%FLD,"=")_"="_$P(%FLD,"=",2)),%FLD=$P(%FLD,"=") Q .Q:$G(%FLD)="" .N %NN,%I S %NN=$G(^SCR(%SCRN,"P","NAME",%FLD)) Q:%NN="" D SAY %L1SCSP %L1SCSP ; [ 18.01.06 18:10 ] [ 27.11.01 5:31 PM ] [ 06.06.01 9:25 AM ] ;N %MBS,MRKV,COLG,%MBP,FILEOLD S %MBS("PAR",1)=" ;oezp xe`z;8,50;20;H;" D ^%L1MBS1 N %MBP S %MBP("D",1)=3 S %MBP("Z",1)="oezp cew" I S %GET="2 - izatl` , 1 - ixnep xcq++23,70,HH#1++1,E,I++12" D N^%L1GET Q:%S=""!($G(%TO)="END") S %SCNUM=(%S=1) I '%SCNUM D .K @("^TEMPAi"_$J) N %L1SCN,%L1SCN1 S %L1SCN="" F S %L1SCN=$O(@FILE@(%L1SCN)) Q:%L1SCN="" D ..S %S=$G(^(%L1SCN)) I %S[" " D ALL^%S1KA ..S %L1SCN1="" F %IJ=1:1:6 Q:%IJ>$L(%S) S %L1SCN1=%L1SCN1_$E(%S,$L(%S)-%IJ+1) ..;S $E(%L1SCN1,7,8)="\/" I %L1SCN1'["""",%L1SCN1'[")",%L1SCN1'["(",%L1SCN1'["," S @("^TEMPAi"_$J_"("""_%L1SCN1_%L1SCN_""")=""""") ..S $E(%L1SCN1,7,8)="\/" S @("^TEMPAi"_$J_"(%L1SCN1_%L1SCN)=""""") .S FILEOLD=FILE,FILE="^TEMPAi"_$J F I=1:1:COLS S %MBP("Z",I+1)=%MBS("Z",I),%MBP("D",I+1)=%MBS("D",I,1) S:$D(%MBS("DR",I)) %MBP("DR",I)=%MBS("DR",I) S %MBP("REF")=FILE_"(NOD)",%SKB1="(""",%SKB2=""")" S MRKV(1)="S RKV=$S(%SCNUM:NOD,1:$P(NOD,""\/"",2))" S MRKV(2)="S RKV=$S(%SCNUM:$G(@(FILE_""(NOD)"")),1:$G(@(FILEOLD_%SKB1_$P(NOD,""\/"",2)_%SKB2)))" I %SCNUM S IND=1 F I=1:1:COLS S MRKV(I+2)="S RKV=$P($G(@(FILE_""(NOD,"_IND_")"")),RZD,"_I_")" I '%SCNUM S IND=1 F I=1:1:COLS S MRKV(I+2)="S RKV=$P($G("_FILEOLD_"($P(NOD,""\/"",2),"_IND_")),RZD,"_I_")" S COLG=COLS+1 S %MBP("VGR")=2 I %UNIT S %MBP("NGR")=50 D ^%L1TS E S %MBP("NGR")=22 S %MBP("LG")=0,%MBP("PG")=79 K %SHL I '$$^%L1DISP(%UNIT) S %DEV="%UNIT" D OPEN^%L1LPT Q:%EROP U %UNIT W !! I '$$^%L1DISP(%UNIT) S %MBP("KOT")="W %L1OUT(""MDP"",""B""),?3,%SHL,$TR($$^%L1HB("" sc""),TS0,TSS),?15,$TR($$^%L1HB(NSNAME),TS0,TSS),%L1OUT(""MDP"",""N"")" I $$^%L1DISP(%UNIT) S %MBP("KOT")="W %CLI,%SHL X %XCL W "" sc"" S $X=6 W ?15,%CLI,NSNAME X %XCL" I $$^%L1DISP(%UNIT) X %chista D ^%L1PCL K @("^TEMPAi"_$J) I '$$^%L1DISP(%UNIT) S %DEV="%UNIT" D CLOSE^%L1LPT Q HB(ST) Q $$^%L1HB(ST) %L1SCSV %L1SCSV ; DATA INPUT [ 31.05.09 16:01 ] [ 14.05.02 9:14 AM ] [ 29.06.01 9:51 AM ] INP ; ------------------- INPUT U $P:(NOECHO:NOWRAP) K %L1MBS D ^%L1MBS ISHUR ; D IS3^%L1GET G:$G(%TO)="END"!(%S=0) END G:%S=2!(%S=3) ZAP G INP Q ZAP ; S @(FILE_"(STRING)")=%MBS("O",1) D KF D SF S IND=1,J=0 F I=2:1:COLS S:%MBS("Z",I)["~" IND=IND+1,J=0 S J=J+1 S $P(@(FILE_"(STRING,IND)"),RZD,J)=%MBS("O",I) END Q SF ;--- INPUT: FILE,STRING,RZD ;---- OUTPUT: S FILEi N IN,IN1,I,JJ,SSS Q:STRING="" Q:'$D(@(FILE_"(STRING)")) I '$D(RZD) N RZD S RZD="\" I FILE="^NAME" S SSS=$P($G(@(FILE_"(STRING,1)")),RZD) I SSS'="" D IND(SSS) Q S SSS=$P($G(@(FILE_"(STRING)")),RZD) I SSS'="" D IND(SSS) Q IND(SSS) ; N I,IN,IN1 Q:$G(SSS)="" D:'$D(%L1SCSV("NOKF")) KF S SSS=$TR(SSS,"/.;,()"""," ") F I=1:1:$L(SSS," ") S IN=$P($P(SSS," ",I),RZD) I IN'="" D .D IN1 .S @(FILE_"i(IN1,STRING)")="" Q KF ; ;--- INPUT: FILE,STRING,RZD ;---- OUTPUT: K FILEi N IN,IN1,I,JJ,SSS Q:STRING="" I '$D(RZD) S RZD="\" I FILE="^NAME" S SSS=$G(@(FILE_"(STRING,1)")) E S SSS=$TR($G(@(FILE_"(STRING)")),"/.;,()"""," ") G KF2 KF1(FILE,STRING,SSS,RZD) ; N IN,IN1,I,JJ Q:$G(SSS)="" KF2 ; F I=1:1:$L(SSS," ") S IN=$P($P(SSS," ",I),RZD) I IN'="" D .D IN1 .Q:IN1="" K @(FILE_"i(IN1,STRING)") ;K STRINGOLD Q IN1 ; S:IN>0 IN=+IN I IN?1N.N!(IN?1U.U.P) S IN1=IN E S IN1="" F JJ=1:1:$L(IN) S IN1=$E(IN,JJ)_IN1 Q %L1SCSV1 %L1SCSV ; DATA INPUT [ 01/18/93 2:59 AM ] INP ; ------------------- INPUT U $P:(NOECHO:NOWRAP) K %L1MBS D ^%L1MBS ISHUR ; S %GET=" - rval `l, 2 - rval, 1 - owzl" D N^%L1GET G:$G(%TO)="END" END G:%S=2 ZAP G INP Q ZAP S @(FILE_"(STRING)")=%MBS("O",1) D KF D SF S IND=1,J=0 F I=2:1:COLS S:%MBS("Z",I)["~" IND=IND+1,J=0 S J=J+1 S $P(@(FILE_"(STRING,IND)"),RZD,J)=%MBS("O",I) END Q SF Q:'$D(@(FILE_"(STRING)")) S SSS=$P($G(@(FILE_"(STRING)")),RZD) I SSS'="" D .D KF .F I=1:1:$L(SSS," ") S IN=$P($P(SSS," ",I),RZD) I IN'="" D ..S IN1="" F JJ=1:1:$L(IN) S IN1=$E(IN,JJ)_IN1 ..S @(FILE_"i(IN1,STRING)")="" Q KF ; Q:$G(STRINGOLD)="" N STRING S STRING=STRINGOLD F I=1:1:$L($G(@(FILE_"(STRING)"))," ") S IN=$P($P($G(@(FILE_"(STRING)"))," ",I),RZD) I IN'="" D .S IN1="" F JJ=1:1:$L(IN) S IN1=$E(IN,JJ)_IN1 .Q:IN1="" K @(FILE_"i(IN1,STRING)") K STRINGOLD Q %L1SCSZ %L1SCSZ ; ASK NUMBER ; OUTPUT: STRING [ 02/03/97 8:35 AM ] X %chista ; K STRING N %SCBEG,%SCSOF S %SCBEG=0,%SCSOF=0 S:$G(STRING)="" %SCBEG=1 ZAPR1 U $P:(NOECHO:NOWRAP) K %ECHO S %HBRY="" S %SAY=NSNAME X %XMSGV S %SAY=" - zncew dniyx, - d`a dniyx, - dbvd , - my itl yetig" X %XMSGN S:'$D(FILE("Z")) FILE("Z")=" : oezp cew" S %GET=FILE("Z")_"++3,70,HH#"_$G(STRING)_"++"_FILE(1)_","_$G(FILE("REGKEY"),"E")_",I" S %FL="" D ^%L1GET Z1 I %TO="PGDW" G:%SCSOF SOF S STRING=$O(@(FILE_"($G(STRING))")),%S=STRING S %SCSOF=$S(STRING?.P:1,1:0),%SCBEG=0 D PCT^%L1SCS G ZAPR1 I %TO="PGUP" G:%SCBEG BEG S STRING=$ZP(@(FILE_"($G(STRING))")),%S=STRING S %SCBEG=$S(STRING?.P:1,1:0),%SCSOF=0 D PCT^%L1SCS G ZAPR1 I %TO="F7" D DAFUS^%L3MBGS G ZAPR1 I %TO="F6" D POISK^%L3MBGS G ZAPR1 K %INV,%FL,%L1 G:%S=""!($G(%TO)="END") END K STRING S STRING=%S ;S %GET=" : oezp cew++3,70,HH#"_$G(STRING) END S %XX=0,%YY=4 X %POSIC,%chiste Q BEG S %SAY=" ! mipezp zligz " W *7 X %XMSGV H 2 W %vverxe,%chists G ZAPR1 SOF S %SAY=" ! mipezp seq " W *7 X %XMSGV H 2 W %vverxe,%chists G ZAPR1 %L1SCV %L1SCV ; [ 10.12.06 17:38 ] [ 21.04.02 9:56 AM ] [ 14.03.02 11:02 AM ] G(%SCRN,%ST) ; N R,%I,NM S R=^SCR(%SCRN,"G","RZD") F %I=1:1 Q:'$D(^SCR(%SCRN,"G","NM",%I)) S NM=^(%I) I NM?."%"1U.E S @NM=$P(%ST,R,%I) Q P(%SCRN,%ST) ; N R,%I,NM S R=^SCR(%SCRN,"G","RZD") F %I=1:1 Q:'$D(^SCR(%SCRN,"G","NM",%I)) S NM=^(%I) I NM?."%"1U.E S $P(@%ST,R,%I)=@NM Q SCG(SCRN,ST,RZD) ; SHURA ^SCR(SCRN) I SCRN="" S ST1="" Q ST1 I '$D(^SCR(SCRN)) S ST1="<"_SCRN_">" Q ST1 I $D(^SCR(SCRN,"G"))<10 S ST1="<"_SCRN_"(G)>" Q ST1 I '$D(^SCR(SCRN,"G","STG")) S ST1="<"_SCRN_"(STG)>" Q ST1 S %STG=^("STG") S ST1="" N EN S EN=($G(^SCR(%SCRN))="E") N %I F %I=1:1 Q:'$D(^SCR(SCRN,"G",%I)) D .N %DL,%SC,%HE,%DL1,%GR S %SC=^(%I,"CRD") .I 'EN S %DL=$L($P(%STG,":",$L(%STG,":")-%I)) .I EN S %DL=$L($P(%STG,":",%I+1)) .S %DL1=$P(%SC,",",5) .S %HE=$P(%SC,",",3),%GR=$P(ST,RZD,%I) .S %GR=$S(%HE="N":$J(%GR,%DL,%DL1),1:$$HBR^%L1FRM(%GR,%DL)) .I 'EN S ST1=%GR_" "_ST1 .I EN S ST1=ST1_" "_%GR I 'EN S ST1=$P(%STG,":")_" "_ST1 I EN S ST1=$P(%STG,":")_ST1 Q ST1 SCH ; HEAD N MAS,SMB1,SMB2,%SCRN,CRD,SC,ST,ST1,%I,%I1,%SHP S %SCRN=%SCV("SCRN") ;,SC=%SCV("SC") S %SHP=$G(%SCV("SHP"),%SCRN_"v") N %NN,%NB S %NN="" F S %NN=$O(%SCV("MS",%NN)) Q:%NN="" D .Q:'$G(^SCR(%SCRN,"P","NAME",%NN)) .S %NB=^(%NN) S MAS(%NB)=%SCV("MS",%NN) .S CRD=^SCR(%SCRN,"P",%NB,"CRD") .I $P(CRD,",",3)["H" D ..N LN S LN=$P(CRD,",",4) ..I LN["/" S LN=$P(LN,"/",2) ..S MAS(%NB)=$E(MAS(%NB),$L(MAS(%NB))-LN+1,255) .I $P(CRD,",",3)["E",%ENGLISH S MAS(%NB)=$$SPA^%L1FRM(MAS(%NB)) S MAS(%NB)=$E(MAS(%NB),1,$P(CRD,",",4)) S MAS(%NB)=MAS(%NB)_$J("",$P(CRD,",",4)-$L(MAS(%NB))) .I $P(CRD,",",5) S MAS(%NB)=$J(MAS(%NB),$P(CRD,",",4),$P(CRD,",",5)) S %NN="" F S %NN=$O(%SCV("MS1",%NN)) Q:%NN="" I %NN?1N.N S MAS(%NN)=%SCV("MS1",%NN) N %STRS S %I1=0 F %I=1:1 Q:'$D(^SHP(%SHP,%I)) S ST=^(%I) S:ST["$" %I1=%I1+1 Q:%SCV="V"&%I1 I ST'["$",(%SCV="V"&'%I1)!(%SCV="N"&(%I1=2)) D .I ST'["{",ST'["}",ST'["[",ST'["]",ST'["#" D W Q .S SMB1="{",SMB2="}" D FIG S SMB1="[",SMB2="]" D FIG .I ST["#" S %W1=0,ST1=$P(ST,"#") D S ST=ST1 ..;F %II=2:1:$L(ST,"#") S %W1='%W1 S:%W1 ST1=ST1_%CLI_" "_$P(ST,"#",%II) S:'%W1 ST1=ST1_" "_$C(27,91,48,109)_$S($D(%CL0):%CL0,1:"")_$P(ST,"#",%II) ..F %II=2:1:$L(ST,"#") S %W1='%W1 S:%W1 ST1=ST1_%CLI_$P(ST,"#",%II) S:'%W1 ST1=ST1_$C(27,91,48,109)_$S($D(%CL0):%CL0,1:"")_$P(ST,"#",%II) .D W Q W S ^TMPS111($J,$ZP(^TMPS111($J,99999))+1)=$E(ST,1,255) Q FIG N P1,P2,%IN I '$D(%ENGLISH) D ^%L1C F S P1=$F(ST,SMB1) S:'P1 P1=1000 S P2=$F(ST,SMB2) S:'P2 P2=1000 Q:P1+P2>1000 D .S %IN=0 .I $E(ST,P1)?1N S %IN=+$E(ST,P1,P1+1) .E I $E(ST,P2-2)?1N S %IN=+$TR($E(ST,P2-3,P2-2)," ","") .I '%ENGLISH S $E(ST,P1-1,P2-1)=$J($G(MAS(%IN)),P2-P1+1) Q .I %ENGLISH S $E(ST,P1-1,P2-1)=$G(MAS(%IN))_$J("",P2-P1+1-$L($G(MAS(%IN)))) Q Q %L1SDAT %L1SDAT ; [ 11.10.15 12:05 ] [ 09.11.12 17:57 ] [ 08.09.12 11:46 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C X %chista S %SAY=" drye jix`z zxcbd " X %XMSGV ZD S %GET="jix`z++3,70,HH#"_$$^%L1DC($H,1)_"++8,D,I" D ^%L1GET Q:%S?.P!(%TO="END") S DAT=%S S DD=$E(DAT,1,2) S MM=$E(DAT,3,4) S YY=$E(DAT,5,6) S TM=$$T^%L1TIME($H) S ST="sudo date -s 20"_YY_"-"_MM_"-"_DD U $P W !!?20 ZSY ST ZT S %GET="dry++3,50,HH#"_TM_"++8,T,I" D ^%L1GET I %S?.P!(%TO="END") G ZT S TM=%S U $P W !!?20 ZSY "sudo date -s "_$E(TM,1,2)_":"_$E(TM,3,4) ZSY "sudo /sbin/hwclock --systohc" S %GET=" ugl" D N^%L1GET Q %L1SERV SERVMD ; [ 19.07.04 16:43 ] [ N CMD S CMD=$ZCMD I $P(CMD,":")="mly" D H .S $ZROUTINES=^UCI("MLR"),$ZGBLDIR=^UCI("MLG") .D @$P(CMD,":",2) .S $ZROUTINES=^UCI("MGR"),$ZGBLDIR=^UCI("MGG") ; S $ZROUTINES=^UCI("MGR"),$ZGBLDIR=^UCI("MGG") D @$S(CMD[":":$P(CMD,":",2),1:CMD) H %L1SF %L1SF ; [ 15.03.19 14:31 ] [ 07.03.19 19:15 ] [ 03.03.19 17:57 ] K D ^%L1C U $P:(NOECHO:NOWRAP:CTRAP=$C(3)) K ^S000($P) S ^%TYPCRT(%L3MYDVN)="VT510" D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":^%ET" ;R A Q:A'=2206 ZCOD X %chista S:$G(%SCRN)="" %SCRN=$G(^SCR) S %FL=1,%GET="SCREEN CODE ( ? - LIST ) :++3,20,EE#"_$G(%SCRN)_"++8,E,I++++++^SCR\\\\V" D ^%L1GET Q:%S=""!($G(%TO)="END") I %S="?" D G ZCOD .S MAC="^SCR",%L1("EU")=1 S %L1("TXT")="S %L1NS(%I)=$J($G(^SCR(%NXN,""NAME"")),30)_"" | ""_$J(%NXN,8)" .S %L1("BE")=8 .D ^%L1NU Q:FLAG'="" S %SCRN=INDEX S %SCRN=%S ZHBR K HBR S %GET="HEBREW - H , ENGLISH - E:++14,20,EE#"_$G(^SCR(%SCRN))_"++1,E,I++EH" D ^%L1GET G:%S=""!($G(%TO)="END") ZCOD S NM=0 S MDFP="" I %S="H" S HBR="",%HBRY="" I %S'=$G(^SCR(%SCRN)) S ^SCR(%SCRN)=%S K MDFP S %GET="SCREEN NAME:++5,20,EE++RB,WF#"_$G(^SCR(%SCRN,"NAME"))_"++30,"_$S($D(HBR):"H",1:"E")_",I" D ^%L1GET S ^SCR(%SCRN,"NAME")=%S I '$D(MDFP) G REG1 ; I $N(^SCR(%SCRN,-1))<0 G REG1 Z0 K MDFP I $G(%CVET) S %CL00=%CL0,%CL0=%CL1 S %GET="MODIFY SCREEN - {}1{}, MODIFY PARAMETERS - {}2{}, MODIFY GROUP -{}3{} , VIEW - {}4{}" D NE^%L1GET S:$D(%CL00) %CL0=%CL00 I %S=""!($G(%TO)="END") G ZCOD I "1234"'[%S D TER G Z0 I %S=2 S MDFP="" D VSVP Q:$G(%TO)="END" G CP I %S=3 S %PAR="G" D CC G CPA I %S=4 D VSVP D PRINT G Z0 REG1 K MDFP F I=1:1 Q:'$D(^SCR(%SCRN,I)) S ^S000($P,I)=^SCR(%SCRN,I) D:$D(HBR) .S SS=^SCR(%SCRN,I) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S ^S000($P,I,"%TOP")=II-($E(SS,II)'=" ") S U=1 K L,R S SCR=$G(^SCR(%SCRN)) K ^SCR1(%SCRN) S MAC1="^SCR(%SCRN)",MAC2="^SCR1(%SCRN)" D ^%S1GC1 S2 S %TIP="G",%PRHBR=$S($D(HBR):1,1:0),RL=79,%RMAX=79,TXT=%SCRN D ^%S2ERG1 S %GET="SAVE - 99" D N^%L1GET S:%TO="F9" %S=99 I %S'=99,%S'="Y",%S'="y",%S'="k" G ZCOD F I=1:1 Q:'$D(^S000($P,I)) I I>23 S %GET=" 99 - xey`l. jqna zexey icn xzei" D N^%L1GET I %S'=99 G S2 X %chista S %GET="NEW SCREEN CODE :++22,20,EE#"_$G(%SCRN)_"++8,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") ZCOD S %SCRN0=%SCRN,%SCRN=%S I %S'=%SCRN0,$D(^SCR(%S)) K %Q S %Q("Z")="SCREEN "_%S_" EXIST ! REWRITE",%Q("Y")=12,%Q("X")=10 D ^%S1ASK G:'YES ZCOD S %NAME=$G(^SCR(%SCRN,"NAME")) K ^SCR(%SCRN) ;F I=1:1:22 Q:'$D(^S000($P,I)) S ^SCR(%SCRN,I)=^S000($P,I) F I=1:1 Q:'$D(^S000($P,I)) S ^SCR(%SCRN,I)=^S000($P,I) K ^S000($P,I) S ^SCR(%SCRN)=SCR,^SCR(%SCRN,"NAME")=%NAME K SCR S MAC1="^SCR1(%SCRN0,""P"",""REF"")" S MAC2="^SCR(%SCRN,""P"",""REF"")" D ^%S1GC1 ;----------------------------------------------- OBR-KA &&& ----- D SV(%SCRN) ;----------------------------------------------- OBR-KA PARAM ----- CP S %PAR="P" D CC S %GET="FOR A WORK WITH GROUP REKVIZIT PRESS , EXIT - " D N^%L1GET I $G(%TO)="END" G CPA S %SAY="WORK WITH GROUP REKVIZIT" X %XMSGN S %PAR="G" D CC CPA K %L1GET D VSVP D ^%L1SCA D PRINT S %GET="COMMENT :++23,1,EE#++65,E,I" D ^%L1GET S ^%ERGS(+$H,"^SCR("_%SCRN,$P($H,",",2))=%S S ^%ERGS(+$H,"^SCR("_%SCRN)=$P($ZG,"/",$L($ZG,"/")) S ^SCR=%SCRN G %L1SF END Q PRINT ; S %GET=$S('$D(^SHP(%SCRN_"s")):"CREATE",1:"EDIT")_" PRINT FORM - 99 ?#2" D NE^%L1GET I %S'=99 G PR0 S YES=1 I $D(^SHP(%SCRN_"s")) K %Q S %Q("Y")=24,%Q("X")=10,%Q("Z")=" PRINT FILE EXIST ! OWERWRITE " D ^%S1ASK I YES D ^%L1SFSH D .N (%UPRCOD,%XMSG,%MSC,%XMSGV,%XMSGN,%SCRN,HBR) D ^%L1C .S KOD=%SCRN_"s" D REG2^%S277 PR0 S %GET=$S('$D(^SHP(%SCRN_"v")):"CREATE",1:"EDIT")_" VIEW FORM - 99 ?#2" D NE^%L1GET Q:%S'=99 D .N (%UPRCOD,%XMSG,%MSC,%XMSGV,%XMSGN,%SCRN,HBR) D ^%L1C .S KOD=%SCRN_"v" .S NAM=$S($D(^SHP(KOD))#10:^SHP(KOD),1:"") G:$D(^SHP(KOD,1)) PR1 .K ^SHP(KOD) .F I=1:1 Q:'$D(^SCR(%SCRN,I)) S ^SHP(KOD,I)=^(I) PR1 .D REG2^%S277 Q CC ; S NM=.9 N %L1SF S %L1SF="" K ^SCR(%SCRN,%PAR,"NEW") F K NM1 S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM'>0 D Q:NM="" I NM>.9 D:$G(NM1)="A" VSVP,VSVALL X:$D(VSVI) "K VSVI D VSV" S:$D(NM1) NM=NM-1 I $G(%TO)="END" S NM=$O(^SCR(%SCRN,%PAR,NM),-1) Q:NM="" S %TO="" I NM>0 S NM=$O(^SCR(%SCRN,%PAR,NM),-1) .D PODVAL S VSVI="" D VSV S %L1GET="",HZG=1 D Z K %L1GET S HZG=0 D Z I %PAR="G",'$D(^SCR(%SCRN,"G",1)) Q I %PAR="P",$D(^SCR(%SCRN,%PAR))<10 Q K %Q S %Q("Y")=23,%Q("X")=10 S %XX=0,%YY=%Q("Y") X %POSIC W %chists S %Q("Z")="ARE YOU SHURE " D ^%S1ASK G:'YES CC F S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM="" I NM>0,$G(^SCR(%SCRN,%PAR,"NM",NM))'?1U.E D .S %SAY="HASN'T NAME !" W *7 X %XMSGN H 2 .D PODVAL S VSVI="" D VSV S %L1GET="",HZG=1 D Z K %L1GET S HZG=0 D Z CG I %PAR="G" D ^%L1SFGZ S %Q("Z")="ARE YOU SHURE " D ^%S1ASK G:'YES CG I %PAR="P" D ^%L1SFPZ S %Q("Z")="ARE YOU SHURE " D ^%S1ASK G:'YES CG Q Z S ZT=$ZT D ^%L1SFZ S $ZT=ZT Q ; VSV G:%PAR="G" VSVG S CRD=^SCR(%SCRN,%PAR,NM,"CRD"),CRDY=$P(CRD,",")-1,CRDX=$P(CRD,",",2),TYP=$P(CRD,",",3),CRDL=$P(CRD,",",4) I CRDL<3 S CRDL=3 S %SAY=$S(TYP'["H":"{",1:$J(NM,CRDL-1))_$S(TYP["H":"}",1:NM_$J("",CRDL-$L(NM)-1))_"++"_CRDY_","_CRDX_","_$S(TYP["H":"HH",1:"EE")_$S($D(VSVI):",I",1:"") X %XMSG I TYP="HH" F II=1:1:$P(CRDL,"*",2)-1 S %SAY=$J("",+CRDL)_"++"_(CRDY+II)_","_CRDX_",HH,I" X %XMSG Q VSVG S CRD=^SCR(%SCRN,%PAR,NM,"CRD"),CRDY=^SCR(%SCRN,%PAR,"VG"),CRDX=$P(CRD,",",2) S:CRDX["+" CRDY=CRDY+1 S TYP=$P(CRD,",",3),CRDL=$P(CRD,",",4) ; I CRDL<3 S CRDL=3 S %SAY=$S(TYP'["H":"{",1:$J(NM,CRDL-1))_$S(TYP["H":"}",1:NM_$J("",CRDL-$L(NM)-1))_"++"_CRDY_","_CRDX_",HH"_$S($D(VSVI):",I",1:"") X %XMSG I TYP="HH" F II=1:1:$P(CRDL,"*",2)-1 S %SAY=$J("",+CRDL)_"++"_(CRDY+II)_","_CRDX_",HH,I" X %XMSG Q PODVAL S CRDY=+^SCR(%SCRN,%PAR,NM,"CRD") S FSTY=$S(CRDY<12:19,1:1) I FSTY'=$G(FSTYOLD) D VSVALL S FSTYOLD=FSTY PDV1 S %XX=0 F II=0:1:3 S %YY=FSTY+II X %POSIC W %chists S Y1=FSTY,X1=1,Y2=FSTY+5,X2=80 D ^%L1RBUA Q ; CRDST N JJ,SMB S IOLD=I F JJ=$L(ST):-1:1 S SMB=$E(ST,JJ) S JJOLD=JJ D CRDH:SMB="}",CRDE:SMB="{" S JJ=JJOLD Q VSVALL X %chista I $D(HBR) W %HBR S %HBRY="" N I,L,R S L=0,R=79 N HB S HB=($G(^SCR(%SCRN))="H") F I=1:1 Q:'$D(^SCR(%SCRN,I)) D .W $$W^%L1C($G(^(I))),! Q .;;W !,$S(HB:$TR($TR(^(I),%TES1,%TES2),%TEN,%THB),1:^(I)) Q VSVP K %ECHO N NM,%PAR,Y1,Y2,X1,X2 D VSVALL S %PAR="P" D VSVPR S %PAR="G" D VSVPR I $D(^SCR(%SCRN,"G","RB")) D .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^("RB"),",",J) .I %TYPCRT["VT" S Y1=Y1-1 I $D(^SCR(%SCRN,"G","RB")) D ^%L1RBUA VSVPZ S %GET="NUMERIC SHOW -1, MNEMONIC -2, P-GLOBAL -3, G-GLOBAL -4, EXIT - #1" D NE^%L1GET Q:%S=""!($G(%TO)="END") I %S=1 D VSVALL G VSVPZ I %S=2 G VSVP I %S=3 D ^%L1SFPZ G VSVPZ I %S=4 S (FSTY,FSTYOLD)=19 D ^%L1SFGZ G VSVPZ Q VSVPR S NM="" F S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM="" I $D(^SCR(%SCRN,%PAR,"NM",NM))#2 S CRD=$G(^SCR(%SCRN,%PAR,NM,"CRD")) D .I $P(CRD,",",3)'="HH" S %SAY=$J(^SCR(%SCRN,%PAR,"NM",NM),$P(CRD,",",4))_"++"_(($P(CRD,",")-1)+($P(CRD,",",2)["+"))_","_$P(CRD,",",2)_","_$S($P(CRD,",",3)["H"!(%PAR="G"):"HH",1:"EE")_",I" X %XMSG Q .N %X1,%Y1,%X2,%Y2 S %L1WH="" .S %X1=$P(CRD,",",2)-$P(CRD,",",4),%X2=$P(CRD,",",2)-1,%Y1=$P(CRD,","),%Y2=%Y1+$P($P(CRD,",",4),"*",2)-1 K %LS ;D ^%L1WH .S %INV="",%L1WH="",%L1WH("CVF")=%CV("BF") S %S=$G(^SCR(%SCRN,%PAR,"NM",NM)) D ^%L1WH K %L1WH,%INV ; S N="" F S N=$O(^SCR(%SCRN,"P","RB",N)) Q:N="" D .N Y1,Y2,X1,X2 .S J=0 F I="Y1","X1","Y2","X2" S J=J+1 S @I=$P(^(N),",",J) .I %TYPCRT["VT" S Y1=Y1-1,Y2=Y2-1 .D ^%L1RBUA .Q Q TER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 Q CRDH ; N NM,L,JJJ Q:$E(ST,JJ-1)=" " S NM=+$TR($E(ST,JJ-2,JJ-1)," ","") Q:NM'>0 S L=3 F JJJ=JJ-3:-1:1 Q:$E(ST,JJJ)'=" " S L=L+1 D CRDC S CRDH=$G(^SCR(%SCRN,%PAR,NM,"CRD")) S ^SCR(%SCRN,%PAR,NM,"CRD")=IOLD_","_JJOLD_","_$S($P(CRDH,",",3)["H":$P(CRDH,",",3),1:"H")_","_$S(L<$P(CRDH,",",4)!($P(CRDH,",",4)=""):L,1:$P(CRDH,",",4)) Q CRDE ; Q:$E(ST,JJ+1)=" " S NM=+$TR($E(ST,JJ+1,JJ+2)," ","") Q:NM'>0 S L=3 F JJJ=JJ+3:1:$L(ST) Q:$E(ST,JJJ)'=" " S L=L+1 D CRDC S CRDE=$G(^SCR(%SCRN,%PAR,NM,"CRD")) S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",1,2)=IOLD_","_(JJOLD-1) S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",4)=$S(L<$P(CRDE,",",4)!($P(CRDE,",",4)=""):L,1:$P(CRDE,",",4)) S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",3)=$S($P(CRDE,",",3)["H":"E",1:$P(CRDE,",",3)) S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",5)=$S($P(CRDE,",",3)'="N":0,1:$P(CRDE,",",5)) Q CRDC ; S MAC1="^SCR1(%SCRN0,%PAR,NM)",MAC2="^SCR(%SCRN,%PAR,NM)" D ^%S1GC1 S MAC1="^SCR1(%SCRN0,%PAR,""NM"",NM)",MAC2="^SCR(%SCRN,%PAR,""NM"",NM)" D ^%S1GC1 S NN1=$G(^SCR1(%SCRN0,%PAR,"NM",NM)) I $L(NN1) S ^SCR(%SCRN,%PAR,"NAME",NN1)=NM S ^SCR(%SCRN,%PAR,NM,"LMAX")=L Q CRDGR D ^%L1SFG Q CRDRB ; N RB,Y1,Y2,X1,X2,I,I1,N,ST,SMB F I=1:1 Q:'$D(^SCR(%SCRN,I)) S ST=^SCR(%SCRN,I) I ST["["!(ST["]") D .F I1=1:1:$L(ST) S SMB=$E(ST,I1) D ..I SMB="[" S SMB1=$E(ST,I1+1) I SMB1?1N S RB(SMB1,"L")=(I+1)_"*"_I1 Q ..I SMB="]" S SMB1=$E(ST,I1-1) I SMB1?1N S RB(SMB1,"P")=(I+1)_"*"_I1 Q ; S N="" F S N=$O(RB(N)) Q:N="" I $D(RB(N,"P")),$D(RB(N,"L")) D .S Y1=$P(RB(N,"P"),"*"),Y2=$P(RB(N,"L"),"*",1) .S X1=$P(RB(N,"P"),"*",2),X2=$P(RB(N,"L"),"*",2) .Q:Y1=Y2!(X1=X2) .I Y1>Y2 S Y=Y1,Y1=Y2,Y2=Y .I X1>X2 S X=X1,X1=X2,X2=X .S ^SCR(%SCRN,"P","RB",N)=Y1_","_X1_","_Y2_","_X2 Q SV(%SCRN) ; N I,ST,%PAR,SCR X %chista F I=1:1 Q:'$D(^SCR(%SCRN,I)) D .S ST=^SCR(%SCRN,I) I ST["{"!(ST["}") S %PAR="P" D CRDST Q .I ST["$" S %PAR="G" D CRDGR .Q D CRDRB Q %L1SFCR %L1SFCR ; CREATE A PROGRAM TEMPLATE [ 07/09/96 12:26 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC) D ^%L1C S %LC("PROG")="P2EZM" S %LC("PROGNAME")="TEST PROGRAM" S %LC("FRST")="MUZAR" S %LC("FRST1")="MUZAR1" S %LC("TMP")="^TEMP($P,""EZ"")" S %LC("TMP1")="^TEMP($P,""EZ""" S %LC("GLB")="^P1EZI(MUZAR)" S %LC("GLB1")="^P1EZI(MUZAR" S %LC("GLBN")="$$SHEM^P1P(%NXN)" K ^TMPS111($J),^S110($J) S I1=0 X "ZR ZL %L1SFCRT F II=2:1 S A=$T(+II) Q:A="""" W !,A ";S B=$$RPLA^%L1FRM(A,""%LC"",""{"",""}"") I B'="""" S I1=I1+1,^TMPS111($J,I1)=B" %L1SFCRT %L1SFCRT ; CREATE A PROGRAM TEMPLATE [ 07/09/96 12:11 PM ] M ; {PROGNAME} N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C,^P1IN BEG S %SCRN={SCR},(%SCVA,%SCVG)=1 D A^%L1SC K %SCVA,%SCVG BEG1 S FRST=0,%FNAME={FRST} D GETF^%L1SC Q:%BS I $D(^{GLB}) D G @LAB .D REST .D V^%L1SC,VG^%L1SC ZB .S %GET=" 0 - lhal, 2 - qitcdl ,1 - okcrl#1" D N^%L1GET .I $G(%TO)="PGUP"!($G(%TO)="PGDW") S %SC("VIEW")=%TO S %L1SCBEG=1 D VG^%L1SC K %L1SCBEG G ZB .I %S=""!($G(%TO)="END") S LAB="BEG1" Q .I %S=0 D DS K {TMP} S LAB="BEG" Q .I %S=1 S LAB="BEG2" Q .I %S=2 D ^%L1SCPC S LAB="BEG" Q D V^%L1SC,VG^%L1SC BEG2 S %L1SCBEG=1 D GETFG^%L1SC D IS^%L1GET I 'YES K {TMP} G BEG D SAVE G BEG1 ; REST ; I %OLDTO="F9" D HZG S %OLDTO="" Q N N,I,EM S I=0 K {TMP} S N="" F S N=$O({GLB1},N)}) Q:N="" D .S I=I+1 .S {TMP1},I)={GLB1},N) S {TMP}=$G({GLB}) Q SAVE ; Q DS ;--- DELETE Q HZG S FLAG="" S MAC=$P(@({GLB0} K %L1 S %L1("EU")=1,%L1("BE")=6 S %L1("TXT1")="{GLBN}<>20\/%NXN<>8" D ^%L1NU I FLAG'="" S %SC("ST")=1 Q S {FRST}=INDEX,{FRST1}={GLBN} Q %L1SFCV %L1SFCV ; CVET <--> BLI CVET [ 11/03/93 3:51 PM ] D ^%L1C S %SCRN="" F S %SCRN=$O(^SCR(%SCRN)) Q:%SCRN="" D ^%L1SCA Q %L1SFG %L1SFG ; [ 19.01.07 12:39 ] [ 09/16/2000 9:26 AM ] [ 09/03/2000 10:56 AM ] CRDGR ; N GRY1,GRX1,GRY2,GRX2,II,STG,SMB,SMB1,SP,SP1,NM,L,CRDE,STG K %MPOZ S GRY1=I,GRX1=$F(ST,"$")-2 F II=GRY1+1:1:23 Q:'$D(^SCR(%SCRN,II)) Q:^(II)["$" Q:'$D(^(II)) Q:^(II)'["$" S GRY2=II,GRX2=$F(^(II),"$")-2 Q:GRY2'>GRY1 Q:GRX2=GRX1 I GRX2>GRX1 S GRX=GRX2,GRX2=GRX1,GRX1=GRX+1 S SMB1=":" F II=GRY1:1:GRY2 Q:'$D(^SCR(%SCRN,II)) Q:^SCR(%SCRN,II)[SMB1 Q:'$D(^(II)) Q:^(II)'[SMB1 S STG=^(II) ; S ^SCR(%SCRN,%PAR,"VG")=II+1,GRY=II N S01 S S01=$E($G(^SCR(%SCRN,II+1)),GRX2,GRX1) ;I S01[":" S STG=S01 S ^SCR(%SCRN,%PAR,"VG")=$S(S01[":"!(S01["\"):II+3,1:II+2),GRY=II ; $S(II>12:II+2,1:II+3),GRY=II S ^SCR(%SCRN,%PAR,"STG")=STG F II="REF","STEP","MAX","RZD","DEL" S ^SCR(%SCRN,%PAR,II)=$G(^SCR1(%SCRN0,%PAR,II)) S SP=0 I $$SCRHBR F II=$L(STG):-1:1 S SMB=$E(STG,II) I SMB=":" S SP=SP+1 S %MPOZ(SP)=II-1 I '$$SCRHBR K %MPOZ F II=1:1:$L(STG) S SMB=$E(STG,II) I SMB=":" S SP=SP+1 S %MPOZ(SP)=II+1 S SP1=SP,SP=0 C F II=SP+2:1 Q:'$D(%MPOZ(II)) D .S NM=II-1 S L=%MPOZ(II-1)-%MPOZ(II)-1 .I '$$SCRHBR S L=%MPOZ(II)-%MPOZ(II-1)-1 .D CRDC^%L1SF N X S X=%MPOZ(II-1) I '$$SCRHBR S X=X+L-1 .S CRDE=$G(^SCR(%SCRN,%PAR,NM,"CRD")) K ^SCR1(%SCRN0,%PAR,NM) .S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",1,2)=(GRY+1)_","_$S(SMB1="\":"+",1:"")_X .S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",4)=$S(L<$P(CRDE,",",4)!($P(CRDE,",",4)<1):L,1:$P(CRDE,",",4)) .S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",3)=$S($P(CRDE,",",3)?.P:"H",1:$P(CRDE,",",3)) .S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",",5)=$S($P(CRDE,",",3)'="N":0,1:$P(CRDE,",",5)) .S ^SCR(%SCRN,%PAR,NM,"SHEM")=$E(STG,%MPOZ(II)+2,%MPOZ(II-1)) .I '$$SCRHBR S ^SCR(%SCRN,%PAR,NM,"SHEM")=$E(STG,%MPOZ(II-1),%MPOZ(II)-2) .Q I SMB1="\" D G M .S NM="" F S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM="" I NM?1N.N S $P(^SCR(%SCRN,%PAR,NM,"CRD"),",")=$P(^SCR(%SCRN,%PAR,NM,"CRD"),",")+1 .I ^SCR(%SCRN,%PAR,"STEP")=1 S ^("STEP")=2 S SMB1="\" F II=GRY:1:GRY2 Q:^SCR(%SCRN,II)[SMB1 I ^(II)[SMB1 S SP=SP1-1 D S SP=SP1-1 G C ;;S ^("VG")=^SCR(%SCRN,%PAR,"VG")+1 G C .S STG=^(II) .I $$SCRHBR F II=$L(STG):-1:1 S SMB=$E(STG,II) I SMB="\" S SP=SP+1 S %MPOZ(SP)=II-1 .I '$$SCRHBR F II=1:1:$L(STG) S SMB=$E(STG,II) I SMB="\" S SP=SP+1 S %MPOZ(SP)=II+1 .Q M S ^SCR(%SCRN,%PAR,"RB")=(GRY1+1)_","_(GRX2+1)_","_(GRY2+1)_","_(GRX1+1) Q SCRHBR(STAM) ; I %ENGLISH Q 0 I $G(^SCR(%SCRN))="H" Q 1 Q 0 %L1SFGZ %L1SFGZ ; [ 07.03.19 18:54 ] [ 08.03.05 12:35 ] [ 08/04/93 1:55 PM ] S %PAR="G" D PODVAL S %L1GET="",HZG=1 D ZN K %L1GET S HZG=0 D ZN Q:$G(%TO)="END" K %L1GET S ^SCR(%SCRN,%PAR,"REF")=NAME S ^SCR(%SCRN,%PAR,"RZD")=RZD S ^SCR(%SCRN,%PAR,"STEP")=STEP S ^SCR(%SCRN,%PAR,"MAX")=MAX S ^SCR(%SCRN,%PAR,"DEL")=DEL I DEL'="Y",DEL'="y" K ^("DEL") Q ZN S NAME=$G(^SCR(%SCRN,%PAR,"REF")) S %GET="GLOBAL++"_FSTY_",2,EE#"_NAME_"++25,E,I" D ^%L1GET G:HZG ZD I $G(%TO)="END"!(%S="") S %TO="END" Q S NAME=%S I $P(NAME,"(")'?."^"1U.U.N.U D TER G ZN S:$E(NAME)'="^" NAME="^"_NAME S:$E(NAME,$L(NAME))=")" NAME=$E(NAME,1,$L(NAME)-1) S:$E(NAME,$L(NAME))="," NAME=$E(NAME,1,$L(NAME)-1) ZD S RZD=$G(^SCR(%SCRN,%PAR,"RZD")) S %GET="DELIMITER ++"_FSTY_",32,EE#"_RZD_"++2,E,I" D ^%L1GET G:HZG Z1 K %L1GET I $G(%TO)="END"!(%S="") G ZN S RZD=$TR(%S," ","") Z1 K %INV S STEP=$G(^SCR(%SCRN,%PAR,"STEP"),1) ZT S %GET="STEP++"_FSTY_",50,EE#"_STEP_"++2,E,I++0123456789" D ^%L1GET K:'HZG %L1GET G:HZG ZL G:$G(%TO)="END"!(%S="") ZN S STEP=%S ZL S MAX=$G(^SCR(%SCRN,%PAR,"MAX"),99999) S %GET="HOW MUCH LINE ++"_(FSTY+1)_",5,EE#"_MAX_"++5,E,I" D ^%L1GET Q:HZG K %L1GET I $G(%TO)="END"!(%S="") G Z1 S MAX=%S ZDEL S DEL=$G(^SCR(%SCRN,%PAR,"DEL"),"N") S %GET="DELETE IT'S POSSIBLE (Y/N) ? ++"_(FSTY+1)_",35,EE#"_DEL_"++1,E,I++YyNn" D ^%L1GET Q:HZG K %L1GET I $G(%TO)="END"!(%S="") G ZL S DEL=%S Q PODVAL S CRDY=+$G(^SCR(%SCRN,%PAR,"VG")) S FSTY=$S(CRDY<12:20,1:1) I FSTY'=FSTYOLD D VSVALL^%L1SF S FSTYOLD=FSTY S %XX=0 F II=0:1:3 S %YY=FSTY+II X %POSIC W %chists S Y1=FSTY,X1=1,Y2=FSTY+4,X2=80 D ^%L1RBUA Q TER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 Q %L1SFPZ %L1SFPZ ; [ 08.03.05 12:34 ] [ 06/30/94 11:37 AM ] S %PAR="P" N STR,NAME,STR,RZD,MN,I,VR,ER S MN=1,NAMEOLD="",STROLD="" S %NN="" F S %NN=$O(^SCR(%SCRN,%PAR,"NAME",%NN)) Q:%NN="" K ^(%NN,"KEY") P D PODVAL S %L1GET="",HZG=1 D ZN K %L1GET S HZG=0 D ZN I %TO="END" S:MN'>1 MN=2 S MN=MN-1 G P ; G:$G(%TO)="END" END K %L1GET D:NAME=""&(NAMEOLD'="") KILL G:NAME="" END G:RZD="" END ; F I=1:1:$L(STR,RZD) S VR=$P(STR,RZD,I) I VR'?.P,$D(^SCR(%SCRN,%PAR,"NAME",VR)) S ^SCR(%SCRN,%PAR,"NAME",VR,"REF")="$P($G("_NAME_"),"""_RZD_""","_I_")" S ^SCR(%SCRN,%PAR,"NAME",VR,"REF1")="$P("_NAME_","""_RZD_""","_I_")" ;*** LEV 24.04.94 F I=1:1:$L(STR,RZD) S VR=$P(STR,RZD,I) I VR'?.P S ^SCR(%SCRN,%PAR,"NAME",VR,"REF")="$P($G("_NAME_"),"""_RZD_""","_I_")" S ^SCR(%SCRN,%PAR,"NAME",VR,"REF1")="$P("_NAME_","""_RZD_""","_I_")" ;*** LEV 24.04.94 I NAME["(" D .N NAME1,NAME2,NAME3 S NAME1=$P($P(NAME,"(",2),")"),NAME3="" .F I=1:1:$L(NAME1,",") S NAME2=$P(NAME1,",",I) I NAME2?1U.E,$D(^SCR(%SCRN,%PAR,"NAME",NAME2)) S NAME3=NAME3_NAME2_",",^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY")="" .S NAME3=$E(NAME3,1,$L(NAME3)-1) .I NAME3'="" S NAME2=$P(NAME3,",",$L(NAME3,",")) Q:NAME2="" .F IR=1:1 Q:'$D(^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY",IR)) .S ^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY",IR)=NAME3_"/\"_$TR(STR,RZD,",") S ^SCR(%SCRN,%PAR,"REF",MN)=NAME S ^SCR(%SCRN,%PAR,"REF",MN,"STR")=STR S ^SCR(%SCRN,%PAR,"REF",MN,"RZD")=RZD S MN=MN+1 G P END Q ZN S NAME=$G(^SCR(%SCRN,%PAR,"REF",MN)),NAMEOLD=NAME S %GET="GLOBAL "_MN_"++"_FSTY_",2,EE#"_NAME_"++25,E,I" D ^%L1GET G:HZG ZD S:%TO="PGUP" %TO="END" I $G(%TO)="END"!($G(%TO)="PGDW"),'$D(^SCR(%SCRN,%PAR,"NEW")) Q S NAME=%S I NAME="" Q I $P(NAME,"(")'?."^"1U.U.N.U D TER G ZN S:$E(NAME)'="^" NAME="^"_NAME S:$E(NAME,$L(NAME))="," NAME=$E(NAME,1,$L(NAME)-1)_")" S:$E(NAME,$L(NAME))'=")" NAME=$E(NAME,1,$L(NAME)-1)_")" ZD S RZD=$G(^SCR(%SCRN,%PAR,"REF",MN,"RZD")) S %GET="DELIMITER ++"_FSTY_",50,EE#"_RZD_"++2,E,I" D ^%L1GET G:HZG ZL K %L1GET I $G(%TO)="END"!(%S="") G ZN S RZD=$TR(%S," ","") ZL S STR=$G(^SCR(%SCRN,%PAR,"REF",MN,"STR")),STROLD=STR ZL1 S %SAY="STRUCTURE ++"_(FSTY+1)_",3,EE#" X %XMSG S %Y1=FSTY+2,%Y2=FSTY+3,%X1=2,%X2=78 S %S=STR D ^%L1WE K %X1,%Y1,%X2,%Y2 Q:HZG I $G(%TO)="END"!(%S="") G ZD S STR=%S S ER=0 F I=1:1:$L(STR,RZD) S VR=$P(STR,RZD,I) I VR'="",VR'?1U.U.N.U.N D TER S ER=1 Q G:ER ZL1 K ^SCR(%SCRN,%PAR,"NEW") Q PODVAL S FSTY=19 ; I FSTY'=FSTYOLD D VSVALL^%L1SF ; S FSTYOLD=FSTY S %XX=0 F II=0:1:4 S %YY=FSTY+II X %POSIC W %chists S Y1=FSTY,X1=1,Y2=FSTY+5,X2=80 D ^%L1RBUA Q TER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 Q KILL ; F I=1:1:$L(STROLD,RZD) S VR=$P(STROLD,RZD,I) I VR'?.P,$D(^SCR(%SCRN,%PAR,"NAME",VR)) K ^SCR(%SCRN,%PAR,"NAME",VR,"REF") K ^SCR(%SCRN,%PAR,"NAME",VR,"REF1") I NAMEOLD["(" D .N NAME1,NAME2,NAME3 S NAME1=$P($P(NAMEOLD,"(",2),")"),NAME3="" .F I=1:1:$L(NAME1,",") S NAME2=$P(NAME1,",",I) I NAME2?1U.E,$D(^SCR(%SCRN,%PAR,"NAME",NAME2)) S NAME3=NAME3_NAME2_"," K ^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY") .S NAME3=$E(NAME3,1,$L(NAME3)-1) .I NAME3'="" S NAME2=$P(NAME3,",",$L(NAME3,",")) Q:NAME2="" .F IR=1:1 Q:'$D(^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY",IR)) .K ^SCR(%SCRN,%PAR,"NAME",NAME2,"KEY",IR) K ^SCR(%SCRN,%PAR,"REF",MN) K ^SCR(%SCRN,%PAR,"REF",MN,"STR") K ^SCR(%SCRN,%PAR,"REF",MN,"RZD") Q %L1SFSH %L1SFSH ; SCR --> SHP [ 25.04.13 12:28 ] [ 001/19/00 3:12 PM ] N %ST,%I,%I1 S %SHP=%SCRN_"s" L ^SHP(%SHP):2 E U 0 S %SAY=" xg` jqnn uaew mr micaer " X %XMSGV Q K ^SHP(%SHP) S %FLDLR=0,%I1=0 N %COLS S %GET="izveaw dcya zexey dnk" D N^%L1GET Q:$G(%TO)="END" S %COLS=%S F %I=1:1 Q:'$D(^SCR(%SCRN,%I)) D .S %ST=^SCR(%SCRN,%I) .I %ST["$" S %FLDLR='%FLDLR S (SMB1,SMB2)="$" D FIG Q .I %ST[":" I %FLDLR S SMB1=":" S %JJJ1=0 D:$G(^SCR(%SCRN,%I+1))[":" WW D:$G(^SCR(%SCRN,%I+1))'[":" KOT D D:$G(^SCR(%SCRN,%I+1))'[":" FP Q ..I ^SCR(%SCRN,%I+1)["\" S %I=%I+1 S %ST=^(%I) S SMB1="\" D KOT Q .I %ST'["{",%ST'["}",%ST'["[",%ST'["]" D W Q .S SMB1="{",SMB2="}" D FIG1 .S SMB1="[",SMB2="]" D FIG .D W .Q Q W S %I1=%I1+1 S ^SHP(%SHP,%I1)=%ST U 0 W !,%ST Q WW N %STO S %STO=%ST S %STK=":"_$P(%ST,":",2,$L(%ST,":")-1)_":" S (KAV,%ST)=$J("",$L($P(%STO,":")))_$TR($J("",$L(%STK))," ","-") D W S %ST=$TR(%STO,":","|") D W Q FIG N P1,P2,P3 F S P1=$F(%ST,SMB1) S:'P1 P1=1000 S P2=$F(%ST,SMB2) S:'P2 P2=1000 Q:P1+P2=2000 D .I P1(P1+2) $E(%ST,P1-2+P10)=">" Q ..I %SMBN1 S $E(%ST,P1-1)="&",$E(%ST,P2-1)=">" Q ..I %SMBN2 S $E(%ST,P2-3,P2-1)=" >",$E(%ST,P1-1,P1+$L(%SMBN2)-1)="&"_%SMBN2 Q .I %SMBN2 S $E(%ST,P2-3,P2-1)=">" .I %SMBN2 S P3=P2-$P(^SCR(%SCRN,"P",+%SMBN2,"CRD"),",",4)-1 S $E(%ST,P3,P3+$L(%SMBN2)-1)="&"_%SMBN2 Q KOT ; ;N CRD,LMAX,P1,%JJJ,%STO,%STK,%STB S %ST=$TR(%ST,"\",":") S %STO=%ST S %STK=":"_$P(%ST,":",2,$L(%ST,":")-1)_":" I SMB1=":",$G(^SCR(%SCRN,%I-1))'[":" S (KAV,%ST)=$J("",$L($P(%STO,":")))_$TR($J("",$L(%STK))," ","-") D W I SMB1=":" S %ST=%STO,%KG=$L(%ST,":"),%ST=$TR(%ST,":","|") D W I ^SCR(%SCRN,%I+1)["\" S %ST=$TR(^(%I+1),"\","|") D W I SMB1=":" S %ST=KAV D W S %STB=$P(%STO,":")_$S(SMB1="\":" ",1:"$") S %ST="" ;F %JJJ=$S(SMB1="\":$L(%STK,":")+%KG-2,1:$L(%STK,":"))-1:-1:$S(SMB1="\":%KG,1:2) D I '%ENGLISH F %JJJ=$L(%STK,":")-1:-1:2 D CRD I %ENGLISH F %JJJ=2:1:$L(%STK,":")-1 D CRD I $E(%ST)=":" S %ST=$E(%ST,2,255) I $E(%ST,$L(%ST))'=":" S %ST=%ST_":" S %ST=%STB_%ST_$S(SMB1="\":2,1:"1") D W Q FP S %ST="" F %JJJ=1:1:%COLS-2 D W S %ST=$J("",$L($P(%STO,":")))_$J("",$L(%STK)) S $E(%ST,$L(%ST)-1)="$" D W S %ST=$G(KAV) D W Q CRD ; S %JJJ1=%JJJ1+1 S CRD=^SCR(%SCRN,"G",%JJJ1,"CRD"),LMAX=^SCR(%SCRN,"G",%JJJ1,"LMAX") I $P(CRD,",",3)="H"!($P(CRD,",",3)="E") S %ST=$$ST($TR($J("",LMAX)," ","T"),%ST) Q I $P(CRD,",",5)>0 S %ST=$$ST($J($TR($J("",$P(CRD,",",4)-$P(CRD,",",5)-1)," ",9)_"."_$TR($J("",$P(CRD,",",5))," ",9),LMAX),%ST) Q S %ST=$$ST($J($TR($J("",$P(CRD,",",4))," ",9),LMAX),%ST) Q Q ST(ST2,ST1) I %ENGLISH Q ST1_":"_ST2 Q ST2_":"_ST1 %L1SFZ %L1SFZ ; [ 04.02.22 11:28 ] [ 07.03.19 19:15 ] [ 21.05.09 11:09 ] ;"NEW" - NADO ZAK-T Z ; N $ZT S $ZT="ZG "_$ZL_":INTR^%L1SFZ" S %FL="" S %GET="NUMBER++"_FSTY_",1,EE#"_NM_"++2,E,I++++DOUBLE - D, RENUMBER - N , CLEAR - C "_$S(%PAR="G":", RIGHT/LEFT SHIFT - SR,SL",1:"")_", VIEW - " D ^%L1GET S %SAY="" X %XMSGN I $G(%TO)="END"!($G(%TO)="UP")!($G(%TO)="PGUP") S %TO="END" Q:$D(^SCR(%SCRN,%PAR,"NEW"))<10 I %S="",$D(^SCR(%SCRN,%PAR,"NEW"))<10 S NM="" Q I $G(%TO)="DW"!($G(%TO)="PGDW"),$D(^SCR(%SCRN,%PAR,"NEW"))<10 Q I %S="A" S NM1="A" Q I %S="" G Z S CHECK="N",RZD="\" ; I %S="D"!(%S="N"),%PAR="P" D S NM1=%S Q .N NEW,OLD,NEWCRD,NEWLM,OPT,OLDCRD,OLDLM S OPT=%S ZOLD .S %GET="OLD NUMBER:++24,10,EE,,,C#"_NM_"++2,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") .S OLD=%S I '$D(^SCR(%SCRN,%PAR,"NM",OLD)) W *7 G ZOLD .S %GET="NEW NUMBER:++24,30,EE#++2,E,I" D ^%L1GET S NEW=%S .I $D(^SCR(%SCRN,%PAR,NEW,"TYP")) W *7 S %SAY=" DEFINED !" X %XMSGN H 2 Q .I '$D(^SCR(%SCRN,%PAR,NEW,"CRD")) W *7 S %SAY=" NOT EXIST !" X %XMSGN H 2 Q .D RNMB ; I %S="C",%PAR="P" D S NM1=%S Q .N NEW,OLD,NEWCRD,NEWLM .S %GET=" CLEAR NUMBER:" D NE^%L1GET Q:%S=""!($G(%TO)="END") S NEW=%S .I '$D(^SCR(%SCRN,%PAR,NEW,"CRD")) W *7 S %SAY=" NOT EXIST !" X %XMSGN H 2 Q .D CLEAR ; I %S="SR",%PAR="G" D S NM=$ZP(^SCR(%SCRN,%PAR,NM)) S:NM="" NM=.9 Q .N %S .S OPT="N" N MAX S MAX=$ZP(^SCR(%SCRN,%PAR,999)) .N I,NEW,OLD F I=MAX:-1:NM+1 S NEW=I,OLD=I-1 D RNMB ; I %S="SL",%PAR="G" D S NM=$ZP(^SCR(%SCRN,%PAR,NM)) S:NM="" NM=.9 Q .N %S .S OPT="N" N MAX S MAX=$ZP(^SCR(%SCRN,%PAR,999)) .N I,NEW,OLD F I=NM:1:MAX-1 S NEW=I,OLD=I+1 D RNMB .S NEW=MAX D CLEAR ; I %S="SW" D S NM=$ZP(^SCR(%SCRN,%PAR,NM)) S:NM="" NM=.9 Q .N NMB,NEW,OLD,OPT ZSW .S %GET="SWAP WITH NUMBER:#3" D N^%L1GET Q:%S=""!($G(%TO)="END") .I '$D(^SCR(%SCRN,%PAR,%S)) X %XMSGV("ER") G ZSW .S NMB=%S .S OPT="N" S NEW=.9,OLD=NM S ^SCR(%SCRN,%PAR,NEW,"CRD")="1,1",^("LMAX")=1 D RNMB .S NEW=NM,OLD=NMB D RNMB .S NEW=NMB,OLD=.9 D RNMB .S NEW=.9 D CLEAR ; I '$D(^SCR(%SCRN,%PAR,%S)) D TER G Z I %S>NM,$D(^SCR(%SCRN,%PAR,"NEW"))>10 D TER G Z I %S'=NM K VSVI D VSV S NM=+$TR($J(%S-1,2)," ",0) Q G S MUMPS1=$G(^SCR(%SCRN,%PAR,NM,"MUMPS1")) ; S MUMPS2=$G(^SCR(%SCRN,%PAR,NM,"MUMPS2")) ; S NLN=20,TOPB=8,VRB="",CREAT="N",NS="" S FUNCTION=$G(^SCR(%SCRN,%PAR,NM,"FNC")) S GLOB=$G(^SCR(%SCRN,%PAR,NM,"GLOB")) I GLOB'?.P D .S NLN=$G(^SCR(%SCRN,%PAR,NM,"NLN"),30) ; .S TOPB=$G(^SCR(%SCRN,%PAR,NM,"TOPB"),8) ; .S VRB=$G(^SCR(%SCRN,%PAR,NM,"VRB")) ; .S CREAT=$S($D(^SCR(%SCRN,%PAR,NM,"CREAT")):"Y",1:"N") .S CHECK=$S($D(^SCR(%SCRN,%PAR,NM,"CHECK")):"Y",1:"N") .S NS=$G(^SCR(%SCRN,%PAR,NM,"NS")) .S RZD=$G(^SCR(%SCRN,%PAR,NM,"RZD")) S (NAME,NAMEOLD)=$G(^SCR(%SCRN,%PAR,"NM",NM)) S TYP=$P($G(^SCR(%SCRN,%PAR,NM,"CRD")),",",3),TYP1=$G(^SCR(%SCRN,%PAR,NM,"TYP")) S DROBL=+$P($G(^SCR(%SCRN,%PAR,NM,"CRD")),",",5) S LENGTH=$P($G(^SCR(%SCRN,%PAR,NM,"CRD")),",",4),LMAX=$G(^SCR(%SCRN,%PAR,NM,"LMAX")) S MUST=$S($D(^SCR(%SCRN,%PAR,NM,"MUST")):"Y",1:"N") S OUTPUT=$S($D(^SCR(%SCRN,%PAR,NM,"OUTPUT")):"Y",1:"N") S HELP=$G(^SCR(%SCRN,%PAR,NM,"HELP")) ZN ;S NAME=$G(^SCR(%SCRN,%PAR,"NM",NM)) S %GET="NAME++"_FSTY_",11,EE#"_NAME_"++8,E,I" D ^%L1GET S:$G(%TO)="UP" %TO="END" G:HZG Z1 I $G(%TO)="END"!(%S="") G Z S NAME=%S I NAME'?1U.U.N.U D TER G ZN I $D(^SCR(%SCRN,%PAR,"NAME",NAME)),$G(^(NAME))'=NM D TER G ZN Z1 K %INV ;S TYP=$P($G(^SCR(%SCRN,%PAR,NM,"CRD")),",",3),TYP1=$G(^SCR(%SCRN,%PAR,NM,"TYP")) I TYP="E",TYP1'="",TYP1'="H" S TYP=TYP1 I TYP="E",TYP1="" S TYP="N" ; I TYP="H" S %L1GET="" ZT S %GET="TYP(E,N,H,HH,D,T,B)?++"_FSTY_",26,EE#"_TYP_"++2,E,I++BENHDTC?" D ^%L1GET K:'HZG %L1GET G:HZG ZL S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") ZN I %S="?" S %SAY="E - ENG, H - HBR, N - NUM , D - DATE, T - TIME, HH - FILD HBR DOUBLE" X %XMSGV H 3 G ZT I %S="H"!(%S="HH"),TYP'="H",TYP'="HH",%PAR="P" D TER G ZT I %S'="H",%S'="HH",TYP="H"!(TYP="HH"),%PAR="P" D TER G ZT S TYP=%S I TYP="D",$G(^SCR(%SCRN,%PAR,NM,"LMAX"))<8 D TER G ZT I (TYP="T"),$G(^SCR(%SCRN,%PAR,NM,"LMAX"))<5 D TER G ZT ZL S %FL="" ;S LENGTH=$P($G(^SCR(%SCRN,%PAR,NM,"CRD")),",",4),LMAX=$G(^SCR(%SCRN,%PAR,NM,"LMAX")) I TYP="HH" S %SAY=" EXAMPLE:60*2 " X %XMSGV I TYP="D" S LENGTH=8,LMAX=8 S %L1GET="" I TYP="C" S LENGTH=16,LMAX=16 S %L1GET="" I TYP="T" S LENGTH=5,LMAX=5 S %L1GET="" I TYP="B" S LENGTH=1,%L1GET="" S %GET="LENGTH++"_FSTY_",48,EE#"_LENGTH_"++6,E,I" D ^%L1GET G:HZG Z2 K %L1GET S:$G(%TO)="UP" %TO="END" I $G(%TO)="END"!(%S="") G Z1 S LENGTH=%S I TYP="D"!(TYP="T") G Z2 I +LMAX,LENGTH>LMAX,'HZG D TER G ZL I TYP="HH",%S'["*" D TER G ZL I TYP="HH",$P(%S,"*")*$P(%S,"*",2)>250 D TER G ZL Z2 I TYP'="N" S DROBL=0 G Z3 S %GET="AFTER DOT++"_FSTY_",64,EE#"_DROBL_"++1,E,I++0123456789" D ^%L1GET G:HZG Z3 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") Z1 S DROBL=%S Z3 ;S MUST=$S($D(^SCR(%SCRN,%PAR,NM,"MUST")):"Y",1:"N") S %GET="MUST (Y/N) ?++"_(FSTY+1)_",8,EE#"_MUST_"++1,E,I++YNyn" D ^%L1GET G:HZG Z31 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") ZL S MUST=%S Z31 ;S OUTPUT=$S($D(^SCR(%SCRN,%PAR,NM,"OUTPUT")):"Y",1:"N") S %GET="OUTPUT (Y/N) ?++"_(FSTY+1)_",28,EE#"_OUTPUT_"++1,E,I++YNyn" D ^%L1GET G:HZG Z32 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") Z3 S OUTPUT=%S Z32 ;S GLOB=$G(^SCR(%SCRN,%PAR,NM,"GLOB")) S %GET="FIND TO GLOBAL++"_(FSTY+1)_",48,EE#"_GLOB_"++8,E,I" D ^%L1GET Q:HZG&(GLOB="") G:HZG Z330 S:$G(%TO)="UP" %TO="END" I %S="",GLOB?."^".E1A.E K ^SCR(%SCRN,%PAR,NM,"GLOB") G:$G(%TO)="END" Z31 S GLOB=%S I GLOB="" G Z4 I $G(^SCR(%SCRN,%PAR,NM,"HELP"))="" S ^("HELP")=" - dbvd , - my zlgzd itl yetig " Z330 ; S %XX=1,%YY=FSTY+2 X %POSIC X %XCL W $J("",78) I GLOB?.P G Z4 S %GET="CHECK (Y/N)++"_(FSTY+2)_",2,EE#"_CHECK_"++1,E,I" D ^%L1GET G:HZG Z33 S:$G(%TO)="UP"!(%S="") %TO="END" G:$G(%TO)="END" Z32 S CHECK=%S Z33 ; S %GET="NAME LENGTH++"_(FSTY+2)_",17,EE#"_NLN_"++2,E,I" D ^%L1GET G:HZG Z331 S:$G(%TO)="UP"!(%S="") %TO="END" G:$G(%TO)="END" Z330 S NLN=%S Z331 ; ;S TOPB=$G(^SCR(%SCRN,%PAR,NM,"TOPB"),8) ; S %GET="TOP BOUNDARY++"_(FSTY+2)_",34,EE#"_TOPB_"++2,E,I" D ^%L1GET G:HZG Z34 S:$G(%TO)="UP"!(%S="") %TO="END" G:$G(%TO)="END" Z33 S TOPB=%S Z34 ; ;S VRB=$G(^SCR(%SCRN,%PAR,NM,"VRB")) ; S %GET="TO VARIABLE++"_(FSTY+2)_",52,EE#"_VRB_"++8,E,I" D ^%L1GET G:HZG Z35 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END" Z331 S VRB=%S G:VRB="" Z35 I VRB'?1U.U.N.U D TER G ZN Z35 ; S %GET="DELIMITER++"_(FSTY+3)_",2,EE#"_RZD_"++2,E,I" D ^%L1GET G:HZG Z350 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") Z34 S RZD=%S Z350 ; S %GET="FUNCTION KEYS++"_(FSTY+3)_",25,EE#"_FUNCTION_"++19,E,I" D ^%L1GET G:HZG Z351 S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END" Z34 S FUNCTION=%S Z351 S %GET="CREATE (Y/N/1) ?++"_(FSTY+3)_",58,EE#"_CREAT_"++2,E,I++1YNyn" D ^%L1GET Q:HZG S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") Z35 S CREAT=%S I "Y1y1"'[CREAT S NS="" G Z4 Z36 ; ;S NS=$G(^SCR(%SCRN,%PAR,NM,"NS")) ;I CREAT[1 D TV^%L1TABL D VSVALL^%L1SF G Z4 S %GET="GLOBAL HEADER++"_(FSTY+3)_",25,EE#"_NS_"++38,"_$S($D(HBR):"H",1:"E")_",I" D ^%L1GET S:$G(%TO)="UP" %TO="END" G:$G(%TO)="END"!(%S="") Z35 S NS=%S Z4 ;S MUMPS1=$G(^SCR(%SCRN,%PAR,NM,"MUMPS1")) ; X %XCL S %SAY="MUMPS COMMAND 1: ++"_(FSTY+2)_",1,EE" X %XMSG W $J("",30) ;K %FL S %GET="++"_(FSTY+3)_",1,EE#"_MUMPS1_"++76,E,I" D ^%L1GET K %LS S %S=MUMPS1,%Y1=FSTY+3,%Y2=FSTY+5,%X1=1,%X2=78,%INV="" D ^%L1WE K %INV S %L1WE="" D ^%L1WE K %L1WE I %S="<" S %GET=" DOUBLE FROM NUMBER:#" D NE^%L1GET G:%S="" Z4 G:'$D(^SCR(%SCRN,%PAR,%S,"MUMPS1")) Z4 S MUMPS1=^("MUMPS1") G Z4 S:$G(%TO)="UP"!($G(%TO)="PGUP") %TO="END" G:$G(%TO)="END" Z32 I %S'=MUMPS1,MUMPS1'="" D IS1^%L1GET I 'YES G Z4 S MUMPS1=%S Z5 X %XCL ;S MUMPS2=$G(^SCR(%SCRN,%PAR,NM,"MUMPS2")) ; S %SAY="MUMPS COMMAND 2 : ++"_(FSTY+2)_",1,EE" X %XMSG ;S %GET="++"_(FSTY+3)_",1,EE#"_MUMPS2_"++76,E,I" D ^%L1GET K %LS N %OLDTO S %S=MUMPS2,%Y1=FSTY+3,%Y2=FSTY+5,%X1=1,%X2=78,%INV="" D ^%L1WE K %INV S %OLDTO=%TO S %L1WE="" D ^%L1WE K %L1WE I %S="<" S %GET=" DOUBLE FROM NUMBER:#" D NE^%L1GET G:%S="" Z5 G:'$D(^SCR(%SCRN,%PAR,%S,"MUMPS2")) Z5 S MUMPS2=^("MUMPS2") G Z5 S %TO=%OLDTO S:$G(%TO)="UP"!($G(%TO)="PGUP") %TO="END" G:$G(%TO)="END" Z4 I %S'=MUMPS2,MUMPS2'="" D IS1^%L1GET I 'YES G Z5 S MUMPS2=%S Z6 ; X %XCL ;S HELP=$G(^SCR(%SCRN,%PAR,NM,"HELP")) S %SAY="HELP:++"_(FSTY+2)_",1,EE" X %XMSG W $J("",30) S %GET="++"_(FSTY+3)_",2,EE#"_HELP_"++77,"_$S($D(HBR):"H",1:"E")_",I++++> - COPY HELP" D ^%L1GET S:$G(%TO)="UP"!($G(%TO)="PGUP") %TO="END" G:$G(%TO)="END" Z5 S HELP=%S I HELP="<" S %GET=" DOUBLE FROM NUMBER:#" D NE^%L1GET G:%S="" Z6 G:'$D(^SCR(%SCRN,%PAR,%S,"HELP")) Z6 S HELP=^("HELP") G Z6 S CRD=^SCR(%SCRN,%PAR,NM,"CRD") S CRD=$P(CRD,",",1,2)_","_TYP_","_LENGTH_","_DROBL S ^SCR(%SCRN,%PAR,NM,"CRD")=CRD S ^SCR(%SCRN,%PAR,NM,"TYP")=TYP S ^SCR(%SCRN,%PAR,NM,"MUMPS1")=MUMPS1 S ^SCR(%SCRN,%PAR,NM,"MUMPS2")=MUMPS2 I NAMEOLD'="" K ^SCR(%SCRN,%PAR,"NAME",NAMEOLD) S ^SCR(%SCRN,%PAR,"NAME",NAME)=NM S ^SCR(%SCRN,%PAR,NM,"HELP")=HELP S ^SCR(%SCRN,%PAR,"NM",NM)=NAME I "yY"'[MUST K ^SCR(%SCRN,%PAR,NM,"MUST") E S ^SCR(%SCRN,%PAR,NM,"MUST")="" I "yY"'[OUTPUT K ^SCR(%SCRN,%PAR,NM,"OUTPUT") E S ^SCR(%SCRN,%PAR,NM,"OUTPUT")="" K ^SCR(%SCRN,%PAR,NM,"VRB"),^("NS") I GLOB?.P K ^SCR(%SCRN,%PAR,NM,"NLN"),^("TOPB"),^("VRB"),^("CREAT"),^("NS"),^("CHECK"),^("RZD"),^("FNC") I GLOB?."^".E1A.E S ^SCR(%SCRN,%PAR,NM,"GLOB")=GLOB,^("NLN")=NLN,^("TOPB")=TOPB,^("CHECK")=CHECK,^("RZD")=RZD,^("FNC")=FUNCTION K:CHECK="N" ^("CHECK") D I VRB'?.P S ^("VRB")=VRB .I "yY"'[CREAT K ^SCR(%SCRN,%PAR,NM,"CREAT") .E S ^SCR(%SCRN,%PAR,NM,"CREAT")="",^("NS")=NS I %PAR="G" S VSVI="" K ^SCR(%SCRN,%PAR,"NEW",NM) Q VSV D VSV^%L1SF Q TER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 Q INTR I $ZS["CTRAP" S $ZT="ZG "_$ZL_":INTR^%L1SFZ" G Z4 Q RNMB ; N NEWCRD,NEWLM,MAC1,MAC2,OLDCRD,OLDLM S NEWCRD=^SCR(%SCRN,%PAR,NEW,"CRD") S MAC1="^SCR(%SCRN,%PAR,OLD)",MAC2="^SCR(%SCRN,%PAR,NEW)" D ^%S1GC1 I OPT="N" S MAC1="^SCR(%SCRN,%PAR,""NM"",OLD)",MAC2="^SCR(%SCRN,%PAR,""NM"",NEW)" D ^%S1GC1 I OPT="N",$G(^SCR(%SCRN,%PAR,"NM",OLD))?1U.E S ^SCR(%SCRN,%PAR,"NAME",^SCR(%SCRN,%PAR,"NM",OLD))=NEW S OLDCRD=^SCR(%SCRN,%PAR,OLD,"CRD"),OLDLM=^("LMAX") S ^SCR(%SCRN,%PAR,NEW,"CRD")=$P(NEWCRD,",",1,2)_","_$P(OLDCRD,",",3,5) I OPT="N" D ;K ^SCR(%SCRN,%PAR,OLD),^SCR(%SCRN,%PAR,"NM",OLD) S ^SCR(%SCRN,%PAR,OLD,"CRD")=OLDCRD,^("LMAX")=OLDLM .N NEW S NEW=OLD D CLEAR S ^SCR(%SCRN,%PAR,"NEW",NEW)="",^SCR(%SCRN,%PAR,"NEW")="" Q CLEAR ; N NEWCRD,NEWLM I $D(^SCR(%SCRN,%PAR,NEW,"CRD")) S NEWCRD=^("CRD"),NEWLM=^("LMAX") K ^SCR(%SCRN,%PAR,NEW) I $G(^SCR(%SCRN,%PAR,"NM",NEW))?1U.E K ^SCR(%SCRN,%PAR,"NAME",^SCR(%SCRN,%PAR,"NM",NEW)) K ^SCR(%SCRN,%PAR,"NM",NEW) I $D(NEWCRD),$D(NEWLM),NEW'<1 S ^SCR(%SCRN,%PAR,NEW,"CRD")=NEWCRD,^("LMAX")=NEWLM Q %L1SGK %L1SGK ;CDS;DISK BLOCK DUMP; [ 04/28/94 2:59 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1984 S $ZT="ZG "_$ZL_":ERR1^%L1SGK" W !?10,$P($P($ZV,","),"-")," - Block Dump Utility" O 63::0 E U 0 W !,"VIEW BUFFER IN USE, TRY LATER." Q S %LR="",R="" K %POINT O 54:("#GLOBAL.RES":"W") ASK G:$D(%INT) EXIT S $ZT="ZG "_$ZL_":ERR1^%L1SGK" U 0 R !,"FROM BLOCK: ",%BN G EXIT:%BN=""!(%BN="^Q"),DEV:%BN="^" G:%BN'="?" ASK1 W !,"Enter block number in one of the following forms:",! W !," bn",!," vn:bn",!," bn:vg",!," vn:bn:vg",!," exp",!," *",! W !,"Where vn is the volume number (0 is the default)," W !?6,"bn is the relative block number," W !?6,"vg is a 'G' followed by the volume group index (default is current)." W !?6,"exp is a MUMPS expression (i.e., X+3)," W !?6,"* means the block currently in the View buffer.",! G ASK ASK1 ; S $ZT="ZG "_$ZL_":ERR^%L1SGK" R !," TO BLOCK: ",%BNF G EXIT:%BNF=""!(%BNF="^Q"),DEV:%BNF="^" R !," GLOBAL: ",%GLB G EXIT:%GLB=""!(%GLB="^Q"),DEV:%GLB="^" I %GLB'["(" S %GLB=%GLB_"(" R !,"ALL BLOCKS ? (1/0) : ",%ALLBLK I %ALLBLK'=1 S %ALLBLK=0 DEV S %DEV=$P U 0 D:%DEV=$P CRT^%SDEV G:$D(QUIT) EXIT S %ID='(%DEV=$P) D SCRL G:%SC="^" DEV G:%SC="^Q" EXIT ASK2 ; I %BN'="*",%BN'?1.N,%BN'?1N1":"1.N,%BN'?1N1":"1.N1":"1"G"1N,%BN'?1.N1":"1"G"1N,%BN'?1N1":"1.N1":"1""""1"G"1N1"""",%BN'?1.N1":"1""""1"G"1N1"""" S @("%BN="_%BN) I %BN'="*" S X=%BN D VB^DBFIX G:'$D(X)#10 ASK S %BN=X V:%BN'="*" %BN:$S($D(VG)#10:VG,1:"") INT1 S %LR=%BN ; DEV S %DEV=$P U 0 D:%DEV=$P CRT^%SDEV G:$D(QUIT) EXIT S %ID='(%DEV=$P) ; D SCRL G:%SC="^" DEV G:%SC="^Q" EXIT U 63 S %B=$ZA U %DEV W !!,"Block ",%B S X=%B D BN^%L1SGK1 W " (",Y,")" W:$D(VGI) ?25,"Volume group ",VGI I +$P(Y,":",2)=0 D BLKDMP^VGLABELE S R="" G ASK S %T=$V(1020,0,1),%T2=$V(1021,0,1,3) I $E(%T2,5) W !,"Block awaiting garbage collection" I %T>12!'%T W *7,!,"Uninitialized block, or invalid block type" G ASK I %T'=3 S %BN=%BN+1 Q:%BN>%BNF G ASK:%BN=0,ASK2 O 54:("#GLOBAL.RES":"A") D DATA^%L1SGK1 C 54 ; D:%T=3 @($P("GDIR^PTR^DATA^XDATA^RDIR^RTNHDR^RTN^MAP^JRNL^SBP^SPDIR^SPBLK","^",%T)_"^%L1SGK1") ; I %T=3 W !,%B," ",%BN ; W !!!,%B," ",%BN I $G(%POINT)=999 W " ",*27,"[7m"," POINTER ERROR ",*27,"[0m" W *7 R " <>",R Q S R="" S %BN=$S(%ALLBLK=1:%BN+1,'$G(BNL):%BN+1,1:Y) Q:%BN>%BNF G ASK:%BN=0,ASK2 EXIT I $D(%DEV),$D(%ID),%ID U %DEV W !! U 0 C:%DEV'=$P&+%DEV %DEV I '$D(%INT) C 63,54 K VG,VGI,VGVOL,VGTAB,%BL,%LR,%SC,%T2,FBLK,BNL,R,Y,Z K %C,%I,%J,%L,%L2,%L3,%N,%N2,%OF,%T,%DEV,%ID,%BN,%B,%LN,%P,%INT,A,B,BAK,C,D,E K COLL,D,F,GBN,GLB,GN,I,JRN,K,KEY,MAX,PSZ,PTR,OFST,QUI,UNT,SAVE,STRING,TYPE,UC,UI,USZ,UT,X Q ERR I $F($ZS,"") U 0 W !!,"Aborted ..." G ASK D EXIT Q ERR1 I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q INT S %INT=1,%ID=1,%DEV=$P,%BN="*" G INT1 SCRL I %ID S %SC=0 Q R !,"Do you want to scroll? ",%SC S:%SC="" %SC="N" I %SC?1.N,%SC>0 S $Y=0 Q I %SC=$E("NO",1,$L(%SC))!(%SC=$E("no",1,$L(%SC))) S %SC=0 Q G SCRL1:%SC=$E("YES",1,$L(%SC)),SCRL1:%SC=$E("yes",1,$L(%SC)) Q:(%SC="^")!(%SC="^Q") W !,"Enter ""Y"" if you want the listing to pause every 'n' lines and wait for a",!,"Carriage Return before continuing. You will be prompted for 'n'." W !,"Or, you may enter directly the number of lines per screen." G SCRL SCRL1 W !,"How many lines per screen? <",$S(%ID:60,1:20),"> " R %SC S:%SC="" %SC=$S(%ID:60,1:20) I %SC?1.N,%SC>0 S $Y=0 Q G:%SC="^" SCRL Q:%SC="^Q" W !,"Enter the number of lines to list before pausing for a Carriage Return." G SCRL1 %L1SGK1 %L1SGK1 ;CDS;DISK BLOCK DUMP (PART II); [ 04/27/94 3:59 PM ] DATA ; ; W !!,"Data block" D OFST G:'%OF NEXT D OFST G:'%OF NEXT NEW BYTREV S BYTREV=$ZB($V($V(44),-3,2),#40,1) I $D(NCOL) S STRING='NCOL G DATA1 D ^BLKDMP2 G:'F EXIT DATA1 S %I=0,%N="" ; W !!," Key,Data",?11,"Global Name/",!," Off Off",?11,"Value",!," --- --- -----" DATA2 S %L2=$V(%I+1,0,1) D N2 ; W !,$J(%I,4),",",%I+%L2+2,?11 D N2 W "=" I %GLOB'["(",%GLOB_"("'[%GLB Q I $G(%POINT),%ALLBLK=0,%GLOB["(",%GLOB'[%GLB S %POINT=999 Q I %GLOB["(",%GLOB'[%GLB Q ; S %L2=$V(%I+1,0,1) W !!,"%I=",%I," %L2=",%L2 ; W !,$J(%I,4),",",%I+%L2+2,?11 D N2 W "=" S %I=%I+%L2+2,%L3=$V(%I,0,1) ; W !!,"%I=",%I," %L2=",%L2," %L3=",%L3 S %ZNACH="" ; I %L3=0 W $V(%I+1,0,4,0) S %ZNACH=%ZNACH_$V(%I+1,0,4,0) S %I=%I+5 I %L3=0 S %ZNACH=%ZNACH_$V(%I+1,0,4,0) S %I=%I+5 E I %L3=2 DO S %I=%I+9 ; If byte reversed, swap bytes before display .; I 'BYTREV W $V(%I+1,0,8,4) S %ZNACH=%ZNACH_$V(%I+1,0,8,4) Q .I 'BYTREV S %ZNACH=%ZNACH_$V(%I+1,0,8,4) Q .NEW %J,%OVAL,%X,%XX S %X=$V(%I+1,0,8,2),%OVAL=$V(%I+1,0,8,4),%XX=15 .F %J=1:1:8 V %I+%J:0:$ZH($E(%X,%XX,%XX+1)):1 S %XX=%XX-2 ; swap bytes .; W $V(%I+1,0,8,4) V %I+1:0:%OVAL:8:4 Q ; put back original value .V %I+1:0:%OVAL:8:4 Q ; put back original value E I %L3=3 S %ZNACH=%ZNACH_$V(%I+2,0,$V(%I+1,0,1),5) S %I=%I+2+$V(%I+1,0,1) E I %L3=8 S %ZNACH=%ZNACH_$V(%I+2,0,256+$V(%I+1,0,1),5) S %I=%I+2+256+$V(%I+1,0,1) E I %L3=7 S %ZNACH=%ZNACH_"......" S %I=%I+1 ; E I %L3=3 W """",$V(%I+2,0,$V(%I+1,0,1),5),"""" S %ZNACH=%ZNACH_$V(%I+2,0,$V(%I+1,0,1),5) S %I=%I+2+$V(%I+1,0,1) ; E I %L3=8 W """",$V(%I+2,0,256+$V(%I+1,0,1),5),"""" S %ZNACH=%ZNACH_$V(%I+2,0,256+$V(%I+1,0,1),5) S %I=%I+2+256+$V(%I+1,0,1) ; E I %L3=7 W "......" S %ZNACH=%ZNACH_"......" S %I=%I+1 E W " *** UNRECOGNIZED DATA TYPE ***" G NEXT W !,%GLOB," = ",%ZNACH S %POINT=1 I %ZNACH'["......" U 54 W %GLOB,!,%ZNACH,! U 0 D CHKSC Q:R="^" G DATA2:%I<%OF,NEXT N S %L2=$V(%I+1,0,1) S %BL=$V(%I+%L2+2,0,3) D BL W ?5,$J(%BL,7) I $X>12 W " " E W ?13 N2 S D=$C(0),%N=$E(%N,1,$V(%I,0,1))_$V(%I+2,0,%L2,5),%P=0 S %GLOB=$P(%N,D) ; W $P(%N,D) F %J=2:1:$L(%N,D)-1 S %C=$P(%N,D,%J) D N3 S:%P %GLOB=%GLOB_""")" ; W:%P ")" Q N3 I %C="" D P W """""" S %GLOB=%GLOB_"""""" Q ; W " %C=",%C I STRING D P S %GLOB=%GLOB_%C Q ; W %C S F=$A(%C)-128,%C=$E(%C,2,1023),%LN=$L(%C) I %LN=0 D P S %GLOB=%GLOB_0 Q ; W 0 I F=127 D P S %GLOB=%GLOB_%C Q ; W %C ; I F'<0 D P W $E(%C,1,F) W:F<%LN ".",$E(%C,F+1,%LN) S %GLOB=%GLOB_$E(%C,1,F) S:F<%LN %GLOB=%GLOB_"."_$E(%C,F+1,%LN) Q I F'<0 D P S %GLOB=%GLOB_$E(%C,1,F) S:F<%LN %GLOB=%GLOB_"."_$E(%C,F+1,%LN) Q D P S F=-2-F S %GLOB=%GLOB_"-" Q ; W "-" F X=1:1:F S %GLOB=%GLOB_(9-$E(%C,X)) ; W 9-$E(%C,X) ; I %LN-1>F W "." S %GLOB=%GLOB_"." F X=F+1:1:%LN-1 W 9-$E(%C,X) S %GLOB=%GLOB_(9-$E(%C,X)) I %LN-1>F S %GLOB=%GLOB_"." F X=F+1:1:%LN-1 S %GLOB=%GLOB_(9-$E(%C,X)) Q P I %P S %GLOB=%GLOB_""",""" Q ; W "," Q E S %P=1 S %GLOB=%GLOB_"(""" Q ; W "(" Q OFST S %OF=$V(1022,0,2) Q ; W " Offset=",%OF Q UNKN W !!,*7,"Unknown block type: ",$ZH(%T) G EXIT ERR I $F($ZS,"") W !!,"Aborted ..." G EXIT U 0 W !,$ZS Q INT S %INT=1,%ID=1,%DEV=$P,%BN="*" G INT1 ; HDR ; W !!,"OFST NAME",?14,"CS",?17,"JRN",?21,"PROTC (S,W,G,U)",?39,"GROWTH",?47,"PTR BLK" W !,"---- --------",?14,"--",?17,"---",?21,"---------------",?38,"-------",?47,"-------" Q CHKSC Q:'%SC Q:$Y<%SC R:'%ID !,"<>",R W:%ID # S $Y=0 Q BN ;BLOCK NUMBER -> VOLUME INDEX:BLOCK NUMBER ;PASS IN X RETURNED IN Y S Y=X I '$D(VGI)!'$D(VGVOL) D GETVOL^%VGUTIL F Z=VGVOL-1:-1:0 I $P(VGVOL(Z),"^",2)'>X S Y=Z_":"_(X-$P(VGVOL(Z),"^",2)) Q Q NEXT U 0 W:"6,7,10,"[(%T_",") !!,"Option not available" S X=%B D BN W !!,"Current block is ",Y U 0 S BNL=$ZB($V(1012,0,4),#FFFFFF,1) NX2 I BNL S X=BNL D BN W !!,"Link block is ",Y,! I $P'=%DEV U %DEV D CHKSC Q:R="^" G NX2 W:'BNL&($P=%DEV) ! ; S %BN=Y EXIT Q %L1SHA %L1SHA ; FORMIROVANIE KRASIVOI SHAPKI ; SHEER ; INPUT %LL - LIST DLIN GRAF ; %STR(I) - NAZVANIE GRAF I #STPOKI SHAPKI ; %SM - SMESHENIE OT LEVOGO KRAIA %SM="C" CENTROVKA ; %VERT - SMESHENIE OT BERXHEGO KRAIA ; S %LL="10,4,8,6,12" K %STR,^VRM2($J) ; S %STR(1)="AAA\\BBBB\\CCCCCC\\DDD\\EEE" ; S %STR(2)="AAAAAA\\BB\\CCC\\DDD\\EEE" K ^VRM2($J) N %GW S %GW=200 S %KG=$L(%LL,","),%SM=$G(%SM,0) I %SM="C" D S %SM=80-(%SM+%KG+1)\2 .F I=1:1:%KG S %SM=%SM+$P(%LL,",",I) S %VERT=$G(%VERT),LIN=%VERT+1 F I=186,187,188,200:1:205 S C(I)=$C(I) I %TYPCRT["VT" S C(186)=$C(124),C(187)=$C(107),C(188)=$C(106),C(200)=$C(109),C(201)=$C(108),C(202)=$C(118),C(203)=$C(119),C(205)=$C(113) 1 S $E(^VRM2($J,LIN),%SM,%GW)=C(201) F GR=1:1:%KG S ^VRM2($J,LIN)=^VRM2($J,LIN)_$TR($J("",$P(%LL,",",GR))," ",C(205))_$S(GR'=%KG:C(203),1:"") ; $C(209) S ^VRM2($J,LIN)=^VRM2($J,LIN)_C(187) 2 F I=1:1 Q:'$D(%STR(I)) S LIN=LIN+1 D .S $E(^VRM2($J,LIN),%SM,%GW)=C(186) F GR=1:1:%KG D S ^VRM2($J,LIN)=^VRM2($J,LIN)_$J(PIC,LL)_C(186) ..S LL=$P(%LL,",",GR),PIC=$P(%STR(I),"\\",GR),LLP=$L(PIC),PIC=PIC_$J("",LL-LLP\2) 3 S LIN=LIN+1 S $E(^VRM2($J,LIN),%SM,%GW)=C(200) F GR=1:1:%KG S ^VRM2($J,LIN)=^VRM2($J,LIN)_$TR($J("",$P(%LL,",",GR))," ",C(205))_$S(GR'=%KG:C(202),1:"") S ^VRM2($J,LIN)=^VRM2($J,LIN)_C(188) I $G(%OTL) W !,"12345678901234567890123456789012345678901234567890123456789012345678901234567890" K %OTL Q %L1SHAP %L1SHAP ; [ 13.01.06 11:18 ] [ 06/16/97 2:00 PM ] ;INPUT: KOD - HEADER'S CODE ; SC - LINE'S COUNTER ; SM - OFFSET ; SL - PAGE'S COUNTER ; L1PAGE - IF $D - START FROM NEW PAGE ; PRPC - PRINT LINE ; USTR - 0,3 ;OUTPUT: ; PEND1 - LAST COLUMN ; RLIST - GODEL DAF ; CHERTA - KAV TAHAT KOTERET ; MPOZ N %NEXTS,%LENGTH,%STRS,%K,%POZ,%IND,%NEXTS,%I,%HBRY I $$^%L1DISP(USTR) W %HBR S %HBRY="" S %SS="&" S:'$D(SM) SM=1 S:'$D(SC) SC=0 S:'$D(SL) SL=1 S:'$D(PRPC) PRPC=1 I PRPC,'$D(USTR) U 0 W !,*7,"*** DEVICE ISN'T DEFINED (USTR) !" Q I '$D(^SHP(KOD)) U 0 W !,"*** COD HEADER ISN'T GOOD: ",KOD," !" Q S %NEXTS=^SHP(KOD,1) O USTR::2 E U 0 W *7 S %SAY=" dqetz zqtcn " X %XMSGV(1) Q I $$^%L1DISP(USTR) U $P:(NOECHO:NOWRAP) I PRPC U USTR W:$D(L1PAGE)&USTR # X:$D(L1PAGE)&(USTR=0!(USTR=$P)) %chista W:'$D(L1PAGE) ! D FSHAP S RLIST=66-%I S PEND1=$L(^(%I-2))+SM-3 S CHERTA=^(%I-1) K %NEXTS,%LENGTH,%STRS,%K,%POZ,%IND,%NEXTS,L1PAGE Q FSHAP ; N %STRS F %I=1:1 Q:'$D(^(%I))#10 Q:$E(^(%I))?1N S %STRS=^(%I),%POZ=0 D PSK D:PRPC PCS S SC=SC+1 I SC>68 S SC=0,SL=SL+1 S:'$D(RAZD) RAZD=":" I $D(^(%I)) K MPOZ F J1=%I:1 Q:'$D(^(J1)) D DO1 G EN1 DO1 ; N SHPZ S %POZ=1,SHPZ=0 F J2=1:1 S %POZ=$F(^(J1),RAZD,%POZ) Q:'%POZ S SHPZ=SHPZ+1,MPOZ($E(^(J1)),SHPZ)=%POZ+SM-1 S %CPOZ=SHPZ Q EN1 ; Q PCS N %II,%W1 W ?SM,$P(%STRS,"#") S %W1=0 F %II=2:1:$L(%STRS,"#") S %W1='%W1 W:USTR=3 *27,"W"_%W1 W:USTR=0!(USTR=$P)&%W1 %ENG,%CLI,%HBR W $P(%STRS,"#",%II) X:USTR=0!(USTR=$P) %XCL W:USTR=3 *27,"W0" W ! Q DEFL N %K I $D(^("P"_%IND)) S %LENGTH=^("P"_%IND) Q F %K=%POZ+2:1 Q:$E(%STRS,%K)'=" " S %LENGTH=%K-%POZ+1 K %K S ^("P"_%IND)=%LENGTH Q PSK ; F %J=%POZ:0 S %POZ=$F(%STRS,%SS,%POZ) Q:%POZ<1 S %IND=+$E(%STRS,%POZ,%POZ+1) D DEFL S %NST=$S($D(MAS(%IND)):$E(MAS(%IND),1,%LENGTH),1:""),%STRS=$E(%STRS,1,%POZ-2)_%NST_$J("",%LENGTH-$L(%NST))_$E(%STRS,%POZ+%LENGTH-1,255) Q %L1SPACE %L1SPACE ; [ 03.08.06 12:43 ] [ 19.09.04 15:17 ] [ N %A S %A=$$TV S %AVK=$P(%A,"\"),%AVA=$P(%A,"\",2) S %SP(1)=" %-a iept | (K) wqica iept mewn " S %SP(2)="----------------------------------" S %SP(3)=$J(%AVA,9,2)_" | "_$J(%AVK,8) Q TV(STAM) ; N %A,%AVA,%AVK,%FL S %FL="l1sp"_$J ZSY "df > "_%FL O %FL:(REWIND:READONLY) U %FL R %A,%A C %FL:(DELETE) S %A=$$SP1^%L1FRM(%A) S %AVK=$P(%A," ",4) S %AVA=100-$P(%A," ",5) Q %AVK_"\"_%AVA %L1SRV %L2SRV ; [ 09.12.05 21:48 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" 0 K (%L2MN) D ^%L1C,^P1IN S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" SERVER MANAGER " S MAC="MM" D ^%L2MENU I %I=1 Q D @MM1(%I) G 0 1 ; D SHOW U 0:(NOWRAP:ECHO) ZP R !!," PORT NUMBER : ",PORTN Q:PORTN="" I 'PORTN!(PORTN'?4N) W *7 G ZP J single^%L2SRV1(PORTN,4) H 2 D SHOW Q 2 ; D ^%L2SRVS Q 3 D SHOW U 0:(NOWRAP:ECHO) ZJ R !!," JOB NUMBER (ALL - '*'): ",JOBN Q:JOBN="" I JOBN="*" S ^SCKSERV=-1 H 2 D SHOW Q S ^SCKSERV(JOBN)=-1 H 2 S ^SCKSERV(JOBN)=-1 D SHOW Q %L1SRV1 %L1SRV1 ;fscwitte@users.sourceforge.net;2000/10/25,21:22:13;Socket Device,Server [ 06.11.05 17:22 ] [ ; NO ^ROUTINE ENTRY QUIT ;---------------------------------------------------------------------- ; public procedure single^SCKSERV1() ; ; General TCP/IP server procedure to handle single client connection. ; single(%ZNPort,%ZNTimeS) new %Z0,%ZNCmd,%ZNData,%ZNDev,%ZNLevel,%ZNSock ; ; set a new errortrap new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":singleQ" kill ^SCKSERV($job) ; ; Construct a dummy, but "unique", devicename. set %ZNDev="SCK$"_$J ; ; Open the device: OPEN %ZNDev:(ZLISTEN=%ZNPort_":TCP":DELIMITER=$C(13,10,58,27,95):ATTACH="listener"):%ZNTimeS:"SOCKET" else set ^SCKSERV($job)="-1,NotOpen" quit ; ; Adjust errortrap after open (need to close) set $ZTRAP="ZGOTO "_$ZLEVEL_":singleC" set ^SCKSERV($job)=0 ; ; USE fills $KEY with "BOUND|socket_handle|portnumber" use %ZNDev set ^SCKSERV($job,0)=$KEY ; ; Start listening, sets $KEY to "LISTENING|socket_handle|portnumber" WRITE /LISTEN(1) set ^SCKSERV($job,1)=$KEY ; ; Wait for connection, $KEY will be "CONNECT|socket_handle|remote_ipaddress" for do quit:^SCKSERV($job) . WRITE /WAIT(%ZNTimeS) . IF $KEY]"" set ^SCKSERV($job,2)=$KEY,^SCKSERV($job)=2 quit ; ; Store the connection socket in local variable, set %ZNSock=$piece($KEY,"|",2) ; ; Close listen socket, so another process can start listening on this port. ; Force connection socket to be the active CLOSE %ZNDev:(SOCKET="listener") USE %ZNDev:(SOCKET=%ZNSock) ; ; specify a trap that does not terminate the FOR-loop set $ZTRAP="GOTO singleX",%ZNLevel=$ZLEVEL set ^SCKSERV($job)=0,%Z0=2 for do quit:^SCKSERV($job) . READ %ZNData:%ZNTimeS ELSE quit . set %Z0=%Z0+1 . set ^SCKSERV($job,%Z0,1)=%ZNData . set ^SCKSERV($job,%Z0,2)=$DEVICE . set ^SCKSERV($job,%Z0,3)=$KEY . ; . ; If an error occurs during READ, stop the loop . IF $DEVICE set ^SCKSERV($job)=$DEVICE quit . ; . ; If no terminator we are in trouble, but ignore for now . IF $KEY="" quit . ; . ; If terminator is associated with db operation, handle request . IF $KEY=$CHAR(13,10) DO ;database request . . set %ZNCmd=$piece(%ZNData," "),%ZNData=$piece(%ZNData," ",2,32767) . . ; . . ; Reply, WRITE ! appends FIRST delimiter ($CHAR(13,10), and flushes data . . if %ZNCmd="get" WRITE "val ",@%ZNData,! quit . . if %ZNCmd="set" set @%ZNData WRITE "ok",! quit . . if %ZNCmd="kil" kill @%ZNData WRITE "ok",! quit . . WRITE "dbe "_%ZNCmd,! . ; . ; If terminator is associated with remote command, handle command . IF $KEY=$CHAR(27,95) DO ;command . . s %ZNCmd="cme "_%ZNData ; assume the worst . . if %ZNData="stop" set ^SCKSERV($j)="-11,stop" quit . . if %ZNData="clone" job single(%ZNPort,%ZNTimeS) set %ZNCmd="dup" . . ; . . ; Non-standard terminator ($CHAR(27,95)), requires explicit flush . . if $e(%ZNData,1,4)="cmd " X $E(%ZNData,5,255) S %ZNCmd="okcmd" . . WRITE %ZNCmd_$CHAR(27,95) ;,# ; ; for-loop terminated by +^SCKSERV($job)'=0, notify client WRITE "end"_$CHAR(27,95) ;,# ; ; singleC - close device before quiting ; singleC CLOSE %ZNDev ; ; singleQ - just QUIT ; singleQ QUIT ; ; singleX - M runtime exception ; ; If not at procedure level + 2, then "normal" error: close and quit ; Else error while executing request from client: reply and retry singleX if %ZNLevel+2>$ZLEVEL ZGOTO %ZNLevel:singleC WRITE "xcpt "_$ZSTATUS_$CHAR(27,95) ;,# quit %L1SRV2 %L1SRV1 ;fscwitte@users.sourceforge.net;2000/10/25,21:22:13;Socket Device,Server [ 17.11.05 19:00 ] [ 06.11.05 17:22 ] [ ; NO ^ROUTINE ENTRY QUIT ;---------------------------------------------------------------------- ; public procedure single^SCKSERV1() ; ; General TCP/IP server procedure to handle single client connection. ; single(%ZNPort,%ZNTimeS) new %Z0,%ZNCmd,%ZNData,%ZNDev,%ZNLevel,%ZNSock ; ; set a new errortrap new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":singleQ" kill ^SCKSERV($job) ; ; Construct a dummy, but "unique", devicename. set %ZNDev="SCK$"_$J ; ; Open the device: OPEN %ZNDev:(ZLISTEN=%ZNPort_":TCP":DELIMITER=$C(13,10,58,27,95):ATTACH="listener"):%ZNTimeS:"SOCKET" else set ^SCKSERV($job)="-1,NotOpen" quit ; ; Adjust errortrap after open (need to close) set $ZTRAP="ZGOTO "_$ZLEVEL_":singleC" set ^SCKSERV($job)=0 ; ; USE fills $KEY with "BOUND|socket_handle|portnumber" use %ZNDev set ^SCKSERV($job,0)=$KEY ; ; Start listening, sets $KEY to "LISTENING|socket_handle|portnumber" WRITE /LISTEN(1) set ^SCKSERV($job,1)=$KEY ; ; Wait for connection, $KEY will be "CONNECT|socket_handle|remote_ipaddress" for do quit:^SCKSERV($job) . WRITE /WAIT(%ZNTimeS) . IF $KEY]"" set ^SCKSERV($job,2)=$KEY,^SCKSERV($job)=2 quit ; ; Store the connection socket in local variable, set %ZNSock=$piece($KEY,"|",2) ; ; Close listen socket, so another process can start listening on this port. ; Force connection socket to be the active CLOSE %ZNDev:(SOCKET="listener") USE %ZNDev:(SOCKET=%ZNSock) ; ; specify a trap that does not terminate the FOR-loop set $ZTRAP="GOTO singleX",%ZNLevel=$ZLEVEL set ^SCKSERV($job)=0,%Z0=2 for do quit:^SCKSERV($job) . READ %ZNData:%ZNTimeS ELSE quit . set %Z0=%Z0+1 . set ^SCKSERV($job,%Z0,1)=%ZNData . set ^SCKSERV($job,%Z0,2)=$DEVICE . set ^SCKSERV($job,%Z0,3)=$KEY . ; . ; If an error occurs during READ, stop the loop . IF $DEVICE set ^SCKSERV($job)=$DEVICE quit . ; . ; If no terminator we are in trouble, but ignore for now . IF $KEY="" quit . ; . ; If terminator is associated with db operation, handle request . IF $KEY=$CHAR(13,10) DO ;database request . . set %ZNCmd=$piece(%ZNData," "),%ZNData=$piece(%ZNData," ",2,32767) . . ; . . ; Reply, WRITE ! appends FIRST delimiter ($CHAR(13,10), and flushes data . . if %ZNCmd="get" WRITE "val ",@%ZNData,! quit . . if %ZNCmd="set" set @%ZNData WRITE "ok",! quit . . if %ZNCmd="kil" kill @%ZNData WRITE "ok",! quit . . WRITE "dbe "_%ZNCmd,! . ; . ; If terminator is associated with remote command, handle command . IF $KEY=$CHAR(27,95) DO ;command . . s %ZNCmd="cme "_%ZNData ; assume the worst . . if %ZNData="stop" set ^SCKSERV($j)="-11,stop" quit . . if %ZNData="clone" job single(%ZNPort,%ZNTimeS) set %ZNCmd="dup" . . ; . . ; Non-standard terminator ($CHAR(27,95)), requires explicit flush . . if $e(%ZNData,1,4)="cmd " X $E(%ZNData,5,255) S %ZNCmd="okcmd" . . WRITE %ZNCmd_$CHAR(27,95) ;,# ; ; for-loop terminated by +^SCKSERV($job)'=0, notify client WRITE "end"_$CHAR(27,95) ;,# ; ; singleC - close device before quiting ; singleC CLOSE %ZNDev ; ; singleQ - just QUIT ; singleQ QUIT ; ; singleX - M runtime exception ; ; If not at procedure level + 2, then "normal" error: close and quit ; Else error while executing request from client: reply and retry singleX if %ZNLevel+2>$ZLEVEL ZGOTO %ZNLevel:singleC WRITE "xcpt "_$ZSTATUS_$CHAR(27,95) ;,# quit %L1SS %L1SS ; [ 09.02.24 07:18 ] [ 22.03.21 14:36 ] [ 21.10.06 17:56 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" BG D FRM ; S2V X %chista S %S2V("NOHB")="" S %S2V("PROG")="VIEW^%L1SS" S %S2V("TXT1")=" TO SHOW TEXT OF PROGRAMM OR FULL STATUS PRESS " D ^%S2VIEW K ^TMPS111($J),^l1ss($J) Q ; VIEW N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,U,%MET,zl) D ^%L1C W %CLI D W^%S2VIEW(U,1,80) X %XCL S %GET=" SHOW PROGRAMM -1 , FULL STATUS -2 , STACK - 3 , KILL JOB - 0 " S %GETIN=1 D NE^%L1GET I %TO="END" Q ; I %S=1 D TV^%L1FL($P($$SPL^%L1FRM($E(^TMPS111($J,U),23,40))," ")) Q ; I %S=2 D Q .Q:'U S %NMF=$G(^l1ss($J,U,"NMF")),%NMF1=1 Q:%NMF="" .K ^S999($J) S MAC1="^TMPS111($J)",MAC2="^S999($J)" D ^%S1GC1 .K ^TMPS111($J) D ^%L1TS .S %S2V("NOHB")="" .S %S2V("TXT1")=" PRESS TO EXIT " .S PRT=$J D IN^%S2V .K ^TMPS111($J) .S MAC2="^TMPS111($J)",MAC1="^S999($J)" D ^%S1GC1 .K ^S999($J) ; I %S=3 D Q .S %NMF=$G(^l1ss($J,U,"NMF")),%NMF1=1 Q:%NMF="" .C %NMF K ^VRM($J) I '$$SIZE^%L1ZOS(%NMF) G M2 .O %NMF:(READONLY:REWIND) .S %I1=0,%PRS=0 F %I=1:1 U %NMF:(TERMINATOR=$C(13,10,26,27)) R %STRING Q:$ZEOF D ..I %STRING[" ($ZINTER" S %PRS=1 ..I %PRS S %I1=%I1+1,^VRM($J,%I1)=$P(%STRING," ") .C %NMF U $P M2 .S MAC="^VRM($J)" S %L1("EU")=2,%L1("BE")=6 .S %L1("T2")=" S %SAY="" [""_$$FUNC^%UCASE($ZG)_""] "" X %XMSGV" .S %L1("TXT1")="$P(%NXS,""~"")_$J("""",15-$L($P(%NXS,""~"")))" .X %chista S %L1("NOHB")="" .D ^%L1NU I FLAG'="" K ^VRM($J) Q .S %L1("IND")=INDEX .S INDEX=@MAC D POISK^%L1ER(INDEX) .G M2 ; I %S=0 D Q .S %Q("Z")="ARE YOU SHURE" D N^%S1ASK Q:'YES .ZSY "kill "_$TR($E(^TMPS111($J,U),1,5)," ","") .I $G(zl) S $E(^S2VTMPS111($J,zl,U),66,79)="-- KILLED --" .S %MET="TMPS111" Q FRM ; N %NMF,%NMF0,%NMF1,%NM,%IO,I,A,B,PID,%NAME,%REF,%DEV S %NMF="l1ss"_$J S %IO=$I I $$^%L1ZOS(2,%NMF) ZSY "ps -fC mumps > "_%NMF I $$^%L1ZOS(10,%NMF)<0 G S2V O %NMF:(REWIND:READONLY) S I=2 K ^TMPS111($J),^l1ss($J) S ^TMPS111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^TMPS111($J,2)="---- ----- -------- --------------- ---------------------- --------------- " F U %NMF R A Q:$ZEOF D .S PID=$TR($E(A,10,14)," ","") Q:'PID .S %NMF0="GTM_JOBEXAM.ZSHOW_DMP_"_PID_"_" .ZSY "rm -f "_%NMF0_"*" .ZSY $$^%L1ENVAR("gtm_dist")_"/mupip intrpt "_PID .S %NMF1=$$^%L1ZOS(13,%NMF0_"*") Q:'$L(%NMF1) .Q:%NMF1'[%NMF0 .I '$$SIZE^%L1ZOS(%NMF1) Q .O %NMF1:(REWIND:READONLY) .S %NAME="",%REF="",%DEV="" .F U %NMF1 R B Q:$ZEOF D ..I $E(B,1,11)="$ZPOSITION=" S %NAME=$P(B,"=",2) ..I $E(B,1,11)="$REFERENCE=" S %REF=$P(B,"=",2) ..I B[" OPEN RMS",B'["GTM_JOBEXAM" S %DEV=%DEV_$S($L(%DEV):",",1:"")_$P(B," ") .C %NMF1 ;;:DELETE .F %NM="%NAME","%REF","%DEV" S @%NM=$TR(@%NM,"""","") .S I=I+1,CONT=$E(A,10,14)_" "_$E(A,25,39)_" "_%NAME_$J("",15-$L(%NAME))_" "_%REF_$J("",23-$L(%REF))_" "_%DEV .S ^TMPS111($J,I)=$E(CONT,1,800) .S ^l1ss($J,I,"NMF")=%NMF1 I $$^%L1ZOS(2,%NMF) Q KLJ(NMPROG) ; N ST S ST=$$WHATNMB(NMPROG) ; ; I 'ST Q 0 ZSY "kill "_$P(ST,"~",2) Q 1 ; ; WHATNMB(NMPROG) ; N A,U,I,PROG K ^TMPS111($J) D FRM S U=0 ; F I=1:1 Q:'$D(^TMPS111($J,I)) D .S A=$G(^(I)) .S PROG=$P($P($E(A,25,50)," "),"^",2) Q:PROG?.P .I PROG=NMPROG S U=I I 'U Q 0 S A=$G(^TMPS111($J,U)) K ^TMPS111($J),^l1ss($J) Q U_"~"_$TR($$SP1^%L1FRM(A)," ","~") %L1SSD %L1SSD ;CDS;SYSTEM SHUTDOWN; [ 21.12.01 7:26 AM ] [ 002/15/00 7:17 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1984 D ^%L1STOP K ^flag,^FLAG,^STLOOP H %L1STOP %L1STOP ; [ 29.12.06 11:24 ] [ 24.12.06 10:17 ] [ 21.11.05 12:56 ] S ^STLOOP("PC")=1 H 3 N %NMF K ^flag,^flagio,^STLOOP,^FLAG,^zms S %NMF="l1ss"_$J I $$^%L1ZOS(2,%NMF) ZSY "ps -fC mumps > "_%NMF C %NMF O %NMF:(REWIND:READONLY) F U %NMF R A Q:$ZEOF D .S PID=$TR($E(A,10,14)," ","") Q:'PID Q:PID=$J .I PID=$P($G(^VESoTCP(0,"In Use",9000)),";",3) Q .ZSY "kill "_PID ;;ZSY "killall gtcm_gnp_server" C %NMF:(DELETE) H 1 Q %L1STPC %L1STPC(ST,GL,MDP) ; [ 20.05.24 15:21 ] [ 28.02.17 12:36 ] [ 16.12.15 13:32 ] N GW,GWPC,J,ST1,ST2,TXT,FLAGRED S FLAGRED=0 I '$D(TS0)!'$D(TSS) D TS I ST'[@MDP@("PG") S ST=$TR(ST,TS0,TSS) S GWPC=$G(@MDP@("GWPC")) S GW=$G(@MDP@("GWPC")) F J=1:1:$L(ST,"#") I '(J#2) S GW=GW-$L($P(ST,"#",J)) S GW=GW+$L(ST,"#")-1 S:GW<1 GW=10 I $D(%L1STPC("RIGHT")) S ST=$J($$SPL^%L1FRM(ST),GW-1) ; S ST1=$$SPR^%L1FRM(ST) ; S ST2=$P(ST,"#") F J=2:1:$L(ST,"#") S ST2=ST2_$S('(J#2):@MDP@("B"),1:"")_$P(ST,"#",J)_$S('(J#2):@MDP@("N"),1:"") S TXT=ST2 D S1 Q ; S1 ; N IND S IND=$O(@GL@(99999),-1)+1 ;;I ST'[@MDP@("PG") D .I '$D(%L1STPC("NOSHP")) S TXT=TXT_$J("",GW-$L(TXT)) .;;S TXT=$E(TXT,$L(TXT)-GWPC+1,255) ; S @GL@(IND)=TXT ES1 Q ; TS ; S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) S TSS=$C(128) F J=129:1:154 S TSS=TSS_$C(J) Q %L1SVMEM %L1SVMEM ; [ 28.09.05 09:15 ] [ 19.06.03 13:06 ] [ 22.10.01 12:55 PM ] [ SAVE N %FN S %FN="#SAVEMEM"_$J I $$^%L1ZOS(2,%FN) O %FN:(WRITE:NEWVERSION):1 E Q U %FN ZWR C %FN Q REST ;;N %FN,A,A1,A2,ZT,SMB,OK,KV,J S %FN="#SAVEMEM"_$J N $ZT ;;S $ZT="ZG "_$ZL_":E" I $$^%L1ZOS(10,%FN)<0 Q O %FN:(REWIND:READONLY):1 E Q U %FN F R A Q:$ZEOF D .S A1=$P(A,"=") I A1["(" S A1=$P(A,")=")_")" .S A2=$P(A,A1_"=",2,254) .I $E(A2)="""" S A2=$E(A2,2,$L(A2)-1) .S A2=$$RPL^%L1FRM(A2,"""""","""") .S @A1=A2 E C %FN Q %L1SYS %L1SYS ; [ 30.01.04 18:11 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C,^P1IN M K MM S J=0 F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" xferd " S MAC="MM" D ^%L2MENU I %I=1 G END D @MM1(%I) G M END Q ; MENU ; ;1;EXIT;; ;1;FILESYSTEM SHOW;1; ;1;DIRECTORY SHOW (SIZE SORT);2; ;1;FILES SHOW (SIZE SORT);3; ;1;ALIAS (.BASHRC);4; ;1;SHOW PROCESSES BY NAME;5; ;1;SHOW PROCESSES BY TERMINAL;6; Q ; 1 ; zsy "df" S %GET="Press " D N^%L1GET q 2 ; u $p:ECHO S ZPR="Directory ( ^ - exit ) : <"_$ZDIR_"> " W !,ZPR r DIR I DIR="^" G E2 I DIR="" S DIR=$ZDIR S FL="l1sys.du" C FL:DELETE O FL:(write:newversion) U FL W "#!/bin/bash",! W "cd "_DIR,! W "du | sort -r -n > l1sys.duvi",! W "vi l1sys.duvi",! C FL ZSY "bash "_FL C FL:DELETE G 2 E2 q 3 ; u $p:ECHO S ZPR="Directory ( ^ - exit ) : <"_$ZDIR_"> " W !,ZPR r DIR I DIR="^" G E3 I DIR="" S DIR=$ZDIR S FL="l1sys.ls" C FL:DELETE O FL:(write:newversion) U FL W "#!/bin/bash",! W "cd "_DIR,! W "ls -l | sort --k=5,5 -nr > l1sys.lsvi",! W "vi l1sys.lsvi",! C FL ZSY "bash "_FL C FL:DELETE G 3 E3 q 4 ZSY "vi /root/.bashrc" Q 5 ; u $p:ECHO R !,"Name of process : ",ZN Q:ZN=""!(ZN="^") ZSY "ps -C "_ZN S %GET="Press " D N^%L1GET Q %L1SZ %L1SZ(FILE) ; [ 10.11.07 09:36 ] [ I $G(FILE)="" Q "" N fsize,fdate,fname S fsize=$J("",14) s fdate=$J("",10) S fname=$J("",64) D &libfstat.fstat(FILE,.fsize,.fdate,.fname) i fsize?.p s fsize="" i fdate?.p s fdate="" i fdate s fdate=$$^%L1DC(fdate,3) q FILE_"^"_fsize_"^"_fdate %L1T %L1T ; [ 19.05.09 13:42 ] [ 27.03.08 10:06 ] [ 04/26/94 10:15 AM ] Z K K MM N %ECHO I '$D(%POSIC) D ^%L1C X %chista S MM(0)=" ze`lah llegn " S MM(1)=" d ` i v i " S MM(2)="llegnl dlah xe`z" S MM(3)="ze`lah mr dcear" W %HBR S MAC="MM" D ^%L2MENU G:%I=1 END I %I=2 D ^%L1TABL G Z K %L1 S MAC="^TABLs",%L1("EU")=1 S %L1("TXT")="S %L1NS(%I)=$P($G(^(%NXN)),""\"")_"" ""_$J(%NXN,8)" D ^%L1NU G:FLAG'="" Z S GLOB=INDEX D I^%L1TABL G Z END Q %L1T2P %L1T2P(ST,%TST) ; TERMINAL -> PRINTER [ 02.07.08 13:40 ] [ 05.11.06 14:29 ] [ 09.01.01 1:17 PM ] I $P=1 D Q 1 .O 3 U 3 W ST,! C 3 U $P:(ECHO:WRAP) U $P:(NOECHO:NOWRAP) N A,A1,I,BUSY S BUSY=0 W $C(27),"[2$s" ;----- IBM PROPRINTER W $C(27),"[862*p" ;----- IBM PROPRINTER HEBREW SET (DECSPPCS) U $P:(ECHO:WRAP) T2Z U $P:(NOECHO:NOWRAP) ;;I '$G(%TST) G P G P F I=1:1:100 R *A:0 W $C(27),"[?15n" ;;R *A:2 S ^A("T2P",1)=A I A=27 S A="" F I=1:1:5 R *A1:1 S ^A("T2P",I+1)=A1 S A(I)=A1 S A=A_$C(A1) ;- ? PRINTER STATUS ;;I A'="[?10n",BUSY<5 H 1 S BUSY=BUSY+1 G T2Z ;;I A'="[?10n" U $P:(NOECHO:NOWRAP) Q 0 P W $C(27),"[2;3;4;1*s" ;-- NO FLOW CONTROL (DECSFC) W $C(27)," G",$C(27),"[?36h",$C(27),"[5i" W ST W:'$D(%L1T2P("EOL")) ! W:$D(%L1T2P("EOL")) %L1T2P("EOL") W $C(27),"[4i" ;---- TURN OFF PRINTER CONTROLLED MODE (MC) W $C(27),"[?36l" ;--- RESET HEBREW ENCODING MODE (DECHEM) W $C(27)," F" ;---- 7-BIT CONTROL (S7C1T) W $C(27),"[2;3;3;1*s" ;-- FLOW CONTROL XON/XOFF (DECSFC) W $C(17) U $P:(NOECHO:NOWRAP) Q 1 %L1TABL %L1TABL ; [ 15.03.19 12:39 ] [ 04.03.14 20:36 ] [ 07.02.14 18:26 ] K K ^TEMP0($P) D ^%L1C N %ECHO,$ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":^%ET" TV S %SCRN="TABL" S %SC("A")="" D ^%L1SC D IS2^%L1GET I 'YES G END S ^TEMP0($P,"RZD")=RZD S T=$T(GLOB+1) F I=2:1:$L(T,";")-1 I $P(T,";",I)?1U.E S $P(^TEMP0($P),"\",I-1)=$G(@$P(T,";",I)) K ^TABLs(GLOB) S PRT=$P S MAC1="^TEMP0(PRT)",MAC2="^TABLs(GLOB)" D ^%S1GC1 END K ^TEMP0($P) Q ; ER S %SAY=" d ` i b y " W *7 X %XMSGV Q ; I N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,GLOB,%SCSFIN,STRING) D ^%L1C S TB=^TABLs(GLOB) S NSNAME=$P(TB,"\"),FILE(1)=$P(TB,"\",3),FILE(2)=$P(TB,"\",5),FILE("Z")=$P(TB,"\",2) S RZD=^TABLs(GLOB,"RZD"),FILE="^"_GLOB K %MBS S %MBS("PAR",1)=" ;"_$P(TB,"\",4)_";7,50;"_$P(TB,"\",5)_";H;" F I=1:1 Q:'$D(^TABLs(GLOB,I)) S TB=^(I) I TB'?.P D .S DL=$P(TB,"\",2),SG=$P(TB,"\",3) .S DL=$TR(DL,".",",") .S %MBS("PAR",I+1)=" ;"_$P(TB,"\")_";"_(7+I)_",50;"_DL_";" .S %MBS("PAR",I+1)=%MBS("PAR",I+1)_$S(SG="N":"E",1:SG)_";" .S %MBS("PAR",I+1)=%MBS("PAR",I+1)_$S($D(^TABLs(GLOB,I,"S")):^("S"),SG="N":"1234567890-.+",SG="B":"kl10",1:"") ; S %L1SCS="",%SCSFIN=0 F D I^%L1SCS Q:%SCSFIN K %L1SCS E3 S %GET="<99> - "_NSNAME_" qitcdl" D N^%L1GET Q:%S'=99 K %MBP S %MBP("D",1)=FILE(1) S %MBP("RZD")=RZD S %MBP("Z",1)="oezp cew" S %GET="3 - zqtcn , 0 - jqn++23,70,H#3++1,E,I" D N^%L1GET Q:$G(%TO)="END"!(%S="") S %UNIT=%S D I^%L1SCSP U 0 S %GET=" ugl" D N^%L1GET Q ; GLOB Q:'($D(^TABLs(GLOB))#2) ;SHTBL;ZKEY;LKEY;NAME;LNAME;;SUGK;SUGN;VLD; K ^TEMP0($P) S MAC1="^TABLs(GLOB)",MAC2="^TEMP0($P)" D ^%S1GC1 S T=$T(GLOB+1) F I=2:1:$L(T,";")-1 I $P(T,";",I)?1U.E S @$P(T,";",I)=$P(^TEMP0($P),"\",I-1) S RZD=^TEMP0($P,"RZD") D VA^%L1SC D VG^%L1SC Q ; TYP1 ; I %S'="E",%S'="H",%S'="N",%S'="D",%S'="T",%S'="B",%S'="CB",%S'="CF",%S'="DY" S %SC("ST")=1 Q %L1TCHLD %L1TCHLD ; [ 20.08.07 12:08 ] [ 23.11.06 17:42 ] [ 04.10.06 07:17 ] D ^%L1C S %TCHOK=0 ;;X %chista S %SAY=" WORK DEFINITIONS RESTORING " X %XMSGV I '$$BDKPORT Q S %SAY=" WAIT, PLEASE ...++10,30,EE" X %XMSG S END=0 F I=1:1:1000 U PORTN R *A:1 Q:'$T U PORTN:(NOWRAP:NOECHO) W $C(0,0,0,0,0,0,0,0,0) U PORTN W "UM"_$C(0,4,0,0,0,0,0,0) F I=1:1:100000 R *A:0 Q:$C(A)="U" I $C(A)'="U" U 0 S %GET="A PORT IS NOT RESPONDING !" D MSG^%L1GET Q S B="" F I=1:1:10 U PORTN R *A:1 Q:'$T S B=B_$C(A) S %TCHOK=1 Q BDKPORT(STAM) ; N %L1INIT S %L1INIT="" I '$$INIT^%L2MOUSE S %GET=" TOUCH PORT IS NOT DEFINED OR LOCKED " D MSG^%L1GET Q 0 S PORTN=$$PORT^%L2MOUSE I PORTN<0 S %GET=" TOUCH PORT NUMBER IS NEGATIVE " D MSG^%L1GET Q 0 Q 1 TV D TV1 G %L1TCHLD TV1 K ^r,^zms,^P1INIT(+$H),^SCKSERV,^L2G,^L2G1 D KILL^P1INIT S ^STLOOP("PC")=1 H 3 K ^STLOOP ;J ^P1PCDOS Q %L1TESTM %L1TESTM ; [ 04/09/98 12:44 PM ] [ 01/15/98 3:36 PM ] [ 06/06/97 10:00 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C K ^%L1TESTM BG0 I $G(^%L1TESTM)=1 G END K (%SH) K ^test($J) N $ZT S $ZT="ZG "_$ZL_":BDK" S %I1=0 F %I=1:1:100 S %M1(%I)="AAAAAAAAAAAAA" F %I=1:1 Q:$S<1000 S %M(%I)=%I,%I1=%I BDK ; I $ZS["CTRAP" S ^%L1TESTM=1 G END K %M1 S $ZT="ZG "_$ZL_":" F %I=1:1:%I1 I %M(%I)'=%I ZU 1 W !,$J,": MEMORY TEST ERROR ! ",%I G BG0 S %SH=$G(%SH)+1 ZU 1 W !,$J,": MEMORY TEST N",%SH," - OK" H 1 ZU 1 W !,$J,": DISK TEST START:" S $ZT="ZG "_$ZL_":BDK2",%I1=0 F %I=1:1:100 S ^test($J,"R")="AAAAAAAAAAAAA" F %I=1:1 S ^test($J,%I)=%I I '(%I#1000) ZU 1 W $J,"," H 1 I $G(^%L1TESTM)=1 G END BDK2 K ^test($J,"R") F %I=1:1:%I1 I ^test($J,%I)'=%I ZU 1 W !,$J,": DISK TEST ERROR ! ",%I G BG0 ZU 1 W !,$J,": DISK TEST N",%SH," - OK" H 1 G BG0 END ZU 1 W !!,$J,": *** END OF TEST *** ",! K ^test($J) Q %L1TG %L1TG ; TEUR GLOBALIM [ 07/04/94 4:55 PM ] N STR,NAME,STR,RZD,MN,I,VR,ER,%HBRY Z X %chista S %SAY=" ["_$$^%L1ZU(0)_"] GLOBAL DESCRIPTION " X %XMSGV S %GET=" GLOBAL NAME:++7,20,EE#++8,E,I++++++^tg\\\\V" D ^%L1GET Q:%S=""!($G(%TO)="END") S %NG=%S S MN=1,NAMEOLD="",STROLD="",NAMEOLD1="" K ^tg1($P) I '$D(^tg(%NG,"REF")) K %Q S %Q("Z")=" DO YOU WANT COPY DESCRIPTION FROM ^SCR" D ^%S1ASK I YES D ^%L1TGC I $D(^tg(%NG)) S MAC1="^tg(%NG)",MAC2="^tg1($P)" D ^%S1GC1 P D PODVAL S %L1GET="",HZG=1 D ZN K %L1GET S HZG=0 D ZN I %TO="END" S:MN'>1 MN=2 S MN=MN-1 G P ; G:$G(%TO)="END" END K %L1GET D:NAME=""&(NAMEOLD'="") KILL G:NAME="" END G:RZD="" END F I=1:1:$L(STR,RZD) S VR=$P(STR,RZD,I) I VR?."%"1U.E S ^tg1($P,"NAME",VR,"REF")="$P($G(^"_%NG_"("_NAME_")),"""_RZD_""","_I_")" S ^tg1($P,"NAME",VR,"REF1")="$P(^"_%NG_"("_NAME_"),"""_RZD_""","_I_")" ;*** LEV 24.04.94 D .N NAME1,NAME2,NAME3 S NAME1=NAME,NAME3="" .F I=1:1:$L(NAME1,",") S NAME2=$P(NAME1,",",I) I NAME2?1U.E,$D(^tg1($P,"NAME",NAME2)) S NAME3=NAME3_NAME2_"," .S NAME3=$E(NAME3,1,$L(NAME3)-1) .S ^tg1($P,"KEY")=NAME3 S ^tg1($P,"REF",MN)=NAME S ^tg1($P,"REF",MN,"STR")=STR S ^tg1($P,"REF",MN,"RZD")=RZD S MN=MN+1 G P END D IS^%L1GET I YES K ^tg(%NG) S MAC1="^tg1($P)",MAC2="^tg(%NG)" D ^%S1GC1 K ^tg1($P) D TABL G Z ; ZN S NAME=$G(^tg1($P,"REF",MN)),NAMEOLD=NAME I NAME="",NAMEOLD1'="" S NAME=NAMEOLD1_"," S %GET="INDEX STRING "_MN_"++"_FSTY_",2,EE#"_NAME_"++40,E,I" D ^%L1GET G:HZG ZD S:%TO="PGUP" %TO="END" I $G(%TO)="END"!($G(%TO)="PGDW"),'$D(^tg1($P,"NEW")) Q S NAME=%S I NAME="" Q S:$E(NAME,$L(NAME))="," NAME=$E(NAME,1,$L(NAME)-1) S NAMEOLD1=NAME F I=1:1 Q:'$D(^tg1($P,"REF",I)) I ^(I)=NAME,I'=MN S MN=I G ZN ZD S RZD=$G(^tg1($P,"REF",MN,"RZD")) S %GET="DELIMITER ++"_FSTY_",60,EE#"_RZD_"++2,E,I" D ^%L1GET G:HZG ZL K %L1GET I $G(%TO)="END"!(%S="") G ZN S RZD=$TR(%S," ","") ZL S STR=$G(^tg1($P,"REF",MN,"STR")),STROLD=STR ZL1 S %SAY="STRUCTURE ++"_(FSTY+1)_",3,EE#" X %XMSG S %Y1=FSTY+2,%Y2=FSTY+3,%X1=2,%X2=78 S %S=STR D ^%L1WE K %X1,%Y1,%X2,%Y2 Q:HZG I $G(%TO)="END"!(%S="") G ZD S STR=%S S ER=0 F I=1:1:$L(STR,RZD) S VR=$P(STR,RZD,I) I VR'="",VR'?1U.U.N.U.N D TER S ER=1 Q G:ER ZL1 K ^tg1($P,"NEW") Q PODVAL S FSTY=1 ; I FSTY'=FSTYOLD D VSVALL^%L1SF ; S FSTYOLD=FSTY S %XX=0 F II=0:1:4 S %YY=FSTY+II X %POSIC W %chists S Y1=FSTY,X1=1,Y2=FSTY+5,X2=80 D ^%L1RBUA Q TER W *7 S %SAY=" d ` i b y " X %XMSGV H 2 Q KILL ; F I=1:1:$L(STROLD,RZD) S VR=$P(STROLD,RZD,I) I VR'?.P,$D(^tg1($P,"NAME",VR)) K ^tg1($P,"NAME",VR,"REF") K ^tg1($P,"NAME",VR,"REF1") D .N NAME1,NAME2,NAME3 S NAME1=NAMEOLD,NAME3="" .F I=1:1:$L(NAME1,",") S NAME2=$P(NAME1,",",I) I NAME2?1U.E,$D(^tg1($P,"NAME",NAME2)) S NAME3=NAME3_NAME2_"," K ^tg1($P,"NAME",NAME2,"KEY") .S NAME3=$E(NAME3,1,$L(NAME3)-1) .I NAME3'="" S NAME2=$P(NAME3,",",$L(NAME3,",")) Q:NAME2="" .F IR=1:1 Q:'$D(^tg1($P,"NAME",NAME2,"KEY",IR)) .K ^tg1($P,"NAME",NAME2,"KEY",IR) K ^tg1($P,"REF",MN) K ^tg1($P,"REF",MN,"STR") K ^tg1($P,"REF",MN,"RZD") Q TABL ;------------------------------------------------------ K ^MBG($P) N A S A="" X %chista F I=1:1 S A=$O(^tg(%NG,"NAME",A)) Q:A="" D .N PRM .S PRM=$G(^tg(%NG,0,A)) .S ^MBG($P,I)=A_"\"_$P(PRM,";")_"\"_+$P(PRM,";",2)_$S($P(PRM,";",2)[".":".",1:"")_"\"_$S($P(PRM,";",2)["H":"H",$P(PRM,";",2)["D":"D",1:"E")_"\"_$G(^tg(%NG,0,A,"FILE"))_"\"_$G(^tg(%NG,0,A,"OUT"))_"\"_$G(^tg(%NG,0,A,2)) S %SAY=" g""eca micew xe`z " X %XMSGV D INIT D ^%L1MBG D IS^%L1GET I 'YES K ^MBG($P) Q ;G 2 K OUT F I=1:1 Q:'$D(^MBG($P,I)) D .S ST=^(I),A=$P(ST,"\") Q:A="" K ^tg(%NG,0,A) .N %TTIP S %TTIP=$P(ST,"\",4) .S ^tg(%NG,0,A)=$P(ST,"\",2)_";"_$P(ST,"\",3)_$S(%TTIP="N":",2",1:"")_$S(%TTIP="H":"H",%TTIP="D":"D",1:"") .I $P(ST,"\",5)'="" S ^tg(%NG,0,A,"FILE")=$S($P(ST,"\",5)'["^":"^",1:"")_$P(ST,"\",5) .I $P(ST,"\",6)'="" S ^tg(%NG,0,A,"OUT")=$P(ST,"\",6),OUT($P(ST,"\",6))="" I $P(ST,"\",7)'="" S ^tg(%NG,0,A,2)=$P(ST,"\",7) K ^MBG($P) ;S FLD="" F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) I A'="",'$D(OUT(A)) S FLD=FLD_A_"*" ;S ^tg(%NG,"FLD")=$E(FLD,1,$L(FLD)-1) Q INIT S NPG=1,PG(1)=0,RZD="\" K %MBG S %MBG("VGR0")=3,%MBG("VGR")=4 F J=1:1 Q:$E($T(SCREEN+J),2)="Q" S %MBG("PAR",J)=$T(SCREEN+J) S %MBG("REF")="^MBG($P" S %REFH1=%MBG("REF") S %REFHS="^MBG($P,SH)" S %MBG("STEP")=2 Q SCREEN ; KOD ;(lbp`)cew;72;8;E;#@S %MBG("NEW",%MBG("F","KOD"))=1## - d`ivi SHEM ;(zixar) my;62;20;H;#@S %MBG("NEW",%MBG("F","SHEM"))=1## DL ;jxe`;40;4;E;#@S %MBG("NEW",%MBG("F","DL"))=1## TYP ;beq;34;1;E;#@S %MBG("NEW",%MBG("F","TYP"))=1## D - jix`z , H - ixar , E - zilbp` , N - ixnep " FILE ;uaew;28;8;E;### oezp xe`z `vnp dti` ,zilbp`a uaew my BEN ; dpyin ;18;8;E;#@S %MBG("NEW",J)=1#I %MBG("O",J)?.P!(%MBG("O",J-1)'?.P) S %MBG("OU",J+1)=1 K %MBG("NEW",J)#(zilbp`) oezp xe`zl dpzyn my SUG ; dpyn zxcbdl MUMPS zcewt ;+72;65;E;### Q %L1TGC %L1TGC ; COPY SCR -> tg [ 07/04/94 4:45 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C X %chista Z S %GET="SCREEN NUMBER++7,10,EE#++8,E,I++++++^SCR\\\\P" D ^%L1GET Q:%S=""!($G(%TO)="END") S %SCRN=%S S %GET="GLOBAL NAME++9,10,EE#++8,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") Z S %NG=%S I $D(^tg(%NG)) K %Q S %Q("U")="N" S %Q("Z")=" GLOBAL DESCRIPTOR EXIST ! OVERLAY" D ^%S1ASK Q:'YES K ^tg(%NG,"REF") S MAC1="^SCR(%SCRN,""P"",""REF"")",MAC2="^tg(%NG,""REF"")" D ^%S1GC1 F I=1:1 Q:'$D(^SCR(%SCRN,"P","REF",I)) S %G=^(I),^tg(%NG,"REF",I)=$P($P(%G,",",2,255),")") Q %L1TGG %L1TGG ; [ 28.04.00 5:53 PM ] [ 06/30/94 6:09 PM ] GET ; N %R,%MKT,%V,%I,%PRALL GETBG S %PRALL=0 I '$G(%L1TGG) S %L1TGG=1,%PRALL=1 ; S %MKT=$G(^tg(%NG,"REF",%L1TGG,"STR")) Q:%MKT="" S %R=$G(^("RZD"),"*"),%REF=$G(@("^"_%NG_"("_^tg(%NG,"REF",%L1TGG)_")")) F %I=1:1:$L(%MKT,%R) S %V=$P(%MKT,%R,%I) I %V?."%"1U.E S @%V=$P(%REF,%R,%I) I %PRALL S %L1TGG=%L1TGG+1 G GETBG Q GET1(%NG,%KEY,%NAME) ; I '$D(^tg(%NG,"NAME",%NAME,"REF")) Q "?????" S %REF=^("REF") X %KEY S @("%REF="_%REF) Q %REF GET2(%NG,%KEY,%NAME) ; N I F I=1:1:$L(%NAME,",") S %NAME1=$P(%NAME,",",I) S %REF="?????" I $D(^tg(%NG,"NAME",%NAME1,"REF")) D .S %REF=^("REF") X %KEY S @("%NAME1="_%REF) Q PUT(%NG,%KEY,%NAME) ; N I F I=1:1:$L(%NAME,",") S %NAME1=$P(%NAME,",",I) I $D(^tg(%NG,"NAME",%NAME1,"REF1")) D .S %REF=^("REF1") X %KEY S @(%REF_"="_%NAME1) Q %L1TGR %L1TGR ; RESTORE ^tg(%NG,"REF") [ 07/04/94 5:35 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C X %chista S %SAY=" RESTORE 'REF'-DESCRIPTION " X %XMSGV S %GET="GLOBAL NAME ++10,10,EE#++8,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S %NG=%S S N="" F S N=$O(^tg(%NG,"NAME",N)) Q:N="" D .S %RF=$P($P(^(N,"REF1"),"(",3,22),")"),%V1=$P(^("REF"),",",3,25) .F I=1:1 Q:'$D(^tg(%NG,"REF",I)) I ^(I)=%RF S @("$P(^(I,""STR""),"_%V1_"=N") Q %L1TIME %L1TIME ; TIME [ 14.09.25 14:23 ] [ 10.09.25 15:13 ] [ 27.10.24 16:29 ] N %HH,%MM,%SS S %MOUSE=$$INIT^%L2MOUSE K %screen S %BEG=1 K %L1NMB("ALB") S %TO="",%L1TIME="",%L1TIME1="",%L1TM="" S:'$D(%XX) %XX=$X-5 S:%XX<0 %XX=0 S %XX1=%XX S:'$D(%YY) %YY=$Y S:%XX>72 %XX=72 S:%YY>23 %YY=23 S %S="" I $D(%L1TS),%L1TS'="" D .I %L1TS'[":",$L(%L1TS)=4 S %L1TS=$E(%L1TS,1,2)_":"_$E(%L1TS,3,4) .I %L1TS'[":",$L(%L1TS)<3 S %L1TS=%L1TS_":00" .I %L1TS>24 S $P(%L1TS,":")=%L1TS#24 .S:%L1TS[":"&($L($P(%L1TS,":"))<2) $P(%L1TS,":")=0_$P(%L1TS,":") .S %S=$TR(%L1TS,":","") K %L1TS D PD I $D(%L1GET) G END VTT X %POSIC D VV G:%S="" END ;I %S'?4N&(%TO="END") S %S="",%L1TIME="",%L1TIME1="" D PD G END S %HH=$E(%S,1,2),%MM=$E(%S,3,4) S:%MM="" %MM="00" I %MM>60!(%MM'?2N) W *7 H 1 G %L1TIME S %HH=$TR($J(%HH,2)," ",0) I %HH>24!(%HH'?2N) W *7 H 1 G %L1TIME S %L1TIME=(%HH*3600)+(%MM*60) S %L1TIME1=%HH_":"_%MM K %HH,%MM,%SS D PD G END ;- END X %XCL I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) I $$HZGTOUCH^%L2MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")),$D(%L1NMB("Y0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) K %L1TM Q VV D VV^%L1DAT Q PD ; X %POSIC W %ENG,%CLI,$J($E(%S,1,2),2) X %XCL W ":" W %ENG,%CLI,$J($E(%S,3,4),2) X %XCL ;W ":" ;W %ENG,%CLI,$J($E(%S,5,6),2) Q T(%TT) ; I %TT?2N1":"2N Q %TT ;;I %TT?6N.N S %TT=$E(%TT,6,10) I %TT?5N1","1N.N S %TT=$P(%TT,",",2) I %TT<0 S %TT=0 ;-%TT Q $TR($J(%TT\3600,2)," ",0)_":"_$TR($J(%TT#3600\60,2)," ",0) ; TDEC(%SHAA) Q %SHAA+$J($P(%SHAA,":",2)/60,2,2) ; TS(%SHAA) ; N %MIN S %MIN=$P(%SHAA,":",2) I %SHAA>24 S %SHAA=%SHAA#24 I $L(%MIN) Q $TR($J($P(%SHAA,":"),2)," ",0)_":"_$TR($J(%MIN,2)," ",0) Q $TR($J($P(%SHAA,"."),2)," ",0)_":"_$TR($J("."_$P(%SHAA,".",2)*60\1,2)," ",0) ; DIF(T1,T2,SEC,DR) ; N (T1,T2,SEC) S T1=$$T2S(T1) S T2=$$T2S(T2) S DIF=T1-T2 I $G(SEC) Q DIF I $G(DR) Q $J(DIF/60,DR,DR) Q DIF\60 ; ; T2S(T) ; S T=$$SPA^%L1FRM(T) I T?1N1":"2N!(T?2N1":"2N) D Q T .S T=T*3600+($P(T,":",2)*60) ; I T["."!(T["/")!(T[" "),T[":" D Q T .S T=$$SP1^%L1FRM(T) .N DT,SHAA S DT=$$^%L1DC($P(T," "),3) .S SHAA=$P(T," ",2) .S T=DT*24*3600+(SHAA*3600+($P(SHAA,":",2)*60)) ; I T["," S T=+T*24*3600+$P(T,",",2) Q T ; I T?6N.N S T=$E(T,1,5)*24*3600+$TR($E(T,6,10)," ",0) Q T ; Q T ; ; PLUS(T,SEC,PR) ; I SEC[":" S SEC=SEC*3600+($P(SEC,":",2)*60) S T=$$T2S(T)+SEC ; N SEC1 S SEC1=T#(24*3600) N TH S TH=T\(24*3600)_","_SEC1 I $G(PR)=":" Q $ZD(TH,"DD.MM.YY 24:60") Q TH ; ; TMIN(MIN) ; N CL,DR S CL=$P(MIN,".") S DR=$P(MIN,".",2) S DR=$E(DR*100,1,2) S DR=DR*60\100 Q CL_":"_DR %L1TIP %L1TIP(%CM) ; [ 01.07.00 5:31 PM ] [ 10/18/2000 9:53 PM ] [ 04/27/99 12:31 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%CM) D ^%L1C X %chista U $P:(NOECHO:NOWRAP) S X1=18,X2=64,Y1=6,Y2=18 S %SAY=" ... zrci m`d ++"_(Y1-2)_","_(X2-12)_",HH,I" X %XMSG S N=$G(^L1TIP(%CM)),%BS=0 F S N=$O(^L1TIP(%CM,N)) S:N="" N=$O(^L1TIP(%CM,N)) D Q:%BS .S %L1RBCL="" D ^%L1RBUA .K SSS F I=1:1 Q:'$D(^L1TIP(%CM,N,I)) K %CHAST S %FRAZA=^(I),%DLG=X2-X1-2 D DELG^%L1SCPC D ..F J=1:1 Q:'$D(%CHAST(1,J)) S SSS($O(SSS(""),-1)+1)=%CHAST(1,J) .F I=1:1 Q:'$D(SSS(I)) S %XX=X1,%YY=Y1+I-1 X %POSIC W %HBR,SSS(I) .S %GET=" - z`vl , - mcew jqn , - jiyndl ++"_(Y2+1)_","_(X2+3)_",HH#++1,E,I" D ^%L1GET I ($G(%TO)="END") S %BS=1,^L1TIP(%CM)=$G(N) .I %TO="PGUP" S N=$O(^L1TIP(%CM,N),-1) S:N="" N=$O(^L1TIP(%CM,N),-1) S N=$O(^L1TIP(%CM,N),-1) Q VV ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %CM="MS" VV1 X %chista I %CM="MTK" D Q:%S="" G:%S="<" VV1 S TIP=%S .S %S="" S %GET=" : xven xtqn ++3,70,HH#"_$G(MTKN)_"++5,E,I++++ - mipekzn zbvd, mihixt zbvd++^PAR\\\\VP\/**" D ^%L1GET .I %TO="END" D S %S="" Q ..S %GET=" - mipekzn qitcdl" D N^%L1GET S:%TO="F9" %S=99 Q:%S'=99 ..N N S N="" F S N=$O(^L1TIP("MTK",N)) Q:N="" D ...S MZR=N,MZR1=$G(^L1TIP("MTK",N)) ...N I,N1 S I=0,N1="" F S N1=$O(^L1TIP("MTK",N,N1)) Q:N1="" D ....S I=I+1,^TEMP($P,I)=^(N1) ...S %SCRN="P1MTK" ...D ^%L1SCPC .; .I %TO="F8" K %L1 D HZGMTK Q .; .I %S,'$D(^L1TIP("MTK",%S)) D ..S MTKN=%S N %S ..K %Q S %Q("X")=24,%Q("Y")=5,%Q("Z")="xg` xvenn oekzn wizrdl " D ^%S2ASK ..Q:'YES ZM ..S %GET=" : dwzrdl xven xtqn ++7,70,HH#++5,E,I++++ - mipekzn zbvd" D ^%L1GET ..I %TO="F8" K %L1 S %L1("BE")=9 D HZGMTK ..Q:'%S I '$D(^L1TIP(%CM,%S)) S %SAY=" ! miiw `l oekzn " X %XMSGV(1) G ZM ..I %S S MAC1="^L1TIP(%CM,%S)",MAC2="^L1TIP(%CM,MTKN)" D ^%S1GC1 ..S %S="<" ; I %CM="MS" S %GET=" : tih xtqn ++3,70,HH#++3,E,I++++++^L1TIP(%CM)\\\\V" D ^%L1GET S TIP=%S I %TO="END" S %S="" Q:%S="" K ^S000($P) D RTI(TIP) K U,R,L,Y1,X1,U1,SAVE S %RMAX=79,%PRHBR=1,RL=79 D ^%S2ERG1 ;;S %GETIN="k" S %GET=" ? xenyl" D N^%L1GET I %S'="k" K ^S000($P) G VV1 ZO S %GETIN=1,%GET=" 0 - "_$S(%CM="MTK":"oekzn",%CM="MS":"tih",1:"")_" lhal , 2 - xenyl `l , 1 - miepiy xenyl " D N^%L1GET I %TO="END" G ZO I %S=0 D IS^%L1GET G:'YES ZO K ^L1TIP(%CM,TIP) G VV1 I %S=2 K ^S000($P) G VV1 I %S'=1 W *7 G ZO I %CM="MTK" S SHEM=$P($G(^PAR(TIP)),"**") G SV S %GET=": my++20,70,HH#"_$G(^L1TIP(%CM,TIP))_"++22,H,I" D ^%L1GET S SHEM=%S SV K ^L1TIP(%CM,TIP) F I=1:1 Q:'$D(^S000($P,I)) S ^L1TIP(%CM,TIP,I)=^S000($P,I),^L1TIP(%CM,TIP,I,"%TOP")=$G(^S000($P,I,"%TOP")) S ^L1TIP(%CM,TIP)=SHEM G VV1 RTI(TIP) K ^S000($P) Q:$G(TIP)="" N I,II F I=1:1 Q:'$D(^L1TIP(%CM,TIP,I)) D:'+$G(^L1TIP(%CM,TIP,I,"%TOP")) S ^S000($P,I)=^L1TIP(%CM,TIP,I),^S000($P,I,"%TOP")=$G(^L1TIP(%CM,TIP,I,"%TOP")) .S SS=^L1TIP(%CM,TIP,I) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S ^L1TIP(%CM,TIP,I,"%TOP")=II-($E(SS,II)'=" ") Q HZGMTK ; S MAC="^L1TIP(%CM)",%L1("EU")=2,%L1("BE")=6 D ^%L1NU I FLAG'="" S %S="<" Q S %S=INDEX Q %L1TM %L1TM(%TM) ; [ 07.07.21 12:47 ] [ 10/09/96 6:45 PM ] Q $$T^%L1TIME(%TM) ; ;$P(H,",",2) -> HH:MM TV N %HH,%MM S %HH=%TM\3600 S %MM=(%TM-(%HH*3600))\60 ;;Q $J(%HH,2)_":"_$TR($J(%MM,2)," ",0) W $J(%HH,2)_":"_$TR($J(%MM,2)," ",0) %L1TMP %L1TMP ; SAVE GLOBALS TO TEMPORARY FILES[ 03/08/98 9:55 AM ] [ 28.04.00 5:57 PM ] [ 03/08/98 9:55 AM ] [ 08/08/97 6:14 AM ] ; %NGLB - INT. NUMBER, %GLBIN - CODE, %GLB - GLOBAL GS(%NGLB,%GLBIN,%GLB,%ER) ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%GLBIN,%GLB,%NGLB,%ER) D ^%L1C S %ER=0 I $D(^tmpsv($P,%NGLB,%GLBIN)) S %ER=1 Q S MAC1=%GLB,MAC2="^tmpsv($P,%NGLB,%GLBIN)" D ^%S1GC1 Q GR(%NGLB,%GLBIN,%GLB) ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%GLBIN,%GLB,%NGLB) D ^%L1C K @%GLB S MAC2=%GLB,MAC1="^tmpsv($P,%NGLB,%GLBIN)" D ^%S1GC1 Q GN(%PUSTO) ; S %NGLB=$ZP(^tmpsv($P,999999))+1 Q %NGLB KL(%NGLB) ; K ^tmpsv($P,%NGLB) Q %L1TRDOS %L1TRDOS ; [ 31.01.06 20:23 ] [ 06/20/2002 12:52 PM ] D ^%L1C X %chista S %SAY=" FILES TRANSMISSION " X %XMSGV L ^L1TRDOS:1 E S %SAY=" WORK WITH JOB FROM OTHE TERMINAL ! " X %XMSGV(1) Q U 0 S PRT=$P N %HBRY W %ENG S %S="" K ^L1TRDOS Z1 S %FL="" U 0 W !!,"FULL NAME OF HOST FILE (INPUT): " D ^%ZMSL I %S="?"!(%TO="F7") D O13^%L1OS D G Z1 .Q:'$D(%L2VNM) .S %S=$S($G(%PATH)'="":%PATH_"\",1:"")_$TR($E(%L2VNM,1,8)_"."_$E(%L2VNM,11,13)," ","") I %S="" G END S %ER=$$^%L1ZOS(10,%S) I %ER<0 D ^%L1OS1 G Z1 S %NMF=%S O %NMF:(READONLY:REWIND):2 E U 0 W !,"*** FILE "_%NMF_" IN USE !" G Z1 I $ZEOF D OE G Z1 S %ER=0 D CAMA G:%ER<0 Z1 U 0 W !?30,$J(%CAMA/1024,3,3)_"K" S %J=0,%B="" U 0 W ! F %I=1:1 Q:%I>%CAMA U %NMF R *%A Q:$ZC>0 D .S %B=%B_$C(%A) .S:%A'=13 %B=%B_$C(%A) .I %A=13 S %J=%J+1,^L1TRDOS(%J)=%B,^L1TRDOS(%J,"BK")="",%B="" Q .I $L(%B)=100 S %J=%J+1,^L1TRDOS(%J)=%B,%B="" Q .I '(%I#10000) U 0 W "." I $L(%B) S %J=%J+1,^L1TRDOS(%J)=%B,%B="" S ^L1TRDOS=$S(%NMF["\":$P(%NMF,"\",$L(%NMF,"\")),1:%NMF) C %NMF MODEM I '$D(^L1TRDOS) S %SAY=" ! xcyl dn oi` " X %XMSGV(1) Q x %chista I $G(%L1TRDOS) S USERPORT=%L1TRDOS,USERGLOB="",USERMOD=1 G GTR S USERPORT=$$^%L1PORT,USERGLOB="" S USERMOD=1,MDTRANS="" S MDMOD=1 S PORTN=USERPORT S MDTON="T" S US="U PORTN:(0::::#001001:#800040:8::$C(13))" D ^%L2MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,$G(^PL("MDXON"))) S OK=$G(%L1MDOK) I '$D(MDTRANS),$G(PORTN)>3,PORTN'=$P C PORTN I $G(OK)'=1 G END GTR S PORTN=USERPORT O PORTN::2 E U 0 S %SAY=" qetz hxet " X %XMSGV(1) G END U PORTN F I=1:1:%DELAY R *A:0 E Q U PORTN W $C(13) H 1 W "MGR:%L1RCDOS:90",$C(13) H 1 U PORTN F I=1:1:3 R A:1 I A["UCI" W $C(13) H 3 W "MGR:%L1RCDOS:90",$C(13) H 1 L3GTR K ^UTILITY($J) S ^UTILITY($J,"L1TRDOS")="" U 0 X %chista D ^%L3GTR D:'$G(%L1TRDOS) ^%L1HANG K ^UTILITY($J) C:PORTN>3&(PORTN'=$P) PORTN Q END K ^L1TRDOS L Q ; TE W *7,!,"TRANSFER ERROR $ZC=",$ZC Q OE W *7,"*** OPEN ERROR ! $ZC=",$ZC Q ; CAMA ; N (%UPRCOD,%XMSG,%NMF,%CAMA,%ER) S %A=$L(%NMF,"\"),%B=$P(%NMF,"\",%A) I %B'="",%B'["*",%B'["." S %ER=$$^%L1ZOS(12,%NMF,32+16+4+1) I %ER<0 D ^%L1OS1 Q S %Y=%ER O13D S %I=$P(%Y,"^"),%J=$P(%Y,"^",2,999) S %K=$A(%J,22) S %A=$A(%J,27),%B=$A(%J,28),%C=$A(%J,29),%D=$A(%J,30) S %CAMA=($J(%A+(%B*256)+(%C*256*256)+(%D*256*256*256),8)) S %CAMA=+$TR(%CAMA," ","") Q %L1TRP %L1TRP ; [ 05.02.06 10:27 ] [ 31.01.06 11:50 ] [ 01.02.04 14:08 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1TRG) D ^%L1C L ^L1TRPRG:1 E S %SAY=" WORKING WITH A JOB FROM OTHER TERMINAL ! " X %XMSGV(1) Q 0 K (%L1TRG) D ^%L1C S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" zegewll "_$S($D(%L1TRG):"milaelb",1:"dpkez ipekcr")_" xeciy " S MAC="MM" D ^%L2MENU I %I=1 Q D @MM1(%I) G 0 MENU ; ;1; d ` i vi ; ;1; mipekcr xeciy;SEND; ;1; mixeciy lewehext;PROT; Q ; SEND ; I $D(^TEMPL($P)),$D(^TEMPR($P)) D G:%S=0 END G:%S=1 Z1 .S %S=1 .I '$D(%L1TRG) S %SCRN="L1TRP" D ^%L1SC I %BS S %S=0 Q .S %SCRN="L1TRPL" D ^%L1SC .S %GETIN=1,%GET=" 2 - ycg xeciy ligzdl ,1 - xeciya jiyndl " D N^%L1GET ; K ^L1TRPRG,^TEMPL($P) I $D(%L1TRG) D G LAK .K ^UTILITY($J) X %chista .W %ENG U $P:(ECHO:WRAP) K %ZG D ^%GSEL U $P:(NOECHO:NOWRAP) .M ^UTILITY($J)=%ZG .M ^L1TRPRG=%ZG ; K ^TEMPR($P) D GET PRG S %SCRN="L1TRP",%SC("A")="" D ^%L1SC G:%BS END I '$D(^TEMPR($P)) G END LAK K ^TEMPL($P) I $D(^LAK) D .K %Q S %Q("Z")="AUTOANSWER mr zegewld lk xegal" D N^%S2ASK I YES D ..S N="",I=0 F S N=$O(^LAK(N)) Q:N="" D ...S MODEM=$P($G(^(N,1)),"\",3) Q:'MODEM Q:$P($G(^LAK(N,1)),"\",7)'="k" ...S I=I+1,^TEMPL($P,I)=N_"\"_$G(^LAK(N))_"\"_MODEM_"\" S %SCRN="L1TRPL" D ^%L1SC I %BS G PRG Z1 ; S %GET="TARGET UCI :++22,10,EE#++18,E,I" D ^%L1GET Q:%S=""!(%TO="END") S UCI=%S N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERR" I $D(%L1TRG) G Z2 F %I=1:1 Q:'$D(^TEMPR($P,%I)) D .S SHEM=$TR($P($G(^(%I)),"\")," ","") Q:'$L(SHEM) .I '$D(%ZR(SHEM)) Q .D RED1^%L1ED(SHEM) .M ^L1TRPRG(SHEM)=^S000($P) K ^S000($P) .U 0 W "." I $D(^L1TRPRG)<10 S %SAY=" ! xeciyl mipezp oi`" X %XMSGV(1) G END K %Q S %Q("Z")="xcyl " D N^%S2ASK I 'YES G END Z2 ; I '$D(^TEMPL($P)) G END F I=$O(^TEMPL($P,99999),-1):-1:1 Q:$P(^(I),"\",4)["OK" S:I<1 I=1 X %chista S ^l2md($P)=3,INTR=0 F L1TRPRGL=I:1 Q:'$D(^TEMPL($P,L1TRPRGL)) D G:INTR END .S A=$G(^(L1TRPRGL)) .D G^%L1SCV("L1TRPL",A) Q:SIMAN="OK" .D MODEM I INTR K %Q S %Q("Z")="CONTINUE",%Q("X")=10,%Q("Y")=24 D ^%S1ASK I YES S INTR=0 END0 S IND=$P($H,",",1)_$TR($J($P($H,",",2),5)," ",0) I '$D(%L1TRG) S MAC1="^TEMPR($P)",MAC2="^L1TRPROT(IND,""R"")" D ^%S1GC1 I $D(%L1TRG) S MAC1="^UTILITY($J)",MAC2="^L1TRPROT(IND,""G"")" D ^%S1GC1 S ^L1TRPROT(IND)="G" S MAC1="^TEMPL($P)",MAC2="^L1TRPROT(IND,""L"")" D ^%S1GC1 K ^L1TRPRG,^TEMPR($P),^TEMPL($P),^UTILITY($J) END L Q ; GET ; U 0 W %ENG X %chista U 0 K ^TEMPR($P) U $P:(ECHO:WRAP) K %ZR D ^%RSEL I '$D(%ZR) W !,"No routines selected" Q S %SAY=" ... oznd `p` " X %XMSGN S N="",I=0 F S N=$O(%ZR(N)) Q:N="" D .S I=I+1,^TEMPR($P,I)=N_"\"_$$HRA(N) U $P:(NOECHO:NOWRAP) Q PROG ; I %OLDTO="F7" D S %SC("ST")=1 Q .N N,NR,%ZR K ^L1TRP($P) .D ^%RSEL Q:'$D(%ZR) .S N="" F S N=$O(%ZR(N)) Q:N="" S ^L1TRP($P,N)="" .S MAC="^L1TRP($P)" .S %L1("BE")=6 .S %L1("EU")=2 .S %L1("T1")=" dxrd | dpkez " .S %L1("TXT1")="%ENG_$$HRA^%L1TRP(%NXN)\/$$ENG^%L1FRM(%NXN,8)<>8" .D ^%L1NU Q:FLAG'="" .S PROG=INDEX,HRA=$$HRA(PROG),%SC("TO")="PL" Q:PROG="" I %OLDTO="F9" D ^%L1CALL("VIEW^%L1TRP(PROG)",%SCRN,"PROG") S %SC("ST")=1 Q I '$D(%ZR(PROG)) S %SC("ER")=1 Q S HRA=$$HRA(PROG) Q HRA(PROG) ; N HRA S HRA="" D RED1^%L1ED(PROG) S HRA=$$ENG^%L1FRM($E($$SPA^%L1FRM($P(^S000($P,1),";",2,40)),1,55),55) Q HRA VIEW(%RNAME) ; D M1^%L1RV Q LKH ; I %OLDTO="F7"!(%OLDTO="F6") D S %SC("ST")=1 Q .N SHM,%S,MAC,%L2VIEW S SHM="",GLB="^TEMPL($P)" .I %OLDTO="F6" S %GET="my zligz++23,60,HH#++10,H,I" D ^%L1GET Q:%S=""!(%TO="ESC") S SHM=%S .K ^TEMPH($P,"EZ") .N N,I S N="" F S N=$O(^LAK(N)) Q:N="" D ..N OK S OK=1 ..N I F I=1:1 Q:'$D(@GLB@(I)) I N=$P(^(I),"\") S OK=0 Q ..Q:'OK ..I $L(SHM),$$HBR^%L1FRM($G(^LAK(N)),$L(SHM))'=SHM Q ..I $P($G(^LAK(N,1)),"\",7)'="k" Q ..S ^TEMPH($P,"EZ",N)=$J($P($G(^LAK(N,1)),"\",3),10)_" | "_$$HBR^%L1FRM($TR($G(^LAK(N)),"|","/"),22)_"|"_$J(N,10)_" " .S MAC="^TEMPH($P,""EZ"")" .S %L2VIEW("T1")=": miyexc zegewl , 'geex' ywn zxfra ,oiivl `p" .S %L2VIEW("Y1")=6 .S %L2VIEW("H")=14 .S %L2VIEW("FIND")=2 .S %L2VIEW("SORT")=2 .S %L2VIEW("SORT",2)="H" .S %L2VIEW("SORT","MASTER")=1 .S %L2VIEW("SORT","HEAD")=" mcen | my | xtqn " .D ^%L2VIEW I $L($G(%L2VIN)),'$D(^L2VMM($J,%L2VIN)),%L2VIN,$G(%I) S ^L2VMM($J,%L2VIN)=%L2VNM .I '$D(^L2VMM($J)) D A^%L1SC S %SC("ST")=1 Q .S N="",I=0 F S N=$O(^L2VMM($J,N)) Q:N="" D ..N LKH,MODEM,SHEM ..S LKH=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",3)) ..S SHEM=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",2)) ..S MODEM=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",1)) ..D ADD^%L1GSEQ(GLB,SH+I,LKH_"\"_SHEM_"\"_MODEM) ..S I=I+1 .K ^L2VMM($J),^TEMPH($P,"EZ") .D GET^%L3MBG .D A^%L1SC Q:$G(LKH)="" S LKH1=$G(^LAK(LKH)) S MDPHONE=$P($G(^LAK(LKH,1)),"\",3) S %SC("TO")="PL" Q MODEM ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1TRG,MDPHONE,LKH1,L1TRPRGL,UCI,INTR) D ^%L1C I $D(%L1TRG) D .K ^UTILITY($J) .N GLB,GLB1 .S N1="" F S GLB="^UTILITY($J,""",N1=$O(^L1TRPRG(N1)) Q:N1="" D I $E(GLB,$L(GLB))'=")" S GLB=GLB_""")",@GLB="" ..S GLB=GLB_N1,GLB1=GLB ..S N2="",N2O=N2 F S N2=$O(^L1TRPRG(N1,N2)) Q:N2="" D ...S GLB=GLB1 ...S N3="" F S N3=$O(^L1TRPRG(N1,N2,N3)) Q:N3="" I N3=1 D Q ....S GLB=GLB_"("""""_^L1TRPRG(N1,N2,N3,2)_""""")"")" S @GLB="" S USERPORT=$$^%L1PORT Q:USERPORT="" S USERGLOB="",INTR=0 S USERMOD=1,MDTRANS="" I $D(%L1TRG) S PROG="%L2GTR1" E S PROG="%L1RCPRG" S MDMOD=1 S PORTN=USERPORT S MDTON="T" S US="O PORTN U PORTN:(NOECHO:NOWRAP:PASTHRU:TERM=$C(13,10))" S %L1RBCL=%CV("CF") W %LIGHT1 D TV^%L1RBUA(20,5,24,76) X %XCL D ^%L2MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,$$XON^%L1PORT,LKH1) I $G(%L1MDOK)["INTR" S INTR=1 S OK=$G(%L1MDOK) I $G(OK)'=1 G ENDM S PORTN=USERPORT O PORTN::2 E U 0 S %SAY=" qetz hxet " X %XMSGV(1) G ENDM X US F I=1:1:%DELAY R *A:0 E Q W $C(13) H 1 W UCI_":"_PROG_":90",$C(13) H 1 F I=1:1:3 R A:1 I A["UCI" W $C(13) H 3 W UCI_":"_PROG_":90",$C(13) H 1 I '$D(%L1TRG) D .K ^UTILITY($J) .S ^UTILITY($J,"L1TRPRG")="" K ^GTR000($P) D ^%L3GTR I '$D(^%L1GTER) D .S $P(^TEMPL($P,L1TRPRGL),"\",4)="OK" .S %YY=17,%XX=33 X %POSIC W "OK" I $D(^%L1GTER) D .S $P(^TEMPL($P,L1TRPRGL),"\",4)="NOK" .I $G(^%L1GTER)["INTR" S INTR=1 D ^%L1HANG K ^UTILITY($J) C:PORTN>3&(PORTN'=$P) PORTN ENDM Q ; ERR L S %NOASKEXIT="" G ER^%L1X ; PROT ; S MAC="^L1TRPROT" S %L1("BE")=5,%L1("T1")=" mixeciy lewehext " S %L1("TXT1")="$$^%L1DC($E(%NXN,1,5),1)_"" ""_$$T^%L1TIME($E(%NXN,6,10))" S %L1("DO")="D PROTV^%L1TRP" S %L1("US")="I '$D(%L1TRG)&(%NXS'=""G"")!($D(%L1TRG)&(%NXS=""G""))" S %L1("REV")="" x %chista D ^%L1NU Q PROTV ; S UCI=$P($$^%L1ZU(0),",") K ^TEMPR($P),^TEMPL($P) I '$D(%L1TRG) S MAC1="^L1TRPROT(INDEX,""R"")",MAC2="^TEMPR($P)" D ^%S1GC1 I $D(%L1TRG) K ^L1TRPRG S MAC1="^L1TRPROT(INDEX,""G"")",MAC2="^L1TRPRG" D ^%S1GC1 S MAC1="^L1TRPROT(INDEX,""L"")",MAC2="^TEMPL($P)" D ^%S1GC1 S TRH=$$^%L1DC($E(INDEX,1,5),1) I '$D(%L1TRG) S %SCRN="L1TRP",%SC("VIEW")=1 D A^%L1SC S %SCRN="L1TRPL",%SC("VIEW")=1 D ^%L1SC K %SC S %GET=" - z`vl , 2 - xeciy jiyndl ,1 - ycgn lkd xcyl " D N^%L1GET Q:%S=""!(%TO="END") I %S=2 D G Z1 .K %SC .I '$D(%L1TRG) S %SCRN="L1TRP" D ^%L1SC .S %SCRN="L1TRPL" D ^%L1SC I %S=1 D G Z1 .K ^TEMP0($P) .F I=1:1 Q:'$D(^TEMPL($P,I)) S $P(^(I),"\",4)="" .K %SC .I '$D(%L1TRG) S %SCRN="L1TRP" D ^%L1SC .S %SCRN="L1TRPL" D ^%L1SC Q %L1TRPR %L1TRPR ; [ 06/20/2002 12:52 PM ] S USERPORT=$G(^PL("MDPORT")),USERGLOB="" S USERMOD=1,MDTRANS="" S MDMOD=1 S PORTN=USERPORT S MDTON="T" S US="U PORTN:(NOWRAP:NOECHO:TERM=$C(13))" D ^%L1MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,$G(^PL("MDXON"))) I $G(OK)'=1 G END S PORTN=USERPORT O PORTN::2 E U 0 S %SAY=" qetz hxet " X %XMSGV(1) G END X US D CL TV S KV="""",KVKV=KV_KV W $C(13) H 1 W "MGR:PRIEM:90",$C(13) H 1 D CL W "ZI ""%L1RCPRG D ^%L2GTR1""",$C(13) H 1 D CL W "ZI "" S N="_KVKV_KVKV_" F S N=$O(^L1TRPRG(N)) Q:N="_KVKV_KVKV_" D""",$C(13) H 1 D CL W "ZI "" .X """"X """"""""ZR F I=1:1 Q:'$D(^L1TRPRG(N,I)) ZI ^(I)"""""""" ZS @N""",$C(13) H 1 D CL W "ZS %L1RCPRG",$C(13) H 1 D CL W "^^^^^",$C(13) END D ^%L1HANG C PORTN Q CL F I=1:1:%DELAY R *A:0 E Q %L1TRPRG %L1TRPRG ; SEND PROGRAMMS TO MULTIPLE COMPUTERS [ 07.02.06 08:44 ] [ 06/20/2002 12:52 PM ] D ^%L1C X %chista S %SAY=" ROUTINES TRANSMISSION " X %XMSGV L ^L1TRPRG:1 E S %SAY=" WORKING WITH A JOB FROM OTHER TERMINAL ! " X %XMSGV(1) Q U 0 S PRT=$P N %HBRY W %ENG S %S="" K ^L1TRPRG S N="" F S N=$O(^SHP("L1TRPRGL",N)) Q:N="" S $E(^SHP("L1TRPRGL",N),70)=" " Z1 ; K ^L1TRPRG S ^L1TRPRG=1 F %I=1:1 Q:'$D(^SHP("L1TRPRG",%I)) D .S SHEM=$TR($G(^(%I))," ","") Q:'$L(SHEM) .I '$D(^ (SHEM)) Q .X "ZL @SHEM F %I1=1:1 Q:$T(+%I1)="""" S ^L1TRPRG(SHEM,%I1)=$T(+%I1)" .I '(%I#10000) U 0 W "." I '$D(^L1TRPRG) S %SAY=" ! xeciyl mipezp oi`" X %XMSGV(1) G END Z2 ; S UCI=$P($$^%L1ZU(0),",") I UCI="MEZ" S UCI="MGR" I '$D(^SHP("L1TRPRGL",^L1TRPRG)) G END S MDPHONE=$P($G(^SHP("L1TRPRGL",^L1TRPRG))," ") I '$L(MDPHONE) G Z2E I $E(^SHP("L1TRPRGL",^L1TRPRG),70)="*" G Z2E D MODEM Z2E S ^L1TRPRG=^L1TRPRG+1 G Z2 MODEM ; S USERPORT=$G(^PL("MDPORT")),USERGLOB="" S USERMOD=1,MDTRANS="" S MDMOD=1 S PORTN=USERPORT S MDTON="T" S US="U PORTN:(0::::#001001:#800040:8::$C(13))" D ^%L1MD(PORTN,MDMOD,$G(MDPHONE),MDTON,US,$G(^PL("MDXON"))) S OK=$G(%L1MDOK) ;;I '$D(MDTRANS),$G(PORTN)>3,PORTN'=$P C PORTN I $G(OK)'=1 G END S PORTN=USERPORT O PORTN::2 E U 0 S %SAY=" qetz hxet " X %XMSGV(1) G END X US F I=1:1:%DELAY R *A:0 E Q W $C(13) H 1 W UCI_":%L1RCPRG:90",$C(13) H 1 F I=1:1:3 R A:1 I A["UCI" W $C(13) H 3 W UCI_":%L1RCPRG:90",$C(13) H 1 K ^UTILITY($J) S ^UTILITY($J,"L1TRPRG")="" U 0 X %chista U PORTN D ^%L2GTR I '$D(^%L1GTER) S $E(^SHP("L1TRPRGL",^L1TRPRG),70)="*" D ^%L1HANG K ^UTILITY($J) C:PORTN>3&(PORTN'=$P) PORTN Q END L Q ; TE W *7,!,"TRANSFER ERROR $ZC=",$ZC Q OE W *7,"*** OPEN ERROR ! $ZC=",$ZC Q ; %L1TRSNS %L1TRSNS ; [ 07.02.06 09:08 ] [ 19.01.06 07:06 ] [ 13.02.03 11:22 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC) D ^%L1C L ^L1TRSNS:1 E S %SAY=" WORKING WITH A JOB FROM OTHER TERMINAL ! " X %XMSGV(1) Q 0 K D ^%L1C S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" SMS- jxc zegewll zerced xeciy " S MAC="MM" D ^%L2MENU I %I=1 Q D @MM1(%I) G 0 MENU ; ;1; d ` i vi ; ;1; zerced xeciy;SEND; ;1; mixeciy lewehext;PROT; Q ; SEND ; I '$G(^PL("MDPSNS")) S %SAY=" ! SMS xiyknl uexr xcbed `l " X %XMSGV(1) Q S UCI=$$^%L1UCI ;----- HEMSHEH SHIDUR KODEM I $D(^TMPL($P)),$D(^TMPR($P)) D G:%S=0!$G(EM) END G:%S=1 Z2 .S %S=1 SND1 .D HZGMSG($G(^TMPR($P))) Q:$G(EM) .S %SCRN="L1TRSNSL" K %SC D ^%L1SC .S %GETIN=1 F S %GET=" 0 - z`vl, 3 - ycgn ligzdle lkd wegnl , 2 - drced owzl, 1 - xeciya jiyndl " D N^%L1GET S:%TO="END" %S="" Q:"0123"[%S&$L(%S) W *7 .I %S=2 G SND1 ; ; ------------ SHIDUR HADASH K ^L1TRSNS,^TMPL($P),^TMPR($P) HM D HZGMSG($G(^TMPR($P))) I $G(EM) G END LAK ; S %SCRN="L1TRSNSV" S %SCNC="" D A^%L1SC D CA^%L1SC LAKV S %FNAME="",FRST=1 D GETF^%L1SC D IS2^%L1GET I 'YES G LAKV S UCL="MER" I $$^%L1UCI["MEZ" S UCL="MEZ" I $$^%L1UCI["MLY" S UCL=^UCI("KL") S SHLK=0 I VLKH=2 D .S %SCRN="L1TRSNSC" D ^%L1SC .S N=999 F S N=$O(^LKH(N)) Q:N="" S PEL=$P($G(^LKH(N,2)),"*",19) S:'PEL PEL=$P($G(^LKH(N,1)),"*",15) D BDL D:PEL VIB I VLKH=1 D .S N=999 F S N=$O(^LKH(N)) Q:N="" S PEL=$P($G(^LKH(N,2)),"*",19) S:'PEL PEL=$P($G(^LKH(N,1)),"*",15) D BDL D:PEL TMPL(N,$G(^LKH(N)),PEL) I VLAK D .S N="" F S N=$O(^LAK(N)) Q:N="" S PEL=$P($G(^LAK(N,1)),"\",2) D BDL D:PEL TMPL("L"_N,$G(^LAK(N)),PEL) I VSEF D .S N="" F S N=$O(^TEL(N)) Q:N="" S PEL=$P($G(^TEL(N,1)),"\",2) D BDL D:PEL TMPL("T"_N,$G(^TEL(N)),PEL) I VSAP!VMRK D .;;S N="" F S N=$O(^["MLY"]YZRN(N)) Q:N="" D ..S A=$G(^[^UCI("MLG")]YZRN(N,10)) ..S PN=$P(A,"*",2) Q:PN="k"&'VMRK Q:PN="l"&VMRK&'VSAP ..N TEL S TEL(1)=$P(A,"*",5) ..S TEL(2)=$P(A,"*",10) ..S TEL(3)=$P(A,"*",19) ..S TEL(4)=$P(A,"*",20) ..N I F I=1:1:4 I $$PEL(TEL(I)) S PEL=$$PEL(TEL(I)) D TMPL("M"_N,$G(^[^UCI("MLG")]YZRN(N)),PEL) Q ; ZL K %SCNC S %SCRN="L1TRSNSL" D ^%L1SC ;--- BHIRAT LAKOHOT ; Z1 S $ZT="ZG "_$ZL_":ERR" S %GET=" 0 - z`vl , 3 - xcyl , 2 - zegewl zniyx owzl, 1 - drcedl xefgl" D N^%L1GET I %S=0 G END I %S=1 G HM I %S=2 G ZL I %S=3 G Z2 W *7 G Z1 ; Z2 ; I '$D(^TMPL($P)) G END F I=$O(^TMPL($P,99999),-1):-1:1 Q:$P(^(I),"\",4)["OK" S:I<1 I=1 X %chista S INTR=0 F L1TRSNSL=I:1 Q:'$D(^TMPL($P,L1TRSNSL)) D G:INTR END .S A=$G(^(L1TRSNSL)) .D G^%L1SCV("L1TRSNSL",A) Q:SIMAN="OK" .D MODEM I INTR K %Q S %Q("Z")="CONTINUE",%Q("X")=10,%Q("Y")=24 D ^%S1ASK I YES S INTR=0 END0 G:'$L($G(MSG)) END S IND=$P($H,",",1)_$TR($J($P($H,",",2),5)," ",0) S ^L1PRSNS(IND,"M")=MSG S MAC1="^TMPL($P)",MAC2="^L1PRSNS(IND,""L"")" D ^%S1GC1 END K ^L1TRSNS,^TMPR($P),^TMPL($P),^UTILITY($J) L Q ; LKH ; I %OLDTO="F7"!(%OLDTO="F6") D S %SC("ST")=1 Q .N SHM,%S,MAC,%L2VIEW S SHM="",GLB="^TMPL($P)" .I %OLDTO="F6" S %GET="my zligz++23,60,HH#++10,H,I" D ^%L1GET Q:%S=""!(%TO="ESC") S SHM=%S .K ^TMPH($P,"EZ") .N N,I S N="" F S N=$O(^L1TRSNS(N)) Q:N="" D ..N OK S OK=1 ..N I F I=1:1 Q:'$D(@GLB@(I)) I N=$P(^(I),"\") S OK=0 Q ..Q:'OK ..I $L(SHM),$$HBR^%L1FRM($G(^L1TRSNS(N)),$L(SHM))'=SHM Q ..I '$G(^L1TRSNS(N,1)) Q ..S ^TMPH($P,"EZ",N)=$J($G(^L1TRSNS(N,1)),10)_" | "_$$HBR^%L1FRM($TR($G(^L1TRSNS(N)),"|","/"),22)_"|"_$J(N,10)_" " .S MAC="^TMPH($P,""EZ"")" .S %L2VIEW("T1")=": miyexc zegewl , 'geex' ywn zxfra ,oiivl `p" .S %L2VIEW("Y1")=6 .S %L2VIEW("H")=14 .S %L2VIEW("FIND")=2 .S %L2VIEW("SORT")=2 .S %L2VIEW("SORT",2)="H" .S %L2VIEW("SORT","MASTER")=1 .S %L2VIEW("SORT","HEAD")=" mcen | my | xtqn " .D ^%L2VIEW I $L($G(%L2VIN)),'$D(^L2VMM($J,%L2VIN)),$G(%I) S ^L2VMM($J,%L2VIN)=%L2VNM .I '$D(^L2VMM($J)) D A^%L1SC S %SC("ST")=1 Q .S N="",I=0 F S N=$O(^L2VMM($J,N)) Q:N="" D ..N LKH,MODEM,SHEM ..S LKH=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",3)) ..S SHEM=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",2)) ..S PEL=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",1)) ..D ADD^%L1GSEQ(GLB,SH+I,LKH_"\"_SHEM_"\"_PEL) ..S I=I+1 .K ^L2VMM($J),^TMPH($P,"EZ") .D GET^%L3MBG .D A^%L1SC ; I %OLDTO="F9",$$^%L1UCI["ME" D ^%L1CALL("KLLKHS",%SCRN,"LKH") S %SC("ST")=1 Q Q:$G(LKH)="" N LKH0 S LKH0=LKH ;I $E(LKH)?1A S LKH0=$E(LKH,2,25) S LKH1=$G(^L1TRSNS(LKH0)) I LKH'=%MOLD S MDPHONE=$G(^L1TRSNS(LKH0,1)) I LKH1="" S $P(%MBG("OU"),"\",2)="" S %SC("TO")="PL" Q MODEM ; S US="O PORTN U PORTN:(0::::#001001:#800040:8::$C(13))" S PORTN=$G(^PL("MDPSNS")) S MSG=$$FRMMSG(MSG) D ^%L3MD(PORTN,MDPHONE,US,LKH1,MSG,0) Q FRMMSG(MSG) ; Q MSG S MSG1="" BFM N A S A=$E(MSG,$L(MSG)-12,$L(MSG)) I '$L(A) G EFM I $E(A)'=" " S A=$J(" "_A,13) S MSG1=A_MSG1 S MSG=$E(MSG,1,$L(MSG)-13) G BFM EFM Q MSG1 ; ERR L S %NOASKEXIT="" G ER^%L1X ; PROT ; S MAC="^L1PRSNS" S %L1("BE")=5,%L1("T1")=" mixeciy lewehext " S %L1("TXT1")="$$^%L1DC($E(%NXN,1,5),1)_"" ""_$$T^%L1TIME($E(%NXN,6,10))" S %L1("DO")="D PROTV^%L1TRSNS" S %L1("REV")="" x %chista D ^%L1NU Q PROTV ; S UCI=$$^%L1UCI K ^TMPR($P),^TMPL($P) D HZGMSG($G(^L1PRSNS(INDEX,"M"))) Q:$G(EM) S MAC1="^L1PRSNS(INDEX,""L"")",MAC2="^TMPL($P)" D ^%S1GC1 S TRH=$$^%L1DC($E(INDEX,1,5),1) S %SCRN="L1TRSNSL",%SC("VIEW")=1 D ^%L1SC K %SC PROTVZ S %GETIN=3,%GET=" - z`vl , 3 - xeciya jiyndl , 2 - zegewl zniyx owzl ,1 - drced owzl " D N^%L1GET Q:%S=""!(%TO="END") I %S=2 D Q:$G(EM) G PROTVZ .K %SC S EM=0 .S %SCRN="L1TRSNSL" D ^%L1SC I %S=1 S EM=0 D Q:$G(EM) G PROTVZ .K ^TMP0($P) .F I=1:1 Q:'$D(^TMPL($P,I)) S $P(^(I),"\",4)="" .K %SC D HZGMSG($G(^L1PRSNS(INDEX,"M"))) Q:$G(EM) .S %SCRN="L1TRSNSL" D ^%L1SC I %S=3 G Z2 Q HZGMSG(%S) ; N %X1,%X2,%Y1,%Y2,%L1WH X %chista S %SAY=" xeciyl drced cilwdl `p " X %XMSGV HM1 S %X1=34,%X2=47,EM=0 S %Y1=3,%Y2=14 S %L1WH("RB")="" S %L1WH("WORD")="" S %L1WH("=")="" S %L1WH("ESC")="" D ^%L1WH D G:EM=2 HM1 Q:EM .N %S,%TO S %GETIN=2 F %GET="0 - z`vl , 2 - rval , 1 - owzl " D N^%L1GET S:%TO="END" %S="" Q:"012"[%S&($L(%S)=1) W *7 .I %S=0 S EM=1 .I %S=1 S EM=2 I %S?.P S EM=1 Q K ^TMPR($P) S MSG=%S,^TMPR($P)=%S Q BDL I '$$PEL(PEL),$$PEL(N) S PEL=N Q PEL(N) ; I $E(N,1,2)="05"!($E(N,1,2)="06") Q 1 Q 0 TMPL(LKH,LKH1,PEL) ; S ^L1TRSNS(LKH)=LKH1 S ^L1TRSNS(LKH,1)=PEL S SHLK=SHLK+1,^TMPL($P,SHLK)=LKH_"\"_LKH1_"\"_PEL_"\" Q VIB ; I $$MAZAV(N)="q" Q I MESUGL!ADSUGL,$$SUGL(N)ADSUGL) Q I MELKH!ADLKH,$TR(N,"-","")ADLKH) Q I MESUGL="-",ADSUGL="-",$$SUGL(N)'="" Q N JOMH S JOMH=$$MMDD($$JOMH(N)) I JOMH<$$MMDD(METRH)!(JOMH>$$MMDD(ADTRH)) Q I METRHML,$$^%L1DC($$TRHMDL(N),3)<$$^%L1DC(METRHML,3) Q I ADTRHML,$$^%L1DC($$TRHMDL(N),3)>$$^%L1DC(ADTRHML,3) Q I $$^%L1DC($$DATPTH(N),3)<$$^%L1DC(MEDATPTH,3)!($$^%L1DC($$DATPTH(N),3)>$$^%L1DC(ADDATPTH,3)) Q I $G(ISAH)'?.P,$$ISCR(N)'=(ISAH="k") Q I $L($TR(IR," ","")),$TR(IR," ","")'=$TR($$IR(N)," ","") Q I MEITRA,$$ITRA(N)ADITRA Q Q:N?1A D TMPL(N,$G(^LKH(N)),PEL) Q ITRA(LKH) ; I $G(LKH)="" Q "***" I '($D(^LKH(LKH,2))#2) Q "?????" Q $P(^LKH(LKH,2),"*",4) MAZAV(LKH) ; Q $P($G(^LKH(LKH,2)),"*",18)'="q" DATPTH(LKH) ; I $G(LKH)="" Q "" I '($D(^LKH(LKH,2))#2) Q "?????" Q $P(^LKH(LKH,2),"*",13) IR(LKH) Q:$G(LKH)="" "" N IR S IR=$P($G(^LKH(LKH,1)),"*",13) S:IR="" IR=$G(^P1PRM("IR")) Q IR JOMH(LKH) Q:$G(LKH)="" "" Q $P($G(^LKH(LKH,1)),"*",17) SUGL(LKH) Q:$G(LKH)="" "" Q $P($G(^LKH(LKH,2)),"*",5) TRHMDL(LKH) Q:$G(LKH)="" "" Q $P($G(^LKH(LKH,2)),"*",16) Q "" MMDD(DAT) ; S DAT=$TR(DAT,"./","") S DAT=$E(DAT,3,4)_$E(DAT,1,2) Q DAT %L1TS %L1TS ; [ 25.07.23 06:34 ] [ 24.07.23 21:01 ] [ 11.03.20 05:18 ] N J S TSEN="ABGDHVZHTIHCLMMNNSAPPZZKRST" S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) I '$$^%W1HB!$D(HSBENG) S TSS=TS0,TS1=TS0 Q D TSS Q ; TSS ; N J S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) S TSS=$C(128) F J=129:1:154 S TSS=TSS_$C(J) S TS1=$C(224) F J=225:1:250 S TS1=TS1_$C(J) Q %L1TSTC1 %L1TSTC1(PORTN) ; [ 09.10.06 19:51 ] [ 08.10.06 10:29 ] [ 17.09.06 13:13 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,%L1TSTC2) D ^%L1C O PORTN CYC ; S OK=0 Q:'$D(@$$^W4DEVI@($P)) S %XMIN=$$XMIN1^%L1CRDTC ;^P1PRM("TOUCH",$$^%L1INDTC,"XMIN") S %XMAX=$$XMAX1^%L1CRDTC ;^P1PRM("TOUCH",$$^%L1INDTC,"XMAX") S %YMIN=$$YMIN1^%L1CRDTC ;^P1PRM("TOUCH",$$^%L1INDTC,"YMIN") S %YMAX=$$YMAX1^%L1CRDTC ;^P1PRM("TOUCH",$$^%L1INDTC,"YMAX") ; U PORTN:(NOWRAP:NOECHO) F I=1:1:100000 R *A Q:$C(A)="U" I $C(A)'="U" G END R *A:0 I $C(A)'="T" G END R *A:0 ;U 0 I A\4 G END U PORTN S X="" R *A,*B S X=A+(B*256) S Y="" R *A,*B S Y=A+(B*256) S B="" F I=1:1:3 R *A:0 S:A>0 B=B_$C(A) E Q ; I X>4000 G CYC I Y>4000 G CYC I $D(%L1TSTC2) S %L1TSTC2=X_"\"_Y G END ;;U 0 W "X=",X," Y=",Y," X1="_(X-491\39.076+1)," Y1="_(25-(Y-700\114.64)) U 0 W "X=",X," Y=",Y," X1="_$$SCX^%L2MOUSE(X)," Y1=",$$SCY^%L2MOUSE(Y) U 0 W ! u PORTN f i=1:1:200 r *a:0 S OK=1 END c PORTN Q %L1TSTC2 %L1TSTC2(PORTN) ; [ 13.11.06 05:04 ] [ 09.10.06 19:44 ] [ 08.10.06 10:32 ] D ^%L1C N %L1TSTC2 S %L1TSTC2="" U 0:(NOECHO:NOWRAP) W $C(27,91),"?25l" S %XX=5,%YY=2 X %POSIC W %LIGHT1,%CV("YF"),"+" X %XCL D ^%L1TSTC1(PORTN) S X1=$P(%L1TSTC2,"\") S Y1=$P(%L1TSTC2,"\",2) U 0:(NOECHO:NOWRAP) O PORTN U PORTN:(NOECHO:NOWRAP) F R *A:1 E Q C PORTN S %XX=75,%YY=23 X %POSIC W %LIGHT1,%CV("YF"),"+" D ^%L1TSTC1(PORTN) S X2=$P(%L1TSTC2,"\") S Y2=$P(%L1TSTC2,"\",2) S X10=X1-((X2-X1)\15) I X10<0 S X10=0 S Y10=Y1-((Y2-Y1)\16) I Y10<0 S Y10=0 S X20=X2+((X2-X1)\22) S Y20=Y2+((Y2-Y1)\21) Q:'$D(@$$^W4DEVI@($P)) S ^P1PRM("TOUCH",$$P^%L1INDTC,"XMIN")=X10 S ^P1PRM("TOUCH",$$P^%L1INDTC,"XMAX")=X20 S ^P1PRM("TOUCH",$$P^%L1INDTC,"YMIN")=Y10 S ^P1PRM("TOUCH",$$P^%L1INDTC,"YMAX")=Y20 W $C(27,91),"?25h" S %GET="CALIBRATION DONE",%GET("ISY")=19 D MSG^%L1GET Q %L1TSTCH %L1TSTCH ; [ 29.10.09 11:19 ] [ 23.11.06 17:41 ] [ 14.12.05 08:02 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C X %chista BG K D ^%L1C I %XMSG(0)'>1 S %HBRY="" ;;S ^P1HZMS(%L3MYDVN)="" S %L1NMB("NO")="" S J=0 F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4),MM2(J)=$P(T,";",5) S MM(0)=" TOUCH PORT TESTING " S MAC="MM" D ^%L2MENU I %I=1 G END D @MM1(%I) G BG END K ^P1HZMS(%L3MYDVN) Q ; MENU ; ;1; E X I T ; ;1; ALL PORTS DEFINITIONS ;10; ;1; NET TERMINAL DEFINITIONS ;11; ;0; TOUCH PORTS DEFINITIONS ;1; ;0; RESTORE CONNECTION TO TERMINAL ;16; ;0; REPAIRE TOUCH DISPLAY ;15; ;0; RESTORE WORKING DEFINITIONS ;7; ;0; CALIBRATION ;4; ;0; TEST OF TOUCH ;5; ;0; SHOW INPUT FROM PORT ;2; ;0; SMARTSET ;6; ;0; CHANGE TERMINAL DEFINITION : PC <-> PC1 ;8; ;1; SYSTEM MANAGER ;9; ;0; INSTALLATION HELP ;12; ;0; START GTM SERVER ;14; ;0; SERVER WORK DIAGNOSTIC ;13; Q ; 1 D ^P1PRMTCH Q 2 X %chista S %SAY=" SHOW SIGNALS FROM TOUCH PORT " X %XMSGV I '$$BDKPORT Q U 0 W ! S END=0 F U PORTN R *A:3 D Q:END .I U 0 W:A=85 ! W A," " R *K:0 S:$C(K)="."!($C(K)="^") END=1 Q .U 0 S %GET="NO ANSWER !",%GET("ISY")=19 D MSG^%L1GET S END=1 C PORTN Q 3 X %chista S %SAY=" SHOW TOUCH PORT MODE " X %XMSGV I '$$BDKPORT Q S END=0 F I=1:1:1000 U PORTN R *A:1 Q:'$T U PORTN:(NOWRAP:NOECHO) W $C(0,0,0,0,0,0,0,0,0) U PORTN W "Um"_$C(0,0,0,0,0,0,0,0) F I=1:1:100000 R *A Q:$C(A)="U" I $C(A)'="U" U 0 S %GET="A PORT IS NOT RESPONDING !" D MSG^%L1GET Q S B="" F I=1:1:10 U PORTN R *A:1 Q:'$T S B=B_$C(A) C PORTN S B1=$A(B,3) S B2=$A(B,4) ; U 0 W !!?20,$TR($J("",35)," ","-"),! S INIT=B1#2 D W("INITIAL TOUCHES ",INIT) S STREAM=B1\2#2 D W("STREAM TOUCHES",STREAM) S UNT=B1\4#2 D W("UNTOUCHES",UNT) S RNG=B1\64#2 D W("RANGE CHECK",RNG) S TRIM=B2\2#2 D W("TRIM ",TRIM) S CAL=B2\4#2 D W("CALIBRATION",CAL) S SCAL=B2\8#2 D W("SCALING",SCAL) S TRACK=B2\64#2 D W("TRACKING MODE",TRACK) W !!?20,$TR($J("",35)," ","-"),!! S %GET="PRESS",%GET("ISY")=19 D MSG^%L1GET Q W(TXT,VL) ; W !?20,$$ENG^%L1FRM(TXT,20),": ",$S($G(VL):"ENABLED",1:"DISABLED") Q 4 X %chista S %SAY=" CALIBRATION " X %XMSGV I '$$BDKPORT Q D ^%L1TSTC2(PORTN) 5 ; N $ZT S $ZT="ZG "_$ZL_":E5^%L1TSTCH" U $P:(CENABLE:CTRAP=$C(3)) X %chista S %SAY=" TOUCH TEST ( CTRL+C - EXIT ) " X %XMSGV W !! I '$$BDKPORT Q F D ^%L1TSTC1(PORTN) E5 Q 6 D ^%L1DOS("SMARTSET") Q 7 ; N %L1INIT S %L1INIT="" D ^%L1TCHLD Q:'$G(%TCHOK) D 3 K %Q S %Q("Z")="DO CALIBRATION" D N^%S2ASK Q:'YES ; D 4 S %GET="PRESS",%GET("ISY")=19 D MSG^%L1GET Q 8 N DEV,POS,ER,GLD S ER=0 S POS=$$TV^%L1DEFWS I POS'["ws" S ER=2 G ER8 S GLD=$$^%L1GLD S DEV=$G(^[GLD]devi2(POS)) I DEV="" S ER=3 G ER8 S ^[GLD]%TYPCRT(DEV)=$S($G(^[GLD]%TYPCRT(DEV))="PC":"PC1",1:"PC") D ^%L1C S %SAY=" %TYPCRT = "_%TYPCRT_"++ 10,35,EE,I,R" X %XMSG S %GET="" D N^%L1GET Q 9 R !!,"PASSWORD : ",PSW I PSW'=19571710 Q X %chista S %SAY=" SYSTEM MANAGER " X %XMSGV N SYSMAN S SYSMAN="" D ^%L1X Q 10 D ^%L1DEV Q 11 D ^%L1MSF Q 12 K ^TMPS111($J) F I=1:1 Q:'$D(^SHP("TCH",I)) S ^TMPS111($J,I)=^(I) S %S2V("PRINT")="" D ^%S2VIEW K ^TMPS111($J) Q 13 D ^%S1SRV Q 14 D SRV^P1PRMN Q 15 D 16^P1POP Q 16 N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %ENGFL="" D SRV^P1PRMN D 421^P1PRMN Q ER8 S %SAY=" ERROR "_ER_" " X %XMSGV(1) Q BDKPORT(STAM) ; N %L1INIT S %L1INIT="" I '$$INIT^%L2MOUSE S %GET=" TOUCH PORT IS NOT DEFINED OR LOCKED " D MSG^%L1GET Q 0 S PORTN=$$PORT^%L2MOUSE I PORTN<0 S %GET=" TOUCH PORT NUMBER IS NEGATIVE " D MSG^%L1GET Q 0 Q 1 %L1TSTPR %L1TSTPR(N,ADDR) ; [ 30.11.09 19:12 ] [ 19.11.09 15:46 ] [ N $ZT N CMD N FLOUT S FLOUT="/usr/local/mumps/prn"_N_".out" C FLOUT:(DELETE) K ^tstprn($J) S CMD="nmap -sP -q --max_rtt_timeout 200 -n -oX "_FLOUT_" "_ADDR_" > /dev/null" ZSY CMD N OK,I S OK=1,I=0 I $$^%L1ZOS(10,FLOUT)<0 G ETP S $ZT="S $ZT="""",zr=$R ZG "_$ZL_":ETP^P1PC" O FLOUT:(READONLY:REWIND) U FLOUT F R A Q:$ZEOF S I=I+1,^tstprn($J,I)=A C FLOUT N STAT S STAT="" F I=1:1 Q:'$D(^tstprn($J,I)) D Q:$L(STAT) .N A S A=$G(^(I)) Q:A="" .I A["0 D ASKR D RemapAUm^%msrpath(VGIN) S UNTR=0 ; flag for translation reset in FIXUP subroutine D USRCHK G ASKVG:USRS<0,EXIT:USRS>0 D UMOUNT^TRANSLA2(VGIN) ; turn off translation B:(OS&'VGRVG) 0 D UNMNT1^VGUTIL2(VGIN) ; state = unmounting D UNMOUNT I QF G EXIT D FINISH B:(OS&'VGRVG) 1 G EXIT UNMOUNT ; S UNTR=1 ; From now on, if error, translation must be reset S X=$ZMSM(7,VGIN,VGINAME) ; invalidate nakeds S X=$ZMSM(60,VGIN) ; release any locks F X=1:1:10 ZF VGIN:1 Q:$T I $ZB(VGFLAGS,#4000,1) D CLOSBIJ^DBMAINT8(QUIET) Q:QF I OS,'VGRVG F F=0:1:VGVOLS-1 D VOLINFO^%VGUTIL2(VGIN,F) D CLOSE^MOUNT I VGRVG,VGCKT S $ZT="ZG "_$ZL_":RVGTRAP^%L1UM16" D S $ZT="ZG "_$ZL_":" .S X=$ZCHAR(64,2,1,0,65,3)_VGNAME .V VGCKT+232+VGRMINDX::0:1 .V 248:$J:VGCKT:0:8 S XX=$ZNET(26,X) V 248:$J:0:0:8 Q FINISH ; Flush, and update DDP F X=1:1:10 ZF VGIN:1 Q:$T D UNMNT2^VGUTIL2(VGIN) ; finish unmount D:$D(^ ("DDP")) DBCHG^DDP Q EXIT ; C 63 K X,XX,JL,J,USRS Q ALL ; Unmount all VGs except for VG 0 NEW D GETVG^%VGUTIL S VG=0 F S VG=$O(VG(VG)) Q:VG'?1.N D AUTO(VG) Q AUTO(LIST) ; Application entry point to unmount a Volume Group LIST ; LIST is list of VGs to be unmounted (indexs or names) separated ; by commas NEW (LIST,QF) S QUIET=1 S OS=$ZB($V(0,-4,2),#F,1) D GETVG^%VGUTIL F ITEM=1:1:$L(LIST,",") S X=$P(LIST,",",ITEM) DO .D CHKNAME(X) Q:QF .I $V(2,$J,2)\32=VGIN S QF=-1 Q ; cannot unmount my current VG .D UMOUNT^TRANSLA2(VGIN) ; turn off translation .D UNMNT1^VGUTIL2(VGIN) ; state = unmounting .D UNMOUNT Q:QF .D FINISH Q CHKNAME(X) ; Check validity of VG, return VGNAME, VGIN, and Vginfo S VGNAME=X,QF=0 I VGNAME=+VGNAME,$D(VG(VGNAME)) S VGNAME=VG(VGNAME) I '$D(VG(VGNAME)) S QF=1 Q I 'VG(VGNAME) S QF=2 Q I VG(VGNAME)=0 S QF=3 Q ; can't unmount VG0 S VGIN=VG(VGNAME) D VGINFO^%VGUTIL2(VGIN,1) Q FIXUP ; D MOUNT^TRANSLA2(VGIN):UNTR D UNMNT1F^VGUTIL2(VGIN) Q USRCHK S USRS=$$LIST^%ACTJOB(.JL,VGIN) Q:'USRS S X="Y" D KILLALL^KILLJOB(VGIN,0) S USRS=0 Q RVGTRAP ; I $ZS["0 D Q:FLG<0 S I=I+2+$ZASCII(M,I+1) .I J=64 Q .I J=65 S VGNAME=$E(M,I+2,I+1+$ZASCII(M,I+1)),FLG=$S(VGNAME="":-2,$D(VG(VGNAME)):FLG+1,1:-1) Q G:FLG<0 SRVRET S VGI=VG(VGNAME) D VGUSE^VGUTIL2(VGI,-1) S CIR=$V(248,$J,0) L +DDPCIR(CIR) V CIR+264+VGI::$V(CIR+264+VGI,-3,1)-1:1 L -DDPCIR(CIR) S J=$ZMSM(60,VGI,$V(48,$J,2)) ; clear remote locks SRVRET ; S M=$ZCHAR(64,2,1,0) I FLG<0 S M=M_$ZCHAR(68,1,-FLG,0) E S M=M_$ZCHAR(0) D VGINFK^%VGUTIL2 K VG,FLG,I,J,VGI Q SETSAT(OMAPS) ; SET SAT FOR VGIN ; SAT is Storage Allocation Table N I,SAT,SATNO,SATEND,SATLIM,SATMAP,SATRE,ADJ,V I $D(OMAPS) S SAT=VGSAT G:OMAPS=VGMAPS SETSAT1 ;S QF=$ZMSM(2,VGSAT,OMAPS+7\8) S SAT=$ZMSM(1,VGMAPS+7\8),VGSAT=SAT I SAT=0 ZU 0 W !,"Unable to allocate memory for allocation table for volume group ",VGIN,! S QF=1 Q SETSAT1 ; D SETSAT^VGUTIL2(VGIN,SAT) S QF=0,ADJ=0,SATLIM=SAT+(VGMAPS+7\8) F V=0:1:VGVOLS-1 D SATVOL Q SATVOL ; SET SAT FOR EACH VOLUME D VOLINFO^%VGUTIL2(VGIN,V) S MAXMAPS=VOLBLKS\512 I ADJ D .S:ADJ>VOLMAPS ADJ=VOLMAPS S X=$V(SAT-1,-3,1),Y=1 .F J=1:1:ADJ S X=$ZB(X,Y,2),Y=Y*2 .V SAT-1:-3:X:1 .S VOLMAPS=VOLMAPS-ADJ,MAXMAPS=MAXMAPS-ADJ,ADJ=0 S SATNO=VOLMAPS\8,SATRE=VOLMAPS#8,SATEND=MAXMAPS+7\8,SATMAP=0 I (SAT+SATNO+(SATRE'=0))>SATLIM!(SAT+SATEND>SATLIM) D Q .W *7,!!,"Invalid label detected on volume ",V,". Volume size is inconsistent with" .W !,"volume group size. Use VGLABELE to examine and correct the problem.",! .S QF=1 ZT "VGSIZE" I MAXMAPS#8 S ADJ=8-(MAXMAPS#8) I SATNO F J=1:1:SATNO V SAT:-3:0:1 S SAT=SAT+1 I SATRE X "F J=7:-1:SATRE S SATMAP=SATMAP*2+1" V SAT:-3:SATMAP:1 S SAT=SAT+1 I SATEND>SATNO F J=SATNO+(SATRE'=0):1:SATEND-1 V SAT:-3:#FF:1 S SAT=SAT+1 Q ASKR ; ASKR1 ; S X="Y" Q CIRSTOP ; from server when remote system goes down D GETVG^%VGUTIL ; look for rvgs mounted from remote system S VGIN="" F S VGIN=$O(VG(VGIN)) Q:VGIN'?1.N D VGINFO^%VGUTIL2(VGIN,1) D . L +SUSPRVG(VGIN) . I VGSTATE=3,VGRVG,VGCKT=CIR D .. D RemapAUm^%msrpath(VGIN) .. S VGFLAGS=$ZB(VGFLAGS,#1+#2+#4,7) D SETVGFF^VGUTIL2(VGFLAGS) ;(8) suspend access .. D SUSPRVG^VGUTIL2(VGIN,SYS) ;(8)Save SYS name & set VG to MOUNTING . L -SUSPRVG(VGIN) ; look for local vgs mounted by remote system F VGIN=0:1:32-1 S Z=$V(CIR+264+VGIN,-3,1) I Z D VGUSE^VGUTIL2(VGIN,-Z) Q %L1UU %L1UU ;ENCODE/DECODE UU CODING;YER;RTE-Jun 15 2000, 4:24:44 PM,BY: Eli Reidler ; ;---------------------------------------------------------------------------------------------------- ; UUE(STRING) ; will UUencode contents of STRING N (STRING) UUE2 S OUTPUT=$C($L(STRING)+32) F P=1:3:$L(STRING) S CHRS3=$E(STRING,P,P+2) D UUE3 S OUTPUT=$TR(OUTPUT," ","`") ; change space chrs (6bit byte value 0 + 32) to ascii 96 (`) UUEQ Q OUTPUT ; UUE3 S CHRS3=CHRS3_$C(0,0) S X=$A(CHRS3)*256+$A(CHRS3,2)*256+$A(CHRS3,3) S B1=X\262144,X=X#262144,OUTPUT=OUTPUT_$C(B1+32) S B2=X\4096,X=X#4096,OUTPUT=OUTPUT_$C(B2+32) S B3=X\64,X=X#64,OUTPUT=OUTPUT_$C(B3+32) S B4=X,OUTPUT=OUTPUT_$C(B4+32) UUE3Q Q ; ;---------------------------------------------------------------------------------------------------- ; ; will decode contents of a UUencoded STRING DEUUE(STRING) ; N $ZT S $ZT="ZG "_$ZL_":^%ZER" N (STRING) S STRING=$TR(STRING,"`"," ") S OUTPUT="" F P=2:4:$L(STRING) S CHRS4=$E(STRING,P,P+3) D DEUUE3 S OUTPUT=$E(OUTPUT,1,$A(STRING)-32) Q OUTPUT ; DEUUE3 S B1=$A(CHRS4)-32 S B2=$A(CHRS4,2)-32 S B3=$A(CHRS4,3)-32 S B4=$A(CHRS4,4)-32 DEUUE4 S X=B1*64+B2*64+B3*64+B4 S OUTPUT=OUTPUT_$C(X\65536),X=X#65536 S OUTPUT=OUTPUT_$C(X\256),X=X#256 S OUTPUT=OUTPUT_$C(X) Q %L1VIDEO %L1VIDEO(PRT) ; [ 09.08.04 09:31 ] [ 05.08.04 09:51 ] [ 02.05.04 22:46 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PRT) D ^%L1C S II0=0 CYC F II=1:1 S CRD=$G(^P1VIDEO(PRT)) Q:$D(^STLOOP("VIDEO")) D H .01 I $L(CRD) D VIZ .I '(II#50) D ..S H=$P($H,",",2) ..S TIM=$TR($J(H\3600,2)," ",0)_":"_$TR($J(H\60#60,2)," ",0)_":"_$TR($J(H#60,2)," ",0) ..S %SAY=" "_TIM_" ++10,35,EE,I,R" X %XMSG ..S ^P1VIDEO(PRT,"TIME")=$H ..S ^P1VIDEO(PRT,"$J")=$J I $D(^STLOOP("VIDEO")) D .H 3 K ^STLOOP("VIDEO") .zsy "killall mumps" Q VIZ ; I $P(CRD,",")="G" D S ^P1VIDEO(PRT)="EG" Q .S X=$P(CRD,",",2) .S Y=$P(CRD,",",3) .S COL=$P(CRD,",",4) .S ROW=$P(CRD,",",5) .S MODE=$P(CRD,",",6) .S BUF=$P(CRD,",",7) .D GET^%VIDEO(BUF,X,Y,COL,ROW,MODE) ; I $P(CRD,",")="P" D S ^P1VIDEO(PRT)="EP" Q .S X=$P(CRD,",",2) .S Y=$P(CRD,",",3) .S COL=$P(CRD,",",4) .S ROW=$P(CRD,",",5) .S MODE=$P(CRD,",",6) .S BUF=$P(CRD,",",7) .D PUT^%VIDEO(BUF,X,Y,COL,ROW,MODE) .;;K @BUF Q %L1VIEW %L1VIEW ; VT220 OR PC [ 09/27/93 3:34 PM ] U 0 S %MM="$J($E(@%M,1,%LL),%LL)" W %ENG S %CLEAR="" I '$D(MAC) W *7,!!?5,"*** HASN'T NAME ARRAY !" Q I $D(@MAC)<10 W *7,!!?5,"*** HASN'T DATA !" Q I '$D(%POSIC) D ^%L1C S %M=MAC_"(%SH)" S %LL=0,%SH=0 F %SH=1:1 Q:'$D(@%M) I $L(@%M)>%LL S %LL=$L(@%M) I %LL>60 S %LL=60 S %I1=%SH I %I1>16 S %I1=16 S %SH=0 I '$D(%SM) S %SM=80-%LL-4\2 I %SM<1!(%SM>70) S %SM=80-%LL-4\2 S:%SM<3 %SM=3 S %SMX=%SM S:'$D(%SMY) %SMY=23-%I1-4\2 I %SMY>22 S %SMY=23-%I1-4\2 S:%SMY<2 %SMY=2 I %I1>(23-%SMY) S %I1=23-%SMY X:'$D(%CLEAR) %chista ;------------------------------- BODY ---------------- D CLEAR D PHON D PC S %I=1,%SH=1 CYC0 D INV CYC R *%A I $L($ZB)=4,$D(%UPRCOD($ZB)) S %A=$ZB G COM I %A=27 R *%A1:0 G:%A1=-1 27 R *%A:0 G:%A=-1 27 S %A=%A1_%A G COM I %A=0 R *%A1:0 I %A1>0 S %A="0"_%A1 G COM G:%A=13 ENDPR COM I $D(%UPRCOD(%A)),$T(@%UPRCOD(%A))'="" G @%UPRCOD(%A) G CYC ;- 27 S %I="" ENDPR S %L1VNM=@%M,%L1VIN=%MSH(%SH) K %MSH,%A,%B,%M,@MAC,%LL,%I1,%B1,%B2 X %XCL I '$D(%CLEAR) X %chista E S %XX=0,%YY=%SMY-2 X %POSIC,%chiste K %SM,%SMX,%SMY W:$D(%HBRY) %HBR Q ;- SERV ; VVERX G:%I=1 VVM D CL S %I=%I-1,%SH=%SH-1 W %vverx D INV G CYC VNIZ G:'$D(@(MAC_"(%SH+1)")) CYC G:%I=%I1 VNM D CL S %I=%I+1,%SH=%SH+1 W %vniz D INV G CYC PGDN G:'$D(@(MAC_"(%SH+%I1-%I-1)")) CYC S %SH=%SH+%I1-%I,%I=1 D CLEAR,PC S %SH=%SH+1 G CYC0 PGUP I %SH-%I1-%I<1 S %SH=0,%I=1 G PGUP1 S %SH=%SH-%I1-%I,%I=1 PGUP1 D CLEAR,PC S %SH=%SH+1 G CYC0 END G:'$D(@(MAC_"(%SH+%I1-%I)")) CYC F %J=1:1 Q:'$D(@(MAC_"(%J)")) S %SH=%J-%I1-1,%I=1 G PGUP1 HOME S %SH=0,%I=1 G PGUP1 ;- VVM G:%SH'>1 CYC S %SH=%SH-2 D CLEAR,PC S %SH=%SH+1 G CYC0 VNM G:'$D(@(MAC_"(%SH+1)")) CYC S %SH0=%SH+1,%SH=%SH-%I+1 D CLEAR,PC S %SH=%SH0 K %SH0 G CYC0 ;- CL X %XCL D PC1 Q ;- INV W %CLI D PC1 Q ;- PHON ; X %XCL S %XX=%SM-1,%YY=%SMY+1 ;S %XX=%SM-3,%YY=%SMY-2 S Y1=%YY,X1=%XX,Y2=%YY+%I1+1,X2=%XX+%LL+4 D RBUA Q ;- PC ; X %XCL N %I S %SHOLD=%SH F %I=1:1:%I1 S %SH=%SH+1 Q:'$D(@%M) D PC1 S %SH=%SHOLD K %SHOLD Q PC1 S %XX=%SMX,%YY=%I+%SMY X %POSIC W %HBR,$J($E(@%M,1,%LL),%LL),%ENG Q ;- CLEAR ; X %XCL N %I S %SHOLD=%SH F %I=1:1:%I1 S %XX=%SM-1,%YY=%I+%SMY X %POSIC W $J("",%LL+3) S %SH=%SHOLD K %SHOLD Q ;- CVET W $J("",%LL+4) I $D(%CL0) W *27,*91,%CL0,"m" E X %XCL Q RBUA ; D ^%L1RBUA Q %L1WE %L1WE ; WINDOW ENGLISH ; %X1,%Y1,%X2,%Y2 - COORD WINDOW,%LS - LENGTH,%INV -INVERS [ 31.03.19 14:54 ] [ 10.04.09 10:53 ] [ 16.10.08 13:37 ] ; %X0,%Y0 - I '$D(%POSIC) D ^%L1C N %L1WEFR S %L1WEFR="" U $P:(NOECHO:NOWRAP:ESCAPE) N %ECHO,%HBRY S %FHBR=0 S %TO="" S:'$D(%S) %S="" N %INS S %INS=1 S:'$D(%X1) %X1=0 S:'$D(%X2) %X2=79 S:'$D(%Y1) %Y1=20 S:'$D(%Y2) %Y2=23 N %M,%I,%II,%XX,%YY,%C,%C1,%C2,%TOP,%X0,%Y0,%HBRY S:%X1<0 %X1=0 S:%X1>79 %X1=79 S:%Y1<0 %Y1=0 S:%Y1>23 %Y1=23 S:%X2<1 %X2=1 S:%X2>79 %X2=79 S:%Y2<1 %Y2=1 S:%Y2>24 %Y2=24 S:%X2<%X1 %X2=%X1 S:%Y2<%Y1 %Y2=%Y1 S:'$D(%LS) %LS=(%X2-%X1+1)*(%Y2-%Y1+1) S %S=$E(%S,1,%LS) S %I=1 ;F %II=1:1:$L(%S) S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) S %I=1 I $D(%INV) W %ENG,%CLI D CLEAR D P G:$D(%L1WE)!$D(%L1GET) END1 S %X0=%X1,%Y0=%Y1 POZ S %XX=%X0,%YY=%Y0 X %POSIC R *%C S ZB="" I $D(%L1WEFR) S %STARTVV=$P($H,",",2) K %L1WEFR F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) ;;R *%C1:0 I %C1>0 S ZB=ZB_%C1 I $L(ZB)>3,$D(%UPRCOD(ZB)) G @%UPRCOD(ZB) G:%C=13 END ;I %C=25 G ESC ;I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) ;I %C=27 R *%C1:0 G:%C1<0 ESC R *%C2:0 I %C2>0 S %C=%C1_%C2 ;I %C=0 D DELAY R *%C1:0 D DELAY R *%C2:0 I %C1>0 S %C="0"_%C1 I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) I %C>31&(%C<127) D VV G POZ G POZ ESC S %TO="END" G END ;- VV I $D(CIST),CIST'[$C(%C) W *7 Q I %INS D VSTAV S %XX=%X0,%YY=%Y0 X %POSIC S $E(%S,%I)=$$SMB^%S2ERG(%C) ;;$S($D(%HBRY):$TR($C(%C),%TES2,%TES1),1:$C(%C)) D .I $D(%HBRY) W $$W^%L1C($E(%S,%I)) Q .W $E(%S,%I) ;;W $S($D(%HBRY):$TR($TR($E(%S,%I),%TES1,%TES2),%TEN,%THB),1:$E(%S,%I)) S:%I>%TOP %TOP=%I D RIGHT Q ;- CLEAR ; F %II=%Y1:1:%Y2 S %XX=%X1,%YY=%II X %POSIC W $J("",%X2-%X1+1) Q ;- P ; S %XX=%X1 S %S=$E(%S,1,%TOP) F %II=%Y1:1:%Y2 S %YY=%II X %POSIC D .N A S A=$E(%S,(%X2-%X1+1)*(%II-%Y1)+1,(%X2-%X1+1)*(%II-%Y1+1)) .D ..I $D(%HBRY) W $$W^%L1C(A) Q ;;W $S($D(%HBRY):$TR($TR(A,%TES1,%TES2),%TEN,%THB),1:A) ..W A Q P1 ; N %SSS S %SSS=$E(%S,%I,400) ;;I $D(%HBRY) S %SSS=$TR($TR(%SSS,%TES1,%TES2),%TEN,%THB) ;; W $E(%SSS,1,%X2-%X0+1) D .I $D(%HBRY) W $$W^%L1C($E(%SSS,1,%X2-%X0+1)) Q .W $E(%SSS,1,%X2-%X0+1) ; S %SSS=$E(%SSS,%X2-%X0+2,400) I $D(%HBRY) S %SSS=$$W^%L1C(%SSS) F %II=%Y0+1:1:%Y2 S %YY=%II,%XX=%X1 X %POSIC W $E(%SSS,1,%X2-%X1+1) Q:%SSS="" S %SSS=$E(%SSS,%X2-%X1+2,400) Q ;- RIGHT ; Q:%X0=%X2&(%Y0=%Y2)!(%I=%LS)!(%I>%TOP) I %FHBR W *8 Q I %X0=%X2 S %X0=%X1,%Y0=%Y0+1 E S %X0=%X0+1 S %I=%I+1 Q LEFT ; Q:%X0=%X1&(%Y0=%Y1)!(%I=1) I %X0=%X1 S %X0=%X2,%Y0=%Y0-1 E S %X0=%X0-1 S %I=%I-1 Q ENDS S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;- LEVO ; D LEFT G POZ PRAVO ; D RIGHT G POZ VVERX ; I %Y0=%Y1,%X0=%X1 S %TO="UP" G END I %Y0=%Y1 S %X0=%X1,%I=1 G POZ S %Y0=%Y0-1,%I=%I-(%X2-%X1+1) G POZ VNIZ ; I %Y0=%Y2!(%I+(%X2-%X1+1)>%TOP) S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;S %X0=%X1+(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) S:%X0>%X2 %X0=%X2 G POZ S %Y0=%Y0+1,%I=%I+(%X2-%X1+1) G POZ INS S %INS=1-%INS S %SAY=$S(%INS:"INSERT",1:"OVERFLOW") X %XMSGV G POZ TAB I %I+10>%TOP S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 S %I=%I+10 S:%I>%LS %I=%LS G POZ1 TABN I %I-10<1 S %I=1 G POZ1 S %I=%I-10 POZ1 S %X0=%X1+(%I-.1#(%X2-%X1+1)+.1)-1,%Y0=%Y1+(%I-.1\(%X2-%X1+1)) S:%X0<%X1 %X0=%X1 S:%X0>%X2 %X0=%X2 G POZ ;- DEL G:%TOP=0 POZ F %II=%I:1:%TOP-1 S $E(%S,%II)=$E(%S,%II+1) S $E(%S,%TOP)=" " S %TOP=%TOP-1 I %I-1>%TOP D LEFT S %XX=%X0,%YY=%Y0 X %POSIC W " " G POZ D P1 ;D CLEAR,P G POZ ;- ADD G:%TOP+1>%LS POZ F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 D CLEAR,P G POZ VSTAV Q:%TOP+1>%LS F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 S %XX=%X0,%YY=%Y0 X %POSIC D P1 Q ;D CLEAR,P S %XX=%X0,%YY=%Y0 X %POSIC Q ;- ;- HOME S %X0=%X1,%Y0=%Y1,%I=1 G POZ PGDN S %TO="DW" G END PGUP S %TO="UP" G END FIND S %TO="F8" G END COR S %TO="F7" G END SAVE S %TO="F9" G END ADDL S %TO="F5" D ADDL^%L1ZMSL G END DELL S %TO="F6" G END REST G:'$D(%L1SF) POZ G:'$D(NM) POZ S %SOLD=%S D D VSVALL^%L1SF,PODVAL^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ K %L1GET S %S=%SOLD,%INV=1 G %L1WE .I %S?.E1"D ".U.N1"^".E S $ZS="<>^"_$P($P($P(%S,"D ",2),"^",2)," ") .;N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) X ^%ERG .S %PR=$P($P($P(%S,"D ",2),"^",2)," "),U=1 .S %DLM=$S($E(%S,1,2)="D ":"D ",1:" D ") .S %LB=$P($P(%S,%DLM,2),"^",1) .X %XCL D POISK^%L1ER(%LB_"^"_%PR) END S %S=$E(%S,1,%TOP) END1 U $P X %XCL K CIS,%LS Q ;- CHISTS G:%I=0 POZ S %TOP=%I-1 D CLEAR,P G POZ ;- DELAY F %II=1:1:400 Q ;MDRG S %FHBR='%FHBR I %FHBR S %FLINS=1 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 K %HBRY G HBR ;S %HBRY="" W %HBR G POZ ;W *27,7 S %SAY="ENGLISH TEXT" X %XMSGV W *27,8 S %HBRY="" G HBR ;HBR I '$D(%HBRY) S %HBRY="" W %HBR D P G POZ ;K %HBRY W %ENG D P G POZ MDRG ; HBR I '$D(%HBRY),'$G(%FHBR) S TXT="HEBREW SHOW" D STR1 S %HBRY="" D P G POZ I $D(%HBRY),'$G(%FHBR) S TXT="HEBREW TEXT" D STR1 S %HBRY="",%FHBR=1 D P G POZ S %FHBR=0 K %HBRY S TXT="ENGLISH" D STR1 D P G POZ ; STR1 Q:'$D(TXT) W %vverxe,%chists S %YY=0,%XX=16 X %POSIC D WT("YF",TXT) K:'$D(TXT(1)) TXT X %XCL Q WT(CV,TXT) X %LIGHT W %CV(CV),TXT X %XCL Q %L1WEBHD %L1WEBHD(KOT,PRM,CLASS) ; [ 28.09.23 12:46 ] [ 31.07.23 13:31 ] [ 01.07.10 16:04 ] S KOT=$G(KOT) I $G(CLASS)="" S CLASS="hdvw" I $G(PRM)["S" W "Session ID="_$G(JB,"?")_"
",! W "",! N %NM S %NM=$$^%W1PCNMR W "",! W "
" I %NM'="" D .W ""_$$^%W1PCNMR_"" .W $$NBSP^%L1FRM(2) W $S($G(PRM)["T":$$H2U^%L1FRM(KOT),1:$$^%W1DICT(KOT)) W "
",! Q STYLE(CLS,BC,FC,SZ,AL) ; I '$D(CLS) S CLS="" I '$D(BC) S BC="#000088" I '$D(FC) S FC="#FFFFFF" I '$D(SZ) S SZ="24pt" I '$D(AL) S AL="center" W "" Q %L1WEBJS %L1WEBJS(FILE,TITLE,KOT) ; [ 10.09.07 16:33 ] [ 26.07.07 15:20 ] [ 28.04.07 16:10 ] S FFILE=$$FULL(FILE) I $$^%L1ZOS(10,FFILE)>0 U 0 W !!," FILE "_FFILE_" EXIST ! " H 1 Q O FFILE:(WRITE:NEWVERSION:REWIND) U FFILE W "",! W "",! W ""_TITLE_"",! W "<%@ taglib uri=""http://cav.co.il/taglibs/mumps"" prefix=""m"" %>",! W "",! W "",! W "",! W "<%@ include file=""w1jbarg.jsp"" %>",! W "",! W "",! W "",! C FFILE Q PATHJSP(STAM) ; N PJSP S PJSP=$$WEBL^W3MAIN I $E(PJSP,$L(PJSP))'="/" S PJSP=PJSP_"/" Q PJSP FULL(FILE) ; N FFILE S %PATHJSP=$$PATHJSP S FILE=$$FUNC^%LCASE(FILE) I FILE'["." S FILE=FILE_".jsp" S FFILE=%PATHJSP_FILE Q FFILE %L1WEBMN %L1WEBMN(MENU) ; [ 16.09.16 14:41 ] [ 05.06.09 14:55 ] [ 09.05.09 18:25 ] N (MENU,JB,%ARG,%REM) N I,N,MN,IM,A S N="",I=0 F S N=$O(^[$$^W3MAIN]W4OPT(MENU,N)) Q:N="" D .S A=$G(^(N)) .S US=$P(A,";") Q:'@US .S RKV=$P(A,";",2) .S PROC=$P(A,";",3) .S I=I+1,MN(I)=$$^%W1DICT(RKV),MA(I)=PROC S IM=I ; D WMN(.MN,.MA) Q ; WMN(MN,MA) ; N MN1,MA1 M MN1=MN N I,CLSMN,HREF,IM S IM=$O(MN(999),-1) S CLSMN=$S($$^%W1DIR="RTL":"menuh",1:"menu") ; W "

",! W "
",! ; W "",! N I1 S I1=0 F I=1:1:IM D .S MN1(I)=$$SPA^%L1FRM(MN1(I)) .N JSP,PRM S JSP=$P(MA(I),"?") .S PRM=$P(MA(I),"?",2,25) .S MA1(I)=$$FUNC^%LCASE(JSP) I PRM'="" S MA1(I)=MA1(I)_"?"_PRM .S HREF="" .I MN1(I)["~" D Q ..W "",! . .S I1=I1+1 .W "",! W "
" ..W "

"_$$H2U^%L1FRM($TR(MN1(I),"~",""))_"

" ..W "
"_I1_"."_HREF_$$H2U^%L1FRM(MN1(I))_"
",! W "
",! W "

",! Q %L1WEEK %L1WEEK(YY,MM) ; [ 02/01/99 8:52 AM ] [ 06/16/97 6:39 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,YY,MM) D INIT^%L1LUAH D DEF^%L1LUAH S %WEEK="" S:DEN=0 DEN=7 I DEN=7 S %WEEK="1,",DNX=2 I DEN=1 S %WEEK="1-7,",DNX=8 I DEN>1,DEN<7 S %WEEK="1-"_(7-DEN+1)_",",DNX=7-DEN+2 F I=1:1 Q:(COLD-DNX)<6 S %WEEK=%WEEK_DNX_"-"_(DNX+6)_"," S DNX=DNX+7 I COLD'78 %X1=78 S:%Y1<0 %Y1=0 S:%Y1>23 %Y1=23 S:%X2<1 %X2=1 S:%X2>79 %X2=79 S:%Y2<1 %Y2=1 S:%Y2>24 %Y2=24 S:%X2<%X1 %X2=%X1 S:%Y2<%Y1 %Y2=%Y1 S %HBRY="" S:'$D(%LS) %LS=(%X2-%X1+1)*(%Y2-%Y1+1) I %LS>400 S %LS=400 D FNS S %S=$E(%S,%JJ,$L(%S)) S %S=$E(%S,1,%LS) S %I=1 F %II=$L(%S):-1:1 S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) S %I=1 I $D(%INV) W %CLI D CLEAR D P G:$D(%L1WH)#2!$D(%L1GET) END1 I $G(%BE)="E",$L(%S) K %BE G ENDS S %X0=%X2,%Y0=%Y1 I $D(%ZMSL("LB","GL")) D SV I %MOUSE,%TOP>1 G ENDS POZ ; ;;W %vverxe,%chists," %X0=",%X0," %Y0=",%Y0," %I=",%I," %X1=",%X1," %Y1=",%Y1," %X2=",%X2," %Y2=",%Y2," %LS=",%LS," %TOP=",%TOP," $L(%S)=",$O(%M(9999),-1) U $P:(NOECHO:NOWRAP) S %XX=%X0,%YY=%Y0 X %POSIC I $G(%PRKB) G RC I %MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) D S %C=$$^%L1NMB("") S:%C="ENTER"!(%C="")!(%C=$C(10)) %C=$C(13) G:$A(%C)<65!($A(%C)>90) CYC2 G:$T(@%C)'="" @%C G CYC2 .S %L1NMB("ZY")=%Y1 K %PRKB ; RC R *%C:1 E K %PRKB G POZ I $G(%ZMSL)'="",%ZMSL[$C(%C),%C'=13 S %TO=$C(%C) K %ZMSL Q 13 S %XX=%X0,%YY=%Y0 X %POSIC S %BEG=0 G:%C=13&'$D(%L1WH("ESC")) END I %C=13,$D(%L1WH("ESC")) G VNIZ I %C=61,$D(%L1WH("=")) G END I %C=25 G ESC I %C=46 S %C=149 READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) 27 I %C=27 D DELAY R:'$D(%FLL) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL) *%C2:%WAIT S:%C2>0 C=%C1_%C2 .R:'$D(%FLL) *%C3:%WAIT S:%C3>0 C=C_%C3 .R:'$D(%FLL) *%C4:%WAIT S:%C4>0 C=C_%C4 I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) I $$ABC(%C) D VV G POZ G POZ VV I $G(%ZMSL)'="",%ZMSL[$C(%C),%C'=13 S %TO=$C(%C) K %ZMSL Q I $D(CIST),CIST="" S %TO=$C(%C) Q I $D(CIST),CIST'[$C(%C) W *7 Q I %C>47&(%C<58)!(%C>64&(%C<91)),%FHBR S %FHBR=0,%INS="" K %HBRY I %C>95&(%C<123)!((%C>127)&(%C<155)),'%FHBR S %FHBR=1,%INS="",%HBRY="" I $D(%INS),%I'>%TOP!'%FHBR D D P S %XX=%X0,%YY=%Y0 X %POSIC Q:'%FHBR Q:%I'>%TOP G WORD .I %I'<%LS!($O(%M(99999),-1)'<%LS) Q . .I %FHBR D S %M(%I)=" ",%TOP=%TOP+1 S %M(%I)=$$SMB^%S2ERG(%C) D W(%C) S:%I>%TOP %TOP=%I D LEFT ..F %II=%TOP+1:-1:%I+1 S %M(%II)=%M(%II-1) .I '%FHBR D S %M(%I)=$$SMB^%S2ERG(%C) D W(%C) S %TOP=$O(%M(900),-1) ..F %II=%TOP+1:-1:%I S:$D(%M(%II-1)) %M(%II)=%M(%II-1) .Q . .I %FHBR D S %M(%I)=" ",%TOP=%TOP+1 S %M(%I)=$S(%C'=44&(%C'=39):$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1),1:$TR($C(%C),%TES2,%TES1)) D W(%I) S:%I>%TOP %TOP=%I D LEFT ..F %II=%TOP+1:-1:%I+1 S %M(%II)=%M(%II-1) .I '%FHBR D S %M(%I)=$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1) D W(%I) S %TOP=$O(%M(900),-1) ..F %II=%TOP+1:-1:%I S:$D(%M(%II-1)) %M(%II)=%M(%II-1) ; VV1 S %M(%I)=$$SMB^%S2ERG(%C) ;;I %C'<65,%C'=149 S %M(%I)=$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1) ;;E S %M(%I)=$TR($C(%C),%TES2,%TES1) D W(%C) S:%I>%TOP %TOP=%I D LEFT ; WORD I $D(%L1WH("WORD")),$C(%C)'=" ",%X0=%X2,%I>1 D ;-- PERENOS PO SLOVAM .N %I1,%I2,%I3,%OK S %I2=0,%OK=0 .F %I1=%I-1:-1:1 S %I2=%I2+1 Q:%M(%I1)=" " Q:%I2>(%X2-%X1) .I %M(%I1)=" ",%I*2-%I1-2'>%LS D ..F %I3=%I-1:-1:%I1+1 S %M(%I3+%I-%I1-1)=%M(%I3),%M(%I3)=" " ..S %TOP=$O(%M(900),-1),%I=%TOP+1 D P ..S %X0=%X2+1-(%I-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%I-.1\(%X2-%X1+1)) ; LBG I $D(%ZMSL("LB","GL")),%CVET W *27,7 D LB($$M2S("%M")) W *27,8 Q CYC2 S %C=$A(%C) G 13 CLEAR ; I $D(%L1WH("CVB")) S %L1RBCL=%CV(%L1WH("CVB")) I $D(%L1WH("RB")) D TV^%L1RBUA(%Y1,%X1,%Y2+2,%X2+2) F %II=%Y1:1:%Y2 S %XX=%X1,%YY=%II X %POSIC W $J("",%X2-%X1+1) I $D(%L1WH("LI")) W %LIGHT1 I $L($G(%L1WH("CVF"))),$D(%CV(%L1WH("CVF"))) W %CV(%L1WH("CVF")) Q P ; S %XX=%X2,%YY=%Y1 W %HBR S %TOP=$O(%M(900),-1) F %II=1:1:%TOP X %POSIC S:'$D(%M(%II)) %M(%II)=" " W $$W^%L1C(%M(%II)) Q:%XX=%X1&(%YY=%Y2) S:%XX=%X1 %YY=%YY+1 S %XX=$S(%XX=%X1:%X2,1:%XX-1) Q DELG ; N %I,%J,%II,%FRAZA,%CHAST S %FRAZA="" F %II=1:1 Q:'$D(%M(%II)) S %FRAZA=%M(%II)_%FRAZA D DLG^%L1FRM(%FRAZA,%X2-%X1+1) K %M S %II=0 F %I=1:1 Q:'$D(%CHAST(1,%I)) D .N A S A=$J($$SPR^%L1FRM(%CHAST(1,%I)),%X2-%X1+1) .F %J=$L(A):-1:1 S %II=%II+1,%M(%II)=$E(A,%J) S %TOP=$O(%M(900),-1) Q LEFT ; ;Q:%X0=%X1&(%Y0=%Y2)!(%I=%LS)!(%I>%TOP) Q:%I'<%LS Q:$O(%M(999),-1)'<%LS I %X0=%X1 S %X0=%X2,%Y0=%Y0+1 E S %X0=%X0-1 S %I=%I+1 S:'$D(%M(%I)) %M(%I)=" " S %FHBR=1,%HBRY="" Q RIGHT ; Q:%X0=%X2&(%Y0=%Y1)!(%I=1) I %X0=%X2 S %X0=%X1,%Y0=%Y0-1 E S %X0=%X0+1 S %I=%I-1 Q LEVO ; D LEFT G POZ PRAVO ; D RIGHT G POZ HOME S %X0=%X2,%Y0=%Y1,%I=1 G POZ ENDS ; S %TOP=$O(%M(900),-1) S %Y0=%Y2,%I=%TOP+1 S:%I>%LS %I=%LS S %X0=%X2-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) S %FHBR=1,%HBRY="" G POZ VVERX ; I %Y0=%Y1 S %X0=%X2,%I=1 G POZ S %Y0=%Y0-1,%I=%I-(%X2-%X1+1) G POZ VNIZ ; I $D(%ZMSL("LB")),$D(%L1LB) D K %L1LB G:$G(%L3VN)'="" END G POZ .W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY .K %L1("VIEW"),%L3VN S %L3VNOHZG="" D TV^%L1LB .D RS I $G(%ZMSL("LB","START"))<2 K %ZMSL("LB","START") .I $G(%L3VN)'="" S %S=$$HBR^%L1FRM($G(%L1LB(%L3VN))_" "_$S($D(%ZMSL("LB","START")):$E(%S,$L(%S)-%ZMSL("LB","START")+1,400),1:""),%LS) .S %S=$$SPL^%L1FRM(%S) D S2M(%S) .K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC .S $X=%XX,$Y=%YY D P S %I=%LS ; S %TOP=$O(%M(900),-1) I %Y0=%Y2!(%I+(%X2-%X1+1)>%TOP&'$D(%L1WH("ESC"))) S %I=%TOP+1 S:%I>%LS %I=%LS S %X0=%X2-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ ;;I %I+(%X0-%X1+1)>%TOP,$D(%L1WH("ESC")) S %I0=%I,%I=%I+%X0-%X1+1 S:%I>%LS %I=%LS D S %X0=%X2+1-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " I %I+(%X0-%X1+1)>%TOP,$D(%L1WH("ESC")) S %I0=%I,%I=%I+%X0-%X1+1 S:%I>%LS %I=%LS D S %X0=%X2,%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " ; I %I+(%X2-%X1+1)>%TOP G ENDS .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " ; S %Y0=%Y0+1,%I=%I+(%X2-%X1+1) G POZ DEL G:%TOP=0 POZ S %TOP=$O(%M(900),-1) F %II=%I:1:%TOP-1 S %M(%II)=$G(%M(%II+1)," ") F %II=%TOP:1 Q:'$D(%M(%II)) K %M(%II) S %TOP=%TOP-1 I %I-1>%TOP D RIGHT S %XX=%X0,%YY=%Y0 X %POSIC W " " G POZ D CLEAR,P G POZ CHISTS G:%I=0 POZ S %TOP=%I-1 F %II=%TOP:1 Q:'$D(%M(%II)) K %M(%II) D CLEAR,P G POZ LIMEND K %ZMSL END I $D(%L1WH("WORD")) D DELG,P S %S="" S %I=1 F %II=%TOP:-1:1 S $E(%S,%I)=$G(%M(%II)) S %I=%I+1 S %S=$$SPL^%L1FRM(%S) END1 I $D(%ECHO) U $P:(ECHO:WRAP) D RS X %XCL K CIST,%LS,%L1WH,%L1GET,%ZMSL Q DELAY Q F %II=1:1:200 Q M2S(M) ; N %S,%I,%II S %S="" S %I=1 F %II=$O(@M@(999),-1):-1:1 Q:'$D(@M@(%II)) S $E(%S,%I)=@M@(%II) S %I=%I+1 S %S=$$SPL^%L1FRM(%S) Q %S S2M(%S) ; K %M S %I=1 F %II=$L(%S):-1:1 S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) Q ESC R *A1:0 R *A1:0 S %TO="END" G END PGUP S %TO="PGUP" G END PGDN S %TO="PGDW" G END INS I $D(%INS) K %INS S %SAY=" OVERLAY " X %XMSGV G POZ S %INS="" S %SAY=" INSERT " X %XMSGV G POZ FIND S %TO="F8" G END COR S %TO="F7" G END SAVE S %TO="F9" G END REST S %TO="F10" G END ADDL S %TO="F5" D ADDL^%L1ZMSL G END DELL S %TO="F6" G END FINDS S %TO="FINDS" G END MOD S %TO="DEL" D DELAY R *C1:0 G END PGLN S %TO="PGLN" D DELAY R *%C1:0 G END HELP S %TO="HELP" D DELAY R *%C1:0 G END IND S %TO="F4" D DELAY R *%C1:0 G END CHISTE S %TO="F2" D DELAY R *%C1:0 G END PGRG S %TO="PGRG" D DELAY R *%C1:0 G END BEGF S %TO="BEGF" D DELAY R *%C1:0 G END ENDF S %TO="ENDF" D DELAY R *%C1:0 I $D(^r($J)),$G(%SCRN)["P1HZ" D 1^P1POP ;-- PTICHAT MEGIRA G END FNS ; I $L(%S)=0 S %JJ=0 Q F %JJ=1:1:$L(%S)+1 Q:$E(%S,%JJ)'=" " Q SV ; I %TYPCRT["PC" s l1zms="" D GET^%VIDEO("l1zms",0,0,80,24,2) Q ;;I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;4$v" S l1zms="" Q RS ; ; I %TYPCRT["PC" D PUT^%VIDEO("l1zms",0,0,80,24,2) K l1zms Q ;;I $E(%TYPCRT,1,3)="VT5",%CVET W $C(27,91),";;;;4;;;$v" K l1zms Q Q LB(%S) ; N %TXT S %TXT=" "_$$SPL^%L1FRM(%S) I $D(%ZMSL("LB","NOTR")) D .N %I F %I=1:1:$L(%S) Q:%ZMSL("LB","NOTR")'[$E(%S,$L(%S)+1-%I) .I %I>$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=%I I $L(%TXT)-1<$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=$L(%TXT) I '$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=1 N %J,%J0 S %J0=%ZMSL("LB","START") F %J=%J0-1:-1:1 Q:$A($E(%TXT,$L(%TXT)-%J))<96!($A($E(%TXT,$L(%TXT)-%J))>122) S %ZMSL("LB","START")=%J I $G(%ZMSL("LB","START")) S %TXT=$E(%TXT,1,$L(%TXT)+1-%ZMSL("LB","START")) S %TXT=$$SPA^%L1FRM(%TXT) Q:%TXT="" I $D(%ZMSL("LB","HELP")) W *27,"[24;30H",$$^%L1HB(%ZMSL("LB","HELP")) D ^%L1LB(%TXT,%ZMSL("LB","GL"),$G(%ZMSL("LB","PR"))) Q TAB ; N %J,%J1,%TOP S %TOP=$O(%M(999),-1) F %J=%I-($G(%M(%I))=" "):-1:1 Q:'$D(%M(%J)) Q:" +,;:-="[%M(%J) I %J<1 S %J=1 S %J1=%J I $D(%M(%J)) S %J1=%J+(" +,;:-="[%M(%J)) S %WORD="" F %J2=%J1:1:%TOP Q:'$D(%M(%J2)) Q:" +,;:-="[%M(%J2) S %WORD=%WORD_%M(%J2) I $L(%WORD),$D(^word(%WORD)) D G POZ .S %WORD1=^(%WORD) .S %S="" F %J3=1:1:%J1-1 S %S=%M(%J3)_%S .S %S=" "_%WORD1_%S .F %J3=%J2+1:1:%TOP S %S=%M(%J3)_%S .D S2M(%S) D P W *7 G POZ ABC(SMB) ; I SMB>31&(SMB<123) Q 1 I SMB>127&(SMB<155) Q 1 Q 0 W(%C) ;;W $S($D(%HBRY):$TR($TR(%M(%I),%TES1,%TES2),%TEN,%THB),1:%M(%I)) N %PR S %PR="" I $D(%HBRY) S %PR="I" W $$WC^%S2ERG($C(%C),%PR) Q %L1WH0 %L1WH ; WINDOW HEBRY ; %X1,%Y1,%X2,%Y2 - COORD WINDOW,%LS - LENGTH,%INV -INVERS [ 18.10.06 13:39 ] [ 02.05.06 10:01 ] [ 01.05.06 21:17 ] ;%L1WH("CVB") - BACKGRAUND ;%L1WH("CVF") - FOREGRAUND ;%L1WH("RB") - RIBUA ; %X0,%Y0 - N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S,%X1,%X2,%Y1,%Y2,%L1WH,%L1GET,%LS,%INV,CIST,%TO) D ^%L1C I $D(%L1WH)#2,'$D(%L1WH("CVF")) S %L1WH("CVF")="YF" W %LIGHT1 U $P:(NOECHO:NOWRAP) ;U $P:(NOECHO:NOWRAP) S:'$D(%S) %S="" S %TO="",%INS="",%FHBR=1 W %HBR S %L1NMB("ALB")=1,%BEG=1 S %MOUSE=$$INIT^%L2MOUSE K %screen N %M,%I,%II,%XX,%YY,%C,%C1,%C2,%TOP,%X0,%Y0,%HBRY,A1 S:'$D(%X1) %X1=0 S:'$D(%X2) %X2=78 S:'$D(%Y1) %Y1=20 S:'$D(%Y2) %Y2=23 S:%X1<0 %X1=0 S:%X1>78 %X1=78 S:%Y1<0 %Y1=0 S:%Y1>23 %Y1=23 S:%X2<1 %X2=1 S:%X2>79 %X2=79 S:%Y2<1 %Y2=1 S:%Y2>24 %Y2=24 S:%X2<%X1 %X2=%X1 S:%Y2<%Y1 %Y2=%Y1 S %HBRY="" S:'$D(%LS) %LS=(%X2-%X1+1)*(%Y2-%Y1+1) I %LS>255 S %LS=255 S %S=$E(%S,1,%LS) S %I=1 F %II=$L(%S):-1:1 S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) S %I=1 I $D(%INV) W %CLI D CLEAR D PC G:$D(%L1WH)#2!$D(%L1GET) END1 S %X0=%X2,%Y0=%Y1 I %MOUSE,%TOP>1 G ENDS POZ ; ;W %vverxe,%chists," %X0=",%X0," %Y0=",%Y0," %I=",%I," %X1=",%X1," %Y1=",%Y1," %X2=",%X2," %Y2=",%Y2," %LS=",%LS," %TOP=",%TOP U $P:(NOECHO:NOWRAP) S %XX=%X0,%YY=%Y0 X %POSIC I $G(%PRKB) G RC I %MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) D S %C=$$^%L1NMB("") S:%C="ENTER"!(%C="")!(%C=$C(10)) %C=$C(13) G:$A(%C)<65!($A(%C)>90) CYC2 G:$T(@%C)'="" @%C G CYC2 .S %L1NMB("ZY")=%Y1 K %PRKB ; RC R *%C:1 E K %PRKB G POZ 13 S %XX=%X0,%YY=%Y0 X %POSIC S %BEG=0 G:%C=13&'$D(%L1WH("ESC")) END I %C=13,$D(%L1WH("ESC")) G VNIZ I %C=61,$D(%L1WH("=")) G END I %C=25 G ESC I %C=46 S %C=149 READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) 27 I %C=27 D DELAY R:'$D(%FLL) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL) *%C2:%WAIT S:%C2>0 C=%C1_%C2 .R:'$D(%FLL) *%C3:%WAIT S:%C3>0 C=C_%C3 .R:'$D(%FLL) *%C4:%WAIT S:%C4>0 C=C_%C4 I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) I $$ABC(%C) D VV G POZ G POZ VV I $D(CIST),CIST'[$C(%C) W *7 Q I %C>47&(%C<58)!(%C>64&(%C<91)),%FHBR S %FHBR=0,%INS="" W %ENG I %C>95&(%C<123)!((%C>127)&(%C<155)),'%FHBR S %FHBR=1,%INS="" W %HBR I $D(%INS),%I'>%TOP!'%FHBR D D PC S %XX=%X0,%YY=%Y0 X %POSIC Q:'%FHBR Q:%I'>%TOP G WORD .I %I'<%LS&($O(%M(99999),-1)'<%LS) Q .I %FHBR D S %M(%I)=" ",%TOP=%TOP+1 S %M(%I)=$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1) D W(%I) S:%I>%TOP %TOP=%I D LEFT ..F %II=%TOP+1:-1:%I+1 S %M(%II)=%M(%II-1) .I '%FHBR D S %M(%I)=$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1) D W(%I) S %TOP=$O(%M(900),-1) ..F %II=%TOP+1:-1:%I S:$D(%M(%II-1)) %M(%II)=%M(%II-1) ; I %C'<65,%C'=149 S %M(%I)=$TR($TR($C(%C),%THB,%TEN),%TES2,%TES1) E S %M(%I)=$TR($C(%C),%TES2,%TES1) D W(%I) S:%I>%TOP %TOP=%I D LEFT WORD I $D(%L1WH("WORD")),$C(%C)'=" ",%X0=%X2,%I>1 D .N %I1,%I2,%I3,%OK S %I2=0,%OK=0 .F %I1=%I-1:-1:1 S %I2=%I2+1 Q:%M(%I1)=" " Q:%I2>(%X2-%X1) .I %M(%I1)=" ",%I*2-%I1-2'>%LS D ..F %I3=%I-1:-1:%I1+1 S %M(%I3+%I-%I1-1)=%M(%I3),%M(%I3)=" " ..S %TOP=$O(%M(900),-1),%I=%TOP+1 D PC ..S %X0=%X2+1-(%I-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%I-.1\(%X2-%X1+1)) Q CYC2 S %C=$A(%C) G 13 CLEAR ; I $D(%L1WH("CVB")) S %L1RBCL=%CV(%L1WH("CVB")) I $D(%L1WH("RB")) D TV^%L1RBUA(%Y1,%X1,%Y2+2,%X2+2) F %II=%Y1:1:%Y2 S %XX=%X1,%YY=%II X %POSIC W $J("",%X2-%X1+1) I $D(%L1WH("LI")) W %LIGHT1 I $D(%L1WH("CVF")),$D(%CV(%L1WH("CVF"))) W %CV(%L1WH("CVF")) Q PC ; S %XX=%X2,%YY=%Y1 W %HBR S %TOP=$O(%M(900),-1) F %II=1:1:%TOP X %POSIC S:'$D(%M(%II)) %M(%II)=" " D W(%II) Q:%XX=%X1&(%YY=%Y2) S:%XX=%X1 %YY=%YY+1 S %XX=$S(%XX=%X1:%X2,1:%XX-1) I '%FHBR W %ENG Q DELG ; N %I,%J,%II,%FRAZA,%CHAST S %FRAZA="" F %II=1:1 Q:'$D(%M(%II)) S %FRAZA=%M(%II)_%FRAZA D DLG^%L1FRM(%FRAZA,%X2-%X1+1) K %M S %II=0 F %I=1:1 Q:'$D(%CHAST(1,%I)) D .N A S A=$J($$SPR^%L1FRM(%CHAST(1,%I)),%X2-%X1+1) .F %J=$L(A):-1:1 S %II=%II+1,%M(%II)=$E(A,%J) S %TOP=$O(%M(900),-1) Q LEFT ; ;Q:%X0=%X1&(%Y0=%Y2)!(%I=%LS)!(%I>%TOP) Q:%I=%LS I %X0=%X1 S %X0=%X2,%Y0=%Y0+1 E S %X0=%X0-1 S %I=%I+1 S:'$D(%M(%I)) %M(%I)=" " S %FHBR=1 W %HBR Q RIGHT ; Q:%X0=%X2&(%Y0=%Y1)!(%I=1) I %X0=%X2 S %X0=%X1,%Y0=%Y0-1 E S %X0=%X0+1 S %I=%I-1 Q LEVO ; D LEFT G POZ PRAVO ; D RIGHT G POZ HOME S %X0=%X2,%Y0=%Y1,%I=1 G POZ ENDS ; S %TOP=$O(%M(900),-1) S %Y0=%Y2,%I=%TOP+1 S:%I>%LS %I=%LS S %X0=%X2-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) S %FHBR=1 W %HBR G POZ VVERX ; I %Y0=%Y1 S %X0=%X2,%I=1 G POZ S %Y0=%Y0-1,%I=%I-(%X2-%X1+1) G POZ VNIZ ; S %TOP=$O(%M(900),-1) I %Y0=%Y2!(%I+(%X2-%X1+1)>%TOP&'$D(%L1WH("ESC"))) S %I=%TOP+1 S:%I>%LS %I=%LS S %X0=%X2-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ ;;I %I+(%X0-%X1+1)>%TOP,$D(%L1WH("ESC")) S %I0=%I,%I=%I+%X0-%X1+1 S:%I>%LS %I=%LS D S %X0=%X2+1-(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " I %I+(%X0-%X1+1)>%TOP,$D(%L1WH("ESC")) S %I0=%I,%I=%I+%X0-%X1+1 S:%I>%LS %I=%LS D S %X0=%X2,%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) G POZ .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " ; I %I+(%X2-%X1+1)>%TOP G ENDS .S %TOP=%I .N %II F %II=%I0:1:%TOP S:'$D(%M(%II)) %M(%II)=" " ; S %Y0=%Y0+1,%I=%I+(%X2-%X1+1) G POZ DEL G:%TOP=0 POZ S %TOP=$O(%M(900),-1) F %II=%I:1:%TOP-1 S %M(%II)=$G(%M(%II+1)," ") F %II=%TOP:1 Q:'$D(%M(%II)) K %M(%II) S %TOP=%TOP-1 I %I-1>%TOP D RIGHT S %XX=%X0,%YY=%Y0 X %POSIC W " " G POZ D CLEAR,PC G POZ CHISTS G:%I=0 POZ S %TOP=%I-1 F %II=%TOP:1 Q:'$D(%M(%II)) K %M(%II) D CLEAR,PC G POZ END I $D(%L1WH("WORD")) D DELG,PC S %S="" S %I=1 F %II=%TOP:-1:1 S $E(%S,%I)=%M(%II) S %I=%I+1 S %S=$$SPL^%L1FRM(%S) END1 D PUT^%L1ZMS I $D(%ECHO) U $P:(ECHO:WRAP) X %XCL K CIST,%LS,%L1WH,%L1GET Q DELAY Q F %II=1:1:200 Q ESC R *A1:0 R *A1:0 S %TO="END" G END PGUP S %TO="PGUP" G END PGDN S %TO="PGDW" G END INS I $D(%INS) K %INS S %SAY=" OVERLAY " X %XMSGV G POZ S %INS="" S %SAY=" INSERT " X %XMSGV G POZ FIND S %TO="F8" G END COR S %TO="F7" G END SAVE S %TO="F9" G END ADDL S %TO="F5" D ADDL^%L1ZMSL G END DELL S %TO="F6" G END SHIFT I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=2,%NMB=9 G SHIFT1 I $G(%L1NMB("ALB"))=2 S %L1NMB("ALB")=1,%HBRY="",%NMB=9 G SHIFT1 I $G(%L1NMB("ALB"))=1 K %L1NMB("ALB") S %NMB=5 G SHIFT1 SHIFT1 D PUT^%L1ZMS,PC S %XX=%X0,%YY=%Y0 G POZ ; W(%I) W $S($D(%HBRY):$TR($TR(%M(%I),%TES1,%TES2),%TEN,%THB),1:%M(%I)) Q ABC(SMB) ; I SMB>31&(SMB<123) Q 1 I SMB>127&(SMB<155) Q 1 Q 0 %L1WND %L1WND(WND) ; [ 28.04.00 6:09 PM ] [ 11/06/99 2:54 PM ] [ C WND O WND:(0::::::::::256*23+80:256*23+80:257) COM S $ZT="ZG "_$ZL_":ER^%L1WND" I WND'=1 F U WND W !,$I,">> " R A Q:A="." W ! X A Q ER W !,$ZS H 2 G COM %L1WP %L1WP ; WORD PROCESSOR [ 07.02.06 08:44 ] [ 13.01.06 11:19 ] [ 04.12.05 15:21 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) K D ^%L1C S GL="^SC" ; S TS=$C(68) F J=69:1:94 S TS=TS_$C(J) S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) ; S TS1=$C(160) F J=161:1:186 S TS1=TS1_$C(J) S TSS=$C(128) F J=129:1:154 S TSS=TSS_$C(J) S MM(1)=" d ` i v i " S MM(2)="ycg jnqn" S MM(3)="miiw jnqn" S MM(4)="jnqn zqtcd / zbvd" S MM(5)="DOS-l dwzrd" S MM(6)="DOS-n xefgy" S MM(7)="miknqn lehia" S MAC="MM" D ^%L2MENU Q:%I=1 D @("M"_%I) G %L1WP Q ; M2 ; N HADASH S HADASH="" G M3 ; READ K U,R,L,Y1,X1,U1,SAVE S %RMAX=79,%PRHBR=1,RL=79 ;;S TXT=$S(%TYPCRT["VT":" CTRL+? - dxfr ",1:" CTRL+F1 - dxfr ") I '%ENGLISH D ^%S2ERG1 I %ENGLISH D ^%S2ERG K %Q S %Q("Z")="xenyl",%Q("Y")=23,%Q("X")=10 D ^%S2ASK Q:'YES I $G(SHEM)="" S SHEM=$P($G(@GL@(KOD)),"\") S SAVE="" D ZK K SAVE D MAS K @GL@(KOD) F I=1:1 Q:'$D(^S000($P,I)) S @GL@(KOD,I)=^S000($P,I),@GL@(KOD,I,"%TOP")=$G(^S000($P,I,"%TOP")) N N,I S N="",I=0 F S N=$O(MAS(N)) Q:N="" S I=I+1,@GL@(KOD,"MAS",N)=$G(%MBS("O",I)) S @GL@(KOD)=SHEM_"\"_$H Q ; MAS K MAS N I,N,%MBS I $D(MSGVIEW) D Q .K MAS .S N="" F S N=$O(@GL@(KOD,"OTB",N)) Q:N="" S MAS(N)=$G(^(N)) ; F I=1:1 Q:'$D(@GL@(KOD,I)) D .S A=$G(^(I)) F J=1:1:$L(A) I $E(A,J)="&",$E(A,J+1)?1N D ..S MAS(+$TR($E(A,J+1,J+2)," ",""))="" K %MBS S N="",I=0 F S N=$O(MAS(N)) Q:N="" D .S I=I+1 .I $D(HZG) D ..S %MBS("Z",I)=" "_$G(@GL@(KOD,"MAS",N),N_" oezp")_" cilwdl `p" ..S %MBS("O",I)=$G(@GL@(KOD,"OTB",N)) .I '$D(HZG) S %MBS("Z",I)=" "_N_" oezp cilwdl `p",%MBS("O",I)=$G(@GL@(KOD,"MAS",N)) .S %MBS("RGS",I)="H" S %MBS("DZ")=20 D ^%S3BST S N="",I=0 F S N=$O(MAS(N)) Q:N="" S I=I+1,MAS(N)=$G(%MBS("O",I)) D .I $D(HZG) S @GL@(KOD,"OTB",N)=MAS(N) Q ; M3 ; K HZG D ZK Q:%S=""!($G(%TO)="END") I $D(@GL@(KOD,"VIEW")) S %GET=" . cala dbvdl dfd uaew " D N^%L1GET Q D RSC G READ ; M4 D KAT Q:FLAG'="" N HZG M40 S SHEM=$P($G(@GL@(KOD)),"\") ;;K SHEM S %GET="jnqn my++20,40,HH,,R#"_$G(@GL@(KOD))_"++30,H,I" D ^%L1GET Q:$G(%TO)="END" S (SHEM,@GL@(KOD))=%S S HZG="" D MAS I $D(MSGVIEW) S USTR=0,GWUL=20,KAMA=0 G KAMA M41 S %GETIN="",%GET=" 3 - zqtcn , 0 - jqn " D N^%L1GET Q:$G(%TO)="END" S:%S="" %S=0 I '%S X %chista S USTR=%S I USTR S %DEV="USTR" D ^%L1LPT Q:%EROP I $$^%L1DISP(USTR) S %GET=" : miwzrd dnk " S %GETIN=1 D N^%L1GET K %GETIN G:$G(%TO)="END"!(%S="") M41 S KAMA=%S U USTR S GWUL=$S(USTR:57,1:20) KAMA ; S NL=1 D KOT S ENDH=0 S I1=1 MET4 S J=0 K ^sc($P) F I=I1:1 Q:'$D(@GL@(KOD,I)) S J=J+1,^sc($P,KOD,J)=$TR(@GL@(KOD,I),TSS,TS0) Q:'(I+1#GWUL) S %L2("GLOB")="^sc($P)" S %L2("!")="",%L2("$")=$C(255) S %L2("U")=USTR,%L2("COD")=KOD,%L2BEG=1 I USTR'=0,USTR'=$P,USTR<51 S USTR=3 S %L1SCPC(1)="" D ^%L2SHAP S I1=I+1 ;;F I=I1:1 Q:'$D(@GL@(KOD,I)) W !,^(I) I '(I+1#GWUL) D PER Q:ENDH D KOT I $D(@GL@(KOD,I)) D PER D:'ENDH KOT G MET4:'ENDH,SOF I $G(KAMA)>0 S KAMA=KAMA-1 I KAMA W # G KAMA SOF I '$$^%L1DISP(USTR) D CLOSE^%L1LPT K ^sc($P) U 0 S %GET=" . dniizqd dbvd#1" D N^%L1GET Q KOT ; I '$D(TS0)!'$D(TSS) D ^%L1TS I $$^%L1DISP(USTR) X %chista N TSS S TSS=TS0 W:$$^%L1DISP(USTR) %CLI W:NL>1 NL I '$$^%L1DISP(USTR) W $TR(" sc",TS0,TSS),! I $$^%L1DISP(USTR) X %XCL W " sc" Q PER S NL=NL+1 I '$$^%L1DISP(USTR) W # Q R !," <.> - dbvd miiql , - jiyndl ",*Y I "u.?/"[$C(Y),Y'=13 S ENDH=1 Q X %chista Q ; M5 X %chista D KAT Q:FLAG'="" S %GET="99 - bivdl" D N^%L1GET I %S=99 D M41 S %GET="(dixtiq llek) DOS-a uaew my++20,70,HH,,R#++20,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S SHEMD=%S I %S="?" D O13^%L1OS G M5 I $$^%L1ZOS(10,SHEMD)>0 K %Q S %Q("Z")="xy`l . miiw uaew",%Q("Y")=10,%Q("X")=10 D ^%S2ASK G:'YES M5 O SHEMD:(WRITE:NEWVERSION) I $ZC'=0 D OE G M5 I '$D(TS0)!'$D(TSS) D ^%L1TS U SHEMD F %I=1:1 Q:'$D(@GL@(KOD,%I)) W $TR(^(%I),TS0,TSS),! C SHEMD Q ; M6 ; S %GET="(dixtiq llek) DOS-a uaew my++20,70,HH,,R#++20,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S SHEMD=%S I %S="?" D O13^%L1OS G M6 I $$^%L1ZOS(10,SHEMD)>0 S %SAY=" miiw `l uaew " X %XMSGV(1) G M6 D ZK Q:$G(KOD)=""!'$D(SHEM) O SHEMD:(REWIND:READONLY) I $ZC'=0 D OE G M6 U SHEMD F %I=1:1 R A Q:$ZC'=0 S @GL@(KOD,%I)=$TR(A,TSS,TS0) I AIN S @GL@(KOD,%I)=$$AAA(@GL@(KOD,%I)) I $ZC>0 D TE G M6 C SHEMD Q ; M7 X %chista D KAT Q:FLAG'="" S %GET="99 - "_KOD_" jnqn lehia xey`l" D N^%L1GET G:%S'=99 M7 K @GL@(KOD) G M7 ; M8 ; -- E-MAIL ;;S AIN=1 D M6 K AIN ;; EINSHTEIN N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S MRK=+$$^%L1MRK("") S MAC="^MSGSEND("_MRK_")" X %chista S %L1("EU")=2 S %L1("BE")=6 S %L1("REV")="" S %L1("T1")=" jix`z | drced xe`z | drced cew" S %L1("TXT1")="$$^%L1DC($P(%NXS,""\"",2),1)\/$P(%NXS,""\"")\/%NXN" S %L1("DO")="S KOD=INDEX,MSGVIEW="""",GL=""^[^UCI(""MGG"")]MSGSEND(MRK)"" D M40^%L1WP" S %L1("DO","MRK")=MRK D ^%L1NU Q ; KAT ; K %L1 S MAC=GL S %L1("BE")=6,%L1("EU")=1 S %L1("TXT1")="$$^%L1DC($P(%NXS,""\"",2),1)<>10\/$P(%NXS,""\"",1)<>30\/%NXN<>10" S %L1("REV")="" D ^%L1NU Q:FLAG'="" S KOD=INDEX,SHEM=$G(@MAC) Q RSC K ^S000($P) F I=1:1 Q:'$D(@GL@(KOD,I)) D:'+$G(@GL@(KOD,I,"%TOP")) S ^S000($P,I)=@GL@(KOD,I),^S000($P,I,"%TOP")=$G(@GL@(KOD,I,"%TOP")) .S SS=@GL@(KOD,I) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S @GL@(KOD,I,"%TOP")=II-($E(SS,II)'=" ") Q TE W *7,!,"TRANSFER ERROR $ZC=",$ZC Q OE W *7,"*** OPEN ERROR ! $ZC=",$ZC Q ZK X %chista S %GET="jnqn cew++20,70,HH,,R#"_$G(KOD)_"++8,E,I" D ^%L1GET S KOD=%S I KOD="*"!($G(%TO)="F7") D KAT G ZK Q:%S=""!($G(%TO)="END") I KOD?.P S %SAY=" d ` i b y " X %XMSGV W *7 H 2 G ZK I $D(HADASH),$D(SAVE),$D(@GL@(KOD)) S %SAY=" ! miiw jnqn " X %XMSGV W *7 H 2 G ZK S KOD=%S I '$D(SAVE)!($G(SHEM)="") S SHEM=$P($G(@GL@(KOD)),"\") S %GET="jnqn my++20,40,HH,,R#"_SHEM_"++30,H,I" D ^%L1GET S SHEM=%S Q AAA(IN) ; N ENG,TIP,TIPS,EE,SYM,KOD S (OUT,ENG)="",TIP="H" Q:IN="" OUT F EE=1:1:$L(IN) S SYM=$E(IN,EE),KOD=$A(SYM) D .I KOD<32!(KOD>154) Q ; SPEC SIMB .I KOD<48!(KOD>57&(KOD<65))!(KOD>90&(KOD<96))!(KOD>122&(KOD<128)) S TIPS="P" .I KOD>47&(KOD<58)!(KOD>64&(KOD<91)) S TIPS="E" .I KOD=32!(KOD>95&(KOD<123))!(KOD>127&(KOD<155)) S TIPS="H" .;I KOD<48!(KOD>57&(KOD<65))!(KOD>90&(KOD<123)) S OUT=SYM_ENG_OUT S ENG="" .S TIP=$S(TIPS="P":TIP,1:TIPS) .I TIP="H" S OUT=SYM_ENG_OUT S ENG="" .E S ENG=ENG_SYM S OUT=ENG_OUT Q OUT %L1X %L1X ; [ 20.07.26 06:40 ] [ 28.03.26 05:28 ] [ 03.03.26 14:39 ] N (MCOM,I000,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%Z,%S2ERG,SYSMAN,%W1JSP) I $P'["/vc/2" K ^zcmd($P) ;;D ^%L1DEFWS D ^%L1C I $ZDIR'="/opt/appsrv/envs/corp/app/mumps/",$G(^W4RLD)=""!($$DIF^%L1TIME($H,$G(^W4RLD))>1200) D ^W4RLD ;;S ^%TYPCRT(%L3MYDVN)="VT510",^%CVET(%L3MYDVN)=1 D ^%L1C K %HBRY S %FLENG="" W %ENG x %chista ;;U 0 W *7 W !," IT'S OLD SYSTEM !" H 1 XX ;S $ZT="U $P ZP @$ZPOS W !! ZSHOW ""S"" B ZG "_$ZL_":ER^%L1X" S GLD=$$^%L1GLD S $ZT="S zr=$R X ^ZT ZG "_$ZL_":XX^%L1X" I '$D(%POSIC)!('$D(%OPT)) D ^%L1C S (%PDS,%PDS1)=$P($$FUNC^%UCASE($P($zg,"/",$L($zg,"/"))),".")_" "_$$^%L1MRK_" "_$P($p,"/dev/",2)_" <"_%L3MYDVN_">>" I $D(^%L1X($P_">")) D .S (%PDS,%PDS1)=($zg_" "_$P($p,"/",3,6)_">>") I %CVET S %PDS=%LIGHT1_%CV("CF")_%PDS_%CCL U $p W !,%PDS S %S="" S %ECHO="" VC W $C(27,91),"?25h" ; CURSOR VISIBLE S:$Y>23 $Y=23 U $p:(NOWRAP:NOECHO:NOESC) W *13,%PDS,%chists K %L1NMB ;;I $E(%TYPCRT,1,3)="VT5" W $C(27)," F" K %L1GET S %BE="E",%FLINS=1 K %INV,CIST S %TO="" S:'$D(%L1XLN) %LS=79-$L(%PDS1) W:$D(%L1XLN) !!!,%PDS,! ;;I $E(%TYPCRT,1,3)="VT5" W $C(17) I %TYPCRT["PC",$D(%FLENG) K %HBRY,%GETHB W %ENG K %HBRY,%FHBR D ^%ZMSL:'$D(%L1XLN),^%L1WE:$D(%L1XLN) I %S="",$G(%TO)="" K %L1XLN ;;I %TO="END" S %TO="UP" ; -- 08/03/19 G LL:%TO="UP",RGHT:%TO="DW",SV:%TO="F7",XX:%S="" S COM=%S G:(%S="."!(%S="u")!(%S="/")!(%S="Q")!(%S="q")!(%S="H")!(%S="i")!(%S="I")!(%S="h")!(%S="EXIT")!(%S="exit"))&$D(SYSMAN) END I %S="."!(%S="u")!(%S="/") W ! G END I (%S="Q")!(%S="q")!(%S="H")!(%S="i")!(%S="I")!(%S="h")!(%S="EXIT")!(%S="exit") W !! H I COM="=?" D G:FLAG'="" VC S COM="="_INDEX .N %ECHO S %CLEAR=2 K %L1 S MAC="^%L1X",%L1("EU")=1,%L1("TXT")="S %L1NS(%I)=^(%NXN)_$J("""",8-$L(%NXN))_""<""_%NXN_"">""" D ^%L1NU I COM?1"=".E,$L(COM)>1 S COM=$E(COM,2,255) I $D(^%L1X(COM)) S %S=^%L1X(COM) G VC I COM=">" S ^%L1X($P_">")="" G XX I COM="<" K ^%L1X($P_">") G XX S:'$D(I000) I000=0 F I000=1:1 Q:'$D(MCOM(I000)) S MCOM(I000)=COM XE U $p W ! D XEC G XX ER ; I $ZS["CTRAP" Q I $L($P)<3 G SVER D SVER I $D(^ZT)=11 G ER1 I $D(%NOASKEXIT) X %chista U $p X:$Y>23 %chista W *7,!," *** ERROR: " W $P($ZS,",",2)," ",$P($ZS,",",4) ;;W !,"$R=",$R,! ER1 U $p D:'$D(%chista) ^%L1C R !!,"<>",%A X %chista W !,$ZS,!!?2,$TR($J("",50)," ","-"),!!,$J($TR($TR("!!! zkxrna d`iby",%TES1,%TES2),%TEN,%THB),34),! W %ENG W !,?2,$J($TR($TR("03-5225075 .lh ""cyx""-l dlwzd lr ricedl `p",%TES1,%TES2),%TEN,%THB),45) W !!?2,$TR($J("",50)," ","-"),! S %L1XER="" I $D(%NOASKEXIT) W !!,$J(" PRESS",40) R KUKU H R !!,"EXIT ? (Y/N/V) ",QQ I QQ="Y"!(QQ="y")!(QQ="h")!(QQ="k")!(QQ=".") Q I QQ="V" D W G XX D ^%L1C G XX ; ERWB ; I $ZS["CTRAP" Q I $L($P)<3 G SVER D SVER U $p W !," *** ERROR: " W $P($ZS,",",2)," ",$P($ZS,",",4),! Q ; SVER Q:$ZS["CTRAP" N zp,ZR,PRT S PRT=$P I PRT?.P!(PRT=0) S PRT=0 S zp=$O(^er(+$H,PRT,"")) I +zp=0 S zp=1000 S (^ZE(PRT),^er(+$H,PRT,zp-1))=$P($ZS,",",2)_"~"_$P($ZS,",",3)_"~"_$H_"~"_$J Q ;- XEC N I000,MCOM,%ECHO ;S:COM="i" COM="H" ;I COM="OFF"!(COM="off")!(COM="mkk") S %L1XOFF="" X %chista G EN01 ;I COM="ON" K %L1XOFF G EN01 I COM="CA"!(COM="ca")!(COM="ay") X %chista G EN01 I COM="AW"!(COM="aw")!(COM="y'") D ^%L1DOS("aw","aw") X %chista G EN01 I COM="LN"!(COM="ln")!(COM="jn") S %L1XLN="" G EN01 I COM="KR" K %L1XLN G EN01 ;;I COM="UCI"!(COM="uci")!(COM="eao") W $$^%L1ZU(0) G EN01 I COM="EN"!(COM="wn") K %HBRY W %ENG S %FLENG="" G EN01 I $E(COM,1,3)="HB(" D X "W $$W^%L1C("_%TX_")" G EN01 .S %TX=$E(COM,4,$L(COM)-1) ; I $E(COM,1,3)="HI(" D X "W $$W^%L1C($$INVH^%L1FRM("_%TX_"))" G EN01 .S %TX=$E(COM,4,$L(COM)-1) ; I COM="HB"!(COM="hb") K %FLENG S %HBRY="" W %HBR G EN01 ;I COM="PS"!(COM="ps")!(COM="tc") D ^%PARTSIZE G EN01 I COM="SS"!(COM="ss")!(COM="cc") D ^%L1SS G EN01 I COM?1"R "."%"1a.e!(COM?1"r "."%"1a.e) D R G EN01 I COM?1"E "."%"1a.e!(COM?1"e "."%"1a.e)!(COM="E")!(COM="e")!(COM="R")!(COM="r") D E G EN01 I COM?1"EW "1a.e!(COM?1"ew "1a.e)!(COM="EW")!(COM="ew") D EW G EN01 I COM?1"ED ".e!(COM="ED")!(COM="ed")!(COM?1"ed ".e) D ED G EN01 I COM="FN"!(COM="fn")!(COM="nk") D ^%L1FND G EN01 I (COM?1"VI "."%"1a.e!(COM?1"vi "."%"1a.e)) D G EN01 .zsy "vi "_$E(COM,4,200) I COM?1"E $"!(COM?1"e $")!(COM="E -")!(COM="e -") D E G EN01 I COM?1"E ".E!(COM?1"e ".E) S COM="E" D E G EN01 I COM="EB"!(COM="eb")!(COM="wp") D EB G EN01 I $E(COM)="G"!($E(COM)="g"),$E(COM,2)=" "!($E(COM,2)="") D G G EN01 I COM="GN"!(COM="gn")!(COM="rn") D GN G EN01 I $E(COM,1,2)="GL"!($E(COM,1,2)="rj")!($E(COM,1,2)="gl"),$E(COM,3)=" "!($E(COM,3)="") D GL G EN01 ;I COM="LG"!(COM="jr")!(COM="lg") D ^%LOGON Q ;I COM="RL"!(COM="xj")!(COM="rl") D RL G EN01 I $E(COM)="V"!($E(COM)="v")!($E(COM)="d"),$E(COM,2)?." " D V G EN01 I COM="RR"!(COM="xx")!(COM="rr") D RR G EN01 I COM="RSE"!(COM="xcw")!(COM="rse") D ^%L1RSE G EN01 I COM="RSJ"!(COM="xcg")!(COM="rsj") D JSP^%L1RSE G EN01 I COM="RSA"!(COM="xcy")!(COM="rsa") D ^%L1RSAND G EN01 I COM="GSE"!(COM="rcw")!(COM="gse") D ^%GSE G EN01 I COM="FL"!(COM="fl")!(COM="kj") D ^%L1FL G EN01 I COM="RS"!(COM="xc")!(COM="rs") D RS G EN01 I COM="OS"!(COM="os") D ^%L1OS G EN01 I COM="mc"!(COM="MC") ZSY "mc" G EN01 I COM="RC"!(COM="xa")!(COM="rc") D RC G EN01 I COM="RCJ"!(COM="xag")!(COM="rcj") D RCJ G EN01 I COM="RD"!(COM="xb")!(COM="rd") D RD G EN01 I COM="GR"!(COM="rx")!(COM="gr") D GR G EN01 I COM="GS"!(COM="rc")!(COM="gs") D GS G EN01 I COM="GC"!(COM="ra")!(COM="gs") D GC G EN01 I COM="GD"!(COM="rb")!(COM="gd") D GD G EN01 I COM="GDEL"!(COM="gdel") D ^%L1GDEL G EN01 I COM="HF"!(COM="ik")!(COM="hf") D H G EN01 I COM="RCMP"!(COM="rcmp") D ^%L1RCMP G EN01 I COM="WW"!(COM="''")!(COM="ff") D W G EN01 I COM="SF"!(COM="ck")!(COM="sf") D ^%L1SF G EN01 I COM="CV"!(COM="cv")!(COM="ad") D ^%L1SFCV G EN01 I COM="RM"!(COM="xv")!(COM="rm") D ^%L1RM G EN01 I COM="GM"!(COM="rv")!(COM="gm") D ^%L1GM G EN01 I COM="TG"!(COM="`r")!(COM="tg") D ^%L1TG G EN01 I COM="ER"!(COM="wx")!(COM="er") D ^%L1ER G EN01 I COM="ED"!(COM="wb")!(COM="ed") D ^%L1MSGED G EN01 I COM="MS"!(COM="ms")!(COM="vc") D ^%L1MSG G EN01 I COM="TR"!(COM="tr")!(COM="'x") D ^%L1TRP G EN01 I COM="VB"!(COM="vb")!(COM="dp") D ^%S2VDB G EN01 I COM="XM"!(COM="xm")!(COM="qv") D ^%L1TS,^%L1XM G EN01 I COM="TB"!(COM="tb")!(COM="`p") D ^P1TBLAK G EN01 I COM="TRG"!(COM="trg")!(COM="'xr") D G EN01 .N %L1TRG S %L1TRG="" D ^%L1TRP I COM="TCH"!(COM="tch")!(COM="`ai") D ^%L1TSTCH G EN01 I COM="SP"!(COM="sp")!(COM="cti") D ^%FREECNT G EN01 I COM="SRV"!(COM="srv") D ^%L2SRV G EN01 I COM="NC"!(COM="nc")!(COM="na") D ^%L1DOS("nc","nc") G EN01 I COM="DOS"!(COM="dos")!(COM="bmc") G:$$TERMINAL^%HOSTCMD("dosemu -k") EN01 G EN01 I COM="tomstop"!(COM="TOMSTOP") G:$$TERMINAL^%HOSTCMD("tomstop") EN01 G EN01 I COM="tomstart"!(COM="TOMSTART") G:$$TERMINAL^%HOSTCMD("tomstart") EN01 G EN01 ;I COM="ASH"!(COM="ash")!(COM="yci") G:$$TERMINAL^%HOSTCMD("ASH") EN01 G EN01 I $E(COM)="!" ZSY $E(COM,2,255) G EN01 I COM=77 D ^%S277 G EN01 I COM=88 D ^%S288 G EN01 I COM="?" D G EN01 .W !,"********************************************",! .W !,"LG - D ^%LOGON" .W !,"R - ROUTINES FULL SCREEN EDITOR" .W !,"RS - D ^%RS" .W !,"RR - D ^%RR" .W !,"V - ROUTINE'S VIEW" .W !,"RD - D ^%RD" .W !,"RC - D ^%L1RCE" .W !,"FL - D ^%FL" .W !,"G - GLOBALS FULL SCREEN EDITOR" .W !,"GS - D ^%GS" .W !,"GR - D ^%GR" .W !,"GL - GLOBAL'S LIST ( ISN'T %GL)" .W !,"HF - HFS-FILE'S FULL SCREEN EDITOR" .W !,"WW - VARIABLE'S LIST" .W !,"OS - D ^%OS" .W !,"SS - D ^%SS" .W !,"EN - ENGLISH" .W !,"HB - HEBREW" .W !,"CA - CLEAR SCREEN" .W !,"TR - SEND PROGRAMM UPDATE" .W !,"!... - DOS COMMAND" I COM'[" ",COM'="H",COM'="h",COM'="W",COM'="w",COM'="ZW",COM'="zw",COM'="K",COM'="k" D G EN01 .N %FLENG .;;I $D(%HBRY),%TYPCRT["PC" S COM=$TR(COM,%THB,%TEN1) .D @("^"_$TR(COM,%TSMALL,%TBIG)) G EN01 I $E(COM)="/"!($E(COM)=".")!($E(COM)="u"),$L(COM)>1 D G EN01 .S COM=$P($E(COM,2,255)," ") .N %FLENG,%HBRY .I $T(@COM)="" D @("^"_COM) Q .D @COM D .N SYSMAN,%FLENG X COM EN01 ; Q END I $D(^ZE($P,"%ERG")),$D(%L1XER),$ZV["2.0" D ^%L1C S %TIP=^ZE($P,"%ERG") G 241^%S2ERG N PORTN S PORTN=$$PORT^%L2MOUSE I PORTN C PORTN D CLOSE^%L1MDLCK(PORTN) Q LL ;S I000=I000-1 I I000<1 U 0 W *7," *** BEGIN " S I000=0 G XX I '$D(I000) S I000=$O(MCOM(99999),-1) I I000>0 S %S=MCOM(I000) S I000=I000-1 I I000<0 U $p W *7," *** BEGIN " S I000=0 G XX G VC RGHT S I000=I000+1 I '$D(MCOM(I000)) U $p W *7," *** END" S I000=I000-1 S:I000<1 I000=0 G XX R1 S %S=MCOM(I000) G VC R S %NAM=$tr($P(COM," ",2),"%","_") ZED %NAM ZLINK $P(%NAM,".") Q E I $D(%S2ERG) W *7 S %SAY="YOU ARE INTO EDITOR ALREADY" X %XMSGV W *7 Q N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,COM,%Z) D ^%L1C S %NAM=$P(COM," ",2) K U,L,R D ^%L1ED Q EB I $D(%S2ERG) W *7 S %SAY="YOU ARE INTO EDITOR ALREADY" X %XMSGV W *7 Q N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,COM,%Z) D ^%L1C D POISK^%L1ER($P($ZS,",",2)) Q EW I $D(%S2ERG) W *7 S %SAY="YOU ARE INTO EDITOR ALREADY" X %XMSGV W *7 Q N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,COM,%Z) D ^%L1C S %NAM=$P(COM," ",2) K U,L,R EWZ I %NAM="" R !!,"JSP FILE NAME : ",%NAM I %NAM="" Q I %NAM'["." S %NAM=$$FUNC^%LCASE(%NAM)_".jsp" D ED^%W1JSP(%NAM) Q ; ED I $D(%S2ERG) W *7 S %SAY="YOU ARE INTO EDITOR ALREADY" X %XMSGV W *7 Q N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,COM,%Z) D ^%L1C S %NAM=$P(COM," ",2) K U,L,R EDZ I %NAM="" R !!,"LINUX FILE NAME : ",%NAM I %NAM="" Q D ED^%W1ED(%NAM) Q ; V S %NAM=$P(COM," ",2) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%NAM,%Z,%HBRY,%W1JSP) D ^%L1C I %NAM'="" S %RNAME=%NAM N %NAM D M1^%L1RV Q ; ----- VIEW PROG D ^%L1RV Q G D B^%S3GLKR Q N %s1gedv D ^%S1GED Q GN S %S3G=-1 D B^%S3GLKR Q GL S %S1GL("MAC")=$P(COM," ",2) D ^%S1GL Q RL D ^%L1RL Q RS N %FORMAT D FORMAT I %FORMAT="" Q I %FORMAT=1 D ^%L1RSDOS Q D ^%L1RS Q RR N %FORMAT D FORMAT I %FORMAT="" Q I %FORMAT=1 D ^%L1RI Q D ^%L2RI Q RD D ^%L1RM Q RC D ^%L1RCE Q RCJ N %JSP D JSPDIR^%L1RSE G RC GS D ^%L1GS Q GR N %FORMAT U $P:(ECHO) W !?10,"GLOBAL RESTORING" D ^%L1GI Q ; D FORMAT Q:%FORMAT="" I %FORMAT=1 D ^%L1GI Q D ^%GI Q GC D ^%S1GC Q GD D ^%GD Q H D ^%L1HFS Q W D ^%L1OW Q SV D .N COM,COD S COM=%S N %S W !!!!,"COD: " S %S="" D ^%ZMSL Q:%S=""!($G(%TO)="END") .S COD=%S S ^%L1X(COD)=COM G VC FORMAT ; F R !!,"MSM-FORMAT - 1, GTM-FORMAT - 2 : ",%FORMAT Q:%FORMAT=1!(%FORMAT=2)!(%FORMAT="") W *7," ???" Q %L1XM %L1XM ;RTM;MSM CPU<->CPU TRANSMIT; [ 14.07.06 09:54 ] [ 31.01.06 20:24 ] [ 23.11.05 10:13 ] ; COPYRIGHT MICRONETICS DESIGN CORP. @1985 ; If you need to send $C(1) or $C(2) through as data, ; pick another character and change the line INIT+1. ; %HT = wait time for READs (0 or 1) ; %DT = # of READs from IO device since last terminal read ; %DC = # iterations thru fast loop with no data received ; %RS = 1 if recording, 0 if not S %INT=0 K %MSM N GLD ; $D(%MSM) flag for calling from %TRANS N $ZT S $ZT="ZG "_$ZL_":ERROR^%L1XM" N %HB,%PRHB D ^%L1TS S GLD=$$^%L1GLD GO S %HT=0,%DT=0,%DC=0,%RS=0,FLSTART=1,%HB=0 G:%INT INIT u $p W !?10,$P($P($ZV,","),"-")," - Transmission Utility" S %IO=$$MDPORT^%L1PORT I %IO S %IO=$G(@$$^W4DEV@(%IO)) I $L(%IO) G ASK1 ASK R !!,"I/O PORT? > ",%IO G:%IO="" EXIT G:%IO?1"^".E EXIT I %IO?1"?".E D QUE G ASK I '$D(^[GLD]dev(%IO)) U 0 W !,"Device ",%IO," is not defined ",*7 G ASK S %IO=^[GLD]dev(%IO) ASK1 U $P I $I=%IO W !!,"Cannot select your own device.",*7 G ASK N $ZT S $ZT="ZG "_$ZL_":NOPEN^%L1XM" U $P:(CENABLE:CTRAP=$C(3)) ; I '$$^%L1MDLCK(%IO) S %GET="A PORT OF MODEM IS BUSY !" D N^%L1GET G EXIT O %IO::0 E W *7,"..line in use..waiting.." O %IO W "ready" S $ZT="ZG "_$ZL_":ERROR^%L1XM" INIT U 0 W ! ;;S %ESC=$ZB($ZA,64,1) ; save escape processing status S %EXIT=$C(1),%RECORD=$C(2),%PRHB=$C(4) ;;V 0:$J:$ZB($V(0,$J,2),#0400,7):2 ; Turn off pass-all, esc processing, & tab control. Set terminators U %IO:(NOECHO:NOWRAP:TERM=$C(3,13)) U $P:(NOECHO:NOWRAP:NOCENABLE:TERM=$C(3,13)) S %ECHO=1 TERM ; U $P S %CR=13 ;;D ^%L1DIAL(^PL("MDXON"),TEL) I $G(TEL) I $G(FLSTART)=1 S %X="AT"_$G(^PL("MDXON"))_"DTW"_TEL_$C(13) K FLSTART S %CR=13 I 1 S %ECHO=0 G TERM10 R *%X0:%HT ;-- WAIT FOR COMMAND FROM KEYBOARD I %X0>31 S %HT=1 I %X0=13 S %HT=0 I %X0=$A(%EXIT) G EXIT I %X0=$A(%PRHB) S %HB=1-%HB ; S %X=$C(%X0),%X2=0 ; TERM10 U %IO W:$L(%X) %X S:$L(%X)!$T %DC=0,%HT=0 S %DT=0 I %X["DT",%X["AT" S %ECHO=0 PORT ; U %IO R %Y:0 G:%INT!(%Y[$C(1)) EXIT ; %INT=1 - FROM ^TRANS I %Y[%PRHB S %HB=1-%HB S %Y1="" I $L(%Y) R %Y1:2 S %Y=%Y_%Y1 U $P W:$L(%Y) $TR(%Y,TS0,$S('$G(%HB):TS0,%XMSG(0)<0:TSS,1:TS1)) W:$T $C(%CR) W:%Y="+++" ! I %Y="NO CARRIER"!(%Y="+++") S %ECHO=1 S:$L(%Y)!$T %DC=0,%HT=0,%DT=%DT+1 G TERM EXIT ; D:%RS HALT ;;I $D(%ESC),%ESC U 0:(::::64) K %ESC,%X,%Y,%RS,%XN,%XE,%XS,%DC,%DT,%HT,%CR,%EXIT,%RECORD U $P:(ECHO:TERM=$C(13)) I %INT!$D(%MSM) U $P:(CENABLE:CTRAP=$C(3)) K %INT Q ; return to %TRANS I %IO'="" C %IO D CLOSE^%L1MDLCK(%IO) U 0 K %IO,%INT W:'$F($ZS,"DSCON") !,"Transmission Complete",!! Q RECORD ; S:'$D(^XMIT) ^XMIT(0)=1 S %XN=^XMIT(0),^XMIT(0)=%XN+1,%RS=1 S %XS="",%XE=1,%X=$E(%X,2,999),^XMIT(%XN)=$H U 0 W !!,"Recording Started in ^XMIT(",%XN,",1)",! Q HALT ; S:$L(%XS) ^XMIT(%XN,%XE)=%XS S %RS=0 U 0 W !!,"Recording halted, last node is ^XMIT(",%XN,",",%XE,")",!! Q NOPEN S %IO="" ; avoid on ERROR ; ;;I $F($ZS,"MXSTR") F %XE=%XE:1 G:%XS="" ERROR1 S ^XMIT(%XN,%XE)=$E(%XS,1,255),%XS=$E(%XS,256,9999) I $F($ZS,"CTRAP") U 0 W !!,"...Aborted." D EXIT Q I $F($ZS,"DSCON") DO:$I'=$P D EXIT .U 0 W !!,"...Disconnected." U $P W !,$ZS D EXIT Q ERROR1 S $ZT="ZG "_$ZL_":ERROR^%L1XM" Q ; resume after ; INT ;FROM TRANSFER UTILS S %INT=1 U $P:(NOCENABLE) G GO ; QUE W !! F %IO=1:1 S %X=$T(TEXT+%IO) Q:%X="" W $P(%X,";",2),! Q TEXT ; ;Enter the port number to be used for the transmission. ;While the transmission is in progress, all characters except CTRL/A ;and CTRL/B will be passed through to the port. ;Use CTRL/B to start or stop recording of the information in the XMIT ;global, and CTRL/A to exit the program. %L1XMIT %L1XMIT ;RTM;MSM CPU<->CPU TRANSMIT; [ 14.07.06 11:25 ] [ 13.07.06 14:19 ] [ 11.02.01 10:23 AM ] ; COPYRIGHT MICRONETICS DESIGN CORP. @1985 ; If you need to send $C(1) or $C(2) through as data, ; pick another character and change the line INIT+1. ; %HT = wait time for READs (0 or 1) ; %DT = # of READs from IO device since last terminal read ; %DC = # iterations thru fast loop with no data received ; %RS = 1 if recording, 0 if not N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %INT=0 K %MSM ; $D(%MSM) flag for calling from %TRANS S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" GO S %HT=0,%DT=0,%DC=0,%RS=0,FLSTART=1 G:%INT INIT u $p W #?10,$P($P($ZV,","),"-")," - Transmission Utility",! W !?10,"CTRL+A - EXIT" ;;I $G(^PL("MDPORT")) S %IO=^("MDPORT") G ASK1 ASK R !!,"I/O PORT? > ",%IO G:%IO="" EXIT G:%IO?1"^".E EXIT I %IO?1"?".E D QUE G ASK I '$D(@$$^W4DEV@(%IO)) U 0 W !,"Device ",%IO," is not defined ",*7 G ASK ASK1 U $P I $I=@$$^W4DEV@(%IO) W !!,"Cannot select your own device.",*7 G ASK S %IO=@$$^W4DEV@(%IO) S $ZT="ZG "_$ZL_":NOPEN^%L1XMIT" U $P:(CENABLE) O %IO::12 E U 0 W "..line in use " C %IO G ASK S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" I '$$^%L1MDLCK(%IO) S %GETIN=0,%GET="A PORT OF MODEM IS BUSY ! OPEN IT - 1, EXIT - 0" D N^%L1GET G:'%S ASK D I '$$^%L1MDLCK(%IO) U 0 W !," MODEM IS BUSY ! " G EXIT .D DELLOCK^%L2MOUSE(%IO) .U 0 W #!!,"I/O PORT > "_$G(@$$^W4DEVI@(%IO)),! S %FRST=1 U %IO INIT U 0 W ! ; S %EXIT=$C(1),%RECORD=$C(2) ; Turn off pass-all, esc processing, & tab control. Set terminators U %IO:(NOECHO:NOWRAP:TERM=$C(3,13)) U $P:(NOECHO:NOWRAP:NOCENABLE:TERM=$C(3,13)) TERM ; U $P I $G(TEL) I $G(FLSTART)=1 S %X="AT"_$G(^PL("MDXON"))_"DTW"_TEL K FLSTART S %CR=13 I 1 G TERM10 I $G(%FRST) S %FRST=0,%X="AT" G TERM1 R %X:%HT ;-- WAIT FOR COMMAND FROM KEYBOARD TERM1 S %CR=13 TERM10 G:$E(%X)=%EXIT EXIT D:$E(%X)=%RECORD .D @$S(%RS:"HALT",1:"RECORD") S %X=$E(%X,2,$L(%X)) Q ; U %IO W:$L(%X) %X W:$T $C(%CR) S:$L(%X)!$T %DC=0,%HT=0 S %DT=0 PORT ; U %IO R %Y:%HT G:%INT&(%Y[$C(1)) EXIT ; %INT=1 - FROM ^TRANS S %CR=13 U $P W:$L(%Y) %Y W:$T $C(%CR) S:$L(%Y)!$T %DC=0,%HT=0,%DT=%DT+1 S:$L(%Y)&%RS %XS=%XS_%Y ;-- FOR RECORD I $T,%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1 K:%XS["OK" FLSTART S %XS="" PORT1 I %DT>20 G TERM ; heavy incoming data, force check of CRT G TERM:$L(%X),PORT:$L(%Y) S %DC=%DC+1 G:%DC<500 TERM S %HT=1 ; READ timeout 1, goto slow mode TERMWAIT ; TERMWAIT and PORTWAIT handle periods in which no data has been ; received from either side for %DC iterations through the ; TERM & PORT loop. U $P R %X#1:%HT E G PORTWAIT G:%X=%EXIT EXIT I %X=%RECORD D @$S(%RS:"HALT",1:"RECORD") S (%DC,%DT,%HT)=0 G TERM S %CR=13 TW1 U %IO W %X W:'$L(%X) $C(%CR) S (%DC,%DT,%HT)=0 G TERM ; PORTWAIT ; U %IO R %Y#1:%HT E G TERMWAIT G:%INT&(%Y[%EXIT) EXIT ; %TRANS rtn or gbl selection finished S %CR=13 U $P W %Y W:'$L(%Y) $C(%CR) S (%DC,%DT,%HT)=0 ; If recording... S:$L(%Y)&%RS %XS=%XS_%Y ; add to captured string ; or terminate & file captured string I '$L(%Y),%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1,%XS="" G PORT ; EXIT ; D:%RS HALT ;;I $D(%ESC),%ESC U 0:(::::64) K %ESC,%X,%Y,%RS,%XN,%XE,%XS,%DC,%DT,%HT,%CR,%EXIT,%RECORD ;;U:(%IO?.N)&(%IO'="") %IO:(:::::#001001:::$C(13,27)) U $P:(ECHO:TERM=$C(13,27)) I %INT!$D(%MSM) U $P:(CENABLE) K %INT Q ; return to %TRANS I %IO'="" C %IO D CLOSE^%L1MDLCK(%IO) U 0 K %IO,%INT W:'$F($ZS,"DSCON") !,"Transmission Complete",!! Q RECORD ; S:'$D(^XMIT) ^XMIT(0)=1 S %XN=^XMIT(0),^XMIT(0)=%XN+1,%RS=1 S %XS="",%XE=1,%X=$E(%X,2,999),^XMIT(%XN)=$H U 0 W !!,"Recording Started in ^XMIT(",%XN,",1)",! Q HALT ; S:$L(%XS) ^XMIT(%XN,%XE)=%XS S %RS=0 U 0 W !!,"Recording halted, last node is ^XMIT(",%XN,",",%XE,")",!! Q NOPEN S %IO="" ; avoid on ERROR ; ;;I $F($ZS,"MXSTR") F %XE=%XE:1 G:%XS="" ERROR1 S ^XMIT(%XN,%XE)=$E(%XS,1,255),%XS=$E(%XS,256,9999) ;;I $F($ZS,"INRPT") U 0 W !!,"...Aborted." D EXIT ;;I $F($ZS,"DSCON") DO:$I'=$P D EXIT .U 0 W !!,"...Disconnected." U $P W !,$ZS D EXIT Q ERROR1 S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" G PORT1 ; resume after INT ;FROM TRANSFER UTILS S %INT=1 U $P:(NOCENABLE) G GO ; QUE W !! F %IO=1:1 S %X=$T(TEXT+%IO) Q:%X="" W $P(%X,";",2),! Q TEXT ; ;Enter the port number to be used for the transmission. ;While the transmission is in progress, all characters except CTRL/A ;and CTRL/B will be passed through to the port. ;Use CTRL/B to start or stop recording of the information in the XMIT ;global, and CTRL/A to exit the program. %L1YN %L1YN(%V) ; [ 12/28/99 10:57 AM ] [ 02/17/98 2:08 PM ] [ 10/17/97 9:37 AM ] N %A S %A=$G(@%V) I "kFYh"[%A,$L(%A) S @%V=$S(%ENGLISH:"Y",1:"k") Q 1 I "lKNn"[%A,$L(%A) S @%V=$S(%ENGLISH:"N",1:"l") Q 0 Q -1 %L1YNT %L1YNT ; [ 24.06.04 10:56 ] [ 18.02.04 13:17 ] [ 10.02.04 08:40 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%GET,%TO) D ^%L1C D SAVE^%L3MBGG X %LIGHT N XX1,XX2,YY1,YY2 S XX1=20,YY1=18,XX2=XX1+40 I $D(%GET("ISY")) S YY1=%GET("ISY") S YY2=YY1+5 S %L1RBCL=%CV("MB") N TXT S TXT="? x y ` l" I $D(%GET("IS")) S TXT=%GET("IS") ; $E(%GET("IS"),1,XX2-XX1-1) I TXT'["?" S TXT="? "_TXT I $L(TXT)>(XX2-XX1-2) S YY2=YY2+1 D TV^%L1RBUA(YY1,XX1,YY2,XX2) I $L(TXT)>(XX2-XX1-2) D G MT .X %LIGHT N %DLG,%FRAZA S %FRAZA=TXT N TXT .S %DLG=XX2-XX1-2 D DELG^%L1SCPC .S TXT=%CHAST(1,1) N XXH S XXH=(XX2-1-(XX2-XX1-$L(TXT)\2)) .S %SAY=TXT_"++"_YY1_","_XXH_",HH++MB,YF" X %XMSG .S TXT=%CHAST(1,2) X %LIGHT .I $E(%CHAST(1,1),$L(%CHAST(1,1)))=" " S TXT=$E(TXT,2,255)_" " .S %SAY=TXT_"++"_(YY1+1)_","_XXH_",HH++MB,YF" X %XMSG X %LIGHT S %SAY=TXT_"++"_YY1_","_(XX2-1-(XX2-XX1-$L(TXT)\2))_",HH++MB,YF" X %XMSG MT N MTXT,Y0,Y2,X0,X2,SH,COLX,COLY S MTXT("B")=%CV("MB") S MTXT(1,1)=" `l " S MTXT(1,1,"TO")="F1" S MTXT(1,2)=" ok " S MTXT(1,2,"TO")="F2" I $G(%GET("DEF")) S MTXT(1,%GET("DEF"),"DEF")="" E S MTXT(1,2,"DEF")="" S Y0=YY1+2+($L(TXT)>(XX2-XX1-2)),Y2=YY2-1,X0=XX1+2,X2=XX2-2 S COLX=$O(MTXT(1,20),-1),COLY=1,SH=1 S STEPX=XX2-XX1-4\2,STEPY=2,%PREV="" D TV^P1RBUA S %S="" D REST^%L3MBGG Q %L1ZB %L1ZB(%S1,%S2,%MS) ; [ 20.09.05 16:38 ] [ 12.10.03 11:30 ] [ N %S12,%S22,%R,%Q,%A,%B,%J I %S1="" Q "" I %S2="" Q %S1 S %S12=$$102^%L12(%S1) S %S22=$$102^%L12(%S2),%S220=%S22 ;SR I $L(%S22)<$L(%S12) S %S22=%S22_%S220 ;I $L(%S22)<$L(%S12) G SR I $L(%S22)<$L(%S12) S %S22=$TR($J("",$L(%S12)-$L(%S22))," ",0)_%S22 I $L(%S12)<$L(%S22) S %S12=$TR($J("",$L(%S22)-$L(%S12))," ",0)_%S12 ; ;S %S22=$E(%S22,1,$L(%S12)) ;S %S22=$TR($J(%S22,$L(%S12))," ",0) S %Q="" F %J=1:1:$L(%S12) D S %Q=%Q_%R .S %A=$E(%S12,%J) .S %B=$E(%S22,%J) .I %MS=1 S %R=$S(%A&%B:1,1:0) Q .I %MS=2 S %R=$S(%A&'%B:1,1:0) Q .I %MS=3 S %R=$S(%A:1,1:0) Q .I %MS=4 S %R=$S('%A&%B:1,1:0) Q .I %MS=5 S %R=$S(%B:1,1:0) Q .I %MS=6 S %R=$S(%A'=%B:1,1:0) Q .I %MS=7 S %R=$S(%A!%B:1,1:0) Q .I %MS=8 S %R=$S('%A&'%B:1,1:0) .I %MS=9 S %R=$S(%A=%B:1,1:0) .I %MS=10 S %R=$S('%B:1,1:0) .I %MS=11 S %R=$S('%A&'%B!%A:1,1:0) .I %MS=12 S %R=$S('%A:1,1:0) .I %MS=13 S %R=$S('%A!(%A&%B):1,1:0) .I %MS=14 S %R=$S(%A'=%B!('%A&'%B):1,1:0) .I %MS=15 S %R=1 Q $$210^%L12(%Q) %L1ZCRC %L1ZCRC(%STR,%PR) ; [ 10.04.08 12:45 ] [ N %R,%I,%J,%B,%X1,%K,%SUM S %SUM=0 S %R=$ZBITSTR(8,0) F %I=1:1:$L(%STR) S %R=$ZBITXOR(%R,$C(0)_$E(%STR,%I)) S %SUM=%SUM+$A(%STR,%I) I '$G(%PR) Q $A(%R,2) Q (%SUM#512) %L1ZH %L1ZH(%N) ; I %N'?1N.N Q $$FUNC^%HD(%N) Q $$NULL^%L1FRM($$FUNC^%DH(%N)) %L1ZMS %L1ZMS ; HEBREW [ 19.01.24 07:55 ] [ 11.01.24 16:08 ] [ 09.01.24 11:33 ] ; $D(%FLL) --> %C,%C1,%C2 ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" U $P:(NOECHO:NOWRAP) I '$D(%POSIC) D ^%L1C N %I,%J,%J1,%JJ,%XX,%YY,%FIRST,%FIRST1,%L,%A,%WORD,%WORD1,%NUMB,%SS,l1zms,%HBRY,C1,%FHBR,ZB,%SYM,%ZMSLX,%ZMSLY,%PRKB N %XX0,%YY0 S %BEG=1,%L1NMB("ALB")=1 I '$D(%MOUSE) S %MOUSE=$$INIT^%L2MOUSE K %screen I %MOUSE S %BE="E" I '$D(%FLL) N %C,%C1,%C2 S %FHBR=1,%HBRY="" S:'$D(%S) %S="" S %SS=%S S:'$D(%LS) %LS=$X+1 S %TO="" I '$D(%C)#2 K %FLL I $G(%C)=27!($G(%C)=0),'$D(%C1) K %FLL I $L(%S)>%LS,%LS'["/" S %S=$E(%S,$L(%S)-%LS+1,255),%SS=%S I $L(%S)>%LS,%LS["/" S %S=$E(%S,$L(%S)-$P(%LS,"/",2)+1,255),%SS=%S D USE S %XX=$X-%LS+1,%YY=$Y S:%XX<0 %XX=0 S:%YY>24 %YY=24 X %POSIC S %XX0=%XX,%YY0=%YY S %ZMSLX=%XX,%ZMSLY=%YY I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_"?109l" ;-- CAPS LOCK OFF (DECCAPSLK) S %NUMB=0 S:'$D(%FLINS) %FLINS=1 D:%LS'["/"!$D(%L1GET) PC I $D(%L1GET) D KILL Q I $P(%LS,"/",2)>%LS D G 13 ;-- WND .N %X1,%X2,%Y1,%Y2,%L1WH .S %X1=%XX0,%X2=%X1+%LS-1 .S %Y1=%YY0,%Y2=%Y1+($P(%LS,"/",2)-.1\%LS) .I %TYPCRT="PC" D GET^%VIDEO("%l1zms",0,0,80,24,2) .I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;2$v" .N %LS0 S %LS0=%LS N %LS S %LS=$P(%LS0,"/",2) .S %L1WH("=")="" .D ^%L1WH .I %TYPCRT="PC",$D(%l1zms) D PUT^%VIDEO("%l1zms",0,0,80,24,2) Q .I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;2;;;$v" ; S %I=%LS S %FIRST=1,%FIRST1=1,%NMB=12 I $G(%BE)="E",$L(%SS) S %pn=$L(%SS) X %levon S %I=%LS-$L(%SS) I $D(%ZMSL("LB","GL")) D SV CYC ; K %SYM S %L=$L(%S) S %A=$E(%S,%I) G:$D(%PRKB) CYC0 I %MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) D W *27,7 S %C=$$^%L1NMB("") W *27,8 G:%C=""!(%C="ENTER") 13 G:$A(%C)<65!($A(%C)>90)!($L(%C)=1) CYC2 G:$T(@%C)'="" @%C G CYC2 .S %L1NMB("ZY")=%ZMSLY .;;S %NMB=12 D ^%L1MSGBR I $G(%ZMSL("TIME")) D:('%FIRST!'$D(%FLL)) G:$T READ S %TO="TIME",%S="" G 13 .N %JJ F %JJ=1:1:%ZMSL("TIME") D ^%L1MSGBR R *%C:1 Q:$T CYC0 D ^%L1MSGBR S %L=$L(%S) S %A=$E(%S,%I) I 1 R:('%FIRST!'$D(%FLL)) *%C:1 E K %PRKB G CYC S %FIRST=0 I %C'=0,%C'=27 K %FLL READ G:%TYPCRT="PC" BDK S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) BDK I %C=8 G DEL I %C=7 S %TO="DBL" G 13 I %C=5 G MOD ;;S %TO="DEL" G 13 I %C=25 S %TO="END" G 13 I %C=24 W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY D ^%L1CLC S:$D(%L1CLC("F")) %S=$E(%L1CLC,1,%LS) K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY D PC S %I=%LS G CYC I %C=20 G VNIZE ;;,$G(^zms($P))?1"^"."%"1U.E W *27,7 D ^%L1ZMST S $X=%XX,$Y=%YY D PC S %I=%LS G CYC I %C=46,$D(%HBRY),%TYPCRT["PC" S %C=149 I $$ABC(%C) G SYM I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) ;;I %C=27 D DELAY R:('$D(%FLL)!'$D(%C1)) *%C1:%WAIT G:%C1<0 ESC D DELAY R:'$D(%FLL)!'$D(%C2) *%C2:%WAIT K %FLL I %C2>0 S %C=%C1_%C2 I %C=27 D DELAY R:'$D(%FLL) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL) *%C2:%WAIT Q:%C2<0 S:%C2>0 C=%C1_%C2 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *%C3:%WAIT Q:%C3<0 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *%C4:%WAIT S:%C4>0 C=C_%C4 I %C=27 G ESC I %C=0 D DELAY R:('$D(%FLL)!'$D(%C1)) *%C1:%WAIT D DELAY R:('$D(%FLL)!'$D(%C2)) *%C2:%WAIT K %FLL I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<120))!(%C1>129):"0"_%C1,1:60+%C1) G:%C>160 SYM KF K %FLL I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) G CYC CYC2 S %C=$A(%C) G BDK SYM ; S %BEG=0 ; I $G(%ZMSL)[$C(%C) S %TO=$C(%C) G 13 I $D(CIST),CIST="" S %TO=$C(%C) G 13 I $D(CIST),CIST'[$TR($C(%C),%TES2,%TES1) W *7 G CYC ;--- 01.10.01 ;;I %I=1 W $TR($C(%C),%TEN,%THB) S %S=$TR($C(%C),%TES2,%TES1)_$E(%S,2,255) W *8,*7 G:$D(%GET(1)) 13 G CYC N %ergdos S %ergdos=$G(^ERGDOS) I %I=1 W $$WC^%S2ERG($C(%C),"I") S %S=$TR($C(%C),%TES2,%TES1)_$E(%S,2,255) W *8,*7 G:$D(%GET(1)) 13 G CYC I '%FLINS,$G(%FIRST1) S %S="" X %POSIC D PC S %FIRST1=0 K %FL W:%I>%LS *7 G:%I>%LS CYC I $D(CIST),CIST'[$TR($C(%C),%TES2,%TES1) W *7 G CYC S %SYM="" I %C>47&(%C<58)!(%C>64&(%C<91)),%FHBR S %FLINS=1,%FHBR=0 ; I %C>95&(%C<123),'%FHBR,%I>1 D FNS I %JJ>0,%I'<%JJ D .N %I1,%SMB,%HB S %HB=0 .F %I1=%JJ:1:%I S %SMB=$A($E(%S,%I1)) I %SMB>95,%SMB<123 S %HB=1 Q .S %pn=%I-%JJ+(%I>1) X %levon S %I=%JJ-(%I>1) ; D FNS I %C>95&(%C<123),'%FHBR S %FHBR=1,%HBRY="" I %FLINS D INSERT G:%JJ=1 CYC ;;W $TR($C(%C),%TEN,%THB) S %S=$E(%S,1,%I-1)_$TR($C(%C),%TES2,%TES1)_$E(%S,%I+1,%L) W $$WC^%S2ERG($C(%C),"I") S %S=$E(%S,1,%I-1)_$TR($C(%C),%TES2,%TES1)_$E(%S,%I+1,%L) I %I<2 G:$D(%GET(1)) 13 G CYC ; I $D(%ZMSL("LB","GL")),%CVET W *27,7 D W *27,8 .N %TXT S %TXT=" "_$$SPL^%L1FRM(%S) .I $D(%ZMSL("LB","NOTR")) D ..N %I F %I=1:1:$L(%S) Q:%ZMSL("LB","NOTR")'[$E(%S,$L(%S)+1-%I) ..I %I>$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=%I .I $L(%TXT)-1<$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=$L(%TXT) .I '$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=1 .N %J,%J0 S %J0=%ZMSL("LB","START") F %J=%J0-1:-1:1 Q:$A($E(%TXT,$L(%TXT)-%J))<96!($A($E(%TXT,$L(%TXT)-%J))>122) S %ZMSL("LB","START")=%J .I $G(%ZMSL("LB","START")) S %TXT=$E(%TXT,1,$L(%TXT)+1-%ZMSL("LB","START")) .S %TXT=$$SPA^%L1FRM(%TXT) .Q:%TXT="" .I $D(%ZMSL("LB","HELP")) W *27,"[30;24H",$$W^%L1C(%ZMSL("LB","HELP")) .D ^%L1LB(%TXT,%ZMSL("LB","GL"),$G(%ZMSL("LB","PR"))) .;;S %XX=%XXZMS,%YY=%YYZMS I %FHBR W *8 G LEVO W *8 G CYC ; 9 ; F %J=%I+($E(%S,%I)=" "):1:%LS Q:" +,;:-="[$E(%S,%J) S %WORD="" F %J1=%J-(%J<%LS):-1:1 Q:" +,;:-="[$E(%S,%J1) S %WORD=%WORD_$E(%S,%J1) I $L(%WORD),$D(^word(%WORD)) S %WORD1=^(%WORD) S %S=$$HBR^%L1FRM($E(%S,1,%J1)_%WORD1_$S(%J<%LS:$E(%S,%J,%LS),1:""),%LS) X %POSIC S $X=%XX,$Y=%YY D PC s %pn=(%LS-%I+$L(%WORD1)-1) S:%pn'<%LS %pn=%LS-1 X %levon S %I=%I-$L(%WORD1)+1 S:%I<1 %I=1 G CYC W *7 G CYC G:%I>%LS CYC S %J=%I+8 S:%J>%L %J=%L S %pn=(%J-%I) G:%pn=0 CYC X %pravon S %I=%J G CYC 15 ; G:%I=1 CYC S %J=%I-8 S:%J<1 %J=1 S %pn=%I-%J X %levon S %I=%J G CYC TAB I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TAB" G 13 G 9 TABN I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TABN" D DELAY R *%C1:0 G 13 G 15 23 ; D INSERT G CYC ADD G 23 ADDL S %TO="F5" R *%C1:0 G 13 MOD S %TO="DEL" G 13 VNIZE I $G(^zms($P))?1"^"."%"1U.E D ^%L1ZMST S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC S %I=%LS G CYC PRSC ; D ^%L1PRSC G CYC IND S %TO="F4" D DELAY R *%C1:0 G 13 CHISTE S %TO="F2" D DELAY R *%C1:0 G 13 FINDS S %TO="FINDS" D DELAY R *%C1:0 G 13 CHISTS ; I $D(%ZMSF) S %TO="F1" D DELAY R *%C1:0 G 13 I $D(CIST),CIST="" S %TO="F1" D DELAY R *%C1:0 G 13 I %I=1,%L=1 S %S=" " D W W *8 G CYC G:%I>%L CYC S %S=$J($E(%S,%I+1,%L),%LS) S %pn=%I-1 X %levon D W S %pn=%L-%I+1 X %levon G CYC SBROS ; S %TO="F3" D DELAY R *%C1:0 G 13 SHIFT I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=2,%NMB=12 G SHIFT1 I $G(%L1NMB("ALB"))=2 S %L1NMB("ALB")=1,%HBRY="",%NMB=12 G SHIFT1 I $G(%L1NMB("ALB"))=1 K %L1NMB("ALB") S %NMB=7 G SHIFT1 SHIFT1 D PUT S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC D G CYC .S %pn=(%LS-%I) X %levon .;S %I=%LS PRAVO ; I $D(CIST),CIST="" S %TO="RIGHT" D DELAY R *%C1:0 G 13 I $D(%ZMSF("LR")) S %TO="RIGHT" D DELAY R *%C1:0 G 13 I %I>($L(%S)+1) K %PRKB G:%I'<%LS CYC0 W %pravo S %I=%I+1 G CYC0 LEVO ; I '%FHBR D FNS I %I'>%JJ,'$D(%SYM) S %FHBR=1,%HBRY="" I $D(CIST),CIST="" S %TO="LEFT" D DELAY R *%C1:0 G 13 I $D(%ZMSF("LR")) S %TO="LEFT" D DELAY R *%C1:0 G 13 I %I=1 K %PRKB G:%I=1 CYC W %levo S %I=%I-1 G CYC 13 ; N %S0 S %S0="" F %JJ=1:1:$L(%S) D .S %S0=%S0_$S($A(%S,%JJ)<128:$E(%S,%JJ),1:$C($A(%S,%JJ)-32)) S %S=%S0 I $D(l1zms) D RS D KILL D PUT D FNS S %S=$E(%S,%JJ,$L(%S)) X %XCL W:$D(%HBRY) %HBR I $D(%ECHO) U $P:(ECHO:WRAP) K %L1NMB Q KILL K CIST,%I,%L,%J,%SS,%LS,%FLINS,%BE,%ZMSL,%ZMSF,%C,%C1,%C2,%FLL,%L1LB,l1zms Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q BK G 13 VVERX ; S %TO="UP" G 13 ENDS I $D(%ZMSF) S %TO="ENDS" D DELAY R *%C1:0 G 13 D FNS I %I>%JJ S %pn=%I-%JJ+1 X %levon S %I=%JJ-1 I '%FHBR S %FHBR=1,%HBRY="" G CYC VNIZ ; ;;I %MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) K %PRKB G CYC S %TO="DW" I $D(%ZMSL("LB")),$D(%L1LB) D K %L1LB G CYC .W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY .K %L1("VIEW"),%L3VN S %L3VNOHZG="" D TV^%L1LB .D RS I $G(%ZMSL("LB","START"))<2 K %ZMSL("LB","START") .I $G(%L3VN)'="" S %S=$$HBR^%L1FRM($G(%L1LB(%L3VN))_$S($D(%ZMSL("LB","START")):$E(%S,$L(%S)-%ZMSL("LB","START")+1,255),1:""),%LS) .K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC .S $X=%XX,$Y=%YY D PC S %I=%LS G 13 HOME I $D(%ZMSF) S %TO="HOME" D DELAY R *%C1:0 G 13 I %I'>%L S %pn=%L-%I X %pravon S %I=%L G CYC PGUP S %TO="PGUP" D DELAY R *%C1:0 G 13 PGDN S %TO="PGDW" D DELAY R *%C1:0 G 13 PGLN S %TO="PGLN" D DELAY R *%C1:0 G 13 PGRG S %TO="PGRG" D DELAY R *%C1:0 G 13 BEGF S %TO="BEGF" D DELAY R *%C1:0 G 13 ENDF S %TO="ENDF" D DELAY R *%C1:0 G 13 HELP S %TO="HELP" D DELAY R *%C1:0 G 13 FIND S %TO="F8" G 13 COR S %TO="F7" G 13 SAVE S %TO="F9" G 13 REST S %TO="F10" G 13 DELL S %TO="F6" G 13 ESC S %TO="END" G 13 DEL ; I $D(CIST),CIST="" S %TO="BS" G 13 G:%S?." " CYC I $D(CIST),CIST="" G CYC D FNS S:%I>%LS %I=%LS I %JJ=%I W " ",*8 S %S=$J($E(%S,%I+1,$L(%S)),%LS) G CYC I %JJ=(%I+1) W %pravo," ",*8 S %S=$J($E(%S,%I+2,$L(%S)),%LS) S %I=%I+1 G CYC G:%I<%JJ A8 S %S=$J($E(%S,1,%I-1)_$E(%S,%I+1,$L(%S)),%LS) S %pn=%I-1 X %levon D W S %pn=%L-%I+1 x %levon G CYC A8 G PRAVO FNS ; I $L(%S)=0 S %JJ=0 Q F %JJ=1:1:$L(%S)+1 Q:$E(%S,%JJ)'=" " Q INSERT D FNS I %JJ=1 W *7 Q S %S=$E(%S,2,%I)_" "_$E(%S,%I+1,%L) S %pn=%I-1 X %levon D W S %pn=(%LS-%I+1) X %levon Q INS I $D(%ZMSF) S %TO="INS" D DELAY R *%C1:0 G 13 S %FLINS='%FLINS G CYC DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q ;MDRG S %FHBR='%FHBR I %FHBR S %FLINS=0 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 S %HBRY="" G CYC ;W *27,7 S %SAY="ENGLISH TEXT",%FLINS=1 X %XMSGV W *27,8 G CYC MDRG S %FHBR='%FHBR I %FHBR S %FLINS=0 S %HBRY="" G CYC K %HBRY S %FLINS=1 G CYC PC ; I $D(%INV) W %CLI I %LS["/",$L(%S)>%LS W %HBR W "..."_$$HBR^%L1FRM(%S,%LS-3) Q W %HBR S %S=$J($E(%S,1,%LS),%LS) D W W *8 Q SV ; I %TYPCRT="PC" D GET^%VIDEO("l1zms",0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;4$v" S l1zms="" Q RS ; I %TYPCRT="PC",$D(l1zms)!$D(^P1VIDEO($$POS^%L2MOUSE)) D PUT^%VIDEO("l1zms",0,0,80,24,2) K l1zms Q I $E(%TYPCRT,1,3)="VT5",%CVET W $C(27,91),";;;;4;;;$v" K l1zms Q I $D(%SCRN) D A^%L1SC Q W W $$W^%L1C(%S) Q PUT ; I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)) D .I '$D(%L1NMB("X0")) Q .I '$D(%L1NMB("Y0")) Q .I '$D(%L1NMB("X2")) Q .I '$D(%L1NMB("Y2")) Q .X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q ABC(SMB) ; I SMB>31&(SMB<127) Q 1 I SMB>127&(SMB<155) Q 1 Q 0 %L1ZMS0 %L1ZMS ; HEBREW [ 25.04.06 07:28 ] [ 21.04.06 14:05 ] [ 30.03.06 15:04 ] ; $D(%FLL) --> %C,%C1,%C2 ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" U $P:(NOECHO:NOWRAP) I '$D(%POSIC) D ^%L1C N %I,%J,%J1,%JJ,%XX,%YY,%FIRST,%FIRST1,%L,%A,%WORD,%WORD1,%NUMB,%SS,l1zms,%HBRY,C1,%FHBR,ZB,%SYM,%ZMSLX,%ZMSLY S %BEG=1,%L1NMB("ALB")=1 I '$D(%MOUSE) S %MOUSE=$$INIT^%L2MOUSE K %screen I %MOUSE S %BE="E" I '$D(%FLL) N %C,%C1,%C2 S %FHBR=1,%HBRY="" S:'$D(%S) %S="" S %SS=%S S:'$D(%LS) %LS=$X+1 S %TO="" I '$D(%C)#2 K %FLL I $G(%C)=27!($G(%C)=0),'$D(%C1) K %FLL ;;I $G(%C)<31!($G(%C)>126) K %FLL,%C I $L(%S)>%LS S %S=$E(%S,$L(%S)-%LS+1,255),%SS=%S D USE S %XX=$X-%LS+1,%YY=$Y S:%XX<0 %XX=0 S:%YY>24 %YY=24 X %POSIC S %ZMSLX=%XX,%ZMSLY=%YY I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_"?109l" ;-- CAPS LOCK OFF (DECCAPSLK) S %NUMB=0 S:'$D(%FLINS) %FLINS=1 D PC I $D(%L1GET) D KILL Q S %I=%LS S %FIRST=1,%FIRST1=1,%NMB=12 I $G(%BE)="E",$L(%SS) S %pn=$L(%SS) X %levon S %I=%LS-$L(%SS) I $D(%ZMSL("LB","GL")) D SV CYC ; K %SYM S %L=$L(%S) S %A=$E(%S,%I) I %MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) D W *27,7 S %C=$$^%L1NMB("") W *27,8 G:%C=""!(%C="ENTER") 13 G:$A(%C)<65!($A(%C)>90)!($L(%C)=1) CYC2 G:$T(@%C)'="" @%C G CYC2 .S %L1NMB("ZY")=%ZMSLY D ^%L1MSGBR I $G(%ZMSL("TIME")) D:('%FIRST!'$D(%FLL)) G:$T READ S %TO="TIME",%S="" G 13 .N %JJ F %JJ=1:1:%ZMSL("TIME") D ^%L1MSGBR R *%C:1 Q:$T CYC0 D ^%L1MSGBR S %L=$L(%S) S %A=$E(%S,%I) I 1 R:('%FIRST!'$D(%FLL)) *%C:1 E G CYC S %FIRST=0 I %C'=0,%C'=27 K %FLL READ G:%TYPCRT="PC" BDK S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) BDK I %C=8 G DEL I %C=7 S %TO="DBL" G 13 I %C=5 G MOD ;;S %TO="DEL" G 13 I %C=25 S %TO="END" G 13 I %C=24 W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY D ^%L1CLC S:$D(%L1CLC("F")) %S=$E(%L1CLC,1,%LS) K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY D PC S %I=%LS G CYC I %C=20 G VNIZE ;;,$G(^zms($P))?1"^"."%"1U.E W *27,7 D ^%L1ZMST S $X=%XX,$Y=%YY D PC S %I=%LS G CYC I %C>31&(%C<127) G SYM I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) ;;I %C=27 D DELAY R:('$D(%FLL)!'$D(%C1)) *%C1:%WAIT G:%C1<0 ESC D DELAY R:'$D(%FLL)!'$D(%C2) *%C2:%WAIT K %FLL I %C2>0 S %C=%C1_%C2 I %C=27 D DELAY R:'$D(%FLL) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL) *%C2:%WAIT Q:%C2<0 S:%C2>0 C=%C1_%C2 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *%C3:%WAIT Q:%C3<0 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) .R:'$D(%FLL) *%C4:%WAIT S:%C4>0 C=C_%C4 I %C=27 G ESC I %C=0 D DELAY R:('$D(%FLL)!'$D(%C1)) *%C1:%WAIT D DELAY R:('$D(%FLL)!'$D(%C2)) *%C2:%WAIT K %FLL I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<120))!(%C1>129):"0"_%C1,1:60+%C1) G:%C>160 SYM KF K %FLL I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) G CYC CYC2 S %C=$A(%C) G BDK SYM ; S %BEG=0 ;;I %C=46,$D(%HBRY) S %C=$S(%XMSG(0)<0:149,1:245) I $G(%ZMSL)[$C(%C) S %TO=$C(%C) G 13 I $D(CIST),CIST="" S %TO=$C(%C) G 13 I $D(CIST),CIST'[$TR($C(%C),%TES2,%TES1) W *7 G CYC ;--- 01.10.01 I %I=1 W $TR($C(%C),%TEN,%THB) S %S=$TR($C(%C),%TES2,%TES1)_$E(%S,2,255) W *8,*7 G:$D(%GET(1)) 13 G CYC ;I $G(%FL)="H",'%FLINS S %S="" X %POSIC D PC I '%FLINS,$G(%FIRST1) S %S="" X %POSIC D PC S %FIRST1=0 K %FL W:%I>%LS *7 G:%I>%LS CYC I $D(CIST),CIST'[$TR($C(%C),%TES2,%TES1) W *7 G CYC S %SYM="" I %C>47&(%C<58)!(%C>64&(%C<91)),%FHBR S %FLINS=1,%FHBR=0 ;;I %C>95&(%C<123)!($C(%C)=" "!($C(%C)=","))!($C(%C)="<"),'%FHBR,%I>1 D FNS I %JJ>0,%I'<%JJ D I %C>95&(%C<123),'%FHBR,%I>1 D FNS I %JJ>0,%I'<%JJ D .N %I1,%SMB,%HB S %HB=0 F %I1=%JJ:1:%I S %SMB=$A($E(%S,%I1)) I %SMB>95,%SMB<123 S %HB=1 Q .;;S %pn=%I-%JJ+(%I>1)-1 X %levon S %I=%JJ-(%I>1)-1 .S %pn=%I-%JJ+(%I>1) X %levon S %I=%JJ-(%I>1) ;;I %C>95&(%C<123)!($C(%C)=" ")!($C(%C)=",")!($C(%C)="<"),'%FHBR S %FHBR=1,%HBRY="" D FNS I %C>95&(%C<123),'%FHBR S %FHBR=1,%HBRY="" I %FLINS D INSERT G:%JJ=1 CYC W $TR($C(%C),%TEN,%THB) S %S=$E(%S,1,%I-1)_$TR($C(%C),%TES2,%TES1)_$E(%S,%I+1,%L) I %I<2 G:$D(%GET(1)) 13 G CYC I $D(%ZMSL("LB","GL")),%CVET W *27,7 D W *27,8 .N %TXT S %TXT=" "_$$SPL^%L1FRM(%S) .I $D(%ZMSL("LB","NOTR")) D ..N %I F %I=1:1:$L(%S) Q:%ZMSL("LB","NOTR")'[$E(%S,$L(%S)+1-%I) ..I %I>$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=%I .I $L(%TXT)-1<$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=$L(%TXT) .I '$G(%ZMSL("LB","START")) S %ZMSL("LB","START")=1 .N %J,%J0 S %J0=%ZMSL("LB","START") F %J=%J0-1:-1:1 Q:$A($E(%TXT,$L(%TXT)-%J))<96!($A($E(%TXT,$L(%TXT)-%J))>122) S %ZMSL("LB","START")=%J .I $G(%ZMSL("LB","START")) S %TXT=$E(%TXT,1,$L(%TXT)+1-%ZMSL("LB","START")) .S %TXT=$$SPA^%L1FRM(%TXT) .Q:%TXT="" .I $D(%ZMSL("LB","HELP")) W *27,"[30;24H",$TR($TR(%ZMSL("LB","HELP"),%TES1,%TES2),%TEN,%THB) .D ^%L1LB(%TXT,%ZMSL("LB","GL"),$G(%ZMSL("LB","PR"))) .;;S %XX=%XXZMS,%YY=%YYZMS I %FHBR W *8 G LEVO W *8 G CYC 9 ; F %J=%I+($E(%S,%I)=" "):1:%LS Q:" +,;:-="[$E(%S,%J) S %WORD="" F %J1=%J-(%J<%LS):-1:1 Q:" +,;:-="[$E(%S,%J1) S %WORD=%WORD_$E(%S,%J1) I $L(%WORD),$D(^word(%WORD)) S %WORD1=^(%WORD) S %S=$$HBR^%L1FRM($E(%S,1,%J1)_%WORD1_$S(%J<%LS:$E(%S,%J,%LS),1:""),%LS) X %POSIC S $X=%XX,$Y=%YY D PC s %pn=(%LS-%I+$L(%WORD1)-1) S:%pn'<%LS %pn=%LS-1 X %levon S %I=%I-$L(%WORD1)+1 S:%I<1 %I=1 G CYC W *7 G CYC G:%I>%LS CYC S %J=%I+8 S:%J>%L %J=%L S %pn=(%J-%I) G:%pn=0 CYC X %pravon S %I=%J G CYC 15 ; G:%I=1 CYC S %J=%I-8 S:%J<1 %J=1 S %pn=%I-%J X %levon S %I=%J G CYC TAB I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TAB" G 13 G 9 TABN I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TABN" D DELAY R *%C1:0 G 13 G 15 23 ; D INSERT G CYC ADD G 23 ADDL S %TO="F5" R *%C1:0 G 13 MOD S %TO="DEL" G 13 VNIZE I $G(^zms($P))?1"^"."%"1U.E D ^%L1ZMST S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC S %I=%LS G CYC IND S %TO="F4" D DELAY R *%C1:0 G 13 CHISTE S %TO="F2" D DELAY R *%C1:0 G 13 FINDS S %TO="FINDS" D DELAY R *%C1:0 G 13 CHISTS ; I $D(%ZMSF) S %TO="F1" D DELAY R *%C1:0 G 13 I $D(CIST),CIST="" S %TO="F1" D DELAY R *%C1:0 G 13 I %I=1,%L=1 S %S=" " D W W *8 G CYC G:%I>%L CYC S %S=$J($E(%S,%I+1,%L),%LS) S %pn=%I-1 X %levon D W S %pn=%L-%I+1 X %levon G CYC SBROS ; S %TO="F3" D DELAY R *%C1:0 G 13 SHIFT I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=2,%NMB=12 G SHIFT1 I $G(%L1NMB("ALB"))=2 S %L1NMB("ALB")=1,%HBRY="",%NMB=12 G SHIFT1 I $G(%L1NMB("ALB"))=1 K %L1NMB("ALB") S %NMB=7 G SHIFT1 SHIFT1 D PUT S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC D G CYC .S %pn=(%LS-%I) X %levon .;S %I=%LS PRAVO ; I $D(CIST),CIST="" S %TO="RIGHT" D DELAY R *%C1:0 G 13 G:%I'<%LS CYC0 W %pravo S %I=%I+1 G CYC0 LEVO ; I '%FHBR D FNS I %I'>%JJ,'$D(%SYM) S %FHBR=1,%HBRY="" I $D(CIST),CIST="" S %TO="LEFT" D DELAY R *%C1:0 G 13 G:%I=1 CYC0 W %levo S %I=%I-1 G CYC0 13 ; I $D(l1zms) D RS D KILL D PUT D FNS S %S=$E(%S,%JJ,$L(%S)) X %XCL W:$D(%HBRY) %HBR I $D(%ECHO) U $P:(ECHO:WRAP) K %L1NMB Q KILL K CIST,%I,%L,%J,%SS,%LS,%FLINS,%BE,%ZMSL,%ZMSF,%C,%C1,%C2,%FLL,%L1LB,l1zms Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q BK G 13 VVERX ; S %TO="UP" G 13 ENDS I $D(%ZMSF) S %TO="ENDS" D DELAY R *%C1:0 G 13 D FNS I %I>%JJ S %pn=%I-%JJ+1 X %levon S %I=%JJ-1 I '%FHBR S %FHBR=1,%HBRY="" G CYC VNIZ ; S %TO="DW" I $D(%ZMSL("LB")),$D(%L1LB) D K %L1LB G CYC .W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY .K %L1("VIEW"),%L3VN S %L3VNOHZG="" D TV^%L1LB .D RS I $G(%ZMSL("LB","START"))<2 K %ZMSL("LB","START") .I $G(%L3VN)'="" S %S=$$HBR^%L1FRM($G(%L1LB(%L3VN))_$S($D(%ZMSL("LB","START")):$E(%S,$L(%S)-%ZMSL("LB","START")+1,255),1:""),%LS) .K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC .S $X=%XX,$Y=%YY D PC S %I=%LS G 13 HOME I $D(%ZMSF) S %TO="HOME" D DELAY R *%C1:0 G 13 I %I'>%L S %pn=%L-%I X %pravon S %I=%L G CYC PGUP S %TO="PGUP" D DELAY R *%C1:0 G 13 PGDN S %TO="PGDW" D DELAY R *%C1:0 G 13 PGLN S %TO="PGLN" D DELAY R *%C1:0 G 13 PGRG S %TO="PGRG" D DELAY R *%C1:0 G 13 BEGF S %TO="BEGF" D DELAY R *%C1:0 G 13 ENDF S %TO="ENDF" D DELAY R *%C1:0 G 13 HELP S %TO="HELP" D DELAY R *%C1:0 G 13 FIND S %TO="F8" G 13 COR S %TO="F7" G 13 SAVE S %TO="F9" G 13 REST S %TO="F10" G 13 DELL S %TO="F6" G 13 ESC S %TO="END" G 13 DEL ; I $D(CIST),CIST="" S %TO="BS" G 13 G:%S?." " CYC I $D(CIST),CIST="" G CYC D FNS S:%I>%LS %I=%LS I %JJ=%I W " ",*8 S %S=$J($E(%S,%I+1,$L(%S)),%LS) G CYC I %JJ=(%I+1) W %pravo," ",*8 S %S=$J($E(%S,%I+2,$L(%S)),%LS) S %I=%I+1 G CYC G:%I<%JJ A8 S %S=$J($E(%S,1,%I-1)_$E(%S,%I+1,$L(%S)),%LS) S %pn=%I-1 X %levon D W S %pn=%L-%I+1 x %levon G CYC A8 G PRAVO FNS ; I $L(%S)=0 S %JJ=0 Q F %JJ=1:1:$L(%S)+1 Q:$E(%S,%JJ)'=" " Q INSERT D FNS I %JJ=1 W *7 Q S %S=$E(%S,2,%I)_" "_$E(%S,%I+1,%L) S %pn=%I-1 X %levon D W S %pn=(%LS-%I+1) X %levon Q INS I $D(%ZMSF) S %TO="INS" D DELAY R *%C1:0 G 13 S %FLINS='%FLINS G CYC DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q ;MDRG S %FHBR='%FHBR I %FHBR S %FLINS=0 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 S %HBRY="" G CYC ;W *27,7 S %SAY="ENGLISH TEXT",%FLINS=1 X %XMSGV W *27,8 G CYC MDRG S %FHBR='%FHBR I %FHBR S %FLINS=0 S %HBRY="" G CYC K %HBRY S %FLINS=1 G CYC PC ; I $D(%INV) W %CLI W %HBR S %S=$J($E(%S,1,%LS),%LS) D W W *8 Q SV ; I %TYPCRT="PC" D GET^%VIDEO("l1zms",0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;4$v" S l1zms="" Q RS ; I %TYPCRT="PC",$D(l1zms)!$D(^P1VIDEO($$POS^%L2MOUSE)) D PUT^%VIDEO("l1zms",0,0,80,24,2) K l1zms Q I $E(%TYPCRT,1,3)="VT5",%CVET W $C(27,91),";;;;4;;;$v" K l1zms Q Q W W $TR($TR(%S,%TES1,%TES2),%TEN,%THB) Q PUT ; I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)) D .I '$D(%L1NMB("X0")) Q .I '$D(%L1NMB("Y0")) Q .I '$D(%L1NMB("X2")) Q .I '$D(%L1NMB("Y2")) Q .X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q %L1ZMSL %ZMSL ; [ 19.01.24 07:52 ] [ 18.01.24 10:02 ] [ 11.01.24 16:10 ] ;PARAMETERS : ; %HBRY - $D - LEKABEL OTIJOT IVRIJOT ; %FLINS - $D - INSERT , '$D - OVERLAY ; %FLL - FIRST SYMBOL AUX ; %LS - LENGTH ; CIST - SET SYMBOLS SHE MUTAR LEHACHNIS (CIST="": COL MAKASH -> %TO) ; %BE="E"- LHATHIL HAKLADAT TEXT MI SOF SHURA ; %ZMSL - SYMBOLS SET THAT INTERRUPT INPUT -> %TO ; %ZMSL("bf") ;-- B<>F - PRE- & POST SYMBOLS ; %ZMSL("LS") : IF $L(%S)=%LS - EXIT ; %ZMSF - TAB,INS,PGUP,PGDN,F1-F10,END,HOME - MESAJEMIM HAKLADA - > %TO ; %MBG("MOVE") - PARAMETER FROM %L3MBG ; %INV - INVERS ; %GET(1) - HAKLADAT SYMBOL 1 & EXIT ;------------------------------------------------------------- ; OUTPUT: %S,%TO ;------------------------------------------------------------- S ^%TYPCRT(%L3MYDVN)="VT510",%TYPCRT=^(%L3MYDVN) K %FLL N %FRVV S %FRVV="" ;;K %HBRY N %ZMSLX,%ZMSLY,%NMB,%NMB0 S %ZMSLX=$X,%ZMSLY=$Y D USE I '$D(%POSIC) D ^%L1C S %MOUSE=0 ;;I '$D(%MOUSE) S %MOUSE=$$HZGTOUCH^%L2MOUSE K %screen S %T1=$P($H,",",2) N %I,%J,%L,%A,%C,%C1,%C2,%BEG,%XX,%YY,%PRKB I '$D(%C) K %FLL K %L1NMB("ALB") ;;W %ENG I $D(%HBRY) W %HBR S:'$D(%S) %S="" S %SS=%S S:'$D(%L1GET("TO")) %TO="" S:'$D(%FLINS) %FLINS=0 S %FHBR=0 S:'$D(%LS) %LS=79-$X S:%LS>79 %LS=79 I %LS=0 S %S="" G 13 S %S=$E(%S,1,%LS) S:'$D(%BE) %BE="" ;;I '$D(%FLL) R *%C:0 S:$T %FLL="" I %C=13 D KILL K %FLL Q D PC I $D(%L1GET) D KILL Q ;;S (%NMB,%NMB0)=7 ;;I $D(%ZMSL("NMB")) S %NMB=%ZMSL("NMB") S %BEG=1 G CYC PC I $D(%INV) W %CLI D USE ;;W $S($D(%HBRY):$TR($TR(%S,%TES1,%TES2),%TEN,%THB),1:%S) I $D(%HBRY) W $$W^%L1C(%S) I '$D(%HBRY) W %S W $J("",%LS-$L(%S)) I $G(%BE)'="E" S %pn=+%LS X %levon S %I=1 E S %I=$L(%S)+($L(%S)<%LS) s %pn=%LS-$L(%S) X %levon Q ; CYC ; I $G(%ZMSL)'="",%ZMSL[%S&(%S'=""),$L(%S)=1 S %TO=%S,%S="" G LIMEND D USE S %L=$L(%S) S %A=$S(%I>%L:" ",1:$E(%S,%I)) I $D(%FLL) G CYC01 I %MOUSE R *%C:0 D STARTVV X:%C<0 "H .1 R *%C:0" I $T K %MS G CYC1 K %MS ;;I %MOUSE,'$$KB^%L2MOUSE!$D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("KB")),'$D(%L1NMB("NO")) D S:'$D(%C) %C="" S:'$G(%PRKB) %MS="" G:%C="ENTER"!(%C="") 13 G:$A(%C)<65!($A(%C)>90) CYC2 G:$T(@%C)'="" @%C G CYC2 D ^%L1MSGBR I $G(%GET("TIME")) D:'$D(%FLL) RTIME(%GET("TIME")) K %FLL,%GET("TIME") G:$T CYC1 S %C=13,%TO="TIME" G CYC1 I $G(%ZMSL("TIME")) D:'$D(%FLL) RTIME(%ZMSL("TIME")) K %FLL G:$T CYC1 D:%BEG&$D(%ZMSL("SS")) S %C=13,%TO="TIME" G CYC1 .W *27,7 .D ^%L1CALL(%ZMSL("SS"),$G(%SCRN),$G(%ZMSL("SS","PAR"))) .S %XX=%ZMSLX+1,%YY=%ZMSLY S:%YY>(23+(%TYPCRT'="PC")) %YY=23+(%TYPCRT'="PC") X %POSIC S $Y=%YY,$X=%XX D PC CYC0 D ^%L1MSGBR I $D(%MS) G CYC R:'$D(%FLL) *%C:1 E K %PRKB G CYC K %MS CYC01 K %MS,%ZMSL("NMB") G CYC1 CYC1 ; K %FLL ;;I %TYPCRT["VT" K %HBRY S %L=$L(%S) S %A=$S(%I>%L:" ",1:$E(%S,%I)) G:%C=13!(%C=10) 13 I %C=46,$D(%HBRY)&(%TYPCRT'["VT") S %C=149 I %C=38,$D(%ZMSL("bf")),%ZMSL("bf")="&<>SC" R %A D D PC G 13 .I $E(%A,1,3)=280 S %S=+$E(%A,4,6),KAM=$E(%A,8,12)*.001 S:KAM<.01 KAM=KAM*1000 Q .I $E(%A,1,3)=284!($E(%A,1,3)=220) S %S=+$E(%A,4,7),KAM=$E(%A,8,12)*.001 S:KAM<.01 KAM=KAM*1000 Q .S %S=+$E(%A,$L(%A)-7,255) I $D(%ZMSL("bf")),%ZMSL("bf")="",%BEG,%C=98!(%C=112)!(%C=66) S %BEG=0 G CYC I $D(%ZMSL("bf")),%ZMSL("bf")[";"!(%ZMSL("bf")["s"),%BEG,$C(%C)=";"!($C(%C)="s") S %BEG=0 K %ZMSL("bf","MUST") G:'$D(%ZMSL("NOLS")) CYC R %S D KILL Q I $D(%ZMSL("bf")),%ZMSL("bf")'="",%BEG,$P(%ZMSL("bf"),"<>")[$C(%C) S %BEG=0 K %ZMSL("bf","MUST") G:'$D(%ZMSL("NOLS")) CYC R %S D KILL Q I $L($P($G(%ZMSL("bf")),"<>")),$D(%ZMSL("bf","MUST")),%ZMSL("bf")'="",$$ABC(%C),$P(%ZMSL("bf"),"<>")'[$C(%C) S %TO="BF",%S="" G 13 I $L($P($G(%ZMSL("bf")),"<>")),$D(%ZMSL("bf","MUST")),%ZMSL("bf")'="",$$ABC(%C),$P(%ZMSL("bf"),"<>")[$C(%C) S %BEG=0 K %ZMSL("bf","MUST") G CYC I $$ABC(%C) K %FLL G SYM S %BEG=0 ; READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) ; 27 I %C=27 D DELAY R:'$D(%FLL)!'$D(%C1) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL)!'$D(%C2) *%C2:%WAIT Q:%C2<0 S:%C2>0 C=%C1_%C2 Q:$D(%UPRCOD(C)) .R:'$D(%FLL)!'$D(%C3) *%C3:%WAIT Q:%C3<0 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) .R:'$D(%FLL)!'$D(%C4) *%C4:%WAIT S:%C4>0 C=C_%C4 I %C=27 G ESC I %C=0 S %TO="" D DELAY R:'$D(%FLL) *%C1:%WAIT D DELAY R:'$D(%FLL) *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) G:%C>160 SYM K %FLL I %C=25 S %TO="END" G 13 I %C=5 S %TO="DEL" G 13 I %C=7 S %TO="DBL" G 13 I %C=13!(%C=10) G 13 I %C=24 W *27,7 N %XXZMS,%YYZMS S %XXZMS=%ZMSLX,%YYZMS=%ZMSLY D ^%L1CLC S:$D(%L1CLC("F")) %S=$E(%L1CLC,1,%LS) K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY D PC G CYC I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) G CYC CYC2 S %C=$S(%C="":13,1:$A(%C)) S:$G(%L1NMB("ALB"))=1 %HBRY="" G CYC1 SYM ; ;;S %L1NMB("NO")="" D STARTVV I $G(%ZMSL)'="",%ZMSL[$C(%C) S %TO=$C(%C) G LIMEND I $D(CIST),CIST="" S %TO=$C(%C) G 13 ;;I $D(%FL),%BE'="E",%I=1,%BEG,'%FLINS S %S="" D PC I %BE'="E",%I=1,%BEG,'%FLINS S %S="" D PC S %BEG=0 K %FL W:%I>%LS *7 G:%I>%LS CYC ;;S:%C=117&'$G(%FHBR) %C=46 I $D(CIST),CIST'[$C(%C) W *7 G CYC ;;W:$D(%HBRY) %HBR I %FLINS D INSERT G:%L=+%LS 13:$D(%ZMSL("LS")),CYC0 S %L=$L(%S) I $G(%BE)="*" W "*" G SYM1 ;;W " %C="_%C_" %HBRY="_$D(%HBRY) I $D(%HBRY) D .;;W $TR($C(%C),%TEN,%THB) S:%C>95&(%C<123) %FHBR=1,%FLINS=1 .S:%C>95&(%C<123)!(%C=44) %FHBR=1,%FLINS=1 .;;I %C=44 W $C(250) Q .S %ergdos=+$G(^ERGDOS) .W $$WC^%S2ERG($C(%C),"I") ; I '$D(%HBRY) W $C(%C) ; SYM1 ;;S %S=$E(%S,1,%I-1)_$S('$D(%HBRY):$C(%C),1:$TR($C(%C),%TES2,%TES1))_$E(%S,%I+1,%L) S:'%FHBR %I=%I+1 I %FHBR W *8 S %S=$E(%S,1,%I-1)_$$SMB^%S2ERG(%C)_$E(%S,%I+1,%L) S:'%FHBR %I=%I+1 I %FHBR W *8 I $L(%S)=+%LS,$D(%ZMSL("LS")) G 13 G:$D(%GET(1)) 13 I '$D(%MS) G CYC0 K %MS G CYC 9 ; G:%I>%LS CYC S %J=%I+8 S:%J>%L %J=%L+1 S %pn=%J-%I G:%pn=0 CYC X %pravon S %I=%J G CYC0 15 ; G:%I=1 CYC S %J=%I-8 S:%J'>0 %J=1 S %pn=%I-%J X %levon S %I=%J G CYC0 TAB I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TAB" G 13 I $D(CIST),CIST="" S %TO="TAB" G 13 G 9 TABN I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TABN" D DELAY R *%C1:0 G 13 I $D(CIST),CIST="" S %TO="TAB" G 13 G 15 23 ; W:$D(%HBRY) %HBR D INSERT G CYC0 INSERT W:%L=+%LS *7 Q:%L=+%LS S %S=$E(%S,1,%I-1)_" "_$E(%S,%I,%L) I '$D(%HBRY) W $E(%S,%I,%L+1) ; I $D(%HBRY) D .;;W $TR($TR($E(%S,%I,%L+1),%TES1,%TES2),%TEN,%THB) .W $$W^%L1C($E(%S,%I,%L+1)) ; S %pn=$L($E(%S,%I,%L+1)) X %levon Q ; ; ADD G 23 FINDS S %TO="FINDS" D DELAY R *%C1:0 G 13 CHISTE S %TO="F2" D DELAY R *%C1:0 G 13 CHISTS ; I $D(%ZMSF) S %TO="F1" D DELAY R *%C1:0 G 13 G:%I>%L CYC S %S=$E(%S,1,%I-1) W $J("",%L-%I+1) S %pn=%L-%I+1 X %levon G CYC0 INS I $D(%ZMSF) S %TO="INS" D DELAY R *%C1:0 G 13 S %FLINS='%FLINS G CYC0 SBROS ; I $D(%ZMSF) S %TO="F3" D DELAY R *%C1:0 G 13 S %S=%SS S %pn=%I-1 X %levon S %I=1 G %ZMSL IND S %TO="F4" D DELAY R *%C1:0 G 13 PRAVO ; I $D(CIST),CIST="" S %TO="RIGHT" G 13 I $D(%ZMSF("LR")) S %TO="RIGHT" G 13 I %LS=1 S %TO=$S(%XMSG(0)>1:"",1:"END") G 13 G:%I>%LS CYC0 W %pravo S %S=$E(%S,1,%I-1)_%A_$E(%S,%I+1,%L),%I=%I+1 ;;G:'$D(%MS) CYC0 K %MS G CYC G CYC0 LEVO ; I $D(CIST),CIST="" S %TO="LEFT" G 13 I $D(%ZMSF("LR")) S %TO="LEFT" G 13 I %LS=1,%I=1 S %TO=$S(%XMSG(0)>1:"END",1:"") G 13 G:%I=1 CYC0 W %levo S %I=%I-1 ;;G:'$D(%MS) CYC0 K %MS G CYC G CYC0 VNIZE ; I $G(^zms($I))?1"^"."%"1U.E W *27,7 K:%TYPCRT="PC" ^zms($P,"SCRN") D ^%L1ZMST S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC G CYC G CYC PRSC ; D ^%L1PRSC G CYC ENTER ; 13 ; I %TO="",$D(%ZMSL("bf")),%ZMSL("bf")="",$E(%S,$L(%S))="f"!($E(%S,$L(%S))="F") S %S=$E(%S,1,$L(%S)-1) I %TO="",$D(%ZMSL("bf")),$P(%ZMSL("bf"),"<>",2)'="",$P(%ZMSL("bf"),"<>",2)[$E(%S,$L(%S)) S %S=$E(%S,1,$L(%S)-1) ;;I %ENGLISH S %S=$$CAPIT(%S) ;;N %JJ,%A F %JJ=1:1:20 R *%A:0 D KILL N %S0 S %S0="" F %JJ=1:1:$L(%S) D .S %S0=%S0_$S($A(%S,%JJ)<128:$E(%S,%JJ),1:$C($A(%S,%JJ)-32)) S %S=%S0 D PUT X %XCL I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) K %L1NMB Q KILL K %C,%LS,CIST,%I,%L,%J,%SS,%FLINS,%FLL,%BE,%ZMSL,%ZMSF K %GET("TIME") Q BK G 13 LIMEND K %ZMSL G 13 SHIFT I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=2,(%NMB,%NMB0)=12 G SHIFT1 I $G(%L1NMB("ALB"))=2 S %L1NMB("ALB")=1,%HBRY="",(%NMB,%NMB0)=12 G SHIFT1 I $G(%L1NMB("ALB"))=1 K %L1NMB("ALB") S (%NMB,%NMB0)=7 G SHIFT1 SHIFT1 D PUT W *27,8 X:%I>1 "S %pn=%I-1 X %levon" D G CYC .N %BE S %BE="E" D PC PUT I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q VVERX ; S %TO="UP" G 13 HOME I $D(%ZMSF) S %TO="HOME" D DELAY R *%C1:0 G 13 I %I>1 S %pn=%I-1 X %levon S %I=1 G CYC VNIZ ; S %TO="DW" G 13 ENDS I $D(%ZMSF) S %TO="ENDS" D DELAY R *%C1:0 G 13 I %I'>%L S %pn=%L-%I+1 X %pravon S %I=%L+1 G:'$D(%MS) CYC0 K %MS G CYC MOD S %TO="DEL" D DELAY R *C1:0 G 13 PGUP S %TO="PGUP" D DELAY R *%C1:0 G 13 PGDN S %TO="PGDW" D DELAY R *%C1:0 G 13 PGLN S %TO="PGLN" D DELAY R *%C1:0 G 13 HELP S %TO="HELP" D DELAY R *%C1:0 G 13 PGRG S %TO="PGRG" D DELAY R *%C1:0 G 13 BEGF S %TO="BEGF" D DELAY R *%C1:0 G 13 ENDF S %TO="ENDF" D DELAY R *%C1:0 I $D(^r($J)),$G(%SCRN)["P1HZ" D 1^P1POP ;-- PTICHAT MEGIRA G 13 FIND S %TO="F8" G 13 COR S %TO="F7" G 13 SAVE S %TO="F9" G 13 REST S %TO="F10" G 13 ADDL ; I $D(%L1SF),$D(%SCRN) N %FSTY S %FSTY=FSTY N FSTY,FSTYOLD S (FSTY,FSTYOLD)=20-%FSTY D .N (FSTY,FSTYOLD,%UPRCOD,%XMSGV,%XMSGN,%XMSG,%SCRN,%PAR,NM) D ^%L1C S %NM=NM N NM S NM=%NM,%ZMZT=$ZT D S $ZT=%ZMZT S NM=%NM D VSVALL^%L1SF,PODVAL^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ ..S NM=.9 D PDV1^%L1SF ..F K NM1 S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM'>0 D Q:NM="" D:$G(NM1)="A" VSVP^%L1SF,VSVALL^%L1SF X:$D(VSVI) "K VSVI D VSV^%L1SF" S:$D(NM1) NM=NM-1 I $G(%TO)="END" S NM=$O(^SCR(%SCRN,%PAR,NM),-1) Q:NM="" S %TO="" I NM>0 S NM=$O(^SCR(%SCRN,%PAR,NM),-1) ...D PDV1^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ K %L1GET S HZG=0 D ^%L1SFZ S %TO="F5" G 13 DELL S %TO="F6" G 13 MVUP S %TO="MVUP" G 13 MVDW S %TO="MVDW" G 13 ESC S %TO="END" G 13 DEL ; I $D(CIST),CIST="" S %TO="DEL" D DELAY R *%C1:0 G 13 G:%I>%L A8 S %S=$E(%S,1,%I-1)_$E(%S,%I+1,%L) W:$D(%HBRY) %HBR W $E(%S,%I,%L-1)_" " S %pn=%L-%I+1 x %levon G:'$D(%MS) CYC0 K %MS G CYC A8 G:%L=0 CYC S %S=$E(%S,1,%I-2),%I=%I-1 W %levo," ",%levo G CYC0 Q DELAY I %TYPCRT="PC1" F %II=1:1:6000 Q ;MDRG S %FHBR='%FHBR I %FHBR S %FLINS=1 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 S %HBRY="" G CYC ;W *27,7 S %SAY="ENGLISH TEXT" X %XMSGV W *27,8 G CYC MDRG S %FHBR='%FHBR K %HBRY I %FHBR S %FLINS=1 S %HBRY="" G CYC0 G CYC0 HBR I '$D(%HBRY) S %HBRY="" D BEGS W $TR($TR(%S,%TES1,%TES2),%TEN,%THB) G HBR1 N %HBRY W %ENG D BEGS W %S HBR1 S %pn=$L(%S)-%I+1 S:%pn<0 %pn=0 X:%pn>0 %levon G CYC0 BEGS S %pn=%I-1 X:%pn>0 %levon Q HBEN I $D(%HBRY) S %S=$E(%S,1,%I-1)_$TR($E(%S,%I,255),%THB,%TEN) G HBR I '$D(%HBRY) S %S=$E(%S,1,%I-1)_$TR($TR($E(%S,%I,255),%TES1,%TES2),%TEN,%THB) G HBR CAPIT(%ST) N J,%SMB N J F J=1:1:$L(%ST) S %SMB=$E(%ST,J) D .I $A(%SMB)<123,$A(%SMB)>95 S $E(%ST,J)=$C($A(%SMB)-32) Q %ST USE ; ;;I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q RTIME(%TM) ; N %JJ F %JJ=1:1:%TM D ^%L1MSGBR R *%C:1 Q:$T Q ABC(SMB) ; I SMB>31&(SMB<127) Q 1 I SMB>127&(SMB<155) Q 1 Q 0 STARTVV Q:'$D(%FRVV) S %STARTVV=$P($H,",",2) K %FRVV Q %L1ZMSL0 %ZMSL ; [ 15.03.19 07:51 ] [ 15.04.08 12:54 ] [ 03.04.08 11:56 ] ;PARAMETERS : ; %HBRY - $D - LEKABEL OTIJOT IVRIJOT ; %FLINS - $D - INSERT , '$D - OVERLAY ; %FLL - FIRST SYMBOL AUX ; %LS - LENGTH ; CIST - SET SYMBOLS SHE MUTAR LEHACHNIS (CIST="": COL MAKASH -> %TO) ; %BE="E"- LHATHIL HAKLADAT TEXT MI SOF SHURA ; %ZMSL - SYMBOLS SET THAT INTERRUPT INPUT -> %TO ; %ZMSL("bf") ;-- B<>F - PRE- & POST SYMBOLS ; %ZMSL("LS") : IF $L(%S)=%LS - EXIT ; %ZMSF - TAB,INS,PGUP,PGDN,F1-F10,END,HOME - MESAJEMIM HAKLADA - > %TO ; %MBG("MOVE") - PARAMETER FROM %L3MBG ; %INV - INVERS ; %GET(1) - HAKLADAT SYMBOL 1 & EXIT ;------------------------------------------------------------- ; OUTPUT: %S,%TO ;------------------------------------------------------------- K %FLL N %FRVV S %FRVV="" N %ZMSLX,%ZMSLY,%NMB,%NMB0 S %ZMSLX=$X,%ZMSLY=$Y D USE I '$D(%POSIC) D ^%L1C ;;I '$D(%MOUSE) S %MOUSE=$$INIT^%L2MOUSE K %screen I '$D(%MOUSE) S %MOUSE=$$HZGTOUCH^%L2MOUSE K %screen S %T1=$P($H,",",2) N %I,%J,%L,%A,%C,%C1,%C2,%BEG,%XX,%YY,%PRKB I '$D(%C) K %FLL K %L1NMB("ALB") W %ENG I $D(%HBRY) W %HBR S:'$D(%S) %S="" S %SS=%S S:'$D(%L1GET("TO")) %TO="" S:'$D(%FLINS) %FLINS=0 S %FHBR=0 S:'$D(%LS) %LS=79-$X S:%LS>79 %LS=79 I %LS=0 S %S="" G 13 S %S=$E(%S,1,%LS) S:'$D(%BE) %BE="" ;;I '$D(%FLL) R *%C:0 S:$T %FLL="" I %C=13 D KILL K %FLL Q D PC I $D(%L1GET) D KILL Q ;;S (%NMB,%NMB0)=7 ;;I $D(%ZMSL("NMB")) S %NMB=%ZMSL("NMB") S %BEG=1 G CYC PC I $D(%INV) W %CLI D USE W $S($D(%HBRY):$TR($TR(%S,%TES1,%TES2),%TEN,%THB),1:%S) W $J("",%LS-$L(%S)) I $G(%BE)'="E" S %pn=+%LS X %levon S %I=1 E S %I=$L(%S)+($L(%S)<%LS) s %pn=%LS-$L(%S) X %levon Q CYC ; I $G(%ZMSL)'="",%ZMSL[%S&(%S'=""),$L(%S)=1 S %TO=%S,%S="" G LIMEND D USE S %L=$L(%S) S %A=$S(%I>%L:" ",1:$E(%S,%I)) I $D(%FLL) G CYC01 I %MOUSE R *%C:0 D STARTVV X:%C<0 "H .1 R *%C:0" I $T K %MS G CYC1 K %MS ;;I %MOUSE,'$$KB^%L2MOUSE!$D(%L1NMB("HZM"))!$D(%L1NMB("LINE"))!$D(%L1NMB("KB")),'$D(%L1NMB("NO")) D S:'$D(%C) %C="" S:'$G(%PRKB) %MS="" G:%C="ENTER"!(%C="") 13 G:$A(%C)<65!($A(%C)>90) CYC2 G:$T(@%C)'="" @%C G CYC2 I %MOUSE,'$$KB^%L2MOUSE!($$KB^%L2MOUSE&$G(^P1PRM("VKB"))) D S:'$D(%C) %C="" S:'$G(%PRKB) %MS="" G:%C="ENTER"!(%C="") 13 G:$A(%C)<65!($A(%C)>90) CYC2 G:$T(@%C)'="" @%C G CYC2 .S %ZMSF="",%L1NMB("ZX")=%ZMSLX+.1#80-.1,%L1NMB("ZY")=%ZMSLY .W *27,7 S %C=$$^%L1NMB("") W *27,8 .I %C="ENTER"!(%C="") S %TO="" D ^%L1MSGBR I $G(%GET("TIME")) D:'$D(%FLL) RTIME(%GET("TIME")) K %FLL,%GET("TIME") G:$T CYC1 S %C=13,%TO="TIME" G CYC1 I $G(%ZMSL("TIME")) D:'$D(%FLL) RTIME(%ZMSL("TIME")) K %FLL G:$T CYC1 D:%BEG&$D(%ZMSL("SS")) S %C=13,%TO="TIME" G CYC1 .W *27,7 .D ^%L1CALL(%ZMSL("SS"),$G(%SCRN),$G(%ZMSL("SS","PAR"))) .S %XX=%ZMSLX+1,%YY=%ZMSLY S:%YY>(23+(%TYPCRT'="PC")) %YY=23+(%TYPCRT'="PC") X %POSIC S $Y=%YY,$X=%XX D PC CYC0 D ^%L1MSGBR I $D(%MS) G CYC R:'$D(%FLL) *%C:1 E K %PRKB G CYC K %MS CYC01 K %MS,%ZMSL("NMB") G CYC1 CYC1 ; K %FLL I %TYPCRT["VT" K %HBRY S %L=$L(%S) S %A=$S(%I>%L:" ",1:$E(%S,%I)) G:%C=13!(%C=10) 13 I %C=46,$D(%HBRY)&(%TYPCRT'["VT") S %C=149 I %C=38,$D(%ZMSL("bf")),%ZMSL("bf")="&<>SC" R %A D D PC G 13 .I $E(%A,1,3)=280 S %S=+$E(%A,4,6),KAM=$E(%A,8,12)*.001 S:KAM<.01 KAM=KAM*1000 Q .I $E(%A,1,3)=284!($E(%A,1,3)=220) S %S=+$E(%A,4,7),KAM=$E(%A,8,12)*.001 S:KAM<.01 KAM=KAM*1000 Q .S %S=+$E(%A,$L(%A)-7,255) I $D(%ZMSL("bf")),%ZMSL("bf")="",%BEG,%C=98!(%C=112)!(%C=66) S %BEG=0 G CYC I $D(%ZMSL("bf")),%ZMSL("bf")[";"!(%ZMSL("bf")["s"),%BEG,$C(%C)=";"!($C(%C)="s") S %BEG=0 K %ZMSL("bf","MUST") G:'$D(%ZMSL("NOLS")) CYC R %S D KILL Q I $D(%ZMSL("bf")),%ZMSL("bf")'="",%BEG,$P(%ZMSL("bf"),"<>")[$C(%C) S %BEG=0 K %ZMSL("bf","MUST") G:'$D(%ZMSL("NOLS")) CYC R %S D KILL Q I $L($P($G(%ZMSL("bf")),"<>")),$D(%ZMSL("bf","MUST")),%ZMSL("bf")'="",$$ABC(%C),$P(%ZMSL("bf"),"<>")'[$C(%C) S %TO="BF",%S="" G 13 I $L($P($G(%ZMSL("bf")),"<>")),$D(%ZMSL("bf","MUST")),%ZMSL("bf")'="",$$ABC(%C),$P(%ZMSL("bf"),"<>")[$C(%C) S %BEG=0 K %ZMSL("bf","MUST") G CYC I $$ABC(%C) K %FLL G SYM S %BEG=0 ; READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) ; 27 I %C=27 D DELAY R:'$D(%FLL)!'$D(%C1) *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" D DELAY R:'$D(%FLL)!'$D(%C2) *%C2:%WAIT Q:%C2<0 S:%C2>0 C=%C1_%C2 Q:$D(%UPRCOD(C)) .R:'$D(%FLL)!'$D(%C3) *%C3:%WAIT Q:%C3<0 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) .R:'$D(%FLL)!'$D(%C4) *%C4:%WAIT S:%C4>0 C=C_%C4 I %C=27 G ESC I %C=0 S %TO="" D DELAY R:'$D(%FLL) *%C1:%WAIT D DELAY R:'$D(%FLL) *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) G:%C>160 SYM K %FLL I %C=25 S %TO="END" G 13 I %C=5 S %TO="DEL" G 13 I %C=7 S %TO="DBL" G 13 I %C=13!(%C=10) G 13 I %C=24 W *27,7 N %XXZMS,%YYZMS S %XXZMS=%ZMSLX,%YYZMS=%ZMSLY D ^%L1CLC S:$D(%L1CLC("F")) %S=$E(%L1CLC,1,%LS) K %GETREST W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY D PC G CYC I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) G CYC CYC2 S %C=$S(%C="":13,1:$A(%C)) S:$G(%L1NMB("ALB"))=1 %HBRY="" G CYC1 SYM ; ;;S %L1NMB("NO")="" D STARTVV I $G(%ZMSL)'="",%ZMSL[$C(%C) S %TO=$C(%C) G LIMEND I $D(CIST),CIST="" S %TO=$C(%C) G 13 ;;I $D(%FL),%BE'="E",%I=1,%BEG,'%FLINS S %S="" D PC I %BE'="E",%I=1,%BEG,'%FLINS S %S="" D PC S %BEG=0 K %FL W:%I>%LS *7 G:%I>%LS CYC ;;S:%C=117&'$G(%FHBR) %C=46 I $D(CIST),CIST'[$C(%C) W *7 G CYC ;;W:$D(%HBRY) %HBR I %FLINS D INSERT G:%L=+%LS 13:$D(%ZMSL("LS")),CYC0 S %L=$L(%S) I $G(%BE)="*" W "*" G SYM1 I $D(%HBRY) W $TR($C(%C),%TEN,%THB) S:%C>95&(%C<123) %FHBR=1,%FLINS=1 I '$D(%HBRY) W $C(%C) SYM1 S %S=$E(%S,1,%I-1)_$S('$D(%HBRY):$C(%C),1:$TR($C(%C),%TES2,%TES1))_$E(%S,%I+1,%L) S:'%FHBR %I=%I+1 I %FHBR W *8 I $L(%S)=+%LS,$D(%ZMSL("LS")) G 13 G:$D(%GET(1)) 13 I '$D(%MS) G CYC0 K %MS G CYC ;;I $D(%HBRY) W $TR($TR(%S,%TES1,%TES2),%TEN,%THB) ;;I '$D(%HBRY) W %S 9 ; G:%I>%LS CYC S %J=%I+8 S:%J>%L %J=%L+1 S %pn=%J-%I G:%pn=0 CYC X %pravon S %I=%J G CYC0 15 ; G:%I=1 CYC S %J=%I-8 S:%J'>0 %J=1 S %pn=%I-%J X %levon S %I=%J G CYC0 TAB I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TAB" G 13 I $D(CIST),CIST="" S %TO="TAB" G 13 G 9 TABN I $D(%ZMSF)!$D(%MBG("MOVE")) S %TO="TABN" D DELAY R *%C1:0 G 13 I $D(CIST),CIST="" S %TO="TAB" G 13 G 15 23 ; W:$D(%HBRY) %HBR D INSERT G CYC0 INSERT W:%L=+%LS *7 Q:%L=+%LS S %S=$E(%S,1,%I-1)_" "_$E(%S,%I,%L) I '$D(%HBRY) W $E(%S,%I,%L+1) I $D(%HBRY) W $TR($TR($E(%S,%I,%L+1),%TES1,%TES2),%TEN,%THB) S %pn=$L($E(%S,%I,%L+1)) X %levon Q ADD G 23 FINDS S %TO="FINDS" D DELAY R *%C1:0 G 13 CHISTE S %TO="F2" D DELAY R *%C1:0 G 13 CHISTS ; I $D(%ZMSF) S %TO="F1" D DELAY R *%C1:0 G 13 G:%I>%L CYC S %S=$E(%S,1,%I-1) W $J("",%L-%I+1) S %pn=%L-%I+1 X %levon G CYC0 INS I $D(%ZMSF) S %TO="INS" D DELAY R *%C1:0 G 13 S %FLINS='%FLINS G CYC0 SBROS ; I $D(%ZMSF) S %TO="F3" D DELAY R *%C1:0 G 13 S %S=%SS S %pn=%I-1 X %levon S %I=1 G %ZMSL IND S %TO="F4" D DELAY R *%C1:0 G 13 PRAVO ; I $D(CIST),CIST="" S %TO="RIGHT" G 13 I $D(%ZMSF("LR")) S %TO="RIGHT" G 13 I %LS=1 S %TO=$S(%XMSG(0)>1:"",1:"END") G 13 G:%I>%LS CYC0 W %pravo S %S=$E(%S,1,%I-1)_%A_$E(%S,%I+1,%L),%I=%I+1 ;;G:'$D(%MS) CYC0 K %MS G CYC G CYC0 LEVO ; I $D(CIST),CIST="" S %TO="LEFT" G 13 I $D(%ZMSF("LR")) S %TO="LEFT" G 13 I %LS=1,%I=1 S %TO=$S(%XMSG(0)>1:"END",1:"") G 13 G:%I=1 CYC0 W %levo S %I=%I-1 ;;G:'$D(%MS) CYC0 K %MS G CYC G CYC0 VNIZE ; I $G(^zms($I))?1"^"."%"1U.E W *27,7 K:%TYPCRT="PC" ^zms($P,"SCRN") D ^%L1ZMST S %XX=%ZMSLX,%YY=%ZMSLY X %POSIC D PC G CYC G CYC PRSC ; D ^%L1PRSC G CYC ENTER ; 13 ; I %TO="",$D(%ZMSL("bf")),%ZMSL("bf")="",$E(%S,$L(%S))="f"!($E(%S,$L(%S))="F") S %S=$E(%S,1,$L(%S)-1) I %TO="",$D(%ZMSL("bf")),$P(%ZMSL("bf"),"<>",2)'="",$P(%ZMSL("bf"),"<>",2)[$E(%S,$L(%S)) S %S=$E(%S,1,$L(%S)-1) ;;I %ENGLISH S %S=$$CAPIT(%S) ;;N %JJ,%A F %JJ=1:1:20 R *%A:0 D KILL D PUT X %XCL I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) K %L1NMB Q KILL K %C,%LS,CIST,%I,%L,%J,%SS,%FLINS,%FLL,%BE,%ZMSL,%ZMSF K %GET("TIME") Q BK G 13 LIMEND K %ZMSL G 13 SHIFT I '$D(%L1NMB("ALB")) S %L1NMB("ALB")=2,(%NMB,%NMB0)=12 G SHIFT1 I $G(%L1NMB("ALB"))=2 S %L1NMB("ALB")=1,%HBRY="",(%NMB,%NMB0)=12 G SHIFT1 I $G(%L1NMB("ALB"))=1 K %L1NMB("ALB") S (%NMB,%NMB0)=7 G SHIFT1 SHIFT1 D PUT W *27,8 X:%I>1 "S %pn=%I-1 X %levon" D G CYC .N %BE S %BE="E" D PC PUT I %MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q VVERX ; S %TO="UP" G 13 HOME I $D(%ZMSF) S %TO="HOME" D DELAY R *%C1:0 G 13 I %I>1 S %pn=%I-1 X %levon S %I=1 G CYC VNIZ ; S %TO="DW" G 13 ENDS I $D(%ZMSF) S %TO="ENDS" D DELAY R *%C1:0 G 13 I %I'>%L S %pn=%L-%I+1 X %pravon S %I=%L+1 G:'$D(%MS) CYC0 K %MS G CYC MOD S %TO="DEL" D DELAY R *C1:0 G 13 PGUP S %TO="PGUP" D DELAY R *%C1:0 G 13 PGDN S %TO="PGDW" D DELAY R *%C1:0 G 13 PGLN S %TO="PGLN" D DELAY R *%C1:0 G 13 HELP S %TO="HELP" D DELAY R *%C1:0 G 13 PGRG S %TO="PGRG" D DELAY R *%C1:0 G 13 BEGF S %TO="BEGF" D DELAY R *%C1:0 G 13 ENDF S %TO="ENDF" D DELAY R *%C1:0 I $D(^r($J)),$G(%SCRN)["P1HZ" D 1^P1POP ;-- PTICHAT MEGIRA .;;N J,%MDP D MDP^P1PC Q:'$G(PRINT) L ^[$$^%L1GLD]pc(PRINT) S J=$O(^[$$^%L1GLD]pc(PRINT,99999),-1)+1 .;;S ^[$$^%L1GLD]pc(PRINT,J)=$G(%MDP("P")) G 13 FIND S %TO="F8" G 13 COR S %TO="F7" G 13 SAVE S %TO="F9" G 13 REST S %TO="F10" G 13 ADDL ; I $D(%L1SF),$D(%SCRN) N %FSTY S %FSTY=FSTY N FSTY,FSTYOLD S (FSTY,FSTYOLD)=20-%FSTY D .N (FSTY,FSTYOLD,%UPRCOD,%XMSGV,%XMSGN,%XMSG,%SCRN,%PAR,NM) D ^%L1C S %NM=NM N NM S NM=%NM,%ZMZT=$ZT D S $ZT=%ZMZT S NM=%NM D VSVALL^%L1SF,PODVAL^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ ..S NM=.9 D PDV1^%L1SF ..F K NM1 S NM=$O(^SCR(%SCRN,%PAR,NM)) Q:NM'>0 D Q:NM="" D:$G(NM1)="A" VSVP^%L1SF,VSVALL^%L1SF X:$D(VSVI) "K VSVI D VSV^%L1SF" S:$D(NM1) NM=NM-1 I $G(%TO)="END" S NM=$O(^SCR(%SCRN,%PAR,NM),-1) Q:NM="" S %TO="" I NM>0 S NM=$O(^SCR(%SCRN,%PAR,NM),-1) ...D PDV1^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ K %L1GET S HZG=0 D ^%L1SFZ S %TO="F5" G 13 DELL S %TO="F6" G 13 MVUP S %TO="MVUP" G 13 MVDW S %TO="MVDW" G 13 ESC S %TO="END" G 13 DEL ; I $D(CIST),CIST="" S %TO="DEL" D DELAY R *%C1:0 G 13 G:%I>%L A8 S %S=$E(%S,1,%I-1)_$E(%S,%I+1,%L) W:$D(%HBRY) %HBR W $E(%S,%I,%L-1)_" " S %pn=%L-%I+1 x %levon G:'$D(%MS) CYC0 K %MS G CYC A8 G:%L=0 CYC S %S=$E(%S,1,%I-2),%I=%I-1 W %levo," ",%levo G CYC0 Q DELAY I %TYPCRT="PC1" F %II=1:1:6000 Q ;MDRG S %FHBR='%FHBR I %FHBR S %FLINS=1 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 S %HBRY="" G CYC ;W *27,7 S %SAY="ENGLISH TEXT" X %XMSGV W *27,8 G CYC MDRG S %FHBR='%FHBR I %FHBR S %FLINS=1 S %HBRY="" G CYC0 G CYC0 HBR I '$D(%HBRY) S %HBRY="" D BEGS W $TR($TR(%S,%TES1,%TES2),%TEN,%THB) G HBR1 N %HBRY W %ENG D BEGS W %S HBR1 S %pn=$L(%S)-%I+1 S:%pn<0 %pn=0 X:%pn>0 %levon G CYC0 BEGS S %pn=%I-1 X:%pn>0 %levon Q HBEN I $D(%HBRY) S %S=$E(%S,1,%I-1)_$TR($E(%S,%I,255),%THB,%TEN) G HBR I '$D(%HBRY) S %S=$E(%S,1,%I-1)_$TR($TR($E(%S,%I,255),%TES1,%TES2),%TEN,%THB) G HBR CAPIT(%ST) N J,%SMB N J F J=1:1:$L(%ST) S %SMB=$E(%ST,J) D .I $A(%SMB)<123,$A(%SMB)>95 S $E(%ST,J)=$C($A(%SMB)-32) Q %ST USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q RTIME(%TM) ; N %JJ F %JJ=1:1:%TM D ^%L1MSGBR R *%C:1 Q:$T Q ABC(SMB) ; I SMB>31&(SMB<127) Q 1 I SMB>127&(SMB<155) Q 1 Q 0 STARTVV Q:'$D(%FRVV) S %STARTVV=$P($H,",",2) K %FRVV Q %L1ZMST %L1ZMST ; [ 12.02.07 14:50 ] [ 02.07.04 10:21 ] [ 28.06.04 13:40 ] Q:'$D(^zms($P)) Q:$D(^zms($P,"NO")) W *27,7 N %XX,%YY N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N I,J I %TYPCRT="PC" N %SCRN D SAVE^%L3MBGG N %XXZMS,%YYZMS,SH,SCH,%S,%FNAME,FRST S %XXZMS=$G(%XX,$X),%YYZMS=$G(%YY,$Y) I $G(^zms($P))'="" D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%SCRN,%UCI) D ^%L1C .I '$D(^zms($P,"SCRN")),$L($G(%SCRN)) S ^("SCRN")=$G(%SCRN),^("SCRN","TMP")="" .N %SCRN .I $G(^zms($P,"SCRN"))'="" D ..S %SCRN=^("SCRN"),(%NG,%NGF)=$$GN^%L1TMP("") ..N %N S %N="" F S %N=$O(^SCR(%SCRN,"P","REF",%N)) Q:%N="" D SVGLB(^(%N)) ..I $D(^SCR(%SCRN,"G","REF")) D SVGLB(^SCR(%SCRN,"G","REF")) ..S %NGL=%NG-1 .; .S (%UCIR,%UCIG)="" .I $D(^zms($P,"UCI")) D ..S %UCOR=$ZROUTINES,%UCOG=$ZGBLDIR ..S %UCIR=$P(^zms($P,"UCI"),"^"),%UCIG=$P(^("UCI"),"^",2) ..I $L(%UCIG) S MAC1="^zms($P)",MAC2="^[%UCIG]zms($P)" D ^%S1GC1 K ^zms($P) ..I $L(%UCIR) S $ZROUTINES=%UCIR ..I $L(%UCIG) S $ZGBLDIR=%UCIG .; .S %N="" F S %N=$O(^zms($P,"V",%N)) Q:%N="" D ..I $D(^(%N))>9 S MAC1="^zms($P,""V"",%N)",MAC2=%N D ^%S1GC1 Q ..I $D(^(%N))#2 S @%N=^(%N) Q .; .I $G(^zms($P))'="" D @^zms($P) . .I $L($G(%UCIR)) D ..S MAC1="^zms($P)",MAC2="^[%UCOG]zms($P)" D ^%S1GC1 K ^zms($P) ..S:$D(%UCOR) $ZROUTINES=%UCOR S:$D(%UCOG) $ZGBLDIR=%UCOG . .I $G(^zms($P,"SCRN"))'="" S %SCRN=^("SCRN") D ..S %NG=+$G(%NGF) ..N %N S %N="" F S %N=$O(^SCR(%SCRN,"P","REF",%N)) Q:%N="" D RSGLB(^(%N)) ..I $D(^SCR(%SCRN,"G","REF")) D RSGLB(^SCR(%SCRN,"G","REF")) ; D ^%L1C I $L($G(^zms($P,"SCRN"))),^("SCRN")'="-",$G(^("RESTPRG"))="" X %chista,%XCL S %SCRN=^zms($P,"SCRN") D A^%L1SC G E I $G(^zms($P,"RESTPRG"))'="" S %RESTPRG=^("RESTPRG") I $D(^zms($P,"NOVIDEO")) S %NOVIDEO="" D REST^%L3MBGG E W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY I $D(^zms($P,"SCRN","TMP")) K ^zms($P,"SCRN") Q SVGLB(%GLB) ; S %GLB=$P(%GLB,",") I $E(%GLB,$L(%GLB))'=")" S %GLB=%GLB_")" S %ER="" D GS^%L1TMP(%NG,"%L1ZMST",%GLB,%ER) S %NG=$$GN^%L1TMP("") Q RSGLB(%GLB) ; S %GLB=$P(%GLB,",") I $E(%GLB,$L(%GLB))'=")" S %GLB=%GLB_")" K @%GLB D GR^%L1TMP(%NG,"%L1ZMST",%GLB) D KL^%L1TMP(%NG) S %NG=%NG+1 Q %L1ZOS %L1ZOS(FNC,PRM1,PRM2) ; [ 20.07.08 12:41 ] [ 16.07.08 09:24 ] [ 08.04.07 08:50 ] N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" I $T(@FNC)'="" G @FNC Q -1 2 I '$$EXIST(PRM1) Q -1 N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" O PRM1 C PRM1:(DELETE) Q 1 3 I '$$EXIST(PRM1) Q -1 N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" I $$EXIST(PRM2) Q -2 O PRM1 C PRM1:(RENAME=PRM2) Q 1 4 Q $ZV 6 ; N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" ZSY "mkdir "_PRM1 Q 1 7 N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" ZSY "rmdir "_PRM1 Q 1 8 N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" ZSY "cd "_PRM1 ;;w !,$ZDIR,! Q 1 10 I '$$EXIST(PRM1) Q -1 I '$$SIZE(PRM1) Q -1 Q 1 11 Q $ZDIR 12 N $ZT S $ZT="ZG "_$ZL_":ER^%L1ZOS" I $ZSEARCH("*.@@@") N A S A=$ZSEARCH(PRM1) I A="" Q -1 Q A 13 Q $ZSEARCH(PRM1) ER Q -9 EXIST(FILE) ; I $ZSEARCH(FILE_"-") Q $L($ZSEARCH(FILE))>0 SIZE(FILE) ; I '$$EXIST(FILE) Q 0 Q $P($$^%L1FLP(FILE),"^",2) %L1ZPC %L1ZPC(%PRM) ; [ 30.01.05 3:10 PM ] [ N %OTB1,%OTB2 I '$L($G(%PRM)) S %PRM="99,97" S %OTB1=$P(%PRM,",") S %OTB2=$P(%PRM,",",2) S %GET=%OTB1_" - qitcdl" I $P(%PRM,",",2) S %GET=%GET_", "_%OTB2_" - EXCEL-l xiardl" D N^%L1GET S:%TO="F9" %S=99 S:%TO="F7" %TO=97 I %S=97!(%S=99) S:%S=97 %L1SCPC("EXCEL")="" D ^%L1SCPC Q %L1ZU %L1ZU(%PRM) ; [ 17.07.03 13:33 ] [ I %PRM=0 Q $$FUNC^%UCASE($ZPARSE($ZGBLDIR,"NAME")) Q "" %L1ZV %L1ZV(DUMP) ; [ 06/06/98 2:49 PM ] [ Q $TR($ZV,"MSM-PC/386","MUMPS-PC") %L2CLNT %L2CLNT(%ZNHost,%ZNPort,%ZNTimeS,%ZNDev) ; [ 08.04.07 08:15 ] [ 08.08.06 13:10 ] [ 01.02.06 13:49 ] new %Z0,%ZNReq,%ZNRsp ; ; set a new errortrap N $ZT ;;S $ZT="G EROP^%L2CLNT" S $ZT="ZG "_$ZL_":EROP^%L2CLNT" kill ^SCKCLI($job) ; ; Construct a dummy, but "unique", devicename. ; set %ZNDev="SCK$"_$J ; ; Open the device: OPEN %ZNDev:(CONNECT=%ZNHost_":"_%ZNPort_":TCP":DELIMITER=$CHAR(13,10,58,27,95,58,12):ATTACH="client"):%ZNTimeS:"SOCKET" else set ^SCKCLI($job)="-1,NotOpen" quit U %ZNDev:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13)) Q EROP set ^SCKCLI($job)="-1,NotOpen" quit %L2CLNT0 %L2CLNT(%ZNHost,%ZNPort,%ZNTimeS,%ZNDev) ; [ 06.11.05 18:40 ] [ 19.09.05 17:29 ] [ 11.09.05 17:58 ] [ new %Z0,%ZNReq,%ZNRsp ; ; set a new errortrap new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":clientQ" kill ^SCKCLI($job) ; ; Construct a dummy, but "unique", devicename. ; set %ZNDev="SCK$"_$J ; ; Open the device: OPEN %ZNDev:(CONNECT=%ZNHost_":"_%ZNPort_":TCP":DELIMITER=$CHAR(13,10,58,27,95):ATTACH="client"):%ZNTimeS:"SOCKET" else set ^SCKCLI($job)="-1,NotOpen" quit Q ; ; Adjust errortrap after open (need to close) ;;set $ZTRAP="ZGOTO "_$ZLEVEL_":clientC" s $ZT="" set ^SCKCLI($job)=0 ; ; After successful OPEN, USE will fill $KEY with ; "ESTABLISHED|socket_handle|host_ip_address" USE %ZNDev:(IOERROR="TRAP":EXCEPTION="ZGOTO "_$ZLEVEL_":clientD") set ^SCKCLI($job,0,3)=$KEY set ^SCKCLI($job)=0 ; use ZSHOW command "D" and "I" before closing the device Q clientC ZSHOW "DI":^SCKCLI($job,"CLOSE") CLOSE %ZNDev ; ; clientQ - just QUIT ; clientQ QUIT ; ; clientD - Device exception occured ; clientD set ^SCKCLI($job)="-11,IOException" goto clientC %L2DAT %L2DAT U $P:(NOECHO:NOWRAP) ; DATE [ 08/02/91 9:52 AM ] S:'$D(%XX) %XX=$X-8 S:%XX<0 %XX=0 S %XX1=%XX S:'$D(%YY) %YY=$Y S:%XX>72 %XX=72 S:%YY>23 %YY=23 X %POSIC S %TO="" S %S="" I $D(%L1DS) S %S=%L1DS W %ENG,%CLI,$J($E(%S,1,2),2) X %XCL W "." W %ENG,%CLI,$J($E(%S,3,4),2) X %XCL W "." W %ENG,%CLI,$J($E(%S,5,6),2) VDD X %POSIC D VV G:%S="" END S %DD=$E(%S,1,2),%MM=$E(%S,3,4),%HH=$E(%S,5,6) S %DD=$TR(%DD," ",0) I %DD>31!(%DD<1) W *7 H 1 G %L1DAT S %MM=$TR(%MM," ",0) I %MM>12!(%MM<1) W *7 H 1 G %L1DAT S %HH=$TR(%HH," ",0) I %HH<90 W *7 H 1 G %L1DAT S %L1DAT=%HH_%MM_%DD S %L1DAT1=%DD_"."_%MM_"."_%HH K %HH,%MM,%DD G END - VV U 0:(0::::65) S %I=1 VR R *A Q:A=13&($L(%S)=6!('$L(%S))) I A=13&($L(%S)=1) S A=$A(%S),%S=0 W *8,0 G VM I A=13&($L(%S)=3) S A=$A($E(%S,3)),%S=$E(%S,1,2)_"0" W *8,0 G VM G:A=13 VR I A=127!(A=8) G:%S="" VV S A=32 G:%I'>$L(%S) VM D G VR .I $L(%S)=1 S %S="" W *8," ",*8 S %I=1 Q .S %S=$E(%S,1,%I-2) .I '(%I#2)!(%I>6) W *8," ",*8 .E W *8,*8," ",*8 .S %I=%I-1 I $L($ZB)=4,$D(%UPRCOD($ZB)),%UPRCOD($ZB)="LEVO" G:%I=1 VR S %I=%I-1 W *8 W:%I=2!(%I=4) *8 G VR I $L($ZB)=4,$D(%UPRCOD($ZB)),%UPRCOD($ZB)="PRAVO" G:%I>6!(%I-1>$L(%S)) VR S %I=%I+1 W %pravo W:%I=3!(%I=5) %pravo G VR I $L($ZB)=4,$D(%UPRCOD($ZB)),%UPRCOD($ZB)="VVERX" G:$L(%S)<6 VR S %TO="UP" Q I $L($ZB)=4,$D(%UPRCOD($ZB)),%UPRCOD($ZB)="VNIZ" G:$L(%S)<6 VR S %TO="DW" Q I A=0 R *A1:0 G VR I A=27 R *A1:0,*A2:0 G VR G:%I>6 VR I A<48!(A>57) G VR VM S %S=$E(%S,1,%I-1)_$C(A)_$E(%S,%I+1,6) W $C(A) W:'(%I#2)&(%I<6) %pravo S %I=%I+1 G VR Q - END X %XCL O 0:(:::::65) U $P:(NOECHO:NOWRAP) I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) Q %L2DBG %DEBUG ;BPS;INTERACTIVE DEBUGGING ROUTINE [ 04/16/99 3:11 AM ] [ 10/11/93 3:42 PM ] ;Copyright Micronetics Design Corp. @1988 U 0 N %I,%IO,%X,%Y,%Z S $ZT="ZG "_$ZL_":ERROR^%DEBUG" MENU ;DISPLAY MENU MENU0 ; W !?10,$P($P($ZV,","),"-")," - ","Interactive Debugging Utility",!?16,$ZHL(1,"dd-MON-yy")," ",$ZHL(2,"bh:mm P") MENU1 W !!,"Available options:",! F %I=0:1 S %Y=$P($T(TEXT+%I),";",2) Q:%Y="*" W !?4,%I+1," - ",%Y W !!,"Select option: " R %X G:%X="^Q" EXIT I %X=""!(%X="^") G EXIT I %X'?1N F %I=0:1 S %Y=$T(TEXT+%I) G:%Y["*" MENU2 I $ZB(%X,"_",1)=$E($ZB($P(%Y,";",2),"_",1),1,$L(%X)) W $E($P(%Y,";",2),$L(%X)+1,99) S %X=%I+1 Q S %Y=$T(TEXT+%X-1) G @($P(%Y,";",3)) MENU2 W:%X'="?" *7 W !!,"Enter the option number to select an option, or" W !,"Enter enough characters to identify the option, or" W !,"Enter '^' or '^Q' to exit the utility." G MENU1 ENABLE ;Enable Error and Ctrl-c Trapping D DBGIO G:%IO["^" MENU0 ZM 2:%IO V $V(280,$J,0)+112::1:2 ;errors V $V(280,$J,0)::1:2 ;V $V(280,$J,0)+128::1:2 ; ctrl-c ;V $V(280,$J,0)+64::1:2 ; line step W !!,"Debugging Environment Enabled" G EXIT DISABLE ;Disable Error Trapping S %Z=$V(280,$J,0) I %Z,$ZB($V(%Z,-3,2),#4,1) W !,"Cannot execute this request while running a program",! G EXIT W !!,"Debugging Environment Disabled" ZM 0:0 G EXIT RUN ;Interactively Debug a Routine S %Z=$V(280,$J,0) I %Z,$ZB($V(%Z,-3,2),#4,1) W !,"Cannot execute this request while running a program",! G EXIT S %Z=$ZT RUN1 ; S %X=$ZN ;R !!,"Enter Routine Name: ",%X G:%X=""!(%X="^") MENU0 G:%X="^Q"!(%X="^q") EXIT I %X="?" W !!,"Enter the name of the routine to be debugged.",!,"You may enter a routine name, or line^routine.",!,"Enter '^' to return to the previous question, or",!,"Enter '^Q' to exit the utility" G RUN1 S %Y=$P($S(%X["^":$P(%X,"^",2),1:%X),"("),$ZT="ZG "_$ZL_":RUNER^%DEBUG" S:%X'["^" %X="^"_%X I '$D(^ (%Y)) D I %Y W *7," ...Routine does not exist" S $ZT="ZG "_$ZL_":" G RUN1 .I $E(%Y)'="%" S %Y=1 Q .N VG S VG=+$P($ZU(""),",",2),%I=$$UCILIB^%VGUTIL2(VG,+$ZU("")) .S:'%I %I=1,VG=0 .I '$D(^|$ZU(%I,VG)| (%Y)) S %Y=1 Q .S %Y=0 Q X "S %Y=$T("_$P(%X,"(")_")" I %Y="" W *7," ...Line does not exist" S $ZT="ZG "_$ZL_":" G RUN1 S $ZT="ZG "_$ZL_":" I $V(280,$J,0) V $V(280,$J,0)+112::0:2 S %IO=$V($V(280,$J,0)+10,-3,2) E D DBGIO G:%IO["^" MENU0 ZM 2:%IO S %I=$V(280,$J,0) V %I+752::$L(%X):1,%I+752+1::%X:$L(%X):1 S $ZT="ZG "_$ZL_":RUN2^%DEBUG" I 1/0 RUN2 ; N %X,%I S %I=$V(280,$J,0) S $ZT="ZG "_$ZL_":",$ZS="" V %I::#8005:2,%I+112::1:2 S %X=$V(%I+752+1,-3,$V(%I+752,-3,1),1) D BRKPT(0,$P(%X,"(")) I $F(%X,"(") D @($$RUNR^%DEBUG) Q G @$$RUNR^%DEBUG RUNR() N ZZ V %I+645::0:1 S ZZ=%X K %X,%I,%IO,%Y,%Z Q ZZ RUNER W *7," ...Invalid entry reference" G RUN1 BRKPT(B,T) ;set break point B to T N BP,CMD,ENT,DSP,ROUT,%BRKPT,E,A,D S D=$V(280,$J,0) I 'D U 0 W *7,!,"BRKPT^%DEBUG: Debugging Environment not Active ***",! Q S %BRKPT(+B)=T G BRKSET^%DEBUGI1 DBGIO ;Get debug device IO1 S %IO="" ;;W !,"Debug device <",$I,">: " R %IO I %IO=""!(%IO=$I)!(%IO=0) S %IO=0 Q I %IO["^" Q I %IO="?" DO G IO1 .W !,"Enter the terminal device number which will be used for" .W !,"controlling the debugger. All debugging prompts and" .W !,"error messages will be directed to this device." .W !,"This feature can be used to debug full screen applications" .W !,"so that the contents of the screen are not disturbed." I %IO'?1.N W *7,!,"Device number must be numeric",! G IO1 I %IO=2!(%IO>19&(%IO<64))!((%IO>199)&(%IO<256)) W *7,!,"Invalid value...Terminal devices are 1,3-19,64-199,256 and up.",! G IO1 I $V(2*%IO+$V(5,-5),-3,2)#2 W *7," ...Device does not exist",! G IO1 I $V(4*%IO+$V(7,-5),-3,0)#2 W *7," ...Device does not exist",! G IO1 O %IO::1 E W *7," ...Device is in use",! G IO1 Q HELP ;Display HELP text S %HELP="HELP1" W # D ^%DEBUGI2 G MENU EXIT ;Exit Interactive Debugger Q ERROR ; I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q TEXT ;Run a Program;RUN ;Enable Debugging Environment;ENABLE ;Disable Debugging Environment;DISABLE ;HELP Information;HELP ;* %L2ERST0 %L1WE ; WINDOW ENGLISH ; %X1,%Y1,%X2,%Y2 - COORD WINDOW,%LS - LENGTH,%INV -INVERS [ 02/26/92 12:48 PM ] ; %X0,%Y0 - S %ZR=$R N (%UPRCOD,%XMSG,%S,%ZR,%L1WE) D ^%L1C U $P:(ECHO:WRAP) O 0:(0::::65) S:'$D(%S) %S="" N %INS S %INS=1 S:'$D(%X1) %X1=0 S:'$D(%X2) %X2=79 S:'$D(%Y1) %Y1=20 S:'$D(%Y2) %Y2=23 N %M,%I,%II,%XX,%YY,%C,%C1,%C2,%TOP,%X0,%Y0,%HBRY S:%X1<0 %X1=0 S:%X1>79 %X1=79 S:%Y1<0 %Y1=0 S:%Y1>23 %Y1=23 S:%X2<1 %X2=1 S:%X2>79 %X2=79 S:%Y2<1 %Y2=1 S:%Y2>24 %Y2=24 S:%X2<%X1 %X2=%X1 S:%Y2<%Y1 %Y2=%Y1 S:'$D(%LS) %LS=(%X2-%X1+1)*(%Y2-%Y1+1) S %S=$E(%S,1,%LS) S %I=1 ;F %II=1:1:$L(%S) S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) S %I=1 I $D(%INV) W %ENG,%CLI D CLEAR D P G:$D(%L1WE) END1 S %X0=%X1,%Y0=%Y1 POZ S %XX=%X0,%YY=%Y0 X %POSIC R *%C G:%C=13!($ZB=13) END I %C=25 S %TO="END" G END I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) I %C=27 R *%C1,*%C2 I %C2>0 S %C=%C1_%C2 I %C=0 D DELAY R *%C1:0 D DELAY R *%C2:0 I %C1>0 S %C="0"_%C1 I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) I %C>31&(%C<127) D VV G POZ G POZ ;- VV I $D(CIST),CIST'[$C(%C) W *7 Q I %INS D VSTAV S %XX=%X0,%YY=%Y0 X %POSIC S $E(%S,%I)=$C(%C) W $E(%S,%I) S:%I>%TOP %TOP=%I D RIGHT Q ;- CLEAR ; F %II=%Y1:1:%Y2 S %XX=%X1,%YY=%II X %POSIC W $J("",%X2-%X1+1) Q ;- P ; S %XX=%X1 F %II=%Y1:1:%Y2 S %YY=%II X %POSIC W $E(%S,(%X2-%X1+1)*(%II-%Y1)+1,(%X2-%X1+1)*(%II-%Y1+1)) Q P1 ; S %SSS=$E(%S,%I,255) W $E(%SSS,1,%X2-%X0+1) S %SSS=$E(%SSS,%X2-%X0+2,255) F %II=%Y0+1:1:%Y2 S %YY=%II,%XX=%X1 X %POSIC W $E(%SSS,1,%X2-%X1+1) Q:%SSS="" S %SSS=$E(%SSS,%X2-%X1+2,255) Q ;- RIGHT ; Q:%X0=%X2&(%Y0=%Y2)!(%I=%LS)!(%I>%TOP) I %X0=%X2 S %X0=%X1,%Y0=%Y0+1 E S %X0=%X0+1 S %I=%I+1 Q LEFT ; Q:%X0=%X1&(%Y0=%Y1)!(%I=1) I %X0=%X1 S %X0=%X2,%Y0=%Y0-1 E S %X0=%X0-1 S %I=%I-1 Q ENDS S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;- LEVO ; D LEFT G POZ PRAVO ; D RIGHT G POZ VVERX ; I %Y0=%Y1 S %X0=%X1,%I=1 G POZ S %Y0=%Y0-1,%I=%I-(%X2-%X1+1) G POZ VNIZ ; I %Y0=%Y2!(%I+(%X2-%X1+1)>%TOP) S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;S %X0=%X1+(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) S:%X0>%X2 %X0=%X2 G POZ S %Y0=%Y0+1,%I=%I+(%X2-%X1+1) G POZ CHISTS ; CHISTE S %TOP=%I-1 S:%TOP<1 %TOP=1 S %S=$E(%S,1,%TOP) D CLEAR,P G POZ INS S %INS=1-%INS S %SAY=$S(%INS:"INSERT",1:"OVERFLOW") X %XMSGV G POZ TAB I %I+10>%TOP S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 S %I=%I+10 S:%I>%LS %I=%LS G POZ1 TABN I %I-10<1 S %I=1 G POZ1 S %I=%I-10 POZ1 S %X0=%X1+(%I-.1#(%X2-%X1+1)+.1)-1,%Y0=%Y1+(%I-.1\(%X2-%X1+1)) S:%X0<%X1 %X0=%X1 S:%X0>%X2 %X0=%X2 G POZ ;- DEL G:%TOP=0 POZ F %II=%I:1:%TOP-1 S $E(%S,%II)=$E(%S,%II+1) S $E(%S,%TOP)=" " S %TOP=%TOP-1 I %I-1>%TOP D LEFT S %XX=%X0,%YY=%Y0 X %POSIC W " " G POZ D P1 ;D CLEAR,P G POZ ;- ADD G:%TOP+1>%LS POZ F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 D CLEAR,P G POZ VSTAV Q:%TOP+1>%LS F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 S %XX=%X0,%YY=%Y0 X %POSIC D P1 Q ;D CLEAR,P S %XX=%X0,%YY=%Y0 X %POSIC Q ;- ;- PGDN S %TO="DW" G END PGUP S %TO="UP" G END ESC S %TO="END" ; END S %S=$E(%S,1,%TOP) END1 O 0:(0:::::65) I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) X %XCL K CIS,%LS S %ZR=$D(@%ZR) Q ;- CHISTS G:%I=0 POZ S %TOP=%I-1 D CLEAR,P G POZ ;- DELAY F %II=1:1:400 Q %L2ERSTR %L1WE ; WINDOW ENGLISH ; %X1,%Y1,%X2,%Y2 - COORD WINDOW,%LS - LENGTH,%INV -INVERS [ 10.05.04 08:29 ] [ 08/25/97 8:59 AM ] ; %X0,%Y0 - I '$D(%POSIC) D ^%L1C U $P:(NOECHO:NOWRAP:ESCAPE) N %ECHO,%HBRY S %FHBR=0 S %TO="" S:'$D(%S) %S="" N %INS S %INS=1 S:'$D(%X1) %X1=0 S:'$D(%X2) %X2=79 S:'$D(%Y1) %Y1=20 S:'$D(%Y2) %Y2=23 N %M,%I,%II,%XX,%YY,%C,%C1,%C2,%TOP,%X0,%Y0,%HBRY S:%X1<0 %X1=0 S:%X1>79 %X1=79 S:%Y1<0 %Y1=0 S:%Y1>23 %Y1=23 S:%X2<1 %X2=1 S:%X2>79 %X2=79 S:%Y2<1 %Y2=1 S:%Y2>24 %Y2=24 S:%X2<%X1 %X2=%X1 S:%Y2<%Y1 %Y2=%Y1 S:'$D(%LS) %LS=(%X2-%X1+1)*(%Y2-%Y1+1) S %S=$E(%S,1,%LS) S %I=1 ;F %II=1:1:$L(%S) S %M(%I)=$E(%S,%II) S %I=%I+1 S %TOP=$L(%S) S %I=1 I $D(%INV) W %ENG,%CLI D CLEAR D P G:$D(%L1WE)!$D(%L1GET) END1 S %X0=%X1,%Y0=%Y1 POZ S %XX=%X0,%YY=%Y0 X %POSIC R *%C S ZB="" F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) ;;R *%C1:0 I %C1>0 S ZB=ZB_%C1 I $L(ZB)>3,$D(%UPRCOD(ZB)) G @%UPRCOD(ZB) G:%C=13 END ;I %C=25 G ESC ;I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) ;I %C=27 R *%C1:0 G:%C1<0 ESC R *%C2:0 I %C2>0 S %C=%C1_%C2 ;I %C=0 D DELAY R *%C1:0 D DELAY R *%C2:0 I %C1>0 S %C="0"_%C1 I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) I %C>31&(%C<127) D VV G POZ G POZ ESC S %TO="END" G END ;- VV I $D(CIST),CIST'[$C(%C) W *7 Q I %INS D VSTAV S %XX=%X0,%YY=%Y0 X %POSIC S $E(%S,%I)=$C(%C) W $E(%S,%I) S:%I>%TOP %TOP=%I D RIGHT Q ;- CLEAR ; F %II=%Y1:1:%Y2 S %XX=%X1,%YY=%II X %POSIC W $J("",%X2-%X1+1) Q ;- P ; S %XX=%X1 S %S=$E(%S,1,%TOP) F %II=%Y1:1:%Y2 S %YY=%II X %POSIC W $E(%S,(%X2-%X1+1)*(%II-%Y1)+1,(%X2-%X1+1)*(%II-%Y1+1)) Q P1 ; S %SSS=$E(%S,%I,255) W $E(%SSS,1,%X2-%X0+1) S %SSS=$E(%SSS,%X2-%X0+2,255) F %II=%Y0+1:1:%Y2 S %YY=%II,%XX=%X1 X %POSIC W $E(%SSS,1,%X2-%X1+1) Q:%SSS="" S %SSS=$E(%SSS,%X2-%X1+2,255) Q ;- RIGHT ; Q:%X0=%X2&(%Y0=%Y2)!(%I=%LS)!(%I>%TOP) I %FHBR W *8 Q I %X0=%X2 S %X0=%X1,%Y0=%Y0+1 E S %X0=%X0+1 S %I=%I+1 Q LEFT ; Q:%X0=%X1&(%Y0=%Y1)!(%I=1) I %X0=%X1 S %X0=%X2,%Y0=%Y0-1 E S %X0=%X0-1 S %I=%I-1 Q ENDS S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;- LEVO ; D LEFT G POZ PRAVO ; D RIGHT G POZ VVERX ; I %Y0=%Y1,%X0=%X1 S %TO="UP" G END I %Y0=%Y1 S %X0=%X1,%I=1 G POZ S %Y0=%Y0-1,%I=%I-(%X2-%X1+1) G POZ VNIZ ; I %Y0=%Y2!(%I+(%X2-%X1+1)>%TOP) S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 ;S %X0=%X1+(%TOP-.1#(%X2-%X1+1)+.1),%Y0=%Y1+(%TOP-.1\(%X2-%X1+1)) S:%X0>%X2 %X0=%X2 G POZ S %Y0=%Y0+1,%I=%I+(%X2-%X1+1) G POZ INS S %INS=1-%INS S %SAY=$S(%INS:"INSERT",1:"OVERFLOW") X %XMSGV G POZ TAB I %I+10>%TOP S %I=%TOP+1 S:%I>%LS %I=%LS G POZ1 S %I=%I+10 S:%I>%LS %I=%LS G POZ1 TABN I %I-10<1 S %I=1 G POZ1 S %I=%I-10 POZ1 S %X0=%X1+(%I-.1#(%X2-%X1+1)+.1)-1,%Y0=%Y1+(%I-.1\(%X2-%X1+1)) S:%X0<%X1 %X0=%X1 S:%X0>%X2 %X0=%X2 G POZ ;- DEL G:%TOP=0 POZ F %II=%I:1:%TOP-1 S $E(%S,%II)=$E(%S,%II+1) S $E(%S,%TOP)=" " S %TOP=%TOP-1 I %I-1>%TOP D LEFT S %XX=%X0,%YY=%Y0 X %POSIC W " " G POZ D P1 ;D CLEAR,P G POZ ;- ADD G:%TOP+1>%LS POZ F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 D CLEAR,P G POZ VSTAV Q:%TOP+1>%LS F %II=%TOP:-1:%I S $E(%S,%II+1)=$E(%S,%II) S $E(%S,%I)=" " S %TOP=%TOP+1 S %XX=%X0,%YY=%Y0 X %POSIC D P1 Q ;D CLEAR,P S %XX=%X0,%YY=%Y0 X %POSIC Q ;- ;- HOME S %X0=%X1,%Y0=%Y1,%I=1 G POZ PGDN S %TO="DW" G END PGUP S %TO="UP" G END FIND S %TO="F8" G END COR S %TO="F7" G END SAVE S %TO="F9" G END ADDL S %TO="F5" D ADDL^%L1ZMSL G END DELL S %TO="F6" G END REST G:'$D(%L1SF) POZ G:'$D(NM) POZ S %SOLD=%S D D VSVALL^%L1SF,PODVAL^%L1SF S %L1GET="",HZG=1 D ^%L1SFZ K %L1GET S %S=%SOLD,%INV=1 G %L1WE .I %S?.E1"D ".U.N1"^".E S $ZS="<>^"_$P($P($P(%S,"D ",2),"^",2)," ") .;N (%UPRCOD,%XMSG,%XMSGV,%XMSGN) X ^%ERG .S %PR=$P($P($P(%S,"D ",2),"^",2)," "),U=1 .S %DLM=$S($E(%S,1,2)="D ":"D ",1:" D ") .S %LB=$P($P(%S,%DLM,2),"^",1) .I $L(%LB) N I,T X "ZL @%PR F I=1:1 S T=$T(+I) Q:T="""" Q:$P(T,"" "")=%LB" I T'="" S U=I .S %L1ER="",%FLI=1 X %XCL X ^%ERG(2) K %L1ER END S %S=$E(%S,1,%TOP) END1 U $P X %XCL K CIS,%LS Q ;- CHISTS G:%I=0 POZ S %TOP=%I-1 D CLEAR,P G POZ ;- DELAY F %II=1:1:400 Q MDRG S %FHBR='%FHBR I %FHBR S %FLINS=1 W *27,7 S %SAY="HEBREW TEXT" X %XMSGV W *27,8 S %HBRY="" W %HBR G POZ W *27,7 S %SAY="ENGLISH TEXT" X %XMSGV W *27,8 G POZ HBR I '$D(%HBRY) S %HBRY="" W %HBR D P G POZ K %HBRY W %ENG D P G POZ %L2GTR %L2GTR ; SEND GLOBALS [ 04.06.07 15:20 ] [ 13.05.07 07:30 ] [ 12.05.07 21:38 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,USERPHONE,USERPORT,USERGLOB,USERMOD,ER,%L1RCV,%L2NALAN,%SCKPORT,%L3GTR) S $ZS="" D ^%L1C S ZT=$ZT,ER=0,SH=0 S $ZT="ZG "_$ZL_":SVER^%L1X" D ^%L1C S %MXDL=500 S %US="U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13,10))" I $D(%SCKPORT) S %US=%SCKPORT("USE"),USERPORT=%SCKPORT K ^L2G($J) K ^A I $D(%L2NALAN) M ^L2G($J,"NALAN")=%L2NALAN ; I '$D(%L1RCV) U 0 D .S %VG=20,%NG=22,%LG=5,%RG=75 .S %L1RBCL=%CV("CF") ; -- ADD .W %LIGHT1 D TV^%L1RBUA(20,5,24,76) X %XCL ; -- ADD .D SCALE0(70) ; K ^%L1GTER($J) I '$D(USERMOD) S USERMOD=1 Q:'$D(USERPORT)&$D(%L1RCV) S PRT=$J ; I $D(USERPORT) S PORTN=USERPORT E I '$D(%L1RCV) S %GET=" I/O PORT > ++12,10,EE#++2,E,I" D ^%L1GET S PORTN=%S ; S BUF=2550 S SOT=$C(4),STX=$C(2),ETX=$C(3) ; I $D(^GTR000(PRT)),'$D(%L1RCV) U 0 K %Q S %Q("Z")=" mcew wqtp didy xeciy jiyndl ",%Q("X")=10,%Q("Y")=4 D ^%S2ASK I YES G IN01 K ^GTR000(PRT) I '$D(USERGLOB),$D(%L1RCV) Q ; I $$NALAN=1 D G IN0 .S FILEGT=$$^%L1ENVAR("gtm_dist")_"/GTR."_PRT .C FILEGT:(DELETE) .O FILEGT:(NEWVERSION:WRITE:BLOCK=2048:RECORD=2044) ; I $D(USERGLOB) G IN0 K ^UTILITY($J) U $P:(ECHO:WRAP) D ^%GSEL U $P:(NOECHO:NOWRAP) ; IN0 S GNAME="" F S GNAME=$O(^UTILITY($J,GNAME)) Q:GNAME="" D .S MAC=$S($E(GNAME)'="^":"^",1:"")_GNAME .I $$NALAN'=1 D GLSV Q . .D GLSVN(GNAME) ; I $$NALAN=1 C FILEGT G M ; IN01 I $D(^GTR000(PRT))<10 D:'$D(%L1RCV) S ER=1000 G ERREND .D MSG("NO GLOBALS FOR TRANSMISSION",3,2) ; M S ER=0,SH=0 I '$$NALAN O PORTN::120 E S ER=1001 G ERREND ; S ^L2G($J,"PORTN")=PORTN S ^L2G($J,"US")=%US ; I $$NALAN=1 S GNLAST=1 D FAST G:ER>999 ERREND G EXCV ; S GNLAST=0 S GNAME="" F S GNAME=$O(^GTR000(PRT,GNAME)) Q:GNAME="" D I 'ER S ^L2G($J,"OK",GNAME)=1,^L2G($J,"OK",GNAME,"TIME")=$H .I '$D(%L1RCV) D MSG("--"_GNAME,1) .I $O(^GTR000(PRT,GNAME))="" S GNLAST=1 .S OKSND=0,SUMBCC=0 D SETSTR ; I ER>999 G ERREND ; EXCV I $$NALAN'=1 D WSTR($C(5)_"SOF"_$C(6)) ; S ^L2G($J,"OK")=1,^L2G($J,"OKTIME")=$H ; I '$D(%L1RCV) D .D SCALE(1,1,70) .I '$D(%L1RCV) D MSG("********** TRANSMISSION SUCCESFUL **********",3) ; K USERPHONE,USERPORT,USERGLOB S $ZT=$G(ZT) ; EXIT Q ;- ERREND ; I $ZS'="" S ER=10000 D SVER^%L1X S $ZT=$G(ZT) D ER S ^%L1GTER($J)=ER_"~"_$P($ZS,",",3) I $$NALAN'=1 D WSTRE($C(5)_"SOF"_$C(6)) K USERPHONE,USERPORT,USERGLOB S $ZT=$G(ZT) I '$D(%L1RCV) D MSG("********** TRANSMISSION ERROR (ER="_ER_") **********",3,3) Q ;- SETSTR ; S ER=0 S N=-1 S N=$N(^GTR000(PRT,GNAME,N)) I N'=-1 D SET I ER=10000 G ENDP ; I N>0,ER<1000 G SETSTR ; I $L($G(GNAME)) K ^GTR000(PRT,GNAME) ENDP Q ;- SET S (CNER,CNER1)=0 ; S1 S STRG=^GTR000(PRT,GNAME,N) S2 S OK=1,ER=0 S21 S STROUT=SOT_$G(GNAME)_"*"_+$G(N)_"*"_$L(STRG)_"*"_$$^%L1ZCRC(STRG,1)_STX_STRG S BCC=$$^%L1ZCRC($E(STROUT,2,$L(STROUT)),1) S SUMBCC=SUMBCC+BCC S STROUT=STROUT_ETX_BCC ; D W(STROUT) ; S SH=SH+1 S ^L2G($J,"SH",SH)=STROUT ; I $$NALAN=2,STROUT'[$C(5),STROUT'[$C(6),'ER G S3 ; ; ---- $$NALAN '=2 OR END OF GLOB ------ D READ I ER>999 D ER Q ; S ^L2G($J,"SH",SH,"IN")=$E(ANS1,1,400) S ^L2G($J,"SH",SH,"SUMBCC")=+SUMBCC ; I $G(ANS1)="",STROUT'["SOF" D Q .S OK=0 S ER=3,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1003 ; I $G(ANS1)="",STROUT[($C(5)_"SOF"_$C(6)) D G ENDST .I $$NALAN=2 D ..S ^L2G($J,"BCCOK")="OK" ..D WOK ; I ANS1=STROUT S ER=31,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1031 Q ; S ER=0 I $$NALAN=2,+SUMBCC'=+$P(ANS1,ETX,2) S ER=41,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1041 Q I $$NALAN=2,+SUMBCC=+$P(ANS1,ETX,2) D S SUMBCC=0 G S3 .S ^L2G($J,"BCCOK1")="OK" .D WOK ; ; ---- $$NALAN'=2 I BCC'=$P(ANS1,ETX,2) D Q .S ER=4,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1004 S SUMBCC=0 Q ; I 'OK S CNER1=CNER1+1 D ER G:CNER1<6 S2 S ER=1010 Q ; S3 S OK=1,CNER1=0 I '$D(%L1RCV) D .Q:(N#100) .D SCALE(N,$O(^GTR000(PRT,GNAME,999999),-1)+1,70) X %US K ^GTR000(PRT,GNAME,N) ; ENDST ; X %US Q ;- ; ER ; I '$D(%L1RCV) D MSG("ERR: "_ER,3,2) X %US S ^L2G($J,"ER",+$G(SH))=ER_"~"_$G(GNAME)_"~"_$H I ER>999 S ^%L1GTER($J)=ER Q ;- DEB Q:$D(%L1RCV) U 0 F J=1:1:$L(SS) W $$^%L1ZH($A($E(SS,J)))_" " U 0 W ! X %US Q GLSV ; S %LENGTH=0 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 I '$D(%L1RCV) D MSG(MAC,1) S CHKS=0 S %MAC2=$R S:$R[")" %MAC2=$E($R,1,$L($R)-1) S II=0 I %PR D .S (GT1,^GTR000(PRT,GNAME,1))=MAC .S (GT2,^GTR000(PRT,GNAME,2))=@MAC .S II=2,CHKS=CHKS+$$^%L1ZCRC(GT1,1)+$$^%L1ZCRC(GT2,1) K GT1,GT2 ; S %MAC1=MAC S %MAC1=$Q(@%MAC1) I %MAC1="",'$D(%L1RCV) W:%PR=0 *7,!?15,"*** ARRAY ",MAC," HASN'T NODES !" Q PR F Q:%MAC1'[%MAC2 Q:%MAC1="" Q:%LENGTH D .S II=II+1 S (GT,^GTR000(PRT,GNAME,II))=%MAC1,CHKS=CHKS+$$^%L1ZCRC(GT,1) .S II=II+1,(GT,^GTR000(PRT,GNAME,II))=$G(@%MAC1,$C(7)) .S CHKS=CHKS+$$^%L1ZCRC(GT,1) S:$L(GT)>(%MXDL-20) %LENGTH=1 .S %MAC1=$Q(@%MAC1) ; S II=II+1 S ^GTR000(PRT,GNAME,II)=$C(5)_$S($O(^UTILITY($J,GNAME))="":"END",1:"ENDG")_"*"_GNAME_"*"_II_"*"_CHKS_$C(6) END K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 Q ; ZT D ERREND G EXIT ; READ ; N A I $$NALAN'=1 X %US D Q .N FIRST S FIRST=1 .S ANS1="" N TIME S TIME=6 RD .N %JJ F %JJ=1:1:255 R *A:TIME Q:A<0 Q:A=27 Q:A=13 Q:A=10 Q:A=12 Q:A=0 D ..S ^A($O(^A(999999),-1)+1)=A ..S ANS1=ANS1_$C(A),TIME=1 .I A<0 S ER=1009 Q .I ANS1="",FIRST S FIRST=0 G RD .S ^A($O(^A(999999),-1)+1,"ANS1")=ANS1 ; ;------------------------- $$NALAN = 1 N H0,A1,TIME,SOFR S SOFR=$S($$NALAN:12,1:13) X %US ; S ANS1="" S H0=$P($H,",",2) S TIME=2 X %US F R *A:TIME Q:A=3 Q:'$T Q:$P($H,",",2)-H0>2 Q:A'=3 S TIME=1 S ANS1=$C(3) F R *A:TIME Q:A=SOFR Q:'$T D Q:$L(ANS1)>200 .S:A'=13&(A'=10)&(A'=12) ANS1=ANS1_$C(A) E Q I $L(ANS1)>200 S ANS1="" I 1 Q ; FAST ; N %PR,GT,GT1,GT2,MAC,%MAC1,%MAC2,%II,II,CRC,%SIZE,%STRING S %SIZE=$P($$^%L1FLP(FILEGT),"^",2) X %US W $C(4,251) O FILEGT:(READONLY:REWIND) S %STRING="" K ^L2G($J,"ERFAST") ; S ER=0 F %II=1:1 U FILEGT R *A Q:$ZEOF D I ER S ER=1020 Q .S:A=12 A=212 .S:A=10 A=210 .S:A=13 A=213 .S %STRING=%STRING_$C(A) .I $L(%STRING)=$G(^%L2G("BLOCK"),1000) D WBL S %STRING="" ; I $L(%STRING),'ER D WBL S %STRING="" ; C FILEGT ;;I $$^%L1ZOS(2,FILEGT) I ER S ER=1000+ER Q X %US W $C(251) I 'ER W "OK" I GNLAST W $C(5)_"SOF"_$C(6) D ENDLINE Q WR(GT) ; U FILEGT W GT,! S %II=%II+1 Q WBL ; S %RPT=0 WBL1 S %RPT=%RPT+1,CRC=0 X %US F %II1=1:1:$L(%STRING) S %SMB=$E(%STRING,%II1) W %SMB D .S CRC=CRC+(%II1*$A(%SMB)) ; S ^L2G($J,"FAST",%II,"CRC")=CRC X %US W $C(3),CRC D ENDLINE ;;G WBL2 R ANS1 ; D READ I ANS1[$C(3) S ANS1=$P(ANS1,$C(3),2) I ANS1[$C(12) S ANS1=$P(ANS1,$C(12)) I +ANS1'=+CRC H:'(%RPT#3) 1 G:%RPT<6 WBL1 S ER=$S(ANS1="":3,1:4) S ^L2G($J,"ERFAST")=CRC_"<>"_ANS1 S ^L2G($J,"FAST",%II,"CRCBACK")=ANS1 Q:ER WBL2 I '$D(%L1RCV),$D(%L3GTR) D .Q:(%II#10000) .D SCALE^%L3GTR(%II,%SIZE,70) X %US Q GLSVN(GNAME) ; N %PR,GT,GT1,GT2,MAC,%MAC1,%MAC2,%II,II,CRC,%SIZE,%STRING S MAC=$S($E(GNAME)'="^":"^",1:"")_GNAME S CRC=0,%II=0 S %PR=0 I ($D(@MAC)#10)'=0 S %PR=1 S %MAC2=$R S:$R[")" %MAC2=$E($R,1,$L($R)-1) I $E(%MAC2,1,2)="^|" S %MAC2="^"_$P(%MAC2,"|",3,255) I %PR S GT1=MAC,GT2=@MAC D WR(GT1),WR(GT2) S %MAC1=MAC S %MAC1=$Q(@%MAC1) F Q:%MAC1'[%MAC2 Q:%MAC1="" D S %MAC1=$Q(@%MAC1) .S GT=%MAC1 D WR(GT) .S GT=$G(@%MAC1) D WR(GT) Q NALAN(STAM) ; I $D(%L2NALAN) Q 2 I $D(%SCKPORT) Q 2 Q 0 ENDLINE W !# Q SCALE0(LN) ; D SCALE0^%L3GTR(LN) Q SCALE(N,MAX,LN) ; D SCALE^%L3GTR(N,MAX,LN) Q MSG(TXT,NOM,DELAY) ; Q:$D(%L1RCV) U $P:(NOECHO:NOWRAP) S %YY=%VG+NOM-1,%XX=%LG+12 X %POSIC W %LIGHT1,$$ENG^%L1FRM(TXT,%RG-%LG-20) X %XCL I $G(DELAY) H DELAY Q WSTR(TXT) ; N GNAME,STRG,N S GNAME=" " S STRG=$C(5)_"SOF"_$C(6),(CNER,CNER1)=0 S N=0 D S2 Q WSTRE(TXT) ; N GNAME,STRG,N S GNAME=" " S STRG=$C(5)_"SOF"_$C(6),(CNER,CNER1)=0 S N=0 D S21 Q WOK ; X %US D CLEAR W "OK",! Q W(STROUT) ; X %US I '$$NALAN D W0(STROUT) Q I $$NALAN=1 D W1(STROUT) Q I $$NALAN=2 D W2(STROUT) Q Q W0(STROUT) ; I '$D(BUF) S BUF=2550 F JJ=1:1:BUF R *Z:0 W STROUT,! Q W1(STROUT) ; W STROUT,! Q W2(STROUT) ; W STROUT,! Q CLEAR ; N A F R *A:0 Q:A<1 Q %L2GTR0 %L2GTR ; SEND GLOBALS [ 10.08.06 09:48 ] [ 09.05.06 06:58 ] [ 28.02.06 13:52 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,USERPHONE,USERPORT,USERGLOB,USERMOD,ER,%L1RCV,%L2NALAN,%SCKPORT,%L3GTR) S $ZS="" D ^%L1C S ZT=$ZT,ER=0,SH=0 S $ZT="ZG "_$ZL_":SVER^%L1X" D ^%L1C S %MXDL=500 S %US="U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13,10))" I $D(%SCKPORT) S %US=%SCKPORT("USE"),USERPORT=%SCKPORT ; I '$D(%L1RCV) U 0 D .S %VG=20,%NG=22,%LG=5,%RG=75 .S %L1RBCL=%CV("CF") ; -- ADD .W %LIGHT1 D TV^%L1RBUA(20,5,24,76) X %XCL ; -- ADD .D SCALE0(70) ; K ^%L1GTER($J) I '$D(USERMOD) S USERMOD=1 Q:'$D(USERPORT)&$D(%L1RCV) S PRT=$J ; I $D(USERPORT) S PORTN=USERPORT E I '$D(%L1RCV) S %GET=" I/O PORT > ++12,10,EE#++2,E,I" D ^%L1GET S PORTN=%S ; S BUF=2550 S SOT=$C(4),STX=$C(2),ETX=$C(3) I $D(^GTR000(PRT)),'$D(%L1RCV) U 0 K %Q S %Q("Z")=" mcew wqtp didy xeciy jiyndl ",%Q("X")=10,%Q("Y")=4 D ^%S2ASK I YES G IN01 K ^GTR000(PRT) I '$D(USERGLOB),$D(%L1RCV) Q ; I $$NALAN=1 D G IN0 .S FILEGT=$$^%L1ENVAR("gtm_dist")_"/GTR."_PRT .C FILEGT:(DELETE) .O FILEGT:(NEWVERSION:WRITE:BLOCK=2048:RECORD=2044) ; I $D(USERGLOB) G IN0 K ^UTILITY($J) U $P:(ECHO:WRAP) D ^%GSEL U $P:(NOECHO:NOWRAP) IN0 S GNAME="" F S GNAME=$O(^UTILITY($J,GNAME)) Q:GNAME="" S MAC=$S($E(GNAME)'="^":"^",1:"")_GNAME D .I $$NALAN'=1 D GLSV Q .D GLSVN(GNAME) ; I $$NALAN=1 C FILEGT G M ; IN01 I $D(^GTR000(PRT))<10 D:'$D(%L1RCV) S ER=1000 G ERREND .D MSG("NO GLOBALS FOR TRANSMISSION",3,2) ; M S ER=0,SH=0 K ^L2G($J) I '$$NALAN O PORTN::120 E S ER=1001 G ERREND S ^L2G($J,"PORTN")=PORTN S ^L2G($J,"US")=%US ; I $$NALAN=1 S GNLAST=1 D FAST G:ER>999 ERREND G EXCV ; S GNLAST=0 S GNAME="" F S GNAME=$O(^GTR000(PRT,GNAME)) Q:GNAME="" D I 'ER S ^L2G($J,"OK",GNAME)=1,^L2G($J,"OK",GNAME,"TIME")=$H .I '$D(%L1RCV) D MSG("--"_GNAME,1) .I $O(^GTR000(PRT,GNAME))="" S GNLAST=1 .S OKSND=0,SUMBCC=0 D SETSTR ; I ER>999 G ERREND ; EXCV I $$NALAN'=1 S GNAME=" " S STRG=$C(5)_"SOF"_$C(6),(CNER,CNER1)=0 S N=0 D S2 S ^L2G($J,"OK")=1,^L2G($J,"OKTIME")=$H I '$D(%L1RCV) D .D SCALE(1,1,70) .I '$D(%L1RCV) D MSG("********** TRANSMISSION SUCCESFUL **********",3) K USERPHONE,USERPORT,USERGLOB S $ZT=$G(ZT) ; EXIT Q ;- ERREND ; I $ZS'="" S ER=10000 D SVER^%L1X S $ZT=$G(ZT) D ER S ^%L1GTER($J)=ER_"~"_$P($ZS,",",3) I $$NALAN'=1 S GNAME=" " S STRG=$C(5)_"SOF"_$C(6),(CNER,CNER1)=0 S N=0 D S21 K USERPHONE,USERPORT,USERGLOB S $ZT=$G(ZT) I '$D(%L1RCV) D MSG("********** TRANSMISSION ERROR (ER="_ER_") **********",3,3) Q ;- SETSTR ; S ER=0 S N=-1 S N=$N(^GTR000(PRT,GNAME,N)) I N'=-1 D SET I ER=10000 G ENDP ; I N>0,ER<1000 G SETSTR ; I $L($G(GNAME)) K ^GTR000(PRT,GNAME) ENDP Q ;- SET S (CNER,CNER1)=0 ; S1 S STRG=^GTR000(PRT,GNAME,N) S2 S OK=1,ER=0 S21 S STROUT=SOT_$G(GNAME)_"*"_+$G(N)_"*"_$L(STRG)_"*"_$$^%L1ZCRC(STRG,1)_STX_STRG ;;S BCC=$$^%L1ZCRC($E(STROUT,2,%MXDL),1) S BCC=$$^%L1ZCRC($E(STROUT,2,$L(STROUT)),1) S SUMBCC=SUMBCC+BCC S STROUT=STROUT_ETX_BCC ; X %US ; I '$$NALAN D .I '$D(BUF) S BUF=2550 .F JJ=1:1:BUF R *Z:0 .W STROUT,! ; I $$NALAN W STROUT,! ; S SH=SH+1 S ^L2G($J,"SH",SH)=STROUT ; I $$NALAN=2,STROUT'[$C(5),STROUT'[$C(6),'ER G S3 I $$NALAN W # ; D READ I ER>999 D ER Q I $G(ANS1)="" S OK=0 S ER=3,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1003 Q S ^L2G($J,"SH",SH,"IN")=$E(ANS1,1,400) I ANS1=STROUT S ER=31,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1031 Q S ER=0 I $$NALAN=2,SUMBCC'=$P(ANS1,ETX,2) S ER=41,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1041 Q I $$NALAN=2,SUMBCC=$P(ANS1,ETX,2) X %US W $C(3)_"OK"_$C(3),#! S SUMBCC=0 G S3 ; I BCC'=$P(ANS1,ETX,2) S ER=4,CNER=CNER+1 D ER G:CNER<5 S2 S ER=1004 S SUMBCC=0 Q I 'OK S CNER1=CNER1+1 D ER G:CNER1<6 S2 S ER=1010 Q S3 S OK=1,CNER1=0 ; I '$D(%L1RCV) D .Q:(N#100) .D SCALE(N,$O(^GTR000(PRT,GNAME,999999),-1)+1,70) X %US K ^GTR000(PRT,GNAME,N) ENDST ; X %US Q ;- ER ; I '$D(%L1RCV) D MSG("ERR: "_ER,3,2) X %US S ^L2G($J,"ER",+$G(SH))=ER_"~"_$G(GNAME)_"~"_$H I ER>999 S ^%L1GTER($J)=ER Q ;- DEB Q:$D(%L1RCV) U 0 F J=1:1:$L(SS) W $$^%L1ZH($A($E(SS,J)))_" " U 0 W ! X %US Q GLSV ; S %LENGTH=0 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 I '$D(%L1RCV) D MSG(MAC,1) S CHKS=0 S %MAC2=$R S:$R[")" %MAC2=$E($R,1,$L($R)-1) S II=0 I %PR S (GT1,^GTR000(PRT,GNAME,1))=MAC,(GT2,^GTR000(PRT,GNAME,2))=@MAC S II=2,CHKS=CHKS+$$^%L1ZCRC(GT1,1)+$$^%L1ZCRC(GT2,1) K GT1,GT2 S %MAC1=MAC S %MAC1=$Q(@%MAC1) I %MAC1="",'$D(%L1RCV) W:%PR=0 *7,!?15,"*** ARRAY ",MAC," HASN'T NODES !" Q S ^L2G($J,GNAME,"MAC1")=%MAC1 S ^L2G($J,GNAME,"MAC2")=%MAC2 PR F Q:%MAC1'[%MAC2 Q:%MAC1="" Q:%LENGTH S II=II+1 S (GT,^GTR000(PRT,GNAME,II))=%MAC1,CHKS=CHKS+$$^%L1ZCRC(GT,1),II=II+1,(GT,^GTR000(PRT,GNAME,II))=$G(@%MAC1,$C(7)) S CHKS=CHKS+$$^%L1ZCRC(GT,1) S:$L(GT)>(%MXDL-20) %LENGTH=1 S %MAC1=$Q(@%MAC1) ;;I %LENGTH D:'$D(%L1RCV) K ^GTR000(PRT,GNAME) G END .D MSG("*** A NODE TOO LONG :"_%MAC1,3,2) D MSG(GT,4) S II=II+1 S ^GTR000(PRT,GNAME,II)=$C(5)_$S($O(^UTILITY($J,GNAME))="":"END",1:"ENDG")_"*"_GNAME_"*"_II_"*"_CHKS_$C(6) END K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 Q ZT D ERREND G EXIT READ ; I $$NALAN'=1 X %US R ANS1:6 Q ; N H0,A,A1,TIME,SOFR S SOFR=$S($$NALAN:12,1:13) X %US ; S ANS1="" S H0=$P($H,",",2) S TIME=2 X %US F R *A:TIME Q:A=3 Q:'$T Q:$P($H,",",2)-H0>2 Q:A'=3 S TIME=1 S ANS1=$C(3) F R *A:TIME Q:A=SOFR Q:'$T D Q:$L(ANS1)>200 .S:A'=13&(A'=10)&(A'=12) ANS1=ANS1_$C(A) E Q I $L(ANS1)>200 S ANS1="" I 1 Q FAST ; N %PR,GT,GT1,GT2,MAC,%MAC1,%MAC2,%II,II,CRC,%SIZE,%STRING ; S %SIZE=$P($$^%L1FLP(FILEGT),"^",2) X %US W $C(4,251) O FILEGT:(READONLY:REWIND) S %STRING="" K ^L2G($J,"ERFAST") ; S ER=0 F %II=1:1 U FILEGT R *A Q:$ZEOF D I ER S ER=1020 Q .S:A=12 A=212 .S:A=10 A=210 .S:A=13 A=213 .S %STRING=%STRING_$C(A) .I $L(%STRING)=$G(^%L2G("BLOCK"),1000) D WBL S %STRING="" ; I $L(%STRING),'ER D WBL S %STRING="" ; C FILEGT ;;I $$^%L1ZOS(2,FILEGT) I ER S ER=1000+ER Q X %US W $C(251) I 'ER W "OK" I GNLAST W $C(5)_"SOF"_$C(6) D ENDLINE Q WR(GT) ; U FILEGT W GT,! S %II=%II+1 Q WBL ; S %RPT=0 WBL1 S %RPT=%RPT+1,CRC=0 X %US F %II1=1:1:$L(%STRING) S %SMB=$E(%STRING,%II1) W %SMB D .S CRC=CRC+(%II1*$A(%SMB)) ; S ^L2G($J,"FAST",%II,"CRC")=CRC X %US W $C(3),CRC D ENDLINE ;;G WBL2 R ANS1 ; D READ I ANS1[$C(3) S ANS1=$P(ANS1,$C(3),2) I ANS1[$C(12) S ANS1=$P(ANS1,$C(12)) I +ANS1'=+CRC H:'(%RPT#3) 1 G:%RPT<6 WBL1 S ER=$S(ANS1="":3,1:4) S ^L2G($J,"ERFAST")=CRC_"<>"_ANS1 S ^L2G($J,"FAST",%II,"CRCBACK")=ANS1 Q:ER WBL2 I '$D(%L1RCV),$D(%L3GTR) D .Q:(%II#10000) .D SCALE^%L3GTR(%II,%SIZE,70) X %US Q GLSVN(GNAME) ; N %PR,GT,GT1,GT2,MAC,%MAC1,%MAC2,%II,II,CRC,%SIZE,%STRING S MAC=$S($E(GNAME)'="^":"^",1:"")_GNAME S CRC=0,%II=0 S %PR=0 I ($D(@MAC)#10)'=0 S %PR=1 S %MAC2=$R S:$R[")" %MAC2=$E($R,1,$L($R)-1) I $E(%MAC2,1,2)="^|" S %MAC2="^"_$P(%MAC2,"|",3,255) I %PR S GT1=MAC,GT2=@MAC D WR(GT1),WR(GT2) S %MAC1=MAC S %MAC1=$Q(@%MAC1) F Q:%MAC1'[%MAC2 Q:%MAC1="" D S %MAC1=$Q(@%MAC1) .S GT=%MAC1 D WR(GT) .S GT=$G(@%MAC1) D WR(GT) Q NALAN(STAM) ; I $D(%L2NALAN) Q 2 I $D(%SCKPORT) Q 2 Q 0 ENDLINE W !# Q SCALE0(LN) ; D SCALE0^%L3GTR(LN) Q SCALE(N,MAX,LN) ; D SCALE^%L3GTR(N,MAX,LN) Q MSG(TXT,NOM,DELAY) ; Q:$D(%L1RCV) U $P:(NOECHO:NOWRAP) S %YY=%VG+NOM-1,%XX=%LG+12 X %POSIC W %LIGHT1,$$ENG^%L1FRM(TXT,%RG-%LG-20) X %XCL I $G(DELAY) H DELAY Q %L2GTR1 %L2GTR1 ;NEW PROGRAM [ 13.05.07 07:02 ] [ 07.08.06 15:28 ] [ 28.02.06 12:51 ] N (%UPRCOD,%XMSG,USERPORT,USERMOD,%L2G1,%SCKPORT) N $ZT S $ZT="ZG "_$ZL_":SVER^%L1X" D ^%L1C S %MXDL=440 I '$D(USERMOD) S USERMOD=1 I '$D(USERPORT) S USERPORT=$P ; S DEV=USERPORT ; I $$NALAN(DEV)=1 S UD=%SCKPORT("USE"),DEV=%SCKPORT I $$NALAN(DEV)'=1 S UD="U DEV:(NOECHO:NOWRAP:PASTHRU:NOCENABLE:TERM=$C(13,10))" S PRT=$J ; I $$NALAN(DEV) D .S %L2G1("NOCLOSE")="" .S PRT=$J ; I '$D(%L2G1("CONT")) K ^GTR100(PRT) ; ZP I '$$NALAN(DEV) S DEV=USERPORT O DEV::60 E S END=2 G END ; PORT ; K ^L2G1($J) S ^L2G1($J)=$H S END=0,SH=0,CNOLD=+$G(^L2G1($J,"CNOLD")) S BCCSUM=0,GNAMEOLD=$G(^L2G1($J,"GNAME")),STROUT="" S BEG=1 S H1=$P($H,",",2),BG0=0 X UD F R *BG:$G(%L2G1("TIME"),300) S:BG=0 BG0=BG0+1 S:BG BG0=0 D:BG=4 S:BG=-1&'$D(%L2G1("NOWAIT"))!(BG0>500) END=2 Q:END .I $G(%L2G1("TIME"))&($$H(H1)>$G(%L2G1("TIME"))) S END=2 Q .D READ Q:END ; --> STR . .S H1=$P($H,",",2) .S ST1=$P(STR,$C(2)),STRG=$P($P(STR,$C(2),2,240),$C(3),1,$L(STR,$C(3))-1) .S GNAME=$P(ST1,"*"),CN=$P(ST1,"*",2),DL=$P(ST1,"*",3) .I CN=1 S CNOLD=0,GNAMEOLD="" .S SH=SH+1 S ^L2G1($J,"SH",SH)=$E(STR,1,%MXDL) .I $D(%L2G1("DISP")) D ..I GNAME'=$G(GNAMEOLD) D MSG(GNAME) ..I '(SH#10) D MSH(SH) . .S ZCRC=$$^%L1ZCRC($P(STR,$C(3),1,$L(STR,$C(3))-1),1) .S BCCSUM=BCCSUM+ZCRC .S OUT=$C(3)_ZCRC . .X UD .I '$$NALAN(DEV) D ..F I=1:1:%DELAY R *A:0 ..W OUT_$C(13) ..S ^L2G1($J,"SH",SH,"OUT")=OUT . .I $$NALAN(DEV),$$ENDGL(STRG) D I ANS'["OK" G NEXT ..W $C(3)_BCCSUM,#! R ANS:5 ..S ^L2G1($J,"SH",SH,"OUT")=BCCSUM ..S ^L2G1($J,"SH",SH,"IN")=ANS . .I GNAMEOLD="" S GNAMEOLD=GNAME . .I $$ENDGL(STRG) D ..I STRG["SOF",GNAMEOLD'="",$D(^GTR100(PRT,GNAMEOLD)) N GNAME S GNAME=GNAMEOLD ..D ZAP . NEXT .I $$ENDGL(STRG) D S:STRG["SOF" END=1 Q ..S END=0,CNOLD=0,BCCSUM=0,GNAMEOLD="" ..K ^GTR100(PRT,GNAME) . .S CNOLD=CN,GNAMEOLD=GNAME .S ^L2G1($J,"CNOLD")=CN,^L2G1($J,"GNAME")=GNAME,^L2G1($J,"BCCSUM")=BCCSUM .I $L(GNAME),CN S ^GTR100(PRT,GNAME,CN)=STRG .S BEG=0 Q ; END ; I $G(END)=1,$P($ZS,",",3)="" D .S ^L2G1($J,"OK")=1,^L2G1($J,"OKTIME")=$H .D MSG("DONE") H 1 ; I $ZS'="" D SVER^%L1X I $$NALAN(DEV),$D(%L2G1("DISP")) U $P:(CENABLE) I $D(%L2G1("NOCLOSE")) K %L2G1 Q K %L2G1 I $$NALAN(DEV)=1 C %SCKPORT Q I $$NALAN(DEV)=2 Q I DEV,DEV'=$P C DEV Q ENDGL(STRG) I STRG[$C(5),STRG[$C(6),STRG["END"!(STRG["SOF") Q 1 Q 0 ;- ZAP ; Q:$G(GNAME)?." " I '$D(PRT) S PRT=$J S J=0 F S J=J+1 Q:'$D(^GTR100(PRT,GNAME,J)) I $E($G(^(J)))="^" D .S:$G(^(J+1))'=$C(7) @(^(J))=$G(^GTR100(PRT,GNAME,J+1)) .S J=J+1 S ^L2G1($J,"OK",GNAME)=1,^L2G1($J,"OK",GNAME,"TIME")=$H U DEV Q H(H1) ; N RZ S RZ=$P($H,",",2)-H1 I RZ<0 S RZ=RZ+86400 Q RZ MSG(GNAME) ; Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y") X %POSIC W %LIGHT1,$$ENG^%L1FRM(GNAME,%L2G1("DISP","L")) X %XCL Q MSH(SH) ; Q:$$NALAN(DEV) Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) W !,SH Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y")+1 X %POSIC W %LIGHT1,$$ENG^%L1FRM(SH,%L2G1("DISP","L")) X %XCL Q READ ; N %J,A,TIME X UD ;;I $$NALAN(DEV)=1 D Q .S STR="",%J=0 .I $D(%L2G1("NOWAIT")) S TIME=99999 .I '$D(%L2G1("NOWAIT")) S TIME=$G(%L2G1("TIME"),60) .F R *A:TIME Q:'$T Q:A=251 S TIME=1 .E S END=2 Q .I A=251 D RFAST Q ; I $D(%L2G1("NOWAIT")) R STR I '$D(%L2G1("NOWAIT")) R STR:$G(%L2G1("TIME"),60) E S END=2 I STR[$C(13) S STR=$P(STR,$C(13)) I STR[$C(10) S STR=$P(STR,$C(10)) I STR[$C(12) S STR=$P(STR,$C(12)) I STR[$C(27,95) S STR=$P(STR,$C(27,95)) Q RFAST ; N STR,STR1,A,B,AOLD,CRC,TIME,ANS,BCC,SH,SH0,RPT,FILEGT S SH0=0,RPT=0 RFAST1 S SH0=SH0+1,^L2G1($J,"FAST",SH0)=$H S FILEGT=$ZDIST_"GTR1."_PRT C FILEGT:(DELETE) O FILEGT:(NEWVERSION:WRITE) RFAST2 S STR="",STR1="",A="",CRC=0,BCC=0,TIME=3,END=0,ER=0,SH=0 N A0 S A0=0 F II=1:1 S AOLD=A X UD R *A:TIME Q:A=251 S:'$T END=2 Q:'$T D Q:ER .N SMB S SMB=A .I A>200,A<251 S A=A-200 .I A=198 S A=58 .I A S A0=0 .I 'A S A0=A0+1 I A0>1000 S ER=1000 Q . .I $L(STR1)>4000 S ER=5,SH=SH+1,^L2G1($J,"FAST",SH0,SH,"ER")=ER Q .I A'=3 I $L(STR1)<4000 S STR1=STR1_$C(A) I A'=12 S CRC=CRC+($L(STR1)*SMB) .I A=3 D S STR1="",CRC=0 ..X UD R BCC S:$E(BCC)=$C(3) BCC=$P(BCC,$C(3),2) ..I BCC[$C(12) S BCC=$P(BCC,$C(12)) ..I BCC[$C(13) S BCC=$P(BCC,$C(13)) ..I BCC[$C(10) S BCC=$P(BCC,$C(10)) ..S SH=SH+1,^L2G1($J,"FAST",SH0,SH,"CRC")=CRC ..D MSG("BLOCK : "_SH) ..I BCC'=CRC D ...S ER=3,^L2G1($J,"FAST",SH0,SH,"ER")=ER_":"_CRC_"<>"_BCC ...D MSG("ERROR : "_^L2G1($J,"FAST",SH0,SH,"ER")) ..X UD W $C(3),CRC,#! S CRC=0 ..Q:ER ..D RFASTOU ; I ER S RPT=RPT+1 S:RPT>3 END=2 I 'END S ^L2G1($J,"FAST",SH0,SH,"RPT")=RPT G RFAST2 C FILEGT ; I A'=251 S ^L2G1($J,"FAST",SH0,SH,"ERA")=A I END=2 S ^L2G1($J,"FAST",SH0,SH,"END")=END I A'=251!END S END=2 Q ; X UD R ANS S ^L2G1($J,"FAST",SH0,SH,"LASTANS")=ANS Q:ANS'["OK" RESTGT O FILEGT:(READONLY:REWIND) F U FILEGT R A Q:$ZEOF D .I $E(A)="^",$E(A,2)?1A,$L(A)>1 R B Q:$ZEOF S @A=B C FILEGT ;;I $$^%L1ZOS(2,FILEGT) S END=1 Q RFASTOU ; N J F J=1:1:$L(STR1) D .U FILEGT W $E(STR1,J) Q ZU(PORT) ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U PORT Q NALAN(DEV) ; I $D(%SCKPORT)>9 Q 1 I $G(DEV)["SCK$" Q 2 Q 0 %L2GTR10 %L2GTR1 ;NEW PROGRAM [ 10.08.06 09:48 ] [ 28.02.06 12:51 ] [ 27.02.06 11:08 ] N (%UPRCOD,%XMSG,USERPORT,USERMOD,%L2G1,%SCKPORT) N $ZT S $ZT="ZG "_$ZL_":SVER^%L1X" D ^%L1C S %MXDL=440 I '$D(USERMOD) S USERMOD=1 I '$D(USERPORT) S USERPORT=$P ; S DEV=USERPORT ; I $$NALAN(DEV)=1 S UD=%SCKPORT("USE"),DEV=%SCKPORT I $$NALAN(DEV)'=1 S UD="U DEV:(NOECHO:NOWRAP:PASTHRU:NOCENABLE:TERM=$C(13,10))" S PRT=$J ; I $$NALAN(DEV) D .S %L2G1("NOCLOSE")="" .S PRT=$J ; I '$D(%L2G1("CONT")) K ^GTR100(PRT) ; ZP I '$$NALAN(DEV) S DEV=USERPORT O DEV::60 E S END=2 G END ; PORT ; K ^L2G1($J) S ^L2G1($J)=$H S END=0,SH=0,CNOLD=+$G(^L2G1($J,"CNOLD")) S BCCSUM=0,GNAMEOLD=$G(^L2G1($J,"GNAME")),STROUT="" S BEG=1 S H1=$P($H,",",2),BG0=0 X UD F R *BG:$G(%L2G1("TIME"),300) S:BG=0 BG0=BG0+1 S:BG BG0=0 D:BG=4 S:BG=-1&'$D(%L2G1("NOWAIT"))!(BG0>500) END=2 Q:END .I $G(%L2G1("TIME"))&($$H(H1)>$G(%L2G1("TIME"))) S END=2 Q .D READ Q:END .S H1=$P($H,",",2) .S ST1=$P(STR,$C(2)),STRG=$P($P(STR,$C(2),2,240),$C(3),1,$L(STR,$C(3))-1) .S GNAME=$P(ST1,"*"),CN=$P(ST1,"*",2),DL=$P(ST1,"*",3) .I CN=1 S CNOLD=0,GNAMEOLD="" .S SH=SH+1 S ^L2G1($J,"SH",SH)=$E(STR,1,%MXDL) .I $D(%L2G1("DISP")) D ..I GNAME'=$G(GNAMEOLD) D MSG(GNAME) ..I '(SH#10) D MSH(SH) .S ZCRC=$$^%L1ZCRC($P(STR,$C(3),1,$L(STR,$C(3))-1),1) .S BCCSUM=BCCSUM+ZCRC .S OUT=$C(3)_ZCRC . .X UD .I '$$NALAN(DEV) D ..F I=1:1:%DELAY R *A:0 ..W OUT_$C(13) ..S ^L2G1($J,"SH",SH,"OUT")=OUT .;;I $$NALAN(DEV)=1 D ..W OUT,#! ..S ^L2G1($J,"SH",SH,"OUT")=OUT . .I $$NALAN(DEV),$$ENDGL(STRG) D I ANS'["OK" G NEXT ..W $C(3)_BCCSUM,#! R ANS:5 ..S ^L2G1($J,"SH",SH,"OUT")=BCCSUM ..S ^L2G1($J,"SH",SH,"IN")=ANS . .I GNAMEOLD="" S GNAMEOLD=GNAME . .I $$ENDGL(STRG) D ..I STRG["SOF",GNAMEOLD'="",$D(^GTR100(PRT,GNAMEOLD)) N GNAME S GNAME=GNAMEOLD ..D ZAP . NEXT .I $$ENDGL(STRG) D S:STRG["SOF" END=1 Q ..S END=0,CNOLD=0,BCCSUM=0,GNAMEOLD="" ..K ^GTR100(PRT,GNAME) . .S CNOLD=CN,GNAMEOLD=GNAME .S ^L2G1($J,"CNOLD")=CN,^L2G1($J,"GNAME")=GNAME,^L2G1($J,"BCCSUM")=BCCSUM .I $L(GNAME),CN S ^GTR100(PRT,GNAME,CN)=STRG .S BEG=0 Q ; END ; I $G(END)=1,$P($ZS,",",3)="" D .S ^L2G1($J,"OK")=1,^L2G1($J,"OKTIME")=$H .D MSG("DONE") H 1 ; I $ZS'="" D SVER^%L1X I $$NALAN(DEV),$D(%L2G1("DISP")) U $P:(CENABLE) I $D(%L2G1("NOCLOSE")) K %L2G1 Q K %L2G1 I $$NALAN(DEV)=1 C %SCKPORT Q I $$NALAN(DEV)=2 Q I DEV,DEV'=$P C DEV Q ENDGL(STRG) I STRG[$C(5),STRG[$C(6),STRG["END"!(STRG["SOF") Q 1 Q 0 ;- ZAP ; Q:$G(GNAME)?." " I '$D(PRT) S PRT=$J S J=0 F S J=J+1 Q:'$D(^GTR100(PRT,GNAME,J)) I $E($G(^(J)))="^" D .S:$G(^(J+1))'=$C(7) @(^(J))=$G(^GTR100(PRT,GNAME,J+1)) .S J=J+1 S ^L2G1($J,"OK",GNAME)=1,^L2G1($J,"OK",GNAME,"TIME")=$H U DEV Q H(H1) ; N RZ S RZ=$P($H,",",2)-H1 I RZ<0 S RZ=RZ+86400 Q RZ MSG(GNAME) ; Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y") X %POSIC W %LIGHT1,$$ENG^%L1FRM(GNAME,%L2G1("DISP","L")) X %XCL Q MSH(SH) ; Q:$$NALAN(DEV) Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) W !,SH Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y")+1 X %POSIC W %LIGHT1,$$ENG^%L1FRM(SH,%L2G1("DISP","L")) X %XCL Q READ ; N %J,A,TIME X UD ;;I $$NALAN(DEV)=1 D Q .S STR="",%J=0 .I $D(%L2G1("NOWAIT")) S TIME=99999 .I '$D(%L2G1("NOWAIT")) S TIME=$G(%L2G1("TIME"),60) .F R *A:TIME Q:'$T Q:A=251 S TIME=1 .E S END=2 Q .I A=251 D RFAST Q ; I $D(%L2G1("NOWAIT")) R STR Q R STR:$G(%L2G1("TIME"),60) E S END=2 Q RFAST ; N STR,STR1,A,B,AOLD,CRC,TIME,ANS,BCC,SH,SH0,RPT,FILEGT S SH0=0,RPT=0 RFAST1 S SH0=SH0+1,^L2G1($J,"FAST",SH0)=$H S FILEGT=$ZDIST_"GTR1."_PRT C FILEGT:(DELETE) O FILEGT:(NEWVERSION:WRITE) RFAST2 S STR="",STR1="",A="",CRC=0,BCC=0,TIME=3,END=0,ER=0,SH=0 N A0 S A0=0 F II=1:1 S AOLD=A X UD R *A:TIME Q:A=251 S:'$T END=2 Q:'$T D Q:ER .N SMB S SMB=A .I A>200,A<251 S A=A-200 .I A=198 S A=58 .I A S A0=0 .I 'A S A0=A0+1 I A0>1000 S ER=1000 Q . .I $L(STR1)>4000 S ER=5,SH=SH+1,^L2G1($J,"FAST",SH0,SH,"ER")=ER Q .I A'=3 I $L(STR1)<4000 S STR1=STR1_$C(A) I A'=12 S CRC=CRC+($L(STR1)*SMB) .I A=3 D S STR1="",CRC=0 ..X UD R BCC S:$E(BCC)=$C(3) BCC=$P(BCC,$C(3),2) ..I BCC[$C(12) S BCC=$P(BCC,$C(12)) ..I BCC[$C(13) S BCC=$P(BCC,$C(13)) ..I BCC[$C(10) S BCC=$P(BCC,$C(10)) ..S SH=SH+1,^L2G1($J,"FAST",SH0,SH,"CRC")=CRC ..D MSG("BLOCK : "_SH) ..I BCC'=CRC D ...S ER=3,^L2G1($J,"FAST",SH0,SH,"ER")=ER_":"_CRC_"<>"_BCC ...D MSG("ERROR : "_^L2G1($J,"FAST",SH0,SH,"ER")) ..X UD W $C(3),CRC,#! S CRC=0 ..Q:ER ..D RFASTOU ; I ER S RPT=RPT+1 S:RPT>3 END=2 I 'END S ^L2G1($J,"FAST",SH0,SH,"RPT")=RPT G RFAST2 C FILEGT ; I A'=251 S ^L2G1($J,"FAST",SH0,SH,"ERA")=A I END=2 S ^L2G1($J,"FAST",SH0,SH,"END")=END I A'=251!END S END=2 Q ; X UD R ANS S ^L2G1($J,"FAST",SH0,SH,"LASTANS")=ANS Q:ANS'["OK" RESTGT O FILEGT:(READONLY:REWIND) F U FILEGT R A Q:$ZEOF D .I $E(A)="^",$E(A,2)?1A,$L(A)>1 R B Q:$ZEOF S @A=B C FILEGT ;;I $$^%L1ZOS(2,FILEGT) S END=1 Q RFASTOU ; N J F J=1:1:$L(STR1) D .U FILEGT W $E(STR1,J) Q ZU(PORT) ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U PORT Q NALAN(DEV) ; I $D(%SCKPORT)>9 Q 1 I $G(DEV)["SCK$" Q 2 Q 0 %L2GTR11 %L2GTR1 ;NEW PROGRAM [ 06.07.05 12:17 ] [ 07/06/05 7:53 AM ] [ 06.07.05 7:28 AM ] N (%UPRCOD,%XMSG,USERPORT,USERMOD,%L2G1,%L2NALAN) D ^%L1C I '$D(USERMOD) S USERMOD=1 I '$D(USERPORT) S USERPORT=$P S PRT=$J N $ZT S $ZT="ZG "_$ZL_":END^%L2GTR1" I '$D(%L2G1("CONT")) K ^GTR100(PRT) S %MXDL=500 I $D(%L2NALAN("DEV")) D .S USERPORT=56 .S (DEVIN,DEVOUT)=%L2NALAN("DEV"),DEV=USERPORT .S %L2G1("NOCLOSE")="" .S PRT=$J I '$D(%L2G1("CONT")) K ^GTR100(PRT) ;W !?20,"CTRL/C - EXIT",! ZP I USERPORT'=56 S DEV=$P I $G(@$$^W4DEV@(USERPORT))>3 S DEV=@$$^W4DEV@(USERPORT) O DEV::60 E S END=2 G END PORT ; ;S END=0,CNOLD=0,BCCSUM=0,GNAMEOLD="",STROUT="",SH=0 K ^L2G1 ;;("SH") S END=0,SH=0,CNOLD=+$G(^L2G1("CNOLD")),BCCSUM=+$G(^L2G1("BCC")),GNAMEOLD=$G(^L2G1("GNAME")),STROUT="" U $P:(NOCENABLE) S BEG=1 S UD="U DEV:(NOECHO:NOWRAP:PASTHRU:NOCENABLE:TERM=$C(13,10))" I DEV=$G(@$$^W4DEV@(56)) S UD="U DEV:DEVIN" X UD S H1=$P($H,",",2),BG0=0 F R *BG:$G(%L2G1("TIME"),60) S:BG=0 BG0=BG0+1 S:BG BG0=0 D:BG=4 S:BG=-1&'$D(%L2G1("NOWAIT"))!(BG0>500) END=2 Q:END .I $G(%L2G1("TIME"))&($$H(H1)>$G(%L2G1("TIME"))) S END=2 Q .D READ Q:END .S ST1=$P(STR,$C(2)),STRG=$P($P(STR,$C(2),2,240),$C(3),1,$L(STR,$C(3))-1) .S GNAME=$P(ST1,"*"),CN=$P(ST1,"*",2),DL=$P(ST1,"*",3) .I CN=1 S CNOLD=0,BCCSUM=0,GNAMEOLD="" .S SH=SH+1 S ^L2G1("SH",SH)=$E(STR,1,%MXDL) .I $D(%L2G1("DISP")) D X UD ..I GNAME'=$G(GNAMEOLD) D MSG(GNAME) ..I '(SH#10) D MSH(SH) .S ^L2G1("SH",SH,"OUT")=$C(3)_$$^%L1ZCRC($P(STR,$C(3),1,$L(STR,$C(3))-1),1) .I $G(@$$^W4DEVI@(DEV))'=56 D ..F I=1:1:%DELAY R *A:0 ..W ^("OUT")_$C(13) .I $G(@$$^W4DEVI@(DEV))=56 D ..U DEV ;:DEVOUT ..W ^("OUT"),#! .I GNAMEOLD="" S GNAMEOLD=GNAME .I STRG[$C(5),STRG[$C(6),STRG["SOF" S END=1 Q ;*** END ROUT .;;I STRG[$C(5),STRG[$C(6),STRG["END",GNAMEOLD=$P(STRG,"*",2) D Q ;*** END ROUT .I STRG[$C(5),STRG[$C(6),STRG["END" D Q ;*** END ROUT ..D ZAP S END=0,CNOLD=0,BCCSUM=0,GNAMEOLD="" K ^GTR100(PRT,GNAME) Q .S CNOLD=CN,GNAMEOLD=GNAME .S ^L2G1("CNOLD")=CN,^L2G1("GNAME")=GNAME,^L2G1("BCC")=BCCSUM .I $L(GNAME),CN S ^GTR100(PRT,GNAME,CN)=STRG .S BEG=0 END ; I $G(END)=1,$ZS="" D .S ^L2G1("OK")=1,^L2G1("OKTIME")=$H .D MSG("DONE") H 1 I $ZS'="" D SVER^%L1X I $D(%L2G1("NOCLOSE")) K %L2G1 Q K %L2G1 I DEV,DEV'=$P C DEV U $P:(CENABLE:NOPASTHRU) K %L2G1 Q ;- ZAP ; Q:$G(GNAME)="" I '$D(PRT) S PRT=$J S J=0 F S J=J+1 Q:'$D(^GTR100(PRT,GNAME,J)) I $E($G(^(J)))="^" S:$G(^(J+1))'=$C(7) @(^(J))=$G(^GTR100(PRT,GNAME,J+1)) S J=J+1 S ^L2G1("OK",GNAME)=1,^L2G1("OK",GNAME,"TIME")=$H U DEV Q H(H1) ; N RZ S RZ=$P($H,",",2)-H1 I RZ<0 S RZ=RZ+86400 Q RZ MSG(GNAME) ; ;Q:$G(DEV)=56 Q:'$D(%L2G1("DISP")) Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y") X %POSIC W %LIGHT1,$$ENG^%L1FRM(GNAME,%L2G1("DISP","L")) X %XCL Q MSH(SH) ; Q:'$D(%L2G1("DISP")) D ZU(0) I '$D(%L2G1("DISP","Y"))!'$D(%L2G1("DISP","X")) W !,SH Q S %XX=%L2G1("DISP","X"),%YY=%L2G1("DISP","Y")+1 X %POSIC W %LIGHT1,$$ENG^%L1FRM(SH,%L2G1("DISP","L")) X %XCL Q READ ; N %J,A,TIME I $G(@$$^W4DEVI@(DEV))=56 D Q .S STR="",%J=0 .I $D(%L2G1("NOWAIT")) S TIME=99999 .I '$D(%L2G1("NOWAIT")) S TIME=$G(%L2G1("TIME"),60) .F R *A:TIME Q:'$T Q:A=251 S TIME=1 .E S END=2 Q .I A=251 D RFAST Q ; I $D(%L2G1("NOWAIT")) R STR E R STR:$G(%L2G1("TIME"),60) E S END=2 Q Q RFAST ; N STR,STR1,A,B,AOLD,CRC,TIME,ANS,BCC,SH,SH0,RPT,FILEGT S SH0=0,RPT=0 RFAST1 S SH0=SH0+1,^L2G1("FAST",SH0)=$H S FILEGT="GTR1."_PRT O FILEGT:(NEWVERSION:WRITE) RFAST2 S STR="",STR1="",A="",CRC=0,BCC=0,TIME=3,END=0,ER=0,SH=0 F II=1:1 S AOLD=A X UD R *A:TIME Q:A=251 S:'$T END=2 Q:'$T D Q:ER .S:A=212 A=12 .;;S ^L2G1("FAST","II",II)=A .I $L(STR1)>4000 S ER=5,SH=SH+1,^L2G1("FAST",SH0,SH,"ER")=ER Q .I A'=3 I $L(STR1)<4000 S STR1=STR1_$C(A) I A'=12 S CRC=CRC+($L(STR1)*A) .I A=3 D S STR1="",CRC=0 ..X UD R BCC S:$E(BCC)=$C(3) BCC=$P(BCC,$C(3),2) ..I BCC[$C(12) S BCC=$P(BCC,$C(12)) ..I BCC[$C(13) S BCC=$P(BCC,$C(13)) ..I BCC[$C(10) S BCC=$P(BCC,$C(10)) ..S SH=SH+1,^L2G1("FAST",SH0,SH,"CRC")=CRC ..D MSG("BLOCK : "_SH) ..I BCC'=CRC D ...S ER=3,^L2G1("FAST",SH0,SH,"ER")=ER_":"_CRC_"<>"_BCC ...D MSG("ERROR : "_^L2G1("FAST",SH0,SH,"ER")) ..X UD W $C(3),CRC,#! S CRC=0 ..Q:ER ..D RFASTOU ; I ER S RPT=RPT+1 S:RPT>3 END=2 I 'END S ^L2G1("FAST",SH0,SH,"RPT")=RPT G RFAST2 C FILEGT ; I A'=251 S ^L2G1("FAST",SH0,SH,"ERA")=A I END=2 S ^L2G1("FAST",SH0,SH,"END")=END I A'=251!END S END=2 Q ; X UD R ANS S ^L2G1("FAST",SH0,SH,"LASTANS")=ANS Q:ANS'["OK" RESTGT O FILEGT:(REWIND:READONLY) F U FILEGT R A Q:$ZC D .I $E(A)="^",$E(A,2)?1A,$L(A)>1 R B Q:$ZC S @A=B C FILEGT ;;I $ZOS(2,FILEGT) S END=1 Q RFASTOU ; N J F J=1:1:$L(STR1) D .U FILEGT W $E(STR1,J) Q ZU(PORT) ; I $P["tty" U $P:(NOECHO:NOWRAP) Q U ^[$$^%L1GLD]dev(1):(NOECHO:NOWRAP) Q %L2ISNAL %L2ISNAL ; [ 31.01.06 20:27 ] [ I $D(^[$$^%L1GLD]PL("ADSL"))=11 Q 1 Q 0 %L2MBG %L2MBG ; INPUT FROM DISPLAY [ 16.12.03 10:33 ] [ 14.12.03 16:46 ] [ 002/17/00 4:38 PM ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C K %BE,%LS,%S,%L1DS,OLDDAT,YOLD,SHOLD,SCHOLD N COLG,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPG,NPGL,OTB,PG,%PRNEW,RKV,RSCR,RZD,%REFH1 N SHOLD,SCHOLD,STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2 ;SH,SCH N %HBRY S %HBRY="" I $D(%MBG("PAR"))>9 D ^%L1MBG1 S NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") BEG D INIT S %REFH1=$G(%MBG("REF"),"^MBG($P") F JJ=1:1:COLG S %MBG("X",JJ)=43,%MBG("Y",JJ)=JJ+VGR0 S STEP=1 D PS Q:$D(%L1MBG) L0 ; LOOP ; K %MBG("TO") X %XCL K %INV I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G RSM K %MBG("NEW"),%PRPL F JJ=1:1:COLG S %MBG("O",JJ)="" K JJ ML ; F JJ=1:1 Q:'$D(%MBG("OU",JJ)) S %FIRST=JJ K JJ S J=0 G INC LGR U $P:(NOECHO:NOWRAP) K %TO,%FLL,%S,%L1DS W %ENG K %MBG("TO",J) S (%MOLD,%MBG("O",J))=$P($G(@(%REFH1_",SH)")),RZD,J) S %XX=0,%YY=24 X %POSIC W %chists I $D(%MBG("H",J)) S %SAY=%MBG("H",J)_"++24,78,HH,I" X %XMSG S RKV=$P($G(@(%REFH1_",SH)")),RZD,J) I RKV'?.P S %MBG("O",J)=RKV K RKV I $D(%MBG("DO",J)) X %MBG("DO",J) I $G(%MBG("TO",J))="P" D PS S %YY=%MBG("Y",J) I %YY>(STEP*COLG+VGR)!(%YY>23) S:%YY>23 %YY=23 D ZAPR G RSM:OTB=".",BEG S %XX=%MBG("X",J) X %POSIC S %LS=%MBG("D",J) S %S=%MBG("O",J) S %INV="" S CIST=$G(%MBG("S",J)) K:CIST="" CIST S %PRNEW=0 I %MBG("RGS",J)="E" D I %S'["==",$D(%MBG("DR",J)),$L($P(%S,"."))>(%MBG("D",J)-%MBG("DR",J)-1) D ER G LGR .S %XX=%XX-%LS X %POSIC S $X=%XX .S %FL="" K %BE D ^%ZMSL K %INV,%FL Q:%S["==" .I $D(%MBG("DR",J)),%S'["%" S %S=$J(%S,%MBG("DR",J)+1,%MBG("DR",J)) I %MBG("RGS",J)="H" S $X=%XX-1,$Y=%YY D ^%L1ZMS I %MBG("RGS",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q I %MBG("RGS",J)="D" S %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,".","") D ^%L1DAT I %S'="" S %S=%L1DAT1 ; LGR --> SET I %MBG("RGS",J)="T" S %XX=%XX-8 S $X=%XX S %L1TS=$TR(%S,".","") D ^%L1TIME I %S'="" S %S=%L1TIME1 ; LGR --> SET S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) ;*** W %ENG S %XX=%MBG("X",J)-DL I $G(%TO)="DEL",'$D(%MBG("DELAS")) D DEL G:%TO'="PGUP" BEG G PGUP I %S["==",J=%FIRST,$O(^(SH))="" G RSM S %X000=%XX I %MBG("RGS",J)'="HH" X %POSIC X %XCL X:$D(%PRPL) %LIGHT W $J(%S,DL) ;*** S $P(@(%REFH1_",SH)"),RZD,J)=%S I %MBG("O",J)'=%S!$D(%MBG("NEW",J))!(%MBG("O",J)="?")!(%MBG("O",J)="*")!($G(%TO)'="") S %PRNEW=1 S %MBG("O",J)=%S IBUD ; I %PRNEW,$D(%MBG("C",J)),%MBG("C",J)'?.P S JOLD=J D D:$G(%MBG("TO",J))="PL" PL G:$G(%MBG("TO",J))'="P" SET D PS G SET ;G BEG .I %OPT=1 D GET^%VIDEO("OLD",0,1,79,VGR0-1,2) .X %MBG("C",J) F J=1:1 Q:'$D(%MBG("O",J)) I $G(%MBG("O",J))'?.P S $P(@(%REFH1_",SH)"),RZD,J)=%MBG("O",J) .I %OPT=1 D PUT^%VIDEO("OLD",0,1,79,VGR0-1,2) .S J=JOLD .Q SET ; NAZAD S:$G(%TO)="END" %TO="UP" I $D(%TO),%TO="UP",J>%FIRST S J=J-1 G:'$D(%MBG("OU",J)) LGR G NAZAD ;I $G(%TO)'="",'$D(%MBG("NEW")) G:J=%FIRST RSM G LGR I $G(%TO)="UP" G:J=%FIRST RSM G LGR INC S J=J+1 I J>COLG G RSM I $D(%MBG("OU",J)) G INC G LGR UP ; I %TO="UP",J>1 S J=J-1 G LGR I J>COLG G RSM I %TO="END" G RSM PGUP ; I %TO="PGUP" G:SH'>1 ML:'$D(%L1MBG),END S SH=SH-1 K %MBG("TO") G BEG I %TO="PGDW" S SH=SH+1 K %MBG("TO") G BEG D CLOU G LOOP CLOU F JJ=1:1:COLG I $G(%MBG("OU",JJ))'="IN" K %MBG("OU",JJ) Q PL S GG=$G(@(%REFH1_",SH)")),I=0 ; D INIT S %YY=VGR0 D PG Q RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END Q PS N %YY,J D CLEAR S %SAY=NPG_"++"_(VGR0-1)_","_(X1+2)_",EE" X %XMSG S %SAY=" cenr++"_(VGR0-1)_","_(X1+8)_",HH" X %XMSG F JJ=1:1:COLG D .S %SAY=%MBG("Z",JJ)_"++"_(JJ+VGR0)_","_(%MBG("X",JJ)+30)_",HH," X %XMSG .S %SAY=":++"_(JJ+VGR0)_","_(%MBG("X",JJ)+2)_",HH," X %XMSG S %YY=VGR0 D P S %YY=VGR0 X %XCL Q P N I,%S,%L1DS,J ; I $D(@(%REFH1_",SH)")) D PG ; S %SAY="PG-DW++"_(Y2-2)_",8,EE,I" X %XMSG S %SAY=" - d`ad cenr++"_(Y2-2)_",28,HH" X %XMSG ; S %SAY="PG-UP++"_(Y2-2)_",35,EE,I" X %XMSG S %SAY=" - mcew cenr++"_(Y2-2)_",53,HH" X %XMSG ; S %SAY="==,"_$S(%OPT=65:"",1:"")_"++"_(Y2-2)_",57,EE,I" X %XMSG S %SAY=" - meiq++"_(Y2-2)_",75,HH" X %XMSG ;I '$D(%MBG("DELAS")) S %SAY=" /U++"_(Y2-1)_",31,EE" X %XMSG S %SAY=" - lhal ++"_(Y2-1)_",48,HH" X %XMSG Q PG N RKV,J,DL X %XCL F J=1:1:COLG S DL=$S(%MBG("RGS",J)="D":8,1:%MBG("D",J)) S %XX=%MBG("X",J)-DL S %YY=%MBG("Y",J) X %POSIC D .W:$D(%MBG("INV",J)) %CLI .S RKV=$P($G(^(SH)),RZD,J) .I %MBG("RGS",J)="HH" D Q ..N %X1,%Y1,%X2,%Y2 ..S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1,%S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S ..Q .S RKV=$E(RKV,1,DL) .W $S('$D(%MBG("DR",J)):$J(RKV,DL),1:$J(RKV,DL,%MBG("DR",J))) X %XCL Q CLEAR ; N %XX,%YY,I F I=Y1:1:Y2-2 S %XX=X1,%YY=I X %POSIC W %chists D RBUA Q ZAPR Q ER ; W *7 S %SAY=" d`iby " X %XMSGN Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=$G(%MBG("LL2"),2),Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR2"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 Q RBUA ; INPUT X1,X2,Y1,Y2 D ^%L1RBUA Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q %L2MBS %L2MBS ; DATA INPUT [ 25.02.05 13:00 ] [ 11/24/91 6:00 PM ] D ^%L1C INP ; ------------------- INPUT N I,%ECHO,%HBRY,%XX,%YY ;,COLS,LL,LB,LT,LZ,LR ;D ^%L2MBS1 S:'$D(%FIRST) %FIRST=1 U $P:(NOECHO:NOWRAP) F JJ=1:1:COLS S %SAY=%MBS("Z",JJ)_"++"_%MBS("VGR0")_","_%MBS("X",JJ)_",HH,I" X %XMSG D PC Q:$D(%L2MBS) S I=1 K %ECHO S %HBRY="" LOOP I $D(%MBS("DO",I)) X %MBS("DO",I) ;************** S %XX=0,%YY=24 X %POSIC W %chists I $D(%MBS("H",I)) S %SAY=%MBS("H",I)_"++24,78,HH,I" X %XMSG ;************** U $P:(NOECHO:NOWRAP) K %FLL W %ENG S %YY=%MBS("Y",I),%XX=%MBS("X",I) X %POSIC S $Y=%YY S %LS=%MBS("D",I,1) K CIST S %S=%MBS("O",I) S %INV="" S CIST=%MBS("S",I) K:CIST="" CIST I %MBS("RGS",I)="E" S %XX=%XX-%LS X %POSIC S $X=%XX S CIST="0123456789-,.;" S %FL="" D ^%ZMSL K %FL I %MBS("RGS",I)="H" S %XX=%XX-1,$X=%XX D ^%L1ZMS I %MBS("RGS",I)="D" S %XX=%XX-8,$X=%XX D ^%L1DAT S %S=%L1DAT1 I %MBS("RGS",I)="T" S %XX=%XX-8,$X=%XX D ^%L1TIME S %S=%L1TIME1 W %ENG S %XX=%MBS("X",I)-%MBS("D",I,1) X %POSIC X %XCL W $J(%S,%MBS("D",I,1)) S %MBS("O",I)=%S I $D(%MBS("C",I)) D .S IOLD=I .X %MBS("C",I) .S I=IOLD .D PC NAZAD I $D(%TO),%TO="UP",I>%FIRST S I=I-1 G:'$D(%MBS("OU",I)) LOOP G NAZAD I $D(%TO),%TO="UP",I=1 G LOOP INC S I=I+1 G:$D(%MBS("OU",I)) INC I I>COLS G END G LOOP Q PC ; N I U $P:(NOECHO:NOWRAP) I '$D(%POSIC) D ^%L1C I %TYPCRT="PC" %ENG,$C(27,91)_LT_";"_LL_";"_LB_";"_LR_"b" E S Y1=LT,X1=LL,Y2=LB,X2=LR D RBUA^%L3MENU F I=1:1:COLS W %ENG D .S %YY=%MBS("Y",I),%XX=%MBS("X",I)-%MBS("D",I,1) X %POSIC .W %HBR .S:'$D(%MBS("O",I)) %MBS("O",I)="" .W $J(%MBS("O",I),%MBS("D",I,1)) Q END Q %L2MBS1 %L2MBS1 ; INIT07/14/91 12:05 PM ] [ 11/24/91 2:51 PM ] N ZAPR,I S LZ=0,LT=24,LB=0,LL=80,LR=0,LX=0 F I=1:1 Q:'$D(%MBS("PAR",I)) S ZAPR=$P(%MBS("PAR",I),"#") D .S %MBS("Z",I)=$P(ZAPR,";",2) I $L(%MBS("Z",I))>LZ S LZ=$L(%MBS("Z",I)) .S %MBS("Y",I)=$P($P(ZAPR,";",3),","),%MBS("X",I)=$P($P(ZAPR,";",3),",",2) .S %MBS("INV",I)=$P($P(ZAPR,";",3),",",3) I %MBS("INV",I)'="I" K %MBS("INV",I) .I %MBS("Y",I)>LB S LB=%MBS("Y",I) .I %MBS("Y",I)LX S LX=%MBS("X",I) .S %MBS("D",I,1)=$P($P(ZAPR,";",4),",") .S %MBS("DR",I)=$P($P(ZAPR,";",4),",",2) .I %MBS("X",I)-%MBS("D",I,1)23 LB=23 S LT=LT-1 S:LT<0 LT=0 S:LZ>70 LZ=70 S LR=LX+4 S:LR>80 LR=80 S:LL<0 LL=0 Q %L2MD %L2MD(PORTN,USERMOD,NUMBER,MDTONE,US,XON,MDLKH) ; [ 08.02.06 12:55 ] [ 07.02.06 09:16 ] [ 01.02.06 14:12 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,USERMOD,NUMBER,MDTONE,MDLKH,%L1MDOK,US,XON,%DELAY,%L2MD,%L2NALAN,%L1RCV) D ^%L1C S %L1MDOK=0,%L2MD="" I '$$NODISP U $P S %SAY=" CTRL/C - CANCEL " X %XMSGV S PRT=$P N $ZT S $ZT="" ;"ZG "_$ZL_":ERR^%L2MD" K ^MODEM($P) S ^MODEM($P)="BEG" ; S US="U PORTN:(NOECHO:NOWRAP:NOCENABLE:PASTHRU:TERM=$C(13))" ; I '$$NODISP D .S %L2MD("M","VG")=3,%L2MD("M","NG")=17,%L2MD("M","LG")=5,%L2MD("M","RG")=25 .W %LIGHT1,%CV("CF") .D TV^%L1RBUA(%L2MD("M","VG"),%L2MD("M","LG"),%L2MD("M","NG")+2,%L2MD("M","RG")+1) .W %LIGHT1,%CV("CF") .S %L2MD("L","VG")=3,%L2MD("L","NG")=17,%L2MD("L","LG")=32,%L2MD("L","RG")=75 .D TV^%L1RBUA(%L2MD("L","VG"),%L2MD("L","LG"),%L2MD("L","NG")+2,%L2MD("L","RG")+1) .X %XCL ; I PORTN?4N,NUMBER?1N.N1".".E D G EXIT ;---------- ADSL .D MSGL($G(MDLKH),"L") .K %L2NALAN .S %L1MDOK='$$^%L2NALAN(NUMBER,PORTN) .I %L1MDOK D MSG("CONNECTION ESTABLISHED","M") Q .D MSG("NO CONNECTION","M") Q ; ; ------------------------------------- MODEM RAGIL I PORTN>3!($L(PORTN)>3)!$$NODISP G ASK+1 ASK S %GET="I/O PORT? > ++3,3,EE#++2,E,I" D ^%L1GET S PORTN=%S G:PORTN="" EXIT I PORTN S PORTN=$G(^[%L3GLD]dev(PORTN)) I PORTN="" G EXIT I $P=PORTN D MSG("CANNOT SELECT YOUR OWN DEVICE.","M") G ASK I '$$^%L1MDLCK(PORTN) S %GET="A PORT OF MODEM IS BUSY !" D N^%L1GET G EXIT C PORTN U $P:(CENABLE:CTRAP=$C(3)) O PORTN::0 E D MSG("..LINE IN USE..WAITING..","M") O PORTN D MSG("READY","M") D HANGUP X US INIT ; S %DC=0 S %DT=0,%Y="" P0 X US D CLPORT S %ST="AT&F"_$G(XON)_$C(13) F %J=1:1:$L(%ST) W $E(%ST,%J) D DELAY P01 X US R *%Y1:1 E S %DC=%DC+1 G:%DC<12 P01:%DC#4,P0 D MSG("NO CARRIER","M") G EXIT G:%Y1=1 EXIT I %Y1'=13 S %Y=%Y_$C(%Y1) G P01 D MSG(%Y,"M") S %DT=%DT+1 S ^MODEM($P,"ATZ",%DT)=%Y G:%Y1=1 EXIT I %Y'["OK" G:%DT<12 P01:%DT#4,P0 D MSG("NO CARRIER","M") G EXIT S %DT=0 I $G(NUMBER)!$$NODISP D DELAY G TP1 TP U $P:(CENABLE:CTRAP=$C(3)) S %GET="PHONE NUMBER > ++23,5,EE,,,,RF#++10,E,I" D ^%L1GET S NUMBER=%S G:NUMBER="" EXIT TP1 X US S NUMBER=$TR(NUMBER,"-","") D CLPORT S ST="ATD"_$G(MDTONE,"P")_NUMBER_$C(13) W ST D MSG(ST,"M") S TXT=%HBR_$$HBR^%L1FRM($G(MDLKH),30)_" "_$$HBR^%L1FRM(NUMBER,10)_%ENG D MSGL(TXT,"L") X US H 5 S OK=0 F I=1:1:10 D Q:OK .S A="" F I1=1:1:60 R *O:1 Q:O=10 D ..I O'=10,O'=13 S A=A_$C(O) .I A="" S OK=3 Q .D Q:OK S ^MODEM("CONN",I)=A ..I $F(A,"CONN") S OK=1 Q ..I $F(A,"BUS") S OK=2 Q ..I $F(A,"NO CAR") S OK=3 Q ..I $F(A,"NO DIAL") S OK=4 Q I OK'=1 D MSG(A,"M") D CLOSE^%L1MDLCK(PORTN) G EXIT I OK=1 K ^MODEM($P) D MSG("MODEM IN USE !","M") S %L1MDOK=OK EXIT H 1 Q ERR S %L1MDOK=$P($P($ZS,"<",2),">") D CLOSE^%L1MDLCK(PORTN) G EXIT HANGUP ; D ^%L1HANG Q CLPORT X US ; F R *A:1 E Q Q DELAY ; F %JJJ=1:1:%DELAY Q MSG(TXT,PR) Q:$$NODISP U $P:(NOECHO:NOWRAP) D SDVIG(PR) S %YY=%L2MD(PR,"NG"),%XX=%L2MD(PR,"LG")+1 X %POSIC W %LIGHT1,%CV($S(PR="M":"GF",1:"YF")) W $$ENG^%L1FRM($$SPA^%L1FRM($$CLA^%L1FRM(TXT)),%L2MD(PR,"RG")-%L2MD(PR,"LG")-1),%CCL Q MSGL(TXT,PR) Q:$$NODISP U $P:(NOECHO:NOWRAP) D SDVIG(PR) S %YY=%L2MD(PR,"NG"),%XX=%L2MD(PR,"LG") X %POSIC W %LIGHT1,%CV("YF"),$TR($TR(TXT,%TES1,%TES2),%TEN,%THB),%CCL Q SDVIG(PR) Q:$$NODISP I %TYPCRT="PC" W ! Q ;;I %TYPCRT="PC" D Q .D GET^%VIDEO("l2md",%L2MD(PR,"LG")-1,%L2MD(PR,"VG")+1,%L2MD(PR,"RG")-%L2MD(PR,"LG")+1,%L2MD(PR,"NG")-%L2MD(PR,"VG"),2) .D PUT^%VIDEO("l2md",%L2MD(PR,"LG")-1,%L2MD(PR,"VG"),%L2MD(PR,"RG")-%L2MD(PR,"LG")+1,%L2MD(PR,"NG")-%L2MD(PR,"VG"),2) I $E(%TYPCRT,1,3)="VT5" D Q .W $C(27,91),(%L2MD(PR,"VG")+2)_";"_%L2MD(PR,"LG")_";"_(%L2MD(PR,"NG")+1)_";"_%L2MD(PR,"RG")_";;"_(%L2MD(PR,"VG")+1)_";"_%L2MD(PR,"LG")_";$v" Q NODISP(STAM) I $D(%L1RCV) Q 1 I $G(%L2MD)="NOMSG" Q 1 Q 0 %L2MENU %L2MENU ; VT220 OR PC [ 15.03.19 08:21 ] [ 08.10.06 09:35 ] [ 17.09.06 13:15 ] ;-- INPUT: MAC - NAME OF OPTIONS ARRAY ; %L2MN("LEFT") - LEFT; %L2MN("TOP") - TOP ; %L2MN("IND") - FOCUS, $D(%L2MN("NOCLR")) - NO CLEAR IN FINISH ; %L2MN("T2") - MUMPS COMMAND ; $D(%L2MN("VIEW")) - VIEW ONLY ; $D(%L2MN("NOCLB")) - NO CLEAR BACKGROUND (IN START) ; $D(%L2MN("POP")) - EXIT TO LEFT, EXIT TO RIGHT ; ;-- OUTPUT: %I - OPTION NUMBER ; %L3MOPT - OPTION NAME ; %TOMN - EXIT FLAG ("LEFT" OR "RIGHT") ;--------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,MAC,@MAC,%L2MN,%CLEAR,%L3MOPT,%I,%HBRY,%TOMN) D ^%L1C I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE D S %I=INDEX Q .D PRE .k ^l2mn0($p) M ^l2mn0($p)=^l2mn($p) .K ^l2mn($p) .M ^l2mn($p)=@MAC .I $D(^l2mn($P,0)) S %L1("T1")=^(0) K ^(0) .S MAC="^l2mn($p)" .S %L1("EU")=2 D ^%L1NU I FLAG'="" S INDEX=1 .K ^l2mn($p) m ^l2mn($p)=^l2mn0($p) S F("CHISTS")=1,F("CHISTE")=2,F("SBROS")=3,F("IND")=4 S F("ADDL")=5,F("DELL")=6,F("COR")=7,F("FIND")=8 S F("SAVE")=9,F("REST")=10 D USE I %XMSG(0)'>1 S %HBRY="" W %ENG K %L3MOPT S %TOMN="" I '$D(MAC) W *7,!!?5,"*** HASN'T NAME ARRAY !" Q I $D(@MAC)<10 W *7,!!?5,"*** HASN'T DATA !" Q S %L1TXT=MAC_"(0)" S %M=MAC_"(%I)" S %LL=0 F %I=1:1 Q:'$D(@%M) I $L($G(@%M))+6>%LL S %LL=$L($G(@%M))+6 S %I1=%I-1 I %I1>20 D ^%L4MENU S:%I=0 %I=1 S %L2MN("IND")=%I G END S F10=0 I $D(%L2MN("F10")),%I1'>10 S F10=1 I $D(%L2MN("LEFT")) S %SM=%L2MN("LEFT") I $D(%L2MN("TOP")) S %SMY=%L2MN("TOP") I $D(%L2MN("TOP0")) S %SMY0=%L2MN("TOP0") I $D(%L2MN("NOCLR")) S %CLEAR=%L2MN("NOCLR") I '$D(%SM) S %SM=80-%LL-4\2 I %SM<1!(%SM>70) S %SM=80-%LL-4\2 S:%SM<3 %SM=3 S %SMX=%SM S:'$D(%SMY) %SMY=24-%I1-1\2 I %SMY>22 S %SMY=24-%I1-1\2 S:%SMY<1 %SMY=1 D PRE I $D(@%L1TXT) D .S:'$D(%SMY0) %SMY0=$G(%SMY)-2 S:%SMY0=0 %SMY0=1 S:%SMY0<0 %SMY0=0 .S %SAY=@%L1TXT_"++"_%SMY0_"," .I '$D(%L2MN("LEFT")) S %SAY=%SAY_(78-(80-$L($TR(@%L1TXT,"{}",""))\2))_",H,I" X %XMSG .I $D(%L2MN("LEFT")) S %SAY=%SAY_(%L2MN("LEFT")+$L(@%L1TXT))_",H,I" X %XMSG D CL0 ;;N %CL0 S %CL0=$C(27,91)_"45;37m" D PHON F %I=1:1:%I1 D .S %XX=%SMX,%YY=%I+%SMY X %POSIC D PCST I $D(%L2MN("VIEW")) K %L2MN Q S %XX=%SM,%YY=%SMY X %POSIC S %I=$G(%L2MN("IND"),1) D INV S %NOM="" CYC ; S (%A1,%B)=0 I 1 F R *%A:1 Q:$T D ^%L1MSGBR I $P($H,",",2)\60-%L2MT D S %L2MT=$P($H,",",2)\60 .N %M,%L,%I,%NP S %TIM=$ZD($H,"24:60") .W *27,7 S %SAY=" "_$$^%L1DC($H,1)_" "_%TIM_" ++0,59,E" X %XMSG W *27,8 READ G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $A(ZB0,1)=27,$D(%UPRCOD(ZB)),$T(@%UPRCOD(ZB))'="" G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC 27 ; I %A=27 D DELAY R *%A1:%WAIT G:%A1<0 ESC D DELAY R *%B:%WAIT G:%B>0&(%A1'=79) SERV I %A1<0 G ESC I %A=25 G ESC I %A=24 W *27,7 N %XXMNU,%YYMNU S %XXMNU=%XX,%YYMNU=%YY D ^%L1CLC W *27,8 S %XX=%XXMNU,%YY=%YYMNU X %POSIC S $X=%XX,$Y=%YY G CYC I %A=20,$G(^zms($I))?1"^"."%"1U.E W *27,7 N %XXMNU,%YYMNU S ($X,%XXMNU)=%XX,($Y,%YYMNU)=%YY,%LS=2 D ^%L1ZMST W *27,8 S %XX=%XXMNU,%YY=%YYMNU X %POSIC S $X=%XX,$Y=%YY G CYC G:%A=13 END I $G(%UPRCOD($ZB))="ESC" G ESC I $G(%A1)>0,$G(%B)>0 N %A1B S %A1B=%A1_%B I $D(%UPRCOD(%A1B)),$D(F(%UPRCOD(%A1B))) S %B=F(%UPRCOD(%A1B))+49 G SERV I $L($ZB)>3,$D(%UPRCOD($ZB)),$D(F(%UPRCOD($ZB))) S %B=F(%UPRCOD($ZB))+49 G SERV I $L($ZB)>3,$D(%UPRCOD($ZB)) S %B=$G(@("%"_%UPRCOD($ZB))) G SERV I %A=27 G SERV I $C(%A)?1N S %NOM=%NOM_$C(%A) I %NOM?2N,(%NOM+1)>%I1 S %NOM=$E(%NOM,2) I (%NOM+1)>%I1 S %A=8 U 0 W *7 I %A=8 S %NOM="" D CL S %IOLD=%I S %I=1 D VSV D SDVIG K %IOLD D INV G CYC I $C(%A)?1N D CL S %IOLD=%I S %I=%NOM+1 D VSV D SDVIG K %IOLD D INV G CYC G CYC END D CL0 ;;S %CL0=$C(27,91)_"44;37m" S %L3MOPT=$G(@%M) K %A,%B,%M,@MAC,%LL,%B1,%B2,%NOM X %XCL ;W %ENG W *27,*91,0,"m" I '$D(%CLEAR) X %chista ;E I %CLEAR=1 S %XX=0,%YY=%SMY-2 X %POSIC,%chiste ;E I %CLEAR=2 S %XX=0,%YY=%SMY+%I1+2 X %POSIC,%chiste K %SM,%SMX,%SMY,%I1,%L2MN W:$D(%HBRY) %HBR I $D(^HBB) W ^HBB Q VSV W *27,7 X %XCL S %SAY=$J($S(%NOM=""&(%I=1):" ",1:%I-1),2) X %XMSGN W *27,8 X %XCL Q SDVIG ; Q:%I=%IOLD I %I>%IOLD F %KK=1:1:%I-%IOLD W %vniz F %KK=1:1:%IOLD-%I W %vverx Q ;- ESC D CL S:'$D(%L2MN("ESC")) %I=1 G END SERV ;;G:%B'=%VVERX&(%B'=%VNIZ)&(%B'=%LEVO)&(%B'=%PRAVO)&($C(%B)'?1N.N) CYC I %B=%VVERX G VVERX I %B=%VNIZ G VNIZ I %B=%PRAVO G PRAVO I %B=%LEVO G LEVO I %B>78,%B<90,%A1=79 S %B=%B-30 ;----- F1 G:%B<48!(%B>(%I1+48)) CYC S %B1=%B-48,%B2=%I-%B1 I %B2<0 D CL S %I=%B1,%pn=-%B2-1 X %vverxn D INV G:F10 END G CYC I %B2>0 D CL S %I=%B1,%pn=%B2-1 X %vnizn D INV G:F10 END G CYC G CYC VVERX G:%I=1 VNM D CL S %I=%I-1 W %vverx D VSV,INV G:$G(@%M)["~" SERV G CYC VNIZ G:%I=%I1 VVM D CL S %I=%I+1 W %vniz D VSV,INV G:$G(@%M)["~" SERV G CYC PRAVO G:'$D(%L2MN("POP")) CYC D CL S %TOMN="RIGHT" G END LEVO G:'$D(%L2MN("POP")) CYC D CL S %TOMN="LEFT" G END ;- CL D CL0 X %XCL S %XX=%SMX,%YY=%I+%SMY X %POSIC D PCST Q PCST ; W %HBR N A,WD S A=$G(@%M),WD=%LL-$L(A)+9 ;;I $E($TR(A," ",""))="~" W $$KAV($E($$SPL^%L1FRM(A),2,255),WD) Q I $E($TR(A," ",""))="~" W $$KAV($E($$SPL^%L1FRM(A),2,255),%LL) Q I %ENGLISH W " "_$G(@%M),$J("",%LL-$L($G(@%M))-6)," - ",$$OPT(%I-1) Q W "- "_$$OPT(%I-1)_" -"_$J($$W^%L1C($G(@%M)),%LL-6) Q Q OPT(%NMB) Q $S(F10:$S(%NMB=0:"ESC",1:"F"_%NMB),1:$J(%NMB,2)) ;- INV W:'$G(%CVET) *27,*91,7,"m" W:$G(%CVET) %CV("RF"),%CV("WB") S %XX=%SMX,%YY=%I+%SMY X %POSIC D PCST X %XCL Q ;- KAV(%KOT,%DL) N KAV S KAV="" I %TYPCRT["VT" S KAV=$C(27)_"(0" D CL0 S KAV=KAV_$TR($J("",%DL-$L(%KOT)\2+1)," ",$S(%TYPCRT["VT":$C(113),1:"-")) I %TYPCRT["VT" S KAV=KAV_$C(27)_"(B" S KAV=KAV_%LIGHT1_%CV("YF")_%KOT_%CCL I %TYPCRT["VT" S KAV=KAV_$C(27)_"(0" S KAV=KAV_$TR($J("",%DL-$L(%KOT)\2-1)," ",$S(%TYPCRT["VT":$C(113),1:"-")) I %TYPCRT["VT" S KAV=KAV_$C(27)_"(B" Q KAV CL0 ; N BCGR S BCGR="MB" I %TYPCRT'="PC",%CVET S BCGR="BCB" I $D(%L2MN("CVB")) S BCGR=%L2MN("CVB") S %CL0=%CV(BCGR)_%CV("WF") S %CCL=$C(27,91,48,109)_%CL0 S %L1RBCL=%CL0 Q PRE ; X:'$D(%CLEAR)&'$D(%L2MN("NOCLB")) %chista D .N %M,%L,%I,%NP S %TIM=$ZD($H,"24:60") .I %TYPCRT="PC",'$D(%L2MN("NOCLB")) D ^%L1CH N %AT S %AT=$$^%L1HEAD("") I $L(%AT) S %SAY=%AT_"++0,"_(80-(80-$L(%AT)\2))_",H,I" X %XMSG X %XCL S %SAY=" "_$$^%L1DC($H,1)_" "_%TIM_" ++0,59,E" X %XMSG S %L2MT=$P($H,",",2)\60 I $D(^MSGSEND(+$$^%L1MRK("")))>9 W $C(27,91,72)_">>>" I $D(^PARSEND(+$$^%L1MRK("")))>9 S %SAY="

++0,4,EE,I" X %XMSG I $$NO^%L1CRDTC S %SAY="++0,6,EE,I" X %XMSG D HZGDEV I $D(%L2MN("T2")) X %L2MN("T2") Q PHON ; W %ENG X %XCL S %XX=%SM-1,%YY=%SMY+1 ;S %XX=%SM-3,%YY=%SMY-2 S Y1=%YY,X1=%XX,Y2=%YY+%I1+1,X2=%XX+%LL+4 D RBUA Q CVET W %CL("RB") W $J("",%LL+4) I $G(%CVET) W *27,*91,%CL0,"m" E W *27,*91,0,"m" Q VNM D CL S %I=%I1,%pn=%I1-1 X %vnizn D VSV,INV G CYC VVM D CL S %I=1,%pn=%I1-1 X %vverxn D VSV,INV G CYC Q RBUA ; INPUT X1,X2,Y1,Y2 S %L1RBCL="",%MENU="" I $D(%L2MN("CVB")) S %L1RBCL=$G(%CV(%L2MN("CVB"))) D ^%L1RBUA K %L1RBCL Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q HZGDEV ; N POS,DEV S POS=$$FUNC^%UCASE($$POS^%L2MOUSE) I POS=0 S POS="" S DEV=$P($P,"/",$L($P,"/")-1,$L($P,"/")) I $P(DEV,"/")="dev" S DEV=$P(DEV,"/",2) S %SAY=" "_%L3MYDVN_" "_$J($$FUNC^%UCASE(DEV),5)_" "_$J(POS,5)_" "_$J(%TYPCRT,5) S %SAY=%SAY_"++1,"_(79-$L(%SAY))_",EE,I" X %XMSG Q %L2MODEM %L2MODEM ; [ 07.05.07 16:50 ] [ 23.04.07 10:40 ] [ 08.02.06 18:17 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L2MODEM) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" ; S NMB=$G(%L2MODEM("MRKTO")) S GLOB=$G(%L2MODEM("GLOB")) S FL=$G(%L2MODEM("FL")) S PROG=$G(%L2MODEM("PROG")) S ADDR=$$SPA^%L1FRM($G(%L2MODEM("ADDR"))) S MDLKH=$G(%L2MODEM("NAMETO")) ; I $G(GLOB)="" D MSG(" ! xcyl dn oi` ") S %L2MODEM("ER")="1\NOGL" G ER I '$D(@GLOB) D MSG(" ! xcyl dn oi` ") S %L2MODEM("ER")="1\NOINGL" G ER I ADDR="" D MSG(" ! xcyl o`l oi` ") S %L2MODEM("ER")="1\NOADDR" G ER ; I $G(PROG)="" S PROG="%L2GTR1" ; I $G(ADDR)[".",$$^%L1ISFTP(PROG) S (PORTN,USERPORT)="" D G END .Q:'$$^%L1G2F(GLOB,FL) .D ^%L1FTP(ADDR,FL) I $ZSY G ES .N ENDFL S ENDFL=FL_".END" O ENDFL U ENDFL W "1",! C ENDFL .H 1 D ^%L1FTP(ADDR,ENDFL) ES .I $ZSY S %L2MODEM("ER")=$ZSY .I '$ZSY S %L2MODEM("OK")=1 .I $$^%L1ZOS(2,FL),$$^%L1ZOS(2,FL_".END") ; S ZT=$ZT,$ZT="" ;"G ER^%L2MODEM" S USERPHONE=$TR(ADDR,"-",",") S USERPORT=$G(%L2MODEM("MDPORT")),USERGLOB="" I USERPHONE="" D MSG(" ! xcyl o`l oi` ") S L2MODEM("ER")="3\PHONE" G ER S USERMOD=1,MDTRANS="" ; I $$DISP D .X %chista .S %L1RBCL=%CV("CF") .W %LIGHT1 D TV^%L1RBUA(20,5,24,76) X %XCL ; I '$$DISP S %L1RCV="" D ^%L2MD(USERPORT,1,USERPHONE,"T",$G(US),$G(%L2MODEM("XON")),MDLKH) I $G(%L1MDOK)'=1 S %L2MODEM("ER")="4\L2MD" G ER ; S PORTN=USERPORT I $D(%L2NALAN("DEV")) S (USERPORT,PORTN)=%L2NALAN("DEV") ; I '$D(%L2MODEM("UCI")) S %L2MODEM("UCI")="MGR" ; D ^%L1MDPRG(PORTN,%L2MODEM("UCI"),PROG) ; I $G(%L1MDPRG("ER")) S L2MODEM("ER")="5\L1MDPRG\"_%L1MDPRG("ER") G ER ; I GLOB'["^UTILITY($J)" D .K ^UTILITY($J) .S ^UTILITY($J,GLOB)="" ; K ^GTR000($J) ; K %L2MODEM("OK") ; I $$DISP D ^%L3GTR ; I '$$DISP D ^%L2GTR ; I $G(^L2G($J,"OK")) S %L2MODEM("OK")=1 ; K ^UTILITY($J) I $D(%L2MODEM("NOCLOSE")) G END ; I $L(PORTN),PORTN'=$P,'$D(%L2NALAN) D .C PORTN O PORTN::1 E Q .D ^%L1GETMD .C PORTN .D CLOSE^%L1MDLCK(USERPORT) ; I $D(%L2NALAN("DEV")) C %L2NALAN("DEV") ; END Q:'$$DISP I $D(%L2MODEM("ER")) D ER I $D(%L2MODEM("OK")),'$D(%L2MODEM("NOCLOSE")),$$DISP S %GET=" ugl . dglvda rvea xeciy " D N^%L1GET Q ; ER I $D(%L2MODEM("ER"))#2,$$DISP S %GET=" ugl . "_+%L2MODEM("ER")_" zexywzd z`iby " D N^%L1GET Q DISP(STAM) ; I $D(%L2MODEM("NODISP")) Q 0 Q 1 MSG(TXT) ; Q:'$$DISP U 0 S %SAY=TXT X %XMSGV(1) %L2MOUS0 %L2MOUSE ; [ 08.04.07 07:30 ] [ 28.03.07 16:58 ] [ 23.11.06 18:16 ] INIT(STAM) N OK ; N GLD S GLD=$$^%L1GLD I '$$HZGTOUCH Q 0 I '$D(@$$^W4DEVI@($P)) Q 0 S PORT=+$$PORT^%L1CRDTC I 'PORT Q 0 I PORT<0 S OK=1 G CRD N PORTN S PORTN=$G(^[GLD]dev(PORT)) I PORTN="" Q 0 C PORTN I $P'["/vc" D DELLOCK(PORTN) S OK=$$^%L1MDLCK(PORTN) I 'OK Q OK O PORTN S OK=1 CRD I '$D(@$$^W4DEVI@($P)) Q 0 S %XMIN=$$XMIN^%L1CRDTC S %XMAX=$$XMAX^%L1CRDTC S %YMIN=$$YMIN^%L1CRDTC S %YMAX=$$YMAX^%L1CRDTC Q OK REPORT(%PORT,%XMIN,%XMAX,%YMIN,%YMAX) ; N GLD S GLD=$$^%L1GLD N POS,CRD I %PORT<0 S POS=$$POS I POS'?.P S CRD=$G(^CRDTCH(POS)) S ^(POS)="?" D:CRD="" Q CRD .I $P["/pts/" S %SAY=" ! zcaer `l ^P1CRDTCH dpkez " X %XMSGV(1) I $G(%PORT)="" Q 0 N %I,%A,%B,%X,%Y,%CRD,%STAT S %CRD=0 CYC ; S %CRD=0,%DLY=0.1 K U U %PORT:(NOWRAP:NOECHO:NOESC:NOTERM:NOCENABLE:NOFILTER) I $D(%L2MOUSE("A")) S %A=%L2MOUSE("A") K %L2MOUSE("A") I $G(%A)=85 G CYC1 F %I=1:1:1000 R *%A:0 S:%A>0 U(%I)=%A Q:$C(%A)="U" I $C(%A)'="U" G:%A>0 CYC R *%A:%DLY S:%A>0 U(1)=%A I $C(%A)'="U" G END CYC1 S U(1)=%A S %DLY=.05 R *%A:%DLY I $C(%A)'="T" G CYC ; 1 - TOUCH S U(2)=%A R *%A:%DLY I %A<0 G END ; 2 - %STAT S U(3)=%A S %STAT=%A U %PORT S %X="" R *%A:%DLY R *%B:%DLY ; 3-4 - %X S U(4)=%A,U(5)=%B I %A<0!(%B<0) G END S %X=%A+(%B*256) S %Y="" U %PORT R *%A:%DLY R *%B:%DLY ; 5-6 - %Y S U(6)=%A,U(7)=%B I %A<0!(%B<0) G END S %Y=%A+(%B*256) S %B="" F %I=1:1:3 U %PORT R *%A:%DLY S:%A>0 %B=%B_$C(%A) S U(%I+7)=%A ; 7-9 I %X>($S(%XMAX<%XMIN:%XMIN,1:%XMAX)+100) G CYC I %Y>($S(%YMAX<%YMIN:%YMIN,1:%YMAX)+100) G CYC ;;N %I,%J F %I=1:1:20 D .F %J=1:1:10 W $C(0) .W "Ua00000000" .F %J=1:1:20 R *%A:0 F %J=1:1:200 R *%A:0 S %CRD=$$SCX(%X)_","_$$SCY(%Y)_","_%STAT END U $P Q %CRD ; SCX(%X) ; N %STEP S %STEP=%XMAX-%XMIN/79 Q %X-%XMIN\%STEP+1 SCY(%Y) ; N %STEP S %STEP=%YMAX-%YMIN/24 I %STEP<0 Q 25-(%Y-%YMAX\-%STEP) Q %Y-%YMIN\%STEP+1 ; DELLOCK(PORTN) ; N MDLOCK,OK,DJ S OK=1 S MDLOCK="/var/lock/LCK.."_$zparse(PORTN,"NAME") I $$EXIST^%L1ZOS(MDLOCK) D I OK zsy "rm "_MDLOCK .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .S DJ=$TR(A," ","") .ZSY "rm /var/lock/LCK..."_DJ Q ; KB(STAM) Q $$KB^%L1CRDTC ; PORT(STAM) N GLD S GLD=$$^%L1GLD I '$D(@$$^W4DEVI@($P)) Q 0 N PORT S PORT=$$PORT^%L1CRDTC Q:PORT="" 0 I PORT<0 Q PORT I $G(^[GLD]dev(PORT))="" Q 0 Q $G(^[GLD]dev(PORT)) ; HZGTOUCH(STAM) ; N GLD S GLD=$$^%L1GLD Q:'$D(@$$^W4DEVI@($P)) 0 N PORT S PORT=$$PORT^%L1CRDTC I 'PORT Q 0 I '$D(%TYPCRT) D ^%L1C I %TYPCRT'="PC" Q 0 I $$NO^%L1CRDTC Q 0 I $ZGLD["/mly.gld" Q 0 I $ZGLD["/mln.gld" Q 0 I '$D(%L1INIT),'$D(^P1HZMS($$^%L3MYDVN)),'$G(^P1PRM("TCHALL")) Q 0 N PORTN S PORTN=$G(^[GLD]dev(PORT)) I PORT>0,PORTN="" Q 0 Q 1 TCHONLY(STAM) I $$HZGTOUCH,'$$KB Q 1 Q 0 POS(STAM) ; I $P["/vc" Q 0 N GLD,POS S GLD=$$^%L1GLD S POS=$G(^[GLD]devi1($$^%L3MYDV)) I POS="",$P["/pts" H .1 D ^%L1DEFWS S POS=$G(^[GLD]devi1($P),0) I POS="" S POS=0 Q POS %L2MOUSE %L2MOUSE ; [ 06.04.09 14:41 ] [ 18.03.09 13:54 ] [ 10.03.09 13:20 ] INIT(STAM) N OK ; N GLD S GLD=$$^%L1GLD I '$$HZGTOUCH Q 0 I '$D(@$$^W4DEVI@($P)) Q 0 S PORT=+$$PORT^%L1CRDTC I 'PORT Q 0 I PORT<0 S OK=1 G CRD N PORTN S PORTN=$G(^[GLD]dev(PORT)) I PORTN="" Q 0 C PORTN I $P'["/vc" D DELLOCK(PORTN) S OK=$$^%L1MDLCK(PORTN) I 'OK Q OK O PORTN S OK=1 CRD I '$D(@$$^W4DEVI@($P)) Q 0 S %XMIN=$$XMIN^%L1CRDTC S %XMAX=$$XMAX^%L1CRDTC S %YMIN=$$YMIN^%L1CRDTC S %YMAX=$$YMAX^%L1CRDTC Q OK REPORT(%PORT,%XMIN,%XMAX,%YMIN,%YMAX) ; N GLD S GLD=$$^%L1GLD N POS,CRD I %PORT<0 S POS=$$POS I POS'?.P S CRD=$G(^CRDTCH(POS)) S ^(POS)="?" D:CRD="" Q CRD .I $P["/pts/" S %SAY=" ! zcaer `l ^P1CRDTCH dpkez " X %XMSGV(1) I $G(%PORT)="" Q 0 N %I,%A,%B,%X,%Y,%CRD,%STAT S %CRD=0 CYC ; S %CRD=0,%DLY=0.1 K U U %PORT:(NOWRAP:NOECHO:NOESC:NOTERM:NOCENABLE:NOFILTER) I $D(%L2MOUSE("A")) S %A=%L2MOUSE("A") K %L2MOUSE("A") I $G(%A)=85 G CYC1 F %I=1:1:100 R *%A:0 S:%A>0 U(%I)=%A Q:$C(%A)="U" I $C(%A)'="U" H %DLY G:%A>0 CYC H %DLY R *%A:0 S:%A>0 U(1)=%A S ^IRA(99999)="OK" I $C(%A)'="U" G END CYC1 S U(1)=%A S %DLY=0 H %DLY S %DLY=0 R *%A:%DLY I $C(%A)'="T" G CYC ; 1 - TOUCH S U(2)=%A R *%A:%DLY I %A<0 G END ; 2 - %STAT S U(3)=%A I U(3)'=4 G CYC S %STAT=%A U %PORT S %X="" R *%A:%DLY R *%B:%DLY ; 3-4 - %X S U(4)=%A,U(5)=%B I %A<0!(%B<0) G END S %X=%A+(%B*256) S %Y="" U %PORT R *%A:%DLY R *%B:%DLY ; 5-6 - %Y S U(6)=%A,U(7)=%B I %A<0!(%B<0) G END S %Y=%A+(%B*256) S %B="" F %I=1:1:3 U %PORT R *%A:%DLY S:%A>0 %B=%B_$C(%A) S U(%I+7)=%A ; 7-9 I %X>($S(%XMAX<%XMIN:%XMIN,1:%XMAX)+100) G CYC I %Y>($S(%YMAX<%YMIN:%YMIN,1:%YMAX)+100) G CYC ;;N %I,%J F %I=1:1:20 D .F %J=1:1:10 W $C(0) .W "Ua00000000" .F %J=1:1:20 R *%A:0 F %J=1:1:200 R *%A:0 S %CRD=$$SCX(%X)_","_$$SCY(%Y)_","_%STAT END U $P Q %CRD ; SCX(%X) ; N %STEP S %STEP=%XMAX-%XMIN/79 Q %X-%XMIN\%STEP+1 SCY(%Y) ; N %STEP S %STEP=%YMAX-%YMIN/24 I %STEP<0 Q 25-(%Y-%YMAX\-%STEP) Q %Y-%YMIN\%STEP+1 ; DELLOCK(PORTN) ; N MDLOCK,OK,DJ S OK=1 S MDLOCK="/var/lock/LCK.."_$zparse(PORTN,"NAME") I $$EXIST^%L1ZOS(MDLOCK) D I OK zsy "rm "_MDLOCK .C MDLOCK O MDLOCK:(REWIND:READONLY) U MDLOCK R A C MDLOCK .S DJ=$TR(A," ","") .ZSY "rm /var/lock/LCK..."_DJ Q ; KB(STAM) Q $$KB^%L1CRDTC ; PORT(STAM) N GLD S GLD=$$^%L1GLD I '$D(@$$^W4DEVI@($P)) Q 0 N PORT S PORT=$$PORT^%L1CRDTC Q:PORT="" 0 I PORT<0 Q PORT I $G(^[GLD]dev(PORT))="" Q 0 Q $G(^[GLD]dev(PORT)) ; HZGTOUCH(STAM) ; ;;Q 1 N GLD S GLD=$$^%L1GLD Q:'$D(@$$^W4DEVI@($P)) 0 N PORT S PORT=$$PORT^%L1CRDTC I 'PORT Q 0 I '$D(%TYPCRT) D ^%L1C I %TYPCRT'="PC" Q 0 I $$NO^%L1CRDTC Q 0 I $ZGLD["/mly.gld" Q 0 I $ZGLD["/mln.gld" Q 0 I '$D(%L1INIT),'$D(^P1HZMS($$^%L3MYDVN)),'$G(^P1PRM("TCHALL")) Q 0 N PORTN S PORTN=$G(^[GLD]dev(PORT)) I PORT>0,PORTN="" Q 0 Q 1 TCHONLY(STAM) I $$HZGTOUCH,'$$KB Q 1 Q 0 POS(STAM) ; I $P["/vc" Q 0 N GLD,POS S GLD=$$^%L1GLD S POS=$G(^[GLD]devi1($$^%L3MYDV)) ;;I POS="",$P["/pts" H .1 D ^%L1DEFWS S POS=$G(^[GLD]devi1($P),0) I POS="" S POS=0 Q POS %L2NALAN %L2NALAN(ADDR,PORT) ; [ 03.08.11 08:47 ] [ 29.08.10 17:18 ] [ 07.12.09 12:01 ] N ER,PORTN S ER=0 K %L2NALAN I ADDR["P" S ADDR=$P(ADDR,"P") S PORTN="SCK$"_$J ;;I '$$^%L1TSTPR($TR(ADDR,".",""),ADDR) S ER=-1.1,%L2NALAN("ER")=ER C PORTN Q ER D ^%L2CLNT(ADDR,PORT,3,PORTN) ;3 I $G(^SCKCLI($J))<0 S ER=^($J) I 'ER S %L2NALAN("DEV")=PORTN I ER S %L2NALAN("ER")=ER C PORTN Q ER %L2NMB %L2NMB(STAM) ; [ 11.03.07 14:03 ] [ 14.01.07 17:41 ] [ 09.01.07 05:30 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%NMB,%BEG,screen,%L2NMB) D ^%L1C U $P:(NOECHO:NOWRAP:CENABLE:CTRAP=$C(3)) S %W=0 I $G(%PRKB) S %W=.1 BG00 S (%C0,%C00)="" BG0 ; BG ; S %L1NMB("X0")=0,%L1NMB("Y0")=0,%L1NMB("X2")=80,%L1NMB("Y2")=25 I $G(%BEG)=1 D GET^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) S %BEG=2 D IN S %TO="" I $D(%NMB) S SH=%NMB W $C(27,91),"?25l" READ0 S SH1=SH READ ; I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 ; I %MOUSE S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I %CRD D G:OK END .S %PRKB=0 .S %XX=$P(%CRD,",",1),%YY=$P(%CRD,",",2) .S N="",OK=0 F S N=$O(%L2NMB("MTXT",N)) Q:N="" D Q:OK ..I %L2NMB("MTXT",N,"X")-1'>%XX,%L2NMB("MTXT",N,"X")+%L2NMB("MTXT",N,"SX")+1'<%XX,%L2NMB("MTXT",N,"Y")-1'>%YY,%L2NMB("MTXT",N,"Y")+%L2NMB("MTXT",N,"SY")+1'<%YY S OK=1 .I OK S %TO="#"_%L2NMB("MTXT",N,"C") Q .S N="",OK=0 F S N=$O(%L2NMB("MFUNC",N)) Q:N="" D Q:OK ..I %L2NMB("MFUNC",N,"X")-1'>%XX,%L2NMB("MFUNC",N,"X")+%L2NMB("MFUNC",N,"SX")+1'<%XX,%L2NMB("MFUNC",N,"Y")-1'>%YY,%L2NMB("MFUNC",N,"Y")+%L2NMB("MFUNC",N,"SY")+1'<%YY S OK=1 .I OK S %TO="$"_%L2NMB("MFUNC",N,"C") Q ; READ1 ; I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 U $P:(NOECHO:NOWRAP) R *%C:0 E H .02 R *%C:0 G:'$T READ I %C'=13,%C'=10 S %PRKB=1 27 I %C=27 D DELAY R *%C1:%WAIT G:%C1<0 ESC D I C,$D(%UPRCOD(C)) X "N %CC F R *%CC:0 E Q" G:$T(@%UPRCOD(C))="" TO K %FLL G @%UPRCOD(C) .S C="" Q:%C1=27 D DELAY R *%C2:%WAIT Q:%C2=27 S:%C2>0 C=%C1_%C2 Q:%C2<0 Q:$D(%UPRCOD(C)) .R *%C3:%WAIT Q:%C3=27 S:%C3>0 C=C_%C3 Q:$D(%UPRCOD(C)) Q:%C3<0 .R *%C4:%WAIT Q:%C4=27 S:%C4>0 C=C_%C4 I $G(%C1)=27 S %C=27 K %C1 G 27 I $G(%C2)=27 S %C=27 K %C2 G 27 I $G(%C3)=27 S %C=27 K %C3 G 27 I $G(%C4)=27 S %C=27 K %C4 G 27 I %C=27 G 27 I %C=0 S %TO="" D DELAY R *%C1:%WAIT D DELAY R *%C2:%WAIT I %C1>0 S %C=$S(%C1<104!(%C1>113&(%C1<121))!(%C1>129):"0"_%C1,1:60+%C1) I %C=13!(%C=10) S %TO=$G(%L2NMB("MTXT",SH,"C"),"") G END I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" G @%UPRCOD(%C) BD ; I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))="" S %TO=%UPRCOD(%C) G END I $C(%C)="=" S %TO=$C(%C) G END S %TO=$TR($C(%C),%TES2,%TES1) I $C(%C)="." S %TO=$C(%C) I $C(%C)="/" S %TO=$C(%C) G END TO K %FLL S %TO=%UPRCOD(C) G END VNIZ ; S %TO="DW" G END VVERX ; S %TO="UP" G END PRAVO ; S %TO="RIGHT" G END LEVO ; S %TO="LEFT" G END PGUP ; S %TO="PGUP" G END PGDN ; S %TO="PGDW" G END SAVE ; S %TO="F9" G END ESC ; S %TO="END" G END END ; I '$D(%TO) S %TO="" ; I $G(%C2)=27!($G(%C3)=27)!($G(%C4)=27) S C2=27 K %C2,%C3,%C4 U $P:(NOECHO:NOWRAP) W $C(27,91),"?25h" I %TO'=".",%TO'="/" Q $TR(%TO,%TES1,%TES2) I %TO="." Q "." I %TO="/" Q "/" ; Q IN ; S %PREV="" S:'$D(SH1) SH1=1 S:'$D(%NMB) %NMB=1 N %L1INIT S %L1INIT="" S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE Q CLCDN Q DELAY Q PUT ; I $D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) D .D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) Q %L2RBUA %L1RBUA ; INPUT X1,X2,Y1,Y2 [ 11.12.06 19:48 ] [ 31.10.03 12:14 ] [ 10/30/2000 6:36 PM ] RBUA ; INPUT X1,X2,Y1,Y2 RBUA1 N I,J,%YY,%XX W %ENG U $P:(NOECHO:NOWRAP) ;I $D(%L1RBCL) W:$G(%CVET) %CV("MB") F I=Y1:1:Y2-1 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) I $D(%L1RBCL) D CLEAR(Y1,X1,Y2,X2) ;I %TYPCRT["PC" W $C(27,91),Y1,";",X1,";",Y2,";",X2,"b" H:%TYPCRT["PC1" 1 Q I %TYPCRT["PC",%XMSG(0)'<0 D Q .W *27,"["_Y1_";"_X1_"H" W $S($G(%L1RBCL)=%CV("MB"):%CV("MB"),1:%CV("CB")) .F I=X1:1:X2 W " " .F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H"," " .W *27,"["_Y2_";"_X1_"H" F I=X1:1:X2 W " " .X %XCL I %TYPCRT["PC",%XMSG(0)<0 D Q .W *27,"["_Y1_";"_X1_"H" .W $C(218) F I=X1+1:1:X2-1 W $C(196) .W $C(191) .F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(179) .W *27,"["_Y2_";"_X1_"H" W $C(192) F I=X1+1:1:X2-1 W $C(196) .W $C(217) .X %XCL I %TYPCRT["-" D TV1(Y1-1,X1-1,Y2-1,X2-1) Q ;;I %TYPCRT="VT520" W $C(27,91)," ",Y1,";",X1,";",Y2,";",X2,"$x" Q I %TYPCRT["VT" W *27,"(0" I %TYPCRT="VT100" W *27,"["_Y1_";"_X1_"H",$C(104) F I=X1+1:1:X2-1 W $C(116) E W *27,"["_Y1_";"_X1_"H",$C(108) W $TR($J("",X2-X1-1)," ",$C(113)) ; F I=X1+1:1:X2-1 W $C(113) W *27,"["_Y1_";"_X2_"H" W $C(107) I %TYPCRT="VT100" F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(112) E F I=Y1+1:1:Y2-1 F J=X1,X2 W *27,"["_I_";"_J_"H",$C(120) I %TYPCRT="VT100" W *27,"["_Y2_";"_X1_"H",$C(105) F I=X1+1:1:X2-1 W $C(116) E W *27,"["_Y2_";"_X1_"H",$C(109) W $TR($J("",X2-X1-1)," ",$C(113)) ; F I=X1+1:1:X2-1 W $C(113) W *27,"["_Y2_";"_X2_"H" W $C(106) I %TYPCRT["?",'$D(%MENU) H 1 I %TYPCRT["VT" W *27,"(B" Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q TV(Y1,X1,Y2,X2) ; I Y1=Y2 D Q ;-- LINE .N %XX,%YY .I $E(%TYPCRT,1,2)["PC" D Q ..S %XX=X1,%YY=Y1 X %POSIC N %I F %I=X1:1:X2 W $C(196) .W $C(27),"(0" S %XX=X1,%YY=Y1 X %POSIC N %I F %I=X1:1:X2 W $C(113) .W $C(27),"(B" D BDK ;I %ENGLISH S X1=X1-1 G RBUA TV1(Y1,X1,Y2,X2) ; N %XX,%YY,%I S %XX=X1,%YY=Y1 X %POSIC F %I=X1:1:X2 W "-" F %I=Y1+1:1:Y2-1 S %XX=X1,%YY=%I X %POSIC W "|" S %XX=X2,%YY=%I X %POSIC W "|" S %XX=X1,%YY=Y2 X %POSIC F %I=X1:1:X2 W "-" Q CLEAR(Y1,X1,Y2,X2) ; D BDK N %XX,%YY,I I %TYPCRT["VT5",%L1RBCL=%CV("BB")!'%CVET W $C(27,91),Y1+1,";",X1+1,";",Y2,";",X2-1,"$z" Q I $G(%CVET),$L($G(%L1RBCL)) N %N S %N="" F S %N=$O(%CV(%N)) Q:%N="" I %L1RBCL=%CV(%N) W %L1RBCL Q U $P:(NOECHO:NOWRAP) F I=Y1:1:Y2-1 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q BDK ; I X1<0,X2>0 D .N R S R=X2-X1,X1=X2,X2=X2+R I X1>X2 D .N X0 S X0=X1,X1=X2,X2=X0 Q %L2RCMP %L2RCMP ;JWC;COMPARE ROUNTINES {BETWEEN UCI'S} [ 03.01.03 5:07 PM ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S %WH=30,%SP=.55,%LL="B" K ^TMPS111($J) S %N=$G(^UTILITY($J,1),1) S %DN=$G(^UTILITY($J,2),2) S %ES=$O(^UTILITY($J,1,%N,999999),-1) F %ES=%ES:-1:1 Q:$G(^(%ES))'="" S %ED=$O(^UTILITY($J,2,%DN,999999),-1) F %ED=%ED:-1:1 Q:$G(^(%ED))'="" NOE ; D W($J("= STATUS = === LINES FROM "_%N_" ===",%WH+14)_"=== LINES FROM "_%DN_" ===") S (%Q,%LCT,%TTL,%TAD,%TSM,%TMD,%TDL)=0,%D=1 F %S=1:1:%ES S %DD=%D D RATE,FRMT Q:%Q Q:%Q G:%D>%ED STA S %DD=%D,%D=%ED+1 D DLT Q:%Q STA D W("") G ESTA D W($J("STATISTICS: "_$S(%TSM:%TSM,1:"ZERO"),16)_" LINE"_$S(%TSM'=1:"S ARE",1:" IS")_" THE SAME") D W($J($S(%TMD:%TMD,1:"ZERO"),28)_" LINE"_$S(%TMD'=1:"S",1:"")_" MODIFIED IN SOURCE ROUTINE") D W($J($S(%TAD:%TAD,1:"ZERO"),28)_" LINE"_$S(%TAD'=1:"S",1:"")_" ADDED TO SOURCE ROUTINE") D W($J($S(%TDL:%TDL,1:"ZERO"),28)_" LINE"_$S(%TDL'=1:"S",1:"")_" DELETED FROM SOURCE ROUTINE") ESTA K ^UTILITY($J,1),^(2) Q ; RATE S %X=^UTILITY($J,1,%N,%S) I %D>%ED S %P=0 Q D LRT Q:%P>%SP K %T S %TP=0 F %=2:1:$L(%X," ") S %LX=$P(%X," ",%) D:(%LX'="") RAT1 RAT0 I %TP>2 X "F %=1:1:%TP S %P=%P+(%Y[%T(%))" S %P=%P/%TP Q:%P>%SP!(%D=%ED)!(%D=(%DD+7)) S %D=%D+1 D LRT Q:%P>%SP G RAT0 RAT1 I %LX'="" S %TP=%TP+1,%T(%TP)=" "_%LX Q:%T(%TP)'["," S %T=%T(%TP),%TP=%TP-1 F %I=1:1:$L(%T,",") S %TP=%TP+1,%T(%TP)=$P(%T,",",%I) Q LRT S %Y=^UTILITY($J,2,%DN,%D) I %X=%Y S %P=2 QUIT S %LX=$P(%X," ",1),%LY=$P(%Y," ",1) S %P=(%LX'="")&(%LY'="")&(%LX=%LY) Q FRMT G:%P>%SP FMT1 S %Y="" D DSP S %D=%DD Q FMT1 G:%D=%DD FMT2 S %T=%X,%TY=%Y D DLT S %X=%T,%Y=%TY FMT2 D DSP S %D=%D+1 Q DLT S %X="" F %DD=%DD:1:%D-1 S %Y=^UTILITY($J,2,%DN,%DD) D DSP Q:%Q Q DSP S %V=$S(%X="":"%TDL",%Y="":"%TAD",%P=2:"%TSM",1:"%TMD") S @%V=@%V+1,%Q=0,%TTL=%TTL+1 Q:(%LL="B"&(%P=2))!(%LL="S") D W($$ENG^%L1FRM("["_$S(%X="":"DELETED ",%Y="":" ADDED ",%P=2:" SAME ",1:"MODIFIED")_"]"_$E(%X,1,%WH+2),%WH+12)_" <> "_$E(%Y,1,%WH+2)) S %LX=$L(%X),%LY=$L(%Y),%LM=$S(%LX>%LY:%LX,1:%LY) F %=%WH+3:%WH:%LM D .D W($$ENG^%L1FRM($E(%X,%,%+%WH-1),%WH+12)_" <> "_$E(%Y,%,%+%WH-1)) Q W(TXT) ; S ^TMPS111($J,$O(^TMPS111($J,99999),-1)+1)=TXT Q %L2RCPRG %L2RCPRG ; [ 07.07.01 6:07 PM ] [ 01/04/2000 3:33 PM ] [ k ^l1trprg D ^%L2GTR1 S N="" F S N=$O(^l1trprg(N)) Q:N="" D .X "X ""ZR F I=1:1 Q:'$D(^l1trprg(N,I)) ZI ^(I)"" ZS @N" ;k ^l1trprg Q %L2RI %L2RI(%PROG) ; GTM ROUTINE RESTORE [ 29.09.26 09:35 ] [ 22.09.26 09:33 ] [ 20.07.26 07:37 ] ;Converts mumps routines from a standard routine output (RO) ;file to individual *.m files. ;possible enhancements: ;selection and/or exclusion by list, range and/or wildcard ;optional confirmation by routine name ;callable entry point ; I '$D(%zdebug) n $et s $et="zg "_$zl_":ERR^%L2RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI") ; I $G(%PROG)'="" S %L2RI("PROG")=%PROG ; I $G(%L2RI("PROG"))="" G BG ; n sel,dir,ff,%ZD s sel=0,dir="",ff="" ; s %ZD=%L2RI("PROG") Q:%ZD="" I %ZD'["/" S %ZD="/home/gtmuser/"_%ZD I $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/downloads/"_$E(%ZD,2,255) U 0 W !,%ZD o %ZD:(REWIND:READONLY) u %ZD:exception="zg "_$zl_":eof" G REST ; BG w !,"Routine Input Utility - Converts RO file to *.m files.",! ;;i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%L2RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI") n d,dir,ff,l,r,x,y,%ZD,ff r !,"Formfeed delimited ? ",x s ff=$s($e($tr(x,"u","U"))="Y":$c(13,12),1:"") f d q:$l(%ZD) . r !,"Input file : ",%ZD,! . i '$l(%ZD) s %ZD="^" q . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for input" . . w !,"If you wish to exit enter a carat (^)",! .I $E(%ZD)="." S %ZD="/home/gtmuser/ppj-transfer/downloads/"_$E(%ZD,2,255) .i $e(%ZD)=">" S %ZD="/home/gtmuser/"_$E(%ZD,2,255) .i $e(%ZD,1,3)="mu>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/"_$E(%ZD,4,255) .i $e(%ZD,1,3)="ml>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/mly/"_$E(%ZD,4,255) .i $e(%ZD,1,2)="a>"!($E(%ZD,1,2)="A:")!($E(%ZD,1,2)="a:") S %ZD="/mnt/floppy/"_$E(%ZD,3,255) . I %ZD["/mnt/floppy" D ^%L1FLOP . i $zparse(%ZD)="" w " no such device" s %ZD="" q . o %ZD:(readonly:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" u %ZD:exception="zg "_$zl_":eof" r x,y u $p w !,x,!,y,!! r !,"Output directory : ",dir,!! i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q f r !,"Selective restore ? (y/n) : ",sel,! s sel=$$FUNC^%LCASE($E(sel)) s:sel="" sel="n" i sel="y"!(sel="n") q s sel=(sel="y") REST s rest="n" i 'sel s rest="y" i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q s (l,r,exit)=0 N PROG f u %ZD r x i $l(x),$e(x)?1a!($e(x)="%"),$e(x,2,99)?.an d q:exit .S PROG=x .i sel d w ! q:exit q:rest="n"!(rest="s") . .U $P w !,x . .i rest="c"!((rest="s")&(x=unr))!("cs"'[rest) d ZREST . .w " -- "_$s(rest="s"!(rest="n"):"Not ",1:"")_"restored" . . ;warning - loop terminated by exception . i 'sel u $p w:$x>70 ! w x,?$x\10+1*10 . . s x=dir_$tr($e(x),"%","_")_$e(x,2,9999)_".m",r=r+1 ;convert % to _ . o x:(newversion:noreadonly:blocksize=2048:recordsize=2044) . f u %ZD r y q:y=ff s l=l+1 u x w $s(y="":" ",1:y),! . c x .;;u $P ZLINK $tr(PROG,"%","_") ; -- 31/01/24 eof u $p i $l(x) c x w !!,"Restored ",l," line",$s(l=1:"",1:"s") w " in ",r," routine",$s(r=1:".",1:"s.") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR u $p w !,$p($zs,",",2,99),! s $ec="" ; Warning - Fall-though EXIT i $d(%ZD),%ZD'=$p c %ZD u $p:(ctrap="":exc="") q ZREST ; n new s unr="" u $p w ?10," -- restore ? (y/n/s/c/r) " r rest s:rest="" rest="n" i rest="^" s exit=1 q s rest=$$FUNC^%LCASE($e(rest)) i "ynscr"'[rest w *7 w ! g ZREST I rest="s"!(rest="c") w " until : " r unr i unr=""!(unr="^") w ! G ZREST i rest="r" d .f r !?5," Enter new name : ",new i $l(new),$e(new)?1a!($e(new)="%"),$e(new,2,99)?.an s x=new q q %L2RI0 %L2RI ; GTM ROUTINE RESTORE [ 31.01.24 07:42 ] [ 09.05.06 07:03 ] [ 26.04.06 12:49 ] ;Converts mumps routines from a standard routine output (RO) ;file to individual *.m files. ;possible enhancements: ;selection and/or exclusion by list, range and/or wildcard ;optional confirmation by routine name ;callable entry point ; w !,"Routine Input Utility - Converts RO file to *.m files.",! i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI") n d,dir,ff,l,r,x,y,%ZD,ff r !,"Formfeed delimited ? ",x s ff=$s($e($tr(x,"u","U"))="Y":$c(13,12),1:"") f d q:$l(%ZD) . r !,"Input file : ",%ZD,! . i '$l(%ZD) s %ZD="^" q . i %ZD="^" q . i %ZD="?" d q . . w !!,"Select the device you want for input" . . w !,"If you wish to exit enter a carat (^)",! .i $e(%ZD)=">" S %ZD="/home/lev/"_$E(%ZD,2,255) .i $e(%ZD,1,3)="mu>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/"_$E(%ZD,4,255) .i $e(%ZD,1,3)="ml>" S %ZD=$$^%L1ENVAR("gtm_dist")_"/mly/"_$E(%ZD,4,255) .i $e(%ZD,1,2)="a>"!($E(%ZD,1,2)="A:")!($E(%ZD,1,2)="a:") S %ZD="/mnt/floppy/"_$E(%ZD,3,255) . I %ZD["/mnt/floppy" D ^%L1FLOP . i $zparse(%ZD)="" w " no such device" s %ZD="" q . o %ZD:(readonly:block=2048:record=2044:exception="g noopen"):0 . i '$t w !,%ZD," is not available" s %ZD="" q . q noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD="" q:%ZD="^" u %ZD:exception="zg "_$zl_":eof" r x,y u $p w !,x,!,y,!! r !,"Output directory : ",dir,!! i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q f r !,"Selective restore ? (y/n) : ",sel,! s sel=$$FUNC^%LCASE($E(sel)) s:sel="" sel="n" i sel="y"!(sel="n") q s sel=(sel="y") s rest="n" i 'sel s rest="y" i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q s (l,r,exit)=0 f u %ZD r x i $l(x),$e(x)?1a!($e(x)="%"),$e(x,2,99)?.an d q:exit .i sel d w ! q:exit q:rest="n"!(rest="s") . .U $P w !,x . .i rest="c"!((rest="s")&(x=unr))!("cs"'[rest) d ZREST . .w " -- "_$s(rest="s"!(rest="n"):"Not ",1:"")_"restored" . . ;warning - loop terminated by exception . i 'sel u $p w:$x>70 ! w x,?$x\10+1*10 . . s x=dir_$tr($e(x),"%","_")_$e(x,2,9999)_".m",r=r+1 ;convert % to _ . o x:(newversion:noreadonly:blocksize=2048:recordsize=2044) . f u %ZD r y q:y=ff s l=l+1 u x w $s(y="":" ",1:y),! . c x eof u $p i $l(x) c x w !!,"Restored ",l," line",$s(l=1:"",1:"s") w " in ",r," routine",$s(r=1:".",1:"s.") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR u $p w !,$p($zs,",",2,99),! s $ec="" ; Warning - Fall-though EXIT i $d(%ZD),%ZD'=$p c %ZD u $p:(ctrap="":exc="") q ZREST ; n new s unr="" u $p w ?10," -- restore ? (y/n/s/c/r) " r rest s:rest="" rest="n" i rest="^" s exit=1 q s rest=$$FUNC^%LCASE($e(rest)) i "ynscr"'[rest w *7 w ! g ZREST I rest="s"!(rest="c") w " until : " r unr i unr=""!(unr="^") w ! G ZREST i rest="r" d .f r !?5," Enter new name : ",new i $l(new),$e(new)?1a!($e(new)="%"),$e(new,2,99)?.an s x=new q q %L2RSIS %L1RSIS(TIME) ; [ 19.05.08 11:39 ] [ 02.01.08 12:09 ] [ 29.10.06 18:42 ] N MAX,%WT S %WT=0 S MAX=19 S CARDONLY=+$G(^[^UCI("MGG")]P1PRM("IOCARD")) I $$^%L1ZU(0)="MLY" S CARDONLY=0 S SIS=$$READ(MAX,$G(^[^UCI("MGG")]P1PRM("IOCARD"))) I $L(SIS)=12 S SIS=+$E(SIS,3,10) I $L(SIS)=18 S SIS=+$E(SIS,6,13) Q SIS READ(MAX,CARDONLY) ; N %pn,J,S,TSTART,SIS S SIS="" S %pn=MAX X %levon U $P:(NOWRAP:NOECHO) S SIS="",%BEG=1 F J=1:1:MAX D READS Q:S=13!(S=27)!(S=0) D .I J=1 S TSTART=$P($H,",",2) .I S=8!(S=127),$L(SIS)>0 S SIS=$E(SIS,1,$L(SIS)-1) W $C(8)," ",$C(8) S J=J-2 Q .I S=8!(S=127),'$L(SIS) Q .S SIS=SIS_$C(S) W "*" ; I $$TCHONLY D .D PUT^%L1NMB .S %SAY="" X %XMSGN ; I $G(CARDONLY),$D(TSTART),$P($H,",",2)-TSTART>+$G(TIME),$E(SIS,$L(SIS))'="!" S %SAY=" ! cala qihxk " X %XMSGV(1) Q 0 I $E(SIS,$L(SIS))="!" S SIS=$E(SIS,1,$L(SIS)-1) I S=27!(S=0) D Q 0 .F R *S:0 Q:S=-1 ; I $ZB=27!(SIS="") Q "" I $E(SIS)=";"!($E(SIS)="s") S SIS=$E(SIS,2,255) I $P($G(^[^UCI("MGG")]PL("BF")),"<>")=$E(SIS) S SIS=$E(SIS,2,20) I $P($G(^[^UCI("MGG")]PL("BF")),"<>",2)=$E(SIS,$L(SIS)) S SIS=$E(SIS,1,$L(SIS)-1) Q SIS READS ; N %C I '$D(%WT) S %WT=.5 RS0 R *%C:%WT I %C>0 S S=%C,%WT=1 Q I $$TCHONLY D S:'$D(S) S=0 Q .K %L1NMB("ALB") S %L1NMB("ZY")=$G(%YY,23) .W *27,7 RS1 .S %NMB=7,S=$$^%L1NMB("") S %WT=$S($G(%PRKB):1,1:.1) K %PRKB .I S="ENTER" S S=13 G ERS1 .I S="ESC" S S=27 G ERS1 .I S="DEL" S S=8 G ERS1 .I $L(S)>1 G RS1 .S S=$A(S) ERS1 . .W *27,8 ; R *S S %WT=1 Q TCHONLY(STAM) ; I $$TCHONLY^%L2MOUSE&$G(^P1PRM("SISTCH")) Q 1 Q 0 %L2RTR %L2RTR ; [ 01/12/94 4:42 PM ] ; HAGDARAT PORT: 1200+EP+7B+1,0,NO ECHO,PALL ? D ^%L1C X %chista Z0 S %GET="PORT:++6,10,E#++2,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S PORT=%S Z S %GET="ROUTINE NAME:#8" D NE^%L1GET I %S=""!($G(%TO)="END") G Z0 I '$D(^ (%S)) W " ???",*7 G Z S ROU=%S U 0 W # O PORT::2 E S %SAY=" LINE IN USE " X %XMSGV(1) G Z0 ;U PORT:(0::::8388608+(9*4096)+(5*16)+9) U PORT:(0::::#840001) F R A:1 Q:'$T W $C(7),$C(13),$C(7),$C(13),"%L2RTR1",$C(13) S ST=$C(2)_$C(4)_%S W ST_$C(13) F R A:1 Q:'$T S X0="S ER=0 X X1 W:'ER $C(6),$C(13) W:ER $C(7),$C(13)" S X1="ZR ZL @ROU U PORT F I=1:1 Q:$T(+I)="""" S ST=$T(+I),OK=1 S ST2=I_$C(2)_ST X X2 Q:ER" S X2="S A=0 X X4 S:IJ=6&'$T ER=1 Q:ER" S X4="F IJ=1:1:6 U PORT W ST2_$C(13) X X5 U 0 W:OK ST2,! W:'OK ""?"",IJ Q:OK" S X5="S OK=0 F IJ1=1:1:10 U PORT R A:6 U 0 W:IJ1>1 ""."" I $TR(A,$C(2),"""")=$TR(ST2,$C(2),"""") S OK=1 Q" X X0 %L2RTR1 %L2RTR1 ; [ 01/12/94 4:40 PM ] S SH=0,ER=0 k ^rtr($J),RN U 0:(0::::#840001) F R A Q:A=$C(6)!(A=$C(7)) D .S SH=$P(A,$C(2)) I A'[$C(4) W A,$C(13) .S ST1=$P(A,$C(2),2) .I ST1[$C(4) S RN=$P(ST1,$C(4),2) K ^rtr($J) Q .I SH S ^rtr($J,SH)=ST1 I A=$C(6) X "X ""ZR F I=1:1 Q:'$D(^rtr($J,I)) ZI ^(I)"" ZS @RN" %L2RTR2 %L2RTR2 ; [ 02/23/94 12:52 PM ] X %chista S %SAY=" %L2RTR dxard " X %XMSGV K ^B Z0 ; U 0 S %GET="PORT:++6,10,E#++2,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S PORT=%S S PRT=$P O PORT::2 E S %SAY=" LINE IN USE " X %XMSGV(1) G Z0 S PRM="(0::::#840001)" ;"(0::::8388608+(9*4096)+(5*16)+9)" S CL="U @(""PORT:""_PRM) F R B:1 Q:'$T" X CL S PST="" K ^S000(PRT) X "ZR ZL %L2RTR1 F I=1:1 S A=$T(+I) Q:A=PST S ^S000(PRT,I)=A" U @("PORT:"_PRM) W "S Z=0 K ^S000($P) F I=1:1 R A Q:A[""^ZZZ^"" S ^S000($P,I)=A,Z=Z+$ZCR(A,1)",$C(13) X CL S ZCR=0 F I=1:1 Q:'$D(^S000(PRT,I)) U @("PORT:"_PRM) S A=^(I) W A,$C(13) X CL U 0 W !,A S ZCR=ZCR+$ZCR(A,1) U @("PORT:"_PRM) W $C(13),"^ZZZ^"_ZCR_$C(13) X CL W "S ^a=""X """"F I=1:1 Q:'$D(^S000($P,I)) I $L(^(I)) ZI ^(I)"""" ZS %L2RTR1""",$C(13) X CL W "S ^a(""C"")=A_""=""_+Z I +$P(A,""^ZZZ^"",2)=+Z ZR X ^a W ""S OK=1"",$C(13)",$C(13) U @("PORT:"_PRM) I 1 S B="" F I=1:1 R B:1 Q:'$T S ^B(I)=B Q:B["OK=1" E U 0 W !!," NO CONNECTION" G END U 0 W !!,"TRANSFER OF %L2RTR1 -- "_$S(B["OK=1":"",1:"NOT")_" OK" END C PORT Q %L2SHA %L2SHA ; FORMIROVANIE KRASIVOI SHAPKI ; SHEER ; 02/08/93 [ 05/20/98 10:21 AM ] [ 04/17/94 1:23 PM ] ; INPUT %L2SHA("L") - LIST DLIN GRAF ; %L2SHA(I) - NAZVANIE GRAF I #STPOKI SHAPKI ; %L2SHA("LEFT") - SMESHENIE OT LEVOGO KRAIA %L2SHA("LEFT")="C" CENTROVKA ; %L2SHA("TOP") - SMESHENIE OT BERXHEGO KRAIA ; ; S %L2SHA("L")="10,4,8,6,12" K %STR,^l2sha($J) ; S %L2SHA(1)="AAA\\BBBB\\CCCCCC\\DDD\\EEE" ; S %L2SHA(2)="AAAAAA\\BB\\CCC\\DDD\\EEE" ; ; OUTPUT: ^l2sha($J) ;--------------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L2SHA,%L2SHAMC) D ^%L1C K ^l2sha($J) S %LL=%L2SHA("L") S %KG=$L(%LL,","),%L2SHA("LEFT")=$G(%L2SHA("LEFT"),0) I %L2SHA("LEFT")="C" D S %L2SHA("LEFT")=80-(%L2SHA("LEFT")+%KG+1)\2 .F I=1:1:%KG S %L2SHA("LEFT")=%L2SHA("LEFT")+$P(%LL,",",I) S %L2SHA("TOP")=$G(%L2SHA("TOP")),LIN=%L2SHA("TOP")+1 F I=186,187,188,200:1:205 S C(I)=$C(I) I %OPT=65 S C(186)=$C(120),C(187)=$C(107),C(188)=$C(106),C(200)=$C(109),C(201)=$C(108),C(202)=$C(118),C(203)=$C(119),C(205)=$C(113) 1 ;;S $E(^l2sha($J,LIN),%L2SHA("LEFT"),200)=C(201) S ^l2sha($J,LIN)=C(201) F GR=1:1:%KG S ^l2sha($J,LIN)=^l2sha($J,LIN)_$TR($J("",$P(%LL,",",GR))," ",C(205))_$S(GR'=%KG:C(203),1:"") ; $C(209) S ^l2sha($J,LIN)=^l2sha($J,LIN)_C(187) 2 F I=1:1 Q:'$D(%L2SHA(I)) S LIN=LIN+1 D .;;S $E(^l2sha($J,LIN),%L2SHA("LEFT"),200)=C(186) .S ^l2sha($J,LIN)=C(186) .F GR=1:1:%KG D S ^l2sha($J,LIN)=^l2sha($J,LIN)_$J(PIC,LL)_C(186) ..S LL=$P(%LL,",",GR),PIC=$P(%L2SHA(I),"\\",GR),LLP=$L(PIC),PIC=PIC_$J("",LL-LLP\2) .S %L2SHA("MC")=$TR(^(LIN),C(186),"|") 3 S LIN=LIN+1 ;;S $E(^l2sha($J,LIN),%L2SHA("LEFT"),200)=C(200) S ^l2sha($J,LIN)=C(200) F GR=1:1:%KG S ^l2sha($J,LIN)=^l2sha($J,LIN)_$TR($J("",$P(%LL,",",GR))," ",C(205))_$S(GR'=%KG:C(202),1:"") S ^l2sha($J,LIN)=^l2sha($J,LIN)_C(188) I $G(%OTL) W !,"12345678901234567890123456789012345678901234567890123456789012345678901234567890" U $P:(NOECHO:NOWRAP) I %TYPCRT["VT" W $C(27),"(0" S N="" F S N=$O(^l2sha($J,N)) Q:N="" S %XX=%L2SHA("LEFT"),%YY=N X %POSIC W ^(N) I %TYPCRT["VT" W $C(27),"(B" K %OTL Q %L2SHAP %L2SHAP ; SHP(%L2("COD")) ; [ 06.03.08 17:35 ] [ 12.04.07 18:33 ] [ 10.12.06 18:07 ] ;-------------------------------------------- ;%L2("U") - 0,3;KOD OF SHP - %L2("COD") ; ; ARRAY OF VALUE REKV (MAS); ; %L2("SM") - OFFSET, %L2("SC") - COUNTER OF LINES, %L2("SL") - COUNTER OF PAGES ; %L2("PC") - PRINT FLAG, %L2("RZ") - DELIMITER ; %L2("RL") - SIZE OF PAGE, %L2("LAST") - LAST POSITION ;--------------------------------------------- ;;I %L2("U")'=0,%L2("U")'=$P,%L2("U")'="LEVPC" S %L2("U")=3 N %L2GLOB D L2GLOB D .N I F I="B","N","PG","COND","NOCOND" I '$D(%L1SCPC("MDP",I)),$D(%L1OUT("MDP",I))#2,$$PCH S %L1SCPC("MDP",I)=%L1OUT("MDP",I) I '$D(%L1SCPC("MDP","B")) S %L1SCPC("MDP","B")=$S($$PCH:$C(27)_"W1",1:"") I '$D(%L1SCPC("MDP","N")) S %L1SCPC("MDP","N")=$S($$PCH:$C(27)_"W0",1:"") I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(13,12) I '$D(%L1SCPC("MDP","GWPC")) S %L1SCPC("MDP","GWPC")=80 I '$D(TS0)!'$D(TSS)!'$D(TS1) D ^%L1TS S %L2("SS")="&" S:'$D(%L2("SM")) %L2("SM")=0 S:'$D(%L2("SC")) %L2("SC")=0 S:$D(%L2("SL")) %L2("SL")=%L2("SL")+1 S:'$D(%L2("SL")) %L2("SL")=1 S:'$D(%L2("PC")) %L2("PC")="1V" I %L2("PC"),'$D(%L2("U")) D MSG("A DEVICE WAS NOT DEFINED (%L2(""U"")) !") Q I '$D(%L2("COD")) D MSG("A HEADER CODE WAS NOT DEFINED (%L2(""COD"")) !") Q I '$D(@%L2GLOB@(%L2("COD"))) D MSG("A NODE "_%L2("COD")_" THERE IS NOT IN "_%L2GLOB_" !") Q S %NEXTS=@%L2GLOB@(%L2("COD"),1) I +%L2("PC") D .;;I %L2("U"),%L2("U")'=$P&(%L2("PC")="1V"),$G(%MDPSUG)=5 W $C(18) .I $$PCH,(%L2("PC")="1V")&'$D(%L2("!")) S %ST=%L1SCPC("MDP","PG") D STPC Q .S %ST="" D STPC S %ST="" D STPC Q I %L2("PC")="1V" D S %L2BEG=1 D FSHAP .I '$G(%L1SCPC("LOGO")),'$D(%L1SCPC(1)) S %AT=$$SPA^%L1FRM($$^%L1HEAD("")) I $L(%AT) D ..I $G(%MDPSUG)=7 D Q ...S %AT=$$SPC^%L1FRM(%AT) ...S %ST=%L1SCPC("MDP","B")_$$CENTR^%L1FRM($$TR($TR(%AT,"#_","")),%L1SCPC("MDP","GWPC"))_%L1SCPC("MDP","N") ...D STPC S %ST="" D STPC .. ..S %ST=%L1SCPC("MDP","B")_$$CENTRB^%L1FRM($$TR($TR(%AT,"#_","")),%L1SCPC("MDP","GWPC"))_%L1SCPC("MDP","N") D STPC S %ST="" D STPC . .N %J F %J=1:1:$G(%L1SCPC("LOGO")) W ! S %L2("SC")=$G(%L2("SC"))+1 I %L2("PC")="1N" D NSHAP I %L2("PC")=0 D FSTR END K %NEXTS,%IND,%J1,%J2,%K,%LENGTH,%NST,%POZ,%SHPZ,%STR,%STRS Q FSHAP ; N %I,%DLMD S %DLMD="$" I $D(%L2("$")) S %DLMD=%L2("$") I $$^%L1DISP(%L2("U")) U $P:(NOECHO:NOWRAP) N %ECHO I $G(%L2("PC"))="1V" D F %I=%L2BEG:1 Q:'$D(@%L2GLOB@(%L2("COD"),%I))#10 Q:^(%I)[%DLMD S %STRS=^(%I),%POZ=0 D PSK D .I %L2("PC") S %ST=$J("",%L2("SM")) D D STPC Q .. ..I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D ...I $G(%L2("PC"))="1V"!($G(%L2("PC"))="1N") D ....N IND,%SMB S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 ....I %L2("PC")="1V" D Q:%SMB="!" .....I %STRS?.P1"-"."-".P,$G(@%L2GLOB@(%L2("COD"),%I+1))?.P1":".E,%I'<(%L2("VG")-4) D Q ......F %I1=%I+1:1 Q:'$D(@%L2GLOB@(%L2("COD"),%I1))#10 Q:^(%I1)[%DLMD S %STRS=^(%I1) Q:%STRS?.P1"-"."-".P D .......S %SMB="!" .......S @%L1SCPC("GLOB")@(IND)=$G(@%L2GLOB@(%L2("COD"),%I1))_%SMB .......S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 ......S %I=%L2("VG")-1 .....S %SMB="^" ....I %L2("PC")="1N" S %SMB="=" ....S @%L1SCPC("GLOB")@(IND)=%STRS_%SMB .. ..S %ST=%ST_$$TR(%STRS) D:'$D(%L1SCPC("GLOB")) ...S %ST=$J("",%L2("SM"))_$$TR($P(%STRS,"#")) S %W1=0 ...F %II=2:1:$L(%STRS,"#") S %W1='%W1 D ....S:$$PCH %ST=%ST_$S(%II#2:%L1SCPC("MDP","N"),1:%L1SCPC("MDP","B")) ....;;I '$$PCH&%W1 S %ST=%ST_%LIGHT1 ....N %ST1 S %ST1=$P(%STRS,"#",%II) ....I $$PCH&%W1,$G(%MDPSUG)=7 S %ST1=$$SPC^%L1FRM(%ST1) ....S %ST=%ST_$$TR(%ST1) ....;;I '$$PCH S %ST=%ST_%CCL ...I $D(%L1SCPC("MDP","_")),$D(%L1SCPC("MDP","\_")) D ....S %ST=$J("",%L2("SM"))_$$TR($P(%STRS,"~")) S %W1=0 ....F %II=2:1:$L(%STRS,"~") S %W1='%W1 S:$$PCH %ST=%ST_$S(%II#2:%L1SCPC("MDP","_"),1:%L1SCPC("MDP","\_")) S %ST=%ST_$$TR($P(%STRS,"~",%II)) ;;S:'$$PCH %ST=%ST_%CCL .S %L2("SC")=%L2("SC")+1 .I %L2("SC")>60 S %L2("SC")=0,%L2("SL")=%L2("SL")+1 I $D(^(%I)) S %L2("VG")=%I Q PSK ; F S %POZ=$F(%STRS,%L2("SS"),%POZ) Q:%POZ<1 D .S %IND=+$E(%STRS,%POZ,%POZ+1) D DEFL .;;S %NST=$S($D(MAS(%IND)):$E(MAS(%IND),1,%LENGTH),1:"") .S %NST=$S($D(MAS(%IND)):$E($$CLST^%L1FRM(MAS(%IND),"",""),1,%LENGTH),1:"") .S %STRS=$E(%STRS,1,%POZ-2)_$J(%NST,%LENGTH)_$E(%STRS,%POZ-1+%LENGTH,255) .Q Q DEFL ; F %K=%POZ+2:1:132 Q:$E(%STRS,%K)'=" " S %LENGTH=%K-%POZ+1 S:$E(%STRS,%K)=">" %LENGTH=%LENGTH+1 K %K ;S ^("S"_%IND)=%LENGTH Q FSTR ; N %DLMD S %DLMD="$" I $D(%L2("$")) S DLMD=%L2("$") S FLAG="ER" I '$D(%L2("VG"))!'$D(%I) F %I=1:1 Q:'$D(^(%I))#10 Q:^(%I)[%DLMD I I $D(^(%I)) S %L2("VG")=%I Q:'$D(%L2("VG")) S %STR=^(%I),%POZ=$F(%STR,%DLMD)-1,%L2("VG")=%I ; S %L2("LG1")=1,%L2("LG2")=%POZ-1 S:'$D(%L2("RZ")) %L2("RZ")=":" K %L2("MP") F %J1=%I:1 Q:'$D(^(%J1)) S %STR=$$SPR^%L1FRM(^(%J1)),%NT=$E(%STR,$L(%STR)) Q:%NT'?1N.N D .S %POZ=%L2("LG2")+1,%SHPZ=0 .F S %POZ=$F(%STR,%L2("RZ"),%POZ) Q:'%POZ S %SHPZ=%SHPZ+1,%L2("MP",%NT,%SHPZ)=%POZ+%L2("SM")-1 .S %L2("MP",%NT)=%SHPZ K %NT,%STR,%POZ,%SHPZ Q:'$D(^(%J1)) ; ________________________________; F %J2=%J1:1 Q:'$D(^(%J2)) S %STR=$$SPR^%L1FRM(^(%J2)) Q:%STR[%DLMD Q:'$D(^(%J2)) S %L2("PG1")=$F(%STR,%DLMD),%L2("PG2")=$L(%STR) S %L2("NG")=%J2+1,%L2("RL")=%L2("NG")-%L2("VG")-1 ;-$G(%L1SCPC("LOGO")) F %J1=%I:1 Q:'$D(^(%J1)) S %STR=$$SPR^%L1FRM(^(%J1)),%NT=$E(%STR,$L(%STR)) Q:%NT'?1N.N D .S %STR=$E(%STR,%L2("LG2")+1,%L2("PG1")-1) .F %J2=1:1:%L2("MP",%NT) S %S=$P(%STR,%L2("RZ"),%J2) X "F %OFF=$L(%S):-1:1 Q:$E(%S,%OFF)=9" D ALL^%S1KA D S %L2("FF",%NT,%J2)=%FF ..I %S["9" S %FF=9_","_%OFF_":"_($L(%S)-(%S[".")) S:%S["." %FF=%FF_","_$L($P(%S,".",2)) S:$E(%S)="S" %FF=%FF_",S" Q ..I %S["TP" S %FF="TP," S %FF=%FF_$L($P(%STR,%L2("RZ"),%J2)) Q ..I %S?1"T"."T" S %FF="T,"_$L(%S) Q ..S %FF="T,"_$L($P(%STR,%L2("RZ"),%J2)) K %NT,%S S FLAG="" Q NSHAP ; D L2GLOB I '$D(%L2("NG")) D FSTR I '$D(%L2("NG")) Q S %L2BEG=%L2("NG") D FSHAP Q MSG(TXT) ; U 0 W *7 S %SAY="*** %L2SHAP ."_TXT X %XMSGV(1) Q STPC ; I $$^%L1DISP(%L2("U")) Q:$D(%L1SCPC("EXCEL")) U $P:(NOECHO:NOWRAP) W $TR($TR(%ST,%TES1,%TES2),%TEN,%THB),! Q I $D(%L1SCPC("GLOB")) D D ^%L1STPC(%ST,%L1SCPC("GLOB"),"%L1SCPC(""MDP"")") Q .I $L(%ST)<79,$A($E(%ST))<$A(" "),%L2("U")'=51 S %ST=%ST_$J("",79-$L(%ST)) W %ST W ! Q TR(%ST) I '$$PCH Q %ST Q $TR($TR(%ST,TS0,TSS),TS1,TSS) L2GLOB ; I '$D(%L2("GLOB")) S %L2GLOB="^SHP" E S %L2GLOB=%L2("GLOB") Q PCH(STAM) S:'$D(%L2("U")) %L2("U")="" I %L2("U")="0"!(%L2("U")=$P)!(%L2("U")["LEVPC")!(%L2("U")="") Q 0 Q 1 %L2SHAP0 %L2SHAP ; SHP(%L2("COD")) ; [ 27.06.08 08:24 ] [ 12.04.07 18:33 ] [ 10.12.06 18:07 ] ;-------------------------------------------- ;%L2("U") - 0,3;KOD OF SHP - %L2("COD") ; ; ARRAY OF VALUE REKV (MAS); ; %L2("SM") - OFFSET, %L2("SC") - COUNTER OF LINES, %L2("SL") - COUNTER OF PAGES ; %L2("PC") - PRINT FLAG, %L2("RZ") - DELIMITER ; %L2("RL") - SIZE OF PAGE, %L2("LAST") - LAST POSITION ;--------------------------------------------- I %L2("U")'=0,%L2("U")'=$P,%L2("U")'="LEVPC" S %L2("U")=3 N %L2GLOB D L2GLOB D .N I F I="B","N","PG","COND","NOCOND" I '$D(%L1SCPC("MDP",I)),$D(%L1OUT("MDP",I))#2,%L2("U") S %L1SCPC("MDP",I)=%L1OUT("MDP",I) I '$D(%L1SCPC("MDP","B")) S %L1SCPC("MDP","B")=$S(%L2("U"):$C(27)_"W1",1:%LIGHT1) I '$D(%L1SCPC("MDP","N")) S %L1SCPC("MDP","N")=$S(%L2("U"):$C(27)_"W0",1:%CCL) I '$D(%L1SCPC("MDP","PG")) S %L1SCPC("MDP","PG")=$C(13,12) I '$D(%L1SCPC("MDP","GWPC")) S %L1SCPC("MDP","GWPC")=80 I '$D(TS0)!'$D(TSS)!'$D(TS1) D ^%L1TS S %L2("SS")="&" S:'$D(%L2("SM")) %L2("SM")=0 S:'$D(%L2("SC")) %L2("SC")=0 S:$D(%L2("SL")) %L2("SL")=%L2("SL")+1 S:'$D(%L2("SL")) %L2("SL")=1 S:'$D(%L2("PC")) %L2("PC")="1V" I %L2("PC"),'$D(%L2("U")) D MSG("A DEVICE WAS NOT DEFINED (%L2(""U"")) !") Q I '$D(%L2("COD")) D MSG("A HEADER CODE WAS NOT DEFINED (%L2(""COD"")) !") Q I '$D(@%L2GLOB@(%L2("COD"))) D MSG("A NODE "_%L2("COD")_" THERE IS NOT IN "_%L2GLOB_" !") Q S %NEXTS=@%L2GLOB@(%L2("COD"),1) I +%L2("PC") D .;;I %L2("U"),%L2("U")'=$P&(%L2("PC")="1V"),$G(%MDPSUG)=5 W $C(18) .I %L2("U"),%L2("U")'=$P&(%L2("PC")="1V")&'$D(%L2("!")) S %ST=%L1SCPC("MDP","PG") D STPC Q .S %ST="" D STPC S %ST="" D STPC Q I %L2("PC")="1V" D S %L2BEG=1 D FSHAP .I '$G(%L1SCPC("LOGO")),'$D(%L1SCPC(1)) S %AT=$$SPA^%L1FRM($$^%L1HEAD("")) I $L(%AT) D ..I $G(%MDPSUG)=7 D Q ...S %AT=$$SPC^%L1FRM(%AT) ...S %ST=%L1SCPC("MDP","B")_$$CENTR^%L1FRM($$TR($TR(%AT,"#_","")),%L1SCPC("MDP","GWPC"))_%L1SCPC("MDP","N") ...D STPC S %ST="" D STPC .. ..S %ST=%L1SCPC("MDP","B")_$$CENTRB^%L1FRM($$TR($TR(%AT,"#_","")),%L1SCPC("MDP","GWPC"))_%L1SCPC("MDP","N") D STPC S %ST="" D STPC . .N %J F %J=1:1:$G(%L1SCPC("LOGO")) W ! S %L2("SC")=$G(%L2("SC"))+1 I %L2("PC")="1N" D NSHAP I %L2("PC")=0 D FSTR END K %NEXTS,%IND,%J1,%J2,%K,%LENGTH,%NST,%POZ,%SHPZ,%STR,%STRS Q FSHAP ; N %I,%DLMD S %DLMD="$" I $D(%L2("$")) S %DLMD=%L2("$") I %L2("U")=0!(%L2("U")=$P) U $P:(NOECHO:NOWRAP) N %ECHO I $G(%L2("PC"))="1V" D F %I=%L2BEG:1 Q:'$D(@%L2GLOB@(%L2("COD"),%I))#10 Q:^(%I)[%DLMD S %STRS=^(%I),%POZ=0 D PSK D .I %L2("PC") S %ST=$J("",%L2("SM")) D D STPC Q .. ..I $D(%L1SCPC("EXCEL")),$D(%L1SCPC("GLOB")) D ...I $G(%L2("PC"))="1V"!($G(%L2("PC"))="1N") D ....N IND,%SMB S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 ....I %L2("PC")="1V" D Q:%SMB="!" .....I %STRS?.P1"-"."-".P,$G(@%L2GLOB@(%L2("COD"),%I+1))?.P1":".E,%I'<(%L2("VG")-4) D Q ......F %I1=%I+1:1 Q:'$D(@%L2GLOB@(%L2("COD"),%I1))#10 Q:^(%I1)[%DLMD S %STRS=^(%I1) Q:%STRS?.P1"-"."-".P D .......S %SMB="!" .......S @%L1SCPC("GLOB")@(IND)=$G(@%L2GLOB@(%L2("COD"),%I1))_%SMB .......S IND=$O(@%L1SCPC("GLOB")@(99999),-1)+1 ......S %I=%L2("VG")-1 .....S %SMB="^" ....I %L2("PC")="1N" S %SMB="=" ....S @%L1SCPC("GLOB")@(IND)=%STRS_%SMB .. ..S %ST=%ST_$$TR(%STRS) D:'$D(%L1SCPC("GLOB")) ...S %ST=$J("",%L2("SM"))_$$TR($P(%STRS,"#")) S %W1=0 ...F %II=2:1:$L(%STRS,"#") S %W1='%W1 D ....S:%L2("U")&(%L2("U")'=$P) %ST=%ST_$S(%II#2:%L1SCPC("MDP","N"),1:%L1SCPC("MDP","B")) ....I '%L2("U")&%W1 S %ST=%ST_%LIGHT1 ....N %ST1 S %ST1=$P(%STRS,"#",%II) ....I %L2("U")&%W1,$G(%MDPSUG)=7 S %ST1=$$SPC^%L1FRM(%ST1) ....S %ST=%ST_$$TR(%ST1) ....I '%L2("U") S %ST=%ST_%CCL ...I $D(%L1SCPC("MDP","_")),$D(%L1SCPC("MDP","\_")) D ....S %ST=$J("",%L2("SM"))_$$TR($P(%STRS,"~")) S %W1=0 ....F %II=2:1:$L(%STRS,"~") S %W1='%W1 S:%L2("U")&(%L2("U")'=$P) %ST=%ST_$S(%II#2:%L1SCPC("MDP","_"),1:%L1SCPC("MDP","\_")) S:'%L2("U")&%W1 %ST=%ST_%LIGHT1 S %ST=%ST_$$TR($P(%STRS,"~",%II)) S:'%L2("U") %ST=%ST_%CCL .S %L2("SC")=%L2("SC")+1 .I %L2("SC")>60 S %L2("SC")=0,%L2("SL")=%L2("SL")+1 I $D(^(%I)) S %L2("VG")=%I Q PSK ; F S %POZ=$F(%STRS,%L2("SS"),%POZ) Q:%POZ<1 D .S %IND=+$E(%STRS,%POZ,%POZ+1) D DEFL .;;S %NST=$S($D(MAS(%IND)):$E(MAS(%IND),1,%LENGTH),1:"") .S %NST=$S($D(MAS(%IND)):$E($$CLST^%L1FRM(MAS(%IND),"",""),1,%LENGTH),1:"") .S %STRS=$E(%STRS,1,%POZ-2)_$J(%NST,%LENGTH)_$E(%STRS,%POZ-1+%LENGTH,255) .Q Q DEFL ; F %K=%POZ+2:1:132 Q:$E(%STRS,%K)'=" " S %LENGTH=%K-%POZ+1 S:$E(%STRS,%K)=">" %LENGTH=%LENGTH+1 K %K ;S ^("S"_%IND)=%LENGTH Q FSTR ; N %DLMD S %DLMD="$" I $D(%L2("$")) S DLMD=%L2("$") S FLAG="ER" I '$D(%L2("VG"))!'$D(%I) F %I=1:1 Q:'$D(^(%I))#10 Q:^(%I)[%DLMD I I $D(^(%I)) S %L2("VG")=%I Q:'$D(%L2("VG")) S %STR=^(%I),%POZ=$F(%STR,%DLMD)-1,%L2("VG")=%I ; S %L2("LG1")=1,%L2("LG2")=%POZ-1 S:'$D(%L2("RZ")) %L2("RZ")=":" K %L2("MP") F %J1=%I:1 Q:'$D(^(%J1)) S %STR=$$SPR^%L1FRM(^(%J1)),%NT=$E(%STR,$L(%STR)) Q:%NT'?1N.N D .S %POZ=%L2("LG2")+1,%SHPZ=0 .F S %POZ=$F(%STR,%L2("RZ"),%POZ) Q:'%POZ S %SHPZ=%SHPZ+1,%L2("MP",%NT,%SHPZ)=%POZ+%L2("SM")-1 .S %L2("MP",%NT)=%SHPZ K %NT,%STR,%POZ,%SHPZ Q:'$D(^(%J1)) ; ________________________________; F %J2=%J1:1 Q:'$D(^(%J2)) S %STR=$$SPR^%L1FRM(^(%J2)) Q:%STR[%DLMD Q:'$D(^(%J2)) S %L2("PG1")=$F(%STR,%DLMD),%L2("PG2")=$L(%STR) S %L2("NG")=%J2+1,%L2("RL")=%L2("NG")-%L2("VG")-1 ;-$G(%L1SCPC("LOGO")) F %J1=%I:1 Q:'$D(^(%J1)) S %STR=$$SPR^%L1FRM(^(%J1)),%NT=$E(%STR,$L(%STR)) Q:%NT'?1N.N D .S %STR=$E(%STR,%L2("LG2")+1,%L2("PG1")-1) .F %J2=1:1:%L2("MP",%NT) S %S=$P(%STR,%L2("RZ"),%J2) X "F %OFF=$L(%S):-1:1 Q:$E(%S,%OFF)=9" D ALL^%S1KA D S %L2("FF",%NT,%J2)=%FF ..I %S["9" S %FF=9_","_%OFF_":"_($L(%S)-(%S[".")) S:%S["." %FF=%FF_","_$L($P(%S,".",2)) S:$E(%S)="S" %FF=%FF_",S" Q ..I %S["TP" S %FF="TP," S %FF=%FF_$L($P(%STR,%L2("RZ"),%J2)) Q ..I %S?1"T"."T" S %FF="T,"_$L(%S) Q ..S %FF="T,"_$L($P(%STR,%L2("RZ"),%J2)) K %NT,%S S FLAG="" Q NSHAP ; D L2GLOB I '$D(%L2("NG")) D FSTR I '$D(%L2("NG")) Q S %L2BEG=%L2("NG") D FSHAP Q MSG(TXT) ; U 0 W *7 S %SAY="*** %L2SHAP ."_TXT X %XMSGV(1) Q STPC ; I $G(%L2("U"))=0!($G(%L2("U"))=$P) Q:$D(%L1SCPC("EXCEL")) U $P:(NOECHO:NOWRAP) W $TR($TR(%ST,%TES1,%TES2),%TEN,%THB),! Q I $D(%L1SCPC("GLOB")) D D ^%L1STPC(%ST,%L1SCPC("GLOB"),"%L1SCPC(""MDP"")") Q .I $L(%ST)<79,$A($E(%ST))<$A(" "),%L2("U")'=51 S %ST=%ST_$J("",79-$L(%ST)) W %ST W ! Q TR(%ST) I $G(%L2("U"))=0 Q %ST Q $TR($TR(%ST,TS0,TSS),TS1,TSS) L2GLOB ; I '$D(%L2("GLOB")) S %L2GLOB="^SHP" E S %L2GLOB=%L2("GLOB") Q %L2SHD %L2SHD(MRK,GLOB,FTP,PROGRCV) ; [ 19.04.07 10:28 ] [ K %L2SHD N MD S MD=0 ; I MRK?1N.N1".".1N.E D G GL .S %L2MODEM("ADDR")=MRK .S %L2MODEM("NAMETO")="" ; I '$D(^MRKZ(MRK)) S %L2SHD("ER")=1 Q S %L2MODEM("ADDR")=$G(^MRKZ(MRK,"ADDR")) I %L2MODEM("ADDR")="" S %L2MODEM("ADDR")=$G(^MRKZ(MRK,"MD")),FTP=0,MD=1 I %L2MODEM("ADDR")="" S %L2SHD("ER")=2 Q S %L2MODEM("NAMETO")=$G(^MRKZ(MRK)) GL ; S %L2MODEM("GLOB")=GLOB S %L2MODEM("FL")=$E(GLOB,2,100) ; I MD D .S %L2MODEM("MDPORT")=$$^%L1PORT .S %L2MODEM("PROG")=$G(PROG,"%L2GTR1") .S %L2MODEM("XON")=$G(^PL("MDXON")) ; S %L2MODEM("UCI")="MGR" I $G(FTP)'=0 S %L2MODEM("FTP")="" ; D ^%L2MODEM Q %L2SRV %L2SRV ; [ 29.01.06 14:20 ] [ 16.12.05 13:01 ] [ 15.12.05 13:47 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" 0 K (%L2MN) D ^%L1C,^P1IN S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" SERVER MANAGER " S MAC="MM" D ^%L2MENU I %I=1 W ! U $P:(NOECHO:NOWRAP) Q D @MM1(%I) G 0 MENU ; ;1; EXIT ; ;1; START SERVER;1; ;1; SHOW SERVERS STATUS;2; ;1; STOP SERVER;3; ;1; SHOW ^SCKSERV;5; ;1; KILL ALL SERVERS;4; Q ; 1 ; D SHOW U 0:(NOWRAP:ECHO) ZP R !!," PORT NUMBER : ",PORTN Q:PORTN="" I 'PORTN!(PORTN'?4N) W *7 W " ???" G ZP J single^%L2SRV1(PORTN,4) ;;I $G(^SCKSERV($J))<0 S %SAY=$TR($P(^(J),",",2),%TSMALL,%TBIG) X %XMSGV(1) H 2 D SHOW R !,">",OTB Q 2 ; D ^%L2SRVS Q 3 D SHOW U 0:(NOWRAP:ECHO) ZJ R !!," JOB NUMBER (ALL - '*'): ",JOBN Q:JOBN="" I JOBN="*" S ^SCKSERV=-1 W !!," WAIT ..." H 10 D SHOW Q ;K ^SCKSERV Q ; S ^SCKSERV(JOBN)=-1 W !!," WAIT ..." H 2 S ^SCKSERV(JOBN)=-1 H 10 D SHOW R !,">",OTB ;;K ^SCKSERV(JOBN) Q 4 S ^SCKSERV=-2 H 4 D SHOW R !,">",OTB Q 5 D SHOW U 0:(NOWRAP:ECHO) R !!," JOB NUMBER : ",JOBN Q:JOBN="" K ^S000($P) S MAC="^SCKSERV("_JOBN_")" D ^%S1GLSV K ^TMPS111($J) M ^TMPS111($J)=^S000($P) K ^S000($P) D ^%S2VIEW Q SHOW D SHOW^%L2SRVS Q %L2SRV1 %L2SRV1 ;fscwitte@users.sourceforge.net;2000/10/25,21:22:13;Socket Device,Server [ 11.07.07 17:44 ] [ 24.06.07 12:58 ] [ 20.06.07 15:28 ] ; NO ^ROUTINE ENTRY QUIT ;---------------------------------------------------------------------- ; public procedure single^SCKSERV1() ; ; General TCP/IP server procedure to handle single client connection. ; single(%ZNPort,%ZNTimeS) new %Z0,%ZNCmd,%ZNData,%ZNDev,%ZNLevel,%ZNSock ; ; set a new errortrap ; new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":singleQE" S ^SCKSERV=0 kill ^SCKSERV($job) ; ; Construct a dummy, but "unique", devicename. ; set %ZNDev="SCK$"_$J ; ; Open the device: ; OP OPEN %ZNDev:(ZLISTEN=%ZNPort_":TCP":DELIMITER=$C(27,95,58,13,10,58,12):ATTACH="listener"):%ZNTimeS:"SOCKET" else set ^SCKSERV($job)="-1,NotOpen" D quit .set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") .set $P(^SCKSERV($job,1),"|",3)=%ZNPort ; ; Adjust errortrap after open (need to close) ; Set $ZTRAP="ZGOTO "_$ZLEVEL_":singleCE" Set ^SCKSERV($job)=0 ; ; USE fills $KEY with "BOUND | socket_handle | portnumber" ; Use %ZNDev set ^SCKSERV($job,0)=$KEY ; ; Start listening, sets $KEY to "LISTENING | socket_handle | portnumber" ; WRITE /LISTEN(1) set ^SCKSERV($job,1)=$KEY ; ; Wait for connection, $KEY will be "CONNECT | socket_handle | remote_ipaddress" ; LOOP For do quit:^SCKSERV($job) Q:$G(^SCKSERV)<0 . set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") . WRITE /WAIT(%ZNTimeS) . IF $KEY]"" set ^SCKSERV($job,2)=$KEY,^SCKSERV($job)=2 quit ; ; Store the connection socket in local variable, ; Set %ZNSock=$piece($KEY,"|",2) ; ; Close listen socket, so another process can start listening on this port. ; Force connection socket to be the active ; CLOSE %ZNDev:(SOCKET="listener") I $G(^SCKSERV)<0 K:^SCKSERV<-1 ^SCKSERV G singleQ ; ; specify a trap that does not terminate the FOR-loop ; ;;set $ZTRAP="GOTO singleX" s %ZNLevel=$ZLEVEL set ^SCKSERV($job)=0,%Z0=2 ; D . set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") . USE %ZNDev:(SOCKET=%ZNSock) . READ %ZNData:%ZNTimeS ELSE quit . set %Z0=%Z0+1 . set ^SCKSERV($job,%Z0,1)=%ZNData . set ^SCKSERV($job,%Z0,2)=$DEVICE . set ^SCKSERV($job,%Z0,3)=$KEY . ; . ; If an error occurs during READ, stop the loop . IF $DEVICE set ^SCKSERV($job)=$DEVICE quit . ; . ; If no terminator we are in trouble, but ignore for now . IF $KEY="" quit . ; . IF $KEY=$CHAR(27,95) DO ; . . N %J,%A F %J=1:1:$L(%ZNData) S %A=$A($E(%ZNData,%J)) I %A'=10,%A'=12,%A'=13,%A'=27 Q . . S %ZNData=$E(%ZNData,%J,$L(%ZNData)) . . set %ZNCmd=$piece(%ZNData," "),%ZNData=$piece(%ZNData," ",2,32767) . . ; . . if %ZNCmd="get" D quit . . . N %DATA S %DATA=$G(@%ZNData) . . . WRITE "val ",%DATA_$C(3)_$$^%L1ZCRC(%DATA),! . . . . if %ZNCmd="set" D quit . . .N CS S CS=$P(%ZNData,$c(3),2),%ZNData=$P(%ZNDdata,$C(3)) . . .N ZCRC S ZCRC=$$^%L1ZCRC(%ZNData) . . .I CS,ZCRC'=CS W "nok",! quit . . .set @%ZNData WRITE "ok",! quit . . . . if %ZNCmd="kil" D quit . . .N CS S CS=$P(%ZNData,$c(3),2),%ZNData=$P(%ZNDdata,$C(3)) . . .N ZCRC S ZCRC=$$^%L1ZCRC(%ZNData) . . .I CS,ZCRC'=CS W "nok",! quit . . .kill @%ZNData WRITE "ok",! quit . . . . if %ZNCmd="cmd" D CMD quit . . . . if %ZNData="stop" set ^SCKSERV($j)="-11,stop" quit . . . . WRITE "ercmd "_%ZNCmd,! . . set ^SCKSERV($job,%Z0,4)=%ZNCmd . ; ; ; for-loop terminated by +^SCKSERV($job)'=0, notify client ;;I $G(^SCKSERV)'<0,'$G(^SCKSERV($J)) C %ZNDev G OP I $G(^SCKSERV)'<0 C %ZNDev G OP ; USE %ZNDev:(SOCKET=%ZNSock) WRITE "end_serv",! ; ; singleC - close device before quiting ; singleC CLOSE %ZNDev ; singleQ - just QUIT ; K:$G(^SCKSERV)<-1 ^SCKSERV singleQ QUIT ; ; singleX - M runtime exception ; ; If not at procedure level + 2, then "normal" error: close and quit ; Else error while executing request from client: reply and retry singleX if %ZNLevel+2>$ZLEVEL ZGOTO %ZNLevel:singleC C %ZNDev D SVER^%L1X H 10 ;USE %ZNDev:(SOCKET=%ZNSock) ;WRITE "xcpt "_$ZSTATUS,! ;,# G OP ; Q ; CMD ; N $ZT CMD1 S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L2SRV1" S $ZS="" S %SCKPORT=%ZNDev S %SCKPORT("SOCK")=%ZNSock N CMD S CMD=$P(%ZNData,$C(3)) S UCI=$P(%ZNData,$C(3),2) I UCI="" S UCI="MGR" S %SCKPORT("CMD")=CMD S %SCKPORT("UCI")=UCI S %SCKPORT("USE")="use %SCKPORT:(SOCKET=%SCKPORT(""SOCK""))" M ^SCKSERV($J,"SCKPORT")=%SCKPORT N (%SCKPORT,%ZNDev,%ZNTimeS) I %SCKPORT("UCI")="MGR" S $ZGBLDIR=^UCI("MGG"),$ZROUTINES=^UCI("MGR") I %SCKPORT("UCI")="MLY" S $ZGBLDIR=^UCI("MLG"),$ZROUTINES=^UCI("MLR") I $ZS="",$L($G(%SCKPORT("CMD"))) X %SCKPORT("CMD") Q ER ;;C %ZNDev D SVER^%L1X H 2 I '$D(^SCKSERV) Q I '$D(^SCKSERV($j)) Q G LOOP Q singleCE D SVER^%L1X G singleC singleQE D SVER^%L1X G singleQ %L2SRV10 %L2SRV1 ;fscwitte@users.sourceforge.net;2000/10/25,21:22:13;Socket Device,Server [ 10.08.06 09:48 ] [ 07.02.06 13:56 ] [ 29.01.06 14:45 ] ; NO ^ROUTINE ENTRY QUIT ;---------------------------------------------------------------------- ; public procedure single^SCKSERV1() ; ; General TCP/IP server procedure to handle single client connection. ; single(%ZNPort,%ZNTimeS) new %Z0,%ZNCmd,%ZNData,%ZNDev,%ZNLevel,%ZNSock ; ; set a new errortrap ; new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":singleQE" S ^SCKSERV=0 kill ^SCKSERV($job) ; ; Construct a dummy, but "unique", devicename. ; set %ZNDev="SCK$"_$J ; ; Open the device: ; OP OPEN %ZNDev:(ZLISTEN=%ZNPort_":TCP":DELIMITER=$C(27,95,58,13,10):ATTACH="listener"):%ZNTimeS:"SOCKET" else set ^SCKSERV($job)="-1,NotOpen" D quit .set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") .set $P(^SCKSERV($job,1),"|",3)=%ZNPort ; ; Adjust errortrap after open (need to close) ; Set $ZTRAP="ZGOTO "_$ZLEVEL_":singleCE" Set ^SCKSERV($job)=0 ; ; USE fills $KEY with "BOUND | socket_handle | portnumber" ; Use %ZNDev set ^SCKSERV($job,0)=$KEY ; ; Start listening, sets $KEY to "LISTENING | socket_handle | portnumber" ; WRITE /LISTEN(1) set ^SCKSERV($job,1)=$KEY ; ; Wait for connection, $KEY will be "CONNECT | socket_handle | remote_ipaddress" ; LOOP For do quit:^SCKSERV($job) Q:$G(^SCKSERV)<0 . set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") . WRITE /WAIT(%ZNTimeS) . IF $KEY]"" set ^SCKSERV($job,2)=$KEY,^SCKSERV($job)=2 quit ; ; Store the connection socket in local variable, ; Set %ZNSock=$piece($KEY,"|",2) ; ; Close listen socket, so another process can start listening on this port. ; Force connection socket to be the active ; CLOSE %ZNDev:(SOCKET="listener") I $G(^SCKSERV)<0 K:^SCKSERV<-1 ^SCKSERV G singleQ ; ; specify a trap that does not terminate the FOR-loop ; ;;set $ZTRAP="GOTO singleX" s %ZNLevel=$ZLEVEL set ^SCKSERV($job)=0,%Z0=2 ; D . set ^SCKSERV($job,"H")=$H_"~"_$ZD($H,"DD.MM.YY 24:60") . USE %ZNDev:(SOCKET=%ZNSock) . READ %ZNData:%ZNTimeS ELSE quit . set %Z0=%Z0+1 . set ^SCKSERV($job,%Z0,1)=%ZNData . set ^SCKSERV($job,%Z0,2)=$DEVICE . set ^SCKSERV($job,%Z0,3)=$KEY . ; . ; If an error occurs during READ, stop the loop . IF $DEVICE set ^SCKSERV($job)=$DEVICE quit . ; . ; If no terminator we are in trouble, but ignore for now . IF $KEY="" quit . ; . IF $KEY=$CHAR(27,95) DO ; . .if %ZNData[$c(13,10) s %ZNData=$P(%ZNData,$c(13,10),$l(%ZNData,$C(13,10))) . . set %ZNCmd=$piece(%ZNData," "),%ZNData=$piece(%ZNData," ",2,32767) . . ; . . if %ZNCmd="get" D quit . . . N %DATA S %DATA=$G(@%ZNData) . . . WRITE "val ",%DATA_$C(3)_$$^%L1ZCRC(%DATA),! . . . . if %ZNCmd="set" D quit . . .N CS S CS=$P(%ZNData,$c(3),2),%ZNData=$P(%ZNDdata,$C(3)) . . .N ZCRC S ZCRC=$$^%L1ZCRC(%ZNData) . . .I CS,ZCRC'=CS W "nok",! quit . . .set @%ZNData WRITE "ok",! quit . . . . if %ZNCmd="kil" D quit . . .N CS S CS=$P(%ZNData,$c(3),2),%ZNData=$P(%ZNDdata,$C(3)) . . .N ZCRC S ZCRC=$$^%L1ZCRC(%ZNData) . . .I CS,ZCRC'=CS W "nok",! quit . . .kill @%ZNData WRITE "ok",! quit . . . . if %ZNCmd="cmd" D CMD quit . . . . if %ZNData="stop" set ^SCKSERV($j)="-11,stop" quit . . . . WRITE "ercmd "_%ZNCmd,! . . set ^SCKSERV($job,%Z0,4)=%ZNCmd . ; ; ; for-loop terminated by +^SCKSERV($job)'=0, notify client I $G(^SCKSERV)'<0,'$G(^SCKSERV($J)) C %ZNDev G OP ; USE %ZNDev:(SOCKET=%ZNSock) WRITE "end_serv",! ; ; singleC - close device before quiting ; singleC CLOSE %ZNDev ; singleQ - just QUIT ; K:$G(^SCKSERV)<-1 ^SCKSERV singleQ QUIT ; ; singleX - M runtime exception ; ; If not at procedure level + 2, then "normal" error: close and quit ; Else error while executing request from client: reply and retry singleX if %ZNLevel+2>$ZLEVEL ZGOTO %ZNLevel:singleC C %ZNDev D SVER^%L1X H 10 ;USE %ZNDev:(SOCKET=%ZNSock) ;WRITE "xcpt "_$ZSTATUS,! ;,# G OP ; Q ; CMD ; S $ZS="" N $ZT S $ZT="G ER" S %SCKPORT=%ZNDev S %SCKPORT("SOCK")=%ZNSock N CMD S CMD=$P(%ZNData,$C(3)) S UCI=$P(%ZNData,$C(3),2) I UCI="" S UCI="MGR" S %SCKPORT("CMD")=CMD S %SCKPORT("UCI")=UCI S %SCKPORT("USE")="use %SCKPORT:(SOCKET=%SCKPORT(""SOCK""))" N (%SCKPORT) I %SCKPORT("UCI")="MGR" S $ZGBLDIR=^UCI("MGG"),$ZROUTINES=^UCI("MGR") I %SCKPORT("UCI")="MLY" S $ZGBLDIR=^UCI("MLG"),$ZROUTINES=^UCI("MLR") I $ZS="" X %SCKPORT("CMD") Q ER ;;C %ZNDev D SVER^%L1X H 10 Q singleCE D SVER^%L1X G singleC singleQE D SVER^%L1X G singleQ %L2SRVS %L2SRVS ; [ 29.01.06 14:37 ] [ 16.12.05 13:06 ] [ 09.12.05 22:13 ] N N,OTB LOOP D SHOW R !!!,">",OTB:20 I $T U $P:(NOECHO:NOWRAP) W ! Q G LOOP ; PORT(N) Q $P($G(^SCKSERV(N,1)),"|",3) TIME(N) Q $P($G(^SCKSERV(N,"H")),"~",2) STAT(N) ; N TM S TM=$G(^SCKSERV(N,"H")) I '($H-TM),$P($H,",",2)-$P(TM,",",2)<10 Q "+" Q "-" CONN(N) Q $P($G(^SCKSERV(N,2)),"|",3) CMD(N) ; N CMD,LI S CMD="" S LI=$O(^SCKSERV(N,9999999),-1) I LI>2 S CMD=$G(^SCKSERV(N,LI,1)) Q CMD ERR(N) I $G(^SCKSERV(N))<0 Q $TR($P(^(N),",",2),%TSMALL,%TBIG) Q "" SHOW ; N N,PORT,STAT,LCMD,COMM,ERR U 0 ; W !,"-----------------------------------------------------------------------------" W !,":JOB NUMBER:PORT:STATUS: CONNECT TO : LAST COMMAND : START TIME : " W !,"-----------------------------------------------------------------------------" S N="" F S N=$O(^SCKSERV(N)) Q:N="" D .S PORT=$$PORT(N),STAT=$$STAT(N),LCMD=$$CMD(N),CONN=$$CONN(N),ERR=$$ERR(N) .S TIME=$$TIME(N) .I ERR'="" S LCMD=ERR .W !?5,N,?12,PORT,?20,STAT,?25,CONN,?40,LCMD,?62,TIME ; Q %L2SS %L2SS ; [ 22.10.25 18:30 ] [ N (%BROWSER) S %NMF="l1ss"_$J N $ZT S %IO=$I I $$^%L1ZOS(2,%NMF) ZSY "ps -fC mumps > "_%NMF O %NMF:(REWIND:READONLY) S I=2 K ^TMPS111($J),^l1ss($J) S ^TMPS111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^TMPS111($J,2)="---- ----- -------- --------------- ---------------------- --------------- " ; F U %NMF R A Q:$ZEOF D .S PID=$TR($E(A,10,14)," ","") Q:'PID .S %NMF0="GTM_JOBEXAM.ZSHOW_DMP_"_PID_"_" .ZSY "rm -f "_%NMF0_"*" .ZSY "mupip intrpt "_PID . .S %NMF1=$$^%L1ZOS(13,%NMF0_"*") Q:'$L(%NMF1) .Q:%NMF1'[%NMF0 . .O %NMF1:(REWIND:READONLY) .S %NAME="",%REF="",%DEV="" .F U %NMF1 R B Q:$ZEOF D ..I $E(B,1,11)="$ZPOSITION=" S %NAME=$P(B,"=",2) ..I $E(B,1,11)="$REFERENCE=" S %REF=$P(B,"=",2) ..I B[" OPEN RMS",B'["GTM_JOBEXAM" S %DEV=%DEV_$S($L(%DEV):",",1:"")_$P(B," ") .C %NMF1 . .F %NM="%NAME","%REF","%DEV" S @%NM=$TR(@%NM,"""","") .S I=I+1,^TMPS111($J,I)=$E(A,11,14)_" "_$E(A,25,39)_" "_%NAME_$J("",15-$L(%NAME))_" "_%REF_$J("",23-$L(%REF))_" "_%DEV .S ^l1ss($J,I,"NMF")=%NMF1 ; I $D(%BROWSER) D G END .U $P F I=1:1 Q:'$D(^TMPS111($J,I)) D ..S A=$G(^(I)) ..S A=$$SP1^%L1FRM(A) ..S A=$TR(A," ",$C(9)) ..W A,! ; I $$^%L1ZOS(2,%NMF) O %NMF:(NEWVERSION:WRITE) U %NMF F I=1:1 Q:'$D(^TMPS111($J,I)) W ^(I),! C %NMF ZSY "vi "_%NMF I $$^%L1ZOS(2,%NMF) ; END ;;K ^TMPS111($J),^l1ss($J) Q %L2TRP %L2TRP ; [ 29.07.01 11:33 AM ] [ 19.07.01 9:16 AM ] [ 07.07.01 6:12 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1TRG) D ^%L1C 0 K (%L1TRG) D ^%L1C S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" zegewll "_$S($D(%L1TRG):"milaelb",1:"dpkez ipekcr")_" xeciy " S MAC="MM" D ^%L2MENU I %I=1 Q D @MM1(%I) G 0 MENU ; ;1; d ` i vi ; ;1; mipekcr xeciy;SEND; ;1; mixeciy lewehext;PROT; Q ; SEND ; I $L($G(^%L1MODJ)),$G(^%L1MODJ)'=$$^%L1ZU(0) S %GET="WORKING WITH A JOB FROM OTHER UCI ! " D N^%L1GET Q L ^L1TRPRG:1 E S %SAY=" WORKING WITH A JOB FROM OTHER TERMINAL ! " X %XMSGV(1) Q J ^%L1MODJ:90 S UCI=$P($$^%L1ZU(0),",") I $D(^TEMPL($P)),$D(^TEMPR($P)) D G:%S=0 END G:%S=1 Z1 .S %S=1 .I '$D(%L1TRG) S %SCRN="L1TRP" D ^%L1SC I %BS S %S=0 Q .S %SCRN="L1TRPL" D ^%L1SC .S %GETIN=1,%GET=" 2 - ycg xeciy ligzdl ,1 - xeciya jiyndl " D N^%L1GET ; K ^L1TRPRG,^TEMPL($P) ; I $D(%L1TRG) D G LAK ;---- ^L1TRPRG - LIST OF GLOBALS .K ^UTILITY($J) .W %ENG U $P:(ECHO:WRAP) D ^%GSEL U $P:(NOECHO:NOWRAP) .S MAC1="^UTILITY($J)",MAC2="^L1TRPRG" D ^%S1GC1 .K ^UTILITY($J) ; ;--------------------------- ROUTINES K ^TEMPR($P) D GET PRG S %SCRN="L1TRP",%SC("A")="" D ^%L1SC G:%BS END I '$D(^TEMPR($P)) G END ;--- ^TEMPR($P - LIST OF PROGRAMMS LAK K ^TEMPL($P) ;-- ^TEMPL($P LIST OF CLIENTS & MODEMS I $D(^LAK) D .K %Q S %Q("Z")="AUTOANSWER mr zegewld lk xegal" D N^%S2ASK I YES D ..S N="",I=0 F S N=$O(^LAK(N)) Q:N="" D ...S MODEM=$P($G(^(N,1)),"\",3) Q:'MODEM Q:$P($G(^LAK(N,1)),"\",7)'="k" ...S I=I+1,^TEMPL($P,I)=N_"\"_$G(^LAK(N))_"\"_MODEM_"\" ; S %SCRN="L1TRPL" D ^%L1SC I %BS G PRG Z1 ; S $ZT="S zr=$R "_^ZT_"ZG "_$ZL_":ERR" I $D(%L1TRG) G Z2 ;----------------------------- ROUTINES F %I=1:1 Q:'$D(^TEMPR($P,%I)) D .S SHEM=$TR($P($G(^(%I)),"\")," ","") Q:'$L(SHEM) .I '$D(^ (SHEM)) Q .X "ZL @SHEM F %I1=1:1 Q:$T(+%I1)="""" S ^L1TRPRG(SHEM,%I1)=$T(+%I1)" .I '(%I#10000) U 0 W "." I '$D(^L1TRPRG) S %SAY=" ! xeciyl mipezp oi`" X %XMSGV(1) G END K %Q S %Q("Z")="xcyl " D N^%S2ASK I 'YES G END Z2 ; I '$D(^TEMPL($P)) G END F I=$O(^TEMPL($P,99999),-1):-1:1 Q:$P(^(I),"\",4)["OK" S:I<1 I=1 X %chista S INTR=0 ; F L1TRPRGL=I:1 Q:'$D(^TEMPL($P,L1TRPRGL)) D G:INTR END .S A=$G(^(L1TRPRGL)) .D G^%L1SCV("L1TRPL",A) Q:SIMAN="OK" ;--> LKH,LKH1,MDPHONE,SIMA .D MODEM END0 S IND=$P($H,",",1)_$TR($J($P($H,",",2),5)," ",0) S MAC1="^TEMPL($P)",MAC2="^L1TRPROT(IND,""L"")" D ^%S1GC1 D PROT K ^L1TRPRG,^TEMPR($P),^TEMPL($P),^UTILITY($J) END L Q ; GET ; U 0 W %ENG X %chista W !?10,$P($P($ZV,","),"-")," - ","FIRST LINE DISPLAY UTILITY" W !?16,$ZHL(1,"dd-MON-yy")," ",$ZHL(2,"bh:mm P") U 0 K ^TEMPR($P) U $P:(ECHO:WRAP) K QUIT D INT^%RSEL I $D(QUIT) W !,"NO ROUTINES SELECTED" Q S %SAY=" ... oznd `p` " X %XMSGN S N="",I=0 F S N=$O(^UTILITY($J,N)) Q:N="" D .S I=I+1,^TEMPR($P,I)=N_"\"_$$HRA(N) U $P:(NOECHO:NOWRAP) Q PROG ; I %OLDTO="F7" D S %SC("ST")=1 Q .N N,NR K ^L1TRP($P) .S N="" F S N=$O(^ (N)) Q:N="" S ^L1TRP($P,N)="" .S MAC="^L1TRP($P)" .S %L1("BE")=6 .S %L1("EU")=2 .S %L1("T1")=" dxrd | dpkez " .S %L1("TXT1")="%ENG_$$HRA^%L1TRP(%NXN)\/$$ENG^%L1FRM(%NXN,8)<>8" .D ^%L1NU Q:FLAG'="" .S PROG=INDEX,HRA=$$HRA(PROG),%SC("TO")="PL" Q:PROG="" I %OLDTO="F9" D ^%L1CALL("VIEW^%L1TRP(PROG)",%SCRN,"PROG") S %SC("ST")=1 Q I '$D(^ (PROG)) S %SC("ER")=1 Q S HRA=$$HRA(PROG) Q HRA(PROG) ; N HRA S HRA="" X "ZL @PROG S HRA=$$ENG^%L1FRM($$SPA^%L1FRM($P($T(+1),"";"",2,40)),55)" Q HRA ; VIEW(PROG) ; K ^TMPS111($J) X "ZL @PROG F I=1:1 Q:$T(+I)="""" S ^TMPS111($J,I)=$T(+I)" D ^%S2VIEW K ^TMPS111($J) Q ; LKH ; I %OLDTO="F7"!(%OLDTO="F6") D S %SC("ST")=1 Q .N SHM,%S,MAC,%L2VIEW S SHM="",GLB="^TEMPL($P)" .I %OLDTO="F6" S %GET="my zligz++23,60,HH#++10,H,I" D ^%L1GET Q:%S=""!(%TO="ESC") S SHM=%S .K ^TEMPH($P,"EZ") .N N,I S N="" F S N=$O(^LAK(N)) Q:N="" D ..N OK S OK=1 ..N I F I=1:1 Q:'$D(@GLB@(I)) I N=$P(^(I),"\") S OK=0 Q ..Q:'OK ..I $L(SHM),$$HBR^%L1FRM($G(^LAK(N)),$L(SHM))'=SHM Q ..I $P($G(^LAK(N,1)),"\",7)'="k" Q ..S ^TEMPH($P,"EZ",N)=$J($P($G(^LAK(N,1)),"\",3),10)_" | "_$$HBR^%L1FRM($TR($G(^LAK(N)),"|","/"),22)_"|"_$J(N,10)_" " .S MAC="^TEMPH($P,""EZ"")" .S %L2VIEW("T1")=": miyexc zegewl , 'geex' ywn zxfra ,oiivl `p" .S %L2VIEW("Y1")=6 .S %L2VIEW("H")=14 .S %L2VIEW("FIND")=2 .S %L2VIEW("SORT")=2 .S %L2VIEW("SORT",2)="H" .S %L2VIEW("SORT","MASTER")=1 .S %L2VIEW("SORT","HEAD")=" mcen | my | xtqn " .D ^%L2VIEW I $L($G(%L2VIN)),'$D(^L2VMM($J,%L2VIN)),%L2VIN,$G(%I) S ^L2VMM($J,%L2VIN)=%L2VNM .I '$D(^L2VMM($J)) D A^%L1SC S %SC("ST")=1 Q .S N="",I=0 F S N=$O(^L2VMM($J,N)) Q:N="" D ..N LKH,MODEM,SHEM ..S LKH=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",3)) ..S SHEM=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",2)) ..S MODEM=$$SPA^%L1FRM($P(^L2VMM($J,N),"|",1)) ..D ADD^%L1GSEQ(GLB,SH+I,LKH_"\"_SHEM_"\"_MODEM) ..S I=I+1 .K ^L2VMM($J),^TEMPH($P,"EZ") .D GET^%L3MBG .D A^%L1SC Q:$G(LKH)="" S LKH1=$G(^LAK(LKH)) S MDPHONE=$P($G(^LAK(LKH,1)),"\",3) S %SC("TO")="PL" Q ; MODEM ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%L1TRG,MDPHONE,LKH,LKH1,L1TRPRGL,UCI,INTR) D ^%L1C S JOB=$O(^L1TRPRM(999999),-1)+1 I $D(%L1TRG) S ^L1TRPRM(JOB,"G")=1 D ^%L1REF("^L1TRPRG") M ^L1TRPRM(JOB,"SRC")=^L1TRPRG I '$D(%L1TRG) M ^L1TRPRM(JOB,"REF")=%L1REF S ^L1TRPRM(JOB,"PORT")=$G(^PL("MDPORT")),INTR=0 S ^L1TRPRM(JOB,"PHONE")=MDPHONE S ^L1TRPRM(JOB,"XON")=$G(^PL("MDXON")) S ^L1TRPRM(JOB,"LKH")=$G(LKH) S ^L1TRPRM(JOB,"LKH1")=$G(LKH1) S ^L1TRPRM(JOB,"UCI")=UCI S ^L1TRPRM(JOB,"STAT")="S\"_$P_"\"_$H ENDM Q ; ERR L S %NOASKEXIT="" G ER^%L1X ; PROT ; K %L1 S MAC="^L1TRPRM" S %L1("BE")=4 S %L1("EU")=1 S %L1("T1")=" qehhq | xcey izn |xeciyl oken izn| lawnd my | lawnd 'qn|xtqn" S %L1("TXT1")="$$STAT^%L2TRP(%NXN)\/$$TIMEN^%L2TRP(%NXN)\/$$TIMER^%L2TRP(%NXN)\/$G(^L1TRPRM(%NXN,""LKH1""))\/$G(^L1TRPRM(%NXN,""LKH""))\/%NXN" ;S %L1("PLACE")="D PLACE^%L2TRP" S %L1("DO")="D DO^%L2TRP" S %L1("US")="%NXN?1N.N" S %L1("TIME")=20 S %L1("REV")="" D ^%L1NU I FLAG="TIME" G PROT Q DO W *27,7 S %GET=" 3 - zerced, 2 - xcyl , 1 - bivdl " D N^%L1GET I %TO="END"!(%S="") W *27,8 Q N JOB,STAT S JOB=INDEX S STAT=$TR($P(%NXS,"|")," ","") ; I %S=1,$D(^L1TRPRM(JOB,"G")) D Q .K ^L1ADR($J) M ^L1ADR($J)=^L1TRPRM(JOB,"REF") .S %L1GM("VIEW")="" D ^%L1RGR1 K %L1GM ; I %S=1,'$D(^L1TRPRM(JOB,"G")) D Q .K ^L1ADR($J) M ^L1ADR($J)=^L1TRPRM(JOB,"SRC") .S %L1RM("VIEW")="" D ^%L1RGR1 K %L1RM ; I %S=2 D Q .N A S A=$TR($P($G(^L1TRPRM(JOB,"STAT")),"\",3),",","") .I A S ^L1TRPRM(JOB,"STAT",A)=^L1TRPRM(JOB,"STAT") .S ^L1TRPRM(JOB,"STAT")="S\"_$P_"\"_$H .S %SAY=" aey xcey uaew ++12,48,HH,I,R" X %XMSG H 1 .S %L1OLD("TIME")=1 J ^%L1MODJ ; I %S=3 D Q .K ^TMPS111($J) N N,J .S J=0,N="" F S N=$O(^L1TRPRM(JOB,"MSG",N)) Q:N="" D ..S J=J+1,^TMPS111($J,J)=$J(^(N),70) .D ^%S2VIEW K ^TMPS111($J) Q STAT(JOB) ; N STAT S STAT=$P($G(^L1TRPRM(JOB,"STAT")),"\") I STAT="S" Q "oken" I STAT="M" Q "xywzn" I STAT="D" Q "xcyn" I STAT="O" Q "OK" I STAT="N" Q "NOK" Q "" TIMEN(JOB) N TM S TM=$G(^L1TRPRM(JOB,"END")) I TM="" Q "" Q $$^%L1DC(TM,1)_" "_$$T^%L1TIME($P(TM,",",2)) TIMER(JOB) N TM S TM=$P($G(^L1TRPRM(JOB,"STAT")),"\",3) I TM="" Q "" Q $$^%L1DC(TM,1)_" "_$$T^%L1TIME($P(TM,",",2)) %L2VIEW %L2VIEW ; VT220 OR PC [ 22.04.07 20:36 ] [ 19.02.07 13:04 ] [ 20.11.06 13:55 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MAC,%L2VIEW,%I,%L2VIN,%L2VNM,%L2VTO,%L1OS,%PATH) D ^%L1C ;----------------------------------------------------------------- ;INPUT: %L2VIEW("X1") - LEFT, %L2VIEW("Y1") - TOP ; %L2VIEW("H") - HEIGHT,%L2VIEW("LAST") - INDEX ON LAST LINE ; %L2VIEW("T1") - HEADER ; %L2VIEW("TN") - BOTTOM HEADER ; %L2VIEW("SH") - COUNTER IN FILE ; %L2VIEW("I") - COUNTER IN SCREEN ; %L2VIEW("LAST") - CURSOR TO END OF FILE ; %L2VIEW("IND") - DISPLAY INDEX ; %L2VIEW("FIND") - COLUMN NUMBER FOR AL-BET FINDING ; %L2VIEW("DO") - DO MUMPS-COMMAND IF CR WAS PRESSED ; %L2VIEW("PREPROG") - PRE-MUMPS-COMMAND ; %L2VIEW("PROG") - DO MUMPS-COMMAND IF OTHER KEY (NO FUNCTION) WAS PRESSED ; %L2VIEW("PROGF9") - DO MUMPS-COMMAND IF F9 WAS PRESSED ; %L2VIEW("PROGT") - DO MUMPS-COMMAND IF CTRL+T WAS PRESSED ; %L2VIEW("SORT") - COLUMN NUMBER FOR SORTING ; %L2VIEW("SORT","MASTER") - ALTERNATIVE COLUMN NUMBER FOR SORTING ; %L2VIEW("SORT","HEADER") - SCREEN HEADER FOR SORTING ; %L2VIEW("SP") - = ; %L2VIEW("VAR") - VARIABLES ; %L1OS - CALL FROM %L1OS , %PATH ; ; ^L2VMSH($J,%SH)=IND ;-- %SH - POR. NOM ; IND - IND V GLOV ; ^L2VMSH1($J,%SH) - SPISOK OTMECH. INDEXOV ; ;OUTPUT : %I,%L2VIN,%L2VNM,%PATH ;------------------------------------------------------------------ D USE K ^L2VMSH($J),^L2VMSH1($J),^L2VMSH2($J),%SH,^L2VMM($J),%PRFND N %FIND,%LL,%SH,%SH0,%SHOLD,%JJ,%N,%IOLD,%J,%I1,%SM,%SMY,%SMX,%A,%A1,%JJ,%L2VMAC N X1,Y1,X2,Y2 I $D(%L2VIEW("Y1")) S %SMY=%L2VIEW("Y1") I $D(%L2VIEW("X1")) S %SM=%L2VIEW("X1") S N="" F S N=$O(%L2VIEW("VAR",N)) Q:N="" I N?."%"1U.E S @N=%L2VIEW("VAR",N) W %ENG S %CLEAR="" I '$D(MAC) W *7,!!?5,"*** HASN'T NAME ARRAY !" Q I $D(@MAC)<10 S %SAY="! mipezp oi` " X %XMSGV(1) Q I '$D(%POSIC) D ^%L1C S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE I %MOUSE S %L1("RB")=1 I '%MOUSE K %L2VIEW("+-") S %L2VMAC=MAC I MAC'["(" S MAC=MAC_"(" I $E(MAC,$L(MAC))=")" S $E(MAC,$L(MAC))="," S %M=MAC_"^L2VMSH($J,%SH))" S %LL=$L($G(%L2VIEW("T1"))),%SH=0 S %N="",%SH=0 F S %N=$O(@(MAC_"%N)")) Q:%N="" S %SH=%SH+1,^L2VMSH($J,%SH)=%N I $L($G(@%M))>%LL S %LL=$L($G(@%M)) I '$D(^L2VMSH($J,1)) S %SAY=" mipezp oi` !" X %XMSGV(1) Q I %LL>75 S %LL=75 S %I1=%SH I $G(%L2VIEW("H")),%I1>%L2VIEW("H") S %I1=%L2VIEW("H") I %I1>16 S %I1=16 ;--- SCREEN SIZE I $D(%L1("RB")),%I1>5 S %I1=5,%SMY=3,%L2VIEW("Y2")=23 S %SH=0 I '$D(%SM) S %SM=80-%LL\2 I %SM<1!(%SM>70) S %SM=80-%LL\2 S:%SM<3 %SM=3 S %SMX=%SM I '$D(%SMY),'$D(%L1("RB")) S %SMY=22-%I1\2 I '$D(%SMY),$D(%L1("RB")) S %SMY=22-(%I1*3)\2 I %SMY>22,'$D(%L1("RB")) S %SMY=22-%I1\2 I %SMY>22,$D(%L1("RB")) S %SMY=22-(%I1*3)\2 S:%SMY<4 %SMY=4 I %I1>(22-%SMY) S %I1=22-%SMY X:'$D(%CLEAR) %chista N %H0 S %H0=$P($H,",",2) ;------------------------------- BODY ---------------- BD I $G(%CVET) N %CL0 S %CL0=$C(27,91)_"45;37m" S X1=%SM-1,X2=%SM+%LL+3-$G(%L1("RB")),Y1=%SMY+1,Y2=%SMY+(%I1*$S($D(%L1("RB")):3,1:1))+1+'$G(%L1("RB")) I %TYPCRT="PC" D GET^%VIDEO("L2VWVD",X1-1,Y1-2-$D(%L2VIEW("T1")),X2,$$YD(Y2),2) I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_(Y1-2-$D(%L2VIEW("T1")))_";"_(X1-1)_";"_Y2_";"_X2_";;"_(Y1-2-$D(%L2VIEW("T1")))_";"_(X1-1)_";2$v" D PHON I $D(%L2VIEW("T1")) D S %SAY=$G(%L2VIEW("T1"))_"++"_(%SMY-1)_","_(%SMX+%LL)_",HH++MB,YF L" X %XMSG .N %L1RBCL S %L1RBCL=%CV("MB") .D CLEAR^%L1RBUA(Y1-1,X1-1,Y1+1,X2) .D RBUA(X1,X2,Y1-2,Y1) I $D(%L2VIEW("T2")) X %L2VIEW("T2") S %I=1,%SH=1 I $D(%L2VIEW("SH")) S %SH=%L2VIEW("SH") I $D(%L2VIEW("I")) S %I=%L2VIEW("I") I $D(%L2VIEW("LAST")) S %SH=$O(^L2VMSH($J,999999),-1),%I=%I1 I %I>%I1 S %I=%I1 I $D(^L2VMSH($J,%SH+%I1)) S %L1("MENU")="" D PC(%SH-%I) I '$D(%L1("RB")) D .I $D(%L2VIEW("SORT","HEAD")),'$D(%L2VIEW("TN")) D S %SAY=" - oein zepyl ++"_Y2_","_(%SMX+%LL)_",HH" X %XMSG ..S %L1RBCL="" D RBUA(X1,X2,Y2,Y2+2) .I $D(%L2VIEW("TN")) D S %SAY=%L2VIEW("TN")_"++"_Y2_","_(%SMX+%LL)_",HH" X %XMSG ..S %L1RBCL="" D RBUA(X1,X2,Y2,Y2+2) CYC0 D INV CYC D ^%L1MSGBR G RDS ;;R *%A:1 G:$T READ G CYC I $G(%L2VIEW("TIME")),'$D(^L2VMSH1($J)) D RTIME(%L2VIEW("TIME")) E S %L2VTO="TIME" G ENDPR ; READ G:%TYPCRT="PC" CYC1 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 S %A=ZB I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))'="" G @%UPRCOD(ZB) I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))="" S %A=ZB I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL G @%UPRCOD($ZB) ; CYC1 ; I %A=61 G 27 ;I %A=27 R *%A1:%WAIT G:%A1=-1 27 R *%A:%WAIT G:%A=-1 27 S %A=%A1_%A G COM I %A=27 D DELAY R:'$D(%FLL) *%A1:%WAIT G:%A1<0 ESC D G COM .S %A="" D DELAY R:'$D(%FLL) *%A2:%WAIT S:%A2>0 %A=%A1_%A2 .R:'$D(%FLL) *%A3:%WAIT S:%A3>0 %A=%A_%A3 .R:'$D(%FLL) *%A4:%WAIT S:%A4>0 %A=%A_%A4 I %A=0 R *%A1:%WAIT I %A1>0 S %A="0"_%A1 G COM I %A=13,$D(%L1OS),@%M'?.P,$E(@%M,18,22)'["<",%L1OS'["6" S %A=$A("V") I %A=13,$D(%L2VIEW("SP")) G:$D(^L2VMSH1($J,%SH)) CYC S %A=32 I %A=13 G:'$D(%L2VIEW("DO")) ENDPR D PROG("DO") G:%L2VIEW("DO")="Q" ENDPR G BD I %A=16 D PRINT G 27 COM I $D(%UPRCOD(%A)),$T(@%UPRCOD(%A))'="" G @%UPRCOD(%A) I $D(%L2VIEW("PROG"))#2 D G:%L2VIEW("PROG")="Q" ENDPR .S %L2VIEW("PROG","%A")=%A .D PROG("PROG") D RESTORE I %A=32,'$D(^L2VMSH1($J,%SH)),$G(^L2VMSH($J,%SH))'="",$G(@%M)'["<"!'$D(%L1OS) S ^L2VMSH1($J,%SH)="" D PC1 G:$D(%L2VIEW("SP"))&'$D(%L1("RB")) VNIZ G CYC I %A=32,'$D(%L2VIEW("+-")),$D(^L2VMSH1($J,%SH)) K ^L2VMSH1($J,%SH) D PC1 G:$D(%L2VIEW("SP")) VNIZ G CYC I %A>32,%A<127,$G(%L2VIEW("FIND")) D G CYC .N %S,%SHOLD,%IOLD,%FIND .S %S=$C(%A),$X=%SMX+%LL-1,$Y=Y2,%LS=20,%BE="E" D ^%L1ZMS Q:%S="" S %NAME=%S .D FND(%NAME) I %A>255 G CYC I $D(%L1OS) D ^%L2VWOS(%A,%M,%L1OS) D RESTORE I $C(%A)="=" G 27 G CYC FND(%NAME) ; N %FIND,%SHOLD,%IOLD S %FIND=0,%SHOLD=%SH,%IOLD=%I F %SH=%SHOLD+1:1 Q:'$D(^L2VMSH($J,%SH)) S %A=$$HBR^%L1FRM($$SPA^%L1FRM($P($G(@%M),"|",$L(@%M,"|")-%L2VIEW("FIND")+1)),$L(%NAME)) I %A=%NAME S %FIND=1 Q I '%FIND W *7 S %SAY="NOT FOUND" X %XMSGV(1) S %SH=%SHOLD,%I=%IOLD D RESTORE Q I %IOLD+%SH-%SHOLD'>%I1 S %I=%IOLD+%SH-%SHOLD D RESTORE Q S %I=1 K %SHOLD,%IOLD D RESTORE Q RESTORE S %SH0=%SH S:%SH<%I %I=%I-1 S %SH=%SH-%I I $D(%L1OS) X %chista I $D(%L1OS) D SPACE^%L1OS D PHON,PC(%SH) S %SH=%SH0 D INV Q ESC ; 27 S %I="",%L2VIN="",%L2VNM="" ENDPR S %L2VNM="",%L2VIN="" I $D(^L2VMSH($J,%SH)) S %L2VIN=^L2VMSH($J,%SH),%L2VNM=$G(@%M) S N="" F %JJ=1:1 S N=$O(^L2VMSH1($J,N)) Q:N="" S %SH=N I $D(^L2VMSH($J,%SH))#2,$D(@%M)#2 S %SH=N,^L2VMM($J,^L2VMSH($J,%SH))=@%M K ^L2VMSH($J),^L2VMSH1($J),^L2VMSH2($J) K %A,%B,%M,%LL,%I1,%B1,%B2 D ^%L1C X %XCL K %SM,%SMX,%SMY W:$D(%HBRY) %HBR I %TYPCRT="PC" D PUT^%VIDEO("L2VWVD",X1-1,Y1-2-$D(%L2VIEW("T1")),X2,$$YD(Y2),2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_(Y1-2-$D(%L2VIEW("T1")))_";"_(X1-1)_";"_Y2_";"_X2_";2;"_(Y1-2-$D(%L2VIEW("T1")))_";"_(X1-1)_";$v" Q W $C(27,91),"?25h" W %HBR K %L2VIEW Q ;- SERV ; VVERX G:%I=1 VVM D CL S %I=%I-1,%SH=%SH-1 W %vverx D INV G CYC VNIZ G:'$D(^L2VMSH($J,%SH+1)) CYC G:%I=%I1 VNM D CL S %I=%I+1,%SH=%SH+1 W %vniz D INV G CYC PGDN G:'$D(^L2VMSH($J,%SH+%I1-%I-1)) CYC S %SH=%SH+%I1-%I,%I=1 D CLEAR,PC(%SH) S %SH=%SH+1 G CYC0 PGUP I %SH-%I1-%I<1 S %SH=0,%I=1 G PGUP1 S %SH=%SH-%I1-%I,%I=1 PGUP1 D CLEAR,PC(%SH) S %SH=%SH+1 G CYC0 MIN N %A S %A=$A("-"),%L2VIEW("PROG","%A")=%A D PROG("PROG") G CYC0 PLUS N %A S %A=$A("+"),%L2VIEW("PROG","%A")=%A D PROG("PROG") G CYC0 END G:'$D(^L2VMSH($J,%SH+%I1-%I)) CYC F %J=1:1 Q:'$D(^L2VMSH($J,%J)) S %SH=%J-%I1-1,%I=1 G PGUP1 HOME S %SH=0,%I=1 G PGUP1 FIND I '$D(%L1OS),$D(%L2VIEW("SORT")) G SORT S %FIND=0 S %SHOLD=%SH,%IOLD=%I S %GET="NAME- ,DATE - ++23,10,EE,,,C#N++1,E,I++DN" D ^%L1GET S:%S="" %S="N" S %PRFND=%S S %YY=23,%XX=0 X %POSIC W %chists FD0 G:%PRFND="N" FN0 S %XX=20 D ^%L1DAT G:%S="" NF FD F %SH=%SHOLD+1:1 Q:'$D(^L2VMSH($J,%SH)) I $TR(@%M," ","")[(+$E(%L1DAT1,4,5)_"-"_$E(%L1DAT1,1,2)_$S($E(%L1DAT1,7,8)<50:"-20",1:"-19")_$E(%L1DAT1,7,8)) S %FIND=1 Q G NF FN0 S %GET="BEGIN OF NAME:++23,20,EE,I,R#++10,E,I" D ^%L1GET I %S="" S %SH=%SHOLD,%I=%IOLD D RESTORE G CYC S %NAME=%S FN F %SH=%SHOLD+1:1 Q:'$D(^L2VMSH($J,%SH)) I $E($TR(@%M," ",""),1,$L(%NAME))=%NAME S %FIND=1 Q NF I '%FIND W *7 S %SAY="NOT FOUND" X %XMSGV H 2 S %SH=%SHOLD,%I=%IOLD K %SHOLD,%IOLD D RESTORE G CYC S %I=1 K %SHOLD,%IOLD D RESTORE G CYC TAB I $D(%PRFND) S %S=%PRFND,%SHOLD=%SH,%IOLD=%I,%FIND=0 G @("F"_%PRFND) G CYC I $L($G(%NAME)) D FND(%NAME) G CYC SORT ; D SORT1 G BD SORT1 N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MAC,%L2VIEW) D ^%L1C S GLB=MAC N MAC Q:'$D(%L2VIEW("SORT","HEAD")) S STG=%L2VIEW("SORT","HEAD") I $G(%L2VIEW("SORT")) D G SORT2 .S %I=%L2VIEW("SORT") .I $G(%L2VIEW("SORT","MASTER")) D ..N A S A=%L2VIEW("SORT","MASTER") ..S %L2VIEW("SORT","MASTER")=%L2VIEW("SORT") ..S %L2VIEW("SORT")=A S M(0)=" : oeinl oezp xegal `p " S M(1)=" d ` i v i " S J=1 K MI F I=1:1:$L(STG,"|") D .S J=J+1 .S M(J)=$$SPA^%L1FRM($P(STG,"|",$L(STG,"|")-I+1)) S MAC="M",%L2MN("NOCLB")=1 D ^%L2MENU Q:%I=1 S %I=%I-1 SORT2 K ^L2VMSH2($J) N N S N="" F S N=$O(^L2VMSH1($J,N)) Q:N="" S ^L2VMSH2($J,^L2VMSH($J,N))=N K ^L2VMSH($J),^L2VMSH1($J) S TYPS=$G(%L2VIEW("SORT",%I),"E") K ^vrm($J) S N="" F J=1:1 S N=$O(@(GLB_"N)")) Q:N="" D .S A=$G(^(N)) .S IND=$$SPA^%L1FRM($P(A,"|",$L(STG,"|")-%I+1)) .I TYPS="H" S IND=$$INV^%L1FRM($$HBR^%L1FRM(IND,10))_$TR($J(J,5)," ",0) .I TYPS="D"!(IND?2N1"."2N1"."2N)!(IND?2N1"."2N1"."4N)!(IND?2N1"/"2N1"/"2N)!(IND?2N1"/"2N1"/"4N) D G SORTV ..S IND=$J($$^%L1DC(IND,3),10)_$TR($J(J,5)," ",0) .I TYPS="E"!(TYPS="N") S IND=$J(IND,10)_$TR($J(J,5)," ",0) SORTV .S ^vrm($J,IND)=N S N="",SH=0 F S N=$O(^vrm($J,N)) Q:N="" S SH=SH+1,^L2VMSH($J,SH)=^vrm($J,N) D .I $D(^L2VMSH2($J,^L2VMSH($J,SH))) S ^L2VMSH1($J,SH)="" K ^vrm($J),^L2VMSH2($J) Q ;- VVM ; I $G(%L1("RB")) G CYC G:%SH'>1 CYC D S %SH=%SH-1 G CYC0 .I %TYPCRT="PC" D CL H .3 D Q ..D GET^%VIDEO("L2VWVD1",X1,Y1,X2-X1,Y2-Y1-2,2) ..D PUT^%VIDEO("L2VWVD1",X1,Y1+1,X2-X1,Y2-Y1-2,2) .I $E(%TYPCRT,1,3)="VT5" D CL D Q ..W $C(27,91),(Y1+1)_";"_X1_";"_(Y2-2)_";"_X2_";;"_(Y1+2)_";"_X1_";$v" .D CLEAR,PC(%SH-2) VNM G:'$D(^L2VMSH($J,%SH+1)) CYC I $G(%L1("RB")) G CYC D CL H .3 S %SH00=%SH,%SH0=%SH+1,%SH=%SH-%I+1 D S %SH=%SH0 K %SH0 G CYC0 .I %TYPCRT="PC" D Q ..D GET^%VIDEO("L2VWVD1",X1,Y1+1,X2-X1,Y2-Y1-2,2) ..D PUT^%VIDEO("L2VWVD1",X1,Y1,X2-X1,Y2-Y1-2,2) . .I $E(%TYPCRT,1,3)="VT5" D Q ..W $C(27,91),(Y1+2)_";"_X1_";"_(Y2-1)_";"_X2_";;"_(Y1+1)_";"_X1_";$v" . .D CLEAR,PC(%SH) ;- CL X %XCL D PC1 Q ;- INV X %XCL W %CLI D D PC1 .N %I Q:'$G(%SH) Q:'$D(^L2VMSH($J,%SH)) .I $D(%L2VIEW("PREPROG")) X %L2VIEW("PREPROG") Q ;- PHON ; X %XCL S %L1RBCL="" I '$D(%L1("RB")) D RBUA(X1,X2,Y1,Y2) I $D(%L1("RB")) D .N %L1RBCL S %L1RBCL=%CV("MB") ; "BB" .D CLEAR^%L1RBUA(Y1,X1-1,Y2+1,X2+1) ; Y2+1 Q ;- PC(%SH) ; N %PC S %PC="" X %XCL N %I S %SHOLD=%SH F %I=1:1:%I1 S %SH=%SH+1 Q:'$D(^L2VMSH($J,%SH)) Q:'$D(@%M) W:$G(%CVET) %CV("MB") D PC1 S %SH=%SHOLD ;;K %SHOLD I $D(%L1OS) S %SAY="F8 - FIND "_$S($G(%L1OS)'[2:", D - DELETE",1:"")_" V - VIEW L - LIST "_$S($G(%L1OS)'[5:" C - COPY ",1:"")_$S($G(%L1OS)'[3:" R - ^%RR",1:"")_$S($G(%L1OS)'[4:" G - ^%GR ",1:"") X %XMSGN Q PC1 Q:'$D(^L2VMSH($J,%SH)) Q:'($D(@%M)#2) S %LL1=$L(^L2VMSH($J,%SH))+1 ;;S %XX=%SMX,%YY=%I+%SMY X %POSIC I $D(%L1("RB")) W $C(27,91),"?25l" S %YY=%SMY+(%I*$S($D(%L1("RB")):3,1:1)) S:$D(%L1("RB")) %YY=%YY-1 I $D(%L1("RB")) D .N X1,X2,Y1,Y2 .S X1=%SM-1,X2=X1+%LL+3 .S Y1=%YY,Y2=%YY+2 .I %I=%I1,$D(%L1("MENU")),$D(%PC) D ; KAMA DAPIM ..N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 ..N Y0 S Y0=%YY+4 ..S X1=X10,X2=X1+7,Y1=Y0,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA(X1,X2,Y1,Y2) ..S X1=X20-7,X2=X1+7,Y1=Y0,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA(X1,X2,Y1,Y2) N %XX,%YY ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X10+1,%YY=Y1 X %POSIC W "PGUP" ..S %XX=X20-6 X %POSIC W "PGDN" ..I '$D(%L2VIEW("+-")) D ...S X1=X10+8,X2=X20-8 Q:X2'>X1 D RBUA(X1,X2,Y1,Y2) ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "E S C" ..I $D(%L2VIEW("+-")),X20-X10>25 D ...S X1=X10+8,X2=X10+15 D RBUA(X1,X2,Y1,Y2) ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "ESC" ...S X1=X2+1,X2=X1+((X20-X10-24)\2) D RBUA(X1,X2,Y1,Y2) ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-3)\2)+1,%YY=Y1 X %POSIC W "-" ...S X1=X2+1,X2=X20-8 D RBUA(X1,X2,Y1,Y2) ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-2)\2),%YY=Y1 X %POSIC W "+" . .W %CV("YF"),%LIGHT1 D RBUA(X1,X2,Y1,Y2) ; S %XX=%SMX X %POSIC I $D(^L2VMSH1($J,%SH)) W %CLI I $D(%L2VIEW("IND")) W $J($E($$W(@%M),1,%LL-5),%LL-5),"|",$J(^L2VMSH($J,%SH),3) W %ENG X %XCL I '$D(%L2VIEW("IND")) W $J($E($$W(@%M),1,%LL),%LL) X %XCL I $D(^L2VMSH1($J,%SH)) W "*" E W " " ; S %L3VINV=0 I %I=%I1,'$D(%L1("MENU")),$D(%L1("RB")) D .N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 .S Y1=%YY+4,Y2=Y1+2 .I '$D(%L2VIEW("+-")) D ..S X1=X10,X2=X20 Q:X2'>X1 D RBUA(X1,X2,Y1,Y2) ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "E S C" .I $D(%L2VIEW("+-")) D ..S X1=X10,X2=X10+12 Q:X2'>X1 D RBUA(X1,X2,Y1,Y2) ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2)-1,%YY=Y1 X %POSIC W "E S C" ..S X1=X2+1,X2=X1+(X20-X10-9\2) D RBUA(X1,X2,Y1,Y2) ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "-" ..S X1=X2+1,X2=X20 D RBUA(X1,X2,Y1,Y2) ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "+" Q W(%TX) I $D(%L2VIEW("NOHB")) Q %TX Q $TR($TR(%TX,%TES1,%TES2),%TEN,%THB) ;- CLEAR ; I $G(%CVET) W %CV("MB") X %XCL N %I S %SHOLD=%SH N %KF S %KF=$S($G(%L1("RB")):3,1:1) F %I=1:1:%I1*%KF S %XX=%SM-1-$G(%L1("RB")),%YY=%I+%SMY X %POSIC W $J("",%LL+3+$G(%L1("RB"))) S %SH=%SHOLD K %SHOLD Q ;- CVET W $J("",%LL+4) I $D(%CL0) W *27,*91,%CL0,"m" E X %XCL Q ;- RBUA(X1,X2,Y1,Y2) ; INPUT X1,X2,Y1,Y2 N %I,SH S:$G(%CVET) %L1RBCL="" D ^%L1RBUA K %L1RBCL Q SAVE ; I $D(%L2VIEW("PROGF9"))#2 D PROG("PROGF9") G:%L2VIEW("PROGF9")="Q" ENDPR G BD G ENDPR Q VNIZE ; I $D(%L2VIEW("PROGT"))#2 D PROG("PROGT") G:%L2VIEW("PROGT")="Q" ENDPR G BD G BD PRSC ; D ^%L1PRSC G ENDPR PROG(DO) ; S %L2VIEW("SH")=%SH,%L2VIEW("I")=%I N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%SH,%L2VIEW,DO,%M) D ^%L1C S MAC1="%L2VIEW",MAC2="%L2VIEWO" D ^%S1GC1 S N="" F S N=$O(%L2VIEW(DO,N)) Q:N="" I N?."%"1U.E S @N=%L2VIEW(DO,N) D .N %L2VIEWO X %XCL X %L2VIEW(DO) X:$D(%L2VIEW("C")) %chista K %L2VIEW S MAC1="%L2VIEWO",MAC2="%L2VIEW" D ^%S1GC1 Q PRINT ; N %L2VWDEV,%L2VWPRN,%L2VWSHL,%NN1 S %NN1=0,%L2VWSHL=0 S %L2VWDEV=3 S %DEV="%L2VWDEV" D OPEN^%L1LPT Q:%EROP S %L2VWPRN("SM")=80-%LL\2 D ^%L1TS I $D(%L2VIEW("PRINT","PROG")) X %L2VIEW("PRINT","PROG") G CLPRINT D KOT U %L2VWDEV S %NN="" F S %NN=$O(@(MAC_"%NN)")) Q:%NN="" D .W !?%L2VWPRN("SM"),$TR($G(@(MAC_"%NN)")),TS0,TSS) S %NN1=%NN1+1 I %NN1>52 D KOT U %L2VWDEV D:$D(%L2VIEW("T1")) KAV CLPRINT S %DEV="%L2VWDEV" D CLOSE^%L1LPT U 0 S %GET=" . dnlyed dqtcd " D N^%L1GET Q KOT ; S %NN1=0 S %L2VWSHL=%L2VWSHL+1 W:%L2VWSHL>1 # U %L2VWDEV S %TIM=$ZD($H,"24:60") W !,%L2VWSHL,$TR(" sc ",TS0,TSS),?10,%TIM_$TR(" :dry ",TS0,TSS)_$$^%L1DC($H,1)_$TR(" :g""ec zwtd jix`z",TS0,TSS),! I $D(%L2VIEW("T3")) X %L2VIEW("T3") I $D(%L2VIEW("T1")) D KAV W !?$G(%L2VWPRN("SM"))+1,$TR(%L2VIEW("T1"),TS0,TSS) D KAV W ! Q ;* KAV ; W !?$G(%L2VWPRN("SM"))+1,$TR($J("",$L(%L2VIEW("T1")))," ","-") Q DELAY Q H .05 USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q RTIME(%TM) ; N %JJ F %JJ=1:1:%TM D ^%L1MSGBR R *%A:1 Q:$T Q RDS ; I '$G(%MOUSE),$G(%L2VIEW("TIME")),$P($H,",",2)-%H0>%L2VIEW("TIME") S %L2VTO="TIME" G ENDPR H .1 R *%A:0 E G MOUSE:%MOUSE,CYC G READ MOUSE ; S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I '%CRD G CYC S LAB="" ;;S %SAY="%CRD="_%CRD_", Y2="_Y2_",X1="_X1_", X2="_X2_" ,%SH="_%SH_", %I="_%I_",%I1="_%I1 X %XMSGV I $P(%CRD,",",2)=(Y2+1) S $P(%CRD,",",2)=Y2-1 I $P(%CRD,",",2)=Y2 S $P(%CRD,",",2)=Y2-1 I $P(%CRD,",",2)'<(Y2+1),($P(%CRD,",",2)'>(Y2+4)) D G:LAB="" CYC G @LAB .N X10,X20 S X10=X1,X20=X2 N X1,X2,%XX,%YY .I $D(%L1("MENU")) D Q ..I $P(%CRD,",")'>(X10+7)&($P(%CRD,",")'25),$P(%CRD,",")<(X20-7)&($P(%CRD,",")'<(X10+8)) S LAB="ESC" Q ..I $D(%L2VIEW("+-")),$P(%CRD,",")'>(X10+15)&($P(%CRD,",")'<(X10+8)) S LAB="ESC" Q ..I $P(%CRD,",")'>X20&($P(%CRD,",")'<(X20-7)) S LAB="PGDN" Q ..I $D(%L2VIEW("+-")),X20-X10>25 D ...I $P(%CRD,",")'<(X10+16)&($P(%CRD,",")'>(X10+16+(X20-X10-24\2))) S LAB="MIN" Q ...I $P(%CRD,",")'<(X10+16+(X20-X10-24\2)+1),$P(%CRD,",")'>(X20-8) S LAB="PLUS" Q . .I '$D(%L2VIEW("+-")) S LAB="ESC" Q .I $P(%CRD,",")'(X10+12)) S LAB="ESC" Q .I $P(%CRD,",")'<(X10+13)&($P(%CRD,",")'>(X10+13+((X20-X10-9)\2))) S LAB="MIN" Q .I $P(%CRD,",")'<(X10+13+((X20-X10-9)\2)),$P(%CRD,",")'>X20 S LAB="PLUS" Q .S LAB="ESC" ; I $P(%CRD,",")<(X1-1)!($P(%CRD,",")>(X2+1)) G RDS I $P(%CRD,",",2)<(Y1-1)!($P(%CRD,",",2)>(Y2+1)) G RDS S %IN=$P(%CRD,",",2)-%SMY-1+$G(^SMXY(%L3MYDVN))\3+1 ;;I '$D(@%L2VMAC@(^L2VMSH($J,%IN))) G CYC ; D .D CL .S %SH=$G(%SHOLD)+%IN,%I=%IN D INV ; S %A=13 S %A=32 G CYC1 YD(Y2) ; N Y23 I $G(%L1("RB")) D Q Y23 .I Y2<22 S Y23=Y2+3 .I Y2<23 S Y23=Y2+2 .I Y2<24 S Y23=Y2 .S Y23=24 I Y2<22 S Y23=Y2+2 I Y2<23 S Y23=Y2+1 I Y2<24 S Y23=Y2 Q 23 %L2VWOS %L2VWOS(%A,%M,%L1OS) ; [ 13.04.01 2:10 PM ] [ 02/12/99 1:05 AM ] [ 12/05/96 9:12 AM ] ;-- %SH - NUMBER OF CURRENT LINE ;-- %L1OS: =1 - NO EDIT ; =2 - NO DELETE ; =3 - NO ROUTINE RESTORE ; =4 - NO GLOBAL RESTORE ; =5 - NO COPY ;---------------------------------- N %II Q:'$D(%L1OS) ;;------------------- VIEW N $ZT S $ZT="" I $C(%A)="V"!($C(%A)="v"),$P($$SP1^%L1FRM(@%M)," ",2)'["<" D G END .S %NMF=$$NM^%L1OS(@%M) .X %chista N %HBRY .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%NMF,%HBRY) .S %S2V("NOHB")="" D ^%L1C,^%S2V ;; ;;------------------- EDIT ;; I $C(%A)="E"!($C(%A)="e")!($C(%A)="w"),%L1OS'[1 D G END .S %NMF=$$NM^%L1OS(@%M) .X %chista N (%NMF) S %TIP="G" D ^%L1HFS ;; ;;------------------- DELETE ;; I $C(%A)="D"!($C(%A)="d"),%L1OS'[2 D G END .S %NMF=$$NM^%L1OS(@%M) .X %chista W !!,%NMF S %Q("Z")="DELETE",%Q("U")="N",%Q("V")="." D ^%S1ASK Q:'YES!(YES=".") .S %ER=$$^%L1ZOS(2,%NMF) I %ER<0 D ^%L1OS1 W !! H 2 Q .W " ...DELETED." H 1 F %II=%SH:1 Q:'$D(^TEMPo($P,%II+1)) S ^TEMPo($P,%II)=^TEMPo($P,%II+1) .K ^TEMPo($P,%II) I '$D(^TEMPo($P,%SH)) S %SH=%SH-1 ;; ;;------------------- ROUTINE RESTORE ;; I $C(%A)="R"!($C(%A)="r"),%L1OS'[3 D G END .D SAVE .S %NMF=$$NM^%L1OS(@%M) .X %chista W !!,%NMF S %Q("Z")="RESTORE",%Q("U")="N",%Q("V")="." D ^%S1ASK Q:'YES!(YES=".") .S %FN=%NMF O %FN:(REWIND:READONLY):2 E U 0 W !,"*** FILE "_%FN_" IN USE !" Q .N (%FN,%DEV,%UPRCOD,%XMSGV,%XMSG,%XMSGN) D ^%L1C S NAME=" ROUTINE ",ZAP=0 W !?10,$C(27,91,55,109)," ",$$^%L1ZU(0)," ",$C(27,91,48,109)," ",$P($P($ZV,","),"-")," - ROUTINE RESTORE UTILITY " D INT^%L1RR ;; ;;------------------- GLOBAL RESTORE ;; I $C(%A)="G"!($C(%A)="g"),%L1OS'[4 D G END .D SAVE .S %NMF=$$NM^%L1OS(@%M) .X %chista W !!,%NMF S %Q("Z")="RESTORE",%Q("U")="N",%Q("V")="." D ^%S1ASK Q:'YES!(YES=".") .S %FN=%NMF O %FN:(REWIND:READONLY):2 E U 0 W !,"*** FILE "_%FN_" IN USE !" Q .N (%FN,%DEV,%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C S NAME=" GLOBAL " K ^L1ADR($J) W !?10,$C(27,91,55,109)," ",$$^%L1ZU(0)," ",$C(27,91,48,109)," ",$P($P($ZV,","),"-")," - GLOBALS RESTORE UTILITY " D SDEV+1^%L1GR ;; ;;------------------- COPY ;; I $C(%A)="C"!($C(%A)="a"),%L1OS'[5 D G END .D SAVE .S %NMF=$$NM^%L1OS(@%M) .S %FN=%NMF O %FN:(READONLY:REWIND):2 E U 0 W !,"*** FILE "_%FN_" IN USE !" Q .N (%NMF,FN,%DEV,%UPRCOD,%XMSG,%XMSGV,%XMSGN) D ^%L1C U $P X %chista .S %S=%NMF,%L1GET="" D Z1^%L1COPY ;; ;;------------------- LIST ;; I $C(%A)="L"!($C(%A)="l"),$D(%L1OS) D G END .S %NMF=$$NM^%L1OS(@%M) .D SAVE N (%PATH,%M,%UPRCOD,%XMSGV,%XMSG,%XMSGN,%NMF) D ^%L1C .S %FN="",%DEV="",%OFN="",%PRM2="" .X %chista W !!,%NMF S %FN=%NMF D OPEN^%FLIST SAVE ; Q END Q %L2XMIT %L2XMIT ;RTM;MSM CPU<->CPU TRANSMIT; [ 08.02.02 2:33 PM ] [ 11.02.01 10:23 AM ] [ 002/13/00 9:04 PM ] ; COPYRIGHT MICRONETICS DESIGN CORP. @1985 ; If you need to send $C(1) or $C(2) through as data, ; pick another character and change the line INIT+1. ; %HT = wait time for READs (0 or 1) ; %DT = # of READs from IO device since last terminal read ; %DC = # iterations thru fast loop with no data received ; %RS = 1 if recording, 0 if not S %INT=0 K %MSM ; $D(%MSM) flag for calling from %TRANS S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" GO S %HT=0,%DT=0,%DC=0,%RS=0,FLSTART=1 G:%INT INIT W !?10,$P($P($ZV,","),"-")," - Transmission Utility" I $D(^PL("MDPORT")) S %IO=^("MDPORT") G ASK1 ASK R !!,"I/O PORT? > ",%IO G:%IO="" EXIT G:%IO?1"^".E EXIT I %IO?1"?".E D QUE G ASK ASK1 I $I=%IO!'%IO W !!,"Cannot select your own device.",*7 G ASK S $ZT="ZG "_$ZL_":NOPEN^%L1XMIT" U $P:(CENABLE) O %IO::0 E W *7,"..line in use..waiting.." O %IO W "ready" S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" U %IO I $ZB($ZA,2,1) U 0 W !,"Device ",%IO," is an output only device.",*7 G ASK INIT U 0 S %ESC=$ZB($ZA,64,1) ; save escape processing status S %EXIT=$C(1),%RECORD=$C(2) ;;V 0:$J:$ZB($V(0,$J,2),#0400,7):2 ; Turn off pass-all, esc processing, & tab control. Set terminators U %IO:(0::::#001001:#800040:::$C(3,8,13,21,24,27,127)) U 0:(0::::#000001:#800040:::$C(3,8,13,15,18,21,24,27,127)) U $P:(NOCENABLE) W ! TERM ; U 0 I $G(FLSTART)=1 S %X="AT"_$G(^PL("MDXON"))_"S0=1" K FLSTART S %CR=13 I 1 G TERM10 R %X:%HT TERM1 S %CR=$ZB ; get READ terminator TERM10 G:$E(%X)=%EXIT EXIT D:$E(%X)=%RECORD .D @$S(%RS:"HALT",1:"RECORD") S %X=$E(%X,2,$L(%X)) Q U %IO W:$L(%X) %X W:$T $C(%CR) S:$L(%X)!$T %DC=0,%HT=0 S %DT=0 PORT ; U %IO R %Y:%HT G:%INT&(%Y=$C(1)) EXIT S %CR=$ZB U 0 W:$L(%Y) %Y W:$T $C(%CR) S:$L(%Y)!$T %DC=0,%HT=0,%DT=%DT+1 S:$L(%Y)&%RS %XS=%XS_%Y I $T,%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1 K:%XS["OK" FLSTART S %XS="" PORT1 I %DT>20 G TERM ; heavy incoming data, force check of CRT G TERM:$L(%X),PORT:$L(%Y) S %DC=%DC+1 G:%DC<500 TERM S %HT=1 ; READ timeout 1, goto slow mode TERMWAIT ; TERMWAIT and PORTWAIT handle periods in which no data has been ; received from either side for %DC iterations through the ; TERM & PORT loop. U 0 R %X#1:%HT E G PORTWAIT G:%X=%EXIT EXIT I %X=%RECORD D @$S(%RS:"HALT",1:"RECORD") S (%DC,%DT,%HT)=0 G TERM S %CR=$ZB TW1 U %IO W %X W:'$L(%X) $C(%CR) S (%DC,%DT,%HT)=0 G TERM PORTWAIT ; U %IO R %Y#1:%HT E G TERMWAIT G:%INT&(%Y=%EXIT) EXIT ; %TRANS rtn or gbl selection finished S %CR=$ZB U 0 W %Y W:'$L(%Y) $C(%CR) S (%DC,%DT,%HT)=0 ; If recording... S:$L(%Y)&%RS %XS=%XS_%Y ; add to captured string ; or terminate & file captured string I '$L(%Y),%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1,%XS="" G PORT EXIT ; D:%RS HALT I $D(%ESC),%ESC U 0:(::::64) K %ESC,%X,%Y,%RS,%XN,%XE,%XS,%DC,%DT,%HT,%CR,%EXIT,%RECORD U:(%IO?.N)&(%IO'="") %IO:(:::::#001001:::$C(13,27)) U 0:(:::::#000001:::$C(13,27)) I %INT!$D(%MSM) U $P:(CENABLE) K %INT Q ; return to %TRANS I %IO?.N&(%IO'="") C %IO U 0 K %IO,%INT W:'$F($ZS,"") !,"Transmission Complete",!! Q RECORD ; S:'$D(^XMIT) ^XMIT(0)=1 S %XN=^XMIT(0),^XMIT(0)=%XN+1,%RS=1,%XS="",%XE=1,%X=$E(%X,2,999),^XMIT(%XN)=$H U 0 W !!,"Recording Started in ^XMIT(",%XN,",1)",! Q HALT ; S:$L(%XS) ^XMIT(%XN,%XE)=%XS S %RS=0 U 0 W !!,"Recording halted, last node is ^XMIT(",%XN,",",%XE,")",!! Q NOPEN S %IO="" ; avoid on ERROR ; I $F($ZS,"") F %XE=%XE:1 G:%XS="" ERROR1 S ^XMIT(%XN,%XE)=$E(%XS,1,255),%XS=$E(%XS,256,9999) I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 I $F($ZS,"") DO:$I'=$P D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 .U 0 W !!,"...Disconnected." Q ERROR1 S $ZT="ZG "_$ZL_":ERROR^%L1XMIT" G PORT1 ; resume after INT ;FROM TRANSFER UTILS S %INT=1 U $P:(NOCENABLE) G GO ; QUE W !! F %IO=1:1 S %X=$T(TEXT+%IO) Q:%X="" W $P(%X,";",2),! Q TEXT ; ;Enter the port number to be used for the transmission. ;While the transmission is in progress, all characters except CTRL/A ;and CTRL/B will be passed through to the port. ;Use CTRL/B to start or stop recording of the information in the XMIT ;global, and CTRL/A to exit the program. %L3CVET %L3CVET(STAM) ; [ 25.02.05 14:06 ] [ N %CVET S %CVET=0 I '$D(%L3MYDVN) S %L3MYDVN=$$^%L3MYDVN I '$D(%L3GLD) S %L3GLD=$$^%L1GLD S %CVET=+$G(^[%L3GLD]%CVET(%L3MYDVN)) Q %CVET CL0(STAM) ; N %CL0 S %CL0=$C(27,91)_"44;37m" I $D(^[%L3GLD]%CVET(%L3MYDVN,"CL0")) S %CL0=^("CL0") Q %CL0 %L3DJRN %L3DJRN ;BFH;DEJOURNAL UTILITY[ 02/16/90 4:48 PM ] [ 04/24/92 4:31 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 S $ZT="ZG "_$ZL_":ERR^%L3DJRN" K REPEAT ;U 0 W !?10,$P($P($ZV,","),"-")," - Dejournal Utility" O 63::1 E W !,"Device 63 is busy, please try again later" Q S SV=$V(44) S OS=$V(SV,-3,2)#16 ; get operating system type, 0=VM, 3=UNIX5, 6=DG, 8=MS/DOS START D AREA G:QF EXIT ALL ; S X="ALL" ;W !!,"De-journal All or Selected globals? " R X S:X="" X="ALL" S ALL=1 G DEV DEV ; D SELDEV G:QF EXIT VERIFY ; S X="Y" ; W !!,"Do you wish to verify each restored SET or KILL? " R X S:X="" X="NO" G ALL:X="^",EXIT:X="^Q" I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) S VERIFY=0 G OUTPUT S VERIFY=1 OUTPUT ; S X="N" ; W !!,"DO YOU WISH TO PRINT THE DATA BEING RESTORED? " R X S:X="" X="NO" G VERIFY:X="^",EXIT:X="^Q" I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) S %DEV=0 G ^%L3DJRN2 EXIT ; I $D(JDEV) C JDEV I $D(%DEV) C:%DEV&(%DEV'=$P) %DEV C 63 K %DA,%DEV,%DN,%DS,%TN,%TS,ALL,DAT,DTYP,GL,GN,GNKD,I,JDEV,JNAME,JNSAV,JTYPE,L,P,PARM,QF,QUE,QUIT,REF,REPEAT,SDEV,STRING,T,TIM,TYP,U,UCI,VGN,VAL,VERIFY,X,X1,X2,X3,Y Q ERR ; I $F($ZS,"") ZU 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q AREA ; S QF=0 ;W !!,"SELECT JOURNAL AREA: " R X S:"^"[X QF=1 S:X="^Q" QF=2 Q:QF ;I X="^L" D ^JRNLSHOW G AREA ;I X="?" S QUE=1 D ^DEJRNL3 G AREA S X=$O(^["MGR"]SYS("JOURNAL","")) I X="" ZU 0 W *7,!,"HASN'T JOURNAL SPACE !!!" G EXIT I '$D(^["MGR"]SYS("JOURNAL",X)) W !," DOES NOT EXIST, ENTER '^L' FOR A LIST OF AVAILABLE JOURNAL SPACES" S QF=1 Q S JNAME=X,X=^["MGR"]SYS("JOURNAL",JNAME) I $P(X,"^",4)'="FULL",$P(X,"^",2)'="TAPE" W !!,"JOURNAL SPACE ",JNAME," IS ",$P(X,"^",4),",",!,"ONLY A FULL JOURNAL SPACE MAY BE USED FOR DE-JOURNALLING" D ^%L3JRIN,^%L3JRN,^%L3JRST S QF=1 Q S JTYPE=$P(X,"^",2),PARM=$P($P(X,"^"),",",2,3),SDEV=$P(X,"^",3) I 'OS S:JTYPE="HFS" PARM=$P(X,"^",6) I JTYPE="SBP",$P(PARM,",",1) D I 'X W *7,!,"VOLUME GROUP ",$P(PARM,",",1)," IS NOT MOUNTED" S QF=1 Q . N (PARM,X) D GETVG^%VGUTIL . S X=$D(VG($P(PARM,",",1))) Q Q SELDEV ; SELECT JOURNAL DEVICE S QF=0 F I=1:1:$L(SDEV,",") S JDEV=$P(SDEV,",",I) C JDEV D @JTYPE I G SELDEV1 E D NOPEN S QF=1 Q Q SBP ; SBP DEVICE O JDEV:(:-($P(PARM,",",2)):($P(PARM,",",1))::"V"):0 Q HFS ; HOST FILE SERVER DEVICE I OS O JDEV:(PARM::::"V"):0 S X=$T I 'OS O JDEV:(PARM:"RA":::"V"):0 S X=$T I X Q TAPE ; TAPE DEVICE S X=$ZT,$ZT="ZG "_$ZL_":TAPERR" O JDEV:($P(PARM,",",1)_"T"::$P(PARM,",",2)):0 S $ZT=X Q TAPERR ; S $ZT=X G:'$F($ZS,"") @X W !,"DEVICE ",JDEV," IS NOT AVAILABLE" I 0 Q SELDEV1 W !!,"DEVICE ",JDEV," WILL BE USED FOR READING THE JOURNAL" U JDEV S X=$ZA ZU 0 G SELDEV3:JTYPE="TAPE",SELDEV2:JTYPE="HFS" I X<0 W !,"UNABLE TO ACCESS SBP AREA" C JDEV S QF=1 Q SELDEV2 ; I X W !,"UNABLE TO ACCESS FILE ",PARM C JDEV S QF=1 Q SELDEV3 ; I '$ZB(X,1,1) D REW . R !,"REWIND? : ",X S:X="" X="Y" I X["^" S QF=1 Q . I X="?" W !,"THE TAPE IS NOT AT THE BEGINNING OF THE REEL.",!,"ENTER 'Y' TO REWIND THE TAPE BEFORE USING IT." G REW . S X=$ZB(X,"_",1) I $E("NO",1,$L(X))=X Q . I $E("YES",1,$L(X))=X U JDEV W *5 ZU 0 Q . W " ??" G REW Q NOPEN ZU 0 W !!,"ALL ",JTYPE," DEVICES (",SDEV,") ARE BUSY, PLEASE TRY AGAIN LATER" Q %L3DJRN2 %L3DJRN2 ;BFH;MSM DEJOURNAL UTILITY - RESTORE FROM JOURNAL [ 04/24/92 4:31 PM ] S (DAT,TIM)="00000" GO W !!,"DE-JOURNAL FROM AREA ",JNAME," TYPE OF JOURNAL AREA = ",JTYPE,! I JTYPE="HFS" W "FILE NAME = ",PARM E I JTYPE="SBP" W "VOLUME GROUP INDEX = ",$P(PARM,",",1)," STARTING BLOCK NUMBER = ",$P(PARM,",",2) E W "FORMAT = ",$P(PARM,",",1)," BLKSIZE = ",$P(PARM,",",2) S KNJ=$S($ZB($V(0,-4,2),128,1):-32,1:0) S JNSAV=^["MGR"]SYS("JOURNAL"),JNSAV(1)=^["MGR"]SYS("JOURNAL",JNAME) D READ I X'="H" ZU 0 W !!,*7,"BAD JOURNAL, FIRST ENTRY IS NOT A TIME ENTRY" D ^%L3JRIN,^%L3JRN,^%L3JRST G EXIT D CHKTIM G:QF EXIT ZU 0 S %DN=DAT,%TN=TIM W !,"FIRST TIME ENTRY IS " D DATTIM READY S X="Y" ;R !!,"READY TO RESTORE? ",X S:X="" X="Y" G EXIT:X="^Q" I X="^" G DONE:$D(REPEAT),OUTPUT^%L3DJRN I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) G EXIT I '(X=$E("YES",1,$L(X))!(X=$E("yes",1,$L(X)))) W " ??" G READY I %DEV U %DEV W:$Y!$X # W !!,"DE-JOURNAL FROM AREA ",JNAME," " D ^%D,^%T S X=$X W ! F I=1:1:X W "-" S U=$C(0),QF=0 LOOP D READ G:QF DONE S TYP=X I TYP="H" D CHKTIM G ERR:QF>1,DONE:QF,LOOP S DIFF=$S($A(TYP,2):1,1:0) I (DIFF&(TYP'?1U15E))!('DIFF&(TYP'?1U11E)) ZU 0 W *7,!!,"Invalid journal entry type: ",TYP G ERR S X=$A(TYP,9)*256+$A(TYP,10),X1=X\2048,X=X-(X1*2048),X2=X\64,X3=X-(X2*64)/2,UCI=$C(X1+64,X2+64,X3+64) S X=$A(TYP,11)*256+$A(TYP,12),X1=X\2048,X=X-(X1*2048),X2=X\64,X3=X-(X2*64)/2,VGN=$C(X1+64,X2+64,X3+64) S TYP=$E(TYP) D READ G:QF DONE S REF=X I TYP="S" D READ G:QF DONE S DTYP=$A(X) D READ G:QF DONE S VAL=X S GN=$P(REF,U) G:ALL REF CHKGL ; CHECK GLOBAL SELECTION I '$D(GL(UCI_VGN)) G LOOP I $D(GL(UCI_VGN,GN)) G REF I $D(GL(UCI_VGN,"*"))&'$D(GL(UCI_VGN,"-",GN)) G REF G LOOP ;DESELECTED REF ; ASSEMBLE GLOBAL REFERENCE G:$P(REF,U,2)="" VALUE:TYP="S",VERIFY I $D(@("^["""_UCI_""","""_VGN_"""]"_GN)) S GNKD=$V(36+$V(24,$J,2),$J,4,8),STRING=$V(GNKD+24,-3,1)#2 S P=0 F I=2:1 S X=$P(REF,U,I) Q:X="" D DECODE S GN=GN_")" G VERIFY:TYP="K" ; VALUE ; DECODE DATA VALUE I DTYP=2 V 0:0:VAL:8:1 S VAL=$V(0,0,8,4) I DTYP=0 V 0:0:VAL:4:1 S VAL=$V(0,0,4) VERIFY G:'VERIFY XECUTE ZU 0 W ! D PRINT VERIFY1 S X="Y" ;R !!,"OK? ",X S:X="" X="Y" I X="?" S QUE=8 D ^DEJRNL3 G VERIFY I X="^Q" G ERR I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) G LOOP I '(X=$E("YES",1,$L(X))!(X=$E("yes",1,$L(X)))) W " ??" G VERIFY1 XECUTE ; I TYP="K" K @("^["""_UCI_""","""_VGN_"""]"_GN) E S @("^["""_UCI_""","""_VGN_"""]"_GN)=VAL I %DEV U %DEV D PRINT G LOOP ; CHKTIM ; VERIFY TIME RECORD S QF=0 D READ Q:QF D READ Q:QF I X'?5N1","1.5N ZU 0 W !!,"INVALID TIME ENTRY ",X,", RESTORE TERMINATED" S QF=1 Q S T=$P(X,",",2),Y=$P(X,",") I '(Y ",X S:X=""!(X="^Q") X="N" I X="?" S QUE=9 D ^DEJRNL3 G CHKTIM1 I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) S QF=1 Q I '(X=$E("YES",1,$L(X))!(X=$E("yes",1,$L(X)))) W " ??" G CHKTIM1 S DAT=%DN,TIM=%TN Q DECODE ; X contains the global subscript to be decoded I STRING D:X["""" DECODE1 S GN=GN_$S(P:",",1:"(")_""""_X_"""",P=1 Q S T=$A(X)-128,X=$E(X,2,999),L=$L(X) I L=0 S GN=GN_$S(P:",",1:"(")_"0",P=1 Q I T=127 D:X["""" DECODE1 S GN=GN_$S(P:",",1:"(")_""""_X_"""",P=1 Q S:T>0 T=T+KNJ I T'<0 S GN=GN_$S(P:",",1:"(")_$E(X,1,T)_$S(TT S GN=GN_"." F Y=T+1:1:L-1 S GN=GN_(9-$E(X,Y)) S P=1 Q DECODE1 ;SPECIAL CASE WHEN GLOBAL REFERENCE CONTAINS '"'s S T="",L=1 DECODE2 S Y=$F(X,"""",L) I Y'=0 S T=T_$E(X,L,Y-1)_"""",L=Y G DECODE2 S T=T_$E(X,L,$L(X)) S X=T Q READ S QF=0 U JDEV R X I $ZC S QF=1 Q PRINT W !,TYP," ^[""",UCI,""",""",VGN,"""]",GN I TYP="S" W "=""",VAL,"""" Q DATTIM D ^%DO,^%TO W %DS," ",%TS Q ; DONE S REPEAT=1 S ^["MGR"]SYS("JOURNAL",JNAME)=JNSAV(1),^["MGR"]SYS("JOURNAL")=JNSAV I %DEV U %DEV W !!,"END OF JOURNAL",!,"LAST TIME ENTRY IS " S %DN=DAT,%TN=TIM D DATTIM W ! ZU 0 W !!,"DE-JOURNALLING COMPLETED FOR JOURNAL AREA ",JNAME D ^%L3JRIN D ^%L3JRN D ^%L3JRST DONE1 S X="N" ;ZU 0 R !!,"DO YOU WISH TO CONTINUE DE-JOURNALLING FROM ANOTHER AREA? ",X I X=$E("NO",1,$L(X))!($E("no",1,$L(X))=X) G EXIT I '(X=$E("YES",1,$L(X))!(X=$E("yes",1,$L(X)))) W " ??" G DONE1 D AREA^%L3DJRN G EXIT:QF>1,DONE1:QF D SELDEV^%L3DJRN G EXIT:QF,GO ; EXIT ZU 0 W !!,"DE-JOURNALLING FINISHED" K KNJ G EXIT^%L3DJRN ERR U JDEV S X=$ZA,Y=$ZB,T=$ZC I %DEV U %DEV D ERR1 ZU 0 D ERR1 W *7,*7 G EXIT ERR1 W !!,"RESTORE TERMINATED BEFORE END OF FILE" W !,"$ZA=",X,!,"$ZB=",Y,!,"$ZC=",T Q %L3GI %L3GI ; [ 17.01.26 21:18 ] [ N (JB,%ARG) S %ZD=$ZCMD D ^%L1GI Q %L3GR %L3GR ;CDS;GLOBAL RESTORE [ 21.04.26 13:54 ] [ 06/30/92 1:20 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1982 S $ZT="ZG "_$ZL_":ERR^%L3GR" W !?10,$P($P($ZV,","),"-")," - Global Restore Utility" SDEV ; D .I $L($G(%L3GR("FN"))) S %FN=%L3GR("FN") Q .S %FN=^%L3GR("FN") ; D GETHFS^%SDEV I '%DEV U 0 W !!,"ALL HOST FILE SERVER (HFS) DEVICES ARE BUSY" Q O %DEV:%FN U %DEV G:$ZA OPENHFS OPENHFS O %DEV:(%FN:"R") U %DEV S %ZA=$ZA U 0 I %ZA<0 W !,?5,"OPEN FAILED ON DEVICE ",%DEV," FOR FILE ",%FN,*7 C %DEV U 0 Q S %TAP=%DEV>46&(%DEV<51) D:%TAP %SET^%MTCHK ;I %TAP U %DEV I @(%MTON_"=0") U 0 W !,"Tape is not ready" C %DEV G SDEV U %DEV R %TIME,%CMT I %TIME="" G BADSAVE U 0 S %S=0,%SEQ=1,%LG="",%POS=0 W !!,"GLOBAL(S) SAVED AT ",%TIME,".",!,"HEADER COMMENT IS : ",%CMT,! S %SEL=0,%ANS="Y" G START START U 0 W !!,"RESTORING..." NXTGBL K %GSEL S %POS=1 NG1 U %DEV R %GN,%GV I %GN="*E" D NEXTFILE G NG1:'QUIT,DONE2 G DONE:$E(%GN,1,2)="**",BADSAVE:%GN="",NXTGBL:%GN="*" I $E(%GN)="*" S %GSEL=$E(%GN,2,999) G NG1 S %GNN=$P(%GN,"("),%GNL=$L(%GNN)+1 S:'$D(%GSEL) %GSEL=%GNN S %POS=2 ASK U 0 W !,"GLOBAL: ",%GSEL W:$X>17 " " W ?18 G SET READ U %DEV R %GN,%GV G:%GN="" BADSAVE I %GN="*E" D NEXTFILE G READ:'QUIT,DONE2 I %GN="*" U 0 W:%SEL&(%ANS="N") " ... Not Restored" W:'(%SEL&(%ANS="N")) " ... Restored" G NXTGBL SET S %LG=%GN G READ:%ANS="N",NXTGBL:%GN="*",DONE:$E(%GN,1,2)="**" S @(%GNN_$E(%GN,%GNL,255))=%GV G READ DONE I %TAP U %DEV I @(%MTTMK_"=0") W *12 DONE2 U 0 W !,"RESTORE COMPLETE" EXIT U 0 I $D(%TAP) D:%TAP %KILL^%MTCHK C:$D(%DEV) %DEV K %GN,%GNL,%GNN,%GV,%DEV,%SBP,%SEL,%ANS,%TIME,%CMT,%GSEL,%RC,%S,%I,%FN,%SEQ,%SIZE,%X,%ZA,QUIT,%TAP,%POS,%LG Q BADSAVE U 0 W !,*7,"INVALID BACKUP FORMAT...UNABLE TO RESTORE." G EXIT ERR ; I $F($ZS,"") U 0 G ERRTAP I $F($ZS,"") U 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q NEXTFILE ; U 0 W !,"SEQUENCE #",%SEQ," RESTORED",! U %DEV R %X U 0 I $E(%X,1,2)="**" S QUIT=1 Q W !,"PLEASE PUT SEQUENCE #",%SEQ+1," INTO THE DRIVE AND" S %SEQ=%SEQ+1 NEXTFIL1 R !,"PRESS WHEN READY",%X I %X?1"?".E W !!,"PRESS TO CONTINUE RESTORING FROM SEQUENCE #",%SEQ,!,"OR ABORT THE RESTORE BY ENTERING 'CONTROL C'" G NEXTFIL1 C %DEV O %DEV:%FN U %DEV I '$ZA R %X I '$ZC U 0 E W !!,"CANNOT ACCESS ",%FN,", PLEASE CORRECT" G NEXTFIL1 I %X?2NP1":"2N1" ".E S %X=1 I %X'=%SEQ W !!,"OUT OF SEQUENCE, THIS FILE IS #",%X,", PLEASE CORRECT" G NEXTFIL1 S QUIT=0 Q %L3GS %L3GS(FL,GLOB,PR) ; [ 03.08.05 10:41 ] [ 10.04.05 1:41 PM ] [ 14.03.04 1:08 PM ] ; PR="A" OR "W" ; ; --- REST : D REST^%L2GS ; ;------------------------------------------ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,FL,GLOB,PR) D ^%L1C S $ZT="G ER" K ^UTILITY($J) O (FL:WRITE) I $E(GLOB,1,3)'="%GS" D SV(GLOB) G END BG1 ; S %GTEMP="^UTILITY($J)" K @%GTEMP S %L1GS("NOMSG")="" S N="",%GSEL=0 F S N=$O(^SHP(GLOB,N)) Q:N="" D .S %GN=$G(^(N)) Q:%GN="" D S21^%L1GS S N="" F S N=$O(^UTILITY($J,N)) Q:N="" U USTR D SV(N) END C USTR Q ; SV(N) ; I $D(@("^"_N))#2 W "^"_N,!,$G(@("^"_N)),! S N1="^"_N_"("""")" F S N1=$ZO(@N1) Q:N1="" W N1,!,$G(@N1),! Q ER U 0 W !!,"$ZE=",$ZE Q ; %L3GSEL %L3GSEL ; [ 06/28/94 6:18 PM ] K ^UTILITY($J) S %P=$$%SRCHPAT^%SRCHPAT(%RS) S %RN=0,X=FIRST D:FIRST'="" .Q:$D(@("^"_X))=0 Q:X]LAST X %P S:$T %RN=%RN+1,^UTILITY($J,FIRST)="" F S X=$O(@("^"_X)) Q:X=""!(X]LAST) X %P S:$T %RN=%RN+1,^UTILITY($J,X)="" %L3GTR %L3GTR ; SEND GLOBALS [ 10.08.06 09:48 ] [ 27.02.06 10:55 ] [ 27.01.06 14:25 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,USERPHONE,USERPORT,USERGLOB,USERMOD,ER,%L1RCV,%L3GTR,%L2NALAN) S $ZS="" D ^%L1C K %L1RCV S %L3GTR="" D ^%L2GTR Q SCALE0(LN) ; U $P:(NOECHO:NOWRAP) S %L1RBCL=%CV("CF") D INCRD W %LIGHT1 D TV^%L1RBUA(%VG,%LG,%NG+2,%RG+1) X %XCL S %YY=%VG+1,%XX=%LG X %POSIC I %TYPCRT="PC" W %LIGHT1 I %TYPCRT["VT" W *27,"(0" W $TR($J("",LN)," ",$S(%TYPCRT["VT":$C(225),1:$C(176))) X %XCL I %TYPCRT["VT" W *27,"(B" Q SCALE(N,MAX,LN) ; U $P:(NOECHO:NOWRAP) D INCRD S %YY=%VG+1,%XX=%LG X %POSIC I %TYPCRT["VT" W *27,"(0" I MAX W %LIGHT1,%CV("YF"),$TR($J("",N/MAX*LN)," ",$S(%TYPCRT["VT":$C(225),1:$C(177))) X %XCL I %TYPCRT["VT" W *27,"(B" Q INCRD ; S:'$D(%VG) %VG=20 S:'$D(%NG) %NG=22 S:'$D(%LG) %LG=5 S:'$D(%RG) %RG=75 Q %L3GTR0 %L3GTR ; SEND GLOBALS [ 10.08.06 09:48 ] [ 27.02.06 10:55 ] [ 27.01.06 14:25 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,USERPHONE,USERPORT,USERGLOB,USERMOD,ER,%L1RCV,%L3GTR,%L2NALAN) S $ZS="" D ^%L1C K %L1RCV S %L3GTR="" D ^%L2GTR Q SCALE0(LN) ; U $P:(NOECHO:NOWRAP) S %L1RBCL=%CV("CF") D INCRD W %LIGHT1 D TV^%L1RBUA(%VG,%LG,%NG+2,%RG+1) X %XCL S %YY=%VG+1,%XX=%LG X %POSIC I %TYPCRT="PC" W %LIGHT1 I %TYPCRT["VT" W *27,"(0" W $TR($J("",LN)," ",$S(%TYPCRT["VT":$C(225),1:$C(176))) X %XCL I %TYPCRT["VT" W *27,"(B" Q SCALE(N,MAX,LN) ; U $P:(NOECHO:NOWRAP) D INCRD S %YY=%VG+1,%XX=%LG X %POSIC I %TYPCRT["VT" W *27,"(0" I MAX W %LIGHT1,%CV("YF"),$TR($J("",N/MAX*LN)," ",$S(%TYPCRT["VT":$C(225),1:$C(177))) X %XCL I %TYPCRT["VT" W *27,"(B" Q INCRD ; S:'$D(%VG) %VG=20 S:'$D(%NG) %NG=22 S:'$D(%LG) %LG=5 S:'$D(%RG) %RG=75 Q %L3JRIN %L3JRIN ;DJM;INITIALIZE JOURNAL SPACE; [ 04/24/92 4:13 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 ;W !?10,$P($P($ZV,","),"-")," - Journal Space Initialization Utility" W !?21 D ^%T W " " D ^%D PROMPT ; S JNAME=$O(^["MGR"]SYS("JOURNAL","")) I JNAME="" W !,*7,"HASN'T JOURNAL SPACE" G EXIT ;R !!,"Journal space name to be reset: ",JNAME G:JNAME=""!(JNAME="^") EXIT ;I JNAME="?" W !,"Select journal space by name, or '^L' for available list" G PROMPT ;I JNAME="^L"!(JNAME="^l") S INT=1 D SHOW^JRNLSHOW G PROMPT I $D(^["MGR"]SYS("JOURNAL",JNAME))#2=0 W !,*7,"NO SUCH NAME DEFINED.. " G EXIT I $P(^(JNAME),"^",4)="ACTIVE" W !,*7,"CANNOT RESET AN ACTIVE JOURNAL SPACE" G EXIT S J=^(JNAME) G HFS:$P(J,"^",2)="HFS",SBP:$P(J,"^",2)="SBP",TAPE:$P(J,"^",2)="TAPE" W !,*7,"UNKNOWN JOURNAL SPACE TYPE: '",$P(J,"^",2),"'... PLEASE SELECET ANOTHER" G EXIT HFS ; host file server file D VERIFY G:QUIT PROMPT S $P(J,"^",4)="EMPTY",$P(J,"^",5)=0,$P(J,",")="*",HFS=$P($P(J,"^",1),",",2) I OS F DEV=51:1:54 O DEV:HFS:5 I $T U DEV S A=$ZA ZU 0 C:A<0 DEV Q:A<0 O DEV:(HFS:"W") C DEV Q S ^["MGR"]SYS("JOURNAL",JNAME)=J W !,"HFS JOURNAL SPACE '",JNAME,"' NOW RESET" G EXIT TAPE ; tape file D VERIFY G:QUIT PROMPT S $P(J,"^",4)="EMPTY",$P(J,"^",5)=0 S ^["MGR"]SYS("JOURNAL",JNAME)=J W !,"TAPE JOURNAL SPACE '",JNAME,"' NOW RESET" G EXIT SBP ; sequential block processor file D VERIFY G:QUIT PROMPT O 63::5 E W !!,*7,"*** VIEW BUFFER IN USE.. RETRY LATER ***",! G EXIT I $P(J,",",2) D I 'BN W *7,!,"VOLUME GROUP ",$P(J,",",2)," IS NOT MOUNTED" G EXIT . N (J,BN) D GETVG^%VGUTIL . S BN=$D(VG($P(J,",",2))) Q S BN=$P(J,",",3),VGI="G"_$P(J,",",2) LOOP ; G NEW W !!,"RESETTING" S $P(X,$C(0),1012)=$C(0) ;create 1012 bytes of zeros S I=0 F BN=BN:0 V BN:VGI Q:$V(1020,0,1)'=9 V 0:0:X:1012:1,1022:0:0:2,-BN:VGI S BN=$V(1012,0,4) Q:BN=0 S I=I+1 I I=10 S I=0 W "." BADBLK I BN W !,*7,"*** INVALID JOURNAL BLOCK ENCOUNTERED.. JOURNAL SPACE UNUSABLE" S $P(J,"^",4)="ERROR",^["MGR"]SYS("JOURNAL",JNAME)=J G EXIT OK S $P(J,"^",4)="EMPTY",$P(J,"^",5)=0,^["MGR"]SYS("JOURNAL",JNAME)=J W !,"SBP JOURNAL SPACE '",JNAME,"' NOW RESET" G EXIT NEW ; quick reset S $P(X,$C(0),1010)=$C(0) ;create 1010 bytes of zeros V BN:VGI G:$V(1020,0,1)'=9 BADBLK V 0:0:X:1010:1,1010:0:$V(1010,0,2)+1:2,1022:0:0:2 V -BN:VGI G OK EXIT ; K BN,DEV,HFS,I,J,JNAME,N,QUIT,X,VGI Q VERIFY ; S QUIT=0 S N="Y" ;W !,"ARE YOU SURE : " R N I N="" S N="NO" W N I N="^" S QUIT=1 Q I N="?" W !,"RESPOND YES OR NO. IF YOU DELETE THE JOURNAL AREA, ALL INFORMATION IN THE",!," JOURNAL AREA WILL BE LOST" G VERIFY I N=$E("NO",1,$L(N)) W ".. not reset" S QUIT=1 Q I N=$E("no",1,$L(N)) W ".. not reset" S QUIT=1 Q Q:N=$E("YES",1,$L(N))!(N=$E("yes",1,$L(N))) W *7," ..PLEASE RESPOND YES OR NO" G VERIFY %L3JRN %L3JRN ;MJ;GLOBAL CHARACTERISTICS--DRIVER [ 04/21/92 2:43 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1990 S $ZT="ZG "_$ZL_":ERROR^%L3JRN" N %OPT O 63::0 I '$T W !!,"VIEW BUFFER BUSY.. PLEASE RETRY LATER" G EXIT D GETVG^%VGUTIL S %MGR=($ZU($P($$^%L1ZU(0),","),$P($$^%L1ZU(0),",",2))="1,0") ;W !?10,$P($P($ZV,","),"-")," - Global Characteristics Utility" %GLOBAL S %UCI="",%VGN=$P($$^%L1ZU(0),",",2) I $D(^JRNL)>9 S N="" F S N=$O(^JRNL(N)) Q:N="" S %GLB=N D JRN G EXIT JRN S %QF=0,%EF=0 S:%GLB?1"^".E %GLB=$E(%GLB,2,99) I %GLB["[" S %UCI=$P(%GLB,"]"),%GLB=$P(%GLB,"]",2) %CHECK I %UCI["""" F %I=1:1:$L(%UCI) I $E(%UCI,%I)="""" S $E(%UCI,%I)="",%I=%I-1 I %UCI'="",%UCI'?1"["3U1","3U,%UCI'?1"["3U W *7," INVALID CROSS UCI NOTATION " Q I %UCI'="" S:$L(%UCI)<5 %UCI=%UCI_","_%VGN ;S %GLB="["""_$P(%UCI,"[",2)_"""]"_$P(%GLB,"]",2) I %UCI'="" S %VGN=$P(%UCI,",",2) S %UCI=$E(%UCI,2,4) S %UI=$ZU(%UCI,%VGN) I %UI<1 W *7," NONEXISTENT UCI NAME" Q I (%UCI'="")&('%MGR) W !,*7,"CROSS UCI IS NOTATION NOT AVAILABLE FROM NON MANAGER UCI" Q S %UI=$S(%UCI'="":+%UI,1:$V(2,$J,2)#32),(%VGI,VGI)=VG(%VGN),%VGSLOT="G"_%VGI D GETVOL^%VGUTIL I '(%GLB?1"%".AN!(%GLB?1A.AN)) U 0 W " INVALID GLOBAL NAME -- ",%GLB,*7 Q I $L(%GLB)>8 W " GLOBAL NAME MUST BE 8 CHARACTERS OR LESS ",*7 Q S %PTRS=$V($V(44)+8,-3,2),%USZ=$V($V(44)+14,-3,2),%VGPTR=$V(40+%PTRS+$V(44)),%VGPTR1=$V(%VGI*4+%VGPTR),%UT=%UI-1*32+$V(%VGPTR1+20) UCINUM ; S %GBN=$V(%UT+4,-3,4),GN=%GLB,%GLB=%GLB_$C(0) %GDBLK V %GBN:%VGSLOT S OF=$V(1022,0),TYP=1,TFL=$E($V(1021,0,1,3)) S K="" K KEY S I=$S(TYP=1&TFL&($V(0,0,4)=0):13,1:0) F I=I:0:OF-1 S CC=$V(I,0,1),UC=$V(I+1,0,1),K=$E(K,1,CC)_$V(I+2,0,UC,1),KEY(I)=K,I=I+UC+2+$S(TYP=8:$V(I,0,1)+1,TYP=1&TFL:11,1:3) S %F=0,%X=-1 %GDENT S %X=$N(KEY(%X)) I %X'<0 G:$S(TFL:%GLB]KEY(%X),1:KEY(%X)]%GLB) %GDENT S:%GLB=KEY(%X) %F=1 I 'TFL,'%F S %GBN=$V(%X+2+$V(%X+1,0,1),0,3) G %GDBLK I TFL,'%F S %GBN=$ZB($V(1012,0,4),#FFFFFF,1) G:%GBN>0 %GDBLK I '%F&%EF W !!,"GLOBAL NOT FOUND IN DIRECTORY!!, CALL SYSTEM MANAGER" G EXIT ;I '%F W " does not exist.. ",*7 %GDENT1 S %HLP=2 I '%F S @("^"_$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]")_GN_"(1)")=1 K ^(1) ZF S %EF=1 W !,"GLOBAL ^"_GN_" CREATED" S %GLB=GN G UCINUM S %OF=%X+2+$V(%X+1,0,1)+4 S %USTS=(($V(%OF,0,1)#4)=3) G %OPT ERROR ; I $F($ZS,"") U 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q EXIT ; I $D(^ZZZZZZZZ)!($D(^UTILITY)) ; FLUSHES LOCAL COPY OF CHANGED GLOBAL C 63 K %,%ANS,%BLK,%DIV,%DN,%DR,%DT,%EF,%GBN,%GLB,%HLP,%I,%MF,%NB,%OPT,%PC,%PT,%QF,%QST,%QUE,%RSP,%RSPHLD,%T,%X,CLASS,GN,PRO,PROTECT,KEY,%OF,XEM,%F,%MAX,%UI,%USZ,%UT,CC,I,K,OF,TFL,TYP,UC,XE K %B,%DB,%GNUM,%GSN,%MGR,%NAM,%PR,%ST,%UCI,%USTS,COL,NEW,SEQ,%GVN,VG Q %OPT S %QUE=1,%HLP=3 ;D %SEL G EXIT:%QF=2,%GLOBAL:%QF %JRN S %ST=$E($V(%OF-1,0,1,3)) ;W !!,"Global is currently",$S(%ST:"",1:" not")," set for journaling" Q:%ST %J1 ; S %ST=0 V %OF-1:0:$V(%OF-1,0,1)+$S(%ST:-128,1:128):1 V -%GBN:%VGSLOT Q EXIT ; I $D(^ZZZZZZZZ)!($D(^UTILITY)) ; FLUSHES LOCAL COPY OF CHANGED GLOBAL C 63 K %,%ANS,%BLK,%DIV,%DN,%DR,%DT,%EF,%GBN,%GLB,%HLP,%I,%MF,%NB,%OPT,%PC,%PT,%QF,%QST,%QUE,%RSP,%RSPHLD,%T,%X,CLASS,GN,PRO,PROTECT,KEY,%OF,XEM,%F,%MAX,%UI,%USZ,%UT,CC,I,K,OF,TFL,TYP,UC,XE K %B,%DB,%GNUM,%GSN,%MGR,%NAM,%PR,%ST,%UCI,%USTS,COL,NEW,SEQ,%GVN,VG Q %L3JRST %L3JRST ;DJM;START (ACTIVATE) JOURNAL; [ 04/24/92 4:33 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 ;W !?10,$P($P($ZV,","),"-")," - Journal Startup Utility" W !?14 D ^%T W " " D ^%D L JOURNAL:1 I '$T W !,*7,"JOURNAL STATUS CHANGE ALREADY IN PROGRESS" G EXIT S JTAB=$V(13,-5) I $V(2,-4,2)\2#2 W !!,"JOURNAL ALREADY ACTIVE" G EXIT PROMPT ; S JNAME=$O(^["MGR"]SYS("JOURNAL","")) I JNAME="" W !,*7,"HASN'T JOURNAL SPACE" G EXIT I $D(^["MGR"]SYS("JOURNAL",JNAME))#2=0 W !,*7,"NO SUCH NAME DEFINED.. ENTER '^L' FOR AVAILABLE LIST" G PROMPT I $P(^(JNAME),"^",4)'="EMPTY" W !,*7,"JOURNAL SPACE MUST BE MARKED 'EMPTY' IN ORDER TO BE USED" G PROMPT AUTO S J=^["MGR"]SYS("JOURNAL",JNAME) G HFS:$P(J,"^",2)="HFS",SBP:$P(J,"^",2)="SBP",TAPE:$P(J,"^",2)="TAPE" W !,*7,"UNKNOWN JOURNAL SPACE TYPE: '",$P(J,"^",2),"'... PLEASE SELECET ANOTHER" G PROMPT HFS ; host file server file S JDEV=$P(J,"^",3),HFS=$P($P(J,"^"),",",2) I OS F I=1:1:$L(JDEV,",") S DEV=+$P(JDEV,",",I) O DEV:(HFS:"W":::"V"):10 I $T U DEV S ZA=$ZA ZU 0 G GOTHFS I 'OS F I=1:1:$L(JDEV,",") S DEV=+$P(JDEV,",",I) O DEV:(HFS:"WA":::"V"::::1024):10 I $T U DEV S ZA=$ZA ZU 0 G GOTHFS W !,*7,"ALL SPECIFIED DEVICE(S): ",JDEV," ARE IN USE.. CANNOT START JOURNAL" G PROMPT GOTHFS ; I ZA C DEV W !,*7,"UNABLE TO ACCESS FILE '",HFS,"' THROUGH DEVICE #",DEV G PROMPT G STARTUP TAPE ; tape file S $ZT="ZG "_$ZL_":TAPERR^JRNSTART" S JDEV=$P(J,"^",3),MODE=$P(J,",",2),BLKSIZE=+$P(J,",",3) F I=1:1:$L(JDEV,",") S DEV=+$P(JDEV,",",I) O DEV:(MODE::BLKSIZE):10 I $T U DEV S ZA=$ZA ZU 0 G GOTTAPE S $ZT="ZG "_$ZL_":" W !,*7,"ALL SPECIFIED DEVICE(S): ",JDEV," ARE IN USE.. CANNOT START JOURNAL" G PROMPT GOTTAPE ; S $ZT="ZG "_$ZL_":" U DEV D %ERRCHK^%MTCHK I %MTERR C DEV G PROMPT ZU 0 G STARTUP TAPERR Q:'$F($ZS,"") W !,"Device ",DEV," is not available" G PROMPT SBP ; sequential block processor file S JDEV=$P(J,"^",3),SBPDB=$P(J,",",2),SBP=+$P(J,",",3) F I=1:1:$L(JDEV,",") S DEV=+$P(JDEV,",",I) O DEV:(0:-SBP:SBPDB::"VW"):10 I $T U DEV S ZA=$ZA ZU 0 G GOTSBP W !,*7,"All specified device(s): ",JDEV," are in use.. cannot start Journal" G PROMPT GOTSBP ; I ZA<0 C DEV W !,*7,"Unable to SBP journal space through device #",DEV G PROMPT STARTUP ; start up the journal space S DTAB=$V(5,-5) V DEV+DEV+DTAB::255:2 V JTAB::0:2 ;clear flags V JTAB+2::DEV:2 ;set journaling device number V JTAB+4::0:4,JTAB+8::0:4,JTAB+12::0:4 ;clear counts V 2:-4:$ZB($V(2,-4,2),2,7):2 ;activate journal V 4:-4:$ZB($V(4,-4,2),4,2):2 ; turn off suspend S $P(J,"^",4)="ACTIVE",$P(J,"^",5)=0 S ^["MGR"]SYS("JOURNAL")=JNAME,^["MGR"]SYS("JOURNAL",JNAME)=J W !!,"Journaling now activated" EXIT ; L K DEV,DTAB,I,J,JDEV,JNAME,UCH,DCH,L,JTAB,SBP,SBPDB,ZA Q STU ;ENTRY POINT FOR AUTOSTART OF JOURNAL AT STARTUP S JTAB=$V(13,-5) S UCH=$P(^["MGR"]SYS(CONFIG,"AUTO","JRNL"),"^",2) F L=1:1 S DCH=$P(UCH,",",L) Q:DCH="" I $D(^["MGR"]SYS("JOURNAL",DCH)) I $P(^["MGR"]SYS("JOURNAL",DCH),"^",4)="EMPTY" S JNAME=DCH D AUTO Q %L3LOG %LOGON ;MJ;LOGON ROUTINE; [ 03/30/92 4:10 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. 1990 K % SYSTEM ; O 0::0 E H U 0 U $P:(NOCENABLE) I $ZB($ZA,8,1) H 1 ; modem control timing S SV=$V(44),MU=$ZB($V(SV,-3,2),16,1),%PS=$S(MU:20480,1:51200) L ZD D EXPDATE S %INT=1,%RETRY=3,%PB=$V(SV+8,-3,2) S %UT=$V(SV+%PB+4) K BASELINE I $V(SV+2,-3,2)#2=0 D ^STU S SV=$V(44),MU=$ZB($V(SV,-3,2),16,1),%PS=$S(MU:20480,1:51200),%UI=1 S:$D(BASELINE) %VGI=0 G PGMR:$D(BASELINE),SYSTEM ;AUTO STARTUP V 0:$J:$ZB($V(0,$J,2),250,1):2 LOGON ; S LOGON=$V(SV+4,-3,2)\64#2,CONSOLE=$V(SV+4,-3,2)\2048#2,SSD=$V(SV+4,-3,2)\32768#2 I LOGON!CONSOLE!SSD,$P'=1 W !,"Signon not allowed now." H V 2:$J:1:2 ;SWITCH TO MGR's uci S CNFG=0 I $D(^["MGR"]SYS("CONFIG"))#2 S CNFG=$P(^["MGR"]SYS("CONFIG"),";",2) I CNFG="" S CNFG=0 S CNFG=+^["MGR"]SYS("CONFIG",CNFG) U $P:(:::::1) I $D(^["MGR"]SYS(CNFG,"DDB",$P))#2 U $P:(:::::#FDFF) U $P:($P(^($P),",",5)::::$ZH($P(^($P),",",6))) I $ZB($ZA,258,1) HALT ; check for nolog and output only bits S:$D(^["MGR"]SYS(CNFG,"PSIZE")) %PS=^["MGR"]SYS(CNFG,"PSIZE") I %PS=20480 S:$ZV["MSM-PC"!($ZV["MUMPS L-PC")&'MU %PS=51200 G:'MU TTT S LATBASE=$V($V(388,-4)+8) I LATBASE S DI=$V($P*4+$V(7,-5)) I $ZB($V(DI+20,-3,4),#10000000,1) S DI=$V(DI+72),SRVSTR=$V(DI+101,-3,$V(DI+100,-3,1),1) D I VCNO&($P(SRVSTR,"`",4)'="") G TIEDLAT Q:'VCNO .S VCNO=0 F I=0:1:7 I $ZU(1,I)'="" D Q:VCNO ..I '$D(^[$ZU(1,I)]SYS("LAT_SERV",1)),I=0 Q ..S SLNO="" F S SLNO=$O(^(SLNO)) Q:SLNO="" I $P(^(SLNO),"`")=SRVSTR S SRVSTR=^(SLNO),VCNO=1 Q TTT S TTT=0 I $D(^["MGR"]SYS(CNFG,"DDB",$P))#2 S TTT=+$P(^($P),",",4) I $D(^["MGR"]SYS(CNFG,"TTT",TTT))#2 G TIEDTERM S %PB=$V(SV+8,-3,2) G:$D(^["MGR"]SYS("PASSWD"))#2=0 PROMPT I $D(%ID) G PR0 ;******* LEV U $P:(NOECHO:NOWRAP) W !,":" R %ID:180 U $P:(ECHO:WRAP) G ABORT:'$T,ABORT:%ID'=^["MGR"]SYS("PASSWD") K %ID PROMPT ; I $D(%ID) G PR0 ;******* LEV D:$D(%) LOGPARMS(%) I $D(%ID) G:$G(TIED) TIEDTERM ; check for signon parms S:'$D(%INT) %INT=1 I %INT W !,$ZV," Line #",$P R " UCI: ",%ID:180 G:'$T ABORT PR0 S %UCI=$P(%ID,":",1) I $L(%UCI)<1 G:$ZB($ZA,8,1) RETRY Q I %UCI[$C(0) W " ...Invalid" G RETRY S %VGNA=$P(%UCI,",",2),%UCI=$P(%UCI,",",1) S:%VGNA="" %VGNA=$P($$^%L1ZU(0),",",2) I %UCI="" W " ...Invalid" G RETRY I $D(^["MGR"]SYS("LOGON",%UCI)) I $P(%ID,":",2)'=$P(^["MGR"]SYS("LOGON",%UCI),":",4) S %OUI=$V(2,$J,2) G:$ZU(%UCI,%VGNA)'="" PROMPT1 W " ...Invalid" G RETRY I $D(^["MGR"]SYS("LOGON",%UCI)) S %ID=$P(^["MGR"]SYS("LOGON",%UCI),":",1,3),%VGNA=$E(%ID,5,7),%UCI=$P(%ID,",") PROMPT1 I $P(%ID,":",3)'="" S %PS=$P(%ID,":",3)*1024 S:%PS<12288!(%PS>262144) %PS=$S($D(^["MGR"]SYS(CNFG,"PSIZE")):^("PSIZE"),1:20480) S %ID=$P(%ID,":",2) UCINUM S %OUI=$V(2,$J,2),%UI=+$ZU(%UCI,%VGNA),%VGI=+$P($ZU(%UCI,%VGNA),",",2) I %UI=0 W " ...UCI not found" G RETRY PGMTST ; S %VGTB=$V($V(40+%PB+SV)+(%VGI*4)) S %UCITB=%UI-1*32+$V(%VGTB+20) I $V(%UCITB+24,-3,3,1)'=$C(0,0,0) G:%ID=$V(%UCITB+24,-3,3,1) PGMR G:'$D(^["MGR"]SYS(CNFG,"PAC")) NOPAC I $V(%UCITB+24,-3,3,1)=$C(0,0,0) G:%ID=^["MGR"]SYS(CNFG,"PAC") PGMR I %ID="" W *7," ... invalid 'null' application id" G RETRY NOPAC ; I $D(^%) ;CLEAR NAKED I $D(^%E) ;CLEAR NAKED V 2:$J:%VGI*32+%UI:2,108:$J:%PS:4 ;SWITCH TO NEW UCI G:%ID="" PGMR I %ID'?1.AN,%ID'?1"%".AN,%ID'?1"^".AN,%ID'?1"^%".AN W *7," ..invalid application id" G RETRY S:'$F(%ID,"^") %ID="^"_%ID I $D(^ ($P(%ID,"^",2)))=0 W *7," ..invalid application id" G RETRY K (%,%ID) G @%ID PGMR ; I $D(^%) ;CLEAR NAKED V 0:$J:$V(0,$J,2)\2*2+1:2,2:$J:%VGI*32+%UI:2,108:$J:%PS:4 W:%INT " Job #",$J K X "ZR Q" Q TIEDTERM ;TIED TERMINAL I $G(TIED) ; from logon parms E S TIED="",%UCI=$P(^(TTT),",",2),%ID=$P(^(TTT),",",1),%PS=$P(^(TTT),",",3) S %UI=$ZU($P(%UCI,":"),$P(%UCI,":",2)) G TIEDGO TIEDLAT ;TIED TERMINAL FOR LAT S TIED="",SRVSTR=$P(SRVSTR,"`",4),%UCI=$P(SRVSTR,":",1),%ID=$P(SRVSTR,":",2),%PS=$S($P(SRVSTR,":",3)="":%PS,1:$P(SRVSTR,":",3)*1024) S %UCI=%UCI_","_$P($ZU(1,I),",",2),%UI=$ZU($P(%UCI,","),$P(%UCI,",",2)) TIEDGO ; V 108:$J:%PS:4 S %VGI=$P(%UI,",",2),%UI=+%UI I %UI=1,%ID="%LOGON" K TIED G PROMPT G NOPAC:%UI>0 W " ..UCI not found" G RETRY INT ; S %INT=0,%UCI=%ID,%RETRY=0 G LOGON RETRY ; I $D(TIED) W !," ..logon aborted" H 2 Q V 2:$J:1:2 ;SWITCH TO MGR's uci S %RETRY=%RETRY-1 G:%RETRY PROMPT W !!,"Logon aborted.." H 2 I $D(%OUI) V 2:$J:%OUI:2 ;SWITCH back to original UCI ABORT Q %MGR ;Entry to put user back into MGR and goto error subrtn (VALIDATE) V 2:$J:1:2 I $D(%ZT) G:%ZT'="" @%ZT Q LOGPARMS(X) ; parse MSM logon parms ; TIED=1 -> UCI:PAC or UCI:RTN ; TIED=0 -> LABEL^RTN S X=$P(X," ",2,99) FOR Q:'($E(X)="-"!($E(X)="/")) DO ; strip out unwanted parms . S %ID=$P(X," ") . I $E(%ID)="/" S X=$P(X," ",2,99) Q ; /autoconfig . I %ID="-E"!(%ID="-e") S X=$P(X," ",2,99) Q ; EMS flag . I %ID="-P"!(%ID="-p"),$E(%ID,4)'?1N S X=$P(X," ",2,99) Q ; pause . S X=$P(X," ",3,99) Q ; all other parms are two part S X=$P(X," ") ; ignore extra '-' parms I X="" K %ID Q ; no signon specified I X?3U1":"1.ANP!(X?3U1","3U1":"1.ANP) S %ID=X,TIED=0,%INT=0 Q S %ID=$P(X,"["),%UCI=$P(X,"[",2) I %UCI="" S %UCI=$ZU(1,0) ; default to MGR E S %PS=$P(%UCI,":",2),%UCI=$P(%UCI,":") I $G(%PS)="" S %PS=^["MGR"]SYS(CNFG,"PSIZE") ; partsize not entered E S:%PS<1024 %PS=%PS*1024 S %UCI=$TR(%UCI,"""]","") ; strip out " and ] I %UCI?3U S %UCI=%UCI_":"_$P($$^%L1ZU(0),",",2) E S $E(%UCI,4)=":" ; for TIEDTERM subroutine S TIED=1,%INT=0 Q EXPDATE ; G:$V(176,-4,4)>94599 EXPIRED Q:$H<($V(176,-4,4)-10) S N=$P($P($ZV,","),"-") I $H+1<$V(176,-4,4) W !!,*7,"WARNING: ***THIS COPY OF ",N," WILL EXPIRE IN ",$V(176,-4,4)-$H," DAY(S)" Q I $H+1=$V(176,-4,4) W !!,*7,"WARNING: ***THIS COPY OF ",N," WILL EXPIRE TOMORROW" Q EXPIRED ; S N=$P($P($ZV,","),"-") W #,!,*7 W !,*7,"***************************************************************" W !,*7,"* *" W !,*7,"* ---- W A R N I N G ---- *" W !,*7,"* *" W !,*7,"* !!! THIS COPY OF ",N," HAS EXPIRED !!! *" W !,*7,"* *" W !,*7,"* CONTINUED USE WILL CAUSE UNPREDICTABLE RESULTS *" W !,*7,"* *" W !,*7,"*..Please contact your ",N," dealer for renewing this license...*" W !,*7,"* *" W !,*7,"***************************************************************" H %L3M DBMAINT3 ;JWC;MOUNT VOLUME GROUPS [ 03/30/92 3:28 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1990 ZF D PTRS^%VGUTIL,OS^%VGUTIL,DSK^%VGUTIL1:'OS,GETVG^%VGUTIL K %DEV D VGSLOT I QF ZU 0 W !,"No room to mount another volume group" Q I OS D GETHFS^%SDEV I '%DEV ZU 0 W *7,!!,"No HFS devices available..." K %DEV Q RETRY D HNAME Q:QF D VGNAME I QF ZU 0 W !,"Volume is not initialized",*7 G RETRY I $D(VG(VGNAME)) D QAGN G:QF=1 RETRY Q:QF I VIN ZU 0 W !,*7,"This is not a volume 0" G RETRY ZU 0 W !,"Mounting." S %VGI=VGIN D START Q:QF D MOUNT^TRANSLA1 ZU 0 W:VGIN "done." C 0 ;D DBMAINT^%SP Q START D GETVOLS I QF ZU 0 W !,"Error in finding volumes for this volume group",*7 Q D CHKVOLS I QF ZU 0 W !,"mounting aborted." Q D MTVOLS^MOUNT,MOUNT,SETSAT^UMOUNT,SETUCI^MOUNT S $ZS="" I $D(^ ("DDP")) S %ZT=$ZT,$ZT="ZG "_$ZL_":PLDER" D DBCHG^DDP S $ZT=%ZT PLDER I $ZS'="",'$F($ZS,"1 F I=1:1:VOLS-1 S VF=I-1*12+512+44,VG0N(I)=$V(VF,0,8,1),VG0M(I)=$V(VF+8,0,2) C:$D(%DEV) %DEV Q HNAME ; I $D(^MOUNT) S HNAME=^MOUNT G CHKNAME ZU 0 W !!,"Enter ",$S(OS:"host file name",1:"disk address") R " for volume group: ",X S QF=0,HNAME=X I X="^Q"!(X="^q")!("^"[X) S QF=1 Q I HNAME?.E1C.E ZU 0 W !,"Invalid characters entered",*7 G HNAME I HNAME["?" ZU 0 W !!?3 ZU 0 W:'OS "Enter the hexadecimal address of the disk which" I ZU 0 W:OS "Enter the full name of the host operating system file which" I ZU 0 W !?3,"contains the first volume of the volume group to mount." I ZU 0 W:'OS !?3,"Enter '^L' for a list of accessible disks." I ZU 0 W !?3,"Enter '^' to return to the previous question." I ZU 0 W !?3,"Enter '^Q' to exit to the utility." G HNAME D CHKNAME G:QF HNAME Q CHKNAME ; S QF=0 G:'OS CHKNAME1 O %DEV:(HNAME:"R") U %DEV S ZA=$ZA C %DEV I ZA<0 ZU 0 W !,"File name ",HNAME," does not exist." S QF=1 Q O 63 O %DEV:(HNAME:"CBR") Q CHKNAME1 I HNAME="^L" S X="" ZU 0 W !,"Accessible disks are:",! I F I=0:1 S X=$O(%DSK(X)) Q:X="" ZU 0 W ?(I#10*8),X ZU 0 W:$X>70 ! I S QF=1 Q I '$D(%DSK(HNAME)) ZU 0 W !,"Disk ",HNAME," not available" S QF=1 Q Q QAGN ; ZU 0 W !,"You have selected volume group '",VGNAME,"' which is already mounted" R !,"To continue mount, enter an alternate volume group name: ",X QAGNR ; I X="^L"!(X="^l") D VGLIST^%VGUTIL G QAGNX I X="^" S QF=1 Q I X="^Q" S QF=2 Q I X?3U S VGALT=X D HASH^%VGUTIL S $P(LABEL(0),"^",5)=Y,QF=0 Q ZU 0 W !," Each mounted volume group must have a unique 3 letter name." ZU 0 W !," Since the volume group you want to mount has the same name " ZU 0 W !," as one which is already mounted, you must give it a " ZU 0 W !," surrogate name which will be valid as long as it is mounted." ZU 0 W !," Enter '^L' to see a list of mounted volume groups." ZU 0 W !," Enter '^' to return to the previous question" ZU 0 W !," Enter '^Q' to exit the utility." QAGNX R !!,"Please enter an alternate volume group name: ",X G QAGNR VGSLOT S QF=1 F VGIN=1:1:7 S VGOF=$V(VGIN*4+VGTAB) Q:'VGOF I '$V(VGOF+4,-3,2) S QF=0 Q %L3MBG %L3MBG ; INPUT FROM DISPLAY [ 16.10.08 13:49 ] [ 10.10.08 16:31 ] [ 10.07.08 07:38 ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N NPG,PG S NPG=1,PG(1)=0 G BEG VSV N %XX,%YY S %XX=%X000,%YY=%Y000 X %POSIC X %XCL X:$D(%PRPL) %LIGHT W:$G(%NOMOD) %CLI ;;W:$D(%MBGLIGHT) %CLI W:$D(%MBGLIGHT) %LIGHT1 I $P(%MBG("DR"),"\",J) W $J(%S,DL,$P(%MBG("DR"),"\",J)) G EV I $P(%MBG("RGS"),"\",J)="H" W $$HBR^%L1FRM($TR($TR(%S,%TES1,%TES2),%TEN,%THB),DL) G EV I $P(%MBG("RGS"),"\",J)="HH"!($P(%MBG("RGS"),"\",J)="EE") G EV W $J(%S,DL) EV X %XCL Q BEG ; U $P:(NOECHO:NOWRAP) N %BE,%GG,%LS,%S,%SOLD,%X000,%Y000,%L1DS,%YY,%L3MBGST,%YYYY,%MSC,%SCHIP N DL,OLDDAT,XOLD,YOLD,SHOLD,SCHOLD N COLS,SH,SCH,%SH00,%SCH00,%YY00,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPGL,OTB,%PRNEW,RKV,RSCR,RZD,%REFH1 N STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2,%MBGOU,%MODIF,%ENDSS N %HBRY,%HIP S %MBGOU=$G(%MBG("OU")) S %L3MBGST="" K ^mbg1($P) BEG1 D INIT S %YY=VGR2 K %L3MBGST I ($G(%SC("VIEW"))="PGUP")!($G(%SC("VIEW"))="PGDW")!($E($G(%SC("VIEW")))=":")!$D(%SC("HIP")) G ZB D PS I $D(%SC("VIEW")) G ZB Q:$D(%L3MBG) G L0 ZB0 I %TO="PGDW" S %SAY=$S(%ENGLISH:"END OF DATA",1:" mipezp seq ") X %XMSGN(1) I %TO="PGUP" S %SAY=$S(%ENGLISH:"BEGIN OF DATA",1:" mipezp zligz ") X %XMSGN(1) G @%ZBL ZB S %ZBL="ZB" I $G(%SC("VIEW"))="PGUP"!($G(%SC("VIEW"))="PGDW") S %TO=%SC("VIEW"),%SC("VIEW")=1 G ZB1 I $E($G(%SC("VIEW")))=":" D K %SC("VIEW") G POISK .S %L3MBGHIP=$E(%SC("VIEW"),2,20) .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .S %SCHIP="" I $D(%SC("HIP"))#2 D K %SC("VIEW") G POISK .S %L3MBGHIP=$P(%SC("HIP"),":") .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .I $P(%SC("HIP"),":",2) S J=$P(%SC("HIP"),":",2) N %L1GET I %ENGLISH S %GET=" PAGE DOWN - , PAGE UP - , EXIT - " E S %GET=" - d`ivi , - mcew , - `ad sc " D N^%L1GET I %TO="END" G END ZB1 I %TO="PGUP" G:NPG'>1 ZB0 S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I %TO="PGDW" G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 W *7 G ZB ; L0 S:$D(YOLD) %YY=YOLD S:$D(SHOLD) SH=SHOLD S:$D(SCHOLD) SCH=SCHOLD I $D(%TO("UP")),'$G(SCH) D D ENDP K %TO S %TO="" .F SH=SH+1:1:SH+COLS-1 D ..S %YY=%YY+STEP ..S SCH=SCH+1 .S $Y=%YY,%YYYY=%YY .S %SH00=SH,%SCH00=SCH,%YY00=%YY I $D(%SC("ENDS")) S NPGOLD=NPG D ENDF S %PS=1 S:$D(%SC("ENDS","NOPS")) %PS=0 S:$G(%SC("ENDS"))'?.P %ENDSS=%SC("ENDS") K %SC("ENDS") G:NPG'=NPGOLD BEG1 D:%PS PS G L0 LOOP ; -------------------------------- NEW LINE K YOLD,SHOLD,SCHOLD,%MBG("TO"),%SC,%MODIF X %XCL F JJ=1:1 Q:'$D(@(%REFH1_"SH-SCH+JJ)")) I $G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %FIRSTL=JJ F JJ=COLS:-1:1 I $D(@(%REFH1_"SH-SCH+JJ)")),$G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %LASTL=JJ LOOP1 ; K %INV S SH=SH+1,SCH=SCH+1 K %PRX I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G ZP ;RSM I %YY+STEP>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP I $D(%MBG("LINE")),$G(%SH00),$G(%YY00),$G(%SCH00) D .N %YY,%YYYY,SH,SCH K %MBGLIGHT S %YYYY=%YY00,SH=%SH00,SCH=%SCH00 D PL S %YY=%YY+STEP,$Y=%YY,%YYYY=%YY S %SH00=SH,%SCH00=SCH,%YY00=%YY I $$NOMOD(SH)=2 G LOOP1 I $D(%MBG("LINE")) D .S %MBGLIGHT="" D PL K %PRPL,%X000,%Y000 ML ; S %NOMOD=$$NOMOD(SH) F JJ=1:1 Q:$P(%MBG("OU"),"\",JJ)?.P S %FIRST=JJ K JJ,%PRX I %YY>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP S J=0 D NMB(0) I $D(XOLD) S J=XOLD K XOLD G LGR G INC ;------------------------------------ NEW COLUMN LGR K %TO,%OLDTO,%FLL,%S,%L1DS,%SC S %TO="",%OLDTO="" D GET S %SAY=$P(%MBG("H"),"\",J) S %SAY=" "_$P(%SAY,"++") X "S A=1" I J'=$G(^mbg1($P,"H")) X %XMSGN S ^mbg1($P,"H")=J I $P(%MBG("H"),"\",J)?.P,$P(%MBG("GLOB"),"\",J)?."^"1A.E S %SAY=" - dbvd , - my zlgzd itl yetig " X %XMSGN I $D(^SCR(%SCRN,"G",J,"MUMPS1")) D S %YY=%YYYY G:$P(%MBG("OU"),"\",J)'?.P INC .N SHOLD,JOLD,SCHOLD .S SHOLD=SH,JOLD=J,SCHOLD=SCH .N SH,SCH,J S J=JOLD,SH=SHOLD,SCH=SCHOLD .X ^SCR(%SCRN,"G",J,"MUMPS1") .I $$HZGTOUCH^%L2MOUSE,'$D(%L1NMB),$$KB^%L2MOUSE S %L1NMB("LINE")="" ;---------------------------------------- PARAMETRIM HACNASA LGR1 S %XX=$P(%MBG("X"),"\",J) I $P(%MBG("OU"),"\",J)?.P,J'=$G(^mbg1($P,"Z")) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH,I" X %XMSG S %XX=$P(%MBG("X"),"\",J) S ^mbg1($P,"Z")=J S %YY=%YYYY,$Y=%YY I %XX["+" S %YY=%YY+1,$Y=$Y+1,%PRPL="" X %LIGHT X %POSIC S %LS=$P(%MBG("D"),"\",J),%FL="" ;;S %S=$$SPA^%L1FRM($G(@$P(%MBG("O"),"\",J))) S %INV="" S (%MOLD,%S)=$G(@$P(%MBG("O"),"\",J)) S %INV="" I $D(%ENDSS),J=%FIRST S %S=%ENDSS S CIST=$P(%MBG("S"),"\",J) K:CIST="" CIST S %PRNEW=0 ;;I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" ;---------------------------------------- HACNASA I $P(%MBG("RGS"),"\",J)="E" D .I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" .S %XX=%XX-%LS X %POSIC S:%XX<0 %XX=0 S $X=%XX .I $$HZGTOUCH^%L2MOUSE S %ZMSL("NMB")=1 .S %FL="" K %BE S %ZMSF="" S:$D(%ENDSS) %BE="E" K:'$D(%BE) %FLINS N %HBRY D ^%ZMSL K %INV,%GET,%ENDSS I %S["=="!(%TO="END")!(%TO="=") S %S=%MOLD Q .I $P(%MBG("DR"),"\",J),%S'["%" S %S=$J(%S,$P(%MBG("DR"),"\",J)+1,$P(%MBG("DR"),"\",J)) ; I $P(%MBG("RGS"),"\",J)="H" S $X=%XX-1 D ^%L1ZMS ; I $P(%MBG("RGS"),"\",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q ; I $P(%MBG("RGS"),"\",J)="EE" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WE .S %L1WE="" K %INV D ^%L1WE K %L1WE .Q I $P(%MBG("RGS"),"\",J)="D" S %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,"/.:","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET ; I $P(%MBG("RGS"),"\",J)="T" S %XX=%XX-5 S $X=%XX S %L1TS=$TR(%S,":/.","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET ; K %ENDSS S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) ;*** S %XX=$P(%MBG("X"),"\",J)-DL I $P(%MBG("OU"),"\",J)?.P D .I $P(%MBG("X"),"\",J)["+" W %LIGHT1 .N %XX,%YY S %XX=$P(%MBG("X"),"\",J) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG ; ;----------------------------------------- VIHOD I $D(%SCHIP) S %S=%MOLD,%MBG("NOZAPR")=1 I %TO="HELP" D HELP S %SC("ST")=1,%TO="" G NAZAD I $G(%TO)="DEL",'$D(%MBG("DELAS")),$D(@(%REFH1_"SH)")),'$G(%NOMOD) D DEL G:%TO'="PGUP" BEG1 G PGUP I %S["==",%MBG("O")?.P S %TO="END",%S="" K %TOEQ I $G(%TO)="=",$D(%MBG("=")) S %TO="END",%TOEQ="" S %X000=%XX,%Y000=%YY D VSV I '$G(%MODIF) S J=%FIRST G NZ I $P(%MBG("D"),"\",J)[".",+%S,$P(%MBG("RGS"),"\",J)="E" S %S=$TR($J(%S,DL)," ",0) S %X000=%XX,%Y000=%YY I $P(%MBG("RGS"),"\",J)'="HH" D VSV X %XCL ;;S %MOLD=$$SPL^%L1FRM($P($G(@(%REFH1_"SH)")),RZD,J)) I $P(%MBG("DR"),"\",J),$P(%MBG("OU"),"\",J)="!",%TO="" S $P(@(%REFH1_"SH)"),RZD,J)=%S G MUST I $P(%MBG("DR"),"\",J),%NOMOD,+%MOLD'=+%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR I '$P(%MBG("DR"),"\",J),%NOMOD,%MOLD'=%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR MUST I $G(@$P(%MBG("O"),"\",J))'=%S!($P(%MBG("NEW"),"\",J)'?.P) S %PRNEW=1 S @$P(%MBG("O"),"\",J)=%S S %YY=%YYYY,$Y=%YY S %SOLD=%S I $P(%MBG("RGS"),"\",J)="D",$TR(%S,"/.")=$TR(%MOLD,"./") G TOUP I $P(%MBG("RGS"),"\",J)="T",+$TR(%S,"/.:")=+$TR(%MOLD,"./:") G TOUP I %S'=%MOLD,$P(%MBG("DR"),"\",J)="" S %MODIF=$G(%MODIF)+1 I $P(%MBG("DR"),"\",J)'="",$J(%S,0,$P(%MBG("DR"),"\",J))'=$J(%MOLD,0,$P(%MBG("DR"),"\",J)) S %MODIF=$G(%MODIF)+1 I SH>$O(@(%REFH1_"999999)"),-1) D .N JJ,ZN S %MODIF=0 F JJ=1:1:$L(%MBG("O"),"\") S ZN=$G(@$P(%MBG("O"),"\",J)) I ZN'="" S %MODIF=1 ; TOUP I %TO="UP",'$G(%MODIF) G UP I %TO="ESC",'$G(%MODIF) G NZ S %CMD=0 F JJ=1:1:COLG D Q:%CMD .I $D(^SCR(%SCRN,"G",JJ,"MUMPS1")),^("MUMPS1")'?.P S %CMD=1 Q .I $D(^SCR(%SCRN,"G",JJ,"MUMPS2")),^("MUMPS2")'?.P S %CMD=1 Q G:'%CMD BDTO I $G(%MODIF),%TO="F8"&($P($G(%MBG("FNC")),"\",J)'[%TO)!(%TO="PGUP")!(%TO="PGDW")!(%TO="BEGF")!(%TO="ENDS") S %TO="" I $G(%MODIF) I (%TO="UP"!(%TO="END"))&(J=%FIRST)!(%TO="DW")!(%TO="HOME") S %TO="" BDTO I $G(%TO)="F8",$P(%MBG("FNC"),"\",J)'[%TO G POISK I $G(%TO)="PGUP" G PGUP ;---------------------- MOVE I %TO="TAB" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'<$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="TAB",$D(%MBG("MOVE")) D D PS G LOOP .N %ST S %ST=$G(@(%REFH1_"SH+1)")) .S @(%REFH1_"SH+1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST ; I %TO="PGLN" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'>1) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="PGLN",$D(%MBG("MOVE")),'$$NOMOD(SH),SH>1 D D PS S %TO="UP" G UP .N %ST S %ST=$G(@(%REFH1_"SH-1)")) .S @(%REFH1_"SH-1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST S SHOLD=SH-1,SCHOLD=SCH-1,YOLD=%YY-1 ; I %TO="INS" I $G(%MODIF)!'$D(%MBG("MOVE"))!$$NOMOD(SH)!(SH>$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="INS" D D PS G LOOP1 .N %SHLAST S %SHLAST=$O(@(%REFH1_"99999)"),-1)+1 .N %I,%ST F %I=%SHLAST:-1:SH+1 S %ST=@(%REFH1_"%I-1)") S @(%REFH1_"%I)")=%ST .S @(%REFH1_"SH)")="" .S %MODIF=$G(%MODIF)+120 .S %YY=%YY-STEP,SH=SH-1,SCH=SCH-1 ; ;;I %TO="DBL" D D PS G L0 .N %SHEND,%G .S %SHEND=$ZP(@(%REFH1_"99999)"))+1 Q:%SHEND>%MBG("GWUL") .S MAC1=%REFH1_"SH)",MAC2=%REFH1_%SHEND_")",%S1GC("R")=RZD_"@@" D ^%S1GC1 .S YOLD=%YY,SHOLD=SH,SCHOLD=SCH ; I %TO="DBL" D G NAZAD .D ..N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%SCRN) D ^%L1C ..D MENU^%L3MBGR(%SCRN) .N %NOVIDEO S %NOVIDEO="" D REST^%L3MBGG .S %TO="",%SC("ST")=1 I %TO="F3",'$D(%MBG("NODBL")),SH>1 S @$P(%MBG("O"),"\",J)=$P(@(%REFH1_"SH-1)"),RZD,J) G LGR1 I $G(%TO)="BEGF" S NPG=1 K SHOLD,SCHOLD,YOLD G BEG1 I $G(%TO)="ENDS" S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 I %TO="",$G(%NOMOD),$P(%MBG("OU"),"\",J)'="!" S %TO="DW" I %TO="HOME" D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) ;;I %TO="DW",J=%FIRST,SCH=%LASTL,$D(%MBG("UPDOWN")) D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) S %OLDTO=%TO I %TO="DW",J=%FIRST S %TO="" I '$G(%MODIF),%MOLD'?.P!($P(%MBG("NEW"),RZD,J)?.P&($G(^SCR(%SCRN,"G",J,"MUMPS2"))?.P)) D CLOU G LOOP K %L1SCBEG ;*** LEV 010495 S %NOMOD=$$NOMOD(SH) I %NOMOD G IBUD I $P(%MBG("GLOB"),"\",J)?."^"1A.E,%TO="" D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;I $P(%MBG("GLOB"),"\",J)?."^"1U.E,%TO="F6"!(%TO="F7"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV I $P(%MBG("GLOB"),"\",J)?."^"1A.E,(%TO="F7")!(%TO="F6"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S (%TO,%OLDTO)="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV IBUD ; I $D(^SCR(%SCRN,"G",J,"MUMPS2")),^("MUMPS2")'?.P S JOLD=J D S %S=$G(@$P(%MBG("O"),"\",J)) G:$D(%SC("ER")) NAZAD D:%S'=$G(%SOLD) VSV D SETM D:$G(%SC("TO"))="PL" PL G:$G(%SC("TO"))'="P" NAZAD D PS G NAZAD .N %FIRSTOLD .S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH D ..N JOLD,YOLD,XOLD,SHOLD,SCHOLD ..S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH,%FIRSTOLD=%FIRST N %FIRST ..K %SC X ^SCR(%SCRN,"G",J,"MUMPS2") .S J=JOLD,%YY=YOLD,%XX=XOLD,SH=SHOLD,SCH=SCHOLD S:$G(%FIRSTOLD) %FIRST=%FIRSTOLD K XOLD,YOLD,SHOLD,SCHOLD .Q SET ; NAZAD ; I $D(%L3MBGHIP) G POISK I $D(%SC("END")),J=%FIRST,'$G(%MODIF) G RSM ;;I $D(%OLDTO),(%OLDTO="END")&(COLG>1)!(%OLDTO="UP")!(%OLDTO="PGDW")!(%OLDTO="ENDS") S %TO=%OLDTO,%OLDTO="" G NZ I $D(%OLDTO),'$G(%MODIF),%OLDTO="END"!(%OLDTO="PGDW")!(%OLDTO="ENDS")!(%OLDTO="UP") S %TO=%OLDTO,%OLDTO="" D G NZ .I $G(@$P(%MBG("O"),"\",J))?." ",J=%FIRST,$G(@(%REFH1_"SH)"))?.P,SH=$O(@(%REFH1_"99999)"),-1) K @(%REFH1_"SH)") I '$D(%SC("ST")),$G(@$P(%MBG("O"),"\",J))?." ",$P(%MBG("OU"),"\",J)?.P,$P(%MBG("NEW"),"\",J)'?.P,%OLDTO'="END" D ER G LGR I $D(%SC("ER")) D ER K %SC G LGR D SETM I $D(%SC("ST")) K %SC G LGR NZ K %SC S:$G(%TO)="END"&(J>%FIRST) %TO="UP" I $G(%TO)="END",J=%FIRST G ZP I $G(%TO)="UP" G:J'>%FIRST UP S J=J-1 G:$P(%MBG("OU"),"\",J)?.P LGR G NZ ; ----------------------------------------- END OF INPUT COLUMN UP ; I $G(%TO)="UP",$D(%MBG("UPDOWN"))&(SCH'>%FIRSTL) D ENDP G L0 I $G(%TO)="UP" S:SCH=1 %TO="PGUP",%TO("UP")="" G:SCH=1 PGUP D D CLOU G LOOP UPB .Q:SCH<2 S %YY=%YY-(2*STEP),SH=SH-2,SCH=SCH-2 .S SH=SH+1 S %NOMOD=$$NOMOD(SH) I %NOMOD=2 S %YY=%YY+STEP,SCH=SCH+1 G UPB .S SH=SH-1 I $G(%TO)="DW" D CLOU G LOOP PGUP ; I $G(%TO)="PGUP" D CLR G:NPG'>1 ML:'$D(%L3MBG),END S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="PGDW" D CLR S %ZBL=$S('$D(%L3MBG):"ML",1:"END") G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="ENDS" D CLR S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 INC S J=J+1 K %L1GET I J>COLG D CLOU G LOOP INC1 S %NOMOD=$$NOMOD(SH) I $P(%MBG("OU"),"\",J)'?.P S RKV=$P($G(@(%REFH1_"SH)")),RZD,J) D PGR G INC G LGR CLOU N JJ S %MBG("OU")=%MBGOU F JJ=1:1:COLG I $P(%MBG("NEW"),"\",JJ)'="Y" S $P(%MBG("NEW"),"\",JJ)="" I $D(%MBGSAVE),$D(@(%REFH1_"SH)"))#2 S ^mbg($P,SH)=@(%REFH1_"SH)"),^mbg($P)="" Q GET F JJ=1:1:COLG S @$P(%MBG("O"),"\",JJ)=$P($G(@(%REFH1_"SH)")),RZD,JJ) Q SETM ; N %GG,JJ S %GG=$G(@(%REFH1_"SH)")) I '$D(%SC("ER")),$G(%SC("ST"))'="ER" F JJ=1:1:COLG S $P(@(%REFH1_"SH)"),RZD,JJ)=$G(@$P(%MBG("O"),"\",JJ)) I $G(%NOMOD),$G(@(%REFH1_"SH)"))'=%GG S @(%REFH1_"SH)")=%GG D PL Q ZP D CLR K YOLD,SHOLD,SCHOLD S %SAY="" X %XMSGN S OTB="" D ZAPR G RSM:OTB="."!($G(%TO)="END"),BEG1 ; PL N Y1,X1,Y2,X2,%GG,XX0,%XX,%YY ; -- INPUT: SH,SCH,%YYYY S %GG=$G(@(%REFH1_"SH)")),I=SCH S Y1=VGR0,X1=%MBG("LL"),Y2=$G(%MBG("NGR"),24) S XX0=$G(%MBG("LR"),70),X2=XX0+1 S:XX0>79 XX0=79 S %XX=X1,%YY=%YYYY X %POSIC W $J("",X2-X1-1) D PG Q RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END K %L3MBG S mbgs=$O(^mbg0($P,9999999),-1)+1 S ^mbg($P)="",MAC1="^mbg($P)",MAC2="^mbg0($P,mbgs)" D ^%S1GC1 K ^mbg($P),^mbg0($P,mbgs-5) K ^mbg1($P) Q ; PS N SH,SCH,%YY,J,JJ,%OFF S SCH=0,SH=PG(NPG),%OFF=0 I $D(%SC("ENDS")),'$D(%L3MBG),'$D(%SC("VIEW")) Q D CLEAR F JJ=1:1:COLG D .I $P(%MBG("X"),"\",JJ)["+" S %OFF=1 X %LIGHT S %YY=VGR2 D P X %XCL Q ; P N I,%S,%L1DS,J,%GG,%SAY,%MBGLIGHT X %XCL F J=1:1:COLG D .N %SAY,%XX,%YY .S %XX=$P(%MBG("X"),"\",J) I %XX["+" W %LIGHT1 .S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG N ZT S ZT=$ZT N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":PZT^%L3MBG" F I=1:1:COLS Q:'$D(@(%REFH1_"SH-SCH+I)")) S %YY=%YY+STEP S %GG=$G(@(%REFH1_"SH-SCH+I)")) D PG PZT S $ZT=ZT S %SAY="" I '$D(%MBG("DELAS")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}/E{} dxey wegnl " I $D(%MBG("MOVE")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}INS{} qpkd {}TAB,+L{} fifdl "_%SAY I $D(%MBG("MIUN")),'$D(%SC("VIEW")) S %SAY="{}F8{} oein/yetig "_%SAY ;;I %TYPCRT="PC" S %SAY="{}CTRL+G{} sxb "_%SAY I %SAY'="",'$D(%L1NMB("LINE")) S %SAY=%SAY_"++"_(Y2-1)_","_(%MBG("LR")-(%MBG("LR")-%MBG("LL")-$L($TR(%SAY,"{}",""))\2))_",HH++"_%BCG_",YF" X %XMSG Q PG N RKV,J,%NOMOD S %NOMOD=0 X %XCL ;---< INPUT - %GG,I > I %GG[("!"_$G(RZD,"\")_"@@!"),'%ENGLISH S %XX=X2-$L(%GG)-2 S:%XX0 X %POSIC W %CLI W $J(SH+%OFS+$G(%MBG("OFF")),2) X %XCL Q PGR ; ------------------ INPUT - RKV,%YY N DL,%XX Q:$G(RKV)="" W:%TYPCRT["VT" *27,"(B" W:%NOMOD %CLI W:$D(%MBGLIGHT) %LIGHT1 ; %CLI S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) S %XX=$P(%MBG("X"),"\",J)-DL X %POSIC W:$P(%MBG("INV"),"\",J)'?.P %CLI I $P(%MBG("X"),"\",J)["+" S %YY=%YY+1 X %POSIC S %YY=%YY-1 X %LIGHT I $G(RKV)="" W $J("",DL) X %XCL Q I $P(%MBG("RGS"),"\",J)="HH" D X %XCL Q .N %X1,%Y1,%X2,%Y2,%S,%L1WH .S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1 .S %S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S .Q I $P(%MBG("RGS"),"\",J)="EE" D X %XCL Q .N %X1,%Y1,%X2,%Y2,%S,%L1WE .S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1 .S %S=RKV S %L1WE="" D ^%L1WE K %L1WE,%S .Q ; D .N RKV1 .I RKV="-" W $J("",DL\2-1)_"-" Q .I $P(%MBG("RGS"),"\",J)="H" D W $J($$^%L1HB(RKV1),DL) Q ..S RKV1="" ..I $L(RKV)>DL&($P(%MBG("D"),"\",J)["/") S RKV1="..."_$E(RKV,$L(RKV)-DL+4,255) Q ..S RKV1=RKV . .I '$P(%MBG("DR"),"\",J) W $J(RKV,DL) Q .W $J(RKV,DL,$P(%MBG("DR"),"\",J)) X %XCL Q CLEAR ;-- INPUT: X2,X1,VGR,Y2,NPG N %XX,%YY,I X %XCL I $D(%SCNC) F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) D RBUA ;Y1 --> VGR I '$D(%SCNC),'$D(%SC("NOCL")) D .;;I %TYPCRT["VT5" W $C(27,91),VGR+1,";",X1+1,";",Y2-1,";",X2-1,"$z" Q .F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W %chists .D RBUA S %SAY=NPG_" sc++"_(VGR0-1)_","_(X1+8)_",HH++"_%BCG_",YF" X %XMSG I '$D(%L3MBG),'$D(%SC("VIEW")) S %SAY=" dxfr++"_(VGR0-1)_","_(X2-2)_",HH++"_%BCG_",YF" X %XMSG Q NOMOD(SH) N %NOMOD S %NOMOD=$$NOMOD1($G(@(%REFH1_"SH)"))) Q %NOMOD NOMOD1(ST) ; N ST1 S ST1=$P(ST,RZD,$L(ST,RZD)) I $E(ST1,1,2)="@@" Q $S($E(ST1,3)="!":2,1:1) Q 0 ZAPR ; D ZAPR^%L3MBG2 Q ER ; X %XMSGV("ER") K %L1GET S %SC("ER")=1 S:$D(%MOLD) %S=%MOLD S:$G(%MODIF)>0 %MODIF=%MODIF-1 Q I $P(%MBG("NEW"),"\",J)'="Y" S $P(%MBG("NEW"),"\",J)="" S $P(@(%REFH1_"SH)"),RZD,J)=$G(%MOLD) I $G(%MODIF)>0 S %MODIF=%MODIF-1 Q DEL Q:$G(%NOMOD) D DEL^%L3MBG2 ; Q INIT D INIT^%L3MBG2 S %NOMOD=0 Q ENDF ; N I,JJ S JJ=0 F I=SH-SCH+1:1 Q:'$D(@(%REFH1_"I)")) D .S JJ=JJ+1 I JJ>COLS S NPG=NPG+1,PG(NPG)=I-1,JJ=1,%PS=1 S SHOLD=I S:SHOLD>0 SHOLD=SHOLD-1 I $G(%MBG("GWUL")),SHOLD'<%MBG("GWUL") S SHOLD=%MBG("GWUL")-1 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) K %SH00,%SCH00,%SCH00 Q ENDP ; N I,JJ S JJ=0 F I=SH-SCH+1:1:SH-SCH+COLS Q:'$D(@(%REFH1_"I)")) S JJ=JJ+1 S SHOLD=I-'$D(^(I)) S:SHOLD>0 SHOLD=SHOLD-1 S:SHOLD<0 SHOLD=0 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) Q POISK D POISK^%L3MBG2 G @%LAB RBUA W:%CVET %LIGHT1,%CV("CF") K %L1RBCL D ^%L1RBUA X %XCL Q CLR X %XCL K %SH00,%SCH00,%YY00 Q HELP ; D SAVE^%L3MBGG D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C .X "ZL %L3MBGH K ^TMPS111($J) N I F I=2:1 Q:$T(+I)="""" S ^TMPS111($J,I)=$T(+I)" S %S2V("LEFT")=5 X %chista W %CV("YF") D ^%S2VIEW D REST^%L3MBGG Q %L3MBG0 %L3MBG ; INPUT FROM DISPLAY [ 19.01.07 10:46 ] [ 18.10.06 13:27 ] [ 26.07.06 15:26 ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N NPG,PG S NPG=1,PG(1)=0 G BEG VSV N %XX,%YY S %XX=%X000,%YY=%Y000 X %POSIC X %XCL X:$D(%PRPL) %LIGHT W:$G(%NOMOD) %CLI ;;W:$D(%MBGLIGHT) %CLI W:$D(%MBGLIGHT) %LIGHT1 I $P(%MBG("DR"),"\",J) W $J(%S,DL,$P(%MBG("DR"),"\",J)) G EV I $P(%MBG("RGS"),"\",J)="H" W $$HBR^%L1FRM($TR($TR(%S,%TES1,%TES2),%TEN,%THB),DL) G EV W $J(%S,DL) EV X %XCL Q BEG ; U $P:(NOECHO:NOWRAP) N %BE,%GG,%LS,%S,%SOLD,%X000,%Y000,%L1DS,%YY,%L3MBGST,%YYYY,%MSC,%SCHIP N DL,OLDDAT,XOLD,YOLD,SHOLD,SCHOLD N COLS,SH,SCH,%SH00,%SCH00,%YY00,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPGL,OTB,%PRNEW,RKV,RSCR,RZD,%REFH1 N STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2,%MBGOU,%MODIF,%ENDSS N %HBRY,%HIP S %MBGOU=$G(%MBG("OU")) S %L3MBGST="" K ^mbg1($P) BEG1 D INIT S %YY=VGR2 K %L3MBGST I ($G(%SC("VIEW"))="PGUP")!($G(%SC("VIEW"))="PGDW")!($E($G(%SC("VIEW")))=":")!$D(%SC("HIP")) G ZB D PS I $D(%SC("VIEW")) G ZB Q:$D(%L3MBG) G L0 ZB0 I %TO="PGDW" S %SAY=$S(%ENGLISH:"END OF DATA",1:" mipezp seq ") X %XMSGN(1) I %TO="PGUP" S %SAY=$S(%ENGLISH:"BEGIN OF DATA",1:" mipezp zligz ") X %XMSGN(1) G @%ZBL ZB S %ZBL="ZB" I $G(%SC("VIEW"))="PGUP"!($G(%SC("VIEW"))="PGDW") S %TO=%SC("VIEW"),%SC("VIEW")=1 G ZB1 I $E($G(%SC("VIEW")))=":" D K %SC("VIEW") G POISK .S %L3MBGHIP=$E(%SC("VIEW"),2,20) .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .S %SCHIP="" I $D(%SC("HIP"))#2 D K %SC("VIEW") G POISK .S %L3MBGHIP=$P(%SC("HIP"),":") .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .I $P(%SC("HIP"),":",2) S J=$P(%SC("HIP"),":",2) N %L1GET I %ENGLISH S %GET=" PAGE DOWN - , PAGE UP - , EXIT - " E S %GET=" - d`ivi , - mcew , - `ad sc " D N^%L1GET I %TO="END" G END ZB1 I %TO="PGUP" G:NPG'>1 ZB0 S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I %TO="PGDW" G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 W *7 G ZB ; L0 S:$D(YOLD) %YY=YOLD S:$D(SHOLD) SH=SHOLD S:$D(SCHOLD) SCH=SCHOLD I $D(%SC("ENDS")) S NPGOLD=NPG D ENDF S %PS=1 S:$D(%SC("ENDS","NOPS")) %PS=0 S:$G(%SC("ENDS"))'?.P %ENDSS=%SC("ENDS") K %SC("ENDS") G:NPG'=NPGOLD BEG1 D:%PS PS G L0 LOOP ; -------------------------------- NEW LINE K YOLD,SHOLD,SCHOLD,%MBG("TO"),%SC,%MODIF X %XCL F JJ=1:1 Q:'$D(@(%REFH1_"SH-SCH+JJ)")) I $G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %FIRSTL=JJ F JJ=COLS:-1:1 I $D(@(%REFH1_"SH-SCH+JJ)")),$G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %LASTL=JJ LOOP1 ; K %INV S SH=SH+1,SCH=SCH+1 K %PRX I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G ZP ;RSM I %YY+STEP>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP I $D(%MBG("LINE")),$G(%SH00),$G(%YY00),$G(%SCH00) D .N %YY,%YYYY,SH,SCH K %MBGLIGHT S %YYYY=%YY00,SH=%SH00,SCH=%SCH00 D PL S %YY=%YY+STEP,$Y=%YY,%YYYY=%YY S %SH00=SH,%SCH00=SCH,%YY00=%YY I $$NOMOD(SH)=2 G LOOP1 I $D(%MBG("LINE")) D .S %MBGLIGHT="" D PL K %PRPL,%X000,%Y000 ML ; S %NOMOD=$$NOMOD(SH) F JJ=1:1 Q:$P(%MBG("OU"),"\",JJ)?.P S %FIRST=JJ K JJ,%PRX I %YY>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP S J=0 D NMB(0) I $D(XOLD) S J=XOLD K XOLD G LGR G INC ;------------------------------------ NEW COLUMN LGR K %TO,%OLDTO,%FLL,%S,%L1DS,%SC S %TO="",%OLDTO="" D GET S %SAY=$P(%MBG("H"),"\",J) S %SAY=" "_$P(%SAY,"++") X "S A=1" I J'=$G(^mbg1($P,"H")) X %XMSGN S ^mbg1($P,"H")=J I $P(%MBG("H"),"\",J)?.P,$P(%MBG("GLOB"),"\",J)?."^"1A.E S %SAY=" - dbvd , - my zlgzd itl yetig " X %XMSGN I $D(^SCR(%SCRN,"G",J,"MUMPS1")) D S %YY=%YYYY G:$P(%MBG("OU"),"\",J)'?.P INC .N SHOLD,JOLD,SCHOLD .S SHOLD=SH,JOLD=J,SCHOLD=SCH .N SH,SCH,J S J=JOLD,SH=SHOLD,SCH=SCHOLD .X ^SCR(%SCRN,"G",J,"MUMPS1") .I $$HZGTOUCH^%L2MOUSE,'$D(%L1NMB),$$KB^%L2MOUSE S %L1NMB("LINE")="" ;---------------------------------------- PARAMETRIM HACNASA LGR1 S %XX=$P(%MBG("X"),"\",J) I $P(%MBG("OU"),"\",J)?.P,J'=$G(^mbg1($P,"Z")) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH,I" X %XMSG S %XX=$P(%MBG("X"),"\",J) S ^mbg1($P,"Z")=J S %YY=%YYYY,$Y=%YY I %XX["+" S %YY=%YY+1,$Y=$Y+1,%PRPL="" X %LIGHT X %POSIC S %LS=$P(%MBG("D"),"\",J),%FL="" ;;S %S=$$SPA^%L1FRM($G(@$P(%MBG("O"),"\",J))) S %INV="" S (%MOLD,%S)=$G(@$P(%MBG("O"),"\",J)) S %INV="" I $D(%ENDSS),J=%FIRST S %S=%ENDSS S CIST=$P(%MBG("S"),"\",J) K:CIST="" CIST S %PRNEW=0 ;;I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" ;---------------------------------------- HACNASA I $P(%MBG("RGS"),"\",J)="E" D .I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" .S %XX=%XX-%LS X %POSIC S:%XX<0 %XX=0 S $X=%XX .I $$HZGTOUCH^%L2MOUSE S %ZMSL("NMB")=1 .S %FL="" K %BE S %ZMSF="" S:$D(%ENDSS) %BE="E" K:'$D(%BE) %FLINS N %HBRY D ^%ZMSL K %INV,%GET,%ENDSS I %S["=="!(%TO="END")!(%TO="=") S %S=%MOLD Q .I $P(%MBG("DR"),"\",J),%S'["%" S %S=$J(%S,$P(%MBG("DR"),"\",J)+1,$P(%MBG("DR"),"\",J)) ; I $P(%MBG("RGS"),"\",J)="H" S $X=%XX-1 D ^%L1ZMS ; I $P(%MBG("RGS"),"\",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q ; I $P(%MBG("RGS"),"\",J)="D" S %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,"/.:","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET ; I $P(%MBG("RGS"),"\",J)="T" S %XX=%XX-5 S $X=%XX S %L1TS=$TR(%S,":/.","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET ; K %ENDSS S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) ;*** S %XX=$P(%MBG("X"),"\",J)-DL I $P(%MBG("OU"),"\",J)?.P D .I $P(%MBG("X"),"\",J)["+" W %LIGHT1 .N %XX,%YY S %XX=$P(%MBG("X"),"\",J) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG ; ;----------------------------------------- VIHOD I $D(%SCHIP) S %S=%MOLD,%MBG("NOZAPR")=1 I %TO="HELP" D HELP S %SC("ST")=1,%TO="" G NAZAD I $G(%TO)="DEL",'$D(%MBG("DELAS")),$D(@(%REFH1_"SH)")),'$G(%NOMOD) D DEL G:%TO'="PGUP" BEG1 G PGUP I %S["==",%MBG("O")?.P S %TO="END",%S="" K %TOEQ I $G(%TO)="=",$D(%MBG("=")) S %TO="END",%TOEQ="" S %X000=%XX,%Y000=%YY D VSV I '$G(%MODIF) S J=%FIRST G NZ I $P(%MBG("D"),"\",J)[".",+%S,$P(%MBG("RGS"),"\",J)="E" S %S=$TR($J(%S,DL)," ",0) S %X000=%XX,%Y000=%YY I $P(%MBG("RGS"),"\",J)'="HH" D VSV X %XCL ;;S %MOLD=$$SPL^%L1FRM($P($G(@(%REFH1_"SH)")),RZD,J)) I $P(%MBG("DR"),"\",J),$P(%MBG("OU"),"\",J)="!",%TO="" S $P(@(%REFH1_"SH)"),RZD,J)=%S G MUST I $P(%MBG("DR"),"\",J),%NOMOD,+%MOLD'=+%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR I '$P(%MBG("DR"),"\",J),%NOMOD,%MOLD'=%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR MUST I $G(@$P(%MBG("O"),"\",J))'=%S!($P(%MBG("NEW"),"\",J)'?.P) S %PRNEW=1 S @$P(%MBG("O"),"\",J)=%S S %YY=%YYYY,$Y=%YY S %SOLD=%S I $P(%MBG("RGS"),"\",J)="D",$TR(%S,"/.")=$TR(%MOLD,"./") G TOUP I $P(%MBG("RGS"),"\",J)="T",+$TR(%S,"/.:")=+$TR(%MOLD,"./:") G TOUP I %S'=%MOLD,$P(%MBG("DR"),"\",J)="" S %MODIF=$G(%MODIF)+1 I $P(%MBG("DR"),"\",J)'="",$J(%S,0,$P(%MBG("DR"),"\",J))'=$J(%MOLD,0,$P(%MBG("DR"),"\",J)) S %MODIF=$G(%MODIF)+1 I SH>$O(@(%REFH1_"999999)"),-1) D .N JJ,ZN S %MODIF=0 F JJ=1:1:$L(%MBG("O"),"\") S ZN=$G(@$P(%MBG("O"),"\",J)) I ZN'="" S %MODIF=1 ; TOUP I %TO="UP",'$G(%MODIF) G UP I %TO="ESC",'$G(%MODIF) G NZ S %CMD=0 F JJ=1:1:COLG D Q:%CMD .I $D(^SCR(%SCRN,"G",JJ,"MUMPS1")),^("MUMPS1")'?.P S %CMD=1 Q .I $D(^SCR(%SCRN,"G",JJ,"MUMPS2")),^("MUMPS2")'?.P S %CMD=1 Q G:'%CMD BDTO I $G(%MODIF),%TO="F8"&($P($G(%MBG("FNC")),"\",J)'[%TO)!(%TO="PGUP")!(%TO="PGDW")!(%TO="BEGF")!(%TO="ENDS") S %TO="" I $G(%MODIF) I (%TO="UP"!(%TO="END"))&(J=%FIRST)!(%TO="DW")!(%TO="HOME") S %TO="" BDTO I $G(%TO)="F8",$P(%MBG("FNC"),"\",J)'[%TO G POISK I $G(%TO)="PGUP" G PGUP ;---------------------- MOVE I %TO="TAB" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'<$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="TAB",$D(%MBG("MOVE")) D D PS G LOOP .N %ST S %ST=$G(@(%REFH1_"SH+1)")) .S @(%REFH1_"SH+1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST ; I %TO="TABN" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'>1) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="TABN",$D(%MBG("MOVE")),'$$NOMOD(SH),SH>1 D D PS S %TO="UP" G UP .N %ST S %ST=$G(@(%REFH1_"SH-1)")) .S @(%REFH1_"SH-1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST S SHOLD=SH-1,SCHOLD=SCH-1,YOLD=%YY-1 ; I %TO="INS" I $G(%MODIF)!'$D(%MBG("MOVE"))!$$NOMOD(SH)!(SH>$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="INS" D D PS G LOOP1 .N %SHLAST S %SHLAST=$O(@(%REFH1_"99999)"),-1)+1 .N %I,%ST F %I=%SHLAST:-1:SH+1 S %ST=@(%REFH1_"%I-1)") S @(%REFH1_"%I)")=%ST .S @(%REFH1_"SH)")="" .S %MODIF=$G(%MODIF)+120 .S %YY=%YY-STEP,SH=SH-1,SCH=SCH-1 ; ;;I %TO="DBL" D D PS G L0 .N %SHEND,%G .S %SHEND=$ZP(@(%REFH1_"99999)"))+1 Q:%SHEND>%MBG("GWUL") .S MAC1=%REFH1_"SH)",MAC2=%REFH1_%SHEND_")",%S1GC("R")=RZD_"@@" D ^%S1GC1 .S YOLD=%YY,SHOLD=SH,SCHOLD=SCH ; I %TO="DBL" D G NAZAD .D ..N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%SCRN) D ^%L1C ..D MENU^%L3MBGR(%SCRN) .N %NOVIDEO S %NOVIDEO="" D REST^%L3MBGG .S %TO="",%SC("ST")=1 I %TO="F3",'$D(%MBG("NODBL")),SH>1 S @$P(%MBG("O"),"\",J)=$P(@(%REFH1_"SH-1)"),RZD,J) G LGR1 I $G(%TO)="BEGF" S NPG=1 K SHOLD,SCHOLD,YOLD G BEG1 I $G(%TO)="ENDS" S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 I %TO="",$G(%NOMOD),$P(%MBG("OU"),"\",J)'="!" S %TO="DW" I %TO="HOME" D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) ;;I %TO="DW",J=%FIRST,SCH=%LASTL,$D(%MBG("UPDOWN")) D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) S %OLDTO=%TO I %TO="DW",J=%FIRST S %TO="" I '$G(%MODIF),%MOLD'?.P!($P(%MBG("NEW"),RZD,J)?.P&($G(^SCR(%SCRN,"G",J,"MUMPS2"))?.P)) D CLOU G LOOP K %L1SCBEG ;*** LEV 010495 S %NOMOD=$$NOMOD(SH) I %NOMOD G IBUD I $P(%MBG("GLOB"),"\",J)?."^"1A.E,%TO="" D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;I $P(%MBG("GLOB"),"\",J)?."^"1U.E,%TO="F6"!(%TO="F7"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV I $P(%MBG("GLOB"),"\",J)?."^"1A.E,(%TO="F7")!(%TO="F6"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S (%TO,%OLDTO)="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV IBUD ; I $D(^SCR(%SCRN,"G",J,"MUMPS2")),^("MUMPS2")'?.P S JOLD=J D S %S=$G(@$P(%MBG("O"),"\",J)) G:$D(%SC("ER")) NAZAD D:%S'=$G(%SOLD) VSV D SETM D:$G(%SC("TO"))="PL" PL G:$G(%SC("TO"))'="P" NAZAD D PS G NAZAD .N %FIRSTOLD .S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH D ..N JOLD,YOLD,XOLD,SHOLD,SCHOLD ..S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH,%FIRSTOLD=%FIRST N %FIRST ..K %SC X ^SCR(%SCRN,"G",J,"MUMPS2") .S J=JOLD,%YY=YOLD,%XX=XOLD,SH=SHOLD,SCH=SCHOLD S:$G(%FIRSTOLD) %FIRST=%FIRSTOLD K XOLD,YOLD,SHOLD,SCHOLD .Q SET ; NAZAD ; I $D(%L3MBGHIP) G POISK I $D(%SC("END")),J=%FIRST,'$G(%MODIF) G RSM ;;I $D(%OLDTO),(%OLDTO="END")&(COLG>1)!(%OLDTO="UP")!(%OLDTO="PGDW")!(%OLDTO="ENDS") S %TO=%OLDTO,%OLDTO="" G NZ I $D(%OLDTO),'$G(%MODIF),%OLDTO="END"!(%OLDTO="PGDW")!(%OLDTO="ENDS")!(%OLDTO="UP") S %TO=%OLDTO,%OLDTO="" D G NZ .I $G(@$P(%MBG("O"),"\",J))?." ",J=%FIRST,$G(@(%REFH1_"SH)"))?.P,SH=$O(@(%REFH1_"99999)"),-1) K @(%REFH1_"SH)") I '$D(%SC("ST")),$G(@$P(%MBG("O"),"\",J))?." ",$P(%MBG("OU"),"\",J)?.P,$P(%MBG("NEW"),"\",J)'?.P,%OLDTO'="END" D ER G LGR I $D(%SC("ER")) D ER K %SC G LGR D SETM I $D(%SC("ST")) K %SC G LGR NZ K %SC S:$G(%TO)="END"&(J>%FIRST) %TO="UP" I $G(%TO)="END",J=%FIRST G ZP I $G(%TO)="UP" G:J'>%FIRST UP S J=J-1 G:$P(%MBG("OU"),"\",J)?.P LGR G NZ ; ----------------------------------------- END OF INPUT COLUMN UP ; I $G(%TO)="UP",$D(%MBG("UPDOWN"))&(SCH'>%FIRSTL) D ENDP G L0 I $G(%TO)="UP" G:SCH=1 ZP D D CLOU G LOOP UPB .Q:SCH<2 S %YY=%YY-(2*STEP),SH=SH-2,SCH=SCH-2 .S SH=SH+1 S %NOMOD=$$NOMOD(SH) I %NOMOD=2 S %YY=%YY+STEP,SCH=SCH+1 G UPB .S SH=SH-1 I $G(%TO)="DW" D CLOU G LOOP PGUP ; I $G(%TO)="PGUP" D CLR G:NPG'>1 ML:'$D(%L3MBG),END S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="PGDW" D CLR S %ZBL=$S('$D(%L3MBG):"ML",1:"END") G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="ENDS" D CLR S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 INC S J=J+1 K %L1GET I J>COLG D CLOU G LOOP INC1 S %NOMOD=$$NOMOD(SH) I $P(%MBG("OU"),"\",J)'?.P S RKV=$P($G(@(%REFH1_"SH)")),RZD,J) D PGR G INC G LGR CLOU N JJ S %MBG("OU")=%MBGOU F JJ=1:1:COLG I $P(%MBG("NEW"),"\",JJ)'="Y" S $P(%MBG("NEW"),"\",JJ)="" I $D(%MBGSAVE),$D(@(%REFH1_"SH)"))#2 S ^mbg($P,SH)=@(%REFH1_"SH)"),^mbg($P)="" Q GET F JJ=1:1:COLG S @$P(%MBG("O"),"\",JJ)=$P($G(@(%REFH1_"SH)")),RZD,JJ) Q SETM ; N %GG,JJ S %GG=$G(@(%REFH1_"SH)")) I '$D(%SC("ER")),$G(%SC("ST"))'="ER" F JJ=1:1:COLG S $P(@(%REFH1_"SH)"),RZD,JJ)=$G(@$P(%MBG("O"),"\",JJ)) I $G(%NOMOD),$G(@(%REFH1_"SH)"))'=%GG S @(%REFH1_"SH)")=%GG D PL Q ZP D CLR K YOLD,SHOLD,SCHOLD S %SAY="" X %XMSGN S OTB="" D ZAPR G RSM:OTB="."!($G(%TO)="END"),BEG1 ; PL N Y1,X1,Y2,X2,%GG,XX0,%XX,%YY ; -- INPUT: SH,SCH,%YYYY S %GG=$G(@(%REFH1_"SH)")),I=SCH S Y1=VGR0,X1=%MBG("LL"),Y2=$G(%MBG("NGR"),24) S XX0=$G(%MBG("LR"),70),X2=XX0+1 S:XX0>79 XX0=79 S %XX=X1,%YY=%YYYY X %POSIC W $J("",X2-X1-1) D PG Q RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END K %L3MBG S mbgs=$O(^mbg0($P,9999999),-1)+1 S ^mbg($P)="",MAC1="^mbg($P)",MAC2="^mbg0($P,mbgs)" D ^%S1GC1 K ^mbg($P),^mbg0($P,mbgs-5) K ^mbg1($P) Q ; PS N SH,SCH,%YY,J,JJ,%OFF S SCH=0,SH=PG(NPG),%OFF=0 I $D(%SC("ENDS")),'$D(%L3MBG),'$D(%SC("VIEW")) Q D CLEAR F JJ=1:1:COLG D .I $P(%MBG("X"),"\",JJ)["+" S %OFF=1 X %LIGHT S %YY=VGR2 D P X %XCL Q ; P N I,%S,%L1DS,J,%GG,%SAY,%MBGLIGHT X %XCL F J=1:1:COLG D .N %SAY,%XX,%YY .S %XX=$P(%MBG("X"),"\",J) I %XX["+" W %LIGHT1 .S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG N ZT S ZT=$ZT N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":PZT^%L3MBG" F I=1:1:COLS Q:'$D(@(%REFH1_"SH-SCH+I)")) S %YY=%YY+STEP S %GG=$G(@(%REFH1_"SH-SCH+I)")) D PG PZT S $ZT=ZT S %SAY="" I '$D(%MBG("DELAS")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}/E{} dxey wegnl " I $D(%MBG("MOVE")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}INS{} qpkd {}TAB,TAB{} fifdl "_%SAY I $D(%MBG("MIUN")),'$D(%SC("VIEW")) S %SAY="{}F8{} oein/yetig "_%SAY ;;I %TYPCRT="PC" S %SAY="{}CTRL+G{} sxb "_%SAY I %SAY'="",'$D(%L1NMB("LINE")) S %SAY=%SAY_"++"_(Y2-1)_","_(%MBG("LR")-(%MBG("LR")-%MBG("LL")-$L($TR(%SAY,"{}",""))\2))_",HH++"_%BCG_",YF" X %XMSG Q PG N RKV,J,%NOMOD S %NOMOD=0 X %XCL ;---< INPUT - %GG,I > D NMB(I-SCH) S %NOMOD=$$NOMOD1(%GG) F J=1:1:COLG S RKV=$P(%GG,RZD,J) D PGR Q NMB(%OFS) N %XX S %XX=XX0-2 ;--- INPUT: XX0,X1,SH I $G(^SCR(%SCRN))="E" S %XX=X1 I %XX-$P(%MBG("X"),"\",1)>0 X %POSIC W %CLI W $J(SH+%OFS+$G(%MBG("OFF")),2) X %XCL Q PGR ; ------------------ INPUT - RKV,%YY N DL,%XX Q:$G(RKV)="" W:%TYPCRT["VT" *27,"(B" W:%NOMOD %CLI W:$D(%MBGLIGHT) %LIGHT1 ; %CLI S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) S %XX=$P(%MBG("X"),"\",J)-DL X %POSIC W:$P(%MBG("INV"),"\",J)'?.P %CLI I $P(%MBG("X"),"\",J)["+" S %YY=%YY+1 X %POSIC S %YY=%YY-1 X %LIGHT I $G(RKV)="" W $J("",DL) X %XCL Q I $P(%MBG("RGS"),"\",J)="HH" D X %XCL Q .N %X1,%Y1,%X2,%Y2,%S,%L1WH .S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1 .S %S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S .Q D .N RKV1 .I RKV="-" W $J("",DL\2-1)_"-" Q .I $P(%MBG("RGS"),"\",J)="H" D W $J($$^%L1HB(RKV1),DL) Q ..S RKV1="" ..I $L(RKV)>DL&($P(%MBG("D"),"\",J)["/") S RKV1="..."_$E(RKV,$L(RKV)-DL+4,255) Q ..S RKV1=RKV . .I '$P(%MBG("DR"),"\",J) W $J(RKV,DL) Q .W $J(RKV,DL,$P(%MBG("DR"),"\",J)) X %XCL Q CLEAR ;-- INPUT: X2,X1,VGR,Y2,NPG N %XX,%YY,I X %XCL I $D(%SCNC) F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) D RBUA ;Y1 --> VGR I '$D(%SCNC),'$D(%SC("NOCL")) D .I %TYPCRT["VT5" W $C(27,91),VGR+1,";",X1+1,";",Y2-1,";",X2-1,"$z" Q .F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W %chists .D RBUA S %SAY=NPG_" sc++"_(VGR0-1)_","_(X1+8)_",HH++"_%BCG_",YF" X %XMSG I '$D(%L3MBG),'$D(%SC("VIEW")) S %SAY=" dxfr++"_(VGR0-1)_","_(X2-2)_",HH++"_%BCG_",YF" X %XMSG Q NOMOD(SH) N %NOMOD S %NOMOD=$$NOMOD1($G(@(%REFH1_"SH)"))) Q %NOMOD NOMOD1(ST) ; N ST1 S ST1=$P(ST,RZD,$L(ST,RZD)) I $E(ST1,1,2)="@@" Q $S($E(ST1,3)="!":2,1:1) Q 0 ZAPR ; D ZAPR^%L3MBG2 Q ER ; X %XMSGV("ER") K %L1GET S %SC("ER")=1 S:$D(%MOLD) %S=%MOLD S:$G(%MODIF)>0 %MODIF=%MODIF-1 Q I $P(%MBG("NEW"),"\",J)'="Y" S $P(%MBG("NEW"),"\",J)="" S $P(@(%REFH1_"SH)"),RZD,J)=$G(%MOLD) I $G(%MODIF)>0 S %MODIF=%MODIF-1 Q DEL Q:$G(%NOMOD) D DEL^%L3MBG2 ; Q INIT D INIT^%L3MBG2 S %NOMOD=0 Q ENDF ; N I,JJ S JJ=0 F I=SH-SCH+1:1 Q:'$D(@(%REFH1_"I)")) D .S JJ=JJ+1 I JJ>COLS S NPG=NPG+1,PG(NPG)=I-1,JJ=1,%PS=1 S SHOLD=I S:SHOLD>0 SHOLD=SHOLD-1 I $G(%MBG("GWUL")),SHOLD'<%MBG("GWUL") S SHOLD=%MBG("GWUL")-1 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) K %SH00,%SCH00,%SCH00 Q ENDP ; N I,JJ S JJ=0 F I=SH-SCH+1:1:SH-SCH+COLS Q:'$D(@(%REFH1_"I)")) S JJ=JJ+1 S SHOLD=I-'$D(^(I)) S:SHOLD>0 SHOLD=SHOLD-1 S:SHOLD<0 SHOLD=0 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) Q POISK D POISK^%L3MBG2 G @%LAB RBUA W:%CVET %LIGHT1,%CV("CF") K %L1RBCL D ^%L1RBUA X %XCL Q CLR X %XCL K %SH00,%SCH00,%YY00 Q HELP ; D SAVE^%L3MBGG D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C .X "ZL %L3MBGH K ^TMPS111($J) N I F I=2:1 Q:$T(+I)="""" S ^TMPS111($J,I)=$T(+I)" S %S2V("LEFT")=5 X %chista W %CV("YF") D ^%S2VIEW D REST^%L3MBGG Q %L3MBG00 %L3MBG ; INPUT FROM DISPLAY [ 19.01.07 11:17 ] [ 18.10.06 13:27 ] [ 26.07.06 15:26 ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C ;;N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" N NPG,PG S NPG=1,PG(1)=0 G BEG VSV N %XX,%YY S %XX=%X000,%YY=%Y000 X %POSIC X %XCL X:$D(%PRPL) %LIGHT W:$G(%NOMOD) %CLI ;;W:$D(%MBGLIGHT) %CLI W:$D(%MBGLIGHT) %LIGHT1 I $P(%MBG("DR"),"\",J) W $J(%S,DL,$P(%MBG("DR"),"\",J)) G EV I $P(%MBG("RGS"),"\",J)="H" W $$HBR^%L1FRM($TR($TR(%S,%TES1,%TES2),%TEN,%THB),DL) G EV W $J(%S,DL) EV X %XCL Q BEG ; U $P:(NOECHO:NOWRAP) N %BE,%GG,%LS,%S,%SOLD,%X000,%Y000,%L1DS,%YY,%L3MBGST,%YYYY,%MSC,%SCHIP N %ENGSCR N DL,OLDDAT,XOLD,YOLD,SHOLD,SCHOLD N COLS,SH,SCH,%SH00,%SCH00,%YY00,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPGL,OTB,%PRNEW,RKV,RSCR,RZD,%REFH1 N STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2,%MBGOU,%MODIF,%ENDSS N %HBRY,%HIP S %MBGOU=$G(%MBG("OU")) S %L3MBGST="" K ^mbg1($P) BEG1 D INIT S %YY=VGR2 K %L3MBGST I ($G(%SC("VIEW"))="PGUP")!($G(%SC("VIEW"))="PGDW")!($E($G(%SC("VIEW")))=":")!$D(%SC("HIP")) G ZB D PS I $D(%SC("VIEW")) G ZB Q:$D(%L3MBG) G L0 ZB0 I %TO="PGDW" S %SAY=$S(%ENGLISH:"END OF DATA",1:" mipezp seq ") X %XMSGN(1) I %TO="PGUP" S %SAY=$S(%ENGLISH:"BEGIN OF DATA",1:" mipezp zligz ") X %XMSGN(1) G @%ZBL ZB S %ZBL="ZB" I $G(%SC("VIEW"))="PGUP"!($G(%SC("VIEW"))="PGDW") S %TO=%SC("VIEW"),%SC("VIEW")=1 G ZB1 I $E($G(%SC("VIEW")))=":" D K %SC("VIEW") G POISK .S %L3MBGHIP=$E(%SC("VIEW"),2,20) .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .S %SCHIP="" I $D(%SC("HIP"))#2 D K %SC("VIEW") G POISK .S %L3MBGHIP=$P(%SC("HIP"),":") .S %L3MBGHIP(1)="",%L3MBGHIP("=")="",J=1 .I $P(%SC("HIP"),":",2) S J=$P(%SC("HIP"),":",2) N %L1GET I %ENGLISH S %GET=" PAGE DOWN - , PAGE UP - , EXIT - " E S %GET=" - d`ivi , - mcew , - `ad sc " D N^%L1GET I %TO="END" G END ZB1 I %TO="PGUP" G:NPG'>1 ZB0 S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I %TO="PGDW" G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 W *7 G ZB ; L0 S:$D(YOLD) %YY=YOLD S:$D(SHOLD) SH=SHOLD S:$D(SCHOLD) SCH=SCHOLD I $D(%SC("ENDS")) S NPGOLD=NPG D ENDF S %PS=1 S:$D(%SC("ENDS","NOPS")) %PS=0 S:$G(%SC("ENDS"))'?.P %ENDSS=%SC("ENDS") K %SC("ENDS") G:NPG'=NPGOLD BEG1 D:%PS PS G L0 LOOP ; -------------------------------- NEW LINE K YOLD,SHOLD,SCHOLD,%MBG("TO"),%SC,%MODIF X %XCL F JJ=1:1 Q:'$D(@(%REFH1_"SH-SCH+JJ)")) I $G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %FIRSTL=JJ F JJ=COLS:-1:1 I $D(@(%REFH1_"SH-SCH+JJ)")),$G(^(SH-SCH+JJ))'[(RZD_"@@!") Q S %LASTL=JJ LOOP1 ; K %INV S SH=SH+1,SCH=SCH+1 K %PRX I $D(%MBG("GWUL")),SH>%MBG("GWUL") W *7 G ZP ;RSM I %YY+STEP>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP I $D(%MBG("LINE")),$G(%SH00),$G(%YY00),$G(%SCH00) D .N %YY,%YYYY,SH,SCH K %MBGLIGHT S %YYYY=%YY00,SH=%SH00,SCH=%SCH00 D PL S %YY=%YY+STEP,$Y=%YY,%YYYY=%YY S %SH00=SH,%SCH00=SCH,%YY00=%YY I $$NOMOD(SH)=2 G LOOP1 I $D(%MBG("LINE")) D .S %MBGLIGHT="" D PL K %PRPL,%X000,%Y000 ML ; S %NOMOD=$$NOMOD(SH) F JJ=1:1 Q:$P(%MBG("OU"),"\",JJ)?.P S %FIRST=JJ K JJ,%PRX I %YY>(STEP*COLS+VGR2)!(%YY>23) S:%YY>23 %YY=23 S %PRX="" G ZP S J=0 D NMB(0) I $D(XOLD) S J=XOLD K XOLD G LGR G INC ;------------------------------------ NEW COLUMN LGR K %TO,%OLDTO,%FLL,%S,%L1DS,%SC S %TO="",%OLDTO="" D GET S %SAY=$P(%MBG("H"),"\",J) S %SAY=" "_$P(%SAY,"++") X "S A=1" I J'=$G(^mbg1($P,"H")) X %XMSGN S ^mbg1($P,"H")=J I $P(%MBG("H"),"\",J)?.P,$P(%MBG("GLOB"),"\",J)?."^"1A.E S %SAY=" - dbvd , - my zlgzd itl yetig " X %XMSGN I $D(^SCR(%SCRN,"G",J,"MUMPS1")) D S %YY=%YYYY G:$P(%MBG("OU"),"\",J)'?.P INC .N SHOLD,JOLD,SCHOLD .S SHOLD=SH,JOLD=J,SCHOLD=SCH .N SH,SCH,J S J=JOLD,SH=SHOLD,SCH=SCHOLD .X ^SCR(%SCRN,"G",J,"MUMPS1") .I $$HZGTOUCH^%L2MOUSE,'$D(%L1NMB),$$KB^%L2MOUSE S %L1NMB("LINE")="" ;---------------------------------------- PARAMETRIM HACNASA LGR1 S %XX=$P(%MBG("X"),"\",J) I $P(%MBG("OU"),"\",J)?.P,J'=$G(^mbg1($P,"Z")) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH,I" X %XMSG S %XX=$P(%MBG("X"),"\",J) S ^mbg1($P,"Z")=J S %YY=%YYYY,$Y=%YY I %XX["+" S %YY=%YY+1,$Y=$Y+1,%PRPL="" X %LIGHT X %POSIC S %LS=$P(%MBG("D"),"\",J),%FL="" ;;S %S=$$SPA^%L1FRM($G(@$P(%MBG("O"),"\",J))) S %INV="" S (%MOLD,%S)=$G(@$P(%MBG("O"),"\",J)) S %INV="" I $D(%ENDSS),J=%FIRST S %S=%ENDSS S CIST=$P(%MBG("S"),"\",J) K:CIST="" CIST S %PRNEW=0 ;;I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" ;---------------------------------------- HACNASA I $P(%MBG("RGS"),"\",J)="E" D .I $D(%MBG("=")) S %ZMSL=$G(%ZMSL)_"=" .S:'$G(%ENGSCR) %XX=%XX-%LS X %POSIC S:%XX<0 %XX=0 S $X=%XX .I $$HZGTOUCH^%L2MOUSE S %ZMSL("NMB")=1 .S %FL="" K %BE S %ZMSF="" S:$D(%ENDSS) %BE="E" K:'$D(%BE) %FLINS N %HBRY D ^%ZMSL K %INV,%GET,%ENDSS I %S["=="!(%TO="END")!(%TO="=") S %S=%MOLD Q .I $P(%MBG("DR"),"\",J),%S'["%" S %S=$J(%S,$P(%MBG("DR"),"\",J)+1,$P(%MBG("DR"),"\",J)) ; I $P(%MBG("RGS"),"\",J)="H" S $X=%XX-1 D ^%L1ZMS ; I $P(%MBG("RGS"),"\",J)="HH" D .N %X1,%Y1,%X2,%Y2 .S %X1=%XX-%LS,%X2=%XX-1,%Y1=%YY,%Y2=%Y1+STEP-1,%LS=%LS*STEP D ^%L1WH .S %L1WH="" K %INV D ^%L1WH K %L1WH .Q ; I $P(%MBG("RGS"),"\",J)="D" S:'$G(%ENGSCR) %XX=%XX-8 S $X=%XX S %L1DS=$TR(%S,"/.:","") D ^%L1DAT S %S=%L1DAT1 ; LGR --> SET ; I $P(%MBG("RGS"),"\",J)="T" S:'$G(%ENGSCR) %XX=%XX-5 S $X=%XX S %L1TS=$TR(%S,":/.","") D ^%L1TIME S %S=%L1TIME1 ; LGR --> SET ; K %ENDSS S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) ;*** S %XX=$P(%MBG("X"),"\",J)-$S($G(%ENGSCR):0,1:DL) I $P(%MBG("OU"),"\",J)?.P D .I $P(%MBG("X"),"\",J)["+" W %LIGHT1 .N %XX,%YY S %XX=$P(%MBG("X"),"\",J) S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG ; ;----------------------------------------- VIHOD I $D(%SCHIP) S %S=%MOLD,%MBG("NOZAPR")=1 I %TO="HELP" D HELP S %SC("ST")=1,%TO="" G NAZAD I $G(%TO)="DEL",'$D(%MBG("DELAS")),$D(@(%REFH1_"SH)")),'$G(%NOMOD) D DEL G:%TO'="PGUP" BEG1 G PGUP I %S["==",%MBG("O")?.P S %TO="END",%S="" K %TOEQ I $G(%TO)="=",$D(%MBG("=")) S %TO="END",%TOEQ="" S %X000=%XX,%Y000=%YY D VSV I '$G(%MODIF) S J=%FIRST G NZ I $P(%MBG("D"),"\",J)[".",+%S,$P(%MBG("RGS"),"\",J)="E" S %S=$TR($J(%S,DL)," ",0) S %X000=%XX,%Y000=%YY I $P(%MBG("RGS"),"\",J)'="HH" D VSV X %XCL ;;S %MOLD=$$SPL^%L1FRM($P($G(@(%REFH1_"SH)")),RZD,J)) I $P(%MBG("DR"),"\",J),$P(%MBG("OU"),"\",J)="!",%TO="" S $P(@(%REFH1_"SH)"),RZD,J)=%S G MUST I $P(%MBG("DR"),"\",J),%NOMOD,+%MOLD'=+%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR I '$P(%MBG("DR"),"\",J),%NOMOD,%MOLD'=%S S %SAY=" ! iepiyl ozip `l " X %XMSGV(1) S %S=%MOLD,%MODIF=0 G LGR MUST I $G(@$P(%MBG("O"),"\",J))'=%S!($P(%MBG("NEW"),"\",J)'?.P) S %PRNEW=1 S @$P(%MBG("O"),"\",J)=%S S %YY=%YYYY,$Y=%YY S %SOLD=%S I $P(%MBG("RGS"),"\",J)="D",$TR(%S,"/.")=$TR(%MOLD,"./") G TOUP I $P(%MBG("RGS"),"\",J)="T",+$TR(%S,"/.:")=+$TR(%MOLD,"./:") G TOUP I %S'=%MOLD,$P(%MBG("DR"),"\",J)="" S %MODIF=$G(%MODIF)+1 I $P(%MBG("DR"),"\",J)'="",$J(%S,0,$P(%MBG("DR"),"\",J))'=$J(%MOLD,0,$P(%MBG("DR"),"\",J)) S %MODIF=$G(%MODIF)+1 I SH>$O(@(%REFH1_"999999)"),-1) D .N JJ,ZN S %MODIF=0 F JJ=1:1:$L(%MBG("O"),"\") S ZN=$G(@$P(%MBG("O"),"\",J)) I ZN'="" S %MODIF=1 ; TOUP I %TO="UP",'$G(%MODIF) G UP I %TO="ESC",'$G(%MODIF) G NZ S %CMD=0 F JJ=1:1:COLG D Q:%CMD .I $D(^SCR(%SCRN,"G",JJ,"MUMPS1")),^("MUMPS1")'?.P S %CMD=1 Q .I $D(^SCR(%SCRN,"G",JJ,"MUMPS2")),^("MUMPS2")'?.P S %CMD=1 Q G:'%CMD BDTO I $G(%MODIF),%TO="F8"&($P($G(%MBG("FNC")),"\",J)'[%TO)!(%TO="PGUP")!(%TO="PGDW")!(%TO="BEGF")!(%TO="ENDS") S %TO="" I $G(%MODIF) I (%TO="UP"!(%TO="END"))&(J=%FIRST)!(%TO="DW")!(%TO="HOME") S %TO="" BDTO I $G(%TO)="F8",$P(%MBG("FNC"),"\",J)'[%TO G POISK I $G(%TO)="PGUP" G PGUP ;---------------------- MOVE I %TO="TAB" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'<$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="TAB",$D(%MBG("MOVE")) D D PS G LOOP .N %ST S %ST=$G(@(%REFH1_"SH+1)")) .S @(%REFH1_"SH+1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST ; I %TO="TABN" I $D(%MBG("MOVE")),$$NOMOD(SH)!(SH'>1) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="TABN",$D(%MBG("MOVE")),'$$NOMOD(SH),SH>1 D D PS S %TO="UP" G UP .N %ST S %ST=$G(@(%REFH1_"SH-1)")) .S @(%REFH1_"SH-1)")=$G(@(%REFH1_"SH)")) .S @(%REFH1_"SH)")=%ST S SHOLD=SH-1,SCHOLD=SCH-1,YOLD=%YY-1 ; I %TO="INS" I $G(%MODIF)!'$D(%MBG("MOVE"))!$$NOMOD(SH)!(SH>$O(@(%REFH1_"99999)"),-1)) S %OLDTO="",%SC("ST")=1 G NAZAD I %TO="INS" D D PS G LOOP1 .N %SHLAST S %SHLAST=$O(@(%REFH1_"99999)"),-1)+1 .N %I,%ST F %I=%SHLAST:-1:SH+1 S %ST=@(%REFH1_"%I-1)") S @(%REFH1_"%I)")=%ST .S @(%REFH1_"SH)")="" .S %MODIF=$G(%MODIF)+120 .S %YY=%YY-STEP,SH=SH-1,SCH=SCH-1 ; ;;I %TO="DBL" D D PS G L0 .N %SHEND,%G .S %SHEND=$ZP(@(%REFH1_"99999)"))+1 Q:%SHEND>%MBG("GWUL") .S MAC1=%REFH1_"SH)",MAC2=%REFH1_%SHEND_")",%S1GC("R")=RZD_"@@" D ^%S1GC1 .S YOLD=%YY,SHOLD=SH,SCHOLD=SCH ; I %TO="DBL" D G NAZAD .D ..N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%SCRN) D ^%L1C ..D MENU^%L3MBGR(%SCRN) .N %NOVIDEO S %NOVIDEO="" D REST^%L3MBGG .S %TO="",%SC("ST")=1 I %TO="F3",'$D(%MBG("NODBL")),SH>1 S @$P(%MBG("O"),"\",J)=$P(@(%REFH1_"SH-1)"),RZD,J) G LGR1 I $G(%TO)="BEGF" S NPG=1 K SHOLD,SCHOLD,YOLD G BEG1 I $G(%TO)="ENDS" S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 I %TO="",$G(%NOMOD),$P(%MBG("OU"),"\",J)'="!" S %TO="DW" I %TO="HOME" D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) ;;I %TO="DW",J=%FIRST,SCH=%LASTL,$D(%MBG("UPDOWN")) D G L0 .S SHOLD=SH-SCH .S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) S %OLDTO=%TO I %TO="DW",J=%FIRST S %TO="" I '$G(%MODIF),%MOLD'?.P!($P(%MBG("NEW"),RZD,J)?.P&($G(^SCR(%SCRN,"G",J,"MUMPS2"))?.P)) D CLOU G LOOP K %L1SCBEG ;*** LEV 010495 S %NOMOD=$$NOMOD(SH) I %NOMOD G IBUD I $P(%MBG("GLOB"),"\",J)?."^"1A.E,%TO="" D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;I $P(%MBG("GLOB"),"\",J)?."^"1U.E,%TO="F6"!(%TO="F7"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S %TO="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV I $P(%MBG("GLOB"),"\",J)?."^"1A.E,(%TO="F7")!(%TO="F6"),$P(%MBG("FNC"),"\",J)'[%TO D ^%L3MBGG S (%TO,%OLDTO)="" G:$D(%SC("ER"))!$D(%SC("ST")) NAZAD S:%MOLD'=@$P(%MBG("O"),"\",J) %MODIF=$G(%MODIF)+1 D VSV ;D SETM D VSV IBUD ; I $D(^SCR(%SCRN,"G",J,"MUMPS2")),^("MUMPS2")'?.P S JOLD=J D S %S=$G(@$P(%MBG("O"),"\",J)) G:$D(%SC("ER")) NAZAD D:%S'=$G(%SOLD) VSV D SETM D:$G(%SC("TO"))="PL" PL G:$G(%SC("TO"))'="P" NAZAD D PS G NAZAD .N %FIRSTOLD .S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH D ..N JOLD,YOLD,XOLD,SHOLD,SCHOLD ..S JOLD=J,YOLD=%YY,XOLD=%XX,SHOLD=SH,SCHOLD=SCH,%FIRSTOLD=%FIRST N %FIRST ..K %SC X ^SCR(%SCRN,"G",J,"MUMPS2") .S J=JOLD,%YY=YOLD,%XX=XOLD,SH=SHOLD,SCH=SCHOLD S:$G(%FIRSTOLD) %FIRST=%FIRSTOLD K XOLD,YOLD,SHOLD,SCHOLD .Q SET ; NAZAD ; I $D(%L3MBGHIP) G POISK I $D(%SC("END")),J=%FIRST,'$G(%MODIF) G RSM ;;I $D(%OLDTO),(%OLDTO="END")&(COLG>1)!(%OLDTO="UP")!(%OLDTO="PGDW")!(%OLDTO="ENDS") S %TO=%OLDTO,%OLDTO="" G NZ I $D(%OLDTO),'$G(%MODIF),%OLDTO="END"!(%OLDTO="PGDW")!(%OLDTO="ENDS")!(%OLDTO="UP") S %TO=%OLDTO,%OLDTO="" D G NZ .I $G(@$P(%MBG("O"),"\",J))?." ",J=%FIRST,$G(@(%REFH1_"SH)"))?.P,SH=$O(@(%REFH1_"99999)"),-1) K @(%REFH1_"SH)") I '$D(%SC("ST")),$G(@$P(%MBG("O"),"\",J))?." ",$P(%MBG("OU"),"\",J)?.P,$P(%MBG("NEW"),"\",J)'?.P,%OLDTO'="END" D ER G LGR I $D(%SC("ER")) D ER K %SC G LGR D SETM I $D(%SC("ST")) K %SC G LGR NZ K %SC S:$G(%TO)="END"&(J>%FIRST) %TO="UP" I $G(%TO)="END",J=%FIRST G ZP I $G(%TO)="UP" G:J'>%FIRST UP S J=J-1 G:$P(%MBG("OU"),"\",J)?.P LGR G NZ ; ----------------------------------------- END OF INPUT COLUMN UP ; I $G(%TO)="UP",$D(%MBG("UPDOWN"))&(SCH'>%FIRSTL) D ENDP G L0 I $G(%TO)="UP" G:SCH=1 ZP D D CLOU G LOOP UPB .Q:SCH<2 S %YY=%YY-(2*STEP),SH=SH-2,SCH=SCH-2 .S SH=SH+1 S %NOMOD=$$NOMOD(SH) I %NOMOD=2 S %YY=%YY+STEP,SCH=SCH+1 G UPB .S SH=SH-1 I $G(%TO)="DW" D CLOU G LOOP PGUP ; I $G(%TO)="PGUP" D CLR G:NPG'>1 ML:'$D(%L3MBG),END S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="PGDW" D CLR S %ZBL=$S('$D(%L3MBG):"ML",1:"END") G:'$D(@(%REFH1_"SH-SCH+COLS)")) ZB0 S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG1 I $G(%TO)="ENDS" D CLR S NPGOLD=NPG D ENDF G:NPG'=NPGOLD BEG1 G L0 INC S J=J+1 K %L1GET I J>COLG D CLOU G LOOP INC1 S %NOMOD=$$NOMOD(SH) I $P(%MBG("OU"),"\",J)'?.P S RKV=$P($G(@(%REFH1_"SH)")),RZD,J) D PGR G INC G LGR CLOU N JJ S %MBG("OU")=%MBGOU F JJ=1:1:COLG I $P(%MBG("NEW"),"\",JJ)'="Y" S $P(%MBG("NEW"),"\",JJ)="" I $D(%MBGSAVE),$D(@(%REFH1_"SH)"))#2 S ^mbg($P,SH)=@(%REFH1_"SH)"),^mbg($P)="" Q GET F JJ=1:1:COLG S @$P(%MBG("O"),"\",JJ)=$P($G(@(%REFH1_"SH)")),RZD,JJ) Q SETM ; N %GG,JJ S %GG=$G(@(%REFH1_"SH)")) I '$D(%SC("ER")),$G(%SC("ST"))'="ER" F JJ=1:1:COLG S $P(@(%REFH1_"SH)"),RZD,JJ)=$G(@$P(%MBG("O"),"\",JJ)) I $G(%NOMOD),$G(@(%REFH1_"SH)"))'=%GG S @(%REFH1_"SH)")=%GG D PL Q ZP D CLR K YOLD,SHOLD,SCHOLD S %SAY="" X %XMSGN S OTB="" D ZAPR G RSM:OTB="."!($G(%TO)="END"),BEG1 ; PL N Y1,X1,Y2,X2,%GG,XX0,%XX,%YY ; -- INPUT: SH,SCH,%YYYY S %GG=$G(@(%REFH1_"SH)")),I=SCH S Y1=VGR0,X1=%MBG("LL"),Y2=$G(%MBG("NGR"),24) S XX0=$G(%MBG("LR"),70),X2=XX0+1 S:XX0>79 XX0=79 S %XX=X1,%YY=%YYYY X %POSIC W $J("",X2-X1-1) D PG Q RSM ; I $D(%MBG("RSM")) D @%MBG("RSM") END K %L3MBG S mbgs=$O(^mbg0($P,9999999),-1)+1 S ^mbg($P)="",MAC1="^mbg($P)",MAC2="^mbg0($P,mbgs)" D ^%S1GC1 K ^mbg($P),^mbg0($P,mbgs-5) K ^mbg1($P) Q ; PS N SH,SCH,%YY,J,JJ,%OFF S SCH=0,SH=PG(NPG),%OFF=0 I $D(%SC("ENDS")),'$D(%L3MBG),'$D(%SC("VIEW")) Q D CLEAR F JJ=1:1:COLG D .I $P(%MBG("X"),"\",JJ)["+" S %OFF=1 X %LIGHT S %YY=VGR2 D P X %XCL Q ; P N I,%S,%L1DS,J,%GG,%SAY,%MBGLIGHT X %XCL F J=1:1:COLG D .N %SAY,%XX,%YY .S %XX=$P(%MBG("X"),"\",J) I %XX["+" W %LIGHT1 .S %SAY=$P(%MBG("Z"),"\",J)_"++"_(VGR0+(%XX["+"))_","_%XX_",HH" X %XMSG N ZT S ZT=$ZT N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":PZT^%L3MBG" F I=1:1:COLS Q:'$D(@(%REFH1_"SH-SCH+I)")) S %YY=%YY+STEP S %GG=$G(@(%REFH1_"SH-SCH+I)")) D PG PZT S $ZT=ZT S %SAY="" I '$D(%MBG("DELAS")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}/E{} dxey wegnl " I $D(%MBG("MOVE")),'$D(%L3MBG),'$D(%SC("VIEW")) S %SAY="{}INS{} qpkd {}TAB,TAB{} fifdl "_%SAY I $D(%MBG("MIUN")),'$D(%SC("VIEW")) S %SAY="{}F8{} oein/yetig "_%SAY ;;I %TYPCRT="PC" S %SAY="{}CTRL+G{} sxb "_%SAY I %SAY'="",'$D(%L1NMB("LINE")) S %SAY=%SAY_"++"_(Y2-1)_","_(%MBG("LR")-(%MBG("LR")-%MBG("LL")-$L($TR(%SAY,"{}",""))\2))_",HH++"_%BCG_",YF" X %XMSG Q PG N RKV,J,%NOMOD S %NOMOD=0 X %XCL ;---< INPUT - %GG,I > D NMB(I-SCH) S %NOMOD=$$NOMOD1(%GG) F J=1:1:COLG S RKV=$P(%GG,RZD,J) D PGR Q NMB(%OFS) N %XX S %XX=XX0-2 ;--- INPUT: XX0,X1,SH I $G(^SCR(%SCRN))="E" S %XX=X1 I %XX-$P(%MBG("X"),"\",1)>0 X %POSIC W %CLI W $J(SH+%OFS+$G(%MBG("OFF")),2) X %XCL Q PGR ; ------------------ INPUT - RKV,%YY N DL,%XX Q:$G(RKV)="" W:%TYPCRT["VT" *27,"(B" W:%NOMOD %CLI W:$D(%MBGLIGHT) %LIGHT1 ; %CLI S DL=$S($P(%MBG("RGS"),"\",J)="D":8,1:+$P(%MBG("D"),"\",J)) S %XX=$P(%MBG("X"),"\",J)-$S($G(%ENGSCR):0,1:DL) X %POSIC W:$P(%MBG("INV"),"\",J)'?.P %CLI I $P(%MBG("X"),"\",J)["+" S %YY=%YY+1 X %POSIC S %YY=%YY-1 X %LIGHT I $G(RKV)="" W $J("",DL) X %XCL Q I $P(%MBG("RGS"),"\",J)="HH" D X %XCL Q .N %X1,%Y1,%X2,%Y2,%S,%L1WH .S %X1=%XX,%X2=%XX+DL-1,%Y1=%YY,%Y2=%Y1+STEP-1 .S %S=RKV S %L1WH="" D ^%L1WH K %L1WH,%S .Q D .N RKV1 .I RKV="-" W $J("",DL\2-1)_"-" Q .I $P(%MBG("RGS"),"\",J)="H" D W $J($$^%L1HB(RKV1),DL) Q ..S RKV1="" ..I $L(RKV)>DL&($P(%MBG("D"),"\",J)["/") S RKV1="..."_$E(RKV,$L(RKV)-DL+4,255) Q ..S RKV1=RKV . .I '$P(%MBG("DR"),"\",J) W $J(RKV,DL) Q .W $J(RKV,DL,$P(%MBG("DR"),"\",J)) X %XCL Q CLEAR ;-- INPUT: X2,X1,VGR,Y2,NPG N %XX,%YY,I X %XCL I $D(%SCNC) F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) D RBUA ;Y1 --> VGR I '$D(%SCNC),'$D(%SC("NOCL")) D .I %TYPCRT["VT5" W $C(27,91),VGR+1,";",X1+1,";",Y2-1,";",X2-1,"$z" Q .F I=VGR:1:Y2-2 S %XX=X1,%YY=I X %POSIC W %chists .D RBUA S %SAY=NPG_" sc++"_(VGR0-1)_","_(X1+8)_",HH++"_%BCG_",YF" X %XMSG I '$D(%L3MBG),'$D(%SC("VIEW")) S %SAY=" dxfr++"_(VGR0-1)_","_(X2-2)_",HH++"_%BCG_",YF" X %XMSG Q NOMOD(SH) N %NOMOD S %NOMOD=$$NOMOD1($G(@(%REFH1_"SH)"))) Q %NOMOD NOMOD1(ST) ; N ST1 S ST1=$P(ST,RZD,$L(ST,RZD)) I $E(ST1,1,2)="@@" Q $S($E(ST1,3)="!":2,1:1) Q 0 ZAPR ; D ZAPR^%L3MBG2 Q ER ; X %XMSGV("ER") K %L1GET S %SC("ER")=1 S:$D(%MOLD) %S=%MOLD S:$G(%MODIF)>0 %MODIF=%MODIF-1 Q I $P(%MBG("NEW"),"\",J)'="Y" S $P(%MBG("NEW"),"\",J)="" S $P(@(%REFH1_"SH)"),RZD,J)=$G(%MOLD) I $G(%MODIF)>0 S %MODIF=%MODIF-1 Q DEL Q:$G(%NOMOD) D DEL^%L3MBG2 ; Q INIT D INIT^%L3MBG2 S %NOMOD=0 Q ENDF ; N I,JJ S JJ=0 F I=SH-SCH+1:1 Q:'$D(@(%REFH1_"I)")) D .S JJ=JJ+1 I JJ>COLS S NPG=NPG+1,PG(NPG)=I-1,JJ=1,%PS=1 S SHOLD=I S:SHOLD>0 SHOLD=SHOLD-1 I $G(%MBG("GWUL")),SHOLD'<%MBG("GWUL") S SHOLD=%MBG("GWUL")-1 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) K %SH00,%SCH00,%SCH00 Q ENDP ; N I,JJ S JJ=0 F I=SH-SCH+1:1:SH-SCH+COLS Q:'$D(@(%REFH1_"I)")) S JJ=JJ+1 S SHOLD=I-'$D(^(I)) S:SHOLD>0 SHOLD=SHOLD-1 S:SHOLD<0 SHOLD=0 S SCHOLD=SHOLD-PG(NPG),YOLD=VGR+((SCHOLD-1)*STEP) Q POISK D POISK^%L3MBG2 G @%LAB RBUA W:%CVET %LIGHT1,%CV("CF") K %L1RBCL D ^%L1RBUA X %XCL Q CLR X %XCL K %SH00,%SCH00,%YY00 Q HELP ; D SAVE^%L3MBGG D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C .X "ZL %L3MBGH K ^TMPS111($J) N I F I=2:1 Q:$T(+I)="""" S ^TMPS111($J,I)=$T(+I)" S %S2V("LEFT")=5 X %chista W %CV("YF") D ^%S2VIEW D REST^%L3MBGG Q %L3MBG1 %L3MBG1 ; INIT07/14/91 12:05 PM ] [ 08/18/2000 8:07 AM ] [ 07/23/93 11:27 AM ] N J,ZAPR I '$D(%MBG("LL")) S %MBG("LL")=78 I '$D(%MBG("LR")) S %MBG("LR")=0 F J=1:1 Q:'$D(%MBG("PAR",J)) S ZAPR=$P(%MBG("PAR",J),"#") D .S $P(%MBG("Z"),"\",J)=$P(ZAPR,";",2) .S $P(%MBG("X"),"\",J)=$P(ZAPR,";",3) .S $P(%MBG("INV"),"\",J)=$P($P(ZAPR,";",3),",",3) .I $P(%MBG("X"),"\",J)>%MBG("LR") S %MBG("LR")=$P(%MBG("X"),"\",J) .I $P(%MBG("X"),"\",J)<%MBG("LL") S %MBG("LL")=$P(%MBG("X"),"\",J) .S $P(%MBG("D"),"\",J)=$P($P(ZAPR,";",4),",") .S $P(%MBG("DR"),"\",J)=$P($P(ZAPR,";",4),",",2) .S %MAXD=$S($L($P(%MBG("Z"),"\",J))>$P(%MBG("D"),"\",J):$L($P(%MBG("Z"),"\",J)),1:$P(%MBG("D"),"\",J)) .I $P(%MBG("X"),"\",J)-%MAXD<%MBG("LL") S %MBG("LL")=$P(%MBG("X"),"\",J)-%MAXD .S $P(%MBG("RGS"),"\",J)=$P(ZAPR,";",5) .S $P(%MBG("S"),"\",J)=$P(ZAPR,";",6) .S $P(%MBG("H"),"\",J)=$P(%MBG("PAR",J),"#",4) .S %MBGD=$P(%MBG("PAR",J),"#",2) I $E(%MBGD)="@" S $P(%MBG("DO"),"\",J)=$E(%MBGD,2,255) K %MBGD .;S $P(%MBG("C"),"\",J)=$P(%MBG("PAR",J),"#",3) I $P(%MBG("C"),"\",J)="" K $P(%MBG("C"),"\",J) S %MBG("COLG")=J-1 S:%MBG("LR")>80 %MBG("LR")=80 S:%MBG("LL")<0 %MBG("LL")=0 K %MBG("PAR") Q %L3MBG2 %L3MBG2 ; [ 19.01.07 10:51 ] [ 09.12.06 14:00 ] [ 28.11.06 15:55 ] ZAPR ; N %GET S %GET(1)="",%TO="",^mbg($P)=2 S %ZMSL="=" I $D(%MBG("=")),$D(%TOEQ) S OTB=".",%TO="" K %TOEQ Q ;;I $$HZGTOUCH^%L2MOUSE S %MBG("NOZAPR")=1 I $G(%MBG("NOZAPR")) S OTB=".",%TO="" Q I %ENGLISH S %GET=" PAGE UP - <0>, CORRECT - <1>, NEXT PAGE - , EXIT - " I '%ENGLISH,$$HZGTOUCH^%L2MOUSE S %GET=" {}ESC{} - miiql , {}1{} - owzl, {}ENTER{} `ad jqn, {}0{} - mcew jqn" I '%ENGLISH,'$$HZGTOUCH^%L2MOUSE S %GET=" {}ENTER{} - `ad jqn , {}ESC{} - miiql , {}1{} - owzl, {}0{} - mcew jqn" I '$$HZGTOUCH^%L2MOUSE D N^%L1GET I $$HZGTOUCH^%L2MOUSE D .N %GETIN S %GETIN=$S($D(%PRX):"ENTER",1:"ESC") K %PRX .S %S="" D HZG^P1HZGKEY(%GET) .I %TO S %S=%TO .I %TO="F10" S %S=0,%TO="" Q .I %TO="F1" S %S=1,%TO="" Q .I %TO="ENTER" S %S="",%TO="" Q .I %TO="" S %S="" X %XCL I %TO="=" S %TO="END" S OTB=$G(%S) I %TO="UP",OTB="" S OTB=1,%TO="" I %TO="DW" S %TO="" I %TO="END" S OTB="" I %TO="END",$D(%MBG("ENDPAGE")),$D(@(%REFH1_"SH-SCH+COLS)")),SH-SCH+COLS+1'>%MBG("GWUL") S %TO="",OTB="" I %TO="END" S OTB=".",%TO="" I OTB=0!($G(%TO)="PGUP") Q:NPG'>1 S NPG=NPG-1 Q I OTB="",'$D(@(%REFH1_"SH-SCH+COLS)")) W *7 D ER G ZAPR I OTB="",SH-SCH+COLS+1>%MBG("GWUL") W *7 D ER G ZAPR I OTB="" S NPG=NPG+1,PG(NPG)=SH-SCH+COLS Q S:OTB="/"!(OTB="u") OTB="." I OTB'="."&(OTB'=1) W *7,*7 H 1 G ZAPR Q ER ; X %XMSGV("ER") K %L1GET Q DEL ; K %L1DS,%SC("NODEL") I $D(%MBG("DELUS")) X %MBG("DELUS") E Q Q:$D(%SC("NODEL")) G DEL1 DELS(SH) ; DEL1 ; K YOLD,SHOLD,SCHOLD,SH0 N %II,%I1,%JJ S SH0=SH F %II=SH:1 Q:'$D(@(%REFH1_"%II+1)")) D .S MAC1=%REFH1_(%II+1)_")" .K @(%REFH1_"%II)") .S MAC2=%REFH1_%II_")" .D ^%S1GC1 K @(%REFH1_"%II)") F %I1=1:1 Q:'$D(PG(%I1)) S NPGL=%I1 I PG(NPGL)=(%II-1),NPGL>1 K PG(NPGL) S %LASTSH=0 I %II=SH S %LASTSH=1 I %II=SH,SCH=1,SH>1 S SCHOLD=COLS-1,SHOLD=SH-2,YOLD=STEP*(COLS-1)+VGR S %TO="PGUP" G EDEL I %II=SH,SCH>1 S SCHOLD=SCH-2,SHOLD=SH-2,YOLD=STEP*SCHOLD+VGR-STEP,SH=SH-1,SCH=SCH-1 D G EDEL .F JJ=1:1:COLG S @$P(%MBG("O"),"\",JJ)=$P($G(@(%REFH1_"SH-1)")),RZD,JJ) K %MODIF I SH>1 S SHOLD=SH-1 I SCH>1 S SCHOLD=SCH-1 I %YY+1>(VGR+STEP) S YOLD=%YY-STEP EDEL I $D(%MBG("DEL")) X %MBG("DEL") Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") I $D(%MBG("PAR"))>9 D ^%L3MBG1 S:'$D(%MBG("OU")) %MBG("OU")="" S %HBRY="" N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":^%ET" S %ENGSCR=0 I %ENGLISH S %ENGSCR=1 S %BCG="CB" I %TYPCRT["VT" S %BCG="BB" S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=%MBG("LL"),Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR"),70),X2=XX0+1 S:XX0>79 XX0=79 ;;I $G(^SCR(%SCRN))="E" S X1=X1+1,X2=X2+1 S STEP=$G(%MBG("STEP"),1) I STEP'>0 S STEP=1 S RSCR=Y2-VGR-1 ;-STEP ;2 I $$HZGTOUCH^%L2MOUSE,Y2>21 S RSCR=RSCR-(Y2-21) S VGR2=VGR-STEP ;S COLS=RSCR\STEP+(STEP>1),SCH=0,SH=PG(NPG) S COLS=RSCR\STEP,SCH=0,SH=PG(NPG) S %REFH1=$G(%MBG("REF"),"^MBG($P") I %REFH1["(",$E(%REFH1,$L(%REFH1))'="," S %REFH1=%REFH1_"," I %REFH1'["(" S %REFH1=%REFH1_"(" I $D(%MBGSAVE),$D(^mbg($P))>9,$G(^mbg($P))'=2,'$D(%L3MBG),$D(%L3MBGST) D .S ^mbg($P)=2 .F S %GET=" 0 - ieaib uaew wegnl , 2 - xfgyl `l ,1 - ieaib uaewn mipezp xfgyl" D N^%L1GET Q:"012"[%S&($L(%S)=1) W *7 .I %S=0 K ^mbg($P) Q .I %S=1 N MAC1,MAC2 S MAC1="^mbg($P)",MAC2=$E(%REFH1,1,$L(%REFH1)-1)_")" D ^%S1GC1 N %SC D PS^%L3MBG Q POISK ; ;--- %L3MBGHIP - STRING LE HIPUS ; %L3MBGHIP("H") - HEBREW TEXT ; %L3MBGHIP("1") - HIPUS MI HATHALA ; %L3MBGHIP("=") - HIPUS MEDUJAK ; J - MISP AMUD LE HIPUS N GRF,I,I1,II,JJ,JPOISK,NPGOLD,OK,PRHBR,STR,%YYOLD ; I $D(%MBG("LINE")),$G(%SH00),$G(%YY00),$G(%SCH00) D .N %YY,%YYYY,SH,SCH K %MBGLIGHT S %YYYY=%YY00,SH=%SH00,SCH=%SCH00 D PL^%L3MBG ; S %YYOLD=%YY,SHOLD=SH,SCHOLD=SCH,NPGOLD=NPG,JPOISK=J,I1=SH D PRHBR ; I $G(%L3MBGHIP("COL")) N J I $D(%L3MBGHIP),$G(%L3MBGHIP("COL"))=0 D K %L3MBGHIP G:'OK NOK G EP .S I=%L3MBGHIP,OK=0 Q:'$D(@(%REFH1_"I)")) Q:I<(SH-SCH+1) Q:I>(SH-SCH+%LASTL) S STR=$G(@(%REFH1_"I)")) .S GRF=$P(STR,RZD,J) .S %EQ=$D(%L3MBGHIP("=")) .S SCH=I-PG(NPG),SH=I .S %YY=VGR+(STEP*SCH)-1 .S %YYYY=%YY,J=JPOISK S %LAB="INC1",OK=1 ; I $D(%L3MBGHIP) D K %L3MBGHIP G:I1 P1 G P11 .S %HIP=%L3MBGHIP,%FND=0,PRHBR=$G(%L3MBGHIP("H"),PRHBR),%EQ=$D(%L3MBGHIP("=")) .I $D(%L3MBGHIP(1)) S NPG=1 D INIT S I1=0 .I $D(%L3MBGHIP("COL")) S J=%L3MBGHIP("COL") ; ;----- '$D(%L3MBGHIP) ZP S %FL="",%ZMSF="",%ZMSF("LR")="" S %SAY=", --> dpini , <-- dl`ny dcenr " I $D(%MBG("MIUN")) S %SAY=" - dlrnln , - dhnln oein "_%SAY X %XMSGN S %GET="++"_(VGR-1)_","_($P(%MBG("X"),"\",J)+1)_",H#"_$G(%HIP)_"++"_$P(%MBG("D"),"\",J)_","_$S(PRHBR:"H",1:"E")_",I" D ^%L1GET D RCAV I $P(%MBG("RGS"),"\",J)="H",%TO="F10" S %SAY=" ! dhnln wx oein ozip dfd dcya " X %XMSGV(1) G ZP I $G(%TO)="F10"!($G(%TO)="F9"),'$D(%MBG("MIUN")) S %SAY=" ! oiinl ozip `l " X %XMSGV(1) G ZP I $G(%TO)="F10"!($G(%TO)="F9"),$D(%MBG("MIUN")) D D PS^%L3MBG S %SAY="*++"_(VGR-1)_","_$P(%MBG("X"),"\",J)_",HH" X %XMSG K %HIP S %LAB="L0" G EP .S %SAY=" ... oeinl oznd `p` " X %XMSGN .K ^mbgsort($P),^mbgsort1($P) N IND,N,I,MAC1,MAC2 .F I=1:1 Q:'$D(@(%REFH1_"I)")) S STR=$G(@(%REFH1_"I)")) D ..I $P(%MBG("RGS"),"\",J)="H" D G SORT ...S IND=$$INV^%L1FRM($P(STR,RZD,J)) ...S IND=$E(IND_$J("",10-$L(IND)),1,10)_$J(I,5) ..I %TO="F9" D ...I $P(%MBG("RGS"),"\",J)="D" S IND=$E($J($$^%L1DC($P(STR,RZD,J),3),10),1,10)_$J(I,5) G SORT ...I $P(%MBG("RGS"),"\",J)="E"&$P(%MBG("DR"),"\",J) S IND=1900000000+$J($P(STR,RZD,J)*100,0,0)_$J(I,5) G SORT ...S IND=$E($J($P(STR,RZD,J),10),1,10)_$J(I,5) ..I %TO="F10" D ...I $P(%MBG("RGS"),"\",J)="D" S IND=$E($J(99999-$$^%L1DC($P(STR,RZD,J),3),10),1,10)_$J(I,5) G SORT ...S IND=$E($J(1000000000-$P($P(STR,RZD,J)*100,"."),10),1,10)_$J(I,5) SORT ..S ^mbgsort($P,IND)=I .S MAC1=%REFH1 I $E(%REFH1,$L(%REFH1))="," S MAC1=$E(%REFH1,1,$L(%REFH1)-1) .S:$E(MAC1,$L(MAC1))'=")" MAC1=MAC1_")" .S MAC2="^mbgsort1($P)" D ^%S1GC1 .K @MAC1 S N="",I=0 F S N=$O(^mbgsort($P,N)) Q:N="" D ..S I=I+1,IND=+^(N) ..S @(%REFH1_"I)")=^mbgsort1($P,IND) .K ^mbgsort($P),^mbgsort1($P) .S (SHOLD,SCHOLD)=0,YOLD=VGR2 K NPG D INIT .;;S (SH,SCH)=1 D SETM^%L3MBG I $G(%TO)="TAB"!($G(%TO)="LEFT"),$P(%MBG("X"),"\",J+1) S J=J+1 K %HIP D PRHBR G ZP I $G(%TO)="TABN"!($G(%TO)="RIGHT"),$P(%MBG("X"),"\",J-1) S J=J-1 K %HIP D PRHBR G ZP I $G(%TO)="END"!(%S="") S J=JPOISK S %LAB="INC1" G EP S %HIP=%S,%FND=0 ; ;--------------- OTO DAF P1 S %YY=$S(I1:%YYOLD,1:VGR2),%FND=0 F I=I1+1:1:SH-SCH+COLS Q:'$D(@(%REFH1_"I)")) S STR=$G(@(%REFH1_"I)")) D Q:%FND .S %YY=%YY+STEP S GRF=$P(STR,RZD,J) .D HIP I %FND S SCH=I-PG(NPG),SH=I,%YYYY=%YY,J=JPOISK S %LAB="INC1" G EP ; ;--------------- DAF AHER G P12 ;S NPG=NPG+1,PG(NPG)=SH-SCH+COLS G P12 N I1 S I1=SH-SCH+COLS P11 ; P12 X %XCL K %SH00,%SCH00,%YY00 F I=I1+1:1 Q:'$D(@(%REFH1_"I)")) S STR=$G(@(%REFH1_"I)")) D Q:%FND .S GRF=$P(STR,RZD,J) D D HIP ..I '(I-1#COLS),I-1'=I1 S NPG=NPG+1,PG(NPG)=I-1 S J=JPOISK I %FND S SHOLD=I-1,SCHOLD=SHOLD-PG(NPG),YOLD=VGR2+(SCHOLD*STEP),XOLD=J I '%FND S NPG=NPGOLD,SHOLD=SHOLD-1,YOLD=%YYOLD-STEP,SCHOLD=SCHOLD-1 S %SAY=" `vnp `l " X %XMSGN(1) N J1 F J1=J:1:COLG Q:$P(%MBG("OU"),"\",J1)?.P S XOLD=J1 K J1 D PS^%L3MBG S %LAB="L0" EP S %TO="" S %SAY="" X %XMSGN Q ; NOK S %SAY=" `vnp `l " X %XMSGN(1) K %HIP S %YY=%YYOLD,J=JPOISK S %LAB="ML" G EP ; RCAV ; S %SAY=$TR($J("",$P(%MBG("D"),"\",J))," ","-")_"++"_(VGR-1)_","_$P(%MBG("X"),"\",J)_",H" X %XMSG Q HIP ; I $D(%EQ)," "_GRF=(" "_%HIP)&'PRHBR!((GRF_" ")=(%HIP_" ")&PRHBR) S %FND=1 Q ;;I '$G(%EQ)," "_GRF[(" "_%HIP)&'PRHBR!((GRF_" ")[(%HIP_" ")&PRHBR) S %FND=1 Q I '$G(%EQ),'PRHBR D Q .S %FND=1 .N JJ,WRD F JJ=1:1:$L(%HIP," ") D Q:'%FND ..S WRD=$P(%HIP," ",JJ) ..I " "_GRF'[(" "_WRD) S %FND=0 I '$G(%EQ),PRHBR D Q .N JJ,JJ1,WRD F JJ=1:1:$L(%HIP," ") D Q:'%FND ..S %FND=1 ..S WRD=$P(%HIP," ",JJ) ..F JJ1=" ",";",",","/","-" I GRF_" "[(WRD_JJ1) S %FND=2 ..Q:%FND>1 ..F JJ1="l","d","a","e" I GRF_" "[(WRD_JJ1)&(JJ<$L(%HIP," ")) S %FND=2 ..S %FND=%FND-1 Q PRHBR S PRHBR=$S($P(%MBG("RGS"),"\",J)["H":1,1:0) Q SUM(%RKV,%SRKV,%PR,%RZD) ; ;-- %RKV - FIELD NAME ;-- %SRKV - TOTAL FIELD NAME ;-- %PR=1 - TOTAL BY GLOBAL ONLY (NOT MEMORY %RKV VALUE) N %A,%I,%NB I '$D(%RZD) S %RZD="\" S @%SRKV=0 S %NB=$G(^SCR(%SCRN,"G","NAME",%RKV)) Q:'%NB I '$G(%PR),$G(SH) S @%SRKV=@%SRKV+@%RKV F %I=1:1 Q:'$D(@(^SCR(%SCRN,"G","REF")_",%I)")) S %A=$G(^(%I)) D .S @%SRKV=@%SRKV+$S($G(%PR)!($G(SH)'=%I):$P(%A,%RZD,%NB),1:"") Q UN(%SCRN,%S) ;--- BDIKA IM PARIT YAHID BTAVLA N N,I,NOTOK,SH00,%MSP,%DLM N GLBCUR S NOTOK=0,SH00=SH S %DLM=^SCR(%SCRN,"G","RZD") S %MSP=%S S %L3MBGHIP=%MSP,%L3MBGHIP(1)=1,%L3MBGHIP("=")="" S GLBCUR=^SCR(%SCRN,"G","REF")_","""_SH_""")" S N=-1 F I=1:1 S N=$N(@(^SCR(%SCRN,"G","REF")_","""_N_""")")) Q:N=-1 I N'=SH,$L(%MSP),%MSP=$P($G(^(N)),%DLM,$G(J,1)) S NOTOK=NOTOK+1 Q I NOTOK'>0 K %L3MBGHIP I NOTOK>0 S %GET=" - blcl . dcerza clwed xak xtqn " D N^%L1GET S:%TO="F9" %S=99 G:%S'=99 UNER D G UNEND .I %MOLD?.P,($O(@GLBCUR)'?1N.N) S %SC("ER")=1 S @GLBCUR="" D SETM^%L3MBG D DEL^%L1GSEQ(^SCR(%SCRN,"G","REF")_")",SH) Q .S @^SCR(%SCRN,"G","NM",J)=%MOLD UNEND Q UNER S %SC("ER")=1 K %L3MBGHIP I %MOLD?.P,($O(@GLBCUR)'?1N.N) D DEL^%L1GSEQ(^SCR(%SCRN,"G","REF")_")",SH) Q %L3MBGG %L3MBGG ; [ 12.03.09 13:05 ] [ 12.02.07 14:15 ] [ 30.12.03 12:19 ] I $P(%MBG("FNC"),"\",J)[%TO&(%TO'="") Q N SHGG,COLGG S SHGG=SH,COLGG=COLG S JOLD=J N FILE,SH,SCH,YOLD,XOLD,SHOLD,SCHOLD,Y000,%YYYY,%XX,%YY N X1,X2,Y1,Y2,%L1SCS,COLS,STRING,%RZDF,%GGSOLD S %L1SCS="" K %PL S (STRING,%GGSOLD)=%S,FILE=$P(%MBG("GLOB"),"\",J) S:$E(FILE)'="^" FILE="^"_FILE I FILE["(" S %SC("ST")="" G END S %RZDF=$P(%MBG("RZDF"),"\/",J) S FILE(1)=$P(%MBG("D"),"\",J),FILE(2)=$P(%MBG("NLN"),"\",J),FILE(3)=$P(%MBG("TOPB"),"\",J) S:FILE(1)="" FILE(1)=8 S:FILE(2)="" FILE(2)=30 S:FILE(3)="" FILE(3)=8 I $G(%TO)="F6"!($G(%TO)="F7")!((%GGSOLD="*")!(%GGSOLD="?")&($G(%TO)="")) D SAVE D D REST G END .S FLAG="" .S:STRING="*"&($G(%TO)="") %TO="F7",%GGSOLD="" S:STRING="?"&($G(%TO)="") %TO="F6",%GGSOLD="" .D @$S($G(%TO)="F7":"DAFUS^%L3MBGS",1:"POISK^%L3MBGS") I $G(FLAG)'=""!'$D(STRING) S %SC("ST")="" Q .S (@$P(%MBG("O"),"\",JOLD),%GGSOLD)=STRING D VRB I @$P(%MBG("O"),"\",J)="",$P(%MBG("NEW"),"\",J)="Y",$P(%MBG("FNC"),"\",J)'[%TO!(%TO="") S %SC("ER")="" G END I @$P(%MBG("O"),"\",J)="",$P(%MBG("NEW"),"\",J)="Y" G END I @$P(%MBG("O"),"\",J)="",$P(%MBG("VRB"),"\",J)?1U.E S @$P(%MBG("VRB"),"\",J)="" G END ; I @$P(%MBG("O"),"\",J)'="",@$P(%MBG("O"),"\",J)'=0 D G:$D(%SC("ER"))!$D(%SC("ST")) END D VRB G END .I '($D(@(FILE_"(STRING)")))#2 D Q ..I $P(%MBG("CREAT"),"\",J)?.P,$P(%MBG("CHECK"),"\",J)'?.P S %SC("ER")="" Q ..I $P(%MBG("CREAT"),"\",J)?.P,$P(%MBG("CHECK"),"\",J)?.P Q ..K %L1GET S %GET=" - miwdl . miiw `l" D N^%L1GET S:%TO="F9" %S=99 I %S'=99 D Q ...I $P(%MBG("NEW"),"\",J)="Y" S %SC("ER")="" Q ...S %SC("ST")="" D VRB Q ..N GLOB,%PROG,RZD,NSNAME,TB,DL,SG ..S GLOB=$P($E(FILE,2,20),"(") S %SC("ST")="" I $D(^TABLs(GLOB)) D SAVE D D REST Q ...I $G(%SCRN)'="",$D(^TABLs(GLOB,"PROG",%SCRN)) S %PROG=^(%SCRN) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG,STRING,GLOB) D ^%L1C S:$G(^TABLs(GLOB,"KEY"))?."%"1U.E @^("KEY")=$G(STRING) D PROGSET,@%PROG Q ...I $D(^TABLs(GLOB,"PROG")) D Q ....S %PROG=^("PROG") ;;N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%PROG,STRING,GLOB) D ^%L1C S:$G(^TABLs(GLOB,"KEY"))?."%"1U.E @^("KEY")=$G(STRING) D PROGSET,@%PROG Q ....I $D(^TABLs(GLOB,"UCI")) S %PROG=%PROG_"["_^("UCI")_"]" ....S:$G(^TABLs(GLOB,"KEY"))?."%"1U.E @^("KEY")=$G(STRING) ....D ^%L1CALL(%PROG,$G(%SCRN),$G(^TABLs(GLOB,"KEY"))) ...N FILE D I^%L1TABL ..D SAVE S NSNAME=$P(%MBG("NS"),"\",J) D ^%L1SCS D REST I $G(%TO)="END" S %SC("ST")="" Q ..S (@$P(%MBG("O"),"\",JOLD),%GGSOLD)=STRING END S J=JOLD S %TO="",%S=%GGSOLD Q PROGSET ; S %PROG("STRING")=$G(STRING) Q SAVE D:'$D(%TYPCRT) ^%L1C I %TYPCRT="PC" D GET^%VIDEO("olds",0,1,80,25,2) Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;;;;2$v" S %SC("TO")="PL" Q Q REST D:'$D(%TYPCRT) ^%L1C ; I %TYPCRT="PC",'$L($G(%SCRN)) D PUT^%VIDEO("olds",0,1,80,25,2) K olds S %SC("TO")="PL" Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;2;;;$v" S %SC("TO")="PL" Q I $L($G(%RESTPRG)) X %RESTPRG Q I $L($G(%SCRN)) N J,STRING,FILE,%SCNC K %L1SCBEG D A^%L1SC Q VRB ; Q:$D(%SC("ER"))!($G(%SC("ST"))="ER") Q:$P(%MBG("VRB"),"\",J)'?1U.E I @$P(%MBG("O"),"\",J)="" S @$P(%MBG("VRB"),"\",J)="" Q N VRB S VRB=$G(@(FILE_"(STRING)")) I %RZDF'="" S VRB=$P(VRB,%RZDF) S @$P(%MBG("VRB"),"\",J)=VRB I '$D(%SC("ER")),$G(%SC("ST"))'="ER" F JJ=1:1:COLGG S $P(@(%REFH1_"SHGG)"),RZD,JJ)=$G(@$P(%MBG("O"),"\",JJ)) Q %L3MBGH %L3MBGH ; [ 02/14/99 6:26 AM ] [ ;-------------------------------------------------------------------; ; - dxfrn z`vl ; ;-------------------------------------------------------------------; ; e` - `ad sc ; ; e` - mcew sc ; ; - dlah seql ; ; - dlah zligzl ; ; - jqn zligzl ; ; ; ; - dlrnl zvaynn oezip wizrdl ; ; e` - oein / yetig ; ; ; ; - dxey wegnl ; ; - dxey ltkyl ; ; - POP-UP hixtz ; ; ; - oeaygn ; ; ; ; miinrt e` <=> - d`ivi ; ;-------------------------------------------------------------------; %L3MBGR %L3MBGR(GL,NR,DLM,STG) ; %MBG GRAPH [ 29.12.00 6:16 AM ] [ 18.05.00 1:57 PM ] [ 17.05.00 5:10 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,GL,NR,DLM,STG) D ^%L1C S DL=78 K ^TMPS111($J),%S2V S CVG=%CV("YF") S KVD=$S(%TYPCRT="PC":$C(223),1:"=") S KVD2=$S(%TYPCRT="PC":$C(222),1:"-") S KVD3=$S(%TYPCRT="PC":$C(221),1:"[") S KVV=$S(%TYPCRT="PC":$C(179),1:"|") S STG1=$$SPA^%L1FRM(STG) S %S2V("TXT1")=STG1 S NRA=$L(STG1,":")-NR-1 D SUM I 'SUM S %SAY=" ! sxb bivdl zexyt` oi` . 0 `ed oezp k""dq " X %XMSGV(1) Q ;I %TYPCRT["VT" W *27,"(0" S N="" F S N=$O(@GL@(N)) Q:N="" S A=$P($G(^(N)),DLM,1,$L(STG1,":")-2) D .S SM=80-$L(STG1)\2+1 .S TXT=" "_%LIGHT1_CVG_KVV_%CCL_$J("",SM-2)_$$MCH(A,DLM,STG1,":",NR) D S1 .S VL=$P(A,DLM,NRA) .S DL1=$S('SUM:0,1:DL*VL/SUM) .I DL1>DL S DL1=DL+1 .I DL1'<.75 S TXT=" "_KVV_$TR($J("",DL1)," ",KVD) D S2 .I DL1<.75,DL1>.3 S TXT=" "_KVV_KVD2 D S2 .;;I DL1'>.3,DL1>.1 S TXT=" "_KVV_KVD3 D S2 .I DL1'>.3,DL1>0 S TXT=" "_KVV_KVV D S2 .I DL1<0,DL1>-.3 S TXT=KVV_KVV D S2 .I DL1'>-.3,DL1>-.7 S TXT=KVD2_KVV D S2 .I DL1<-.7 S TXT=KVD_KVV D S2 S %S2V("PRINT")="" S %S2V("PRINT","KOT")=$P(STG1,":",NR+1)_" itl sxb " S %S2V("PRINT","KOT",1)=$J("",SM)_$TR($J("",$L(STG1))," ","-") S %S2V("PRINT","KOT",2)=$J("",SM)_STG1 S %S2V("PRINT","KOT",3)=%S2V("PRINT","KOT",1) S %S2V("RIGHT")=125 X %chista D ^%S2VIEW ;I %TYPCRT["VT" W *27,"(B" K ^TMPS111($J) Q SUM ; S SUM=0 S N="" F S N=$O(@GL@(N)) Q:N="" S A=$G(^(N)) S SUM=SUM+$P(A,DLM,NRA) Q S1 ; S ^TMPS111($J,$O(^TMPS111($J,9999999),-1)+1)=TXT Q S2 ; S ^TMPS111($J,$O(^TMPS111($J,9999999),-1)+1)=%LIGHT1_CVG_TXT_%CCL Q MENU(%SCRN) ; Q:'$D(^SCR(%SCRN,"G","REF")) Q:$G(^SCR(%SCRN,"G","REF"))'["(" Q:'$D(^SCR(%SCRN,"G","RZD")) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%SCRN) D ^%L1C S GL=^SCR(%SCRN,"G","REF") S STG=$$SPA^%L1FRM(^("STG")),RZD=^("RZD") I $E(GL,$L(GL))="," S GL=$E(GL,1,$L(GL)-1) I $E(GL,$L(GL))'=")" S GL=GL_")" S M(0)=" : sxbl oezp xegal `p " S M(1)=" d ` i v i " S J=1 K MI F I=2:1:$L(STG,":") D .I $G(^SCR(%SCRN,"G",I,"TYP"))'="N" Q .S J=J+1 .S M(J)=$$SPA^%L1FRM($P(STG,":",$L(STG,":")-I)) .S MI(J)=$L(STG,":")-I-1 I '$D(M(2)) S %SAY=" ! g""eca mixtqn mipezp oi` " X %XMSGV(1) Q I '$D(M(3)) S %I=2 G GR S MAC="M" D ^%L2MENU Q:%I=1 GR D %L3MBGR(GL,MI(%I),RZD,STG) Q MCH(%ST1,%D1,%ST2,%D2,%NR) ; N %MP,%I,%ST3,%SMB S %ST3=" " F %I=1:1:$L(%ST1,%D1) D .S %RV=$P(%ST1,%D1,$L(%ST1,%D1)-%I+1) .S %SMB=$$HBR^%L1FRM(%RV,$L($P(%ST2,%D2,%I+1))) .I %I=%NR S %SMB=%LIGHT1_CVG_%SMB_%CV("BF")_"*"_%CCL S %ST3=%ST3_%SMB .E S %ST3=%ST3_%SMB_" " Q $E(%ST3,1,$L(%ST3)-1) %L3MBGS %L3MBGS ; [ 31.05.06 09:16 ] [ 17.01.06 18:20 ] [ 12.09.05 18:50 ] DAFUS ; K STRING N %L1,INDEX,MAC,KOD,%FIRST,%I N I,INDEX,SH,SCH,%ECHO,SHEM1,SHEM2 N I,J,N,N1,IN,IN1 S:$G(FILE(1))="" FILE(1)=8 S:$G(FILE(2))="" FILE(2)=30 S:$G(FILE(3))="" FILE(3)=8 D UCI S MAC=FILE S %HBRY="" K %L1 I $D(FILE("RB")) S %L1("RB")="" S N="" F I=1:1 S N=$O(@FILE@(N)) Q:N="" Q:I>36 ;;I $G(%S)'="",%S'?."0",$G(%MSC("FNC"))["FF"!($G(%MBG("FNC"))["FF") D Q:$G(%TO)="END" I $G(%S)'="",%S'?."0",I>36 D Q:$G(%TO)="END" .N %SO S %SO=%S I %S?1N.N S %S=+%S .S %FL="" S %GET=": F7 - mlek, F8 - cew llek , - cewn yetig#13" S %GETIN=%S .I %ENGLISH S %GET="SEARCH :(F7 - ALL, F8 - INCUDING CODE , - FROM CODE#13" S %GETIN=%S .D N^%L1GET K %GETIN Q:$G(%TO)="END" I $G(%TO)="F7" S %S="" .I $$HZGTOUCH^%L2MOUSE S %S=%SO .I $G(%TO)="",%S'="" D S MAC="^L3MBGS($J)" Q ..K ^L3MBGS($J) N N,I,SS,J1 ..S N="" F S N=$O(@FILE@(N)) Q:N="" I N'<%S S ^L3MBGS($J,N)="" .I $G(%TO)="F8",%S'="" D Q ..S J1=0 F I=$L(%S):1:FILE(1) S SS=%S_$TR($J("",I-$L(%S))," ",0) S:$D(@FILE@(SS)) ^L3MBGS($J,SS)="" S N=SS D ...F S N=$O(@FILE@(N)) Q:N="" Q:$E(N,1,$L(%S))'=%S S ^L3MBGS($J,N)="" ..S J1=0 F I=$L(%S):1:FILE(1) S SS=$TR($J("",FILE(1)-I)," ",0)_%S_$TR($J("",J1)," ",0) S:$D(@FILE@(SS)) ^L3MBGS($J,SS)="" S N=SS D S J1=J1+1 ...F S N=$O(@FILE@(N)) Q:N="" Q:$E($$NULL^%L1FRM(N),1,$L(%S))'=%S S ^L3MBGS($J,N)="" ..S MAC="^L3MBGS($J)" .;;I $G(%TO)="F8" S %L1("US")="$E(+%NXN_$P(%NXN,+%NXN,2,20),1,$L(%S))=%S" .I %S'="" U $P S %SAY=" ...oznd `p .dligza "_%S_" mr micew yetig " X %XMSGV ;(1) I %S="" K %L1("US") S %L1("EU")=1,%L1("BE")=$G(FILE(3),6) ;;,%L1("NGR")=22 D HZG D ^%L1NU K ^L3MBGS($J) S %TO="" Q:FLAG'="" S STRING=INDEX Q Q POISK ; Q:FILE["(" N FL0 S FL0=$P($E(FILE,2,100),"(") I FL0["]" S FL0=$P(FL0,"]",2) I FL0["|" S FL0=$P(FL0,"|",2) Q:FL0="" N %ZMSF S %ZMSF="",FLAG="" S %GET=$S($D(^TABLs(FL0,"FIND")):"( F6 - illk yetig )",1:"")_" my zlgzd ++24,60,HH,,,C#++15,H,I" ;;++++ agx yetig - my? " I %ENGLISH S %GET="BEGINNING OF NAME "_$S($D(^TABLs(FL0,"FIND")):"(ADVANCED SEARCH - F6 )",1:"")_"++24,20,EE,,,C#++15,E,I" D ^%L1GET I %S=""&(%TO'="F6")!($G(%TO)="END") S FLAG="AB" G EP I %TO'="F6" G PSK1 N SHEM S SHEM=%S K STRING I $L($G(%SCRN)),$D(^TABLs(FL0,"FIND",%SCRN)) D G:$D(STRING(1)) EP G PSKNU .D @(^(%SCRN)) I $D(^TABLs(FL0,"FIND")) D G:$D(STRING(1)) EP G PSKNU .D @^("FIND") G PSK1 PSK(%S) ; -- +FILE PSK1 K STRING N %L1,INDEX,MAC,KOD,%FIRST,%I N I,INDEX,SH,SCH,%ECHO,SHEM1,SHEM2 N I,J,N,N1,IN,IN1,%GET I '$D(%L3MBGSI) S %L3MBGSI="i" S:$G(FILE(1))="" FILE(1)=8 S:$G(FILE(2))="" FILE(2)=30 S:$G(FILE(3))="" FILE(3)=8 S %HBRY="" D UCI I $E(%S,$L(%S))="?"!($E(%S)="?") D G PSKNU .N SHEM,POS .I $E(%S)="?" S %S=$E(%S,2,$L(%S)) .E S %S=$E(%S,1,$L(%S)-1) .K ^TEMPi($P) S N="" F S N=$O(@FILE@(N)) Q:N="" S OK=1 D I OK S ^TEMPi($P,N)=SHEM ..S SHEM=$P($G(^(N)),RZD) ..I $L(%S)>$L(SHEM) S OK=0 Q ..;;F I=1:1:$L(%S) I '$F(SHEM,$E(%S,I)) S OK=0 Q ..S POS=0 ..F I=1:1:$L(%S) S POS=$F(SHEM,$E(%S,I),POS) I 'POS S OK=0 Q S %S=$TR(%S,",.;/()-"," ") S SHEM1=$P(%S," ",$L(%S," ")) S SHEM2=$P(%S," ",$L(%S," ")-1) ;_" " D HIPUS(SHEM1) I SHEM2'?.P D .K ^TEMPi1($P) S MAC1="^TEMPi($P)",MAC2="^TEMPi1($P)" D ^%S1GC1 K ^TEMPi($P) .D HIPUS(SHEM2) .S N="" F S N=$O(^TEMPi($P,N)) Q:N="" I '$D(^TEMPi1($P,N)) K ^TEMPi($P,N) .K ^TEMPi1($P) Q:$D(P3PSK) PSKNU S MAC="^TEMPi($P)" K %L1 S %L1("EU")=2,%L1("BE")=$G(FILE(3),8) ;;,%L1("NGR")=22 ;S %L1("US")="$G(@(FILE_""(%NXN)""))_"" ""[SHEM2" D HZG D ^%L1NU I FLAG'="" K ^TEMPi($P) G EP S STRING=INDEX K ^TEMPi($P) EP K %INV S %SAY=" ++24,60,HH" X %XMSG K %L3MBGSI Q END Q CREAT ; S %SAY="...oznd `p " X %XMSGN N %I I $E(FILE)'="^" S FILE="^"_FILE D UCI K @(FILE_"i") S STRING="",%I=0 I $D(^TABLs($E(FILE,2,8),"RZD")) S RZD=^("RZD") S:'$D(RZD) RZD="*" F S STRING=$O(@(FILE_"(STRING)")) Q:STRING="" D .I FILE="^NAME",$L($G(^(STRING,1))) D IND(^(1)) Q .I $D(@(FILE_"(STRING)"))#2 D IND(^(STRING)) Q IND(TOH) ; N %ST,IN,IN1,I,JJ S %ST=$TR(TOH,",.;""()-/"," ") F I=1:1:$L(%ST," ") S IN=$P($P(%ST," ",I),RZD) I IN'="" D .S:IN>0 IN=+IN I IN?1N.N!(IN?1U.U) S IN1=IN .E S IN1="" F JJ=1:1:$L(IN) S IN1=$E(IN,JJ)_IN1 .S @(FILE_"i(IN1,STRING)")="" S %I=%I+1 I '(%I#100) W "." Q UCI ; Q:FILE["[" I $D(^TABLs($E(FILE,2,8),"UCI")) S FILE("UCI")=^("UCI") I $D(FILE("UCI")) S FILE="^["""_FILE("UCI")_"""]"_$P(FILE,"^",2) Q HZG ; S:'$D(RZD) RZD="*" N RZDO S RZDO=RZD I $G(%RZDF)'="" S RZD=%RZDF N FL0 S FL0=$E(FILE,2,100) I FL0["]" S FL0=$P(FL0,"]",2) Q:FL0="" I $L($G(%SCRN)),$D(^TABLs(FL0,"HZG",%SCRN))#2 S %L1("TXT1")=^(%SCRN) S:$D(^TABLs(FL0,"SET"))#2 %L1("SET")=^("SET") S:$D(^TABLs(FL0,"HZGKOT",%SCRN))#2 %L1("T1")=^(%SCRN) G M1 I $D(^TABLs(FL0,"HZG"))#2 S %L1("TXT1")=^TABLs(FL0,"HZG") S:$D(^TABLs(FL0,"SET"))#2 %L1("SET")=^("SET") S:$D(^TABLs(FL0,"HZGKOT"))#2 %L1("T1")=^("HZGKOT") I '$D(^TABLs(FL0,"HZG")) S %L1("TXT1")="$P($G(@FILE@(%NXN)),"""_RZD_""")<>"_FILE(2)_"H\/$S(FILE'=""^word"":%NXN,1:$$INV^%L1FRM(%NXN))<>"_FILE(1) M1 S RZD=RZDO I $D(^TABLs(FL0,"FIRST"))#2 S %L1("FIRST")=^TABLs(FL0,"FIRST") I $L($G(%SCRN)),$D(^TABLs(FL0,"FIRST",%SCRN)) S %L1("FIRST")=^TABLs(FL0,"FIRST",%SCRN) I $L($G(FILE(6))) S %L1("US")=$G(%L1("US"),1)_"&("_FILE(6)_")" Q I $L($G(%SCRN)),$D(^TABLs(FL0,"US",%SCRN)) S %L1("US")=$G(%L1("US"),1)_"&("_^TABLs(FL0,"US",%SCRN)_")" Q I $D(^TABLs(FL0,"US"))#2 S %L1("US")=$G(%L1("US"),1)_"&("_^TABLs(FL0,"US")_")" Q Q HIPUS(SHEM) ; N JJ,N,N1 I $P(SHEM," ")?1U.U!($P(SHEM," ")?1N.N) S N=SHEM E S N="" F JJ=1:1:$L(SHEM) S N=$E(SHEM,JJ)_N K ^TEMPi($P) S N1=N I '$D(@(FILE_%L3MBGSI))!($G(%TO)="R") S %SAY=" belhw oekcr oizndl `p " X %XMSGV H 1 D CREAT I $L(N1) I $D(@(FILE_%L3MBGSI_"(N1)"))>9 S JJ="" F S JJ=$O(@(FILE_%L3MBGSI_"(N1,JJ)")) Q:JJ="" S ^TEMPi($P,JJ)=$G(@FILE@(JJ)) F S N1=$O(@(FILE_%L3MBGSI_"(N1)")) Q:N1="" Q:$$NOMATH(N1,N) S JJ="" F S JJ=$O(@(FILE_%L3MBGSI_"(N1,JJ)")) Q:JJ="" S ^TEMPi($P,JJ)=$G(@FILE@(JJ)) ;"" Q NOMATH(N1,N) ; I $E(N1,1,$L(N))'=N Q 1 Q 0 %L3MD %L3MD(PORTN,NUMBER,US,MDLKH,MSG,LNG) ; [ 16.12.03 10:36 ] [ 14.12.03 16:48 ] [ 08/13/2002 3:26 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PORTN,USERMOD,NUMBER,MDTONE,MDLKH,%L1MDOK,US,%DELAY,%L2MD,MSG,LNG) D ^%L1C,^%L1TS S %L1MDOK=0,%L2MD="" U $P S %SAY=" CTRL/C - CANCEL " X %XMSGV U $P S PRT=$P S $ZT="ZG "_$ZL_":ERR^%L3MD" K ^MODEM($P) S ^MODEM($P)="BEG" ;;S US="U PORTN:(0::::#001001:#800040:::$C(13))" S %S=MSG,%L1WH="",%L1WH("RB")="",%X1=4,%X2=74,%Y1=21,%Y2=23 D ^%L1WH S %L2MD("M","VG")=4,%L2MD("M","NG")=17,%L2MD("M","LG")=4,%L2MD("M","RG")=27 W %LIGHT1,%CV("CF") D TV^%L1RBUA(%L2MD("M","VG"),%L2MD("M","LG"),%L2MD("M","NG")+2,%L2MD("M","RG")+1) W %LIGHT1,%CV("CF") S %L2MD("L","VG")=4,%L2MD("L","NG")=17,%L2MD("L","LG")=32,%L2MD("L","RG")=75 D TV^%L1RBUA(%L2MD("L","VG"),%L2MD("L","LG"),%L2MD("L","NG")+2,%L2MD("L","RG")+1) X %XCL I $G(PORTN)>3 G ASK+1 ASK S %GET="I/O PORT? > ++3,3,EE#++2,E,I" D ^%L1GET S PORTN=%S G:PORTN="" EXIT I $P=PORTN!'PORTN D MSG("CANNOT SELECT YOUR OWN DEVICE.","M") G ASK C PORTN U $P:(CENABLE:CTRAP=$C(3)) O PORTN::0 E D MSG("..LINE IN USE..WAITING..","M") O PORTN D MSG("READY","M") D HANGUP X US ;;I $ZB($ZA,2,1) D MSG("DEVICE "_PORTN_" IS AN OUTPUT ONLY DEVICE.","M") G ASK INIT ; I $$CMD("AT+CSDUH="_$S(LNG:8,1:28)) G EXIT I 'LNG S MSG=$TR($$INV^%L1FRM($TR(MSG,"""","'")),TS0,TS1) I $$CMD("AT*CSWHT=0,"""_$TR(MSG,"""","'")_"""") G EXIT S %DT=0 I $G(NUMBER) D DELAY G TP1 TP U $P:(CENABLE:CTRAP=$C(3)) S %GET="PHONE NUMBER > ++23,5,EE,,,,RF#++10,E,I" D ^%L1GET S NUMBER=%S G:NUMBER="" EXIT TP1 X US S NUMBER=$TR(NUMBER,"-","") D CLPORT S ST="AT+CSMH=1,"""_NUMBER_""""_$C(13) W ST D MSG(ST,"M") S TXT=%HBR_$$HBR^%L1FRM($G(MDLKH),30)_" "_$$HBR^%L1FRM(NUMBER,10)_%ENG D MSGL(TXT,"L") X US H 3 F I=1:1:60 R A:1 D Q:OK S ^MODEM("CONN",I)=A .I $F(A,"CONN") S OK=1 Q I OK'=1 D MSG(A,"M") G EXIT I OK=1 K ^MODEM($P) D MSG("MODEM IN USE !","M") S %L1MDOK=OK EXIT H 1 Q ERR S %L1MDOK=$P($P($P($ZS,",",3),"<",2),">") G EXIT HANGUP ; ;D ^%L1HANG Q CLPORT X US ; F I=1:1:%DELAY R *A:0 I A>0 F R *A:1 E Q Q DELAY ; F %JJJ=1:1:%DELAY Q MSG(TXT,PR) U $P:(NOECHO:NOWRAP) D SDVIG(PR) S %YY=%L2MD(PR,"NG"),%XX=%L2MD(PR,"LG")+1 X %POSIC W %LIGHT1,%CV($S(PR="M":"GF",1:"YF")) W $$ENG^%L1FRM($$SPA^%L1FRM($$CLA^%L1FRM(TXT)),%L2MD(PR,"RG")-%L2MD(PR,"LG")-1),%CCL Q MSGL(TXT,PR) U $P:(NOECHO:NOWRAP) D SDVIG(PR) S %YY=%L2MD(PR,"NG"),%XX=%L2MD(PR,"LG") X %POSIC W %LIGHT1,%CV("YF"),TXT,%CCL Q SDVIG(PR) ; I %TYPCRT="PC" D Q .D GET^%VIDEO("l2md",%L2MD(PR,"LG")-1,%L2MD(PR,"VG")+1,%L2MD(PR,"RG")-%L2MD(PR,"LG")+1,%L2MD(PR,"NG")-%L2MD(PR,"VG"),2) .D PUT^%VIDEO("l2md",%L2MD(PR,"LG")-1,%L2MD(PR,"VG"),%L2MD(PR,"RG")-%L2MD(PR,"LG")+1,%L2MD(PR,"NG")-%L2MD(PR,"VG"),2) I $E(%TYPCRT,1,3)="VT5" D Q .W $C(27,91),(%L2MD(PR,"VG")+2)_";"_%L2MD(PR,"LG")_";"_(%L2MD(PR,"NG")+1)_";"_%L2MD(PR,"RG")_";;"_(%L2MD(PR,"VG")+1)_";"_%L2MD(PR,"LG")_";$v" Q CMD(%CMD) ; S %DC=0 S %DT=0,%Y="" P0 X US D CLPORT S %ST=%CMD_$C(13) F %J=1:1:$L(%ST) W $E(%ST,%J) D DELAY P01 X US R *%Y1:2 E S %DC=%DC+1 G:%DC<12 P01:%DC#4,P0 D MSG("NO CARRIER","M") Q 1 Q:%Y1=1 2 I %Y1'=13 S %Y=%Y_$C(%Y1) G P01 ;D MSG(%Y,"M") S %DT=%DT+1 S ^MODEM($P,"ATZ",%DT)=%Y Q:%Y1=1 3 I %Y'["OK" G P01:%DT#24,P0:%DT<49 D MSG("NO CARRIER","M") Q 4 S %DT=0 Q 0 %L3MENU %L3MENU ; VT220 OR PC [ 27.03.08 10:07 ] [ 08/20/2000 2:38 PM ] [ 05/21/97 7:49 AM ] U 0 ;S:'$D(%CL0) %CL0=44 I '$D(%POSIC) D ^%L1C W %HBR K %L3MOPT I '$D(MAC) W *7,!!?5,"*** HASN'T NAME ARRAY !" Q I $D(@MAC)<10 W *7,!!?5,"*** HASN'T DATA !" Q S %L1TXT=MAC_"(0)" S %M=MAC_"(%I)" S %LL=0 ; S:'$D(%CL1) %CL1=46 S:'$D(%CL2) %CL2=44 S:'$D(%CL3) %CL3=37 F %I=1:1 Q:'$D(@%M) I $L(@%M)>%LL S %LL=$L(@%M) S %I1=%I-1 I %I1>19 U 0 W !,*7," *** ARRAY TOO LARGE (",%I1,")" S %I="" H 2 G END I '$D(%SM) S %SM=80-%LL-4\2 I %SM<1!(%SM>70) S %SM=80-%LL-4\2 S:%SM<3 %SM=3 S %SMX=%SM S:'$D(%SMY) %SMY=23-%I1-4\2 I %SMY>22 S %SMY=23-%I1-4\2 S:%SMY<2 %SMY=2 X:'$D(%CLEAR) %chista S %AT="" ;"03-5620172 .lh n''ra ciixh oil`" I $D(^n($J)) S %AT=" b v n " S %SAY=%AT_"++0,"_(77-(80-$L(%AT)\2))_",H,I" X %XMSG I $D(@%L1TXT) S:'$D(%SMY0) %SMY0=2 S %SAY=@%L1TXT_"++"_%SMY0_","_(77-(80-$L(@%L1TXT)\2))_",H,I" X %XMSG D PHON F %I=1:1:%I1 S %XX=%SMX,%YY=%I+%SMY X %POSIC W %HBR,$J(@%M,%LL),%ENG S %XX=%SM,%YY=%SMY X %POSIC S %I=1 S:$D(%L2MN("IND")) %I=%L2MN("IND") D INV CYC R *%A I %A=27,%OPT=1 D DELAY R *%A1:0 D DELAY R *%B:0 G:%B>0 SERV I %A1<0 S %I=1 G END I %A=25 S %I=1 G END I %A=24 W *27,7 N %XXMNU,%YYMNU S %XXMNU=%XX,%YYMNU=%YY D ^%L1CLC W *27,8 S %XX=%XXMNU,%YY=%YYMNU X %POSIC S $X=%XX,$Y=%YY G CYC I %A=13 G END I $L($ZB)>3,$D(%UPRCOD($ZB)) S %B=$G(@("%"_%UPRCOD($ZB))) G SERV I %A=27 G SERV G CYC END S %L3MOPT=@%M K %A,%B,%M,@MAC,%LL,%I1,%B1,%B2 W %ENG W *27,*91,0,"m" I '$D(%CLEAR) X %chista E S %XX=0,%YY=%SMY-2 X %POSIC,%chiste K %SM,%SMX,%SMY W:$D(%HBRY) %HBR Q ;- SERV G:%B'=%VVERX&(%B'=%VNIZ)&($C(%B)'?1N.N) CYC ;I %B=%VVERX S:%I=1 %I="" G:%I="" END D CL S %I=%I-1 W %vverx D INV G CYC I %B=%VVERX G:%I=1 VNM D CL S %I=%I-1 W %vverx D INV G CYC ;I %B=%VNIZ S:%I=%I1 %I="" G:%I="" END D CL S %I=%I+1 W %vniz D INV G CYC I %B=%VNIZ G:%I=%I1 VVM D CL S %I=%I+1 W %vniz D INV G CYC G:$C(%B)<1!($C(%B)>%I1) CYC S %B1=$C(%B),%B2=%I-%B1 I %B2<0 D CL S %I=%B1,%pn=-%B2-1 X %vverxn D INV G CYC I %B2>0 D CL S %I=%B1,%pn=%B2-1 X %vnizn D INV G CYC ;- CL W *27,*91,0,"m" S %XX=%SMX,%YY=%I+%SMY X %POSIC W %HBR,$J(@%M,%LL),%ENG Q ;- INV W *27,*91,7,"m" S %XX=%SMX,%YY=%I+%SMY X %POSIC W %HBR,$J(@%M,%LL),%ENG Q ;- PHON ; W %ENG W *27,*91,0,"m" S %XX=%SM-1,%YY=%SMY+1 ;S %XX=%SM-3,%YY=%SMY-2 ;W "%YY=",%YY," %XX=",%XX," %I1=",%I1," %LL+4=",%LL+4 ; W $C(27,91),%YY,";",%XX,";",%YY+%I1+1,";",%XX+%LL+4,"b" S Y1=%YY,X1=%XX,Y2=%YY+%I1+1,X2=%XX+%LL+4 D RBUA Q CVET W $J("",%LL+4) I $D(%CL0) W *27,*91,%CL0,"m" E W *27,*91,0,"m" Q VNM D CL S %I=%I1,%pn=%I1-1 X %vnizn D INV G CYC VVM D CL S %I=1,%pn=%I1-1 X %vverxn D INV G CYC Q RBUA ; INPUT X1,X2,Y1,Y2 S %L1RBCL="" D ^%L1RBUA Q DELAY I %TYPCRT="PC1" F %II=1:1:%DELAY Q %L3MOUNT MOUNT ;JWC;MOUNT A VOLUME [ 10/03/93 11:03 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP. 1984 G ^DBMAINT ; for ignorant user MTVOLS S VGOF=$V(VGIN*4+VGTAB),MAXBLKS=0 F VIN=0:1:VOLS-1 D MNT I QF ZU 0 W !,"mounting failed at volume index ",VIN Q Q MNT D:OS OPNVOL D:'OS OPENOK Q:QF D PCHVOL S MAXBLKS=MAXBLKS+$P(LABEL(VIN),"^",4) Q PCHVOL S VF=VIN*8+VGOF+32 V VF:-3:$P(LABEL(VIN),"^",4):4,VF+6:-3:$P(LABEL(VIN),"^",6):2 I OS V VF+5:-3:HFSDBI:1 E V VF+4:-3:%DSK($P(LABEL(VIN),"^",8)):2 Q OPNVOL S HNAME=$P(LABEL(VIN),"^",8) D HFSTAB^%VGUTIL1 V HFSDB+24:-3:HNAME:64:1 ; poke in name and open flag I VGIN!VIN,OS=8 O 63,51:(HNAME:"CBM") U 51:(:::0) W *6 W:'$ZC *4 C 51 ; update 'last modified' date I 'VGIN,'VIN,OS'=8 S QF=0 G OPENOK S BYPASS=0 I OS=8 S BYPASS=$D(^SYS("DD",$P(HNAME,$C(0),1)))'>0 S MU=$ZB($V(SV,-3,2),16,1) ;multi-user flag S INTDRV=0 I OS=8&MU S INTDRV=$D(^SYS("DDINT",$P(HNAME,$C(0),1)))'>0 I OS=8&BYPASS S ^SYS("DD",$P(HNAME,$C(0),1))="" ZF S:INTDRV ^SYS("DDINT",$P(HNAME,$C(0),1))="" ZF ; flag to disable bypass I VGIN=0,VIN=0,OS=8 D CLOSE I QF ZU 0 W !!,"Cannot close Volume Group 0, call system manager!" Q V HFSDB+16:-3:#FFFFFF:4 ; SET MAX BLK NO I OS=8&'BYPASS G OPNVOL1 V 8+HFSDB:-3:$S(OS=8&BYPASS&('INTDRV):1,OS=8&BYPASS&INTDRV:3,1:0)+#100:2 D OPEN ; turn on Dave's driver if PC CHECK ; check HFSDBTAB for successful open S QF=0 I $ZB(FLAGS,#8000,1) Q:$ZV'["MSM-PC" D ^MOUNT1 Q:'QF ; TRY TO USE IT D CLOSE S QF=1 Q:OS'=8 OPNVOL1 ; TRY WITHOUT MS_DOS BYPASS V HFSDB+8:-3:#100:2 D OPEN I '$ZB(FLAGS,#8000,1) D CLOSE S QF=1 Q CLOSE ; unmount volume S QF=0,FLAGS=$V(8+HFSDB,-3,2) V 8+HFSDB:-3:$ZB(FLAGS,#200,7):2 O 63:(:::"S") C 63 F I=1:1:5 H 1 S FLAGS=$V(8+HFSDB,-3,2) I '$ZB(FLAGS,#200,1) Q E ZU 0 W !,"System won't unmount volume" S QF=1 Q OPEN ; mount volume ZU 0 W:'$G(STUAUTO) "." S VOF=512,QF=0 O 63 O 63:(:::"S") F I=1:1:3 H 1 S FLAGS=$V(8+HFSDB,-3,2) G:$ZB(FLAGS,#8000,1) OPENOK C 63 S QF=1 Q OPENOK ; O 63 S VMAP=$P(LABEL(VIN),"^",6)-1*512,SZ=512 V VMAP+1:$S(OS:"DB/"_HFSDBI,1:$P(LABEL(VIN),"^",8)) F I=511:-1:0 Q:$V(I,0,1)'=254 S SZ=SZ-1 ; get vol size V:OS HFSDB+16:-3:VMAP+SZ:4 ; PUT THE REAL BLK NO IN V:'OS $V($V(44)+448)+(VGIN*32)+(VIN*4):-3:VMAP+SZ:4 C 63 Q SETUCI ; SET UCI FROM BLK VGUCI O 63 V VGUCI:"G"_VGIN S VGOF=$V(VGIN*4+VGTAB),UCITAB=$V(VGOF+20),UCISZ=$V(SV+14,-3,2) F I=0:1:$V(12,-4,2)-1 S UCI=$V(I*UCISZ,0,UCISZ,1) V I*UCISZ+UCITAB:-3:UCI:UCISZ:1 Q LABEL ; VOL NAME^VG NAME^MAGIC^MAX BLK^HASH^REAL MAPS^VOL NO^HNAME I OS O %DEV:(HNAME:"CBM") U %DEV:(:::0) W *6 ; READ LABEL E V 0:HNAME U 63 S LABEL=$ZA U 0 I LABEL S LABEL="" Q S LABEL=$V(512,0,8,1)_"^"_$V(512+8,0,3,1)_"^"_$V(512+16,0,4)_"^"_$V(512+20,0,4)_"^"_$V(512+24,0,2)_"^"_$V(512+28,0,2)_"^"_$V(512+30,0,1)_"^"_HNAME Q %L3MYDV %L3MYDV(STAM) ; [ 28.02.05 16:56 ] [ 27.02.05 14:23 ] [ N N I $L($P) Q $P Q $J %L3MYDV0 %L3MYDVN(STAM) ; [ 09.07.06 12:09 ] [ 12.04.05 15:14 ] [ 06.04.05 19:38 ] I '$D(%L3GLD) S %L3GLD=$$^%L1GLD() I $L($P)>2,+$G(^[%L3GLD]devi($P)) Q +$G(^[%L3GLD]devi($P)) I $D(^[%L3GLD]devi($J))#2 Q ^[%L3GLD]devi($J) Q $J %L3MYDVN %L3MYDVN(STAM) ; [ 23.02.09 12:52 ] [ 08.02.09 16:01 ] [ 01.04.08 17:47 ] N %L3MYDVF S %L3MYDVF=0 I '$D(%L3GLD) S %L3GLD=$$^%L1GLD() BG I $L($P)>2,+$G(^[%L3GLD]devi($P)) D Q %NOM .S %NOM=^($P) .I $P["/pts/" D ..I $D(^zcmd($P)) S %WS=^($P) I $D(^[%L3GLD]devi3(%WS)) S %NOM=^(%WS) Q ..N WS S WS=$G(^[$$^%L1GLD]devi1($P)) I WS="" S %NOM=$J Q ..N MS S MS=$G(^[$$^%L1GLD]devi3(WS)) I MS="" S %NOM=$J Q ..S %NOM=MS ; I $D(^[%L3GLD]devi($J))#2 Q ^($J) ; Q $J %L3MYLPT %L3MYLPT(STAM) ; [ 04.04.05 13:12 ] [ 23.03.05 10:00 ] [ 27.02.05 11:28 ] Q $G(^DEV($$^%L3MYDVN,"LP")) SUG(STAM) ; Q $G(^DEV($$^%L3MYDVN,"LP","SUG")) CMDS(STAM) ; Q $G(^DEV($$^%L3MYDVN,"LP","CMDS")) CMDF(STAM) ; Q $G(^DEV($$^%L3MYDVN,"LP","CMDF")) %L3PCT %L3PCT ; PRINT/TYPE TAVLAOT [ 09/29/96 12:50 PM ] ;INP - %MBG("PAR"),%MBG("VGR0"),%MBG("VGR"),%MBG("STEP"),%MBG("NGR") I '$D(%POSIC) D ^%L1C N %BE,%LS,%S,%L1DS,OLDDAT,YOLD,SHOLD,SCHOLD N COLG,CIST,COLG,%ECHO,I,%I,%I1,%INV,J,JOLD,NPG,NPGL,OTB,PG,%PRNEW,RKV,RSCR,RZD,%REFH1 N SHOLD,SCHOLD,STEP,VGR0,VGR,XX0,X1,X2,Y1,Y2 ;SH,SCH ; N %HBRY S %HBRY="" I $D(%MBG("PAR"))>9 D ^%L3MBG1 S NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") ; BEG D INIT S %REFH1=$G(%MBG("REF"),"^MBG($P") D PS ZB S %GET="<<" D N^%L1GET I %TO="END"!(%TO=""&(%S="")) G END PGUP ; I %TO="PGUP" G:NPG'>1 ZB S NPG=NPG-1 K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG I %TO="PGDW" G:'$D(@(%REFH1_",SH-SCH+COLS+1)")) ZB S NPG=NPG+1,PG(NPG)=SH-SCH+COLS K SHOLD,SCHOLD,YOLD,%MBG("TO") G BEG G ZB ;- END S %YY=24,%XX=1 X %POSIC W %ENG,%chists,%HBR Q ;- PS D PS^%L3MBG Q CLEAR ; N %XX,%YY,I D ^%L1RBUA F I=Y1:1:Y2-2 S %XX=X1,%YY=I X %POSIC W $J("",X2-X1-1) Q ;- ZAPR ; S %XX=X1,%YY=Y2-2 X %POSIC W $J("",X2-X1-1) S %GET=" - jiyndl , <.> - miiql , 1 - owzl, 0 - mcew jqn ++"_(Y2-2)_",75,HH#++1,E,I++10.u" D ^%L1GET S OTB=%S I OTB=0 Q:NPG'>1 S NPG=NPG-1 Q I OTB="" S NPG=NPG+1,PG(NPG)=SH-SCH+COLS Q I OTB'="."&(OTB'=1) W *7,*7 H 1 G ZAPR Q ER ; S %XXX=%XX,%YYY=%YY,$X=%XX,$Y=%YY W *7 S %SAY=" d`iby ++0,40,HH,I" X %XMSG H 2 S %SAY=" ++0,40,HH,I" X %XMSG S %XX=%XXX,%YY=%YYY X %POSIC Q INIT S:'$D(NPG) NPG=1,PG(1)=0 S RZD=$G(%MBG("RZD"),"\") S VGR0=$G(%MBG("VGR0"),1),VGR=$G(%MBG("VGR"),3) S Y1=VGR0,X1=%MBG("LL")-1,Y2=$G(%MBG("NGR"),24) S COLG=%MBG("COLG") S XX0=$G(%MBG("LR"),70)+5,X2=XX0+1 S:XX0>79 XX0=79 S RSCR=Y2-VGR-2,STEP=$G(%MBG("STEP"),2) S COLS=RSCR-STEP\STEP,SCH=0,%YY=VGR,SH=PG(NPG) Q %L3RD %L3RD ;DJM;DISPLAY ROUTINE DIRECTORY; [ 11/17/92 9:57 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 W !!,?20,"ROUTINE DIRECTORY " D ^%D W !,?24,"OF ",$$^%L1ZU(0),?39 D ^%T W ! INT ; N %RDS,%RDA S $ZT="ZG "_$ZL_":ERROR^%L3RD",%NAM="",%RDS=1,%RDA="" F %RNUM=0:1 S %NAM=$O(^ (%NAM)) Q:%NAM="" X:'(%RNUM#8) "W ! S %RDS=%RDS+1" X:'(%RDS#20) "R !,""<>"",%RDA S %RDS=1 W *13" Q:$L(%RDA)&("/.?^"[%RDA) W ?(%RNUM)#8*10,%NAM W !,?5,%RNUM," Routine",$S(%RNUM=1:".",1:"s.") EXIT ; K %NAM Q ERROR ; I $F($ZS,"") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q %L3RI %L3RI ; [ 11.01.26 04:15 ] [ N ARG S ARG=$ZCMD D ^%L2RI(ARG) Q %L3RR %L3RR ;DJM;MSM: ROUTINE RESTORE; [ 06/28/94 5:43 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. (c) 1985 S $ZT="ZG "_$ZL_":ERR^%L3RR" W !?10,$P($P($ZV,","),"-")," - ROUTINE RESTORE UTILITY" S %FN=^%L3RR("FN") D GETHFS^%SDEV I '%DEV U 0 W !!,"ALL HOST FILE SERVER (HFS) DEVICES ARE BUSY" Q O %DEV:%FN U %DEV G:$ZA OPENHFS OPENHFS O %DEV:(%FN:"R") U %DEV S %ZA=$ZA U 0 I %ZA<0 W !,?5,"OPEN FAILED ON DEVICE ",%DEV," FOR FILE ",%FN,*7 C %DEV U 0 Q INT ; BYPASS DEVICE SELECTION, %DEV=INPUT DEV, MUST BE ALREADY OPEN S %TAP=%DEV>46&(%DEV<51) S (%RNUM,%C,%S,QUIT)=0,%SEQ=1 Q:%TAP U %DEV R %TIME,%CMT G:%TIME="" L4 I %TIME?1"DISK#"1N.N S %TIME=%CMT R %CMT U 0 W !,"ROUTINE(S) SAVED AT ",%TIME,!,"HEADER COMMENT IS: ",%CMT L1 U 0 S %RT=1 G L2 L2 I %RT U 0 W !,"RESTORING...",! S $ZT="ZG "_$ZL_":ERR1^%L3RR" F %I=1:1 U %DEV R %RN Q:%RN="" D:%RN="*EOF*" NEXTFILE Q:QUIT D RESTORE Q:QUIT I 'QUIT,%TAP Q L4 U 0 W !!,%RNUM," ROUTINE",$S(%RNUM=1:"",1:"S")," RESTORED." I $D(%DEV),%DEV>58,%DEV<63 U %DEV S %RN=$ZA U 0 W !,"LAST BLOCK READ IN: ",%RN EXIT ; I $D(%DEV) I %DEV'=$P C %DEV C 63 I $D(%TAP) D:%TAP %KILL^%MTCHK K %DEV,%I,%RN,%RNN,%RR,%RNUM,%RT,%PCODE,%SBP,%S,%C,%RC,%FN,%SEQ,%SIZE,%X,%ZA,QUIT,%TAP,%TIME,%CMT Q RESTORE ; I %RT S %RNN=%RN G R1 R1 ; I $ZN=$P(%RNN,":") U 0 W !," *** ",$ZN," CANNOT RESTORE OVER ITSELF" G L1 D PCZLOAD I %PCODE U %DEV X "ZL ZS @%RNN" S %RNUM=%RNUM+1 U 0 I %RT W:'(%RNUM-1#8) ! W ?%RNUM-1#8*10,%RNN Q W " --RESTORED" Q PCZLOAD I $P(%RN,":",2)="" S %PCODE=1 Q D ZLOAD Q ;I $L(%RNN)<9,%RNN?1A.AN!(%RNN?1"%".AN) G R1 ;I $L(%RC)<9,%RC?1A.AN!(%RC?1"%".AN) S %C=1 G RESTORE ERR ; I $F($ZS,"") U 0 W !!,"...ABORTED." G L4 Q ERR1 ; I $F($ZS,"") Q I $F($ZS,"") U 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q PCSKIP ; I $P(%RN,":",2)="" S %PCODE=1 Q N (%DEV,%RNN,%PCODE) S %ZERO=$C(0,0,0,0) D SKIPHFS S %PCODE=0 Q U 0 W !!,"*** CANNOT RESTORE COMPILED ROUTINES THROUGH DEVICE #",%DEV,!,*7 W 1/0 Q SKIPHFS S %DLMS=24 D GETDLM U %DEV:(:::::"") D SKIPRTN U %DEV:(:::::%DLMS) Q SKIPRTN F %X=1:1 R %BLK#1024 Q:$E(%BLK,1013,1016)=%ZERO Q:$ZC S %PCODE=0 Q ZLOAD N (%DEV,%RNN,%PCODE) S %RNN=$P(%RNN,":") X "ZR ZI %RNN_"" "" ZS @%RNN" ;create dummy routine S %BN=$ZBN(^ (%RNN)),%BNHDR=%BN,%PTR=#1000000 S %UI=$$^%L1ZU(0),%UI=$ZU($P(%UI,","),$P(%UI,",",2)),%VGI=$P(%UI,",",2),%UI=+%UI,UCITAB=$V($V($V(10,-5)+(%VGI*4))+20) S RP=$V(UCITAB+(%UI-1*32)+20,-3,2)*512 K UCITAB,%UI,%VGI O 63::0 E U 0 W !,"Waiting for device 63" O 63 G LOADHFS:%DEV>50&(%DEV<55) U 0 W !!,"*** CANNOT RESTORE COMPILED ROUTINES THROUGH DEVICE #",%DEV,!,*7 C 63 S %PCODE=1 Q LOADHFS S %DLMS=24 D GETDLM U %DEV:(:::::"") D XFER U %DEV:(:::::%DLMS) Q XFER R %BLK#1024 XFER10 V 0:0:%BLK:1024:1 G:'$ZC XFER20:$V(1012,0,4) ;continuation block present S %BNTAB($V(1016,0,4))=%BN V 1016:0:%BN:4,-%BN,%BNHDR F %Z=18,24 S %X=$V(%Z,0,4),%Y=%X#%PTR,%X=%X\%PTR,%Y=%X*%PTR+%BNTAB(%Y) V %Z:0:%Y:4 V -%BNHDR C 63 S %PCODE=0 Q XFER20 ;THERE WILL BE A CONTINUATION BLOCK S %BNX=$ZBN("",RP),%BNTAB($V(1016,0,4))=%BN V 1016:0:%BN:4,1012:0:%BNX:4,-%BN S %BN=%BNX G XFER GETDLM S %SV=$V(44),%SVA=%SV+$V(%SV+8,-3,2),%DDBTB=$V(%SVA+28),%DDB=$V(%DEV*4+%DDBTB) S %DLMS=$V(%DDB+%DLMS+1,-3,$V(%DDB+%DLMS,-3,1),1) Q NEXTFILE ; Q:%TAP C %DEV U 0 W !,"SEQUENCE #",%SEQ," RESTORED" W !,"PLEASE PUT SEQUENCE #",%SEQ+1," INTO THE DRIVE AND" S %SEQ=%SEQ+1 NEXTFIL1 R !,"PRESS WHEN READY",%X I %X?1"?".E W !!,"PRESS TO CONTINUE RESTORING FROM SEQUENCE #",%SEQ,!,"OR ABORT THE RESTORE BY ENTERING 'CONTROL C'" G NEXTFIL1 O %DEV:%FN U %DEV I '$ZA R %X I '$ZC U 0 E W !!,"CANNOT ACCESS ",%FN,", PLEASE CORRECT" G NEXTFIL1 I %X?2NP1":"2N1" ".E S %X=1 I %X?1"DISK#"1N.N S %X=$P(%X,"#",2) I %X'=%SEQ W !!,"OUT OF SEQUENCE, THIS FILE IS #",%X,", PLEASE CORRECT" G NEXTFIL1 I %RT U 0 W !,"RESTORING...",! U %DEV R %RN S QUIT=0 Q %L3RSEL %L3RSEL ; [ 10/23/95 8:09 PM ] ;K ^UTILITY($J) I $E(%RS)="-" G DEL S %P=$$%SRCHPAT^%SRCHPAT(%RS) S %RN=0,X=FIRST D:FIRST'="" .Q:$D(^ (X))=0 Q:X]LAST X %P S:$T %RN=%RN+1,^UTILITY($J,FIRST)="" F S X=$O(^ (X)) Q:X=""!(X]LAST) X %P S:$T %RN=%RN+1,^UTILITY($J,X)="" U 0 W !!,?10,%RN," ROUTINE SELECTED." Q DEL ; S %P=$$%SRCHPAT^%SRCHPAT($E(%RS,2,$L(%RS))),%RN=0 S %RN=0,X=FIRST D:FIRST'="" .Q:$D(^UTILITY($J,X))=0 Q:X]LAST X %P I $T S %RN=%RN+1 K ^UTILITY($J,X) F S X=$O(^UTILITY($J,X)) Q:X=""!(X]LAST) X %P I $T S %RN=%RN+1 K ^UTILITY($J,X) U 0 W !!,?10,%RN," ROUTINE DE-SELECTED." Q %L3SHAP %L3SHAP ; [ 14.01.06 18:55 ] [ 13.01.06 11:57 ] [ 17.05.04 18:54 ] ;INPUT: %L1PC("SHP","KOD") - HEADER'S CODE ; %L1PC("SHP","SC") - LINE'S COUNTER ; %L1PC("SHP","SM") - OFFSET ; %L1PC("SHP","SL") - PAGE'S COUNTER ; %L1PC("SHP","PAGE") - IF $D - START FROM NEW PAGE ; %L1PC("SHP","PRPC") - PRINT LINE ; USTR - 0,3 ;OUTPUT: ; PEND1 - LAST COLUMN ; RLIST - GODEL DAF ; CHERTA - KAV TAHAT KOTERET ; MPOZ ,NSP N %NEXTS,%LENGTH,%STRS,%K,%POZ,%IND,%NEXTS,%I,%HBRY N KOD,SC,SM,SL,L1PAGE,PRPC,USTR0 S USTR0=$G(USTR) N USTR S USTR=USTR0 Q:'$D(%L1PC("SHP","KOD")) I '$$^%L1DISP(USTR) S %DEV="USTR" D ^%L1LPT Q:%EROP I $G(%L1PC("SHP","PROG"))'="" X %L1PC("SHP","PROG") S KOD=%L1PC("SHP","KOD") ;S SC=+$G(%L1PC("SHP","SC")) S SM=$G(%L1PC("SHP","SM"),1) S SL=$G(%L1PC("SHP","SL"),1) S PRPC=$G(%L1PC("SHP","PRPC"),1) I $$^%L1DISP(USTR) W %HBR S %HBRY="" S %SS="&" S:'$D(SM) SM=1 S:'$D(SC) SC=0 S:'$D(SL) SL=1 S:'$D(PRPC) PRPC=1 I PRPC,'$D(USTR) U 0 W !,*7,"*** DEVICE ISN'T DEFINED (USTR) !" H 2 Q I '$D(^SHP(KOD)) U 0 W !,"*** COD HEADER ISN'T GOOD: ",KOD," !" H 2 Q S %NEXTS=^SHP(KOD,1) ;;O USTR::2 E U 0 W *7 S %SAY=" dqetz zqtcn " X %XMSGV(1) Q U USTR I $$^%L1DISP(USTR) U $P:(NOECHO:NOWRAP) I PRPC U USTR W:$D(%L1PC("SHP","PAGE"))&USTR # X:$D(%L1PC("SHP","PAGE"))&(USTR=0!(USTR=$P)) %chista W:$D(%L1PC("SHP","PAGE"))&(USTR=0!(USTR=$P))&(%TYPCRT="PC") ! W:'$D(%L1PC("SHP","PAGE")) ! D FSHAP S RLIST=66-%I ;S PEND1=$L(^(%I-2))+SM-3 ;S CHERTA=^(%I-1) S %L1PC("SHP","SC")=SC+1 S %L1PC("SHP","SL")=SL K %NEXTS,%LENGTH,%STRS,%K,%POZ,%IND,%NEXTS Q FSHAP ; N %STRS F %I=1:1 Q:'$D(^SHP(KOD,%I))#10 Q:$E(^(%I))?1N S %STRS=^(%I),%POZ=0 D PSK D:PRPC PCS S SC=SC+1 I SC>68 S SC=0,SL=SL+1 S:'$D(RAZD) RAZD=":" I $D(^(%I)) K MPOZ F J1=%I:1 Q:'$D(^(J1)) D DO1 G EN1 DO1 ; N SHPZ S %POZ=1,SHPZ=0 F J2=1:1 S %POZ=$F(^(J1),RAZD,%POZ) Q:'%POZ S SHPZ=SHPZ+1,MPOZ($E(^(J1)),SHPZ)=%POZ+SM-1 S %CPOZ=SHPZ Q EN1 ; Q PCS I '$D(TS0)!'$D(TSS) D ^%L1TS N %II,%W1 S %STRS=$TR($TR(%STRS,%TES1,%TES2),%TEN,%THB) W ?SM,$S(USTR=0!(USTR=$P):$P(%STRS,"#"),1:$TR($P(%STRS,"#"),TS0,TSS)) S %W1=0 F %II=2:1:$L(%STRS,"#") D .S $X=0 S %W1='%W1 .I '$$^%L1DISP(USTR) W %L1OUT("MDP",$S(%W1:"B",1:"N")) W $TR($P(%STRS,"#",%II),TS0,TSS) .I $$^%L1DISP(USTR) W:%W1 %ENG,%CLI,%HBR W $P(%STRS,"#",%II) U $P X %XCL I '$$^%L1DISP(USTR),%W1=1 W *27,%L1OUT("MDP","N") W ! Q DEFL N %K I $D(^("P"_%IND)) S %LENGTH=^("P"_%IND) Q F %K=%POZ+2:1 Q:$E(%STRS,%K)'=" " S %LENGTH=%K-%POZ+1 K %K S ^("P"_%IND)=%LENGTH Q PSK ; F %J=%POZ:0 S %POZ=$F(%STRS,%SS,%POZ) Q:%POZ<1 S %IND=+$E(%STRS,%POZ,%POZ+1) D DEFL S %NST=$S($D(MAS(%IND)):$E(MAS(%IND),1,%LENGTH),1:""),%STRS=$E(%STRS,1,%POZ-2)_%NST_$J("",%LENGTH-$L(%NST))_$E(%STRS,%POZ+%LENGTH-1,255) Q %L3SP %L3SP ;DJM;DISPLAY AVAILABLE SPACE; [ 31.12.06 08:53 ] [ 11/28/97 12:57 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 ;ZU 0 W !?10,$C(27,41,74,27,91,55,109)," zkxrn jeza wqica iept mewn zwica ",$C(27,91,48,109) O 63::0 I '$T W !,"VIEW BUFFER BUSY." Q D GETVG S %NOSHOW=0 D ^%L1C ;I %VG=1 S %VGI=0,%VOLP=$V(%VGTAB) D DISPVG G EXIT S %VGI=0,%VOLP=$V(%VGTAB) D DISPVG G EXIT ;D SPACE EXIT ; C 63 K %I,%VGTAB,%VOLP,%VGNA,%VGI,%FLAG,%VG,%X,%OS Q DISPVG ;DISPLAY ONE VOLUME GROUP Q:'$V(%VOLP+4,-3,2) S %VGNA=$V(%VOLP,-3,3,1) S %NOVOL=$V(%VOLP+30,-3,2),%TOTBLK=0,%FTOTBLK=0 I '$G(%ENGLISH) ZU 0 W %HBR,!!?13,"miwela k''dq",?28,"miept miwela",?44,"%- iept" I $G(%ENGLISH) ZU 0 W !!?11,"TOTAL OF BLOCKS",?28,"FREE BLOCKS",?44,"%- FREE" ZU 0 W !?11,"---------------",?28,"-------------",?44,"--------" D INT K %NOVOL,%DB,%VOLENT,%SPMAP,%SZ,%SP,%SPLAB,%SPDBNA,%I,%J,%HFSDB,%VA,%HFSTAB Q INT NEW (%FTOTBLK,%TOTBLK,%VGI,%NOSHOW) I '$D(%NOSHOW) S %NOSHOW=1 D PTRS^%SP O 63 S (%TOTBLK,%FTOTBLK)=0 I '$D(%VGI) S %VGI=0 S %VOLP=$V(%VGI*4+%VGTAB),%NOVOL=$V(%VOLP+30,-3,2) I %OS S %HFSTAB=$V(44,-5) S %SPFBLK=0 F %DB=0:1:%NOVOL-1 S %VOLENT=%VOLP+32+(%DB*8) D DBDISP S %SPFBLK=%SPFBLK+$V(%VOLENT,-3,4) Q INT1 ; N (%DB,%SP,%SZ,%VGI,VGVOL) D PTRS S (%TOTBLK,%FTOTBLK)=0,%VOLP=$V(%VGI*4+%VGTAB),%NOVOL=$V(%VOLP+30,-3,2),%NOSHOW=1 I %OS S %HFSTAB=$V(44,-5) S %VOLENT=%VOLP+32+(%DB*8),%SPFBLK=$P(VGVOL(%DB),"^",2) D DBDISP Q DBDISP ; S %SPMAP=$V(%VOLENT+6,-3,2) D DBDISP1,HFS I '%NOSHOW ZU 0 W !,?11,$J(%SZ,8,0),?28,$J(%SP,8,0),?44,$J(%SP*100/$S(%SZ:%SZ,1:1),6,2) S %TOTBLK=%TOTBLK+%SZ,%FTOTBLK=%FTOTBLK+%SP Q DBDISP1 ;GET TOTAL BLOCKS & TOTAL FREE BLOCKS S %SP=0,%SZ=0 S %SPMP=$V(%VOLENT+6,-3,2) INTSUM ; F %K=0:1:%SPMP-1 D DBSPACE Q DBSPACE ;COMPUTE TOTAL BLOCKS & FREE BLOCKS V %K*512+%SPFBLK+1:"G"_%VGI S %SP=%SP+$S($V(1022,0,2)>511:0,1:$V(1022,0,2)) Q:%OS I %K'=(%SPMP-1) S %SZ=%SZ+512 Q F %L=0:1:511 Q:$V(%L,0,1)=#FE S %SZ=%SZ+1 Q PTRS S %VGTAB=$V(10,-5) OS S %OS=$V(0,-4,2)#16 ; GET OPERATING SYSTEM TYPE, 0=SA, 3=UNIX5, 6=DG, 8=MS/DOS Q GETVG ; GET LIST OF MOUNTED VOLUME GROUPS D PTRS K %VG S %VG=0 F %I=0:1:7 S %VGI=$V(4*%I+%VGTAB) I %VGI D GETVG1 Q GETVG1 ; GET ONE VOLUME GROUP S %X=$V(%VGI+4,-3,2) Q:'%X S %VG(%I)=$V(%VGI,-3,3,1),%VG=%VG+1 S %VG($V(%VGI,-3,3,1))=%I Q HFS G:'%OS SA S %HFSDB=$V($V(%VOLENT+5,-3,1)*4+4+%HFSTAB),%SZ=$V(%HFSDB+16,-3,4),%SPDBNA=$P($V(%HFSDB+24,-3,64,1),$C(0),1) Q SA S %SPDBNA=$V($V(4*$V(%VOLENT+5,-3,1)+76+$V(4*$V(%VOLENT+4,-3,1)+$V($V(18,-5)+16))),-3,$S($ZB($V(0,-4,2),#F00,1)=#800:3,1:8),1) Q %L3SS %L3SS ; [ 28.03.07 13:04 ] [ 21.10.06 17:56 ] [ 09.05.06 06:57 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" BG D FRM Q ; FRM ; N %NMF,%NMF0,%NMF1,%NM,%IO,I,A,B,PID,%NAME,%REF,%DEV S %NMF="l1ss"_$J S %IO=$I I $$^%L1ZOS(2,%NMF) ZSY "ps -fC mumps > "_%NMF I $$^%L1ZOS(10,%NMF)<0 Q O %NMF:(REWIND:READONLY) S I=2 K ^TMPS111($J),^l1ss($J) S ^TMPS111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^TMPS111($J,2)="---- ----- -------- --------------- ---------------------- --------------- " F U %NMF R A Q:$ZEOF D .S PID=$TR($E(A,10,14)," ","") Q:'PID .S %NMF0="GTM_JOBEXAM.ZSHOW_DMP_"_PID_"_" .ZSY "rm -f "_%NMF0_"*" .ZSY $$^%L1ENVAR("gtm_dist")_"/mupip intrpt "_PID .S %NMF1=$$^%L1ZOS(13,%NMF0_"*") Q:'$L(%NMF1) .Q:%NMF1'[%NMF0 .I '$$SIZE^%L1ZOS(%NMF1) Q .O %NMF1:(REWIND:READONLY) .S %NAME="",%REF="",%DEV="" .F U %NMF1 R B Q:$ZEOF D ..I $E(B,1,11)="$ZPOSITION=" S %NAME=$P(B,"=",2) ..I $E(B,1,11)="$REFERENCE=" S %REF=$P(B,"=",2) ..I B[" OPEN RMS",B'["GTM_JOBEXAM" S %DEV=%DEV_$S($L(%DEV):",",1:"")_$P(B," ") .C %NMF1 ;;:DELETE .F %NM="%NAME","%REF","%DEV" S @%NM=$TR(@%NM,"""","") .S I=I+1,^TMPS111($J,I)=$E(A,10,14)_" "_$E(A,25,39)_" "_%NAME_$J("",15-$L(%NAME))_" "_%REF_$J("",23-$L(%REF))_" "_%DEV .S ^l1ss($J,I,"NMF")=%NMF1 ; I $$^%L1ZOS(2,%NMF) U 0:(NOECHO:NOWRAP) W !! F I=1:1 Q:'$D(^TMPS111($J,I)) W ^(I),! K ^TMPS111($J),^l1ss($J) Q KLJ(NMPROG) ; N ST S ST=$$WHATNMB(NMPROG) ; I 'ST Q 0 ZSY "kill "_$P(ST,"~",2) Q 1 WHATNMB(NMPROG) ; N A,U,I,PROG K ^TMPS111($J) D FRM S U=0 F I=1:1 Q:'$D(^TMPS111($J,I)) D .S A=$G(^(I)) .S PROG=$P($P($E(A,25,50)," "),"^",2) Q:PROG?.P .I PROG=NMPROG S U=I I 'U Q 0 S A=$G(^TMPS111($J,U)) K ^TMPS111($J),^l1ss($J) Q U_"~"_$TR($$SP1^%L1FRM(A)," ","~") %L3SSD %L3SSD ;CDS;SYSTEM SHUTDOWN; [ 01/04/99 10:13 AM ] [ 10/29/97 5:11 AM ] H %L3TRTB %L3TRTB ;CLJ;EDIT/ENABLE/DISABLE TRANSLATION [ 07/17/92 2:38 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1990 K stmsm INT1 S $ZT="ZG "_$ZL_":ERR^%L3TRTB",SGNDX=1 S SGCNFG=+^SYS("CONFIG",$P(^SYS("CONFIG"),";",2)) ;;W !?10,$P($P($ZV,","),"-")," - TRANSLATION/REPLICATION MANAGEMENT UTILITY" D:$D(stmsm) CONFIG^SGCNFG D INT K SGNDX,SGCFNM,EDITED Q INT N (SGCNFG,EDITED,SGDSP,QUIT) ;;I $G(SGDSP)="DISPLAY" D DISP,DISP^REPTABLE G EXIT2 ;;S SGID="TRANSLAT",SGHDR="AVAILABLE FUNCTIONS:" S:'$D(EDITED) EDITED=0 D ^SGMENU G:$D(QUIT) EXIT G:SGOPT="" EXIT ;;I '$D(@("^ ("""_$P(SGOPT,"^",2)_""")")) ZU 0 W !,"Option not available" ;;E D @SGOPT S SGOPT="EDIT" D @SGOPT ;;R !!,"Press to continue",SGOPT G INT EXIT ; D:$G(EDITED) EDITED EXIT2 K SGID,SGOPT,SGHDR Q ERR I $F($ZS,"") U 0 ZU 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q ; EDIT ;EDIT TRANSLATION TABLE ;SGCNFG IS THE CONFIGURATION INDEX D DISP S SV=$V(44),PB=$V(SV+8,-3,2),MAX=$V($V(32*4+PB+SV),-3,4) EDIT10 S SG=^%L3TRTB("SG") ;R !!,"ENTER TRANSLATION TABLE INDEX: ",SG Q:SG=""!(SG="^")!(SG="^Q") I SG?1.N,SG>0,SG'>MAX S T=$G(^SYS(SGCNFG,"TRANSLATE",SG)) D GET G KEY I SG?1.N,SG>0,SG'>MAX S T=$G(^SYS(SGCNFG,"TRANSLATE",SG)) D GET G KEY I SG?1"-"1.N S SG=$E(SG,2,99),X=$S($D(^SYS(SGCNFG,"TRANSLATE",SG)):1,1:0) K:X ^(SG) S:X EDITED=1 W:X " ...deleted" W:'X *7," ...no such entry" Q I SG="?" S V="SG" D DUMMY Q I SG="^L" D DISP Q Q FROM ;TRANSLATE FROM UCI S V="FROM",PRMPT="UCI TO TRANSLATE FROM",CONTROL="1`EDIT10`BIT``TO`DUMMY",VAL="4`VALUCI",SPECPROC="" G ASK TO ;TRANSLATE TO UCI S V="TO",PRMPT="UCI TO TRANSLATE TO",CONTROL="0`EDIT10`FROM``LOCK`DUMMY`DEL",VAL="4`VALUCI",SPECPROC="2`S:X="""" TV=""NO"" I 1" G ASK LOCK ;LOCK MASTER S PRMPT="UCI FOR MAINTENANCE OF LOCKS",V="LOCK",CONTROL="0`EDIT10`TO``RI`DUMMY`DEL",VAL="4`VALUCI",SPECPROC="2`S:X="""" LV=""NO"" I 1" G ASK RI ;REPLICATION INDEX S V="RI",PRMPT="REPLICATION TABLE INDEX",I="FILE" F J="TO^TV","LOCK^LV","RI^RV" I @$P(J,"^")'="" S I=$P(J,"^",2) Q ;ESTABLISH PROCEED BRANCH S CONTROL="0`EDIT10`LOCK`DISP^REPTABLE`"_I_"`DUMMY`DEL",VAL="1`I X?1.N,$D(^SYS(SGCNFG,""REPLICATE"",X))#10",SPECPROC="2`S:X="""" RV=""NO"" S:$P(CONTROL,""`"",5)=""RV""&(@V="""")&(X="""") $P(CONTROL,""`"",5)=""FILE"" I 1 " G ASK TV ;TRANSLATION VALID S:TV="" TV="YES" S V="TV",PRMPT="ENABLE TRANSLATION",I="FILE" F J="LOCK^LV","RI^RV" I @$P(J,"^")'="" S I=$P(J,"^",2) Q S CONTROL="0`EDIT10`RI``"_I_"`DUMMY",VAL="2`YES`NO",SPECPROC="" G ASK LV ;LOCK MASTER VALID S:LV="" LV="YES" S V="LV",PRMPT="ENABLE LOCK TABLE TRANSLATION",I="TV",J="RV" S:TO="" I="RI" S:RI="" J="FILE" S CONTROL="0`EDIT10`"_I_"``"_J_"`DUMMY",VAL="2`YES`NO",SPECPROC="" G ASK RV ;REPLICATION VALID S:RV="" RV="YES" S V="RV",PRMPT="ENABLE REPLICATION",I="RI" F J="LOCK^LV","TO^TV" I @$P(J,"^")'="" S I=$P(J,"^",2) Q S CONTROL="0`EDIT10`"_I_"``FILE`DUMMY",VAL="2`YES`NO",SPECPROC="" G ASK CS ;COLLATING SEQUENCE S V="CS",PRMPT="COLLATING SEQUENCE" S:CS="" CS="NUMERIC" S CONTROL="1`EDIT10`KEY``BIT`DUMMY",VAL="2`NUMERIC`STRING",SPECPROC="" G ASK BIT ;COLLATING SEQUENCE S V="BIT",PRMPT="Global encoding [7=7-bit/8=8-bit]" S:BIT="" BIT=8 S CONTROL="1`EDIT10`CS``FROM`DUMMY",VAL="2`7`8",SPECPROC="" G ASK KEY ;KEY TO MATCH S V="KEY",PRMPT="GLOBAL NAME",CONTROL="1`EDIT10`EDIT10``CS`DUMMY",VAL="1`S:$E(X)=""^"" X=$E(X,2,999) I X?1.8AN!(X?1""%"".7AN)!(X?.7AN1""*"")!(X?1""%"".6AN1""*"")",SPECPROC="" G ASK FILE ;FILE TABLE ENTRY D PUT S ^SYS(SGCNFG,"TRANSLATE",SG)=T,EDITED=1 D DISP Q ; DISP ;DISPLAY TRANSLATION TABLE Q I $D(^SYS(SGCNFG,"TRANSLATE")) ZU 0 W !!,"CURRENT TRANSLATION TABLE: " D DISP2 F SG=-1:0 S SG=$N(^SYS(SGCNFG,"TRANSLATE",SG)) Q:SG<0 D DISP3 I '$D(^SYS(SGCNFG,"TRANSLATE")) ZU 0 W !!,"TRANSLATION TABLE IS EMPTY." Q DISP2 ; ZU 0 W !!," GLOBAL TRANSLATE LOCK REPL FUNCTIONS COLL GLOBAL" ZU 0 W !,"# NAME(S) FROM UCI TO UCI MASTER IND ENABLED SEQ ENCODE" ZU 0 W !,?3,"------- ---------------- ------ ---- --------- ---- ------" Q DISP3 ; S T=^SYS(SGCNFG,"TRANSLATE",SG),X=$P(T,"^") D UNHASH ZU 0 W !,SG,?3,$P(T,"^",10)_$S($ZB(+$P(T,"^",7),8,1):"*",1:""),?15,X,"," S X=$P(T,"^",2) D UNHASH ZU 0 W X S X=$P(T,"^",3) I X D UNHASH ZU 0 W ?24,X,"," S X=$P(T,"^",4) D UNHASH W X S X=$P(T,"^",5) I X D UNHASH ZU 0 W ?34,X,"," S X=$P(T,"^",6) D UNHASH W X S X=$P(T,"^",8) W:X?1.2N ?45,X S S="",X=$P(T,"^",7) F I=1,2,4 S:$ZB(+X,+I,1) S=S_I I S'="" S X=$E(S),S=$E(S,2,999) ZU 0 W ?50,$S(X=1:"TRANSLATION",X=2:"REPLICATION",X=4:"LOCK MASTER",1:"") ZU 0 W ?64,$E($P(T,"^",9),1,3) W ?70,$P(T,"^",11)_"-bit" F I=0:0 Q:S="" S X=$E(S),S=$E(S,2,99) W !,?50,$S(X=1:"TRANSLATION",X=2:"REPLICATION",1:"LOCK MASTER") Q GET ;EXTRACT INFO FROM ^SYS (PASS IN T) S (FROM,TO,LOCK,TV,LV,RV,RI,CS,KEY,BIT)="" S X=$P(T,"^") I X D UNHASH S FROM=X_"," S X=$P(T,"^",2) D UNHASH S FROM=FROM_X S X=$P(T,"^",3) I X D UNHASH S TO=X_"," S X=$P(T,"^",4) D UNHASH S TO=TO_X S X=$P(T,"^",5) I X D UNHASH S LOCK=X_",",X=$P(T,"^",6) D UNHASH S LOCK=LOCK_X S X=$P(T,"^",7) F I="1:TV","2:RV","4:LV" S @$P(I,":",2)=$S($ZB(+X,+I,1):"YES",1:"NO") S RI=$P(T,"^",8),CS=$P(T,"^",9),KEY=$P(T,"^",10)_$S($ZB(+X,8,1):"*",1:""),BIT=$P(T,"^",11) Q PUT ;REBUILD ^SYS NODE (PASS BACK IN T) S T="" F I=1:1:3 F J=1,2 S X=$P(@$P("FROM^TO^LOCK","^",I),",",J) I X'="" D HASH S $P(T,"^",I-1*2+J)=Y S $P(T,"^",7)=$S(TV["Y":1,1:0)+$S(RV["Y":2,1:0)+$S(LV["Y":4,1:0)+$S(KEY["*":8,1:0) S $P(T,"^",8)=RI,$P(T,"^",9)=CS,$P(T,"^",10)=$P(KEY,"*"),$P(T,"^",11)=BIT Q UNHASH ; UNHASH A UCI NAME, INPUT IN X, RETURNED IN X S X(1)=X\2048,X=X-(X(1)*2048),X(2)=X\64,X(3)=X-(X(2)*64)/2,X=$C(X(1)+64,X(2)+64,X(3)+64) ;UNHASH NAME K X(1),X(2),X(3) Q HASH ; HASH A UCI NAME, INPUT IN X, RETURNED IN Y S Y=0 F Z=1:1:3 S Y=Y*32+$A(X,Z)-64 S Y=Y+Y Q ASK ;QUESTION HANDELER ;PASS IN V,PRMPT,CONTROL. V CONTAINS CURRENT VARAIBLE NAME. PRMPT IS THE PROMPT. ;CONTROL="REQUIRED 1 OR 0`^Q BRANCH`^ BRANCH`^L ROUTINE`PROCEED BRANCH`? ROUTINE ;W !!,PRMPT W:@V'="" " <",@V,">" R ": ",X S X=$G(^%L3TRTB(V),@V) I X?1"-".N,$P(CONTROL,"`",7)'="" D @$P(CONTROL,"`",7) I X="",@V="",$P(CONTROL,"`",8)'="" G @$P(CONTROL,"`",8) I X="",@V'="" S X=@V ;FIX FOR DEFAULT I X="" G:@V=""&(CONTROL) @$P(CONTROL,"`",3) G @$P(CONTROL,"`",5) I X="?" D @$P(CONTROL,"`",6) G ASK I X="^L",$P(CONTROL,"`",4)'="" D @$P(CONTROL,"`",4) G ASK G:X="^" @($P(CONTROL,"`",3)) G:X="^Q" @($P(CONTROL,"`",2)) D VAL G:'$D(X)#10 ASK S @V=X G @$P(CONTROL,"`",5) ;* VAL ;INPUT VALIDATER ;PASS IN VAL. $P(VAL,"`") SPECIFIES TYPE OF VALIDATION. ;1`XECUTABLE CODE ;2`SET OF CODES ;3`RANGE: MIN-MAX^...^MIN-MAX ;4`ROUTINE: LABEL^ROUTINE ;PASS IN SPECPROC. $P(SPECPROC,"`") SPECIFIES TYPE ;1`ROUTINE: LABEL^ROUTINE ;2`XECUTABLE CODE D @("VAL"_+VAL) I '$T K X ZU 0 W *7," ...INVALID" Q I 1 X:+SPECPROC=2 $P(SPECPROC,"`",2,999) D:+SPECPROC=1 @$P(SPECPROC,"`",2,999) I '$T K X ZU 0 W *7," ...INVALID" Q VAL1 X $P(VAL,"`",2,999) Q VAL2 F I=2:1:$L(VAL,"`") S Y=$P(VAL,"`",I) I $E(Y,1,$L(X))=X S X=Y Q Q VAL3 I 0 Q:X'?1.N F I=2:1:$L(VAL,"`") S Y=$P(VAL,"`",I) I +Y'>X,X'>$P(Y,"-",2) Q Q VAL4 D @$P(VAL,"`",2,999) Q DUMMY ;DUMMY HELP I V="SG" S %HELP="REPTABLE;1~1;1;2;50;64" I V="FROM" S %HELP="%L3TRTB;2;1~1;1;2" I V="TO" S %HELP="%L3TRTB;3;1~1;1;2" I V="LOCK" S %HELP="%L3TRTB;4;1~1;1;2" I V="TV" S %HELP="%L3TRTB;5~1;1;2" I V="RV" S %HELP="%L3TRTB;6~1;1;2" I V="LV" S %HELP="%L3TRTB;7;~1;1;2" I V="RI" S %HELP="%L3TRTB;8~1;1;2;50;64" I V="CS" S %HELP="%L3TRTB;9~1;1;2" I V="BIT" S %HELP="%L3TRTB;12~1;1;2" I V="KEY" S %HELP="%L3TRTB;10~1;1;2" I $G(%HELP)'="" N (%HELP) D ^%UTLH Q ZU 0 W !!,"NO HELP AVAILABLE." Q VALUCI ;VALIDATE UCI I X?3U1","3U Q I X?3U S Y=","_$P($$^%L1ZU(0),",",2),X=X_Y ZU 0 W Y Q Q DEL S (@V,X)="" I "TO^LOCK^RI"[V X $P(SPECPROC,"`",2,999) S @$S(V="TO":"TV",V="LOCK":"LV",1:"RV")="NO" Q CF S stmsm=1 G INT1 EDITED ;Update tables after an edit session ;Variable SGCNFG must be passed in S MODE=3 D ALONE G:Q EXIT S MSG=$C(27)_7_$C(27,91)_"24;1H"_$C(27,91,75)_"UPDATING TABLES IN MEMORY..."_$C(27)_8 G PTRS^TRANSLA1 ALONE ;See if other jobs active S Q=0 S:$V(168,-4,2)>2 Q=1 D DISLOG S MODE=MODE+4 Q:'Q S V="CONT",^%L3TRTB("CONT")="Y",PRMPT="OTHER USERS ARE LOGGED ON TO THE SYSTEM."_$C(13,10)_"DO YOU WISH TO UPDATE MEMORY",CONT="Y",CONTROL="1`Q^TRANSLA1`Q^TRANSLA1``Q^TRANSLA1`DUMMY",VAL="2`YES`NO",SPECPROC="2`S:$E(X)=""Y"" Q=0" G ASK Q Q ;I WOULDN'T REMOVE THIS IF I WERE YOU. DISLOG ;DISABLE LOGON S X=$V(4,-4,2) S:'$ZB(X,#40,1) X=X+#40 V 4:-4:X:2 Q ENLOG ;ENABLE LOGON V 4:-4:$ZB(+$V(4,-4,2),(#FF-#40),1):2 Q %L3TYPCR %L1TYPCR(STAM) ; [ 25.02.05 12:18 ] [ N %TYPCRT S %TYPCRT="PC" I $L($P) S %TYPCRT=$G(^[GLD]%TYPCRT(+$G(^[GLD]devi($P)))) Q %TYPCRT %L3UA %L3UA ;DJM;ADD NEW UCI TO SYSTEM; [ 06/30/92 12:36 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 D GETVG^%VGUTIL S VGTAB=$V(10,-5) I $V(2,-4,2)#2=0 W !,*7,$P($P($ZV,","),"-")," MUST BE INITIALIZED VIA ^STU PRIOR TO CREATING NEW UCI'S" G EXIT I $V(168,-4,2)>2 W *7,!!,"ALL OTHER USERS MUST BE OFF." D ^%SS G EXIT O 63::5 E W *7,!!,"VIEW BUFFER BUSY.. REQUEST ABORTED" G EXIT VGPROMPT ; I VG=1 S VGI=0 G UCIPROMP D VGPMT G:ERVG EXIT UCIPROMP ; S %VGNA=VG(VGI) S SGMAX=$V(12,-4,2) F SGCUR=1:1 Q:$ZU(SGCUR,VGI)="" S SGCUR=SGCUR-1 I SGCUR'(VGVOL-1) W *7," ...VOLUME NOT MOUNTED" S ERFLG=1 Q I SGBLK?1N1":".N I +$P(SGBLK,":",2)=0!($P(SGBLK,":",2)>$P(VGVOL(+SGBLK),"^",3)) W *7," ..INVALID RELATIVE MAP NO." S ERFLG=1 Q I SGBLK?1N1":".N S SGBLK=$P(VGVOL(+SGBLK),"^",2)\512+$P(SGBLK,":",2)-1 I SGBLK="" S SGBLK=X D DEBLK I SGBLK'?1N.N W *7," ..ENTER NUMERIC VALUE" S ERFLG=1 Q Q CONVERT ; F I=0:1:VGVOL-1 Q:SGBLK<(+$P(VGVOL(I),"^",2)) I SGBLK'<(+$P(VGVOL(I),"^",2)) S SGDEVT=I E S SGDEVT=I-1 S SGBLK=SGBLK-$P(VGVOL(SGDEVT),"^",2) Q DEBLK ; N (X,VGVOL) S C1=0,C2=X F I=VGVOL-1:-1:0 S C3=$P(VGVOL(I),"^",2)/512 I C3'>X S C1=I,C2=X-C3+1 Q ;W !,C1,":",C2 Q %L3UAR %L3UAR ;DJM;ADD ROUTINE DIRECTORY; [ 06/30/92 12:36 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP. @1984 K SGRTN W !!,"ROUTINE DIRECTORY ALLOCATION" PROMPT3 ; S SGBLK=1 D CONVERT^%L3UAG I SGDEVT'%LL S %LL=$L(@%M) S %I1=%I-1 I '%I1 G ENDPR1 I $D(%L3VLL),%LL<%L3VLL S %LL=%L3VLL I %LL<20 S %LL=20 I %LL>75 S %LL=75 S %L3VLL=%LL S %I=0 I '$D(%SM) S %SM=80-%LL-4\2 I %SM<1!(%SM>70) S %SM=80-%LL-4\2 S:%SM<3 %SM=3 I %SM+%LL>77 S %SM=77-%LL ;;I %I1<$G(%L3VLB) S %I1=$G(%L3VLB) S %SMX=%SM S:'$D(%SMY) %SMY=23-%I1-4\2 S %SM=%SMX I %SMY>20 S %SMY=20 I %SMY+%I1>22 S %SMY=22-%I1 S:%SMY<1 %SMY=1 S %L3VLB=%I1 ;------------------------------- BODY ---------------- S %I=$G(%SMI,1) I %I>%I1 S %I=1 N %H0 S %H0=$P($H,",",2) BG I $G(%CVET) N %CL0 S %CL0=$C(27,91)_"45;37m" I $D(%L3VNOHZG) G BD D PHON D PC BD K %L3VNOHZG I $D(%L1("VIEW")) G ENDPR1 CYC0 D INV CYC D ^%L1MSGBR I $D(%L1("PLACE")),%I'=$G(%IO) X %L1("PLACE") S %IO=%I ;;I '$G(%L1("TIME")) R *%A:1 E G CYC ;;I $G(%L1("TIME")) D RTIME(%L1("TIME")) E S %L3VTO="TIME" G ENDPR1 G RDS ; READ G:%TYPCRT="PC" 20 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))'="" D CLBF G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL D CLBF G @%UPRCOD($ZB) ; 20 N C I %A=27 D DELAY R:'$D(%FLL) *%A1:%WAIT G:%A1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" I %A1=27 K %A1 S %A=27 Q .D DELAY R:'$D(%FLL) *%A2:%WAIT I %A2=27 K %A2 S %A=27 Q .S:%A2>0 C=%A1_%A2 .R:'$D(%FLL) *%A3:%WAIT I %A3=27 K %A3 S %A=27 Q .S:%A3>0 C=C_%A3 .R:'$D(%FLL) *%A4:%WAIT I %A4=27 K %A4 S %A=27 Q .S:%A4>0 C=C_%A4 I %A=27 G 20 I %A=20 G VNIZE ;,$G(^zms($I))?1"^"."%"1U.E W *27,7 D ^%L1ZMST S $X=%XX,$Y=%YY G:%TYPCRT'="PC" BG G CYC0 I %A<48!(%A>57) X "I $G(%CD)'="""" S %SAY="""" X %XMSGN" S %CD="" I $L($ZB)>3,$D(%UPRCOD($ZB)) S %A=$ZB G COM I %A=0 D DELAY R *%A1:%WAIT I %A1>0 S %A="0"_%A1 G COM I %A>47,%A<58,$D(%L1("TXT1"))#2 D G CYC .S %CD=%CD_$C(%A) S %SAY=%CD X %XMSGN .N %II,%OK S %OK=0 F %II=1:1:%I1 Q:'$D(@%L3VMAC@(%II)) D Q:%OK ..N %ST,%IN,%LN S %ST=$G(@%L3VMAC@(%II)) ..S %LN=+$P(%L1("TXT1"),"<>",$L(%L1("TXT1"),"<>")) ..S %CD0=$$SPA^%L1FRM($E(%ST,$L(%ST)-%LN+1,255)) ..I $E(%CD0,1,$L(%CD))=%CD D CL S %I=%II D INV S %OK=1 Q ; ENT I %A=13!(%A=32),$D(%L1NUV("PROG")) D G BG .S %L1NUV("INDEX")=%I,%L1NUV("%L3VIEW")=@%M .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1NUV) D ^%L1C .S N="" F S N=$O(%L1NUV("PRMIN",N)) Q:N="" X %L1NUV("PRMIN",N) .I $D(%L1NUV("UROV")),$D(%L1NUV("PROG",%L1NUV("UROV"))) D @%L1NUV("PROG",%L1NUV("UROV")) Q .I $D(%L1NUV("PROG"))=1 D @%L1NUV("PROG") Q G:%A=13!(%A=32) ENDPR:'$D(%L1("LOOK")),PGDN COM I $D(%UPRCOD(%A)),$T(@%UPRCOD(%A))'="" D CLBF G @%UPRCOD(%A) ;I "/.u"[$C(%A) S %L3VTO="." G ENDPR D CLBF G CYC ;- INS S %A=13 G ENT 27 R *%A1:%WAIT D DELAY R *A1:%WAIT S %I="" ENDPR S %L3VNM=@%M,%L3VN=%I I $D(%L1("DO")),%L3VN D D DOOUT G:$G(%L1("DO"))="Q" ENDPR1 X:$D(%L1("T2")) %L1("T2") G BG .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1,%K,%IND,%COLI,%L3VN,%L3VNM) D ^%L1C .K %L1("DO-OUT") N %VNM S %VNM=%L3VNM N %L3VNM S %L3VNM=%VNM .N %VN S %VN=%L3VN N %L3VN S %L3VN=%VN .S MAC1="%L1",MAC2="%L1OLD" D ^%S1GC1 .S N="" F S N=$O(%L1("DO",N)) Q:N="" I N?."%"1U.E S @N=%L1("DO",N) .S INDEX=%IND(%K+%L3VN-%COLI),%NXS=$G(@%L1("MAC")@(INDEX)) .N %IND,%K,%COLI .X %XCL X %L1("DO") X:'$D(%L1("DO","-")) %chista K %L1 S MAC1="%L1OLD",MAC2="%L1" D ^%S1GC1 ENDPR1 K %A,%B,%M,%LL,%I1,%B1,%B2 I $D(%L3VMAC),$D(@%L3VMAC) K @%L3VMAC W $C(27,91),"?25h" X %XCL K %SM,%SMX W:$D(%HBRY) %HBR K %HEAD,%L3VH,%L3VMAC,%HEAD,%L3VNM Q ;- DOOUT ; N N S N="" F S N=$O(%L1("DO-OUT",N)) Q:N="" I N?."%"1U.E S @N=%L1("DO-OUT",N) Q SERV ; VVERX G:$D(%L1("LOOK")) PGUP I %I=1 D CL D D INV G CYC .F %I=%I1:-1:1 Q:$D(@%M) D CL S %I=%I-1 D INV G CYC VNIZ G:$D(%L1("LOOK")) PGDN I %I=%I1 D CL S %I=1 D INV G CYC I '$D(@%L3VMAC@(%I+1)) G CYC D CL S %I=%I+1 D INV G CYC LEVO ; PRAVO ; G CYC PGDN S %L3VTO="PGDW" G ENDPR1 PGUP S %L3VTO="PGUP" G ENDPR1 PGRG S %L3VTO="P" G ENDPR1 FIND S %L3VTO="F8" G ENDPR1 ESC S %L3VTO="VVERX" G ENDPR1 VNIZE ; I $G(^zms($I))?1"^"."%"1U.E D S $X=%XX,$Y=%YY G:%TYPCRT'="PC" BG G CYC0 .N %NG,NOMGL S (NOMGL,%NG)=$$GN^%L1TMP("") .I MAC["^l2mn(" D SVGLB^%L1ZMST("^l2mn($P)") .W *27,7 D ^%L1ZMST S %HBRY="" .S %NG=NOMGL I MAC["^l2mn(" D RSGLB^%L1ZMST("^l2mn($P)") .D ^%L1C G CYC0 ;- PRSC ; D ^%L1PRSC G CYC0 CL X %XCL D PC1 Q CLBF N %JJ,%A F %JJ=1:1:100 R *%A:0 Q ;- INV W %CLI S %L3VINV=1 D PC1 Q ;- PHON ; I $D(%HEAD) S %SAY=$J(%HEAD,%LL)_"++"_(%SMY-1)_","_(%SM+%LL)_",HH,I" X %XMSG X %XCL ;;N Y1,X1,Y2,X2 S %XX=%SM-1,%YY=%SMY+1 ;S %XX=%SM-3,%YY=%SMY-2 S Y1=%YY,X1=%XX,Y2=%YY+(%I1*$S($D(%L1("RB")):3,1:1))+1,X2=%XX+%LL+3 ;;I $D(%L1("RB")) S Y2=Y2-2 I $D(%L1("NGR")),Y2<%L1("NGR") S Y2=%L1("NGR") ;;D CLEAR I '$D(%L1("RB")) D RBUA I $D(%L1("RB")) D .N %L1RBCL S %L1RBCL=%CV("BB") .I Y2>$G(%V3MAXY),$G(%V3MAXY)>-1 S %V3MAXY=Y2 .I Y2<$G(%V3MAXY),$G(%V3MAXY)>-1 N Y2 S Y2=$G(%V3MAXY)+1 .D CLEAR^%L1RBUA(Y1,X1-1,Y2+1,X2+1) I $G(%UR)>0,$D(%TOP(%UR)) S %SAY=$TR($J("",X2-X1+1)," ",$S(%TYPCRT["PC"&($G(MAC)["^l2mn("):$C(177),1:" "))_"++"_(Y1-1)_","_X2_",HH" X %XMSG S %SAY=" "_%TOP(%UR)_" sc ++"_(Y1-1)_","_(X1+6)_",H" X %XMSG I $D(%L1("MENU")),'$D(%L1("RB")) S %SAY=" PGUP ++"_(Y1-1)_","_(X1+1)_",E" X %XMSG I '$D(%L1("RB")) S %SAY=" d`ivi - "_$S(%TYPCRT="VT220":"",1:"")_" ++"_(Y1-1)_","_(X2-2)_",HH" X %XMSG I $D(%L1("MENU")),'$D(%L1("RB")) S %SAY=" PGDN ++"_(Y2-1)_","_(X1+1)_",E" X %XMSG I '$D(%L1("LOOK")),'$D(%L1("MENU")),'$D(%L1("RB")) S %SAY="+P - qitcdl++"_(Y2-1)_","_(X2-2)_",HH" X %XMSG I $D(%L1("SORT")) S %SAY=" - oiinl++"_(Y2-1)_","_(X2-25)_",HH" X %XMSG Q ;- PC ; X %XCL N %I F %I=1:1:%I1 Q:'$D(@%M) D PC1 Q PC1 S %YY=%SMY+(%I*$S($D(%L1("RB")):3,1:1)) S:$D(%L1("RB")) %YY=%YY-1 I $D(%L1("RB")) D .N X1,X2,Y1,Y2 .S X1=%SM-1,X2=X1+%LL+3 .S Y1=%YY,Y2=%YY+2 . .I %I=%I1,$D(%L1("MENU")) D ; KAMA DAPIM ..N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 ..S X1=X10,X2=X1+7,Y1=%YY+3,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA ..S X1=X20-7,X2=X1+7,Y1=%YY+3,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA N %XX,%YY ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X10+1,%YY=Y1 X %POSIC W "PGUP" ..S %XX=X20-6 X %POSIC W "PGDN" ..S X1=X10+8,X2=X20-8 Q:X2'>X1 ..I X2-X1>10 S %POPUP=1,X2=X1+((X2-X1)\2)-1 ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2)-1,%YY=Y1 X %POSIC W "ESC" ..I $D(%L1("+-")),X2-X1>10 D ...S %POPUP=2 ...S X1=X2+1,X2=X20-15 ...D RBUA ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W " -" ... ...S X1=X2+1,X2=X20-8 ...D RBUA ...X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ...S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W " +" ..Q:%POPUP'=1 ..S X1=X2+1,X2=X20-8 ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W "POPUP" . .W %CV("YF"),%LIGHT1 D RBUA ; S %XX=%SMX X %POSIC D .X %XCL I $G(@%M)["~",$G(%CVET) W %CV("BB"),%CV("YF"),%LIGHT1 .E I $G(%L3VINV) X %XCL W:'$G(%CVET) %CLI I $G(%CVET) W %CV("WB"),%CV("RF") .E W %CV("MB"),%CV("YF"),%LIGHT1 .I $D(%HBRY) W $J($E($$W^%L1C($G(@%M)),1,%LL),%LL) Q ;;,%ENG .W $J($E($G(@%M),1,%LL),%LL) Q ;;,%ENG ; S %L3VINV=0 I %I=%I1,'$D(%L1("MENU")),$D(%L1("RB")) D ; -- DAF 1 .N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 .S X1=X10,X2=X20 .S %POPUP=0 I X2-X1>10 S %POPUP=1,X2=X1+((X2-X1)\2) .S Y1=%YY+3,Y2=Y1+2 .S X1=X10 Q:X2'>X1 D RBUA .X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 .S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "E S C" .I $D(%L1("+-")),X2-X1>10 D Q ..S %POPUP=2 ..S X1=X2+1,X2=X1+(X20-X1\2)-1 ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W " -" .. ..S X1=X2+1,X2=X20 ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W " +" . .Q:%POPUP'=1 Q:$D(%L1NU("+-")) .S X1=X2+1,X2=X20 Q:X2'>X1 D RBUA .X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 .S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W "POPUP" Q ;- CLEAR ; X %XCL N %I ;I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_%SMY_";"_%SM_";"_%V3MAXY_";"_(%SM+%LL+3)_"${" Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_32_";"_(%SMY+1)_";"_%SM_";"_%V3MAXY_";"_(%SM+%LL+2)_"$x" Q F %I=1:1:%V3MAXY-%SMY-1 S %XX=%SM-1,%YY=%I+%SMY X %POSIC W $J("",%LL+3) Q ;- CVET W $J("",%LL+4) I $D(%CL0) W *27,*91,%CL0,"m" E X %XCL Q ;- RBUA S %L1RBCL="" S:$G(%CVET) %L1RBCL=%CV("MB") N %XX,%YY I $D(%L1("CVB")) S %L1RBCL=%CV(%L1("CVB")),%CL0=%L1RBCL_%CV("WF") D ^%L1RBUA K %L1RBCL Q DELAY I %TYPCRT="PC1" N %JJJ F %JJJ=1:1:2000 Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q RTIME(%TM) ; N %JJ F %JJ=1:1:%TM D ^%L1MSGBR R *%A:1 Q:$T Q RDS ; I $G(%L1("TIME")),$P($H,",",2)-%H0>$G(%L1("TIME")) S %L3VTO="TIME" G ENDPR1 H .1 R *%A:0 E G MOUSE:%MOUSE,CYC G READ MOUSE ; S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I '%CRD G CYC S LAB="" I $P(%CRD,",",2)'(Y2+3)) D I LAB'="" G @LAB .N X10,X20 S X10=X1,X20=X2 N X1,X2,%XX,%YY . .I $D(%L1("MENU")) D Q ; KAMA DAPIM ..I $P(%CRD,",")<(X10+7)&($P(%CRD,",")'X20&($P(%CRD,",")'<(X20-7)) S LAB="PGDN" Q ..N X2 S X2=X20-7 I $G(%POPUP) S X2=X10+8+((X20-X10-14)\2) ..I $P(%CRD,",")>(X10+7)&($P(%CRD,",")(X2+1)&($P(%CRD,",")<(X20-7)) S LAB="VNIZE" Q ..I $G(%POPUP)=2,$P(%CRD,",")>(X2+1)&($P(%CRD,",")<(X20-15)) S LAB="-" Q ..I $G(%POPUP)=2,$P(%CRD,",")>(X2+1)&($P(%CRD,",")<(X20-7)) S LAB="+" Q . .S X2=X20 I $G(%POPUP)=1 S X2=X10+((X20-X10)\2) .I $P(%CRD,",")>X10&($P(%CRD,",")X2,$P(%CRD,",")X2,$P(%CRD,",")<(X2+(X20-X2\2)) S LAB="-" Q .I $G(%POPUP)=2,$P(%CRD,",")>X2+(X20-X2\2),$P(%CRD,",")(X2+1)) G RDS ;ESC I $P(%CRD,",",2)<(Y1-1)!($P(%CRD,",",2)>(Y2+1)) G RDS ; ESC S %IN=$P(%CRD,",",2)-%SMY-1+$G(^SMXY(%L3MYDVN))\3+1 I '$D(@%L3VMAC@(%IN)) G RDS ;ESC ; I %IN'=%I D .D CL .S %I=%IN D INV ; S %A=13 G ENT %L3VIEW0 %L3VIEW ; SHOW WINDOW ( SCREEN ONE ONLY) [ 13.09.06 11:07 ] [ 18.12.05 17:11 ] [ 29.11.05 09:54 ] ;INPUT: ; %CLEAR=1 - jqn iewip ila, 0 - jqn iewip mr ; %L3VMAC - WORK ARRAY NAME ("%L1NS" - FROM %L1NU) ; %L3VLL - WINDOWS WIDTH ; %SM - WINDOW LEFT ; %SMY - WINDOW.TOP ; %SMI - IND BHALON ;OUTPUT: %L3VTO -"PGUP","PGDN" ; %L3VN - CHOOSED INDEX ; %L3VNM - CHOOSED NAME ;EXECUTION: ; %L1NUV("PROG",%UROV) - MUMPS COMMAND FOR EXECUTION ; %L1NUV("UROV") - LEVEL FOR EXECUTION %L1NUV("PROG",UROV) ; %L1NUV("PRMIN",N) - MUMPS COMMAND FOR INPUT PARAMETERS ;------------------------------------------------------------ ;;S %SAY=%L1("MAC") X %XMSGV(1) N %MAC1,%I,%IO,%M,X1,Y1,X2,Y2,%LL,%XX,%YY,%L1OLD,%CD,%HBRY,%L3VINV,%MOUSE,%PORT ;;I $P'["/dev/pts/" S %V3MAXY=-1 D USE S %HBRY="",%CD="" I $D(%L1("NOHB")) K %HBRY S %L3VTO="",%L3VN="",%L3VNM="" S:'$D(%L3VH) %L3VH=16 S %L3VINV=0,%POPUP=0 ;;W %ENG S %MOUSE=$$INIT^%L2MOUSE,%PORT=$$PORT^%L2MOUSE I '$D(%L3VMAC) W *7,!!?5,"*** A NAME ARRAY IS NOT DEFINED!" H 2 G ESC I $D(@%L3VMAC)<10 G ESC ;W *7,!!?5,"*** ARRAY HASN'T A DATA !" H 2 G ESC I '$D(%POSIC) D ^%L1C ;I $ZV["3.",$P=1 D GET^%VIDEO(.OLD,1,1,80,24,2) S %M=%L3VMAC_"(%I)" S %LL=0 F %I=1:1 Q:'$D(@%M) I $L(@%M)>%LL S %LL=$L(@%M) S %I1=%I-1 I '%I1 G ENDPR1 I $D(%L3VLL),%LL<%L3VLL S %LL=%L3VLL I %LL<20 S %LL=20 I %LL>75 S %LL=75 S %L3VLL=%LL S %I=0 I '$D(%SM) S %SM=80-%LL-4\2 I %SM<1!(%SM>70) S %SM=80-%LL-4\2 S:%SM<3 %SM=3 I %SM+%LL>77 S %SM=77-%LL ;;I %I1<$G(%L3VLB) S %I1=$G(%L3VLB) S %SMX=%SM S:'$D(%SMY) %SMY=23-%I1-4\2 S %SM=%SMX I %SMY>20 S %SMY=20 I %SMY+%I1>22 S %SMY=22-%I1 S:%SMY<1 %SMY=1 S %L3VLB=%I1 ;------------------------------- BODY ---------------- S %I=$G(%SMI,1) I %I>%I1 S %I=1 N %H0 S %H0=$P($H,",",2) BG I $G(%CVET) N %CL0 S %CL0=$C(27,91)_"45;37m" I $D(%L3VNOHZG) G BD D PHON D PC BD K %L3VNOHZG I $D(%L1("VIEW")) G ENDPR1 CYC0 D INV CYC D ^%L1MSGBR I $D(%L1("PLACE")),%I'=$G(%IO) X %L1("PLACE") S %IO=%I ;;I '$G(%L1("TIME")) R *%A:1 E G CYC ;;I $G(%L1("TIME")) D RTIME(%L1("TIME")) E S %L3VTO="TIME" G ENDPR1 G RDS ; READ G:%TYPCRT="PC" 20 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))'="" D CLBF G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL D CLBF G @%UPRCOD($ZB) ; 20 N C I %A=27 D DELAY R:'$D(%FLL) *%A1:%WAIT G:%A1<0 ESC D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G @%UPRCOD(C) .S C="" I %A1=27 K %A1 S %A=27 Q .D DELAY R:'$D(%FLL) *%A2:%WAIT I %A2=27 K %A2 S %A=27 Q .S:%A2>0 C=%A1_%A2 .R:'$D(%FLL) *%A3:%WAIT I %A3=27 K %A3 S %A=27 Q .S:%A3>0 C=C_%A3 .R:'$D(%FLL) *%A4:%WAIT I %A4=27 K %A4 S %A=27 Q .S:%A4>0 C=C_%A4 I %A=27 G 20 I %A=20 G VNIZE ;,$G(^zms($I))?1"^"."%"1U.E W *27,7 D ^%L1ZMST S $X=%XX,$Y=%YY G:%TYPCRT'="PC" BG G CYC0 I %A<48!(%A>57) X "I $G(%CD)'="""" S %SAY="""" X %XMSGN" S %CD="" I $L($ZB)>3,$D(%UPRCOD($ZB)) S %A=$ZB G COM I %A=0 D DELAY R *%A1:%WAIT I %A1>0 S %A="0"_%A1 G COM I %A>47,%A<58,$D(%L1("TXT1"))#2 D G CYC .S %CD=%CD_$C(%A) S %SAY=%CD X %XMSGN .N %II,%OK S %OK=0 F %II=1:1:%I1 Q:'$D(@%L3VMAC@(%II)) D Q:%OK ..N %ST,%IN,%LN S %ST=$G(@%L3VMAC@(%II)) ..S %LN=+$P(%L1("TXT1"),"<>",$L(%L1("TXT1"),"<>")) ..S %CD0=$$SPA^%L1FRM($E(%ST,$L(%ST)-%LN+1,255)) ..I $E(%CD0,1,$L(%CD))=%CD D CL S %I=%II D INV S %OK=1 Q ; ENT I %A=13!(%A=32),$D(%L1NUV("PROG")) D G BG .S %L1NUV("INDEX")=%I,%L1NUV("%L3VIEW")=@%M .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1NUV) D ^%L1C .S N="" F S N=$O(%L1NUV("PRMIN",N)) Q:N="" X %L1NUV("PRMIN",N) .I $D(%L1NUV("UROV")),$D(%L1NUV("PROG",%L1NUV("UROV"))) D @%L1NUV("PROG",%L1NUV("UROV")) Q .I $D(%L1NUV("PROG"))=1 D @%L1NUV("PROG") Q G:%A=13!(%A=32) ENDPR:'$D(%L1("LOOK")),PGDN COM I $D(%UPRCOD(%A)),$T(@%UPRCOD(%A))'="" D CLBF G @%UPRCOD(%A) ;I "/.u"[$C(%A) S %L3VTO="." G ENDPR D CLBF G CYC ;- INS S %A=13 G ENT 27 R *%A1:%WAIT D DELAY R *A1:%WAIT S %I="" ENDPR S %L3VNM=@%M,%L3VN=%I I $D(%L1("DO")),%L3VN D D DOOUT G:$G(%L1("DO"))="Q" ENDPR1 X:$D(%L1("T2")) %L1("T2") G BG .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%L1,%K,%IND,%COLI,%L3VN,%L3VNM) D ^%L1C .K %L1("DO-OUT") N %VNM S %VNM=%L3VNM N %L3VNM S %L3VNM=%VNM .N %VN S %VN=%L3VN N %L3VN S %L3VN=%VN .S MAC1="%L1",MAC2="%L1OLD" D ^%S1GC1 .S N="" F S N=$O(%L1("DO",N)) Q:N="" I N?."%"1U.E S @N=%L1("DO",N) .S INDEX=%IND(%K+%L3VN-%COLI),%NXS=$G(@%L1("MAC")@(INDEX)) .N %IND,%K,%COLI .X %XCL X %L1("DO") X:'$D(%L1("DO","-")) %chista K %L1 S MAC1="%L1OLD",MAC2="%L1" D ^%S1GC1 ENDPR1 K %A,%B,%M,%LL,%I1,%B1,%B2 I $D(%L3VMAC),$D(@%L3VMAC) K @%L3VMAC X %XCL K %SM,%SMX W:$D(%HBRY) %HBR K %HEAD,%L3VH,%L3VMAC,%HEAD,%L3VNM Q ;- DOOUT ; N N S N="" F S N=$O(%L1("DO-OUT",N)) Q:N="" I N?."%"1U.E S @N=%L1("DO-OUT",N) Q SERV ; VVERX G:$D(%L1("LOOK")) PGUP I %I=1 D CL D D INV G CYC .F %I=%I1:-1:1 Q:$D(@%M) D CL S %I=%I-1 D INV G CYC VNIZ G:$D(%L1("LOOK")) PGDN I %I=%I1 D CL S %I=1 D INV G CYC I '$D(@%L3VMAC@(%I+1)) G CYC D CL S %I=%I+1 D INV G CYC PGDN S %L3VTO="PGDW" G ENDPR1 PGUP S %L3VTO="PGUP" G ENDPR1 PGRG S %L3VTO="P" G ENDPR1 FIND S %L3VTO="F8" G ENDPR1 ESC S %L3VTO="VVERX" G ENDPR1 VNIZE ; I $G(^zms($I))?1"^"."%"1U.E D S $X=%XX,$Y=%YY G:%TYPCRT'="PC" BG G CYC0 .N %NG,NOMGL S (NOMGL,%NG)=$$GN^%L1TMP("") .I MAC["^l2mn(" D SVGLB^%L1ZMST("^l2mn($P)") .W *27,7 D ^%L1ZMST S %HBRY="" .S %NG=NOMGL I MAC["^l2mn(" D RSGLB^%L1ZMST("^l2mn($P)") .D ^%L1C G CYC0 ;- CL X %XCL D PC1 Q CLBF N %JJ,%A F %JJ=1:1:100 R *%A:0 Q ;- INV W %CLI S %L3VINV=1 D PC1 Q ;- PHON ; I $D(%HEAD) S %SAY=$J(%HEAD,%LL)_"++"_(%SMY-1)_","_(%SM+%LL)_",HH,I" X %XMSG X %XCL ;;N Y1,X1,Y2,X2 S %XX=%SM-1,%YY=%SMY+1 ;S %XX=%SM-3,%YY=%SMY-2 S Y1=%YY,X1=%XX,Y2=%YY+(%I1*$S($D(%L1("RB")):3,1:1))+1,X2=%XX+%LL+3 ;;I $D(%L1("RB")) S Y2=Y2-2 I $D(%L1("NGR")),Y2<%L1("NGR") S Y2=%L1("NGR") ;;D CLEAR I '$D(%L1("RB")) D RBUA I $D(%L1("RB")) D .N %L1RBCL S %L1RBCL=%CV("BB") .I Y2>$G(%V3MAXY),$G(%V3MAXY)>-1 S %V3MAXY=Y2 .I Y2<$G(%V3MAXY),$G(%V3MAXY)>-1 N Y2 S Y2=$G(%V3MAXY)+1 .D CLEAR^%L1RBUA(Y1,X1-1,Y2+1,X2+1) I $G(%UR)>0,$D(%TOP(%UR)) S %SAY=$TR($J("",X2-X1+1)," ",$S(%TYPCRT["PC"&($G(MAC)["^l2mn("):$C(177),1:" "))_"++"_(Y1-1)_","_X2_",HH" X %XMSG S %SAY=" "_%TOP(%UR)_" sc ++"_(Y1-1)_","_(X1+6)_",H" X %XMSG I $D(%L1("MENU")),'$D(%L1("RB")) S %SAY=" PGUP ++"_(Y1-1)_","_(X1+1)_",E" X %XMSG I '$D(%L1("RB")) S %SAY=" d`ivi - "_$S(%TYPCRT="VT220":"",1:"")_" ++"_(Y1-1)_","_(X2-2)_",HH" X %XMSG I $D(%L1("MENU")),'$D(%L1("RB")) S %SAY=" PGDN ++"_(Y2-1)_","_(X1+1)_",E" X %XMSG I '$D(%L1("LOOK")),'$D(%L1("MENU")),'$D(%L1("RB")) S %SAY="+P - qitcdl++"_(Y2-1)_","_(X2-2)_",HH" X %XMSG I $D(%L1("SORT")) S %SAY=" - oiinl++"_(Y2-1)_","_(X2-25)_",HH" X %XMSG Q ;- PC ; X %XCL N %I F %I=1:1:%I1 Q:'$D(@%M) D PC1 Q PC1 S %YY=%SMY+(%I*$S($D(%L1("RB")):3,1:1)) S:$D(%L1("RB")) %YY=%YY-1 I $D(%L1("RB")) D .N X1,X2,Y1,Y2 .S X1=%SM-1,X2=X1+%LL+3 .S Y1=%YY,Y2=%YY+2 . .I %I=%I1,$D(%L1("MENU")) D ..N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 ..S X1=X10,X2=X1+7,Y1=%YY+3,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA ..S X1=X20-7,X2=X1+7,Y1=%YY+3,Y2=Y1+2 ..W %CV("YF"),%LIGHT1 D RBUA N %XX,%YY ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X10+1,%YY=Y1 X %POSIC W "PGUP" ..S %XX=X20-6 X %POSIC W "PGDN" ..S X1=X10+8,X2=X20-8 Q:X2'>X1 ..I X2-X1>10 S %POPUP=1,X2=X1+((X2-X1)\2) ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "ESC" ..Q:'%POPUP ..S X1=X2+1,X2=X20-8 ..D RBUA ..X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 ..S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W "POPUP" . .W %CV("YF"),%LIGHT1 D RBUA ; S %XX=%SMX X %POSIC D .X %XCL I $G(@%M)["~" W %CV("BB"),%CV("YF"),%LIGHT1 .E I $G(%L3VINV) X %XCL W %CV("WB"),%CV("RF") .E W %CV("MB"),%CV("YF"),%LIGHT1 .I $D(%HBRY) W $J($E($TR($TR($G(@%M),%TES1,%TES2),%TEN,%THB),1,%LL),%LL) Q ;;,%ENG .W $J($E($G(@%M),1,%LL),%LL) Q ;;,%ENG ; S %L3VINV=0 I %I=%I1,'$D(%L1("MENU")),$D(%L1("RB")) D .N X10,X20 S X10=X1,X20=X2 N X1,X2,Y1,Y2 .S X1=X10,X2=X20 .S %POPUP=0 I X2-X1>10 S %POPUP=1,X2=X1+((X2-X1)\2) .S Y1=%YY+3,Y2=Y1+2 .S X1=X10 Q:X2'>X1 D RBUA .X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 .S %XX=X1+((X2-X1-3)\2),%YY=Y1 X %POSIC W "E S C" .S X1=X2+1,X2=X20 Q:X2'>X1 D RBUA .X %XCL W %CV("MB"),%CV("YF"),%LIGHT1 .S %XX=X1+((X2-X1-5)\2),%YY=Y1 X %POSIC W "POPUP" Q ;- CLEAR ; X %XCL N %I ;I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_%SMY_";"_%SM_";"_%V3MAXY_";"_(%SM+%LL+3)_"${" Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91)_32_";"_(%SMY+1)_";"_%SM_";"_%V3MAXY_";"_(%SM+%LL+2)_"$x" Q F %I=1:1:%V3MAXY-%SMY-1 S %XX=%SM-1,%YY=%I+%SMY X %POSIC W $J("",%LL+3) Q ;- CVET W $J("",%LL+4) I $D(%CL0) W *27,*91,%CL0,"m" E X %XCL Q ;- RBUA S %L1RBCL="" S:$G(%CVET) %L1RBCL=%CV("MB") N %XX,%YY I $D(%L1("CVB")) S %L1RBCL=%CV(%L1("CVB")),%CL0=%L1RBCL_%CV("WF") D ^%L1RBUA K %L1RBCL Q DELAY I %TYPCRT="PC1" N %JJJ F %JJJ=1:1:2000 Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q RTIME(%TM) ; N %JJ F %JJ=1:1:%TM D ^%L1MSGBR R *%A:1 Q:$T Q RDS ; I $G(%L1("TIME")),$P($H,",",2)-%H0>$G(%L1("TIME")) S %L3VTO="TIME" G ENDPR1 H .1 R *%A:0 E G MOUSE:%MOUSE,CYC G READ MOUSE ; S %CRD=$$REPORT^%L2MOUSE($G(%PORT),%XMIN,%XMAX,%YMIN,%YMAX) I '%CRD G CYC S LAB="" I $P(%CRD,",",2)'(Y2+3)) D I LAB'="" G @LAB .N X10,X20 S X10=X1,X20=X2 N X1,X2,%XX,%YY . .I $D(%L1("MENU")) D Q ..I $P(%CRD,",")<(X10+7)&($P(%CRD,",")'X20&($P(%CRD,",")'<(X20-7)) S LAB="PGDN" Q ...X %XCL W %CV("WB"),%CV("RF") ...S %XX=X20-6,%YY=Y2 X %POSIC W "PGDN" ..N X2 S X2=X20-7 I $G(%POPUP) S X2=X10+8+((X20-X10-14)\2) ..I $P(%CRD,",")>(X10+7)&($P(%CRD,",")(X2+1)&($P(%CRD,",")<(X20-7)) S LAB="VNIZE" Q ...X %XCL W %CV("WB"),%CV("RF") ...S X1=X2+1,X2=X20-8 ...S %XX=X1+((X2-X1-5)\2)-1,%YY=Y2+2 X %POSIC W "POPUP" . .S X2=X20 I $G(%POPUP) S X2=X10+((X20-X10)\2) .I $P(%CRD,",")>X10&($P(%CRD,",")X2,$P(%CRD,",")(X2+1)) G RDS ;ESC I $P(%CRD,",",2)<(Y1-1)!($P(%CRD,",",2)>(Y2+1)) G RDS ; ESC S %IN=$P(%CRD,",",2)-%SMY-1\3+1 I '$D(@%L3VMAC@(%IN)) G RDS ;ESC ; I %IN'=%I D .D CL .S %I=%IN D INV ; S %A=13 G ENT %L3VLD %L3VLD ;RTM;DATABASE INTEGRITY UTILITY; [ 31.12.06 08:54 ] [ 18.06.00 2:32 PM ] [ 10/04/2000 5:03 PM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1984 I $ZV["4." D G DONE .U 0 W !!," WAIT ..." .S %ERR=0 D ^%L4VLD I '$G(%ERR) S SUMBAD=0 Q .I $G(%ERR) D ..N %N K ^%VLD S %N="",SUMBAD=0 F S %N=$O(%ERR(%N)) Q:%N="" S SUMBAD=SUMBAD+1,^%VLD(%N)=%ERR(%N) S %ZT="ERR^%L3VLD",$ZT="S zr=$R "_^ZT_"ZG "_$ZL_":%MGR^%LOGON" S %DEV=$P U 0 S %HI=$V(2,$J,2) S SUMBAD=0 ; home UCI O 63::0 E W !,"VIEW BUFFER IN USE.. REQUEST ABORTED" K %DEV Q S VIEW=$ZB($V($V(44)+2,-3,2),#80,1) I VIEW V 0:$J:$ZB($V(0,$J,2),#8000,7):2 W !?10,$P($P($ZV,","),"-")," - DATABASE INTEGRITY UTILITY" VG ;SELECT VOLUME GROUP S (%ALLFLG,%UCI)="" D GETVG^%VGUTIL I VG=1 S %VG="G0",%VGN=VG(0),(%VGI,%VGR)=0 G UCI ;ONLY ONE VOLUME GROUP VG1 ;R !!,"Enter volume group to validate : ",%VGR S %VGI=%VGR G:%VGI="^"!(%VGI="^Q")!(%VGI="^Q") EXIT S:%VGI="" (%VGI,%VGR)="ALL" G:%VGI="ALL" TRACE S (%VGI,%VGR)="ALL" G:%VGI="ALL" TRACE UCI S %UCI="ALL" TRACE S %AN="N" ; I $E("NO",1,$L(%AN))=%AN!($E("no",1,$L(%AN))=%AN) S TR=0 I $D(TR)<1 W " ??",*7 G TRACE I %UCI="ALL"!(%VGR="ALL") D CRT^%SDEV G:$D(QUIT) EXIT S A=$$^%L1ZOS(2,"VALOK") S SV=$V(44),%PB=$V(SV+8,-3,2),%USZ=$V(SV+14,-3,2) S %VGT=$V(4*10+%PB+SV) G UCIALL:%UCI="ALL",VGALL:%VGI="ALL" D PTR V 2:$J:%VGI*32+%UI:2 D INT^%GSEL I '$D(^UTILITY($J)) W !!,"No Globals Selected" V 2:$J:%HI:2 G TYPE START D CRT^%SDEV G:$D(QUIT) TYPE VALROUT G:%TYPE=1 VALGLOB U 0 W !!,"VALIDATING ROUTINES FROM [",%UN,",",%VGN,"]",! I %DEV'=$P U %DEV W !!,"VALIDATING ROUTINES FROM [",%UN,",",%VGN,"]",! U %DEV ZM:TR 1 S %ER=$ZV(%RBN,9999,%VGI) ZM:TR 0 S BAD=0 I %ER'="" S %NM="" D VALIDAT1 W !,"ALL ROUTINES PROCESSED, ",$S(BAD=0:"NO",1:BAD)," ERROR",$S(BAD=0:"S",BAD=1:"",1:"S")," FOUND." S SUMBAD=SUMBAD+BAD VALGLOB G:%TYPE=2 DONE S BAD=0,%GLB="" U 0 W !!,"VALIDATING GLOBALS FROM [",%UN,",",%VGN,"]",! I %DEV'=$P U %DEV W !!,"VALIDATING GLOBALS FROM [",%UN,",",%VGN,"]",! U %DEV V 2:$J:%VGI*32+%UI:2 F %COUNT=1:1 S %GLB=$S(%UCI'="ALL"&(%VGR'="ALL"):$O(^UTILITY($J,%GLB)),1:$O(@("^"_%GLB))) Q:%GLB="" S %PRT=$ZBN(@("^["""_%UN_"""]"_%GLB)) I %PRT D . U 0 W:%DEV'=$P ?%COUNT-1#8*10,%GLB W:%DEV'=$P&(%COUNT#8=0) ! U %DEV . V %PRT:"G"_%VGI I $V(1020,0,1)'=2 S %ER="3,"_%PRT_",0",%NM=%GLB D VALIDAT1 Q . ZM:TR 1 S %ER=$ZV(%PRT,9999,%VGI) ZM:TR 0 I %ER'="" S %NM=%GLB D VALIDAT1 W !,%COUNT-1," GLOBAL",$S(%COUNT'=2:"S",1:"")," PROCESSED, ",$S(BAD=0:"NO",1:BAD)," ERROR",$S(BAD=0:"S",BAD=1:"",1:"S")," FOUND." S SUMBAD=SUMBAD+BAD V 2:$J:%HI:2 Q:%UCI="ALL"!(%VGR="ALL") DONE U 0 W !!,"DONE" I SUMBAD D .S %L1RBCL="" D TV^%L1RBUA(4,15,10,72) .W *7,*7 S %SAY="mipezp qiqaa ze`iby yi++5,70,HH,I" X %XMSG .S %SAY="rvea `l ieaib++6,70,HH,I" X %XMSG .S %SAY="dpkez wtql xywzdl `p++7,70,HH,I" X %XMSG .S %GET="" D N^%L1GET I 'SUMBAD O 51::2 I O 51:("VALOK":"W") U 51 W $H_": OK",$C(13) C 51 EXIT I $D(%DEV),%DEV'=$P U %DEV W ! C %DEV I $ZV["4." K (QUIT) Q V 2:$J:%HI:2 C 63 V:VIEW 0:$J:$ZB($V(0,$J,2),#8000,2):2 K (QUIT) Q ERR ; V 2:$J:%HI:2 V:VIEW 0:$J:$ZB($V(0,$J,2),#8000,2):2 I $F($ZS,"") U 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q PTR ;GET POINTERS TO DIRECTORY BLOCKS FOR UCI S %VGP=$V(%VGI*4+%VGT),%UT=$V(%VGP+20),%UT=%UI-1*%USZ+%UT,%GBN=$V(%UT+4,-3,4),%RBN=$V(%UT+8,-3,4) Q VGALL ;VALIDATE ALL VOLUME GROUPS S %ALLFLG=1 F %VGI=0:1:7 I $D(VG(%VGI)) S %VG="G"_%VGI,%VGN=VG(%VGI),VGP=$V(%VGI*4+%VGT) D:$V(VGP+4,-3,2) UCIALL G DONE UCIALL ;VALIDATE ALL UCIS FOR A GIVEN VOLUME GROUP S %TYPE=3 F %UI=1:1:$V(12,-4,2) S %UN=$P($ZU(%UI,%VGI),",") I %UN'="" D PTR,VALROUT Q:%ALLFLG G DONE UTIL ;SET UP UTILITY GLOBAL FOR ALL V 2:$J:%VGI*32+%UI:2 K ^UTILITY($J) S S="" F J=0:0 S S=$N(@("^"_S)) Q:S=-1 S ^UTILITY($J,S)="" Q VALIDAT1 ; V 2:$J:%HI:2 D %L3VLD1 V 2:$J:32*%VGI+%UI:2 Q %L3VLD1 ;RTM;DATABASE VALIDATION UTILITY PART II; [ 11/29/90 8:56 AM ] ;COPYRIGHT MICRONETICS DESIGN CORP @1984 S VALIDATE=1 ; if called from VALIDATE INT W:%NM'="" !!,"^",%NM ; VERIFY calls it here with VALIDATE=0 F %Z=1:1:$L(%ER,"^") S %ET=$P(%ER,"^",%Z),BAD=BAD+1 D RPT W ! Q RPT ; S %B=$P(%ET,",",2) W:VALIDATE ! W !,"BLOCK ",+%B,"," I $D(%GBN) S:%NM'="" $P(%B,":",$L(%B,":")+1)=%GBN W ?15,"OFFSET ",$J($P(%ET,",",3),3,0) W ": ",$S($T(@$P(%ET,",",1))'="":$P($T(@$P(%ET,",",1)),";",2,999),1:"UNKNOWN ERROR: "_$P(%ET,",",1)) I VALIDATE W !,"PATH TO BLOCK: " F %I=$L(%B,":"):-1:1 S %X=$P(%B,":",%I) W %X W:%I>1 "-> " Q 1 ;UNKNOWN BLOCK TYPE 2 ;UNKNOWN DATA TYPE IN BLOCK 3 ;BLOCK TYPE MIS-MATCH WITH DESCENDANT BLOCK 4 ;BLOCK NOT MARKED ALLOCATED IN MAP BLOCK 5 ;RIGHT-HAND LINK DOES NOT MATCH DOWN-LINK OF POINTER KEY 6 ;BLOCK NUMBER MISMATCH 10 ;NON-ZERO COMMON COUNT FOR LEADING KEY IN BLOCK 11 ;ZERO LENGTH UNIQUE COUNT IN KEY 12 ;COMMON COUNT GREATER THAN TOTAL LENGTH OF PREVIOUS KEY 20 ;LENGTH OF LEADING KEY DOES NOT AGREE WITH EXPECTED VALUE 21 ;LEADING KEY DOES NOT MATCH EXPECTED VALUE 30 ;KEYS ARE NOT IN ASCENDING ORDER 31 ;KEY VALUE IS NOT HIGHER THAN KEY IN SUBTREE 40 ;HDRNEXT() INCONSISTENT WITH ACTUAL END 50 ;ZERO POINTER TO LOWER LEVEL 51 ;POSSIBLE LOOP IN POINTER BLOCKS 52 ;POSSIBLE LOOP IN RIGHT-HAND LINKS 60 ;INDEX TO FIRST FREE BLOCK IN MAP IS WRONG 61 ;COUNT OF FREE BLOCK IN MAP IS WRONG 64 ;MAP BLOCK NOT ALLOCATED TO SYSTEM %L3XM %XMIT ;RTM;MSM CPU<->CPU TRANSMIT; [ 05/12/92 8:18 PM ] ; COPYRIGHT MICRONETICS DESIGN CORP. @1985 ; If you need to send $C(1) or $C(2) through as data, ; pick another character and change the line INIT+1. ; %HT = wait time for READs (0 or 1) ; %DT = # of READs from IO device since last terminal read ; %DC = # iterations thru fast loop with no data received ; %RS = 1 if recording, 0 if not S %INT=0 K %MSM ; $D(%MSM) flag for calling from %TRANS S $ZT="ZG "_$ZL_":ERROR^%XMIT" GO S %HT=0,%DT=0,%DC=0,%RS=0 G:%INT INIT W !?10,$P($P($ZV,","),"-")," - TRANSMISSION UTILITY" ASK I $D(^XM("PORT")) S %IO=^XM("PORT") G INIT R !!,"I/O PORT? > ",%IO G:%IO="" EXIT G:%IO?1"^".E EXIT I %IO?1"?".E D QUE G ASK I $P=%IO!'%IO W !!,"CANNOT SELECT YOUR OWN DEVICE.",*7 G ASK S $ZT="ZG "_$ZL_":NOPEN^%XMIT" U $P:(CENABLE) O %IO::0 E W *7,"..LINE IN USE..WAITING.." O %IO W "READY" S $ZT="ZG "_$ZL_":ERROR^%XMIT" U %IO I $ZB($ZA,2,1) U 0 W !,"DEVICE ",%IO," IS AN OUTPUT ONLY DEVICE.",*7 G ASK INIT U 0 S %ESC=$ZB($ZA,64,1) ; save escape processing status S %EXIT=$C(1),%RECORD=$C(2) ; TURN OFF PASS-ALL, ESC PROCESSING, & TAB CONTROL. SET TERMINATORS U %IO:(0::::#001001:#800040:::$C(3,8,13,21,24,27,127)) U 0:(0::::#000001:#800040:::$C(3,8,13,15,18,21,24,27,127)) U $P:(NOCENABLE) W ! S SH=0 TERM ; I '$D(^XM) U 0 R %X:%HT G M S SH=SH+1 S:SH>$L($G(^XM)) %X=%EXIT S %X=$E($G(^XM),SH) I 1 M S %CR=$ZB ; get READ terminator G:$E(%X)=%EXIT EXIT D:$E(%X)=%RECORD .D @$S(%RS:"HALT",1:"RECORD") S %X=$E(%X,2,$L(%X)) Q U %IO W:$L(%X) %X W:$T $C(%CR) S:$L(%X)!$T %DC=0,%HT=0 S %DT=0 PORT ; U %IO R %Y:%HT G:%INT&(%Y=$C(1)) EXIT S %CR=$ZB U 0 W:$L(%Y) %Y W:$T $C(%CR) S:$L(%Y)!$T %DC=0,%HT=0,%DT=%DT+1 S:$L(%Y)&%RS %XS=%XS_%Y I $T,%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1,%XS="" PORT1 I %DT>20 G TERM ; heavy incoming data, force check of CRT G TERM:$L(%X),PORT:$L(%Y) S %DC=%DC+1 G:%DC<500 TERM S %HT=1 ; READ timeout 1, goto slow mode TERMWAIT ; TERMWAIT and PORTWAIT handle periods in which no data has been ; received from either side for %DC iterations through the ; TERM & PORT loop. ;U 0 R %X#1:%HT E G PORTWAIT S SH=SH+1 S:SH>$L($G(^XM)) %X=%EXIT S %X=$E($G(^XM),SH) I 1 G:%X=%EXIT EXIT I %X=%RECORD D @$S(%RS:"HALT",1:"RECORD") S (%DC,%DT,%HT)=0 G TERM S %CR=$ZB U %IO W %X W:'$L(%X) $C(%CR) S (%DC,%DT,%HT)=0 G TERM PORTWAIT ; U %IO R %Y#1:%HT E G TERMWAIT G:%INT&(%Y=%EXIT) EXIT ; %TRANS rtn or gbl selection finished S %CR=$ZB U 0 W %Y W:'$L(%Y) $C(%CR) S (%DC,%DT,%HT)=0 ; If recording... S:$L(%Y)&%RS %XS=%XS_%Y ; add to captured string ; or terminate & file captured string I '$L(%Y),%RS S ^XMIT(%XN,%XE)=%XS,%XE=%XE+1,%XS="" G PORT EXIT ; D:%RS HALT I $D(%ESC),%ESC U 0:(::::64) K %ESC,%X,%Y,%RS,%XN,%XE,%XS,%DC,%DT,%HT,%CR,%EXIT,%RECORD U:(%IO?.N)&(%IO'="") %IO:(:::::#001001:::$C(13,27)) U 0:(:::::#000001:::$C(13,27)) I %INT!$D(%MSM) U $P:(CENABLE) K %INT Q ; return to %TRANS I %IO?.N&(%IO'="") C %IO U 0 K %IO,%INT W:'$F($ZS,"") !,"TRANSMISSION COMPLETE",!! Q RECORD ; S:'$D(^XMIT) ^XMIT(0)=1 S %XN=^XMIT(0),^XMIT(0)=%XN+1,%RS=1,%XS="",%XE=1,%X=$E(%X,2,999),^XMIT(%XN)=$H U 0 W !!,"RECORDING STARTED IN ^XMIT(",%XN,",1)",! Q HALT ; S:$L(%XS) ^XMIT(%XN,%XE)=%XS S %RS=0 U 0 W !!,"RECORDING HALTED, LAST NODE IS ^XMIT(",%XN,",",%XE,")",!! Q NOPEN S %IO="" ; avoid on ERROR ; I $F($ZS,"") F %XE=%XE:1 G:%XS="" ERROR1 S ^XMIT(%XN,%XE)=$E(%XS,1,255),%XS=$E(%XS,256,9999) I $F($ZS,"") U 0 W !!,"...ABORTED." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 I $F($ZS,"") DO:$P'=$P D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 .U 0 W !!,"...DISCONNECTED." Q ERROR1 S $ZT="ZG "_$ZL_":ERROR^%XMIT" G PORT1 ; resume after INT ;FROM TRANSFER UTILS S %INT=1 U $P:(NOCENABLE) G GO ; QUE W !! F %IO=1:1 S %X=$T(TEXT+%IO) Q:%X="" W $P(%X,";",2),! Q TEXT ; ;ENTER THE PORT NUMBER TO BE USED FOR THE TRANSMISSION. ;WHILE THE TRANSMISSION IS IN PROGRESS, ALL CHARACTERS EXCEPT CTRL/A ;AND CTRL/B WILL BE PASSED THROUGH TO THE PORT. ;USE CTRL/B TO START OR STOP RECORDING OF THE INFORMATION IN THE XMIT ;GLOBAL, AND CTRL/A TO EXIT THE PROGRAM. %L4CLC %L4CLC(%S) ; CALCCULATOR ONE-LINE [ 25.07.15 12:51 ] [ 13.08.11 13:59 ] [ 30.11.01 11:19 PM ] N (%S) N $ZT S $ZT="ZG "_$ZL_":ER" S %S=$$SPA^%L1FRM(%S) S %IGUL=0 I %S["<>" S %IGUL=$P(%S,"<>",2),%S=$P(%S,"<>") M0 ; S %L1BT=%S S %S=$TR(%S,"X:|[]{},","*//()().") I $L(%S,"(")'=$L(%S,")") Q "!PARENTHESISNUMBERISWRONG" S I=1,S=%S,UR=1 K ZN,V BEG ; I $E(S,I)="" D VC G EN I $E(S,I)="(" S ZN(UR)=$E(S,I-1) S:ZN(UR)="" ZN(UR)="+" S:ZN(UR)=")"!(ZN(UR)?1N) ZN(UR)="*" S UR=UR+1 G ADI I $E(S,I)=")" D VC S UR=UR-1 G:UR<1 ER S VUR=$G(V(UR)) S V(UR)=VUR_$S("+-*/"[$E(VUR,$L(VUR)):"",1:ZN(UR))_V G ADI S V(UR)=$G(V(UR))_$E(S,I) ADI S I=I+1 G BEG ; VC S S2=V(UR),ZN="",S4="",V=0,J1=1,JOLD=1 D X "S V="_S4 K V(UR) Q C .S S3="" C1 .F J=J1:1:$L(S2) Q:"+-*/"[$E(S2,J) S S3=S3_$E(S2,J) .I S3="",J<$L(S2) S S3=$E(S2,J) S J1=J+1 G C1 .I J'<$L(S2),$L(ZN),$L(S3) D:S3["%" PRCNT Q:S3["%" S @("S4="_S4_ZN_S3) Q .I J'<$L(S2) S:S4="" S4=S3 Q .S ZN1=$E(S2,J),S31="",JOLD=J C2 .F J2=J+1:1:$L(S2) Q:"+-*/"[$E(S2,J2) S S31=S31_$E(S2,J2) .S ZN2="" I J2<$L(S2),S31="" S S31=$E(S2,J2),J=J2 G C2 .I J2<$L(S2) S ZN2=$E(S2,J2) .;;W !,"S4=",S4," ZN=",ZN," S3=",S3," ZN1=",ZN1," S31=",S31," ZN2=",ZN2 H 2 .;-------- +,- & *,/ .I ZN="",ZN1="+"!(ZN1="-"),ZN2="*"!(ZN2="/"),S31'["%" S:S31["%" S31=S31*.01 S S32="" D S @("S30="_S31_ZN2_S32) S @("S4="_S4_ZN_S3_ZN1_S30) S ZN=$E(S2,J3),J1=J3+1,ZN1="",ZN2="" Q:J1>$L(S2) G C ..F J3=J2+1:1:$L(S2) Q:"+-"[$E(S2,J3)&("+-*/"'[$E(S2,J3-1)) S S32=S32_$S($E(S2,J3)'="%":$E(S2,J3),1:"*.01") ..S @("S32="_S32) .I ZN="+"!(ZN="-"),ZN1="*"!(ZN1="/"),S3'["%" S J3=J2 D:ZN2'="" S @("S30="_S3_ZN1_S31) S @("S4="_S4_ZN_S30) S ZN=$E(S2,J3),ZN1="",ZN2="",J1=J3+1 Q:J1>$L(S2) G C ..F J3=J2:1:$L(S2) Q:"+-"[$E(S2,J3)&("+-*/"'[$E(S2,J3-1)) S S31=S31_$S($E(S2,J3)'="%":$E(S2,J3),1:"*.01") ..S @("S31="_S31) .I S3["%",ZN="" D PRCNT S ZN=ZN2,(ZN1,ZN2)="" S J1=J2+1 Q:J1>$L(S2) G C .I S3["%",ZN'="" D PRCNT S ZN=ZN1 S (ZN1,ZN2)="" S J1=JOLD+1 Q:J1>$L(S2) G C .S @("S4="_S4_ZN_S3) S ZN=ZN1 S (ZN1,ZN2)="" S J1=JOLD+1 Q:J1>$L(S2) G C Q PRCNT ; I ZN="+"!(ZN="-") S @("S4="_S4_"*("_100_ZN_+S3_")*.01") I ZN="*"!(ZN="/") S @("S4="_S4_ZN_+S3_"*.01") Q ; EN ; N %RES S %RES=$J($G(V),2,2) I $G(%IGUL) S %RES=$$SUM^W4IGUL(%RES,%IGUL) Q %RES ; ER Q "!ERROR" %L4GCH %L4GCH ;MJ;GLOBAL CHARACTERISTICS--DRIVER [ 10/20/97 4:42 PM ] ;Copyright Micronetics Design Corp. @1990 S $ZT="ZG "_$ZL_":ERROR^%L4GCH" O 63::0 I '$T W !!,"View Buffer busy.. Please retry later" G EXIT D GETVG^%VGUTIL S %MGR=($V(2,$J,2)=1) W !?10,$P($P($ZV,","),"-")," - Global Characteristics Utility" %GLOBAL D SELECT^%GSEL($S(%MGR:"UN",1:"N")) G:'$D(^UTILITY($J)) EXIT K %COLLSEQ,%JOURNAL,%PROTECT I %GSEL=1 D G %GLOBAL:%QF=1,EXIT:%QF D %OPT G EXIT:%QF=2,%GLOBAL .S (%GN,%GLB)=$O(^UTILITY($J,"")) .U 63:(:::"P"),0 .D FIND .U 63:(:::"C"),0 ; Process multiple globals D %OPT G:%QF=2 EXIT I '$D(%COLLSEQ),'$D(%JOURNAL),'$D(%PROTECT),'$D(%DELPROT) G %GLOBAL ; nothing changed W !!,"Changing characteristics for ",%GSEL," globals." S (%COUNT,%GN)="" LOOP S (%GN,%GLB)=$O(^UTILITY($J,%GN)) G:%GN="" EXIT S %W=0,%DD=$D(@("^"_%GN)) I $D(%COLLSEQ),%DD>1 W !,*7,"Global ^",%GN," has subscripts. Cannot change collating sequence." U 63:(:::"P"),0 D FIND I %QF U 63:(:::"C"),0 G EXIT:%QF=2,LOOP I $D(%COLLSEQ),%DD<10 DO .S %X=$V(%OF-1,0,1) .I %X#2'=%COLLSEQ V %OF-1:0:$ZB(%X,1,6):1 S %W=1 ;toggle cs bit I $D(%JOURNAL) D %JRN1^%L4GCH1 S %W=1 I $D(%PROTECT) V %OF:0:%PROTECT:1 S %W=1 I $D(%DELPROT) DO .S %X=$V(%OF-1,0,1) .I $ZB(%X,#20,1)\32'=%DELPROT V %OF-1:0:$ZB(%X,#20,6):1 S %W=1 I %W V -%GBN:"G"_VGI U 63:(:::"C"),0 I $G(%TPTR),$ZMSM(5,%TPTR) ; invalidate top ptr blk in all nakeds S %COUNT=%COUNT+1 ; print status line - allow for message from collseq subrtn I $X W !,$J(%COUNT,$L(%GSEL))," globals processed.",*13 E W $J(%COUNT,$L(%GSEL)),*13 G LOOP EXIT ; C 63 K %ANS,%BLK,%DIV,%DN,%DR,%DT,%EF,%GBN,%GLB,%GN,%HLP,%I,%MF,%NB,%OPT,%PC,%PT,%QF,%QST,%QUE,%RSP,%RSPHLD,%T,%VGN,%X,BTMLEVEL,CLASS,FBLK,GN,PRO,KEY,%OF,%F,%MAX,%UI,CC,I,K,OF,UC,VGI,VGVOL K %ACCESS,%B,%COLLSEQ,%COUNT,%DB,%GNUM,%GSN,%JOURNAL,%MGR,%NAM,%PR,%PROT,%PROTECT,%UCI,%NEW,%GVN,VG,%GSEL,%W,%DD Q ERROR ; I $F($ZS,"") U 63:(:::"C"),0 C 63 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2 Q ; %OPT ; Select characteristic to be changed K %GDFLT ; dflt value only for jrnl menu S %QUE=1,%HLP=3 D %SEL Q:%QF ; All 4 of the following subroutines goto %OPT when done G ^%L4GCH1:%OPT=1,%GRO^%L4GCH1:%OPT=2,%PRO:%OPT=3,%JRN^%L4GCH1:%OPT=4,%DEL^%L4GCH1:%OPT=5 ; Q FIND ; Find directory block and patch offset for the global ; Returns with %GBN (gdir blk containing the global) in the VIEW buffer ; %OF=offset of protection byte, %ACCESS=1 if user has access ; %TPTR=top pointer block S %QF=0,%EF=0 I %GLB["["!(%GLB["|") D Q:%QF .S %UCI=$E(%GLB,3,5),%VGN=$E(%GLB,7,9),%GLB=$E(%GLB,12,$L(%GLB)) .S %UI=+$ZU(%UCI,%VGN) .I '%UI W *7,!,"Global ",%GN," is not on a mounted volume group" S %QF=1 E S %UCI="",%VGN=$P($$^%L1ZU(0),",",2),%UI=+$ZU("") S VGI=VG(%VGN) D Q:%QF .N (%QF,VGI,%GSEL,%GN) D VGINFO^%VGUTIL2(VGI) .I VGRVG S %QF=1 W:%GSEL=1 ! W !,"%L4GCH not allowed on Remote Volume Group" W:%GSEL>1 " ^",%GN," skipped" Q D GETVOL^%VGUTIL S GN=%GLB,%GLB=%GLB_$C(0) FIND1 ; S %GBN=$$GDIR^%VGUTIL2(VGI,%UI),%TPTR=0 FIND2 ; I '%GBN S %F=0 G FIND35 V %GBN:"G"_VGI S OF=$V(1022,0,2),BTMLEVEL=$V(1021,0,1)\128 S K="" K KEY S I=$S(BTMLEVEL&($V(0,0,4)=0):13,1:0) ; 1st btm gdir starts at 13 F I=I:0:OF-1 S CC=$V(I,0,1),UC=$V(I+1,0,1),K=$E(K,1,CC)_$V(I+2,0,UC,1),KEY(I)=K,I=I+UC+2+$S(BTMLEVEL:11,1:3) S %F=0,%X=-1 FIND3 S %X=$N(KEY(%X)) I %X'<0 G:$S(BTMLEVEL:%GLB]KEY(%X),1:KEY(%X)]%GLB) FIND3 S:%GLB=KEY(%X) %F=1 I 'BTMLEVEL,'%F S %GBN=$V(%X+2+$V(%X+1,0,1),0,3) G FIND2 I BTMLEVEL,'%F S %GBN=$ZB($V(1012,0,4),#FFFFFF,1) G:%GBN>0 FIND2 FIND35 ; I '%F,%EF W *7,!!,"Global ",%GN," has been deleted...skipped." S %QF=1 Q I '%F W:%GSEL>1 !,"^",GN W " does not exist.. ",*7 I %F DO Q .S %OF=%X+2+$V(%X+1,0,1)+4,%EF=1 .S %ACCESS=(($V(%OF,0,1)#4)=3),%TPTR=$V(%OF-4,0,3) .Q:%MGR!%ACCESS ; honor protection and always give MGR access .W !,*7,"Access denied to ^",GN W:%GSEL>1 "...skipped." S %QF=1 .Q U 63:(:::"C"),0 FIND4 ; Global does not exist in gdir I $E(%GN)'="[",$E(%GN)'="|" D TRCHK^%L4GCH1 Q:%QF ; check translation W !,"Do you want to create global ^",$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]"),GN," : " R %RSP S:%RSP="" %RSP="Y" S %RSP=$TR(%RSP,"yesnq","YESNQ") I %RSP["?" S %HLP=2 D ^%L4GCH2 G FIND4 S:%RSP["^Q" %QF=2 S:(%RSP["^")!($E(%RSP,1)="N") %QF=1 Q:%QF I $E(%RSP,1,$L(%RSP))'=$E("YES",1,$L(%RSP)) W " ?? ",*7 G FIND4 S @("^"_$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]")_GN_"(1)")=1 K ^(1) ZF S %EF=1 W !,"Global created" U 63:(:::"P"),0 G FIND1 ; %PRO ; Modify protection byte ; If >1 globals selected, pass back new protection byte in %PROTECT I %GSEL>1 DO ; For multiple globals, begin with svector default .I $D(%PROTECT) S %PROT=%PROTECT Q .S %X=$O(^UTILITY($J,"")) ; get first global selected .S %X=($E(%X)'="%") ; Is it a non-% global? .S %PROT=$V(122+%X,-4,1) ; %X=0 is for % globals I %GSEL=1 S (%PROT,%PROTECT)=$V(%OF,0,1) W !!,$S('$D(%PROTECT):"Default",1:"Current")," Status -->" D %LST S %QUE=2,%HLP=4 D %SEL G EXIT:%QF>1,%OPT:%QF S PRO=$S(%OPT=1:0,%OPT=2:1,%OPT=3:2,%OPT=4:3,1:4) ; %CLASS S %QUE=3,%HLP=5 D %SEL G EXIT:%QF>1,%PRO:%QF ; %CLASS1 F %I=1:1 S %X=$P(%OPT,",",%I) Q:%X="" S %PT(%X)=PRO S %PROT=0,%DIV=256 F %X=1:1:4 S %DIV=%DIV\4,%PROT=%PROT+(2*%DIV*(%PT(%X)\2)+(%DIV*(%PT(%X)#2))) I %GSEL=1 DO G:%QF %OPT .U 63:(:::"P"),0 .D FIND1 I %QF U 63:(:::"C"),0 Q .V %OF:0:%PROT:1 V -%GBN:"G"_VGI .U 63:(:::"C"),0 .I $G(%TPTR),$ZMSM(5,%TPTR) ; invalidate top ptr blk in all nakeds E S %PROTECT=%PROT ; return new value to main procedure W !!," New Status --> " D %LST G %OPT %LST S %DIV=256 F %X=1:1:4 S %DIV=%DIV\4,%PC=%PROT\%DIV#4,%PT(%X)=%PC W ?(%X-1*15+20),$P("System,World,Group,User",",",%X)," = ",$P("NONE,R,RW,RWD",",",%PC+1) Q %SEL ;OPTION DRIVER S %MF=0 U 0 W !!,"Select ",$P($T(@("MENU"_%QUE)),";",2,99) W !! F %I=1:1 S %T=$T(@("MENU"_%QUE)+%I) Q:$P(%T,";",2)="*" W !,?5,%I,?10,$P(%T,";",2) W !!,$P($T(@("MENU"_%QUE)+%I+1),";",2) %SEL1 I %GSEL=1 W " for ^",$S(%UCI="":"",1:"["""_%UCI_$S(%VGN="":"",1:""","""_%VGN)_"""]"),GN I $D(%GDFLT) W " <",%GDFLT,">" R ": ",%RSP I %RSP="",$D(%GDFLT) S %QF=0,%OPT=%GDFLT Q S %QF=$S("^Q"=%RSP:2,"^"[%RSP:1,1:0) Q:%QF I %RSP?1"?".E D ^%L4GCH2 G %SEL I %RSP["," D %SEL4 I %RSP'["," D %SEL2 G %SEL1:%QF>1,%SEL:'%QF S %QF=0 Q %SEL2 I %RSP?1N.N G %SEL3 ;SELECTION BY LEADING CHARACTER S %QF=0 F %I=1:1 S %T=$P($T(@("MENU"_%QUE)+%I),";",2) Q:%T="*" I %RSP=$E(%T,1,$L(%RSP)) S %QF=%QF+1,%OPT=%I Q:%QUE=2 I %QF=0 G %SEL5 I (%QF=1)&(%MF=1) W $E($P($T(@("MENU"_%QUE)+%OPT),";",2),1,255) Q E W $E($P($T(@("MENU"_%QUE)+%OPT),";",2),$L(%RSP)+1,255) Q W !!,*7,"Please be more specific ",! F %I=1:1 S %T=$P($T(@("MENU"_%QUE)+%I),";",2,99) Q:%T="*" I %RSP=$E(%T,1,$L(%RSP)) W !,?5,%I,?10,%T W !!,$P($T(@("MENU"_%QUE)+%I+1),";",2)," " Q %SEL3 I (%RSP<%I&%RSP>0) W " ",$P($T(@("MENU"_%QUE)+%RSP),";",2,99) S %QF=1,%OPT=%RSP Q E S %QF=0 G %SEL5 %SEL4 I %QUE'=3 W !!,*7,"Enter one choice only ",! S %QF=0 Q S %RSPHLD=%RSP,%MF=1 W " " F %X=1:1 S %RSP=$P(%RSPHLD,",",%X) Q:%RSP="" D %SEL2 Q:%QF'=1 S $P(%RSPHLD,",",%X)=%OPT W:$L(%RSPHLD,",")'=%X "," S %MF=0,%RSP=%RSPHLD Q:%QF'=1 S %OPT=%RSPHLD Q %SEL5 W !!,*7,"Invalid option selection, enter '?' for more help" Q MENU1 ;OPTION ;Collating Sequence ;Global Growth ;Protection ;Journaling ;Allow/Prevent KILL ;* ;Enter option MENU2 ;PROTECTION STATUS ;N - None ;R - Read ;RW - Read/Write ;RWD - Read/Write/Delete ;* ;Enter protection MENU3 ;CLASS ;System ;World ;Group ;User ;* ;Enter class MENU4 ;Journaling Option ;Always journal ;Journal only when UCI is journaled ;Never journal ;* ;Select Option %L4GCH1 %L4GCH1 ;MJ;GLOBAL CHARACTERISTICS--COLLATING SEQ [ 10/20/97 4:42 PM ] ;Copyright Micronetics Design Corp. @1984 ; Enter at the top for collating sequence ; If >1 global selected, return collseq in %COLLSEQ G:%GSEL>1 %COL G:$D(@("^"_GN))<10 %COL W !!,*7,"Global ^",GN," contains subscripts..." W !?5,"collating sequence cannot be changed",*7 G EXIT %COL I %GSEL=1 S %COLLSEQ=$V(%OF-1,0,1)#2 %COL1 W !!,"Enter Collating Sequence" W:%GSEL=1 " for ^",$S(%UCI="":"",1:"["""_%UCI_"""]"),GN I %GSEL=1 W:%COLLSEQ " " W:'%COLLSEQ " " R ": ",%X I $E(%X)="^" K %COLLSEQ G EXIT:%X="^",EXIT^%L4GCH:%X="^Q" I %X["?" S %HLP=6 D ^%L4GCH2 G %COL1 S %NEW=$S(%X="N":0,%X="S":1,%X="":3,1:4) W:%NEW<3 $S(%X="N":"UMERIC",%X="S":"TRING") I %GSEL=1 S:%NEW=%COLLSEQ %NEW=3 I %NEW=4 W " ?? ",*7 G %COL1 I %NEW=3 W " unchanged " K %COLLSEQ G EXIT S %COLLSEQ=%NEW G:%GSEL>1 EXIT U 63:(:::"P"),0 D FIND1^%L4GCH G:%QF EXITC V %OF-1:0:$V(%OF-1,0,1)+$S(%NEW:1,1:-1):1 EXITW ; V -%GBN:"G"_VGI EXITC ; U 63:(:::"C"),0 I $G(%TPTR),$ZMSM(5,%TPTR) ; invalidate top ptr blk in all nakeds EXIT G %OPT^%L4GCH %GRO ; I %GSEL>1 W !!,"Cannot change growth pointer on multiple globals." G EXIT %G1 S %X=$V(%OF+4,0,3) W !!,"Enter Global Growth Pointer <" W:'%X "0" W:%X (%X\512+1) W ">: " R %X G EXIT:"^"=%X,EXIT^%L4GCH:%X="^Q" I %X=""!(%X=$V(%OF+4,0,3)) W " unchanged" G EXIT I %X?1"?".E S %HLP=7 D ^%L4GCH2 G %G1 I %X?1N.N S %BLK=%X-1*512+1 G DN I %X'?1N1":"1N.N W " Invalid syntax",*7 G %G1 S %DB=$P(%X,":",1),%B=$P(%X,":",2) I '$D(VGVOL(%DB)) W !,?5,"Volume ",%DB," does not exist.",*7 G %G1 S %BLK=%B-1*512+1+$P(VGVOL(%DB),"^",2) DN ; I %X="0" D G EXITC:%QF,EXITW ;remove the growth pointer for the global .U 63:(:::"P"),0 .D FIND1^%L4GCH Q:%QF .V %OF+4:0:0:3 F VOL=0:1:VGVOL-1 I (%BLK>$P(VGVOL(VOL),"^",2))&(%BLK<($P(VGVOL(VOL),"^",2)+$P(VGVOL(VOL),"^",4)-510)) G DN1 E W !!,"Map is not in database" G %G1 DN1 U 63:(:::"P"),0 D FIND1^%L4GCH G:%QF EXITC V %OF+4:0:%BLK:3 ;W !!,"New global growth pointer is Map ",%BLK\512+1 G EXITW BN ;Transform block # from internal to external format ;Input - X as a block number ;Output - Y as volume index:relative block number S Y="0:"_X F I=VGVOL-1:-1:0 S %P1=$P(VGVOL(I),"^"),%P2=$P(VGVOL(I),"^",2) I %P2'>X,%P1+%P2-1'1 EXIT U 63:(:::"P"),0 D FIND1^%L4GCH G:%QF EXITC D %JRN1 G EXITW %JRN1 S %X=$V(%OF-1,0,1) ; get current value of jrn/cs field S %X=$ZB(%X,#C0,2) ; Turn off both jrnl flags S %X=$ZB(%X,%JOURNAL,7) ; Turn on selected jrnl flags V %OF-1:0:%X:1 Q %DEL I %GSEL=1 S %DELPROT=$ZB($V(%OF-1,0,1),#20,1) %DEL1 W !!,"Prevent KILL of Entire Global" W:%GSEL=1 " for ^",$S(%UCI="":"",1:"["""_%UCI_"""]"),GN I %GSEL=1 W:%DELPROT " " W:'%DELPROT " " R ": ",%X I $E(%X)="^" K %DELPROT G EXIT:%X="^",EXIT^%L4GCH:%X="^Q" I %X["?" S %HLP=9 D ^%L4GCH2 G %DEL1 I $E(%X)="n" S %X="N" I $E(%X)="y" S %X="Y" S %NEW=$S($E(%X)="N":0,$E(%X)="Y":1,%X="":3,1:4) I %GSEL=1 S:%NEW=(%DELPROT\32) %NEW=3 W:%NEW<4 $S(%X="N":"O",%X="Y":"ES",1:"") I %NEW=4 W " ?? ",*7 G %DEL1 I %NEW=3 W " unchanged " K %DELPROT G EXIT S %DELPROT=%NEW G:%GSEL>1 EXIT U 63:(:::"P"),0 D FIND1^%L4GCH G:%QF EXITC V %OF-1:0:$V(%OF-1,0,1)+$S(%NEW:#20,1:-#20):1 G EXITW TRCHK ; check for translated globals N X,DD,ZR S X=$V(140,$J,2) D OFF^%MODESET(3) S DD=$D(@("^"_%GN)),ZR=$R V 140:$J:X:2 I $E(ZR,2)="|" D S %QF=1 Q .W:%GSEL=1 ! .W *7,!,"Global ",%GN," is translated to ",$E(ZR,4,10) .W !,"It may not be changed from this UCI" Q %L4GCH2 %L4GCH2 ;MDS;MSM GLOBAL CHANGE UTILITY HELP INFO [ 10/20/97 4:43 PM ] ;Copyright Micronetics Design Corp. @1990 ; ;THIS ROUTINE WRITES THE HELP RESPONSES FOR THE ;GLOBAL CHANGE UTILS ; N ID,F S ID=$P($P($ZV,","),"-") S $Y=0 W !! F %I=0:1 S %X=$P($T(@("HLP"_%HLP)+%I),";",2) Q:%X="*" D Q:%X=94 .F S F=$F(%X,"@ID") Q:'F S %X=$E(%X,1,F-4)_ID_$E(%X,F,$L(%X)) .W %X,! I $Y>21 D CONT Q:%X=94 W # W "Enter to continue" R *%X F %Y=$X:-1:1 W $C(8,32,8) K %X,%Y Q CONT W "Enter to continue, '^' to quit." R *%X F %Y=$X:-1:1 W *8,*32,*8 Q %HELP ; HLP2 ;Enter '^' to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter 'Y' or to create global, or enter 'N' to select another global. ;* HLP3 ;Enter '^' or to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter C-Collating Sequence, P-Protection, G-Global Growth, ; J-Journaling, A-Allow/Prevent KILL ;or Enter the Option number. ;* HLP4 ;Enter '^' or to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter N-None, R-Read, RW-Read/Write, RWD-Read/Write/Delete ;or Enter the Protection number. ; ;None means that no access is possible to the class to be specified. ;Read means that the class can read the global, but not write or ;delete nodes. ;Read/Write means that the class can read from and write to the global. ;Read/Write/Delete means that the class can also delete nodes. ;* HLP5 ;Enter '^' or to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter the class of user that you wish to apply the protection ;previously entered as follows: S-System, U-User, G-Group, W-World ;or Enter the Class number. ; ;To enter more than one class, separate by commas, ;i.e. U,S or 4,1 for User and System classes. ; ;The user classes are as defined as follows. ; ;System is the manager's UCI ;User is the UCI in which the global resides. ;Group is the set of all UCI's in this Volume Group. ;World is the set of all UCI's in other Volume Groups. ; ;Protection status is maintained in the following priority ;order: System,User,Group,World. For example, if a global ;in the manager's UCI has no access for SYSTEM, but has RWD access ;for USER, a error will be generated when this global ;is accessed from the manager's UCI. In this example, when the global ;is accessed, @ID first checks the protection status for SYSTEM ;(MGR) and finds that no access is allowed. Even though USER access ;is allowed, @ID preferentially uses the SYSTEM class protection ;status in determining global access. ;* HLP6 ;Enter '^' to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter N-Numeric, S-String ;* HLP7 ;Enter '^' to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter a Map Number for global growth. The Map Number ; can be specified as "Volume Number:Relative Map" ; if the actual Map Number is not known, or ;Enter '0' to remove the global growth pointer. ;* HLP8 ;Enter '^' to back up to the previous question, or ;Enter '^Q' to exit, or ;Select option 1 to journal selected global(s) regardless of the ; journal status for the UCI. ;Select option 2 to journal selected global(s) when the UCI ; is journalled. ;Select option 3 to disable journaling for the global(s) ; regardless of the journaling status for the UCI. ;* HLP9 ;Enter '^' to back up to the previous question, or ;Enter '^Q' to exit, or ;Enter YES to prevent unsubscripted KILLs to the selected global(s), or ;Enter NO to allow unsubscripted KILLs (i.e., allow the global(s) to be deleted) ;* %L4LOGON %LOGON ;MJ;LOGON ROUTINE; [ 03/08/99 8:46 AM ] [ 11/23/93 11:15 AM ] ;Copyright Micronetics Design Corp. @1990 K % S %LOGON=1 SYSTEM ; O 0::0 E H U 0 U $P:(NOCENABLE) I $ZB($ZA,8,1) H 1 ; modem control timing S MU=$ZB($V(0,-4,2),16,1),%PS=$S(MU:20480,1:51200) G:$V(121,-4,1) LICENSE^%LOGON0 L ZD D EXPDATE^%LOGON0 S %INT=1,%RETRY=3 K BASELINE I $V(2,-4,2)#2=0 D ^STU S MU=$ZB($V(0,-4,2),16,1),%PS=$S(MU:20480,1:51200),%UI=1 S:$D(BASELINE) %VGI=0 G PGMR:$D(BASELINE),SYSTEM ;AUTO STARTUP V 0:$J:$ZB($V(0,$J,2),250,1):2 LOGON ; W $C(27,41,76) S LOGON=$V(4,-4,2)\64#2,CONSOLE=$V(4,-4,2)\2048#2,SSD=$V(4,-4,2)\32768#2 I LOGON!CONSOLE!SSD,$I'=1 W !,"Signon not allowed now." H V 2:$J:1:2 ;SWITCH TO MGR's UCI S CNFG=0 I $D(^SYS("CONFIG"))#2 S CNFG=$P(^SYS("CONFIG"),";",2) I CNFG="" S CNFG=0 S CNFG=+^SYS("CONFIG",CNFG) U $I:(:::::1) I $D(^SYS(CNFG,"DDB",$I))#2 U $I:(:::::#FDFF) U $I:($P(^($I),",",5)::::$ZH($P(^($I),",",6))) IF I $ZB($ZH($P(^($I),",",6)),258,1) HALT ; check for nolog and output only bits S:$D(^SYS(CNFG,"PSIZE")) %PS=^SYS(CNFG,"PSIZE") I %PS=20480 S:$V(0,-4,2)#16=8&'MU %PS=51200 G:'MU TTT S LATBASE=$V($V(29,-5)+8,-3,0) I LATBASE,'$G(%LOGON) S DI=$V(4*$I+$V(7,-5),-3,0) I $ZB($V(DI+20,-3,4),#10000000,1) S DI=$V(DI+72,-3,0),SRVSTR=$V(DI+101,-3,$V(DI+100,-3,1),1) D G:VCNO&($P(SRVSTR,"`",4)'="") TIEDLAT I 'VCNO W !!,"This LAT service has been disabled or deleted" H .S SRVSTR=$$UPCASE(SRVSTR) .S VCNO=0 F I=0:1:$V($V(58,-5)+8,-3,2)-1 D Q:VCNO ..D VGINFO^%VGUTIL2(I,1) I '$ZB(VGFLAGS,#100,1) Q ..I $ZU(VGSYSUCI,I)="" Q ..I '$D(^[$ZU(VGSYSUCI,I)]SYS("LAT_SERV",1)),I=0 Q ..S SLNO="" F S SLNO=$O(^(SLNO)) Q:SLNO="" I $P(^(SLNO),"`")=SRVSTR,$P(^(SLNO),"`",3)="Y" S SRVSTR=^(SLNO),VCNO=1 Q TTT S TTT=0 I $D(^SYS(CNFG,"DDB",$I))#2 S TTT=+$P(^($I),",",4) I $D(^SYS(CNFG,"TTT",TTT))#2 G TIEDTERM I $I>1,$D(^SYS(CNFG,"DDB",$I))#2=0,$D(^SYS(CNFG,"TTT","DYNAMIC"))#2 S TTT=^("DYNAMIC") G TIEDTERM G:$D(^SYS("PASSWD"))#2=0 PROMPT U $P:(NOECHO:NOWRAP) W !,":" R %ID:180 U $P:(ECHO:WRAP) G ABORT:'$T,ABORT:%ID'=^SYS("PASSWD") K %ID PROMPT ; I $ZB(+$P($$LICINFO^%MSMOPS,"^",2),32,1) D .I $D(%),$ZUCASE(%)'["MGR:XXX" S %=%_" MGR:XXX" .I '$D(%) S %=" MGR:XXX" D:$D(%) LOGPARMS^%LOGON0(%) I $D(%ID) G:$G(TIED) TIEDTERM ; check for signon parms S:'$D(%INT) %INT=1 I %INT W !,$ZV," Line #",$I," UCI: " D READ G:'$T ABORT S %UCI=$P(%ID,":",1) I $L(%UCI)<1 G:$ZB($ZA,8,1) RETRY Q I %UCI[$C(0) W " ...Invalid" G RETRY S %VGNA=$P(%UCI,",",2),%UCI=$P(%UCI,",",1) S %USERVGNA=1 I %VGNA="" S %VGNA=$P($$^%L1ZU(0),",",2) S %USERVGNA=0 I %UCI="" W " ...Invalid" G RETRY I $D(^SYS("LOGON",%UCI)) I $P(%ID,":",2)'=$P(^SYS("LOGON",%UCI),":",4) S %OUI=$V(2,$J,2) G:$ZU(%UCI,%VGNA)'="" PROMPT1 W " ...Invalid" G RETRY I $D(^SYS("LOGON",%UCI)) S %ID=$P(^SYS("LOGON",%UCI),":",1,3),%VGNA=$E(%ID,5,7),%UCI=$P(%ID,",") PROMPT1 I $P(%ID,":",3)'="" S %PS=$P(%ID,":",3)*1024 S:%PS<12288!(%PS>262144) %PS=$S($D(^SYS(CNFG,"PSIZE")):^("PSIZE"),1:20480) S %ID=$P(%ID,":",2) UCINUM S %OUI=$V(2,$J,2),%UI=+$ZU(%UCI,%VGNA),%VGI=+$P($ZU(%UCI,%VGNA),",",2) I %UI'=0 G PGMTST S %TEMPVGNA=%VGNA I %UI=0 F %VGI=0:1:$V($V(58,-5)+8,-3,2)-1 S %TEMPVGNA=$P($ZU(1,%VGI),",",2) I %TEMPVGNA'="" S %UI=+$ZU(%UCI,%TEMPVGNA) Q:%UI I %UI=0 W " ...UCI not found" G RETRY S:'%USERVGNA %VGNA=%TEMPVGNA S %UI=+$ZU(%UCI,%VGNA),%VGI=+$P($ZU(%UCI,%VGNA),",",2) I %UI=0 W " ...Invalid Volume Group" G RETRY PGMTST ; S %PGMR=$$UCIPSWD^%VGUTIL2(%VGI,%UI) I %PGMR'="" G:%ID=%PGMR PGMR G:'$D(^SYS(CNFG,"PAC")) NOPAC I %PGMR="" G:%ID=^SYS(CNFG,"PAC") PGMR I %ID="" W *7," ... invalid 'null' application id" G RETRY NOPAC ; I $D(^%) ;CLEAR NAKED I $D(^%E) ;CLEAR NAKED V 2:$J:%VGI*32+%UI:2,108:$J:%PS:4 ;SWITCH TO NEW UCI G:%ID="" PGMR S:'$F(%ID,"^") %ID="^"_%ID S I=$P(%ID,"^",2) I I'?1A.7AN,I'?1"%".7AN W *7," ..invalid application id" G RETRY S I=$P(%ID,"^") I I'="",I'?1A.7AN,I'?1"%".7AN,I'?1.8N W *7," ..invalid label" G RETRY I $E($P(%ID,"^",2))'="%",$D(^ ($P(%ID,"^",2)))=0 W *7," ..invalid application id" G RETRY K (%,%ID) G @%ID PGMR ; I $D(^%) ;CLEAR NAKED V 0:$J:$ZB($V(0,$J,2),1,7):2,2:$J:%VGI*32+%UI:2,108:$J:%PS:4 S EXP=$G(EXP) I $ZB(+$P($$LICINFO^%MSMOPS,"^",2),32,1) D .W:'EXP $ZV," " .S:'%INT %INT=1 W "Line #",$I W:%INT " Job #",$J K X "ZR Q" Q READ ; Read user login ; returns $T=0 if timeout I $ZB($V(0,-4,2),#F0F,1)=#800 U $P:(NOECHO:NOWRAP) R %ID:180 S:%ID?3L1":".E %ID=$$UPCASE(%ID) U $P:(ECHO:WRAP) Q ; MUMPS/VM NEW X,Y,BS,DEL U $P:(NOECHO:NOWRAP) ; echo off S DEL=$V(126,-4,1),BS=$V(127,-4,1) S X="" R "" ; flush type-ahead F R *Y:180 Q:Y=13!'$T DO ; $T set here, not modified hereafter .I (Y=8!(Y=127)&'BS)!(Y=BS) DO Q ; process backspace ..Q:X="" W $C(8,32,8) ; erase # ..S X=$E(X,1,$L(X)-1) ; remove last char .I (Y=21!(Y=24)&'DEL)!(Y=DEL) DO Q ; line delete ..Q:X="" ..F Y=1:1:$L(X) W $C(8,32,8) ; erase the line ..S X="" Q .I Y>96 S Y=Y-32 .S X=X_$C(Y) W $C(Y) Q ; echo * for each char U $P:(ECHO:WRAP) ; echo on S:X?3L1":".E!(X?3L1","3L1":".E) X=$$UPCASE(X) ; if UCI entered in lower case, -> upper S %ID=X Q UPCASE(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") TIEDTERM ;TIED TERMINAL I $G(TIED) ; from logon parms E S TIED="",%UCI=$P(^(TTT),",",2),%ID=$P(^(TTT),",",1),%PS=$P(^(TTT),",",3) S %UI=$ZU($P(%UCI,":"),$P(%UCI,":",2)) G TIEDGO TIEDLAT ;TIED TERMINAL FOR LAT S TIED="",SRVSTR=$P(SRVSTR,"`",4),%UCI=$P(SRVSTR,":",1),%ID=$P(SRVSTR,":",2),%PS=$S($P(SRVSTR,":",3)="":%PS,1:$P(SRVSTR,":",3)*1024) S %UCI=%UCI_","_$P($ZU(1,I),",",2),%UI=$ZU($P(%UCI,","),$P(%UCI,",",2)) TIEDGO ; V 108:$J:%PS:4 S %VGI=$P(%UI,",",2),%UI=+%UI I %UI=1,%ID="%LOGON" K TIED G PROMPT G NOPAC:%UI>0 W " ..UCI not found" G RETRY INT ; S %INT=0,%UCI=%ID,%RETRY=0 G LOGON RETRY ; I $D(TIED) W !," ..logon aborted" H 2 Q V 2:$J:1:2 ;SWITCH TO MGR's uci S %RETRY=%RETRY-1 G:%RETRY PROMPT W !!,"Logon aborted.." H 2 I $D(%OUI) V 2:$J:%OUI:2 ;SWITCH back to original UCI ABORT Q %MGR ;Entry to put user back into MGR and goto error subrtn (VALIDATE) V 2:$J:1:2 I $D(%ZT) G:%ZT'="" @%ZT Q %L4MENU %L4MENU ; [ 08.10.06 09:43 ] [ 17.09.06 13:18 ] [ 19.06.05 07:48 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MAC,@MAC,%I) D ^%L1C ;---------- INIT ------------- S CL0=%CL0,CCL0=%CCL,CVKP="BCB,YF",BCGR="MB" I %TYPCRT'="PC",%CVET S BCGR="BCB" S VRT=" "_$S(%TYPCRT="PC":$C(179),$E(%TYPCRT,1,3)="VT5":$C(27)_"(0"_$C(120,27)_"(B",1:"|")_" " S %L1RBCL=%CV(BCGR) ; ;;S SM0=72,SM01=SM0+2 S LCOD=2,LG(1)=5-'%ENGLISH ; S WD(1)=32+LCOD,WD(2)=32+LCOD I %ENGLISH D .S X1(1)=LG(1),X2(1)=X1(1)+WD(1)+1 .S X1(2)=X2(1)+3,X2(2)=X1(2)+WD(2)+1 I '%ENGLISH D .S X1(2)=LG(1),X2(2)=X1(2)+WD(2)+1 .S X1(1)=X2(2)+3,X2(1)=X1(1)+WD(1)+1 ; S ind=$O(^l4m0($P,9999),-1)+1 M ^l4m0($p,ind)=^l4menu($p) S GL="^l4menu($P,TF)" K ^l4menu($P) S SH0=0,SAYOLD="" S SH1(1)=1 S CWND=1 ; D SIDKVZ S RL=%L4MAX\2+(%L4MAX#2) S Y1=$S(RL<17:5,1:3),Y2=Y1+RL+1 ;--------------- SIDUR KVUZOT ; M S SH=1,TF=1,(CWND,CWNDOLD)=1,CURTF=TF,FL10=1,(PG,PGOLD)=1 ; H D VIEW ; R S %OTO=$G(%TO,"DW") K CAM,%TO,COD,REST,%SC,P1AI,HRP S CURTF=TF I $P($H,",",2)\60-%L2MT D TIME F I=SH:-1:1 Q:$D(@GL@(SH1(TF)+((CWND-1)*RL)+I-1)) S SH=I I $G(CDNIN) S CDN=$E(CDNIN,1,$L(CDNIN)-1),%TO=$E(CDNIN,$L(CDNIN)) K CDNIN G R1 D BAR(CWND,SH) I %TO'?1N.N,%TO'="*",$A(%TO)<96!($A(%TO)>122) S CDN="" ;;D CL1 ; R1 ;;I %TO="END",TF=1,CWND=1 S SH=0 G END I %TO="END"!(%TO="=") S SH=0,TF=1,CWND=1 G END ;;I %TO="END",TF=1,CWND=2 S %TO="TAB" ;;I %TO="END" D G R ;;I %TO="=" G END I %TO="LEFT"!(%TO="RIGHT") S %TO="TAB" ;;I %TO="RIGHT"&'%ENGLISH!(%TO="LEFT"&%ENGLISH) D G R .I CWND=2 D CLN(CWND,0),CLBAR(CWND,SH) S CWND=1 D CLN(CWND,1) Q I %TO="TAB"!(%TO="TABN") K P1HZTF7 D CLN(CWND,0),CLBAR(CWND,SH) S CWND=3-CWND D CLN(CWND,1) G R ; ;----------------------- HIPUS LEFI SHEM ;;I %TO="F6" D CLBAR(CWND,SH) D G:STRING="" R S %TO="" D VIEW S %TO="" .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,STRING,SH,SHOLD,PG,PGOLD,CWNDOLD,X1,X2,Y1,Y2,WD1,WD2,SH1,SH2,RL,TF,GL,KVZ,BCGR,KOT,CL0,CCL0,CVKP,CWND,PG,LCOD) D ^%L1C .S SHF6=SH,SHOLDF6=$G(SHOLD),CWNDOLDF6=CWNDOLD,PGOLDF6=PGOLD,%SCRN="%L4MENU" .S FILE=MAC,%HBRY="" D POISK^%L3MBGS .I FLAG'="" S STRING="",SH=SHF6,SHOLD=SHOLDF6,CWNDOLD=CWNDOLDF6,PGOLD=PGOLDF6 .Q:STRING="" .D FIND(STRING) ;-------------------------- NUMBER ; I %TO>0&(%TO<10)!(%TO=0) S OKCDN=0 S:$G(CDN)>3 CDN="" S CDN=$G(CDN)_%TO S:$L(CDN)>2 CDN=$E(CDN,$L(CDN-1),$L(CDN)) D G R .N %I,A F %I=1:1:(2*RL) Q:'$D(@GL@(SH1(TF)+%I-1)) D Q:OKCDN ..I %I-1=CDN D CLBAR(CWND,SH),CLN(CWND,0) S SH=%I,OKCDN=1 S:SH'>RL CWND=1 S:SH>RL CWND=2,SH=SH-RL D CLN(CWND,1) Q ; I %TO>0&(%TO<10)!(%TO=0) D G R .N SHT S SHT=%TO .I $D(@GL@(SH1(TF)+((CWND-1)*RL)+SHT-1)) D CLBAR(CWND,SH) S SH=SHT Q ; ;------------------------------ HEBREW I $A(%TO)>95&($A(%TO)<123) S OKCDN=0 S CDN=%TO_$G(CDN) D G R .N %I,A F %I=1:1:(2*RL) Q:'$D(@GL@(SH1(TF)+%I-1)) S A=$G(^(SH1(TF)+%I-1)) D Q:OKCDN ..N IN S IN=$E(A,$L(A)-$L(CDN)+1,255) ..I IN=CDN D CLBAR(CWND,SH),CLN(CWND,0) S SH=%I,OKCDN=1 S:SH'>RL CWND=1 S:SH>RL CWND=2,SH=SH-RL D CLN(CWND,1) Q ;-------- ENTER I %TO="" G END ; I %TO="UP",SH'>1 D G R .D CLBAR(CWND,SH) .I $D(@GL@(SH1(TF)+((CWND-1)*RL)+RL-1)) S SH=RL Q .N I F I=SH+RL-1:-1:SH Q:$D(@GL@(SH1(TF)+((CWND-1)*RL)+I-1)) .S SH=I I %TO="UP" D CLBAR(CWND,SH) S SH=SH-1 G R ; I %TO="DW",'$D(@GL@(SH1(TF)+((CWND-1)*RL)+SH))!(SH'9 m ^l4menu($p)=^l4m0($p,ind) Q ; BAR(WND,SCH) X:$D(BAR1) %LIGHT D POS1(WND,SCH) S %S=$$DATA(TF,WND,SH) I $E($TR(%S," ",""))="~" X %XCL S %TO=$S('%OTO:%OTO,1:0) Q D POS1(WND,SCH) N CIST,%LS,%INV S CIST="",%LS=WD(WND)-LCOD-2 S:'$D(BAR1) %INV="" D CL0 S %ZMSL("TIME")=60 I '%ENGLISH S %ZMSF="",%L1NMB("NO")="" D ^%L1ZMS X %XCL I %ENGLISH S %ZMSF="" D ^%L1ZMSL X %XCL Q BAR1(WND,SCH) N BAR1 S %L1GET="",BAR1="" D BAR(WND,SCH) K %L1GET Q ; DATA(TF,WND,SCH) N A S A=$G(@GL@(SH1(TF)+((WND-1)*RL)+SCH-1)) Q A ; HZG(TF) ; N %CL0,%CCL,BC S BC=BCGR D CL0 ;S BCGR=$S(TF=1:"GB",1:"YB") D CL0 X %XCL W %HBR S %L1RBCL=%CL0 ;;I TF=1 S %XX=1,%YY=Y1-3 X %POSIC W %CV("BB"),%chists D TV^%L1RBUA(Y1,X1(1),Y2,X2(1)) D KOTHZG(TF,1,PG) I $D(@GL@(SH1(TF)+(2*RL))) X %LIGHT S %SAY=" ++"_(Y1+RL)_","_(X1(TF)+10)_",HH" X %XMSG F %I=1:1:RL Q:'$D(@GL@(SH1(TF)+%I-1)) D PC(TF,1,%I) D TV^%L1RBUA(Y1,X1(2),Y2,X2(2)) D KOTHZG(TF,2,PG+1) F %I=1:1:RL Q:'$D(@GL@(SH1(TF)+RL+%I-1)) D PC(TF,2,%I) S RL(TF)=%I-'$D(@GL@(SH1(TF)+%I-1)) S BCGR=BC Q KOTHZG(TF,WND,PG) ; Q X %LIGHT S %SAY=PG_" sc "_$G(KOT(TF))_" ++"_(Y1-1)_","_(X2(WND)-6)_",HH" I $D(@GL@(SH1(TF)-1)) S %SAY=" "_%SAY D CL0 X %XMSG I $D(@GL@(SH1(TF)+(2*RL))) X %LIGHT S %SAY=" ++"_(Y1+RL)_","_(X1(TF)+10)_",HH" X %XMSG Q CL0 S %CL0=%CV(BCGR) S %CCL=$C(27,91,48,109)_%CV(BCGR) S %L1RBCL=%CL0 Q CL1 S %CL0=CL0,%L1RBCL=%CL0 S %CCL=CCL0 X %XCL Q PC(TF,WND,%I) ; N A S A=$G(@GL@(SH1(TF)+((WND-1)*RL)+%I-1)) D POS(WND,%I) D CL0 I $E($TR(A," ",""))="~" W %LIGHT1,%CV($S(%TYPCRT="PC":"YF",1:"CF")),$TR($TR($$KAV($E($$SPL^%L1FRM(A),2,255),WD(CWND)),%TES1,%TES2),%TEN,%THB),%CCL Q N %I0 S %I0=%I-1 ;;I '%ENGLISH W %LIGHT1,%CV("YF"),$J(WND-1*RL+%I0,2),%CCL D CL0 W %HBR," ",$TR($TR($$HBR^%L1FRM(A,WD(CWND)-LCOD-2)_" ",%TES1,%TES2),%TEN,%THB) Q ;;I %ENGLISH W %ENG,$E(A,1,WD(CWND)-LCOD-1)_$J("",WD(CWND)-LCOD-2-$L(A))," " W %LIGHT1,%CV("YF"),$J(WND-1*RL+%I0,2),%CCL D CL0 W %LIGHT1,%CV("YF"),$J(WND-1*RL+%I0,2),%CCL D CL0 W " ",$TR($TR($$HBR^%L1FRM(A,WD(CWND)-LCOD-2)_" ",%TES1,%TES2),%TEN,%THB) Q Q CLN(WND,FL) ; Q N %I D CL0 X %XCL F %I=1:1:RL D POS(WND,%I) D .I FL,$D(@GL@(SH1(TF)+((WND-1)*RL)+%I-1)) W %LIGHT1_$J(%I,2)_%CCL Q .;;W " " Q POS(TF,SH) ; S %XX=X1(TF),%YY=Y1-1+SH X %POSIC Q POS1(WND,SCH) ; I '%ENGLISH S %XX=X1(WND)+WD(WND)-2,%YY=Y1-1+SCH X %POSIC S $X=%XX,$Y=%YY Q I %ENGLISH S %XX=X1(WND),%YY=Y1-1+SCH X %POSIC S $X=%XX,$Y=%YY Q Q CLBAR(WND,SCH) ;;N %TO,%I S %L1GET="" K %INV S %LS=WD(WND) D PC(TF,WND,SCH) ; Q D POS1(WND,SCH) ;;S %SAY=$J("",7)_"++"_%YY_",45,HH++BB,WF" X %XMSG ;;D POS1(WND,SCH) D CL0 X %XCL D POS1(WND,SCH) S %L1NMB("NO")="" D ^%L1ZMS K %L1GET Q COD(TF,SH1) ; N A,I S A=$G(@GL@(SH1)) N COD S COD=$$SPA^%L1FRM($E(A,$L(A)-LCOD+1,255)) S:COD="" COD=" " Q COD ; SAYN ; Q SAYV ; D CL1 X %XCL N %AT S %AT=$$^%L1HEAD("") I $L(%AT) S %SAY=%AT_"++0,"_(80-(80-$L(%AT)\2))_",H,I" X %XMSG X %XCL I $D(@MAC@(0))#2 D .X %LIGHT N YK S YK=2 I $G(RL)>16 S YK=1 .I '%ENGLISH S %SAY=@MAC@(0)_"++"_YK_","_(80-(80-$L(@MAC@(0))\2))_",HH++BB,YF" X %XMSG Q .I %ENGLISH S %SAY=@MAC@(0)_"++"_YK_","_(80-$L(@MAC@(0))\2)_",EE" X %XMSG Q D HZGDEV^%L2MENU D CL0 X %XCL I $D(^MSGSEND(+$$^%L1MRK("")))>9 W $C(27,91,72)_">>>" I $D(^PARSEND(+$$^%L1MRK("")))>9 S %SAY="

++0,4,EE,I" X %XMSG I $D(@$$^W4DEVI@($P)),$$NO^%L1CRDTC S %SAY="++0,6,EE,I" X %XMSG D TIME Q FIND(PAR) ; ; OUT: SHOLD,SH,TF N I,I1,N,N1 S OK=0 F I=1:1 Q:'$D(^l4menu($P,1,I)) D Q:OK .S N=$$COD(1,I) Q:N="" .D FIND1 S OK=1 Q I 'OK W *7 Q FIND1 ; ;;D VTF2(I) S SHOLD=$$GETSH(1,I),CWNDOLD=CWND,PGOLD=PG ;;S PG=1 F I1=1:1 Q:'$D(^l4menu($P,TF,I1)) I $$COD(TF,I1)=COD S SH=$$GETSH(TF,I1),PG=(I1-1\(2*RL))*2+1 Q Q GETSH(TF,I) ; S A=I-SH1(TF)+1 GETSHA I A<0 S A=A+(2*RL),SH1(TF)=SH1(TF)-(2*RL),PG=PG-2 S:PG<1 PG=1 G GETSHA I SH1(TF)<0 S SH1(TF)=1 I A>(2*RL) S A=A-(2*RL),SH1(TF)=SH1(TF)+(2*RL),PG=PG+2 G GETSHA S CWND=1 I A>RL S A=A-RL,CWND=2 Q A ; SAVE ; I %TYPCRT="PC" D GET^%VIDEO("p1hztf",0,0,79,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;;;;3$v" Q REST ; I %TYPCRT="PC" D PUT^%VIDEO("p1hztf",0,0,79,24,2) Q I $E(%TYPCRT,1,3)="VT5" W $C(27,91),";;;;3;;;$v" Q D VIEW Q VIEW D CL1 X %chista I %TYPCRT="PC" D ^%L1CH D HZG(TF) D SAYN ;--- SHURA TAHTONA D SAYV ;--- SHURA ELYONA D CL1 X %XCL Q SIDKVZ ; N N,I S N=0,I=0 F S N=$O(@MAC@(N)) Q:N="" S I=I+1 D .N A S A=$G(@MAC@(N)) .I '%ENGLISH S ^l4menu($P,1,I)=$$HBR^%L1FRM(A,WD(CWND)-LCOD-1) .I %ENGLISH S ^l4menu($P,1,I)=$E(A,1,WD(CWND)-LCOD-2) S %L4MAX=I Q TIME ; N %M,%L,%I,%NP S %TIM=$ZD($H,"24:60") W *27,7 S %SAY=" "_$$^%L1DC($H,1)_" "_%TIM_" ++0,59,E" X %XMSG W *27,8 S %L2MT=$P($H,",",2)\60 Q KAV(%KOT,%DL) N KAV S KAV="" I %TYPCRT["VT" S KAV=$C(27)_"(0" D CL0 S KAV=KAV_$TR($J("",%DL-$L(%KOT)\2+1)," ",$S(%TYPCRT["VT":$C(113),1:$C(196))) ;"-" I %TYPCRT["VT" S KAV=KAV_$C(27)_"(B" S KAV=KAV_%LIGHT1_%CV("YF")_%KOT_%CCL I %TYPCRT["VT" S KAV=KAV_$C(27)_"(0" S KAV=KAV_$TR($J("",%DL-$L(%KOT)\2-1)," ",$S(%TYPCRT["VT":$C(113),1:$C(196))) ;"-" I %TYPCRT["VT" S KAV=KAV_$C(27)_"(B" Q KAV %L4NH %L4NH ;HELP %L4NU ;INPUT PARAMETERS: NAME GLOBAL WITH INDEX (MAC) ; L4("EU") - ; = 98 ; L4("TX",%UROV)- TEXT IN BEG LINE( ---------- ) ; L4("T1",%UROV) - HEADER TEXT ; L4("T2",%UROV) - COMMAND FOR TYPE HEADER ; L4("CD") - SIGN TYPE CODE (NO DEF-LAST. LEVEL.; "" - IND2_...INDn.," " - NO TYPE IND.,"I" - INDEX ONLY) ; L4("SS",%UROV)-LIMIT-SIMBOL ; L4("NR",%UROV) - NUMBER POLE SS ( ---""--- - 1) ; L4("SET",%UROV) - COMMAND MUMPS FOR INIT VALUE ; L4("US0",%UROV) - ---"--- ; L4("US",%UROV) - ---"--- FOR CHOOSE MENU (%NXN - INDEX,^(%NN) - DATA ; L4("US1",%UROV) - ---"---,AFTER INPUT NUMBER IN MENU ; L4("TXT",%UROV) - COMMAND MUMPS FOR TYPE TEXT ; L4("FIRST",%UROV) - START VALUE FOR MENU ; L4("LAST",%UROV) - USL END MENU ; L4("BE",%UROV) - LINE-TOP MENU ; L4("BU",%UROV) - NUMBER START LEVEL ; L4(1) - IF 1 NOAD IN MENU -> NEXT LEVEL ; L4(",") - MUCH NUMBERS FOR CHOOSE ; L4("NOM",%UROV) - IF DEF,NO TYPE LINE'S NUMBERS ;OUTPUT - FULL REF (MAC) ; OR ARRAY INDEX %MM ; FLAG (FLAG) %L4NL L4NL ; K %STEC,%L4,KOD,INDEX,%TOP S:'$D(L4("EU")) L4("EU")=99 S:'$D(L4("BE")) L4("BE")=0 S:'($D(L4("FIRST"))#2) L4("FIRST")="" S:'($D(L4("US"))#2) L4("US")=1 K %MM S FLAG="",%UR=1,%PRZPT=0,%PRV=0,%PREND=0,INDEX="",NOMER="" S %RSTR=20,%KAV="""""",%KAV1="""" S %GLOB=MAC D FKOD S %UROV=%I-1 S %XF="S %FIRST=%KAV1_%L4(""FIRST"")_%KAV1" S %XL="S %LASTI=0 I $D(%L4(""LAST""))#2 I @%L4(""LAST"") S %LASTI=1" S %XU="X:$D(%L4(""US0""))#2 %L4(""US0"") S %USL=$S($D(%L4(""US""))#2:%L4(""US""),1:1)" G PROV CYC1 S %V=%MAC1,%V1=%MAC11,%V2=%PRS I $D(%L4("SET"))#2 X %L4("SET") S %MAC1=%V,%MAC11=%V1,%PRS=%V2 S %V=%MAC1,%V1=%MAC11,%V2=%PRS X %XU I @%USL S %K=%K+1 S %MAC1=%V,%MAC11=%V1,%PRS=%V2 D PSTR I '%PRFIN S %IND(%K)=%NXN Q PSTR ; I %SHS+2>%RSTR S %PRFIN=1 Q W !,%K,?2,";" I $D(%L4("TXT"))#2 S %VP=%MAC1,%VP1=%MAC11,%VP2=%PRS X %L4("TXT") S %SHS=%SHS+1 S %MAC1=%VP,%MAC11=%VP1,%PRS=%VP2 K %VP,%VP1,VP2 Q W ?9,$S($D(%L4("TX"))#2:%L4("TX"),1:""),$S($D(%L4("CD"))#2:$S(%L4("CD")=" ":"",%L4("CD")="":KOD_%NXN,1:%NXN),1:%NXN) I $D(%L4("CD")),%L4("CD")="" S %SHS=%SHS+1 Q I '($D(@%MAC1)#2) W ?10," <",%NXN,"> " S %SHS=%SHS+1 Q S %CHAST=$S($D(%L4("SS"))#2:$P(@%MAC1,%L4("SS"),$S($D(%L4("NR"))#2:%L4("NR"),1:1)),1:@%MAC1) S %LASTP=60-$L(%MAC11)-$L(%NXN) W ?20," ",$E(%CHAST,1,%LASTP) S %SHS=%SHS+1 F I=1:1 Q:$L(%CHAST)<%LASTP W !?19,$E(%CHAST,%LASTP+1,%LASTP+60) S %LASTP=%LASTP+60,%SHS=%SHS+1 K %CHAST Q ;____ PRV S %PRV=1 U $P:(NOECHO:NOWRAP) PROV ; I $D(@MAC)=0 W !,"*** HASN'T DATA !" S FLAG="ND" H 2 G END1 S FLAG="" S %MAC1=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_",",1:MAC_"(") S %PRS=$F(%MAC1,",") BEGP ; S %INUR=%UROV+(%PRS>0) F %I=1:1 Q:$P($T(PAR+1),",",%I)="" S PAR=$P($T(PAR+1)," ",2),%L4I=$P(PAR,",",%I) I $D(L4(%L4I))>0 S %L4(%L4I)=$S($D(L4(%L4I,%INUR)):L4(%L4I,%INUR),1:L4(%L4I)) X %XF S %MAC1=%MAC1_%FIRST_")" S %K=0,%TOP(%UR)=1,%STEC(%UR,%TOP(%UR))=%MAC1_"!"_"0" CYC S %PRS=$F(%MAC1,","),%RSTR=20-%L4("BE") S %XX=0,%YY=%L4("BE") X %POSIC W # S %SHS=0 I %PRS S %MAC11=$P(%MAC1,",",1,%UROV) I '%PRS S %MAC11=MAC_"(" W ?10,$S($D(%L4("T1"))#2:%L4("T1"),1:""),!,%chists S %SHS=%SHS+1 S %V=%MAC1,%V1=%MAC11,%V2=%PRS I $D(%L4("T2"))#2 X %L4("T2") S %SHS=%SHS+1 S %MAC1=%V,%MAC11=%V1,%PRS=%V2 K %V,%V1,%V2 S %PRFIN=0 S %NXN=$O(@%MAC1) K %IND S %MAC1=%MAC11_$S(%PRS:",",1:"")_"%NXN)" F %I=1:1 Q:%NXN="" X %XL Q:%LASTI D CYC1 Q:%PRFIN S %NXN=$O(@%MAC1) I %K=0 W !," *** LAST LEVEL !" G:L4("EU")=98 END H 2 G VVERX^%L4NL2 I %K=1,$D(L4(1)),L4("EU")'=(%UROV+(%PRS'=0)) G:%PRV VVERX^%L4NL2 S %NOM=1 G NOM S %PRV=0 I %PRFIN W !?30," *** ""-->""" S %LAST=$S($D(%IND(%K-%PRFIN)):%IND(%K-%PRFIN),1:"") ZN I $D(L4("PR")) G ZNP K %P X %chiste R !," (? - ) > ",*%SIMB I %SIMB=0 D ^%S1CALC G CYC G SERV^%L4NL2:%SIMB=27,AVAR^%L4NL2:%SIMB=13&'%PRZPT,END1:%SIMB=13&%PRZPT W $C(%SIMB) S %SIMB=$C(%SIMB) G INSTR^%L4NL2:%SIMB="?" NOMER ; S %NOM=%SIMB,%PREND=0 G:%PRZPT ZNZ^%L4NL2 VVOD R *%SIMB I %SIMB>31 W $C(%SIMB) I $C(%SIMB)?1N S %NOM=%NOM_$C(%SIMB) S:$L(%NOM)>3 %SIMB=8 G:$L(%NOM)>3 VVOD+1 G VVOD I %SIMB=8 G:$L(%NOM)=0 VVOD S:$L(%NOM)=1 %NOM="" S:$L(%NOM)>1 %NOM=$E(%NOM,1,$L(%NOM)-1) W %levo G VVOD I %SIMB'=13&(%SIMB'=46)&(%SIMB'=44) S %NOM=%NOM_$C(%SIMB) S %SIMB=8 G VVOD+1 I %SIMB=46 S %PREND=1 I %SIMB=44,%UROV+(%PRS'=0)=L4("EU") S %PRZPT=1,%NOM=%NOM_"," G ZNZ^%L4NL2 I %NOM="" G AVAR^%L4NL2 I %NOM="." S FLAG="." S MAC=$S($P(%MAC11,"(",2)'="":%MAC11_")",1:MAC) G END1 NOM I '$D(%IND(%NOM)) W *7,?63,"*** !!" X PEREX G ZN S %UR=%UR+1 S:%PRS %UROV=%UROV+1 S:%UROV=L4("EU") %PREND=1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%IND(%NOM)_"""," S %PRS=1 X %XF S %MAC1=%MAC1_%FIRST_")" S KOD=KOD_%IND(%NOM),INDEX=%IND(%NOM) G:'%PREND BEGP END S MAC=$P(%MAC1,",",1,%UROV)_")" I $E(NOMER,$L(NOMER))="," S NOMER=$E(NOMER,1,$L(NOMER)-1) S %UR=%UR+1 S:%PRS %UROV=%UROV+1 S:%UROV'1 INDEX=%KOD Q PAR ; T1,T2,TXT,FIRST,LAST,BU,TX,SS,NR,US,US0,CD,BE,SET Q %L4NL2 %L4NL2 ; AVAR ; R !," EXIT ? (Y/N) ",%YES I %YES="D"!(%YES="Y")!(%YES="") S FLAG="AB" G END1^%L4NL G:%YES="N" ZN^%L4NL G AVAR INSTR W !!,ZWEZD,! W !,"-> " W !,"<- " W !,"^",!,"! " W !,"- ",!,ZWEZD,! R !?40," ",YES S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC^%L4NL SERV R *%P1:0,*%P:0 I %P>0 G LEVO:%P=%LEVO,PRAVO:%P=%PRAVO,VVERX:%P=%VVERX W *7,?63,"*** ERROR !" X PEREX G ZN^%L4NL LEVO ; I %TOP(%UR)=1 W *7,?43,"*** BEGIN OF LEVEL!" X PEREX G ZN^%L4NL K %STEC(%UR,%TOP(%UR)) S %TOP(%UR)=%TOP(%UR)-1,%MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC^%L4NL PRAVO ; I %NXN="" W *7,?33,"*** END OF LEVEL !" X PEREX G ZN^%L4NL X %chiste S %TOP(%UR)=%TOP(%UR)+1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%LAST_""")" S %STEC(%UR,%TOP(%UR))=%MAC1_"!"_(%K-1) S %K=%K-1 G CYC^%L4NL VVERX ; I '$D(L4("BU")),%UR=1 S FLAG="^" G END1^%L4NL S %PRZPT=0 S %GLOB=%MAC1 D FKOD^%L4NL S %UROV=%I-1 I %UROV=1 S FLAG="^" G END1^%L4NL I $D(L4("BU")) I %UROV-1=L4("BU") S FLAG="^" G END1^%L4NL K %STEC(%UR) S %UR=%UR-1,%UROV=%UROV-2 S:%UROV=0 MAC=$P(MAC,"(",1),%PRS=0,KOD="" S %GLOB=$P(%MAC1,",",1,%UROV) D FKOD^%L4NL S %K=0 S:'%PRS %UROV=1 S:%PRS MAC=%GLOB_")" G PRV^%L4NL Q ZNP K %P X %chiste G:'%PRFIN&(%TOP(%UR)=1) END1^%L4NL R !!?15,"NEXT SCREEN.- '-->',PREVIOS SCREEN - '<--', EXIT - ",*%SIMB G SERV:%SIMB=27,END1^%L4NL:%SIMB=13 W *7 X PEREX G ZNP ZNZ R %S S %S=%NOM_%S I '$D(NOMER) S NOMER="" S %FLE=0 F %JJ=1:1 S %NOM=$P(%S,",",%JJ) Q:%NOM="" I '$D(%IND(%NOM)) W !,%NOM," - !" S %FLE=1 G:%FLE ZN^%L4NL S %JE=%JJ-1 S %PREND=1 F %JJ=1:1:%JE S %NOM=$P(%S,",",%JJ),%MM(%IND(%NOM))=%MAC11_$S(%PRS:",""",1:"""")_%IND(%NOM)_""")" S NOMER=NOMER_%IND(%NOM)_"," G ZN^%L4NL %L4NU %L4NU ; [ 08.08.01 5:33 PM ] [ 06/15/98 11:34 AM ] [ 06/13/98 9:30 AM ] K %STEC,%L4,KOD,INDEX,%TOP,NOMER,%PRTCH,%ORD S:'$D(L4("EU")) L4("EU")=99 S %ORD=1 I $G(%S3G)<0 S %ORD=-1 S:'$D(L4("BE")) L4("BE")=0 S:'($D(L4("FIRST"))#2) L4("FIRST")="" S:'($D(L4("US"))#2) L4("US")=1 K %MM S FLAG="",%UR=1,%PRZPT=0,%PRV=0,%PREND=0,INDEX="",NOMER="" S %VETKA=$P(MAC,"""",2),%RSTR=20,%KAV="""""",%KAV1="""" S %GLOB=MAC D FKOD S %UROV=%I-1 S %XF="S %FIRST=%KAV1_%L4(""FIRST"")_%KAV1" S %XL="S %LASTI=0 I $D(%L4(""LAST""))#2 I @%L4(""LAST"") S %LASTI=1" S %XU="X:$D(%L4(""US0""))#2 %L4(""US0"") S %USL=$S($D(%L4(""US""))#2:%L4(""US""),1:1)" G PROV CYC1 S %V=%MAC1,%SS="" S:$D(^(%NXN))#2 %SS=^(%NXN) I $D(%L4("SET"))#2 X %L4("SET") S %V=$O(@%V) S %V=%MAC1 X %XU I @%USL S %V=$O(@%V) S %K=%K+1 D PSTR I '%PRFIN S %IND(%K)=%NXN I $E(%V,1,2)?1"^"1U S %V=$O(@%V) S %V=%MAC1 Q PSTR ; I %SHS+2>%RSTR S %PRFIN=1 Q W !?3 I '$D(L4("PR")),'$D(%L4("NOM")) W %K,?5,";" I $D(%L4("TXT"))#2 S %V=%MAC1 X %L4("TXT") S %V=$O(@%V) S %SHS=%SHS+1 Q S %KODL4=$S($D(%L4("TX"))#2:%L4("TX"),1:"")_$S($D(%L4("CD"))#2:$S(%L4("CD")=" ":"",%L4("CD")="":KOD_%NXN,1:%NXN),1:%NXN) I '($D(^(%NXN))#2) W ?10," <",%NXN,"> " S %SHS=%SHS+1 Q S %CHAST=$S($D(%L4("SS"))#2:$P(^(%NXN),%L4("SS"),$S($D(%L4("NR"))#2:%L4("NR"),1:1)),1:^(%NXN)) W ?9,%KODL4 ; X %XCL S $X=$L(%KODL4)+9 I $D(%L4("CD")),%L4("CD")="I" S %SHS=%SHS+1 Q S %LASTP=69-$L(%KODL4) W " ",$E(%CHAST,1,%LASTP) S %SHS=%SHS+1 F %II=1:1 S %CHASTL4=$E(%CHAST,%LASTP*%II+1,%LASTP*(%II+1)) Q:%CHASTL4="" W !?$L(%KODL4)+9," ",%CHASTL4 S %SHS=%SHS+1 K %CHAST,%KODL4,%CHASTL4 Q ;___ PRV S %PRV=1 PROV U $P:(NOECHO:NOWRAP:NOESC) I $D(@MAC)=0 W:'$D(L4("ND")) !!,"*** HASN'T DESCENDANTS !" S FLAG="ND" H 2 G END1 S FLAG="" S %MAC1=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_",",1:MAC_"(") S %PRS=$F(%MAC1,",") BEGP ; S %INUR=%UROV+(%PRS>0) F %I=1:1 Q:$P($T(PAR+1),",",%I)="" S PAR=$P($T(PAR+1)," ;",2),%L4I=$P(PAR,",",%I) I $D(L4(%L4I))>0 S %L4(%L4I)=$S($D(L4(%L4I,%INUR)):L4(%L4I,%INUR),1:L4(%L4I)) X %XF S %MAC1=%MAC1_%FIRST_")" S %K=0,%TOP(%UR)=1,%STEC(%UR,%TOP(%UR))=%MAC1_"!"_"0" CYC S %PRS=$F(%MAC1,","),%RSTR=20-%L4("BE") S %XX=0,%YY=%L4("BE") X %POSIC X %chiste S %SHS=0 I %PRS S %MAC11=$P(%MAC1,",",1,%UROV) I '%PRS S %MAC11=MAC_"(" W ?10,$S($D(%L4("T1"))#2:%L4("T1"),1:""),!,%chists S %SHS=%SHS+1 I $D(%L4("T2"))#2 X %L4("T2") S %SHS=%SHS+1 X %XCL S %PRFIN=0 S %NXN=$O(@%MAC1,%ORD) K %IND F %I=1:1 Q:%NXN="" X %XL Q:%LASTI D CYC1 Q:%PRFIN S %NXN=$O(^(%NXN),%ORD) I %K=0 W:L4("EU")'=98 !," *** LAST LEVEL !" X %XCL G:L4("EU")=98 END H 2 G:%UR>1 VVERX S FLAG="ND" G END1 I %K=1,$D(L4(1)),L4("EU")'=%INUR G:%PRV VVERX S %NOM=1 G NOM S %PRV=0 I %PRFIN W !?30," *** LOOK AT ""-->""" X %XCL S %LAST=$S($D(%IND(%K-%PRFIN)):%IND(%K-%PRFIN),1:"") G ZN END S MAC=$P(%MAC1,",",1,%UROV)_")" END01 I $E(NOMER,$L(NOMER))="," S NOMER=$E(NOMER,1,$L(NOMER)-1) END1 ;;S %CL0=44 X %XCL U $P:(ECHO:WRAP) K %GLOB,%L4I,%MAC1,%L4,%MACF,%K,%KOD,%I,%J,%IND,%NXN,%SIMB K %YES,%NOM,%SIMB,%SUB,%XF,%XL,%XU,%FIRST,%GLOB,%LASTI,%USL K %LAB,%LAST,%LASTP,%MAC11,%PRFIN,%PRS,%RSTR,%SHS,%VETKA,%KAV,%KAV1,%MACN Q ;* FKOD ; S KOD="" S KOD1=$P($P(%GLOB,"(",2),")") S:$E(KOD1)="""" KOD1=$P(KOD1,"""",2) F %I=2:1 Q:$P(%GLOB,",",%I)="" S %KOD=$P(%GLOB,",",%I) S:%KOD["""" %KOD=$P(%KOD,"""",2) S KOD=KOD_%KOD S:%UR>1 INDEX=%KOD I $E(KOD,$L(KOD))=")" S KOD=$E(KOD,1,$L(KOD)-1) S KOD1=KOD1_KOD Q PAR ; ;T1,T2,TXT,FIRST,LAST,BU,TX,SS,NR,US,US0,US1,CD,BE,SET,NOM Q %L4NU4 ; ZN I $D(L4("PR")) G ZNP K %P S %XX=0,%YY=22 X %POSIC,%chiste W " NUMBER (? - HELP > " X %XCL W %chists R *%SIMB X %XCL I $D(%UPRCOD($ZB)),$T(@%UPRCOD($ZB))'="" G @%UPRCOD($ZB) I %SIMB>31,%SIMB<192 W $C(%SIMB) X %XCL I %UROV+(%PRS'=0)=L4("EU"),$D(L4(",")) S %PRZPT=1 ;;I %SIMB=0 D ^%S1CALC S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC G SERV:%SIMB=27!'%SIMB,AVAR^%L4NU3:%SIMB=13&('%PRZPT!(NOMER="")),END1:%SIMB=13&%PRZPT S %SIMB=$C(%SIMB) G INSTR^%L4NU3:%SIMB="?" NOMER ; S %NOM=%SIMB,%PREND=0 VVOD R *%SIMB G:%SIMB=27!(%SIMB>191) VVOD I %SIMB>31 W $C(%SIMB) X %XCL I $C(%SIMB)?1N S %NOM=%NOM_$C(%SIMB) I '%PRZPT S:$L(%NOM)>3 %SIMB=8 G:$L(%NOM)>3 VVOD+1 I $C(%SIMB)?1N G VVOD I %SIMB=8 G:$L(%NOM)=0 VVOD S:$L(%NOM)=1 %NOM="" S:$L(%NOM)>1 %NOM=$E(%NOM,1,$L(%NOM)-1) W %levo," ",%levo G VVOD I '$D(%L4("NOM")),%SIMB'=13&(%SIMB'=46)&(%SIMB'=44)&(%SIMB'=45)!((%SIMB=44!(%SIMB=45))&'%PRZPT) S %NOM=%NOM_$C(%SIMB) S %SIMB=8 G VVOD+1 I %SIMB=46 S %PREND=1,%PRTCH="" I %SIMB=44,%PRZPT S %NOM=%NOM_"," G VVOD I %SIMB=45,%PRZPT S %NOM=%NOM_"-" G VVOD I %NOM="",NOMER="" G AVAR^%L4NU3 I %PRZPT G ZNZ I %NOM="." S FLAG="." S MAC=$S($P(%MAC11,"(",2)'="":%MAC11_")",1:MAC) G END1 NOM I '$D(%L4("NOM")),'$D(%IND(+%NOM)) W *7,?63,"*** ERROR !!" X PEREX G ZN I $D(%L4("NOM")),'$D(^(%NOM)) W *7,?63,"*** ERROR !!" X PEREX G ZN NOM1 S %UR=%UR+1 S:%PRS %UROV=%UROV+1 S:%UROV'',PREVIOS - '<--', EXIT - ",*%SIMB X %XCL G SERV:%SIMB=27,END1:%SIMB=13 W *7 X PEREX G ZNP ZNZ ; S %S=%NOM,%FLE=0 I %S["-" F %JJ=1:1 S %NOM=$P(%S,",",%JJ) Q:%NOM="" D DO1 G EN1 DO1 ; I %NOM?1"-"1N.N S %NOM=$E(%NOM,2,10) K:$D(@%NOMMENU) %MM(@%NOMMENU) S %S=$P(%S,",",1,%JJ-1)_$P(%S,",",%JJ+1,255) K %NOM Q I %NOM?1"-"1N.N1"-"1N.N S %NOM1=$P(%NOM,"-",2),%NOM2=$P(%NOM,"-",3) F %NOM=%NOM1:1:%NOM2 K:$D(@%NOMMENU) %MM(@%NOMMENU) S %S=$P(%S,",",1,%JJ-1)_$P(%S,",",%JJ+1,255) I K %NOM,%NOM1,%NOM2 Q I %NOM?1N.N1"-"1N.N S %NOM1=$P(%NOM,"-",1),%NOM2=$P(%NOM,"-",2) S %NOM="" F %JJ2=%NOM1:1:%NOM2 S:$D(^(%JJ2)) %NOM=%NOM_%JJ2_"," I S $P(%S,",",%JJ)=$E(%NOM,1,$L(%NOM)-1) K %NOM,%NOM1,%NOM2,%JJ1,%JJ2 Q EN1 ; S %FLE=0 F %JJ=1:1 S %NOM=$P(%S,",",%JJ) Q:%NOM="" I '$D(@%NOMMENU) W !,%NOM," - !" S %FLE=1 G:%FLE ZN S %JE=%JJ-1 S %PREND=1 F %JJ=1:1:%JE S %NOM=$P(%S,",",%JJ),%MM(@%NOMMENU)=%MAC11_$S(%PRS:",""",1:"""")_@%NOMMENU_""")",NOMER=NOMER_$S(NOMER'="":",",1:"")_@%NOMMENU S %NOM1="" F %JJ=1:1:$L(NOMER,",") S %JJ1=$P(NOMER,",",%JJ) I %JJ1'="",$D(%MM(%JJ1)) S %NOM1=%NOM1_%JJ1_"," S NOMER=$E(%NOM1,1,$L(%NOM1)-1) I %L4("US")=1 S %SAY=" *** "_NOMER X %soob G ZN SERV R *%P1:0,*%P:0 G LEVO:%P=%LEVO,PRAVO:%P=%PRAVO,VVERX:%P=%VVERX W *7,?63,"*** ERROR !" X PEREX G ZN LEVO ; I %TOP(%UR)=1 W *7,?43,"*** BEGIN OF LEVEL!" H 2 X PEREX,%XCL G ZN K %STEC(%UR,%TOP(%UR)) S %TOP(%UR)=%TOP(%UR)-1,%MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC PRAVO ; I %NXN=""!%LASTI W *7,?33,"*** END OF LEVEL !" H 2 X PEREX,%XCL G ZN X %chiste S %TOP(%UR)=%TOP(%UR)+1 S %MAC1=%MAC11_$S(%PRS:",""",1:"""")_%LAST_""")" S %STEC(%UR,%TOP(%UR))=%MAC1_"!"_(%K-1) S %K=%K-1 G CYC VVERX ; N A R *A:0 I '$D(L4("BU")),%UR=1 S FLAG="^" G END01 S %PRZPT=0 S %GLOB=%MAC1 D FKOD S %UROV=%I-1 I %UROV=1 S FLAG="^" G END1 I $D(L4("BU")) I %UROV-1=L4("BU") S FLAG="^" G END1 K %STEC(%UR) S %UR=%UR-1,%UROV=%UROV-1 I %UROV>1 S %UROV=%UROV-1 S %MAC1=$P(%STEC(%UR,%TOP(%UR)),"!",1) S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) G CYC Q %L4NU3 %L4NU3 ; [ 06/13/98 12:09 PM ] [ 12/16/92 3:21 PM ] AVAR ; R !," END OF SEARCH ? (Y/N) ",%YES I %YES="D"!(%YES="Y")!(%YES="") S FLAG="AB" X %XCL G END1^%L4NU X %XCL G:%YES="N" ZN^%L4NU G AVAR INSTR W !!,ZWEZD,!,"ENTER MENU NUMBER (AND DOT <.> AFTER NUMBER IN YOU WANT TO TERMINATE SEARCH)" W !,"-> NEXT SCREEN " W !,"<- PREVIOUS SCREEN " W !,"^",!,"| GO TO PREVIOUS LEVEL " W !,"- EMERGENCY EXIT",!,ZWEZD,! R !?40,"PRESS ",YES S %K=$P(%STEC(%UR,%TOP(%UR)),"!",2) X %XCL G CYC^%L4NU Q %L4SP %L4SP ;DJM;DISPLAY AVAILABLE SPACE; [ 08/15/2000 5:00 PM ] [ 05/25/93 10:25 AM ] ;Copyright Micronetics Design Corp. @1984 ;;W !?10,$P($P($ZV,","),"-")," - ","Disk Space/Free Space Utility",!?16,$ZHL(1,"dd-MON-yy")," ",$ZHL(2,"bh:mm P") O 63::0 I '$T W !,"VIEW buffer busy." Q NEW D GETVG^%VGUTIL S %NOSHOW=0 I VG=1 S %VGI=0 D DISPVG G EXIT D SPACE EXIT ; C 63 Q SPACE ;DISPLAY MOUNTED DATABASES R !!,"Select volume group to display : ",%VGNA I %VGNA="^L" W ! D VGLIST^%VGUTIL G SPACE I %VGNA="?" W !!,"Enter the name or number of the volume group to be displayed.",!,"Enter to display all volume groups.",!,"Enter '^L' for a list of mounted volume groups.",!,"Enter '^' or '^Q' to exit" G SPACE Q:%VGNA="^" I %VGNA="" G MNTVG I %VGNA'?3U&%VGNA'?1.N W "... Invalid volume group name." G SPACE I '$D(VG(%VGNA)) W "... not a mounted volume group." G SPACE S:%VGNA?3U %VGI=VG(%VGNA) S:%VGNA?1.N %VGI=%VGNA,%VGNA=VG(%VGI) D DISPVG Q MNTVG ;DISPLAY ALL MOUNTED VOLUME GROUPS D GETVG^%VGUTIL S %VGI=0,%NOSHOW=0 MNTVG1 ; D DISPVG S %VGI=$O(VG(%VGI)) Q:%VGI'?1.N D PAUSE Q:%FLAG G MNTVG1 DBMAINT(%VGI) ; O 63 S %NOSHOW=0 D DISPVG Q PAUSE ; S %FLAG=0 W !,"<>" R %I S:%I="." %FLAG=1 Q DISPVG ;DISPLAY ONE VOLUME GROUP D VGINFO^%VGUTIL2(%VGI),OS Q:'VGINAME D ^%L1C S %TOTBLK=0,%FTOTBLK=0 I %ENGLISH D .W !!?5,"Volume Group: ",VGNAME .W " Index: ",%VGI .I VGRVG W " (Remote on ",VGCIRN,")" .E W:VGRESBLK " DKRES reserved blocks: ",VGRESBLK .W !!?5,"Vol",?12,"Maps",?20,"Tot Blks",?30,"Free Spc",?43,"%-Free",?53,$S(%OS:"Host File Name",1:"Disk Address") I '%ENGLISH D .W %HBR .W !!?5,VGNAME," : dveaw " .W %VGI," : qwcpi` " .W !!?5,"dveaw",?12,"dtn",?20," k""dq",?30," iept",?43,"%-iept",?53,$S(%OS:"mipezp qiqa",1:"zaezk") .W %ENG W !?5,"---",?12,"----",?20,"--------",?30,"--------",?43,"------",?53,"--------------" D INT W:VGVOLS>1 !,?20,"========",?30,"========",?43,"======",!,?20,$J(%TOTBLK,8,0),?30,$J(%FTOTBLK,8,0),?43,$J(%FTOTBLK*100/$S(%TOTBLK:%TOTBLK,1:1),6,2) K %DB,%SZ,%SP,%I,%J,%TOTBLK,%FTOTBLK Q INT N (%FTOTBLK,%TOTBLK,%VGI,%NOSHOW,VGVOLS) I '$D(%NOSHOW) S %NOSHOW=1 O 63 S (%TOTBLK,%FTOTBLK)=0 I '$D(%VGI) S %VGI=0 D VGINFO^%VGUTIL2(%VGI),OS S %SPFBLK=0 F %DB=0:1:VGVOLS-1 D DBDISP S %SPFBLK=%SPFBLK+VOLBLKS Q INT1 ; N (%DB,%SP,%SZ,%VGI,VGVOL) S (%TOTBLK,%FTOTBLK)=0,%NOSHOW=1,%SPFBLK=$P(VGVOL(%DB),"^",2) D OS,DBDISP Q DBDISP ; D VOLINFO^%VGUTIL2(%VGI,%DB) D DBDISP1 I '%NOSHOW W !?5,$J(%DB,2,0),?11,$J(VOLMAPS,4,0),?20,$J(%SZ,8,0),?30,$J(%SP,8,0),?43,$J(%SP*100/$S(%SZ:%SZ,1:1),6,2),?53,VOLDBNA S %TOTBLK=%TOTBLK+%SZ,%FTOTBLK=%FTOTBLK+%SP Q DBDISP1 ;GET TOTAL BLOCKS & TOTAL FREE BLOCKS S %SP=0,%SZ=VOLDBSZ F %K=0:1:VOLMAPS-1 V %K*512+%SPFBLK+1:"G"_%VGI S %SP=%SP+$S($V(1022,0,2)>511:0,1:$V(1022,0,2)) Q OS S %OS=$V(0,-4,2)#16 Q %L4SSD SSD ;CDS;SYSTEM SHUTDOWN; [ 12/03/98 3:03 PM ] [ 09/21/93 11:44 AM ] H %L4VLD %L4VLD ; [ 21.12.01 10:35 AM ] [ 10/21/99 7:29 PM ] [ 10/04/2000 5:22 PM ] Q %L5K %L5K ; [ 23.11.06 18:22 ] [ 29.05.03 11:38 ] [ 05/03/98 7:25 PM ] W # N Y,YES D ^%L1C W !?20,"UCI: ",$$^%L1ZU(0),! W !," KILL GLOBALS "_%CLI_" ^SCR,^SHP,^TABLs,^rep "_%CCL_" ? (Y/N) " R Y S YES=(Y="Y"!(Y="y")!(Y="F")!(Y="k")) W " - ",$S(YES:"YES",1:"NO") Q:'YES K ^SCR,^SHP,^TABLs,^rep D ^%L1GI Q %L5MENU %L5MENU ; [ 11.12.06 23:28 ] [ N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,MAC,@MAC) D ^%L1C S %N="",%I=0 F S %N=$O(@MAC@(%N)) Q:%N="" S %I=%I+1 X %chista S %LN=14,%COLM=%I S %CVB=%CV("CB") S %CVFR=%LIGHT1_%CV("BF") S %CVF=%LIGHT1_%CV("YF") ; I %COLM<5 S %Y1=8 I %COLM>4,%COLM<9 S %Y1=5 I %COLM>8,%COLM<13 S %Y1=3 I %COLM>12,%COLM<17 S %Y1=3 I %COLM>16 S %Y1=2 ; I %COLM=1 D COLM1(1) ; I %COLM=2 D COLM2(1) ; I %COLM=3 D COLM3(1) ; I %COLM=4 D COLM4(1) ; I %COLM=5 D COLM4(1) S %Y1=%Y1+5 D COLM1(5) ; I %COLM=6 D COLM4(1) S %Y1=%Y1+5 D COLM2(5) ; I %COLM=7 D COLM4(1) S %Y1=%Y1+5 D COLM3(5) ; I %COLM=8 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) ; I %COLM=9 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM1(9) ; I %COLM=10 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM2(9) ; I %COLM=11 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM3(9) ; I %COLM=12 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) ; I %COLM=13 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM1(13) ; I %COLM=14 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM2(13) ; I %COLM=15 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM3(13) ; I %COLM=16 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM4(13) ; I %COLM=17 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM4(13) S %Y1=%Y1+5 D COLM1(17) ; I %COLM=18 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM4(13) S %Y1=%Y1+5 D COLM2(17) ; I %COLM=19 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM4(13) S %Y1=%Y1+5 D COLM3(17) ; I %COLM=20 D COLM20 ; Q COLM1(IND) ; S %L1RBUA("DOUBLE")="" S %L1RBCL=%CVB S %X1=80-%LN\2 S %X2=%X1+%LN+1,%Y2=%Y1+3 D VRB(@MAC@(IND)) Q COLM2(IND) ; S %L1RBUA("DOUBLE")="" S %L1RBCL=%CVB S %X1=80-(3*%LN)\2 S %X2=%X1+%LN+1,%Y2=%Y1+3 D VRB(@MAC@(IND)) S %X1=%X2+%LN S %X2=%X1+%LN+1 D VRB(@MAC@(IND+1)) Q COLM3(IND) ; S %L1RBUA("DOUBLE")="" S %L1RBCL=%CVB S %X1=80-(4*%LN)\2 S %X2=%X1+%LN+1,%Y2=%Y1+3 D VRB(@MAC@(IND)) S %X1=%X2+(%LN\2) S %X2=%X1+%LN+1 D VRB(@MAC@(IND+1)) S %X1=%X2+(%LN\2) S %X2=%X1+%LN+1 D VRB(@MAC@(IND+2)) Q ; COLM4(IND) ; S %L1RBUA("DOUBLE")="" S %L1RBCL=%CVB S %X1=80-(5*%LN)\2-1 S %X2=%X1+%LN+1,%Y2=%Y1+3 D VRB(@MAC@(IND)) S %X1=%X2+(%LN\3) S %X2=%X1+%LN+1 D VRB(@MAC@(IND+1)) S %X1=%X2+(%LN\3) S %X2=%X1+%LN+1 D VRB(@MAC@(IND+2)) S %X1=%X2+(%LN\3) S %X2=%X1+%LN+1 D VRB(@MAC@(IND+3)) Q COLM20 D COLM4(1) S %Y1=%Y1+5 D COLM4(5) S %Y1=%Y1+5 D COLM4(9) S %Y1=%Y1+5 D COLM4(13) S %Y1=%Y1+5 D COLM4(17) Q TXT(%FRAZA,X1,Y1,X2,Y2,%DLG) ; D DELG^%L1SCPC W %CVB,%CVF S %XX=X1,%YY=Y1 X %POSIC W $J($$CENTR^%L1FRM($$SPA^%L1FRM(%CHAST(1,1)),%LN),%LN) I $D(%CHAST(1,2)) D .S %XX=X1,%YY=Y1+1 X %POSIC .W $J($$CENTR^%L1FRM($$SPA^%L1FRM(%CHAST(1,2)),%LN),%LN) Q VRB(TXT) ; W %CVFR D TV^%L1RBUA(%Y1,%X1,%Y2,%X2) D TXT(TXT,%X1,%Y1,%X2,%Y2,%LN) Q %RD ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; Copyright 1987, 2003 Sanchez Computer Associates, Inc. ; ; ; ; This source code contains the intellectual property ; ; of its copyright holder(s), and is made available ; ; under a license. If you do not know the terms of ; ; the license, please stop and do not read further. ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; %RD ;GT.M %RD utility - routines directory ;invoke ^%RD for an interactive routine directory ;invoke OBJ^%RSEL for an interactive directory based on object modules ; SRC n %ZE,%ZR s %ZE=".m" d RD^%RSEL q OBJ n %ZE,%ZR s %ZE=$s($zver["VMS":".obj",1:".o") d RD^%RSEL q LIB n %ZE,%ZR s %ZE=".m",%ZR="%*" d RD^%RSEL q %RSEL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; Copyright (c) 1987, 2015 Fidelity National Information ; ; Services, Inc. and/or its subsidiaries. All rights reserved. ; ; ; ; This source code contains the intellectual property ; ; of its copyright holder(s), and is made available ; ; under a license. If you do not know the terms of ; ; the license, please stop and do not read further. ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; %RSEL ;service@greystone.com gtm,%rsel;19920523;GT.M %RSEL utility - routine select into a local array ;invoke ^%RSEL to create %ZR - a local array of existing routines, interactively ;invoke OBJ^%RSEL to create %ZR based on object modules ;invoke CALL^%RSEL to maintain the array %ZR with the input %ZR, %ZE specifies extensions .m or .o[bj] ; SRC n $et s $et=$s($d(%zdebug):"b",1:"zg "_$zl_":err^%RSEL") n add,beg,cnt,ctrap,d,delim,end,exc,from,i,k,last,mtch,pct,r,rd,rdf,out,scwc,stack,stop,strt,to,%ZE s %ZE=".m" k %ZR i $d(%ZRSET) k ^%RSET($j) d init,main q OBJ n $et s $et=$s($d(%zdebug):"b",1:"zg "_$zl_":err^%RSEL") n add,beg,cnt,ctrap,d,delim,end,exc,from,i,k,last,mtch,pct,r,rd,rdf,out,scwc,stack,stop,strt,to,%ZE s %ZE=$s($zver["VMS":".obj",1:".o") k %ZR i $d(%ZRSET) k ^%RSET($j) d init,main q RD n $et s $et=$s($d(%zdebug):"b",1:"zg "_$zl_":err^%RSEL") n add,beg,cnt,ctrap,d,delim,end,exc,from,i,k,last,mtch,pct,r,rd,rdf,out,scwc,stack,stop,strt,to,%ZRSET w !,"Routine directory" d init s (out,rd,rdf)=1 i $l($g(%ZR)) w ! d work w !,"Total of ",cnt," routine",$s(cnt=1:".",1:"s."),! q d main i rdf s %ZR="*" d work W !,"Total of ",cnt," routine",$s(cnt=1:".",1:"s."),! q CALL n add,beg,cnt,ctrap,d,delim,end,exc,from,i,k,last,mtch,pct,r,rd,rdf,out,scwc,stack,stop,strt,to n:'$d(%ZE) %ZE i $g(%ZE)'[".o" s %ZE=".m" d init i $d(%ZRSET) d i $l($g(^%RSET($j))) s out=0 d main s ^%RSET($j)=cnt q . i $d(^%RSET($j))>1 s r="" f s r=$o(^%RSET($j,r)) q:'$l(r) s cnt=cnt+1 e d i $l($g(%ZR)) s out=0 d main s:'$d(%ZRSET) %ZR=cnt s:$d(%ZRSET) ^%RSET($j)=cnt q . i $d(%ZR)>1 s r="" f s r=$o(%ZR(r)) q:'$l(r) s cnt=cnt+1 d main q SILENT(patt,label) n $et s $et=$s($d(%zdebug):"b",1:"zg "_$zl_":err^%RSEL") i ""=$g(label) s label="SRC" d @label q init i $zver["VMS" d . s delim=",",scwc="%",from="abcdefghijklmnopqrstuvwxyz !""#$&'()+'-./;<=>?@[]\^_`{}|~",to="ABCDEFGHIJKLMNOPQRSTUVWXYZ" e d . s delim=" ",scwc="?",from=" !""#$&'()+'-./;<=>@[]\^_`{}|~",to="" s from=from_$c(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127) zsh "d":d s d="" f s d=$o(d("D",d)) q:d="" i $p=$p(d("D",d)," ") s d=d("D",d),ctrap=$p($p(d,"CTRA=",2)," "),exc=$p(d,"EXCE=",2) q e s (ctrap,exc)="" ; should never happen s k=$l(exc,"""") s k=$l(exc) i $e(exc,1,1)="""",$e(exc,k,k)="""" s exc=$e(exc,2,k-1) if ctrap'="" s exc="s ctrap="_ctrap x exc k d s (cnt,rd)=0,out=1,(last,r(0))=$c(255) i '$l($zro) s d=1,d(1)="" q s d=0 f k=1:1:$l($zro,delim) d i $l(r) s d=d+1,d(d)=$p(r,"*") . s r=$tr($p($zro,delim,k),"*") . i delim=" " d s:$l(r) r=$zparse(r_"/","","*") q ; UNIX conventions . . i r'["(" q ; no source info - it does both . . i %ZE[".o" d q ; only want objects . . . s r=$p(r,"(") ; grab object directory . . . f k=k:1:$l($zro,delim) q:$p($zro,delim,k)[")" ; and step over source info . . s r=$p(r,"(",2) ; grab 1st souce directory . . i r[")" s r=$p(r,")") q ; it's the only one - we're done . . d f k=k+1:1 s r=$p($zro,delim,k) i $l(r) d i r[")" s r=$p(r,")") q ; record all but the last . . . i r'[")" s r=$p($zparse(r_"/","","*"),"*") i $l(r) s d=d+1,d(d)=r . e d s:$l(r) r=$zparse(r,"","*") q ; VMS conventions . . i r[".olb" s r="" q ; it's an object library and we don't poke in them . . i r'["/" q ; no souces info - it does both . . i %ZE[".o" d q ; only want objects . . . s r=$p(r,"/") ; grab the object directory . . . f k=k:1:$l($zro,delim) q:$p($zro,delim,k)[")" ; and step over source info . . s r=$p(r,"=",2) ; grab 1st source directory . . i $e(r)'="(" q ; /SRC or /NOSRC - we're done . . s r=$p(r,"(",2) ; strip the opening ( . . i r[")" s r=$p(r,")") q ; it's in parens but only one . . d f k=k+1:1 s r=$p($zro,delim,k) i $l(r) d i r[")" s r=$p(r,")") q ; record all but the last . . . i r'[")" s r=$p($zparse(r,"","*"),"*") i $l(r) s d=d+1,d(d)=r q main u:'$d(%zdebug) $p:(ctrap=$c(3):exception="zg "_$zl_":main^%RSEL") s mtch="__" d start(0) f d q:'$l(%ZR) . zsh "s":stack ; get the current stack . i $p(stack("S",1),"^",2)=$p($g(stack("S",4)),"^",2) s %ZR=patt,patt="",out=0 k stack q:'$l(%ZR) ; if silent, don't prompt . e r !,"Routine: ",%ZR,! q:'$l(%ZR) . i $e(%ZR)="?" d help q . d work . i '$d(stack) q ; if silent, don't output count . e w !,$s(rd:"T",1:"Current t"),"otal of ",cnt," routine",$s(cnt=1:".",1:"s."),! i $D(%ZRSET) s ^%RSET($j)=cnt k %ZR e s %ZR=cnt u $p:(ctrap=ctrap:exception=exc) q work i rd s add=1,cnt=0,r=%ZR k %ZR s %ZR=r ; This behavior is a bit odd e i "'-"[$e(%ZR) s add=0,r=$e(%ZR,2,999) e s add=1,r=%ZR s r=$tr(r,from,to) ; strip out invalid characters, and, in VMS, xlate lower to upper ; In addition, filter out "all" non-ascii characters (irrespective of M or UTF-8) n r1,c s r1="" f k=1:1:$l(r) s c=$e(r,k) if $a(c)<128 s r1=r1_c s r=r1 s end=$p(r,":",2),beg=$p(r,":"),rdf=0 i end=beg!'$l(end) q:'$l(beg) s stop=last ; if all stripped out, done s:'$l(beg) beg="*" s pct=$e(beg) ; CAUTION: ELSE on next line e s strt=$$mask(beg),stop=$$mask(end) i $l($p(stop,"$")) q:stop']strt ; if end before begining, done i "*?"[pct s mtch="%*" d start(1) f s r=$$search(1) q:r]stop!'$l(r) d save ; if alls, get _files first s pct=pct="%",mtch=beg d start(pct) f s r=$$search(pct) q:r]stop!'$l(r) d save ; do begining i stop=last q ; no range - we're done s stop=$p(stop,"$") i $l(stop),stop]$p(strt,"$") d ; if no overlap, do middle . s strt=$tr(strt,"$",last) . i pct s mtch="%*" d start(1) f s r=$$search(1) q:stop']r!'$l(r) i r]strt d save . i $e(end)'="%" s mtch="*" d start(0) f s r=$$search(0) q:stop']r!'$l(r) i r]strt d save e s strt=$p(strt,"$") i '$l(strt) s strt="$" s pct=$e(end)="%",mtch=end d start(pct) f s r=$$search(pct) q:'$l(r) i strt']r d save ; and finish q mask(val) q $tr($e(val),"*?","$$")_$tr($e(val,2,9999),"*?%","$$$") ; start(pct) s mtch=$s('pct:mtch,1:"_"_$e(mtch,2,9999))_%ZE f k=1:1:d s r(k)=$$next(k,pct) q search(pct) s r=last f k=d:-1:1 i $l(r(k)) s:r(k)=r(k-1) r(k)=$$next(k,pct) i $l(r(k)),r(k)']r s i=k,r=r(k) i r'=last s r(i)=$$next(i,pct) e s r="" q r ; next(k,pct,t) f s t=$zsearch(d(k)_mtch,k) q:t="" s t=$zparse(t,"NAME") q:t?1A.AN!pct i scwc="%",$e(t)]"Z" s t="" q q $s('pct:t,$e(t)="_":"%"_$e(t,2,9999),1:"") ; save i $d(%ZRSET) d . i add,'$d(^%RSET($j,r)) s ^%RSET($j,r)=d(i),cnt=cnt+1 . e i 'add,$d(^%RSET($j,r)) k ^%RSET($j,r) s cnt=cnt-1 . i i out w:$x>70 ! w r,?$x\10+1*10 e d . i add,'$d(%ZR(r)) s %ZR(r)=d(i),cnt=cnt+1 . e i 'add,$d(%ZR(r)) k %ZR(r) s cnt=cnt-1 . i i out w:$x>70 ! w r,?$x\10+1*10 q help i "Dd"[$e(%ZR,2),$l(%ZR)=2 d q . w ! s r="" . f s r=$o(%ZR(r)) q:'$l(r) w:$x>70 ! w r,?($x\10+1*10) w !,"",?15,"to leave",!,"* ",?15,"for all",!,"rout ",?15,"for 1 routine",!,"rout1:rout2 ",?15,"for a range" w !,"* ",?15,"as wildcard permitting any number of characters" w !,scwc,?15,"as a single character wildcard in positions other than the first" i rd q w !,"' ",?15,"as the 1st character to remove routines from the list" w !,"?D ",?15,"for the currently selected routines" q err u $p:(ctrap=ctrap:exception=exc) w !,$p($ZS,",",2,999),! s $ec="" q %S1ASK %S1ASK ; ;%Q("Z") - ASK,%Q("U") - DEFAULT.,%Q("V")-POSSIBLE POINT ;- YES=1 - YES,0 - NO [ 22.02.04 11:57 ] [ 07/04/94 4:03 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%Q,YES) D ^%L1C BG S YES="E" U 0 I $D(%Q("U"))#2,%Q("U")'="Y",%Q("U")'="N" W *7,!,"*** %S1ASK .ERROR IN PARAMETR'S VALUES: %Q(""U"")=",%Q("U") G END I '($D(%Q("Z"))#2) W !,"*** %S1ASK . ISN'T (%Q(""Z"")) !" G END ; S:'$D(%Q("Y")) %Q("Y")=$Y S:'$D(%Q("X")) %Q("X")=0 S %XX=%Q("X"),%YY=%Q("Y") X %POSIC W %chists W %Q("Z")_" (Y/N) ? " S %S="" S:$D(%Q("U")) %S=%Q("U") S %LS=1 S $Y=%YY D ^%ZMSL S YES=%S G BDK I '$D(%Q("U")) W !!,%Q("Z")_" (Y/N) ? " W:$D(%Q("U")) "<"_%Q("U")_"> " S %LS=1,%S="" D ^%ZMSL S YES=%S ; BDK I $D(%Q("V")) I YES="."&($D(%Q("U")))!(YES=""&('$D(%Q("U")))) S YES="." G END I $D(%Q("B")) I YES="."!(YES="^") G END I YES="D"!(YES="Y")!(YES="y")!(YES="h") S YES=1 G END I YES="N"!(YES="n")!(YES="n") S YES=0 G END I YES="" G:'($D(%Q("U"))#2) ER S YES=$S(%Q("U")="Y":1,1:0) G END I YES="?" G:$D(%Q("H"))>10 INSTR W !?30,"A HELP TEXT IS NOT EXIST !" G BG G ER1 END X %XCL Q ;- ER ;;I $D(%Q("X")),$D(%Q("Y")) W " *** ERROR IN %Q PARAMETERS" H 1 G END ER1 W ?30," *** ERROR ! " H 1 G BG ;- INSTR S PROGR=%Q("H") I PROGR["^W" D @PROGR G BG K PROGR W ! F %J=1:1 Q:'$D(%Q("H",%J)) W !?3,%Q("H",%J) G BG N S %Q("X")=5,%Q("Y")=24 G BG %S1GC %S1GC ;MAC1 --> MAC2; [ 15.12.21 19:38 ] [ 04/09/99 11:56 PM ] [ 11/07/96 9:47 AM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC) D ^%L1C FROM K MAC2 S %TO="",%S=$G(MAC1,"^"),%BE="E" K CIST,%LS S %FLINS=1 W !!,"%FROM :" D ^%ZMSL Q:(%TO="END")!("^"[%S&(%TO="")) S MAC1=%S I $E(MAC1)'="^" S MAC1="^"_MAC1 S MAC1=$$IG(MAC1) I $E(MAC1,$L(MAC1))'="!" G FROM S MAC1=$E(MAC1,1,$L(MAC1)-1) S MAC2=MAC1 TO S %FL="",%FLINS=1,%TO="",%BE="E",%S=$G(MAC2) W !,"%TO :" D ^%ZMSL G:%S=""&(%TO="")!(%TO="END") FROM S MAC2=%S I $E(MAC2)'="^" S MAC2="^"_MAC2 I MAC1=MAC2 U 0 S %SAY=" MAC1=MAC2 " X %XMSGV H 2 G FROM ;S MAC2=$$IG(MAC2) I $E(MAC2,$L(MAC2))'="!" W !!,"FROM :"_MAC1 G TO ;S MAC2=$E(MAC2,1,$L(MAC2)-1) I $D(@MAC2) K %Q,%ECHO W ! S %X=$X,%Y=$Y S %Q("Z")="OVERWRITE" D ^%S1ASK G:'YES TO W " KILL OLD "_MAC2_" ? " S %S="N",$Y=%Y,$X=50 D ^%ZMSL I %S="Y"!(%S="y")!(%S="h") K @MAC2 D ^%S1GC1 G FROM IG(MAC) ; I MAC="??"!(MAC="^??")!(MAC="^^D")!(%TO="F7") D ^%GD S MAC="" Q MAC I MAC=""!(MAC="^") Q "" I $E(MAC,$L(MAC))=":" S MAC=$E(MAC,1,$L(MAC)-1) D ^%L4NU Q:FLAG'="" "" Q MAC I '$D(@MAC) W !,*7,"*** ISN'T GLOBAL !!! " Q "" Q MAC_"!" %S1GC1 %S1GC1 ;MAC1 --> MAC2; [ 30.08.14 09:09 ] [ 04/10/99 12:45 AM ] [ 09/18/94 9:49 AM ] M @MAC2=@MAC1 I $D(%S1GC("R")) D .I $D(@MAC2)#2 S @MAC2=$P(@MAC2,%S1GC("R")) .N %MAC20 S %MAC20=$R I $E(%MAC20,$L(%MAC20))=")" S %MAC20=$E(%MAC20,1,$L(%MAC20)-1) .N %N S %N=MAC2 F S %N=$Q(@%N) Q:%N="" Q:$E(%N,1,$L(%MAC20))'=%MAC20 D ..I $D(@%N)#2 S @%N=$P(@%N,%S1GC("R")) K %S1GC Q %S1GED ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; Copyright 1989,2001 Sanchez Computer Associates, Inc. ; ; ; ; This source code contains the intellectual property ; ; of its copyright holder(s), and is made available ; ; under a license. If you do not know the terms of ; ; the license, please stop and do not read further. ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; %s1ged ;%ged - global editor bg n (%zdebug,%s1gedv) D ^%L1C X %chista s %("lo")="abcdefghijklmnopqrstuvwxyz" s %("up")="ABCDEFGHIJKLMNOPQRSTUVWXYZ" s %("$zso")=$zso s %("$io")=$io s $zso=$select($zv'["VMS":".",1:"[]")_"_"_$j_".ged" s %("zlbeg")=$zl beg ; n $et s $et=$s($d(%zdebug):"b",1:"s $ec="""" zg "_$zl_":beg") u 0:(ctrap=$c(3)) f w !,$s($d(%s1gedv):"View ^",1:"Edit ^") r %("global") q:%("global")="" d . i $e(%("global"))'="^" s %("global")="^"_%("global") . if (($e(%("global"),2)="%")&($l(%("global"))=2)) d q .. w !,"%ged will not "_$s($d(%s1gedv):"view :",1:"edit: "),%("global") .. q . if ($e(%("global"),2)="?") d help q . d convert . d main . k @%("local"),@(%("a")_$e(%("global"),3,%("glbl lngth"))) . zwi %("add"),%("change"),%("kill"),%("s") . quit s:$D(%("$zso"))#2 $zso=%("$zso") u:$g(%("$io")) %("$io"):(ctrap="":exception="") q ; main ; s %("glbl lngth")=$f(%("global"),"(")-2 if %("glbl lngth")=-2 s %("glbl lngth")=$l(%("global")) s %("local")=$e(%("global"),2,%("glbl lngth")) d zwr s %=%("global") o $zso u $zso f r % q:$zeof s @(%("a")_$e(%,3,9999)) s %("s")=$g(%("s"))+1 c $zso zed $zso q:$d(%s1gedv) K %Q S %Q("Z")="SAVE",%Q("X")=5,%Q("Y")=24 D ^%S1ASK I 'YES q o $zso:(read:rewind) d stor c $zso:delete o $zso c $zso:delete w !,"node : ",%("global") w !,"selected : ",+$g(%("s")) w !,"changed : ",+$g(%("change")) w !,"added : ",+$g(%("add")) w !,"killed : ",+$g(%("kill")) q ; zwr ; n $et s $et=$s($d(%zdebug):"b",1:"s $ec="""" goto continue") o $zso:(newversion:exc="":noreadonly) u $zso zwr @%("global") continue c $zso q badzwr ; c $zso:delete u 0 w !,"invalid global description: ",%("global") q stor ; s %("storlvl")=$zl u $zso f r % quit:$zeof d istor do work q istor ; n $et s $et="do istorerr" i '$l($tr(%," ")) q i $e(%)'="^" s %="^"_% i $e(%,1,%("glbl lngth"))=$e(%("global"),1,%("glbl lngth")) do . s %=$e(%,2,99999) . s @% . quit else do . set %("cur io")=$io . u 0 w !,"%ged will not edit: ",% . use %("cur io") . quit q ; istorerr; close $zso use 0 w !,"invalid syntax: ",%,!,"return to continue: " r %:30,! zed $zso open $zso:(read:rewind) s $ec="" zg %("storlvl"):stor work ; s %=%("local") if $d(@%)'[0 d check ; Set top node f s %=$q(@%) q:%="" d check d kill q check ; if ($d(@("^"_%))[0)&($d(@(%("a")_$e(%,2,9999)))[0) d add q if ($d(@("^"_%))[0)&($d(@(%("a")_$e(%,2,9999)))'[0) d addcheck q if ($d(@("^"_%))'[0)&($d(@(%("a")_$e(%,2,9999)))[0) d conflict q if @("^"_%)=@% d withdraw q if @(%("a")_$e(%,2,9999))=@("^"_%) d change q d checkerr q ; add ; s @("^"_%)=@% s %("add")=$g(%("add"))+1 d withdraw q ; change ; s @("^"_%)=@% s %("change")=$g(%("change"))+1 d withdraw q ; withdraw; if $d(@(%("a")_$e(%,2,9999)))'[0 zwithdraw @(%("a")_$e(%,2,9999)) q ; conflict; u 0 w !,"WARNING: The original value for node ^",%," was not stored before" w !,"the edit session and may have changed while in the editor.",! s %("%local")=%("a")_$e(%,2,9999) w !,"old value : ",$s($d(@%("%local"))'[0:@%("%local"),1:"") w !,"current value : ",@("^"_%) w !,"edit value : ",@(%),!! w !,"Do you still wish to use the edit value? [n] " r %("ans"):30 s %("ans")=$tr(%("ans"),%("lo"),%("up")) if "\NO"[("\"_%("ans")) d withdraw q if "\YES"[("\"_%("ans")) d change q d withdraw q addcheck; u 0 w !,"WARNING: Node ^",%," was deleted while in the editor",! s %("%local")=%("a")_$e(%,2,9999) w !,"old value : ",$s($d(@%("%local"))'[0:@%("%local"),1:"") w !,"current value : " w !,"edit value : ",@(%),!! w !,"Do you still wish to use the edit value? [n] " r %("ans"):30 s %("ans")=$tr(%("ans"),%("lo"),%("up")) if "\NO"[("\"_%("ans")) d withdraw q if "\YES"[("\"_%("ans")) d add q d withdraw q checkerr; u 0 w !,"WARNING: Node ^",%," was modified while in editor",! s %("%local")=%("a")_$e(%,2,9999) w !,"old value : ",$s($d(@%("%local"))'[0:@%("%local"),1:"") w !,"current value : ",@("^"_%) w !,"edit value : ",@(%),!! w !,"Do you still wish to use the edit value? [n] " r %("ans"):30 s %("ans")=$tr(%("ans"),%("lo"),%("up")) if "\NO"[("\"_%("ans")) d withdraw q if "\YES"[("\"_%("ans")) d add q d withdraw q ; kill ; n $et s $et="s $ec="""" q" s %=(%("a")_$e(%("local"),2,9999)) if $d(@%)'[0 d killcheck f s %=$q(@%) q:%="" d killcheck q ; killcheck; if $d(@("^"_%("b")_$e(%,2,9999)))[0 s %("kill")=$g(%("kill"))+1 q if @("^"_%("b")_$e(%,2,9999))=@% zwi @("^"_%("b")_$e(%,2,9999)) s %("kill")=$g(%("kill"))+1 q u 0 w !,"killed node has changed: " w !,"node : ^",%("b")_$e(%,2,9999) w !,"old value : ",@(%("a")_$e(%,2,9999)) w !,"current value : ",@("^"_%("b")_$e(%,2,9999)) q ; nofile c $zso:delete u 0 w !,"No changes made",! q ; convert; s %("b")=$e(%("global"),2) s %("a")=$a(%("global"),2) s %("a")=%("a")+1 s %("a")=$s(%("a")=91:65,%("a")=123:97,%("a")=38:65,1:%("a")) s %("a")=$c(%("a")) q ; help i "dD"[$e(%("global"),3),$l(%("global"))=3 d ^%GD q w !,"VALID INPUT",!! w !,?3,"",?16,"to leave the %GED utility ",! w !,?4,"?D",?16,"to display existing globals in your directory ",! w !,"[global name]",?16,"the MUMPS name for the global e.g. ABC" w !?16,"the global name may be followed by: " w !?16,"subscript(s) in parentheses" w !?16,"a subscript is a MUMPS expression e.g. ""joe"",10,$e(a,1)," w !?16,"a ""*"" as a subscript causes all descendents to be included," w !?16,"or by a range of subscripts in parentheses" w !?16,"expressed as [expr]:[expr] e.g 1:10 ""a"":""d""" w !?16,"a MUMPS pattern to match selected subscripts: ^TEST(?1.3N)" q %S1GL %S1GL N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S1GL) D ^%L1C ; [ 13.01.06 11:22 ] [ S USTR=0 K OLDMAC N %HBRY,%S2V ZAPR1 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%S1GL" K %INV S %TO="" I $G(%S1GL("MAC"))="" K %S1GL("MAC") I $D(%S1GL("MAC")) S MAC=%S1GL("MAC") K %S1GL G M S %S="^",%BE="E" M0 K %HBRY W %ENG U $P W #!," NAME OF GLOBAL (EXIT - : " D ^%ZMSL K %INV S MAC=%S M I MAC="??"!(MAC="^??")!(MAC="^^D")!(%TO="F7") D ^%GD G ZAPR1 G:MAC=""!(MAC="^")!(%TO="END") END I MAC="?"!(MAC="^?") D INSTR K MAC G M0 I $E(MAC)'="^" S MAC="^"_MAC I $$^%L1DISP(USTR) U $P:(ECHO:WRAP:NOESC) W !! K %Q,%HBRY S %Q("Z")="HEBREW",%Q("U")="Y" S %Q("X")=1,%Q("Y")=$Y D ^%S1ASK I YES W %HBR S %S2V("HBRY")="" I $$^%L1DISP(USTR) K:'YES %HBRY I $E(MAC,$L(MAC))=":" S MAC=$E(MAC,1,$L(MAC)-1) D ^%L4NU G:FLAG'="" ZAPR1 S OLDMAC=MAC I '$D(@MAC) W !,*7,"*** ISN'T GLOBAL !!! " G ZAPR1 S %S3G("MAC")=MAC,%S3G("VIEW")="" D B^%S3GLKR G ZAPR1 Q END K USTR Q INSTR W !,"***********************************************************" W !," ENTER REFERENCE" W !," OR REFERENCE & ':' IN ORDER TO SEARCH A NODE" W !," OR ?? TO TYPE GLOBAL DIRECTORY " W !,"***********************************************************",! Q ER I $ZS["CTRAP" U 0 W !,*7,"INTRERUPT..." G Z W !,*7,"ERROR:",$ZS G Z W !,"$R=",$R Q Z U $P W !! S %S=0,CIST="03",%LS=1 W "DEVICE ? (0,3)> " D ^%ZMSL S USTR=%S G END:USTR="" I USTR'=0&(USTR'=3) W *7,!?20,"*** ERROR !" G Z G ZAPR1 %S1GLL %S1GLL I '$D(%LEVO) D ^%L1C ; [ 13.01.06 11:12 ] [ S USTR=0 ZAPR1 S $ZS="ER^%S1GLL" O USTR W !!,"NAME OF ARRAY LOCAL " S %S="",%BE="E" D ^%ZMSL S MAC=%S G:MAC=""!(MAC="^") END I MAC="?" D INSTR K MAC G KOD I $E(MAC,$L(MAC))=":" S MAC=$E(MAC,1,$L(MAC)-1) D ^%L4NL G:FLAG'="" ZAPR1 I '$D(@MAC) W !,*7,"*** HASN'T DATA !!! " G ZAPR1 I '$$^%L1DISP(USTR) D ACPU G ZAPR U 0 W !!!?20,MAC W ! D ^%S1GLPCL W ! G ZAPR1 ; ACPU ; O 3::3 E U 0 W *7,!," *** !" Q O 3 U 3 W #?20,MAC,!! D ^%S1GLPC W !! C 1 Q Q END K USTR Q ER I $ZS["CTRAP" U 0 W !,*7,"INTRERUPT..." G ZAPR1 W !,*7,"ERROR:",$ZS S KO=+$ZS S:$L(KO)<2 KO="0"_KO I $D(^E(KO))#2 U 0 W !!,^(KO) G ZAPR1 Q %S1GLPC %S1GLPC ; [ 29.07.01 11:39 AM ] [ 06.07.01 11:10 AM ] [ 04/03/99 2:37 AM ] S $Y=0 K ^TEMPg($P) L ^s1glpc:1 E U $P W !," ... BUSY ! " Q k ^s1glpc M ^s1glpc=@MAC O "s1glpc.m":(newversion) U "s1glpc.m" ZWR ^s1glpc C "s1glpc.m" k ^s1glpc L S %RNAME="s1glpc" D ^%L1RV Q %S1GLPCL %S1GLPCL ; [ 08/23/91 9:36 AM ] ; S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 W !,MAC,"=",@MAC S %MAC2=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_",",1:MAC_"(") S %MAC1=%MAC2_""""")" S %IND1=$O(@%MAC1) G:%IND1="" END VN1 S %IND1=$O(@%MAC1) I %IND1="" G VV S %MAC1=%MAC2_""""_%IND1_""")" VN ; D PC S %MAC2=$E(%MAC1,1,$L(%MAC1)-1)_"," S %MAC1=%MAC2_""""")" G VN1 VV ; VV1 ; I $L(%MAC1,",")<3 S %MAC2=$P(MAC,"(")_"(" E S %MAC2=$P(%MAC1,",",1,$L(%MAC1,",")-2)_"," S %MAC1=$P(%MAC1,",",1,$L(%MAC1,",")-1)_")" I $L(%MAC1,",")<$L(MAC,",")!($L(%MAC1,",")=$L(MAC,",")&(MAC["("))!(%MAC1=")") G END G VN1 PC ; I %IND1'="",($D(@%MAC1)#10)'=0 W !,%MAC1,"=",@%MAC1 Q END ;K %MAC1,%MAC2,MAC,%IND1 Q Q %S1GLSV %S1GLSV ; [ 22.12.21 07:57 ] [ 03.02.21 14:19 ] [ 20.01.21 20:57 ] N %PR,%MAC1,%MAC2,%ORD S %ORD=1 I $G(%S3G)<0 S %ORD=-1 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 W !,MAC,"=",@MAC S %MAC2=$E($R,1,$L($R)-1)_$S($E(MAC,$L(MAC))=")":",",1:"") S ^S000($P,1)=MAC_"=<<<<>>>>" I %PR S ^S000($P,1)=MAC_"="_@MAC S %MAC1=MAC I $E(%MAC1,$L(%MAC1))=")" S %MAC1=$E(%MAC1,1,$L(%MAC1)-1)_","""")" I $E(%MAC1,$L(%MAC1))'=")" S %MAC1=%MAC1_"("""")" S %MAC1=$Q(@%MAC1) I %MAC1="" W:%PR=0 *7,!?15,"*** ARRAY ",MAC," HASN'T DESCENDANTS !" H 2 Q PR F I=2:1:1000000 Q:%MAC1'[%MAC2 Q:%MAC1="" S ^S000($P,I)=%MAC1_"="_$G(@%MAC1) S %MAC1=$Q(@%MAC1) I I=1000000 S FLAG=1 END K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 Q %S1JOBL %S1JOBL ; [ 21.10.06 17:27 ] [ 14.12.05 07:44 ] [ 23.03.05 10:24 ] N FN,I,PID,DEV,NAME S FN="s1j"_$J ZSY "rm -f "_FN ZSY "ps -A > "_FN D GET^%L1OS(FN) C FN:DELETE S %L3MYDVN=$$^%L3MYDVN K ^s1job(%L3MYDVN) F I=1:1 Q:'$D(^TMPS111($J,I)) D .N A S A=$G(^(I)) Q:A="" .S PID=$TR($E(A,1,5)," ") .S DEV=$TR($E(A,7,14)," ") .S NAME=$TR($E(A,24,40)," ") .S ^s1job(%L3MYDVN,NAME,PID)=DEV Q %S1KA %S1KA ; N %J,%J0,%J1,%J2,%CC S %J0=1 M F %J=%J0:1:$L(%S) Q:$E(%S,%J)'=" " M1 I %J0=1 S %CC=$E(%S,1,%J-1) S %J1=$F(%S," ",%J) I '%J1!(%J1'<$L(%S)) S %S=%CC_$E(%S,%J,255) G END S %CC=%CC_$E(%S,%J,%J1-1) S %J0=%J1 G M ALL F %J=1:1 Q:$E(%S,%J)'=" " S %S=$E(%S,%J,255) G %S1KA END I $E(%S,$L(%S))=" " F %J2=$L(%S):-1:1 Q:$E(%S,%J2)'=" " I S %S=$E(%S,1,%J2) Q %S1KLJ %S1KLJ(NAME) ; [ 21.10.06 17:30 ] [ D ^%S1JOBL Q %S1LH %S1LH ; [ 11.01.02 7:46 AM ] [ I $$TERMINAL^%HOSTCMD("C:\LOADHEB") Q %S1MCIND %S1MCIND(%MAC) ; [ 08.11.15 11:59 ] [ 26.10.15 12:45 ] [ 20.10.15 14:08 ] I %MAC'["(" Q %MAC N %IND,%IND1,%IN,%IN1,%J,%MAC1 ;;S %MAC="^AA(A1,""B1"",C1,""D1"")" S %IND=$P($P(%MAC,"(",2),")") S %IND1="" ; F %J=1:1:$L(%IND,",") D .S (%IN,%IN1)=$P(%IND,",",%J) .I $E(%IN)'="""",$E(%IN)?1A!($E(%IN)="%") S %IN1="""""""_"_%IN_"_""""""" .S %IND1=%IND1_%IN1_"," S %MAC1=$P(%MAC,"(")_"("_$E(%IND1,1,$L(%IND1)-1)_")" Q %MAC1 %S1SGL %S1SGL ; SAVE GLOBAL [ 03/31/92 3:46 PM ] S %BN=2235,%REFER="MSG",%PRFIND=0,%PRZI=0 O 63 ASK1 ;S %BN=3686 ; S $ZT="ERR^BLKDMP" I %BN'="*",%BN'?1.N,%BN'?1N1":"1.N,%BN'?1N1":"1.N1":"1"G"1N,%BN'?1.N1":"1"G"1N,%BN'?1N1":"1.N1":"1""""1"G"1N1"""",%BN'?1.N1":"1""""1"G"1N1"""" S @("%BN="_%BN) I %BN'="*" S X=%BN D VB^DBFIX G:'$D(X)#10 ASK S %BN=X V:%BN'="*" %BN:$S($D(VG)#10:VG,1:"") INT S %INT=1,%ID=1,%DEV=$P S %LR=%BN DEV S %DEV=$P U 0 ;D:%DEV=$P CRT^%SDEV G:$D(QUIT) EXIT S %ID='(%DEV=$P) O 63 U 63 S %B=$ZA U 0 W !!,"Block :",%B S X=%B D BN^BLKDMP1 W " (",Y,")" W:$D(VGI) ?25,"Volume group ",VGI I +$P(Y,":",2)=0 D BLKDMP^VGLABELE S R="" G ASK S %T=$V(1020,0,1),%T2=$V(1021,0,1,3) I $E(%T2,5) W !,"Block awaiting garbage collection" I %T'=3 G NEXT ;>12!'%T W *7,!,"Uninitialized block, or invalid block type" G ASK ;D @($P("GDIR^PTR^DATA^XDATA^RDIR^RTNHDR^RTN^MAP^JRNL^SBP^SPDIR^SPBLK","^",%T)_"^BLKDMP1") DATA W !!,"Data block" D OFST G:'%OF NEXT NEW BYTREV S BYTREV=$ZB($V($V(44),-3,2),#40,1) I $D(NCOL) S STRING='NCOL G DATA1 D ^BLKDMP2 G:'F EXIT DATA1 S %I=0,%N="" W !!," Key,Data",?11,"Global Name/",!," Off Off",?11,"Value",!," --- --- -----" DATA2 W ! S %L2=$V(%I+1,0,1) S %GLOB="" D N2 G:'%PRFIND&(%GLOB'[%REFER) NEXT G:$P(%GLOB,"(")'=%REFER!(%PRFIND) EXIT W "%GLOB=",%GLOB S %I=%I+%L2+2,%L3=$V(%I,0,1) S %VALUE="" I %L3=0 S %VALUE=$V(%I+1,0,4,0) S %I=%I+5 E I %L3=2 DO S %I=%I+9 ; If byte reversed, swap bytes before display .I 'BYTREV S %VALUE=$V(%I+1,0,8,4) Q .NEW %J,%OVAL,%X,%XX S %X=$V(%I+1,0,8,2),%OVAL=$V(%I+1,0,8,4),%XX=15 .F %J=1:1:8 V %I+%J:0:$ZH($E(%X,%XX,%XX+1)):1 S %XX=%XX-2 ; swap bytes .S %VALUE=$V(%I+1,0,8,4) V %I+1:0:%OVAL:8:4 Q ; put back original value E I %L3=3 S %VALUE=$V(%I+2,0,$V(%I+1,0,1),5) S %I=%I+2+$V(%I+1,0,1) E I %L3=8 S %VALUE=$V(%I+2,0,256+$V(%I+1,0,1),5) S %I=%I+2+256+$V(%I+1,0,1) E I %L3=7 W "......" S %I=%I+1 E W " *** UNRECOGNIZED DATA TYPE ***" G NEXT W " %VALUE=",%VALUE S @("^"_%REFER_"z"_$S(%GLOB["(":"("_$P(%GLOB,"(",2,255),1:""))=%VALUE G DATA2:%I<%OF,NEXT EXIT C 63 N S %L2=$V(%I+1,0,1) S %BL=$V(%I+%L2+2,0,3) D BL W ?5,$J(%BL,7) I $X>12 W " " E W ?13 N2 S D=$C(0),%N=$E(%N,1,$V(%I,0,1))_$V(%I+2,0,%L2,5),%P=0 S %GLOB=$P(%N,D) Q:$P(%N,D,2)="" F %J=2:1 S %C=$P(%N,D,%J) Q:%C="" D N3 S %GLOB=%GLOB_""")" Q N3 I STRING D P S %GLOB=%GLOB_%C Q S F=$A(%C)-128,%C=$E(%C,2,1023),%LN=$L(%C) I %LN=0 D P S %GLOB=%GLOB_0 Q I F=127 D P S %GLOB=%GLOB_%C Q I F'<0 D P S %GLOB=%GLOB_$E(%C,1,F) S:F<%LN %GLOB=%GLOB_"."_$E(%C,F+1,%LN) Q D P W "-" S F=-2-F F X=1:1:F S %GLOB=%GLOB_(9-$E(%C,X)) I %LN-1>F S %GLOB=%GLOB_"." F X=F+1:1:%LN-1 S %GLOB=%GLOB_(9-$E(%C,X)) Q P I %P S %GLOB=%GLOB_""",""" Q E S %GLOB=%GLOB_"(""" S %P=1 Q OFST S %OF=$V(1022,0,2) Q NEXT ; U 0 W:"6,7,10,"[(%T_",") !!,"Option not available" S X=%B D BN W !!,"Current block is ",Y S CUR=Y U 0 S BNL=$ZB($V(1012,0,4),#FFFFFF,1) NX2 I BNL S X=BNL D BN W !!,"Link block is ",Y,! I %PRZI S %BN=%BN+1 Q:%BN>BLOCK2 G ASK1 W:'BNL&($P=%DEV) ! Q:Y=CUR Q:Y=0 S %BN=Y G ASK1 Q BN ;BLOCK NUMBER -> VOLUME INDEX:BLOCK NUMBER ;PASS IN X RETURNED IN Y S Y=X I '$D(VGI)!'$D(VGVOL) D GETVOL^%VGUTIL F Z=VGVOL-1:-1:0 I $P(VGVOL(Z),"^",2)'>X S Y=Z_":"_(X-$P(VGVOL(Z),"^",2)) Q Q ZI U 0 R !!,"FROM BLOCK:",BLOCK1 Q:BLOCK1="" W !!,"TO BLOCK :" R BLOCK2 G:"^"[BLOCK2 ZI W !!,"GLOBAL ^" R %REFER G:%REFER="" ZI S %PRFIND=0,%PRZI=1,%BN=BLOCK1 O 63 G ASK1 %S1SRV %S1SRV ; [ 25.02.05 13:11 ] [ 27.08.04 18:49 ] [ 09.08.04 09:56 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C BG X %chista K ^TMPS111($J) D KOT S ^TMPS111($J,1)=$J("",SM)_KAV S ^TMPS111($J,2)=$J("",SM)_KOT S ^TMPS111($J,3)=$J("",SM)_KAV D STR1 S ^TMPS111($J,4)=$J("",SM)_STR1 S ^TMPS111($J,5)="" D STR2 S ^TMPS111($J,6)=$J("",SM)_STR2 W ! ZSY "uptime" X %XCL W ! F I=1:1:6 W !,^TMPS111($J,I) R *A:10 Q:A=13!(A=25) G BG Q KOT ; S KOT=" SERVER " S J=0 K MP S MP(0)=80 S N="" F S N=$O(^[%L3GLD]devi2(N)) Q:N="" I $E(N,1,2)="ws",J<6 D .S L=$L(^(N),"/") .S J=J+1,KOT=" "_$J(N,5)_" "_$J($P(^(N),"/",L-1,L),5)_" |"_KOT .S MP(J)=MP(J-1)-12 S SM=80-$L(KOT)\2 I SM<0 S SM=0 S KAV=$TR($J("",$L(KOT))," ","-") Q STR1 ; S STR1="" K MD S N="",J=0 F S N=$O(^[%L3GLD]devi2(N)) Q:N="" I $E(N,1,2)="ws",J<6 D .S J=J+1 .I $D(^CRDTCHT(N)) S MD(J)=$J($P(^(N),"\",2),5)_" "_$$T^%L1TIME(+$E(^(N),6,10)+$G(^SYNCTIME(N,"SMT")))_" "_$$SIMAN($E(^CRDTCHT(N),1,5)_","_+$E(^(N),6,10),N) .I '$D(^CRDTCHT(N)) S MD(J)=$J("",6)_"-"_$J("",6) F J=1:1 Q:'$D(MD(J)) S STR1=MD(J)_" "_STR1 S STR1=STR1_" TOUCH" Q STR2 ; S STR2="" K MD S N="",J=0 F S N=$O(^[%L3GLD]devi2(N)) Q:N="" I $E(N,1,2)="ws",J<6 D .S J=J+1 .I $D(^P1VIDEO(N)) D ..S MD(J)=$S($D(^P1VIDEO(N,"$J")):$J(^("$J"),5),1:$J("",5)) ..S MD(J)=MD(J)_" "_$S($D(^P1VIDEO(N,"TIME")):$J($$T^%L1TIME($P(^("TIME"),",",2)+$G(^SYNCTIME(N,"SMT"))),5),1:$J("",5)) ..S MD(J)=MD(J)_" "_$$SIMAN($G(^P1VIDEO(N,"TIME")),N) . .I '$D(^CRDTCHT(N)) S MD(J)=$J("",6)_"-"_$J("",6) F J=1:1 Q:'$D(MD(J)) S STR2=MD(J)_" "_STR2 S STR2=STR2_" VIDEO" Q SIMAN(H,POS) ; I $P(H,",")-$G(^SYNCTIME(POS,"SMD"))'=+$H Q "-" I $P($H,",",2)-$G(^SYNCTIME(POS,"SMT"))-$P(H,",",2)>20 Q "-" I $P($H,",",2)-$G(^SYNCTIME(POS,"SMT"))-$P(H,",",2)<-20 Q "-" Q "+" %S277 %S277 ; [ 25.04.10 13:55 ] [ 27.04.06 11:36 ] [ 08.01.02 1:48 PM ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC) BG K (%Z) D ^%L1C S N="" F S N=$O(^SHP(N)) Q:N="" I '$D(^SHP(N,1)) K ^SHP(N) S %TIPT=1 N %ECHO S N="" %77 X %chista W ! F I=1:1 Q:$T(MEN+I)["Q ;" S MM(I)=$P($T(MEN+I),";",2) S MAC="MM" D ^%L2MENU Q:%I=1 X %chista S HEAD=$P($T(MEN+%I),";",2) D @$P($T(MEN+%I),";",3) G BG MEN ; ; EXIT ; ; CREATE/MODIFY A HEADER ;REG1; ; ERASE A HEADER ;REG3; ; TYPE A HEADER ;REG5; K D ^%L1C Q ; REG0 K ^S000($P) Q REG1 S VP="V" D ZCOD Q:KOD="" REG10 K ^S000($P) F I=1:1 Q:'$D(^SHP(KOD,I)) S ^S000($P,I)=^SHP(KOD,I) REG2 S U=1 K L,R S %GETIN=$G(^SHP(KOD,"RG"),$S(%XMSG(0)'>1:"H",1:"E")) S %GET=" ENGLISH - E , HEBREW - H ++14,5,EE#1" D NE^%L1GET K %GETIN Q:%S=""!($G(%TO)="END") S %TIP="G" I %S="H"!(%S="h")!(%S="i") S ^SHP(KOD,"RG")=%S D RSHP K U,R,L,Y1,X1,U1 S %RMAX=79,%PRHBR=1,RL=79 D ^%S2ERG1 G ZS D ^%S2ERG ZS S %GET="SAVE (Y/N) ?#1" D NE^%L1GET K %GETIN I %S'="Y"&(%S'="h")&(%S'="y")!($G(%TO)="END") K:'$D(^SHP(KOD,1)) ^SHP(KOD) Q D REG4 S ^%ERGS(+$H,"^SHP("_KOD,$P($H,",",2))=%S S ^%ERGS(+$H,"^SHP("_KOD)=$P($$^%L1ZU(0),",") S ^SHP=KOD Q REG3 S VP="VP" D ZCOD Q:KOD="" D VIEW Z3 W !?20," ARE YOU SURE YOU WANT TO DELETE (Y/N/T - TYPE) ?" S CIST="YNT",%S="N" D ^%ZMSL G:%TO="END"!(%S="") REG3 I %S'="Y",%S'="N",%S'="T" W *7 G Z3 I %S="T" D VIEW G REG3 I %S'="Y" G REG3 K ^SHP(KOD) W *7," HEADER ",KOD," IS ERASE !" S KOD="" G REG3 ;------------------------- SAVE REG4 X %chista S %GET="SAVING CODE :++24,30,EE#"_$G(KOD)_"++10,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S KOD=%S REG41 ; N RGR S NAM=$G(^SHP(KOD)) S %GET="NAME ++15,10,EE#"_(NAM)_"++20,H,I" D ^%L1GET S NAM=%S S RGR=$G(^SHP(KOD,"RG"),$S(%XMSG(0)>1:"E",1:"H")) K ^SHP(KOD) F J=1:1 Q:'$D(^S000($P,J)) S ^SHP(KOD,J)=^S000($P,J) S ^SHP(KOD)=$G(NAM) S ^SHP(KOD,"RG")=RGR K ^S000($P) Q REG5 S VP="VP" D ZCOD Q:KOD="" D PR2 G REG5 REG6 D PR1 Q PR1 S %QTY=2,%DEF="3" D %IOS Q:'$D(%IOD) U @%IOD I %IOD=1!(%IOD=2) G R1 G R10 R1 W #,!,?4," COD ",?10," NAME OF HEADER ",! S IS="" F K=0:0 S IS=$O(^SHP(IS)) Q:IS="" W ?4,IS," " W:$D(^(IS))#10 ^(IS) W ! C %IOD Q R10 U 0 S IS="" F K=1:1:20 S IS=$O(^SHP(IS)) Q:IS="" W !?4,IS," " W:$D(^(IS))#10 ^(IS) G R10+4:IS="" R !!,"EXIT '^' / NEXT ",VK G R10+4:VK="^",R10+1:VK="" I $D(%IOD),%IOD C %IOD K %IOD O 0 U 0 Q PR2 S %QTY=2,%DEF="3" D %IOS Q:'$D(%IOD) I '%IOD D VIEW Q KL U 0 W !!," EXEMPLAR :" S CIST="0123456789",%LS=3,%S=1 D ^%ZMSL Q:%TO="END" S K1=%S S:K1="" K1=1 W "1...5....1....5....2....5....3....5....4....5....5....5....6....5....7....5....8" W:%IOD["1" "....5....9....5....0....5....1....5....2....5....3" F I=1:1:K1 S %IO=%IOD U @%IOD W !,KOD,?12,NAM,!! D %S288 R:'%IOD !!,"<>",Y W # I $D(%IOD),%IOD C %IOD K %IOD O 0 U 0 Q %IOS U 0 W !!,"DEVICE (0,3) >" S CIST="03",%LS=1,%S="" S:$D(%DEF) %S=%DEF D ^%ZMSL Q:%S="" S %IOD=%S K %S O %IOD Q %S288 D ^%L1TS F I=1:1 Q:'$D(^SHP(KOD,I)) W $S($G(%IOD):$TR(^(I),TS0,TSS),1:^(I)),! Q RSHP K ^S000($P) F I=1:1 Q:'$D(^SHP(KOD,I)) D:'+$G(^SHP(KOD,I,"%TOP")) S ^S000($P,I)=^SHP(KOD,I),^S000($P,I,"%TOP")=$G(^SHP(KOD,I,"%TOP")) .S SS=^SHP(KOD,I) F II=1:1:$L(SS) Q:$E(SS,II)'=" " .S ^SHP(KOD,I,"%TOP")=II-($E(SS,II)'=" ") Q ZCOD I $G(HEAD)'="" S %SAY=HEAD X %XMSGV I '$L($G(KOD)) S KOD=$G(^SHP) S %GET="HEADER'S CODE:++4,10,EE#"_$G(KOD)_"++10,E,I++++++^SHP\\\\"_VP D ^%L1GET I %S=""!($G(%TO)="END") S KOD="" Q S KOD=%S S NAM=$S($D(^SHP(KOD))#10:^SHP(KOD),1:"") Q VIEW ; K ^TMPS111($J) F I=1:1 Q:'$D(^SHP(KOD,I)) S ^TMPS111($J,I)=^SHP(KOD,I) K R,L,U S TXT=" EXIT - " S:%XMSG(0)'>1 %HBRY="" D ^%S2VIEW K ^TMPS111($J) Q %S2ASK %S2ASK ; ;%Q("Z") - ASK,%Q("U") - DEFAULT.,%Q("V")-POSSIBLE POINT ;- YES=1 - YES,0 - NO [ 15.03.19 07:08 ] [ 01.03.04 10:26 ] [ 09.02.04 13:44 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%Q,YES) D ^%L1C BG I $D(%Q(1)) S %GET(1)="" I %ENGLISH,$D(%Q("U")) S:%Q("U")="l" %Q("U")="N" S:%Q("U")="k" %Q("U")="Y" I %ENGLISH G ^%S1ASK N %ECHO,%HBRY S %HBRY="" S YES="E" U 0 I $D(%Q("U"))#2,%Q("U")'="l",%Q("U")'="k" W *7,!,"*** %S2ASK .ERROR IN PARAMETR'S VALUES: %Q(""U"")=",%Q("U") G END I '($D(%Q("Z"))#2) W !,"*** %S2ASK . ISN'T (%Q(""Z"")) !" G END I $$HZGTOUCH^%L2MOUSE D G END .N %GET S %GET("IS")=$TR(%Q("Z"),"{}","") .I $D(%Q("U")) S %GET("DEF")=$S(%Q("U")="l":1,1:2) .D IS^%L1GET I '$D(%Q("X"))!'$D(%Q("Y")) G N ;W *7,!,"*** %S2ASK .UNFEFINED COORDINATS" G END I $D(%Q("X")),$D(%Q("Y")),$D(%Q("C")) S %XX=0,%YY=%Q("Y") X %POSIC W %chists I $D(%Q("X")),$D(%Q("Y")) S %XX=%Q("X"),%YY=%Q("Y") X %POSIC W $$^%L1HBR("? (l\k) "_%Q("Z")) S %XX=%XX-2,$X=%XX,$Y=%YY S %S=$G(%Q("U")) S CIST="klFK",%LS=1,%INV="" D ^%L1ZMS K %INV S YES=%S I $D(%Q("V")) I YES="."&($D(%Q("U")))!(YES=""&('$D(%Q("U")))) S YES="." G END I $D(%Q("B")) I YES="."!(YES="^") G END I YES="k"!(YES="F") S YES=1 G END I YES="l"!(YES="K") S YES=0 G END I YES="" G:'($D(%Q("U"))#2) ER S YES=$S(%Q("U")="k":1,1:0) G END I YES="?" G:$D(%Q("H"))>9 INSTR W !?30,"HASN'T HELP !" G %S2ASK G ER END X %XCL Q ;- ;;ER W *8,*8,$S($A(YES)<97&($A(YES)>64):$TR($TR(" ugl",%TES1,%TES2),%TEN,%THB),1:"")_$TR($TR(" *** d`iby",%TES1,%TES2),%TEN,%THB),%chists H 1 W *13,%chists G %S2ASK ER W *8,*8,$S($A(YES)<97&($A(YES)>64):$$W^%L1C(" ugl"),1:"")_$$W^%L1C(" *** d`iby"),%chists H 1 W *13,%chists G %S2ASK ;- INSTR S PROGR=%Q("H") I PROGR["^W" D @PROGR G %S2ASK K PROGR W ! F %J=1:1 Q:'$D(%Q("H",%J)) W !?3,%Q("H",%J) G %S2ASK N N Q,L S Q=$$RPL^%L1FRM(%Q("Z"),%LIGHT1,"") S Q=$$RPL^%L1FRM(%Q("Z"),%CLI,"") S Q=$$RPL^%L1FRM(%Q("Z"),%CCL,"") S L=$L(Q)-2 S %Q("X")=80-L\2 S %Q("Y")=24,%Q("C")="" G %S2ASK %S2BST %S2BST ; [ 04/13/92 11:51 AM ] S:'$D(%MBS("B")) %MBS("B")=0 S:%MBS("B")>15 %MBS("B")=15 S %MBS("F")=0 S:'$D(%MBS("DZ")) %MBS("DZ")=30 S %30V=%MBS("DZ") S %SH=0,%RST=20-%MBS("B") ;,$ZS="ER^%S2BST" ; D:'$D(%LEVO) ^%L1C G VIV ZAPR ; W !,$E(%MBS("Z",%SH),1,%30V-1),?%30V,":" S:'$D(%MBS("O",%SH)) %MBS("O",%SH)="" X %XCL W %MBS("O",%SH) X %XCL Q OBRVV ; D BEGS R *%C I %C=27 R *%C1:0,*%D:0 I %D>0 D VVERX:%D=%VVERX,VNIZ:%D=%VNIZ,VVOD:%D'=%VNIZ&(%D'=%VVERX) Q VVOD S %S=%MBS("O",%SH),%FLL=1 K CIST,%LS I %C>31&(%C<127) S %S=$C(%C)_$E(%MBS("O",%SH),2,$L(%MBS("O",%SH))) S:$D(%MBS("D",%SH,1))#10 %LS=%MBS("D",%SH,1) S:$D(%MBS("S",%SH))#10 CIST=%MBS("S",%SH) I %C=13 S %FLL=0 G CONTR I $D(CIST)&(%C>31)&(%C<160) G:(CIST'[$C(%C)) OBRVV VIZ ; S %PRVX=0 S:'$D(%S) %S="" S %I=$L(%S)+1 I '$D(%LS) S %LS=255 S:'$D(%FLL) %FLL=0 S %BEG=1 W %S D BEGS S %I=1 CYC S:'%BEG %FLL=0 S %L=$L(%S) S %A=$S(%I>%L:" ",1:$E(%S,%I)) R:'%FLL *%C S %BEG=0 G:%C=27 SERV S %FLL=0 G TAB:%C=2,TAB:%C=9,FIN:%C=13,IC:%C=23,DC:%C=8!(%C=127),SYM:%C>31&(%C<127),CYC SYM I $D(CIST)'=0 I '(CIST[$C(%C)) W *7 G CYC G:%I>%LS CYC W *%C S %S=$E(%S,1,%I-1)_$C(%C)_$E(%S,%I+1,%L),%I=%I+1 G CYC FIN D KOH+1 G CONTR SERV R *%C1:0,*%D:0 I %D>0 S %FLL=0 G DC:%D=216 G LEFT:%D=%LEVO,RIGHT:%D=%PRAVO,UP:%D=%VVERX,DOWN:%D=%VNIZ,ERL:%D=%CHISTS,CYC RIGHT G:%I>%LS CYC W %pravo S %S=$E(%S,1,%I-1)_%A_$E(%S,%I+1,%L),%I=%I+1 G CYC LEFT G:%I=1 CYC W %levo S %I=%I-1 G CYC IC G:%L=%LS CYC S %S=$E(%S,1,%I-1)_" "_$E(%S,%I,%L) W $E(%S,%I,%L+1) X "F %NP=1:1:(%L+2-%I) W %levo" G CYC DC I %I'>%L S %S=$E(%S,1,%I-1)_$E(%S,%I+1,%L) W $E(%S,%I,%L-1)_" " X "F %NP=1:1:%L-%I+1 W %levo" G CYC G:%L=0 CYC S %S=$E(%S,1,%I-2),%I=%I-1 W %levo," ",%levo G CYC ERL G:%I>%L CYC S %S=$E(%S,1,%I-1) W $J("",%L-%I+1) X "F %NP=1:1:%L-%I+1 W %levo" G CYC KOH D KOH+1 G CYC X "F %NP=1:1:$L(%S)+1-%I W %pravo" S %I=$L(%S)+1 Q TAB S %J=%I-(%C=2*2)\10+(%C=9)*10+1 S:%J>%L %J=%L+1 S:%J<1 %J=1 X:%J>%I "F %NP=1:1:%J-%I W %pravo" X:%J<%I "F %NP=1:1:%I-%J W %levo" S %I=%J G CYC UP G:%I=1 CYC S %J=%I-80 S:%J<1 %J=1 G TAB+1 DOWN G:%I>%L CYC S %J=%I+80 S:%J>%L %J=%L+1 G TAB+1 ;- CONTR ; I %S=".",$D(%MBS(".")) S %TXT="DO YOU MASN'T ENTER DOT !" D SOOB,BEGS G VIZ I %S="."!(%S="&") S %MBS("O",%SH)="",%SH=%SH+%KOLS+1-%SCH,%SCH=%KOLS+1 G ENDC S %SOLD=%S I $D(%MBS("D",%SH,2)) I ($L(%S)<%LS)&(%MBS("D",%SH,2)=1) S %TXT="*** FORMAT !" D SOOB,BEGS G VIZ S %MC=$S($D(%MBS("C",%SH))#2:%MBS("C",%SH),$D(%MBS("C"))#2:%MBS("C"),1:"") I %MC'=""&(%S'="&") X "S %FLOSH=0,%TXT="""" "_%MC I %FLOSH D SOOB,BEGS K %MC G VIZ S %MBS("O",%SH)=%S S %MP=$S($D(%MBS("P",%SH))#2:%MBS("P",%SH),$D(%MBS("P"))#2:%MBS("P"),1:"") I %MP'="",%S'="&" X "S %FLOSH=0 S %XX=0,%YY=%MBS(""B"") X %POSIC x %chiste D @%MP" S:'$D(%SCH) %SCH=0 S %SH1=%SH,%SCH1=%SCH,%SH=%SH-%SCH D P S %SH=%SH1,%SCH=%SCH1,%MP="" K %SH1,%SCH1 D BEGS S %SH=%SH+1,%SCH=%SCH+1 ENDC S:%S="&" %MBS("F")=1 K %FLL,%BEG,%I,%NP,%MC,%MP,%L,%C,%D,%LS,%J Q ; ********************************** . ********* ;- VIV ; D P S %SH=%SH-%SCH+1,%SCH=1 I $D(%MBS("LOOK")) G ZR CVV ; D OBRVV G CVV:%SCH'>%KOLS I %MBS("F") K %MBS("O") G END ZR S %XX=0,%YY=21 X %POSIC I '$D(%MBS("LOOK")) W "MODIFY - 1,"_$S($D(%MBS("O",%SH-%RST-1)):"PREVIOS SCREEN - 2 ,",1:"")_$S('%PRFIN:"NEXT SCREEN",1:"TERMINATE")_" INPUT - " X %XCL W %chists U $P:(ECHO:WRAP) R %REG X %XCL E R "PRESS ",Y S %REG="" S %SH=%SH+%KOLS+1-%SCH,%SCH=%KOLS+1 I %REG="" G:%PRFIN END S %SH=%SH-1 G VIV I %REG=2&($D(%MBS("Z",%SH-%RST-1))) S %SH=%SH-1.1\%RST-1*%RST G VIV I %REG'=1 W *7,%vverx x %chiste G ZR S %SH=%SH-%SCH+1,%SCH=1 ; W %vverx x %chiste w !,%vverxE,%vniz D BEGS G CVV D BEGS G CVV END S %XX=0,%YY=23 X %POSIC K %SH,%SCH,CIST,%FLL,%LS,%C,%D,%REG,%KOLS,%I,%I1,%J,%30V K %XX,%YY X %XCL U $P:(ECHO:WRAP:WIDTH=80) Q ; ******************** VVERX ; I %SCH>1 W %vverx S %SCH=%SCH-1,%SH=%SH-1 Q VNIZ ; W %vniz S %SCH=%SCH+1,%SH=%SH+1 Q BEGS ; S %XX=%30V+1,%YY=%SCH+%MBS("B") X %POSIC Q SOOB W %vverxe,%chists S %XX=10,%YY=0 X %POSIC W %TXT,%chists H 3 W *13,%chists Q SOOB1 W %vverxe,%chists S %XX=10,%YY=0 X %POSIC W %TXT,%chists X %XCL Q ER S %TXT="*** ERROR IN CHECK COMMAND ! " K %MBS("C") D SOOB,BEGS S $ZS="ER^%S2BST" G VIV Q P ; I $D(%MBS("N")) S %TXT=%MBS("N") D SOOB1 S:%MBS("B")=0 %MBS("B")=1 S %XX=0,%YY=%MBS("B") X %POSIC X %chiste F %SCH=1:1:%RST S %SH=%SH+1 Q:'$D(%MBS("Z",%SH)) D ZAPR S %KOLS=%SCH-'$D(%MBS("Z",%SH)) S %PRFIN='$D(%MBS("Z",%SH+1)) Q %S2DBV %S2DBV %S2ERG %S2ERG S %S2ERG="" ; [ 11.03.25 12:11 ] [ 29.12.23 10:03 ] [ 28.12.23 19:28 ] BEG S $ZE="ERRRR^%S2ERG" S %GWUL=78 K %HBRY W %ENG I $G(^ERGDOS) S %ergdos=1 E S %ergdos=0 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" K U1,Y1 S:'$D(%FLV) %FLV=1 S:'$D(%FLI) %FLI=0 S SDV=60,%FHBR=0 S:'$D(%TIP) %TIP="R" W %vverxe,%chists M11 S:'$G(U) U=1 S:'$D(^S000($P,U)) ^S000($P,U)="" S:'$D(L) L=0 S:'$D(R) R=L+%GWUL S:'$D(%FLC) %FLC=0 M12 W *27,"[1;24r" D:$D(TXT) STR1 S %X=0,%Y=1,RL=1+R-L,%K=L U $P:(NOECHO:NOWRAP:ESCAPE) D P M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 S %K=L+%X K U1,Y1,X1 M2 I '$D(^S000($P,U)) S ^(U)="" S %SS=^(U) U $P:(NOECHO:NOWRAP:ESCAPE) ;;S %SAY=" HELP - + " X %XMSGN 3 U $P:(NOECHO:NOWRAP:ESCAPE) W:%FLI %vverxe,%LIGHT1,%CV("RF"),"+",U,":",$L(^S000($P,U)),":",%K+1,":",%Y,":",%X+1," " X %XCL ;,%chists S %YY=%Y,%XX=%X X %POSIC READ D ^%L1MSGBR I '$D(^S000($P,U)) S ^(U)="" U $P:(NOECHO:NOWRAP:ESCAPE) R *C:1 E G READ S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC COM I $D(%UPRCOD(C)) G @%UPRCOD(C) K %NOVSV I C=215 K %HBRY S %FHBR=0 R *D:1 W $C(C,D) S C=D-48,%NOVSV=1 G READ0 I C>223,C<251 S C=C-128 I '$$ERGDOS,C<127,C>31,'%FLV G READ1 ; *** 28/12/23 I $$ERGDOS,C>31,'%FLV G READ1 ; *** 28.12.23 G ERCOM:C<32&(C-31)&(C-29) READ0 I %FLV G:%K'<$L(^(U))!($L(^(U))=400) READ1 S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,400) D V S %XX=%X,%YY=%Y X %POSIC READ1 S ^(U)=$E(^(U),1,%K)_$$SMB(C)_$E(^(U),%K+2,400) D .Q:$G(%NOVSV) .;;I $D(%HBRY),C=44 W $C(250) Q .W $$WC($C(C),"I") K %NOVSV G:%FHBR 3 ; PRAVO I %X<(RL-1) S %K=%K+1,%X=%X+1 G 3 S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=1 D P G M13 MET G ^%S2ERG01 ; MDRG ; G HBR 27 ; ESC S %XX=20,%YY=23 X %POSIC W ! X %XCL U $P:(ECHO:WRAP) K %S2ERG,%LABOLD Q INS S TXT="INSERT" D STR1 I '%FLV S %FLV=1,%GTV="" H 1 G 3 I %FLV S %FLV=0 K %GTV S TXT="OVERLAY" D STR1 H 1 G 3 HBR I '$D(%HBRY) S %HBRY="" S TXT="HEBREW TEXT" D STR1 S %HBRY="",%FHBR=1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 S %FHBR=0 K %HBRY S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 G M12 HELP ; X "ZL %S2ERGH K ^TMPS111($J) N I,J,T,TH S J=0 F I=2:1 Q:$T(+I)="""" S T=$T(+I),TH=$E(T,2,4) S:TH=""\R\""!(TH=""\G\"") T="" ""_$P(T,TH,2,20) I TH'=""\R\""&(TH'=""\G\"")!(TH=(""\""_%TIP_""\"")) S J=J+1,^TMPS111($J,J)=T" D G BEG .S %SAY=" EXIT FROM HELP - " X %XMSGN .N L S L=0 D ^%S2VIEW X %XCL 2 G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 MOD G 5^%S2ERG02 FIND G 6^%S2ERG02 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^(I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 SMB(C) ; N SMB I $D(%HBRY) D Q SMB .I $$ERGDOS D Q ..I C<96!(C>122),C'=44,C'=46 S SMB=$C(C) Q ; *** 28/12/23 ..I C=44 S SMB=$C(154) Q ; *** ..I C=46 S SMB=$C(149) Q ; *** ..S SMB=$TR($C(C),%TES2,%TES1) ; *** ..S SMB=$C($A(SMB)+32) ; *** . .; -- OLD -- .I C=46 S SMB=$C(117) Q .S SMB=$TR($C(C),%TES2,%TES1) ; Q $C(C) ; ; W(U) ; ;W %LIGHT1,%CV("CF") N ST,STO,STH S ST=$G(^S000($P,U)),%FLC=0,STH="" D W1(ST) Q ; W1(ST) ; I '$D(L) S L=0 I '$D(R) S R=79 I '$D(%HBRY) S STO=$E(ST,L+1,R+1) G WE ; D Q ;I %TYPCRT["PC" D Q ;; -- ZOC ! .S STO=$E(ST,L+1,R+1) .N JJ F JJ=1:1:$L(STO) D ..N SMB S SMB=$E(STO,JJ) ..W $$WC(SMB,1) Q ; I '$D(TSS) D ^%L1TS S STO=$TR($E(ST,L+1,R+1),TS0,$S($G(%XMSG(0))<1:TSS,1:TS1)) G WE WE I '$D(%W1JSP) W STO Q N JJ F JJ=1:1:$L(STO) W $$WC($E(STO,JJ)) Q ; WH ; N JJ F JJ=1:1:$L(STH) D .N SMB S SMB=$E(STH,JJ) .I ($A(SMB)<96)!($A(SMB)>122) W SMB Q .I $G(^ERGDOS) W $C($A(SMB)+32) Q .W $C(215,$A(SMB)+48) S STH="" Q ; WC(%A,%PR) ; I '$$ERGDOS,$D(%HBRY),$A(%A)=44,$G(%PR)="I" Q $C(250) ; *** OLD 28.12.23 I '$$ERGDOS I $D(%HBRY),$A(%A)=46,$G(%PR)="I" Q $C(245) ; *** OLD I $$ERGDOS,$D(%HBRY),$A(%A)=44,'$G(%PR) Q $C(154) ; *** NEW I $$ERGDOS,$D(%HBRY),$A(%A)=46,'$G(%PR) Q $C(149) ; *** NEW ; I $A(%A)>95,$A(%A)<123 D .I $D(%HBRY) D ..I $$ERGDOS D Q ...I '$G(%PR) S %A=$TR(%A,%TES2,%TES1) ; *** NEW ...S %A=$C($A(%A)+32) ; *** NEW .. ..I $G(%PR) S %A=$C($A(%A)+128) Q ..S %A=$C($A($TR(%A,%TES2,%TES1))+128) Q %A ; ; 801 F JJ=0:0 S J=$F(^(I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FOUND" D STR1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12^%S2ERG 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'330 S C=%K-%X,%K=%K\10+1*10,%X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=1 D P S %X=R-L,%K=R G M13 ENDS S S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G 3 ENDL S S=$L(^(U)) G:S>" S %S=^(U),%6=20 ;%L2STR D ^%L1WE S ^(U)=%S K %S,%6 I %Y>18 S U1=U,U=U-%Y+1,Y1=%Y S:U<1 U=1 G M12 D P G 3 PGLN G 3:'L D SLEVO G M12 BK S %K=L,%X=0 G VNIZ HOME I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G 3 PGUP G 3:U'>%Y S U=U-%Y-19 S:U'>0 U=1 G M12 PGRG G 3:L>295 D SPRAVO G M12 SPRAVO S L=L+SDV,U1=U,Y1=%Y,U=U-%Y+1,R=R+SDV Q REST S %PROG="^%S2ERG" D 18^%S2ERG03 G 3 VNIZE W %vverxe F I=1:1:23 Q:'$D(^(U-%Y+I)) W %vniz S:'$D(^(U-%Y+I)) I=I-1 S U=U-%Y+I,%Y=I,%K=L,%X=0 G M2 DELL X "F I=U:1 Q:'$D(^(I+1)) S ^(I)=^(I+1)" K ^(I) S %X=0,%K=L D P G M2 ADDL G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 ADD G:%K'<$L(^(U))!($L(^(U))=400) READ S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,400) D V G 3 PGDN G 3:'$D(^(U-%Y+21)) S U=U-%Y+21 G BEG+2 .S %LABOLD($O(%LABOLD(""),-1)+1)=U 24 S $ZE="" X %chista S %ZT=$ZT S ^ZE($P,"%ERG")=%TIP D ^%L1X 241 K ^ZE($P,"%ERG") G:$ZE=""!($ZV'["2.0") BEG X:%TIP="R" ^%ERG(1) Q ; G BEG ER24 W !,$ZS D ^%L1C S %PR="" G 24+1 XEC G 24 SAVE S %PROG="^%S2ERG" D 26^%S2ERG03 G 3 KOD F J=1:1:$L(^(U)) S %SMB=$E(^(U),J) I $A(%SMB)<123,$A(%SMB)>96 S $E(^(U),J)=$C($A(%SMB)-32) S SDV=0 D SLEVO S SDV=60 G M12 096 G KOD VVERX G:%Y=1 VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ S U=U+1,%Y=%Y+1 G MAINA:%Y>22,M2 LEVO G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 G M12 SLEVO S R=R-$S(L>SDV:SDV,1:L),L=$S(L>SDV:L-SDV,1:0) S U1=U,U=U-%Y+1,Y1=%Y Q SBROS G:^(U)=%SS BK S ^(U)=%SS D V G BK V S %YY=%Y,%XX=0 X %POSIC W %chists D W(U) Q VVERXE S %K=L,U=U-%Y+1,%X=0,%Y=1 G M2 ENDF D DELAY R *%A:%WAIT D DELAY R *%A:%WAIT F I=U+1:1 Q:'$D(^(I)) S U=I-20 S:U<1 U=1 S L=0 G M11 BEGF S U=1,L=0 G M11 CHISTS S ^(U)=$E(^S000($P,U),1,%K) W %chists G 3 CHISTE F I=U:-1:1 Q:$E(^(I),1)'=" "&($E(^(I),1)'="") S %LAB=$P(^(I)," ",1) ZGE S TXT=" NUMBER ERASE LINE,BEGIN "_%LAB D STR1 K TXT W:U-I'=0 "+",U-I W " " U $P:(ECHO:WRAP) R %COLUD U $P:(NOECHO:NOWRAP:ESCAPE) G:%COLUD=0 3 UD I %COLUD="" S ^(U)=$E(^(U),1,%K) D V X %chiste F I=U+1:1 G:'$D(^(I)) 3 K ^(I) I %COLUD'?1N.N W *7," *** ERROR !" H 2 G ZGE I '$D(^(U+%COLUD)) S %COLUD="" G UD F I=U:1 Q:'$D(^(I+%COLUD)) S ^(I)=^(I+%COLUD) K ^(I+%COLUD) F I1=I:1 Q:'$D(^(I1)) K ^(I1) S %X=0,%K=L D P G M2 DEL G:%K>$L(^(U)) READ G:%K=$L(^(U)) 1271 S ^(U)=$E(^(U),1,%K)_$E(^(U),%K+2,400) D V G 3 1271 G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 S ^(U)=$E(^(U),1,%K) D V G 3 P S %YY=%Y,%XX=0 X %POSIC X %chiste I $O(^S000($P,1)) F I=0:1:23-%Y Q:'$D(^(I+U)) D .S %YY=I+%Y,%XX=0 X %POSIC D W(I+U) X %XCL W %chists D STR1 Q ;W %vverxe,%chists Q MAINA S:'$D(^(U)) ^(U)="" I $D(^S000($P,1)) W $C(27),"E" D W(U) W %vverxe,%chists S %Y=23 G M2 VIRA R ! S U=U-1 D VIR:'U,P:%Y=1 S:%Y>1 %Y=%Y-1 G:$L($G(^(U))) M2 ;S:C=164 S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G M2 S S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G M2 VIR F I=U+1:1 Q:'$D(^(I)) X "F I=I:-1:U+2 S ^(I)=^(I-1)" S U=U+1,^(U)="" Q VIR1 F I=1:1 Q:'$D(^(I)) X "F I=I+%COLVS-1:-1:U+%COLVS+1 S ^(I)=^(I-%COLVS)" X "F I=U+1:1:U+%COLVS S ^(I)=""""" S U=U+1 Q ERXEC W !,"ERROR = ",$ZE S $ZE=%ZE G 24+1 ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 Q:'$D(TXT) W %vverxe,%chists S %YY=0,%XX=16 X %POSIC D WT^%S2ERG02("YF",TXT) K:'$D(TXT(1)) TXT X %XCL Q FINDS K %SIMB S TXT="SEARCH KEY NOW . ENTER STRING FOR SEARCH :" D STR1 U $P:(ECHO:WRAP) R %SIMB U $P:(NOECHO:NOWRAP:ESCAPE) I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ??? "_$P($ZE,">")_">",!! K X ^%ERG K %S2ERG Q ERRRR D ^%L1C S %XX=0,%YY=23 X %POSIC W %chists,*7,"ERROR:",$ZE,! I $ZE["PGMOV" K W " NAME ROUTINE :$" K %S2ERG Q DELAY F %IJK=1:1:10000 Q ; ERGDOS() ; Q $G(%ergdos) %S2ERG0 %S2ERG S %S2ERG="" ; [ 29.12.23 09:51 ] [ 28.12.23 19:28 ] [ 13.12.20 14:27 ] BEG S $ZE="ERRRR^%S2ERG" S %GWUL=78 K %HBRY W %ENG I $G(^ERGDOS) S $ZDATA("ERGDOS")=1 E S $ZDATA("ERGDOS")=0 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" K U1,Y1 S:'$D(%FLV) %FLV=1 S:'$D(%FLI) %FLI=0 S SDV=60,%FHBR=0 S:'$D(%TIP) %TIP="R" W %vverxe,%chists M11 S:'$G(U) U=1 S:'$D(^S000($P,U)) ^S000($P,U)="" S:'$D(L) L=0 S:'$D(R) R=L+%GWUL S:'$D(%FLC) %FLC=0 M12 W *27,"[1;24r" D:$D(TXT) STR1 S %X=0,%Y=1,RL=1+R-L,%K=L U $P:(NOECHO:NOWRAP:ESCAPE) D P M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 S %K=L+%X K U1,Y1,X1 M2 I '$D(^S000($P,U)) S ^(U)="" S %SS=^(U) U $P:(NOECHO:NOWRAP:ESCAPE) ;;S %SAY=" HELP - + " X %XMSGN 3 U $P:(NOECHO:NOWRAP:ESCAPE) W:%FLI %vverxe,%LIGHT1,%CV("RF"),"+",U,":",$L(^S000($P,U)),":",%K+1,":",%Y,":",%X+1," " X %XCL ;,%chists S %YY=%Y,%XX=%X X %POSIC READ D ^%L1MSGBR I '$D(^S000($P,U)) S ^(U)="" U $P:(NOECHO:NOWRAP:ESCAPE) R *C:1 E G READ S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC COM I $D(%UPRCOD(C)) G @%UPRCOD(C) K %NOVSV I C=215 K %HBRY S %FHBR=0 R *D:1 W $C(C,D) S C=D-48,%NOVSV=1 G READ0 I C>223,C<251 S C=C-128 I '$$ERGDOS,C<127,C>31,'%FLV G READ1 ; *** 28/12/23 I $$ERGDOS,C>31,'%FLV G READ1 ; *** 28.12.23 G ERCOM:C<32&(C-31)&(C-29) READ0 I %FLV G:%K'<$L(^(U))!($L(^(U))=400) READ1 S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,400) D V S %XX=%X,%YY=%Y X %POSIC READ1 S ^(U)=$E(^(U),1,%K)_$$SMB(C)_$E(^(U),%K+2,400) D .Q:$G(%NOVSV) .;;I $D(%HBRY),C=44 W $C(250) Q .W $$WC($C(C),"I") K %NOVSV G:%FHBR 3 ; PRAVO I %X<(RL-1) S %K=%K+1,%X=%X+1 G 3 S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=1 D P G M13 MET G ^%S2ERG01 ; MDRG ; G HBR 27 ; ESC S %XX=20,%YY=23 X %POSIC W ! X %XCL U $P:(ECHO:WRAP) K %S2ERG,%LABOLD Q INS S TXT="INSERT" D STR1 I '%FLV S %FLV=1,%GTV="" H 1 G 3 I %FLV S %FLV=0 K %GTV S TXT="OVERLAY" D STR1 H 1 G 3 HBR I '$D(%HBRY) S %HBRY="" S TXT="HEBREW TEXT" D STR1 S %HBRY="",%FHBR=1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 S %FHBR=0 K %HBRY S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 G M12 HELP ; X "ZL %S2ERGH K ^TMPS111($J) N I,J,T,TH S J=0 F I=2:1 Q:$T(+I)="""" S T=$T(+I),TH=$E(T,2,4) S:TH=""\R\""!(TH=""\G\"") T="" ""_$P(T,TH,2,20) I TH'=""\R\""&(TH'=""\G\"")!(TH=(""\""_%TIP_""\"")) S J=J+1,^TMPS111($J,J)=T" D G BEG .S %SAY=" EXIT FROM HELP - " X %XMSGN .N L S L=0 D ^%S2VIEW X %XCL 2 G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 MOD G 5^%S2ERG02 FIND G 6^%S2ERG02 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^(I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 SMB(C) ; N SMB I $D(%HBRY) D Q SMB .I $$ERGDOS D Q ..I C<96!(C>122),C'=44,C'=46 S SMB=$C(C) Q ; *** 28/12/23 ..I C=44 S SMB=$C(154) Q ; *** ..I C=46 S SMB=$C(149) Q ; *** ..S SMB=$TR($C(C),%TES2,%TES1) ; *** ..S SMB=$C($A(SMB)+32) ; *** . .; -- OLD -- .I C=46 S SMB=$C(117) Q .S SMB=$TR($C(C),%TES2,%TES1) ; Q $C(C) ; ; W(U) ; ;W %LIGHT1,%CV("CF") N ST,STO,STH S ST=$G(^S000($P,U)),%FLC=0,STH="" D W1(ST) Q ; W1(ST) ; I '$D(L) S L=0 I '$D(R) S R=79 I '$D(%HBRY) S STO=$E(ST,L+1,R+1) G WE ; D Q ;I %TYPCRT["PC" D Q ;; -- ZOC ! .S STO=$E(ST,L+1,R+1) .N JJ F JJ=1:1:$L(STO) D ..N SMB S SMB=$E(STO,JJ) ..W $$WC(SMB,1) Q ; I '$D(TSS) D ^%L1TS S STO=$TR($E(ST,L+1,R+1),TS0,$S($G(%XMSG(0))<1:TSS,1:TS1)) G WE WE I '$D(%W1JSP) W STO Q N JJ F JJ=1:1:$L(STO) W $$WC($E(STO,JJ)) Q ; WH ; N JJ F JJ=1:1:$L(STH) D .N SMB S SMB=$E(STH,JJ) .I ($A(SMB)<96)!($A(SMB)>122) W SMB Q .I $G(^ERGDOS) W $C($A(SMB)+32) Q .W $C(215,$A(SMB)+48) S STH="" Q ; WC(%A,%PR) ; I '$$ERGDOS,$D(%HBRY),$A(%A)=44,$G(%PR)="I" Q $C(250) ; *** OLD 28.12.23 I '$$ERGDOS I $D(%HBRY),$A(%A)=46,$G(%PR)="I" Q $C(245) ; *** OLD I $$ERGDOS,$D(%HBRY),$A(%A)=44,'$G(%PR) Q $C(154) ; *** NEW I $$ERGDOS,$D(%HBRY),$A(%A)=46,'$G(%PR) Q $C(149) ; *** NEW ; I $A(%A)>95,$A(%A)<123 D .I $D(%HBRY) D ..I $$ERGDOS D Q ...I '$G(%PR) S %A=$TR(%A,%TES2,%TES1) ; *** NEW ...S %A=$C($A(%A)+32) ; *** NEW .. ..I $G(%PR) S %A=$C($A(%A)+128) Q ..S %A=$C($A($TR(%A,%TES2,%TES1))+128) Q %A ; WC0(%A,%PR) ; I $A(%A)>95,$A(%A)<123,$D(%HBRY) D .I $G(%PR) S %A=$C($A(%A)+128) Q .S %A=$C($A($TR(%A,%TES2,%TES1))+128) I %A="<"!(%A=">")!(%A=":")!(%A="/")!(%A="!")!(%A="&")!(%A="_") W %LIGHT1,%CV("CF"),%A,%CCL G WCE I $G(%FLC)!(%A="""") W %LIGHT1,%CV("CF"),%A,%CCL G WCE I %A=")"!(%A="(")!(%A="[")!(%A="]") W %LIGHT1,%CV("CF"),%A,%CCL G WCE I %A="," W %LIGHT1,%CV("CF"),%A,%CCL G WCE I %A="=" W %LIGHT1,%CV("CF"),%A,%CCL G WCE I %A="'" W %LIGHT1,%CV("YF"),%A,%CCL G WCE W %A WCE Q "" ; 801 F JJ=0:0 S J=$F(^(I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FOUND" D STR1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12^%S2ERG 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'330 S C=%K-%X,%K=%K\10+1*10,%X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=1 D P S %X=R-L,%K=R G M13 ENDS S S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G 3 ENDL S S=$L(^(U)) G:S>" S %S=^(U),%6=20 ;%L2STR D ^%L1WE S ^(U)=%S K %S,%6 I %Y>18 S U1=U,U=U-%Y+1,Y1=%Y S:U<1 U=1 G M12 D P G 3 PGLN G 3:'L D SLEVO G M12 BK S %K=L,%X=0 G VNIZ HOME I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G 3 PGUP G 3:U'>%Y S U=U-%Y-19 S:U'>0 U=1 G M12 .S %LABOLD($O(%LABOLD(""),-1)+1)=U PGRG G 3:L>295 D SPRAVO G M12 SPRAVO S L=L+SDV,U1=U,Y1=%Y,U=U-%Y+1,R=R+SDV Q REST S %PROG="^%S2ERG" D 18^%S2ERG03 G 3 VNIZE W %vverxe F I=1:1:23 Q:'$D(^(U-%Y+I)) W %vniz S:'$D(^(U-%Y+I)) I=I-1 S U=U-%Y+I,%Y=I,%K=L,%X=0 G M2 DELL X "F I=U:1 Q:'$D(^(I+1)) S ^(I)=^(I+1)" K ^(I) S %X=0,%K=L D P G M2 ADDL G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 ADD G:%K'<$L(^(U))!($L(^(U))=400) READ S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,400) D V G 3 PGDN G 3:'$D(^(U-%Y+21)) S U=U-%Y+21 G BEG+2 .S %LABOLD($O(%LABOLD(""),-1)+1)=U 24 S $ZE="" X %chista S %ZT=$ZT S ^ZE($P,"%ERG")=%TIP D ^%L1X 241 K ^ZE($P,"%ERG") G:$ZE=""!($ZV'["2.0") BEG X:%TIP="R" ^%ERG(1) Q ; G BEG ER24 W !,$ZS D ^%L1C S %PR="" G 24+1 XEC G 24 SAVE S %PROG="^%S2ERG" D 26^%S2ERG03 G 3 KOD F J=1:1:$L(^(U)) S %SMB=$E(^(U),J) I $A(%SMB)<123,$A(%SMB)>96 S $E(^(U),J)=$C($A(%SMB)-32) S SDV=0 D SLEVO S SDV=60 G M12 096 G KOD VVERX G:%Y=1 VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ S U=U+1,%Y=%Y+1 G MAINA:%Y>22,M2 LEVO G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 G M12 SLEVO S R=R-$S(L>SDV:SDV,1:L),L=$S(L>SDV:L-SDV,1:0) S U1=U,U=U-%Y+1,Y1=%Y Q SBROS G:^(U)=%SS BK S ^(U)=%SS D V G BK V S %YY=%Y,%XX=0 X %POSIC W %chists D W(U) Q VVERXE S %K=L,U=U-%Y+1,%X=0,%Y=1 G M2 ENDF D DELAY R *%A:%WAIT D DELAY R *%A:%WAIT F I=U+1:1 Q:'$D(^(I)) S U=I-20 S:U<1 U=1 S L=0 G M11 BEGF S U=1,L=0 G M11 CHISTS S ^(U)=$E(^S000($P,U),1,%K) W %chists G 3 CHISTE F I=U:-1:1 Q:$E(^(I),1)'=" "&($E(^(I),1)'="") S %LAB=$P(^(I)," ",1) ZGE S TXT=" NUMBER ERASE LINE,BEGIN "_%LAB D STR1 K TXT W:U-I'=0 "+",U-I W " " U $P:(ECHO:WRAP) R %COLUD U $P:(NOECHO:NOWRAP:ESCAPE) G:%COLUD=0 3 UD I %COLUD="" S ^(U)=$E(^(U),1,%K) D V X %chiste F I=U+1:1 G:'$D(^(I)) 3 K ^(I) I %COLUD'?1N.N W *7," *** ERROR !" H 2 G ZGE I '$D(^(U+%COLUD)) S %COLUD="" G UD F I=U:1 Q:'$D(^(I+%COLUD)) S ^(I)=^(I+%COLUD) K ^(I+%COLUD) F I1=I:1 Q:'$D(^(I1)) K ^(I1) S %X=0,%K=L D P G M2 DEL G:%K>$L(^(U)) READ G:%K=$L(^(U)) 1271 S ^(U)=$E(^(U),1,%K)_$E(^(U),%K+2,400) D V G 3 1271 G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 S ^(U)=$E(^(U),1,%K) D V G 3 P S %YY=%Y,%XX=0 X %POSIC X %chiste I $O(^S000($P,1)) F I=0:1:23-%Y Q:'$D(^(I+U)) D .S %YY=I+%Y,%XX=0 X %POSIC D W(I+U) X %XCL W %chists D STR1 Q ;W %vverxe,%chists Q MAINA S:'$D(^(U)) ^(U)="" I $D(^S000($P,1)) W $C(27),"E" D W(U) W %vverxe,%chists S %Y=23 G M2 VIRA R ! S U=U-1 D VIR:'U,P:%Y=1 S:%Y>1 %Y=%Y-1 G:$L($G(^(U))) M2 ;S:C=164 S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G M2 S S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G M2 VIR F I=U+1:1 Q:'$D(^(I)) X "F I=I:-1:U+2 S ^(I)=^(I-1)" S U=U+1,^(U)="" Q VIR1 F I=1:1 Q:'$D(^(I)) X "F I=I+%COLVS-1:-1:U+%COLVS+1 S ^(I)=^(I-%COLVS)" X "F I=U+1:1:U+%COLVS S ^(I)=""""" S U=U+1 Q ERXEC W !,"ERROR = ",$ZE S $ZE=%ZE G 24+1 ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 Q:'$D(TXT) W %vverxe,%chists S %YY=0,%XX=16 X %POSIC D WT^%S2ERG02("YF",TXT) K:'$D(TXT(1)) TXT X %XCL Q FINDS K %SIMB S TXT="SEARCH KEY NOW . ENTER STRING FOR SEARCH :" D STR1 U $P:(ECHO:WRAP) R %SIMB U $P:(NOECHO:NOWRAP:ESCAPE) I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ??? "_$P($ZE,">")_">",!! K X ^%ERG K %S2ERG Q ERRRR D ^%L1C S %XX=0,%YY=23 X %POSIC W %chists,*7,"ERROR:",$ZE,! I $ZE["PGMOV" K W " NAME ROUTINE :$" K %S2ERG Q DELAY F %IJK=1:1:10000 Q ; ERGDOS() ; I $ZDATA("ERGDOS")=1 Q 1 Q 0 %S2ERG01 %S2ERG01 ; [ 05/15/98 8:02 PM ] [ 07/09/96 10:38 AM ] 1 K %STROKA,%STROKA1,%LAB,%SM,%,%UOLD S %E=0 G:%TIP'="R" 1111 S TXT=" LABEL <"_$P(^S000($P,1)," ",1)_"> " D STR1^%S2ERG U $P:(ECHO) R %STROKA S %UOLD=U 13 I %STROKA="-" W %vverxe,%chists K %UOLD G 3^%S2ERG S:%STROKA="" %STROKA=$P(^S000($P,1)," ",1) S %STROKA1=$P(%STROKA,":",1) S %=$S(%STROKA1["+":"+",%STROKA1["-":"-",1:" ") S %LAB=$P(%STROKA1,%,1) S:%LAB="" %LAB=$P(^(1)," ",1) S %LAB=$P(%LAB,"(") S %E='(%LAB?1"%".AN!(%LAB?.AN)) I '%E S %SM=$P(%STROKA1,%,2) S:%SM="" %SM=0 S:%'=" " %SM=%_%SM S %E='(%SM?1"+"1N.N!(%SM?1"-"1N.N)!(%SM?1N.N)) I %E W *7," LABEL ISN'T RIGHT !" H 2 G 1 I $G(%UOLD) S %LABOLD($O(%LABOLD(""),-1)+1)=%UOLD K %UOLD F I=1:1 Q:'$D(^(I)) Q:$P($P(^(I)," ",1),"(")=%LAB I '$D(^(I)) W *7," LABEL NOT !" H 2 G 1 I '$D(^(I+%SM)) W *7," OFFSET TOO LARGE !" H 2 G 1 S U=I+%SM,L=0,R=L+%GWUL K %STROKA,%STROKA1,%LAB,%SM,%E,% G M12^%S2ERG 1111 U $P:(ECHO) S TXT=" LINE NUMBER <1> " D STR1^%S2ERG R %STROKA U $P:(NOECHO:NOWRAP:ESCAPE) S:%STROKA="" %STROKA="1" S %UOLD=U I %STROKA="-" K %UOLD G 3^%S2ERG 11113 S %LAB=$P(%STROKA,":",1) S:%LAB="" %LAB=1 S %E='(%LAB?1"+"1N.N!(%LAB?1N.N)) I %E W *7," NUMBER ISN'T RIGHT !" H 2 G 1 I '$D(^S000($P,%LAB)) W *7," NUMBER TOO LARGE !" H 2 G 1 I $G(%UOLD) S %LABOLD($O(%LABOLD(""),-1)+1)=%UOLD K %UOLD S U=%LAB,L=0,R=L+%GWUL K %STROKA,%STROKA1,%LAB,%E G M12^%S2ERG Q %S2ERG02 %S2ERG02 ; [ 08.12.24 13:12 ] [ 30.10.23 09:53 ] [ 13.02.04 10:52 ] 5 U $P:(ECHO) S TXT=" UPDATE : " D STR1 R %SS G 550:%SS="" D WT("YF"," TO : ") R %S D WT("YF"," VERIFICATION ?(Y/N) ") R YES F J=0:0 Q:"DNY"[YES&(YES'="") R YES U $P:(NOECHO:NOWRAP:ESCAPE) I "DYdy"[YES S YES="Y" S TXT="UPDATE - Y, NO UPDATE - N, EXIT - ^" D STR1 S Y1=%Y,U1=U D CH1 S TXT="END OF UPDATING. PRESS " D STR1 U $P:(ECHO) R YES S %Y=1,U=U1,%X=0,L=0,RL=(%GWUL+1),R=%GWUL,%K=L K Y1,U1,X1 D P G M2 I %S'=%SS F J=U:1 Q:'$D(^(J)) S %K1=%K D CH D P K %K1 G M2 550 G 3 CH S %PZC=$F(^(J),%SS,%K1) Q:'%PZC S ^(J)=$E(^(J),1,%PZC-$L(%SS)-1)_%S_$E(^(J),%PZC,999) S %K1=%PZC-$L(%SS)+$L(%S) G CH CH1 S %PZC=0 I '$D(%PRHBR) S %PZC=%K F J=U:1 Q:'$D(^(J)) S %PZC=$F(^(J),%SS,%PZC) Q:%PZC>0 I '%PZC!('$D(^(J))) W *7,%vverxe," NOT FOUND",%chists H 2 Q S %PZC=%PZC-$L(%SS)-1,%Y=%Y+(J-U),%X=%X+(%PZC-%K),U=J,%K=%PZC I %XU J=RL D I J1&'J0 S J=J1 Q .S J1=0,J0=0 F S J0=$F(^(%PZC),RAZ,J0) S:J0'0)) S L=J,R=L+RL-1 G M12 I %X<0,J-RL<0 S L=0,R=L+RL-1,X1=J,Y1=1 G M12 S %Y=1,X1=%X G M12 STR1 W %vverxe,%chists S %YY=0,%XX=16 X %POSIC D WT("YF",TXT) K TXT Q P S %YY=%Y,%XX=0 X %POSIC X %chiste F I=0:1:23-%Y Q:'$D(^(I+U)) S %YY=I+%Y,%XX=0 X %POSIC W $E(^(I+U),L+1,R+1),%chists Q M2 I '$D(%PRHBR) G M2^%S2ERG E G M2^%S2ERG1 M12 I '$D(%PRHBR) G M12^%S2ERG E G M12^%S2ERG1 3 I '$D(%PRHBR) G 3^%S2ERG E G 3^%S2ERG1 ERCOM G ERCOM^%S2ERG WT(CV,TXT) X %LIGHT W %CV(CV),TXT X %XCL Q %S2ERG03 %S2ERG03 ; SAVE/REST 18 N C,C1 U $P:(NOECHO:NOWRAP:ESCAPE) R *C I $A($E($ZB))=27 S C="" X "F %JJ=2:1:$L($ZB) S C=C_$A($E($ZB,%JJ))" I $D(%UPRCOD(C)) S C=%UPRCOD(C) G M I $C(C)="G"!($C(C)="g") S %NLAB=$O(%LABOLD($G(%NLAB)),-1) G:%NLAB="" EXIT D S %X=0,%Y=1 G EX .S %STROKA=%LABOLD(%NLAB)-1 .S %LAB=%STROKA+(%TIP="R") S U=%LAB,L=0,R=L+%GWUL,%K=L K %STROKA,%STROKA1,%LAB,%E ; I $C(C)="L"!($C(C)="j")!($C(C)="l") D ^%S2ERGLP G EXIT:$D(%G)<11 S %COLVS=%G D VIR1 D N NS F I=1:1:%G S NS=I+U-1 S ^(NS)=$E($G(^(NS))_$G(%G(I)),1,255) D TOP .I $G(%PRHBR)'=1 S %K=L,%Y=%Y+1,%X=0 Q .S %Y=%Y+1,%X=RL-1,%K=L+%X Q ; I $C(C)="H"!($C(C)="h")!($C(C)="i") D S U1=U,Y1=%Y,X1=%X,U=U-%Y+1,%Y=1,%X=0 D @("P"_%PROG) S U=U1,%Y=Y1,%X=X1 K U1,Y1,X1,%PP G EX .S %L1WE="" S %YY=19,%XX=0 X %POSIC W %chists,"<>" .S %S=^(U),%6=20 .N %I,%S1,%N S %S1=$P(%S,"^m(",1) .F %I=2:1:$L(%S,"^m(") S %N=$P($P(%S,"^m(",%I),")") D ..S %TXT="" S:%N %TXT=$G(^m(%N)) S %S1=%S1_""""_%TXT_""""_$P($P(%S,"^m(",%I),")",2,25) .S %S=%S1 .D ^%L1WE ;;I %Y>18 S U1=U,U=U-%Y+1,Y1=%Y S:U<1 U=1 .S %GET="" D N^%L1GET . I $C(C)="R"!($C(C)="x")!($C(C)="r") S ^S000($P,U)=$$PEREST(^S000($P,U)) G EX ; I $C(C)=1 S %LABOLD($O(%LABOLD(""),-1)+1)=U ; I $C(C)="M"!($C(C)="m")!($C(C)="v") N %PP D I $D(%PP) S U1=U,Y1=%Y,X1=%X,U=U-%Y+1,%Y=1,%X=0 D @("P"_%PROG) S U=U1,%Y=Y1,%X=X1 K U1,Y1,X1,%PP .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,U,%K,%PP) D ^%L1C 181 .S %GET="LABEL:#8" D VE^%L1GET .I %S="?"!(%TO="F7") X "W ! X %chista ZP %S2ERGM" R !!?40,"",Y S %PP="" G 181 .Q:%S="" .S %MACRO=" "_$P($T(@(%S_"^%S2ERGM"))," ",2,255) .I '$D(^S000($P,U)) S ^(U)="" .I $L(^(U))+$L(%MACRO)'>255 S ^(U)=$E(^(U),1,%K)_%MACRO_$E(^(U),%K+1,255) ; I $C(C)="W" D .D ^%L1TS .N I F I=1:1 Q:'$D(^S000($P,I)) S ^(I)=$TR(^(I),TS1,TS0) .S L=0,R=L+%GWUL,%K=L .S U1=U,Y1=%Y,X1=%X,U=U-%Y+1,%Y=1,%X=0 G EX ; M I C="ADDL" G EXIT:%Y'<23 S TXT="HOW MANY LINES <3> " D @("STR1"_%PROG) U $P:(ECHO) R %COLVS U $P:(NOECHO:NOWRAP:ESCAPE) S:%COLVS="" %COLVS=3 G:%COLVS'?1N.N EXIT D VIR1 S %K=L,%X=0,%Y=%Y+1 G EX G EXIT:$D(%Z)<11 I C="VNIZ" S %COLVS=%Z D VIR1 D N NS F I=1:1:%Z S NS=I+U-1 S ^(NS)=$E($G(^(NS))_$G(%Z(I)),1,255) D TOP .I $G(%PRHBR)'=1 S %K=L,%Y=%Y+1,%X=0 Q .S %Y=%Y+1,%X=RL-1,%K=L+%X Q ; I C="LEVO" N %TOP F I=1:1:%Z S NS=I+U-1 D:'$D(^(NS)) CREATS D GTOP S ^(NS)=%Z(I)_$E($G(^(NS)),%TOP,255) D TOP I $G(%PRHBR)=1 G EX ; I C="PRAVO" F I=1:1:%Z S NS=I+U-1 D:'$D(^(NS)) CREATS S ^(NS)=^(NS)_$J("",%K-$L(^(NS)))_%Z(I) D TOP ; I C="VVERX" F I=1:1:%Z S NS=I+U-1 D:'$D(^(NS)) CREATS S ^(NS)=$E(^(NS),1,%K)_$J("",%K-$L(^(NS)))_%Z(I)_$E(^(NS),%K+1,999) D TOP EX D @("P"_%PROG) EXIT U $P:(NOWRAP:NOECHO:ESCAPE) Q ;------------------------- CTRL + Z ------------------------ 26 S %GET="SAVE LINE[,COLUMN] <1>#7" D VE^%L1GET S C=%S S:C="" C=1 G:C="-" EXIT G 26:C'?.N.",".N G:C'=0 260 K %Q S %Q("Z")=" ERASE OLD ARRAY :",%Q("X")=10,%Q("Y")=0 W *13,%chists D ^%S1ASK K:YES %Z G EXIT 260 I $D(%Z) S YES=0 F J=0:0 Q:"123"[YES&($L(YES)=1) S %GET=" OLD ARRAY: ERASE - 1,LOOK - 2,TO ADD - 3 <1>#1" D VE^%L1GET S YES=%S S:YES="" YES=1 I $D(%Z) K:YES=1 %Z I YES=2 W # X "F J=1:1 Q:'$D(%Z(J)) W !,%Z(J)" R !!?40,"PRESS ",YES S U1=U,Y1=%Y,X1=%X,U=U-%Y+1,%Y=1,%X=0 D @("P"_%PROG) S U=U1,%Y=Y1,%X=X1 K U1,Y1,X1 G 260 S:'$D(%Z) %Z=0 S I=999.3 S:C["," I=+$P(C,",",2) S C=+C F J=1:1:C Q:'$D(^S000($P,U+J-1)) D S:I'=999.3 %S=%S_$J("",I-$L(%S)) S %Z(%Z+J)=$TR(%S,$C(9)," ") .I $G(%PRHBR)'=1 S %S=$E(^(U+J-1),%K,%K+I) Q .S %TOP=^(U+J-1,"%TOP") I ^S000($P,U+J-1) .I %K+2-I>%TOP S %TOP=%K+2-I .S %S=$E(^(U+J-1),%TOP,%K+1) Q S %Z=%Z+J-'$D(%Z(%Z+J)) K:'%Z %Z G EXIT Q DELAY ; F I=1:1:500 Q TOP Q:$G(%PRHBR)'=1 S SS=$J($E(^(NS),$L(^(NS))-%RMAX+1,255),%RMAX) F II=1:1:$L(SS) Q:$E(SS,II)'=" " S ^(NS,"%TOP")=II-($E(SS,II)'=" ") S ^S000($P,NS)=SS Q VIR1 N I F I=1:1 Q:'$D(^S000($P,I)) N NS F I=I+%COLVS-1:-1:U+%COLVS+1 S ^S000($P,I)=^S000($P,I-%COLVS) I $G(%PRHBR)=1 S ^S000($P,I,"%TOP")=$G(^S000($P,I-%COLVS,"%TOP")) I ^S000($P,I) F I=U+1:1:U+%COLVS S NS=I D CREATS S U=U+1 Q CREATS I $G(%PRHBR)'=1 S ^(NS)="" Q S ^(NS)=$J("",%RMAX),^(NS,"%TOP")=%RMAX I ^S000($P,NS) Q GTOP I $G(%PRHBR)'=1 S %TOP=1 Q S %TOP=^(NS,"%TOP") I %TOP>(%K+1) S %TOP=%K+1 I $O(^S000($P,NS)) Q PEREST(%S) ; N %I,%I0,%FLEQ,%FLKV,%ST,%MP,%ST1,%S1 S %FLEQ=0,%FLKV=0,%I=0,%I0=1,%ST="",%S1="" BP S %I=%I+1 I %I>$L(%S) D:$L(%ST) PRST Q %S1 I $E(%S,%I)="=",%FLKV D:'%FLEQ S1 G:'%FLEQ BP D ST G BP I $E(%S,%I)="=",'%FLKV S %FLEQ=1 D S1 G BP I '%FLEQ D S1 G BP I $E(%S,%I)="""" S %FLKV='%FLKV D ST G BP I $E(%S,%I)=" ",%FLKV D ST G BP I $E(%S,%I)'=" " D ST G BP I $E(%S,%I)=" ",'%FLKV D PRST S %S1=%S1_" " G BP Q ST S %ST=%ST_$E(%S,%I) Q S1 S %S1=%S1_$E(%S,%I) Q PRST ; N %J,%J1,%ST3,%ST1,%ST2 S %ST2="" I %ST["_" D .F %J=1:1:$L(%ST,"_") S %ST1(%J)=$P(%ST,"_",%J) .S %J1=1 F %J=1:1 Q:'$D(%ST1(%J)) D ..I %ST1(%J)["^m(" S %J1=%J1+1,%ST3(%J1)=%ST1(%J),%J1=%J1+1 Q ..S %ST3(%J1)=$G(%ST3(%J1))_%ST1(%J)_"_" .S %J1="" F S %J1=$O(%ST3(%J1)) Q:%J1="" I $E(%ST3(%J1),$L(%ST3(%J1)))="_" S %ST3(%J1)=$E(%ST3(%J1),1,$L(%ST3(%J1))-1) .S %J1=99999 F S %J1=$O(%ST3(%J1),-1) Q:%J1="" S %ST2=%ST2_%ST3(%J1)_"_" I %ST'["_" S %ST2=%ST_" " S %S1=%S1_$E(%ST2,1,$L(%ST2)-1) S %I0=%I S %ST="" S %FLEQ=0 Q %S2ERG1 %S2ERG1 S %S2ERG="" ; [ 25.03.19 14:02 ] [ 15.03.19 13:49 ] [ 07.03.19 19:32 ] ; INPUT : RL,%RMAX N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" S %GWUL=78 D ^%L1GRAF I '$D(RL) S RL=%GWUL I '$D(TXT) S TXT=" CTRL+Y miywn ugl d`ivil " I '$D(%RMAX) S %RMAX=%GWUL I '$D(%PRHBR) S %PRHBR=1,%HBRY="" I RL>%RMAX S %SAY="RL="_RL_" ,%RMAX="_%RMAX X %XMSGV H 3 W *7 Q S %TOP=0 I %PRHBR S %TOP=%RMAX U $P:(NOWRAP:NOECHO:ESCAPE) W *27,"[1;24r" BEG D ^%L1TS ;S $ZS="ERRRR^%S2ERG" M1 K U1 S %FLV=1,%FLGRF=0,%FLI=$S(%PRHBR:1,1:0),%FLH=0,SDV=60 S:'$D(%TIP) %TIP="R" S:'$D(U) U=1 S:'$D(L) L=0 I $D(^S000($P,U)) S:%PRHBR L=%RMAX-RL S R=L+RL-1 G M12 CREATS I '$D(^S000($P,U)) S ^S000($P,U)=$S('%PRHBR:"",1:$J("",%RMAX)) ;S %X=$S(%PRHBR:RL-1,1:0) ;*** LEV Q M12 S %X=$S(%PRHBR:RL-1,1:0),%Y=1 S:%PRHBR %HBRY="" W:%PRHBR %HBR D P D:$D(TXT) STR1 M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 K U1,Y1,X1 M2 D CREATS S %K=L+%X M21 I %PRHBR S %TOP=$G(^S000($P,U,"%TOP"),%RMAX) I ^S000($P,U) S %SS=^S000($P,U) 3 ; ;;I %FLI W %vverxe,"LINE:",U," COL:",$S(%PRHBR:%RMAX-(%K+1)+1,1:%K+1)," LENGTH:",$S(%PRHBR:%RMAX-%TOP,1:$L(^S000($P,U)))," " S %YY=%Y,%XX=%X X %POSIC ;READ R *C I $L($ZB)>3,$D(%UPRCOD($ZB)) S C=$ZB G @%UPRCOD($ZB) READ D ^%L1MSGBR I '$D(^S000($P,U)) S ^(U)="" U $P:(NOWRAP:NOECHO:ESCAPE) R *C:1 E G READ S ZB="" F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $L(ZB)>3,$D(%UPRCOD(ZB)) G @%UPRCOD(ZB) ;I C=27 R *C1:%WAIT G:C1=-1 27 R *C:%WAIT G:C=-1 27 S C=C1_C G COM ;I C=0 X "F %JJ=1:1:500" R *C1:%WAIT I C1>0 S C="0"_C1 I %TYPCRT="VT220"&(C=31)!(C="094") D G M12 .X "ZL %S2ERGH K ^TMPS111($J) N I,J,T,TH S J=0 F I=2:1 Q:$T(+I)="""" S T=$T(+I),TH=$E(T,2,4) S:TH=""\R\""!(TH=""\G\"") T="" ""_$P(T,TH,2,20) I TH'=""\R\""&(TH'=""\G\"")!(TH=(""\""_%TIP_""\"")) S J=J+1,^TMPS111($J,J)=T" D ..S %SAY=" EXIT FROM HELP - " X %XMSGN ..N L S L=0 D ^%S2VIEW X %XCL .;;S %GET="" D N^%L1GET D HELP^%L1GRAF S %GET="" D N^%L1GET .S U1=U,Y1=%Y,U=U-%Y+1,X1=%X Q ;I %TYPCRT="VT220"&(C=30)!(C="099")!(C="097") D ^%S2ERGP S U1=U,Y1=%Y,U=U-%Y+1,X1=%X G M12 ;B S %FLGRF='%FLGRF S TXT=$S(%FLGRF:" GRAF ",1:" NORMAL ") D STR1 G 3 I %TYPCRT="VT220"&(C=30)!(C="099")!(C="097") S %FLGRF='%FLGRF S TXT=$S(%FLGRF:" GRAF ",1:" NORMAL ") D STR1 G 3 ; ----- I %FLGRF,C=95 S %GLO="^S000($P)",%NS=U,%NP=%K D PERE^%L1PR,P G 3 I %FLGRF,C=38 S %GLO="^S000($P)",%NS=U,%NP=%K D SCEP^%L1PR,P G 3 COM I $D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" G @%UPRCOD(C) I C<127,C>31,'%FLV G READ1 I C=2 S %NETTO=$$SPA^%L1FRM(^S000($P,U)) S ^S000($P,U)=$J(%NETTO_$J("",%RMAX-$L(%NETTO)\2),%RMAX) S %TOP=$L(%NETTO)+(%RMAX-$L(%NETTO)\2) D V D SVTOP S %X=%RMAX-%TOP-1,%K=L+%X G 3 G ERCOM:C<32&(C-31)&(C-29) ;;I $D(%HBRY),C=46 S C=$S(%XMSG(0)<0:149,1:245) READ0 I %FLV,(%K<1!(%TOP<2))&%PRHBR!((%K+1)'<%RMAX&'%PRHBR) G 3 I %FLV,'%PRHBR G:(%K+1)'<$L(^S000($P,U))!($L(^S000($P,U))=%RMAX) READ1 D LINE I %FLV,%PRHBR G:(%K+1)'>%TOP READ1 D LINE READ1 I %PRHBR&(%TOP<1) G READ S C=$C(C) READ2 I %FLGRF S C=$$GRA^%L1GRAF(C) I '%PRHBR S ^S000($P,U)=$E(^S000($P,U),1,(%K+1)-1)_$J(C,(%K+1)-$L(^S000($P,U)))_$E(^S000($P,U),(%K+1)+1,%RMAX) W C G PRAVO I %PRHBR D W $$WC(C),*8 S:(%K+1)-1<%TOP %TOP=(%K+1)-1 G LEVO .;;S ^S000($P,U)=$E(^S000($P,U),1,(%K+1)-1)_$TR(C,%TES2,%TES1)_$E(^(U),(%K+1)+1,%RMAX) W $TR(C,%TEN,%THB),*8 S:(%K+1)-1<%TOP %TOP=(%K+1)-1 G LEVO .S ^S000($P,U)=$E(^S000($P,U),1,%K)_$$SMB^%S2ERG($A(C))_$E(^S000($P,U),%K+2,400) W $$WC^%S2ERG(C) PRAVO G:(%K+1)'<%RMAX 3 I %X<(RL-1) S %K=%K+1,%X=%X+1 G:%FLI 3 W:$A(C)>127 %pravo G 3 S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=1 D P G M13 LINE I '%PRHBR S ^(U)=$E(^S000($P,U),1,(%K+1)-1)_" "_$E(^(U),(%K+1),%RMAX) D V S %XX=%X,%YY=%Y X %POSIC Q Q:%TOP<2 S ^(U)=$E(^S000($P,U),2,%K+1)_" "_$E(^(U),%K+2,%RMAX) D V S %XX=%X,%YY=%Y X %POSIC S %TOP=%TOP-1 Q MET G ^%S2ERG01 ; 27 ; ESC S %XX=20,%YY=23 X %POSIC W ! X %XCL U $P:(ECHO:WRAP:WIDTH=80) K %S2ERG Q INS S TXT="INSERT" D STR1 I '%FLV S %FLV=1,%GTV="" H 1 G 3 I %FLV S %FLV=0 K %GTV S TXT="OVERLAY" D STR1 H 1 G 3 HBR S TXT="HEBREW" D STR1 I '%FLH S %FLH=1 S %HBRY="" W %HBR S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 I %FLH S %FLH=0 K %HBRY W %ENG S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 HELP D ^%S2ERHEL G BEG 2 G 3:%Y'<23 D VIR S %X=$S('%PRHBR:0,1:RL-1),%Y=%Y+1,%K=L+%X D P G 3 MOD G 5^%S2ERG02 FIND D SVTOP G 6^%S2ERG02 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:%PRHBR TAB1 TABN1 G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^(I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^(I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FIND" D STR1 H 1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'%RMAX %K=%RMAX-1 S %X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=1 D P S %X=R-L,%K=R G M13 ENDS I '%PRHBR S S=$L(^S000($P,U)),%K=$S(SR:R,1:S),%X=%K-L G 3 I %PRHBR S %K=$S((%TOP-1)R:R,1:%TOP-1),%X=%K-L G 3 ENDL S S=$L(^S000($P,U)) G:S>" S %S=^S000($P,U),%6=20 D S ^S000($P,U)=$S('%PRHBR:"",1:$J("",%RMAX-$L(%S)))_%S,%TOP=%RMAX-$L(%S) D SVTOP K %S,%6 I %Y>18 S U1=U,U=U-%Y+1,Y1=%Y S:U<1 U=1 G M12 .N (%S,%6,%PRHBR,%RMAX,%GWUL) .I %PRHBR S %X1=0,%X2=%GWUL,%Y1=20,%Y2=23,%LS=%RMAX F %II=1:1:$L(%S) Q:$E(%S,%II)'=" " S %S=$E(%S,%II,255) .D ^%L1C D @$S(%PRHBR:"^%L1WH",1:"^%L2ERSTR") .Q D P G 3 PGLN G 3:'L D SLEVO G M12 BK I '%PRHBR S %K=L,%X=0 G VNIZ S %K=R,%X=RL-1 G VNIZ HOME G:%PRHBR HOMEH I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G 3 HOMEH ; S %K=(%K+RL-%X-1),%X=RL-1 G 3 PGUP G 3:U'>%Y D SVTOP S U=U-%Y-19 S:U'>0 U=1 G M12 PGRG G 3:(L+1)>(%RMAX-SDV) S:R+SDV>(%RMAX-1) SDV=%RMAX-1-R D SPRAVO S SDV=60 G M12 SPRAVO D SVTOP S L=L+SDV,U1=U,Y1=%Y,U=U-%Y+1,R=R+SDV Q REST D SVTOP S %PROG="^%S2ERG1" D 18^%S2ERG03 G M21 VNIZE W %vverxe F I=1:1:23 Q:'$D(^(U-%Y+I)) W %vniz S:'$D(^(U-%Y+I)) I=I-1 D SVTOP S U=U-%Y+I,%Y=I,%X=$S('%PRHBR:0,1:RL-1),%K=L+%X G M2 DELL F I=U:1 Q:'$D(^S000($P,I+1)) S ^(I)=^(I+1),^S000($P,I,"%TOP")=$G(^S000($P,I+1,"%TOP")) K ^S000($P,I) S %X=$S(%PRHBR:RL-1,1:0),%K=L+%X D P G M2 ADDL G 3:%Y'<23 D VIR D CREATS S %Y=%Y+1 D P G M2 ADD G:%K'<$L(^S000($P,U))!($L(^(U))=%RMAX) READ S ^(U)=$E(^S000($P,U),1,%K)_" "_$E(^(U),%K+1,%RMAX) D V G 3 PGDN G 3:'$D(^(U-%Y+21)) D SVTOP S U=U-%Y+21 G BEG+2 24 S $ZS="" X %chista S %ZT=$ZT U $P:(ECHO:WRAP:WIDTH=80) S ^ZE($P,"%ERG")=%TIP D ^%L1X 241 K ^ZE($P,"%ERG") S:$D(%ZT) $ZT=%ZT G:$ZS=""!($ZV'["2.0") BEG X:%TIP="R" ^%ERG(1) Q ; G BEG ER24 W !,$ZS D ^%L1C S %PR="" G 24+1 XEC G 24 SAVE D SVTOP S %PROG="^%S2ERG1" D 26^%S2ERG03 G M21 KOD F J=1:1:$L(^S000($P,U)) S %SMB=$E(^(U),J) I $A(%SMB)<123,$A(%SMB)>96 S $E(^(U),J)=$C($A(%SMB)-32) S SDV=0 D SLEVO S SDV=60 G M12 096 G KOD VVERX D SVTOP G:%Y=1 VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ D SVTOP S U=U+1,%Y=%Y+1 G MAINA:%Y=24,M2 SVTOP Q:'$D(%PRHBR) S ^S000($P,U,"%TOP")=%TOP I ^S000($P,U) Q LEVO S:%K=0 %X=0 G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 D P G M13 SLEVO D SVTOP S L=$S(L>SDV:L-SDV,1:0),R=L+RL-1 S U1=U,U=U-%Y+1,Y1=%Y,%X=0,%Y=1 K X1 Q SBROS G:^S000($P,U)=%SS BK S ^(U)=%SS D V G BK V S %YY=%Y,%XX=0 X %POSIC W %chists D W(U) Q VVERXE D SVTOP S U=U-%Y+1,%X=$S('%PRHBR:0,1:RL-1),%Y=1,%K=L+%X G M2 CHISTS I '%PRHBR S ^(U)=$E(^S000($P,U),1,%K) W %chists G 3 S ^(U)=$J("",%K+1)_$E(^S000($P,U),%K+2,$L(^(U))) S %XX=0,%YY=%Y X %POSIC W $J("",%K+1) S %TOP=%K+1 G 3 CHISTE F I=U:-1:1 Q:$E(^(I),1)'=" "&($E(^(I),1)'="") S %LAB=$P(^(I)," ",1) ZGE S TXT=" NUMBER ERASE LINE,BEGIN "_%LAB D STR1 K TXT W:U-I'=0 "+",U-I W " " U $P:(ECHO:WRAP) R %COLUD G:%COLUD=0 3 UD I %COLUD="" S ^(U)=$E(^S000($P,U),1,%K) D V X %chiste F I=U+1:1 G:'$D(^(I)) 3 K ^(I) I %COLUD'?1N.N W *7," *** ERROR !" H 2 G ZGE I '$D(^(U+%COLUD)) S %COLUD="" G UD F I=U:1 Q:'$D(^S000($P,I+%COLUD)) S ^(I)=^(I+%COLUD) S ^S000($P,I,"%TOP")=^S000($P,I+%COLUD,"%TOP") K ^S000($P,I+%COLUD) F I1=I:1 Q:'$D(^S000($P,I1)) K ^(I1) S %X=$S('%PRHBR:0,1:RL-1),%K=L+%X D P G M2 DEL ; I '%PRHBR G:%K>$L(^S000($P,U)) READ G:%K=$L(^(U)) 1271 I '%PRHBR S ^(U)=$E(^S000($P,U),1,%K)_$E(^(U),%K+2,%RMAX) D V G 3 ;------ %PRHBR G:%TOP'<%RMAX!(%K>R)!((%K+1)<%TOP) READ I (%K+1)=%TOP S ^S000($P,U)=$J("",%K+2)_$E(^S000($P,U),%K+3,%RMAX) D V S %K=%K+1,%X=%X+1,%TOP=%TOP+1 G 3 S ^(U)=" "_$E(^S000($P,U),1,%K)_$E(^(U),%K+2,%RMAX) D V S %TOP=%TOP+1 G 3 1271 G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 S ^(U)=$E(^S000($P,U),1,%K) D V G 3 P S %YY=%Y,%XX=0 X %POSIC X %chiste W:%PRHBR!%FLH %HBR F I=0:1:23-%Y Q:'$D(^S000($P,I+U)) S %YY=I+%Y,%XX=0,$X=0 X %POSIC D W(I+U) W %chists W %vverxe,%chists Q MAINA D CREATS I $D(^S000($P,1)) D W(U) W %vverxe,%chists S %Y=23 G M2 VIRA R ! S U=U-1 D VIR:'U,P:%Y=1 S:%Y>1 %Y=%Y-1 G M2 VIR F I=U+1:1 Q:'$D(^(I)) F I=I:-1:U+2 S ^S000($P,I)=^S000($P,I-1) I %PRHBR S ^S000($P,I,"%TOP")=^S000($P,I-1,"%TOP") S U=U+1 K ^S000($P,U) D CREATS Q W(U) ; D W^%S2ERG(U) Q N ST S ST=$E(^S000($P,U),L+1,R+1) I '$D(%HBRY) W ST Q I %TYPCRT["VT" W $TR($TR(ST,%TES1,%TES2),%TEN,%THB) Q ; I %TYPCRT["PC" D Q ;; -- ZOC ! .N STO S STO=$E(ST,L+1,R+1) .N JJ F JJ=1:1:$L(STO) D ..N SMB S SMB=$E(STO,JJ) ..W $$WC(SMB,1) Q ;;I $A(SMB)<96!($A(SMB)>122) W SMB Q ;;N A S A=$TR(SMB,%TES1,%TES2) ;;W $C($A(A)+128) Q ; WC(%A,%PR) ; I $D(%HBRY),%A="," Q $C(250) I $D(%HBRY),%A="." Q $C(245) I $A(%A)>95,$A(%A)<123,$D(%HBRY) D .I $G(%PR) S %A=$C($A(%A)+128) Q .S %A=$C($A($TR(%A,%TES2,%TES1))+128) Q %A ; MDRG ; I %PRHBR D S ^(U)=$E(^S000($P,U),$L(%S)+1,(%K+1))_%S_$E(^S000($P,U),(%K+2),255) S %TOP=%TOP-$L(%S) D SVTOP S Y1=%Y,U1=U,X1=%X-$L(%S),U=U-%Y+1,%Y=1 G M12 .S %S="" Q:%K'>1 .S:(%K+1)-1<%TOP %TOP=(%K+1)-1 S %X=%K-L .S %XX=%X,%YY=%Y .S %LS=%XX I %LS>%TOP S %LS=%TOP Q:%LS'>0 .N (%YY,%XX,%XMSG,%UPRCOD,%S,U,%RMAX,%LS) D ^%L1C .S %GET="++"_%YY_","_$S(%XX'<%LS:%XX-%LS+1,1:0)_"#++"_%LS_",E,I" D ^%L1GET ; .S %K=$S((%TOP-1)R:R,1:%TOP-1),%X=%K-L I '%PRHBR D S ^(U)=$E(^S000($P,U),1,(%K+1)-1)_%S_$E(^S000($P,U),(%K+1),255) S Y1=%Y,U1=U,X1=%X,U=U-%Y+1,%Y=1 G M12 .S S=$L(^S000($P,U)),%K=$S(SR:R,1:S),%X=%K-L .S %XX=%X,%YY=%Y .N (%YY,%XX,%XMSG,%UPRCOD,%S,RL,U,%RMAX) D ^%L1C .S %S="" S %LL=$S(%RMAX-$L(^S000($P,U))>(RL-%XX):RL-%XX-1,1:%RMAX-$L(^S000($P,U))-1) Q:%LL<1 .S %GET="++"_%YY_","_RL_"#++"_$S(%RMAX-$L(^S000($P,U))>(RL-%XX):RL-%XX-1,1:%RMAX-$L(^S000($P,U))-1)_",H,I" D ^%L1GET ERXEC W !,"ERROR = ",$ZS S $ZS=%ZE G 24+1 ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 W %vverxe,%chists W %CLI S %YY=0,%XX=(RL-$L(TXT))\2+10 X %POSIC W $TR($TR(TXT,%TES1,%TES2),%TEN,%THB) X %XCL Q FINDS K %SIMB S TXT="SEARCH KEY . INPUT SIMBOL ( - END SEARCH):" D STR1 U $P:(ECHO:WRAP) R %SIMB I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ???" X ^%ERG K %S2ERG Q ERRRR D ^%L1C S %XX=0,%YY=23 X %POSIC W %chists,*7,"ERROR:",$ZS,! W " 'X ^%ERG' AND '$'" K %S2ERG Q %S2ERGA %S2ERGA ; [ 11/30/98 11:58 AM ] [ 05/16/98 8:24 AM ] [ Q D ^%L1C X %chista W %LIGHT1,%CV("YF") W !!! N I F I=1:1 S T=$P($T(TXT+I),";",2,25) Q:T["Q;" W T,! X %XCL Q TXT ; ; Hello ! My name is Lev Fainstein . I'm glad to present to You ; my version of full screen editor. MSM version of full screen editor ; (X ^%E) it isn't useful in my opinion. Other version (X ^%G) is much better, ; but it isn't work properly on dumb terminals . ; If You'll decide that my version is suitable, You can send message to ; e-mail rsd@netvision.net.il . ; If You'll want to get full version of this editor that include built-in ; full-screen programm manager, built-in msm-shell, progamm viewer , ; possibility to transfer part of one programm to another (even in other ; UCI) , technical support and new versions of programm please send ; 30$ USA (cash) by address : ; ; Hagvura 15/30, Qyriat-Gat , Israel , 82000 ; Lev Fainstein Q ;Q; %S2ERGH %S2ERGH ; [ 06/15/98 11:20 AM ] [ 05/16/98 11:01 AM ] [ 05/15/98 8:18 PM ] ; FOR PROPERLY WORK OF EDITOR YOU NEED TO DO SETTINGS IN MANAGER UCI : ; S ^%TYPCRT(+$G(@$$^W4DEVI@($P)))="PC" - FOR CONSOLE OR WINDOW ; S ^%TYPCRT(+$G(@$$^W4DEVI@($P)))="VT520" - FOR TERMINALS FROM VT420 OR BETTER ; S ^%TYPCRT(+$G(@$$^W4DEVI@($P)))="VT220" - FOR TERMINALS VT220,VT320 ; FOR COLORS MONITOR SET ^%CVET($P)=1 ; SET GLOBAL PROTECTION FOR GLOBAL ^%ERGS TO "RWD" (SYSTEM,WORLD,GROUP,USER) =========================== CURSOR MOVING COMMANDS ========================== ; UP, DOWN, LEFT, RIGHT ARROWS , , - USUAL +"^" = +"N" = MOVE CURSOR TO END OF SCREEN LINE : OR +"]" MOVE CURSOR TO BEGIN OF SCREEN LINE : + MOVE CURSOR TO BEGIN OF LINE : \R\MOVE CURSOR TO LABEL OR \R\ LABEL+OFFSET,LABEL-OFFSET : +"G" \G\MOVE CURSOR TO LINE #N : +"G" AND #N TEN CHARACTERS TO RIGHT : TEN CHARACTERS TO LEFT : + 60 CHARACTERS TO RIGHT : +"P" 60 CHARACTERS TO LEFT : +"L" END OF SCREEN : +"T" LAST SCREEN : + : FIRST SCREEN : +"G" AND : FIND A STRING : (OR +"F") + STRING IF STRING="" - REPEAT LAST FIND TAB-SEARCH : +<->+ SEARCHING FORWARD - SEARCHING BACKWARD-+ IF STRING="" - CANCEL TAB-SEARCH : ADD BOOK-MARK : +"R" THEN "1" BACK TO BOOK-MARK : +"R" THEN "G" ; ============================== EDITING COMMANDS ============================= ; OPEN A NEW LINE : OR + INSERT/OVERLAY EDITING MODE : INSERT SPACE : +"W" EDIT A ENTIRE LINE : OR + UPDATE STRING TO ANOTHER : +"E" INSERT MACRO-STRING : +"R" THEN "M" AND LABEL FROM ROUTINE %S2ERGM RESTORE A MODIFIED LINE : \R\INSERT MULTI-LEVEL LOOP WITH GLOBAL : +"R" THEN "L" ; ============================== DELETE COMMANDS ============================== ; DELETE A LINE : OR + DELETE A SYMBOL : OR ERASE FROM CURSOR TO END OF LINE : OR +"\" DELETE GROUP OF LINES : ; ============================== COPY/PASTE COMMANDS ========================== ; SAVE GROUP OF LINES : OR +"Z" RESTORE GROUP OF LINES : (OR +"R") + - UNDER CURRENT LINE + - TO END OF LINES + - TO CURSOR PLACE ; ============================= MISCELLANEOUS COMMANDS ======================== ; TURN ON/OFF AT INDICATION IN FORM : BUILT-IN MSM-SHELL (FULL VERSION ONLY) : +"X" \R\BUILT-IN PROGRAMM MANAGER (FULL VERSION \R\ONLY) : IN "ROUTINE NAME" FIELD ENTER "*" OR PART OF ROUTINE NAME AND "*" OR "?" \R\VIEW OTHER PROGRAMMS (FULL VERSION ONLY) : IN BUILT-IN MSM-SHELL ENTER "V" ============================================================================= EXIT FROM EDITOR : OR +"Y" %S2ERGJ %S2ERGJ ; [ 05.01.08 10:54 ] [ R !!,"DAYS :",DAYS S FL="ls"_$J ZSY "ls -l "_^[$$^W3MAIN]W3MAIN("WEBL")_" *.jsp > "_FL O FL:(REWIND) F U FL R A Q:$ZEOF D .S A=$$SPA^%L1FRM(A) .S A=$$SP1^%L1FRM(A) .S DAT=$P(A," ",6),PROG=$P(A," ",8) .S DT=$P(DAT,"-",3)_"/"_$P(DAT,"-",2)_"/"_$E(DAT,3,4) .S DT=$$^%L1DC(DT,3) .I DT<($H-DAYS) Q .U 0 W $$^%L1DC(DT,1)," ",PROG,! C FL Q %S2ERGLP %S2ERGLP ; [ 02/24/93 6:13 PM ] N (%G,%UPRCOD,%XMSGV,%XMSGN,%XMSG) D ^%L1C N $ZT S ZT=$ZT S $ZT="ZG "_$ZL_":ER^%S2ERGLP" GB K %G S %GET="GLOBAL:^++0,1,EE,,,C#++20,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") I $E(%S)'="^" S %S="^"_%S S %S2GLB=%S S %S2LB="GB" I $D(@%S2GLB) GB1 I %S2GLB'["(" S %S2GLB=%S2GLB_"(" I $E(%S2GLB,$L(%S2GLB))=")" S %S2GLB=$E(%S2GLB,1,$L(%S2GLB)-1)_"," IN S %GET="INDEXES:++0,32,EE#++20,E,I" D ^%L1GET G:%S=""!($G(%TO)="END") GB S %S2IND=%S S %S2LB="IN" I $D(@(%S2GLB_%S2IND_")")) IN1 F %S2UR=1:1:$L(%S2IND,",") D .S %S2GLBU=%S2GLB_$P(%S2IND,",",1,%S2UR)_")" .S %S2INDU=$P(%S2IND,",",%S2UR) .S %G(%S2UR)=" "_$TR($J("",%S2UR-1)," ",".")_"S "_%S2INDU_"="""" F S "_%S2INDU_"=$O("_%S2GLBU_") Q:"_%S2INDU_"="""" D" S %G=$L(%S2IND,",") S $ZT=ZT Q ER I $ZS["SYNTX"!($ZS["INDER") S $ZT="ZG "_$ZL_":ER" D G @%S2LB .S %SAY=" ERROR !++0,70,EE,I" W *7 X %XMSG H 2 S %SAY=" ++0,70,EE,I" W *7 X %XMSG S $ZT="ZG "_$ZL_":ER" G @(%S2LB_1) %S2ERGM %S2ERGM ; [ 07/15/96 12:46 PM ] CA X %chista Q Q:%S=""!($G(%TO)="END") G S %GET=" ++,,HH#++,E,I" D ^%L1GET Q:%S=""!($G(%TO)="END") GN S %GET=" " D N^%L1GET Q:%S=""!($G(%TO)="END") S S %SCRN="",(%SCVA,%SCVG)=1 D A^%L1SC K %SCVA,%SCVG S %FNAME="",FRST=1 NU S MAC=" " K %L1 S %L1("EU")=1,%L1("BE")=6 N N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C AE K %Q S %Q("Z")="",%Q("U")="N" D ^%S1ASK I YES A K %Q S %Q("Z")="",%Q("X")="",%Q("Y")="",%Q("U")="" D ^%S2ASK I YES D S %GET=":jix`z++3,70,HH#"_$TR($$^%L1DC($H,1),"/.","")_"++8,D,I" D ^%L1GET Q:%S=""!($G(%TO)="END") %S2ERGN %S2ERG ; [ 02/11/92 11:50 AM ] BEG S $ZS="ERRRR^%S2ERG" M1 K U1,Y1 S %FLV=1,%FLI=0,%FLH=0,SDV=60 S:'$D(%TIP) %TIP="R" S:'$D(U) U=1 S:'$D(^S000($P,U)) ^S000($P,U)="" S:'$D(L) L=0 S:'$D(R) R=L+%GWUL M12 S %X=0,%Y=1,RL=1+R-L,%K=L D P M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 S %K=L+%X K U1,Y1,X1 M2 I '$D(^(U)) S ^(U)="" S %SS=^(U) U $P:(NOECHO:NOWRAP) 3 W:%FLI %vverxe,"+",U,":",$L(^(U)),":",%K+1,":",%Y,":",%X+1;,%chists S %YY=%Y,%XX=%X X %POSIC READ R *C I $L($ZB)=4,$D(%UPRCOD($ZB)) S C=$ZB G @%UPRCOD($ZB) I C=27 R *C1:0 G:C1=-1 27 R *C:0 G:C=-1 27 S C=C1_C G COM I C=0 R *C1:0 I C1>0 S C="0"_C1 COM I $D(%UPRCOD(C)) G @%UPRCOD(C) I C<127,C>31,'%FLV G READ1 G ERCOM:C<32&(C-31)&(C-29) READ0 I %FLV G:%K'<$L(^(U))!($L(^(U))=255) READ1 S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,255) D V S %XX=%X,%YY=%Y X %POSIC READ1 S ^(U)=$E(^(U),1,%K)_$J($C(C),%K-$L(^(U))+1)_$E(^(U),%K+2,255) W *C PRAVO I %X<(RL-1) S %K=%K+1,%X=%X+1 G:%FLI 3 W:C>127 %pravo G READ S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=1 D P G M13 MET G ^%S2ERG01 ; ESC S %XX=20,%YY=23 X %POSIC W ! U $P:(CENABLE) X %XCL U $P:(ECHO:WRAP:WIDTH=80) Q INS S TXT="INSERT" D STR1 I '%FLV S %FLV=1,%GTV="" H 1 G 3 I %FLV S %FLV=0 K %GTV S TXT="OVERLAY" D STR1 H 1 G 3 HBR S TXT="HEBREW" D STR1 I '%FLH S %FLH=1 S %HBRY="" W %HBR S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 I %FLH S %FLH=0 K %HBRY W %ENG S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-%Y+1 G M12 HELP D ^%S2ERHEL G BEG 2 G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 MOD G 5^%S2ERG02 FIND G 6^%S2ERG02 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^(I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^(I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FIND" D STR1 H 1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12^%S2ERG 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'230 S C=%K-%X,%K=%K\10+1*10,%X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=1 D P S %X=R-L,%K=R G M13 END S S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G 3 ENDL S S=$L(^(U)) G:S>" S %S=^(U),%6=20 D ^%L2ERSTR S ^(U)=%S K %S,%6 I %Y>18 S U1=U,U=U-%Y+1,Y1=%Y S:U<1 U=1 G M12 D P G 3 PGLN G 3:'L D SLEVO G M12 BK S %K=L,%X=0 G VNIZ HOME I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G 3 PGUP G 3:U'>%Y S U=U-%Y-19 S:U'>0 U=1 G M12 PGRG G 3:L>195 D SPRAVO G M12 SPRAVO S L=L+SDV,U1=U,Y1=%Y,U=U-%Y+1,R=R+SDV Q REST G 18^%S2ERG03 VNIZE W %vverxe F I=1:1:23 Q:'$D(^(U-%Y+I)) W %vniz S:'$D(^(U-%Y+I)) I=I-1 S U=U-%Y+I,%Y=I,%K=L,%X=0 G M2 DELL X "F I=U:1 Q:'$D(^(I+1)) S ^(I)=^(I+1)" K ^(I) S %X=0,%K=L D P G M2 ADDL G 3:%Y'<23 D VIR S %K=L,%X=0,%Y=%Y+1 D P G 3 ADD G:%K'<$L(^(U))!($L(^(U))=255) READ S ^(U)=$E(^(U),1,%K)_" "_$E(^(U),%K+1,255) D V G 3 PGDN G 3:'$D(^(U-%Y+21)) S U=U-%Y+21 G BEG+2 24 S $ZS="" X %chista S %ZT=$ZT U $P:(ECHO:WRAP:WIDTH=80) S ^ZE($P,"%ERG")=%TIP D ^%L1X 241 K ^ZE($P,"%ERG") S:$D(%ZT) $ZT=%ZT G:$ZS="" BEG X:%TIP="R" ^%ERG(1) Q ; G BEG ER24 W !,$ZS D ^%L1C S %PR="" G 24+1 XEC G 24 SAVE G 26^%S2ERG03 KOD F J=1:1:$L(^(U)) S %SMB=$E(^(U),J) I $A(%SMB)<123,$A(%SMB)>96 S $E(^(U),J)=$C($A(%SMB)-32) S SDV=0 D SLEVO S SDV=60 G M12 096 G KOD VVERX G:%Y=1 VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ S U=U+1,%Y=%Y+1 G MAINA:%Y=24,M2 LEVO G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 G M12 SLEVO S R=R-$S(L>SDV:SDV,1:L),L=$S(L>SDV:L-SDV,1:0) S U1=U,U=U-%Y+1,Y1=%Y Q SBROS G:^(U)=%SS 13 S ^(U)=%SS D V G 13 V S %YY=%Y,%XX=0 X %POSIC W %chists,$E(^(U),L+1,R+1) Q VVERXE S %K=L,U=U-%Y+1,%X=0,%Y=1 G M2 CHISTS S ^(U)=$E(^(U),1,%K) W %chists G 3 CHISTE F I=U:-1:1 Q:$E(^(I),1)'=" "&($E(^(I),1)'="") S %LAB=$P(^(I)," ",1) ZGE S TXT=" NUMBER ERASE LINE,BEGIN "_%LAB D STR1 K TXT W:U-I'=0 "+",U-I W " " U $P:(ECHO) R %COLUD G:%COLUD=0 3 UD I %COLUD="" S ^(U)=$E(^(U),1,%K) D V X %chiste F I=U+1:1 G:'$D(^(I)) 3 K ^(I) I %COLUD'?1N.N W *7," *** ERROR !" H 2 G ZGE I '$D(^(U+%COLUD)) S %COLUD="" G UD F I=U:1 Q:'$D(^(I+%COLUD)) S ^(I)=^(I+%COLUD) K ^(I+%COLUD) F I1=I:1 Q:'$D(^(I1)) K ^(I1) S %X=0,%K=L D P G M2 DEL G:%K>$L(^(U)) READ G:%K=$L(^(U)) 1271 S ^(U)=$E(^(U),1,%K)_$E(^(U),%K+2,255) D V G 3 1271 G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 S ^(U)=$E(^(U),1,%K) D V G 3 P S %YY=%Y,%XX=0 X %POSIC X %chiste I $O(^S000($P,1)) F I=0:1:23-%Y Q:'$D(^(I+U)) S %YY=I+%Y,%XX=0 X %POSIC W $E(^(I+U),L+1,R+1),%chists W %vverxe,%chists Q MAINA S:'$D(^(U)) ^(U)="" I $D(^S000($P,1)) W $C(27),"E",$E(^(U),L+1,R+1),%vverxe,%chists S %Y=23 G M2 VIRA R ! S U=U-1 D VIR:'U,P:%Y=1 S:%Y>1 %Y=%Y-1 S:C=164 S=$L(^(U)),%K=$S(SR:R,1:S),%X=%K-L G M2 VIR F I=U+1:1 Q:'$D(^(I)) X "F I=I:-1:U+2 S ^(I)=^(I-1)" S U=U+1,^(U)="" Q VIR1 F I=1:1 Q:'$D(^(I)) X "F I=I+%COLVS-1:-1:U+%COLVS+1 S ^(I)=^(I-%COLVS)" X "F I=U+1:1:U+%COLVS S ^(I)=""""" S U=U+1 Q ERXEC W !,"ERROR = ",$ZS S $ZS=%ZE G 24+1 ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 W %vverxe,%chists S %YY=0,%XX=10 X %POSIC W TXT K TXT Q FINDS K %SIMB S TXT="SEARCH KEY . INPUT SIMBOL ( - END SEARCH):" D STR1 U $P:(ECHO) R %SIMB I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ???" I $ZV["2.0" X ^%ERG Q ERRRR D ^%L1C S %XX=0,%YY=23 X %POSIC W %chists,*7,"ERROR:",$ZS,! W " 'X ^%ERG' AND '$'" Q %S2ERGP %S2ERGP ; [ 02/20/94 11:58 AM ] X %chista D HELP B U $P:(ECHO:WRAP:WIDTH=80) R !!,"COD SIMBOL (?,?? - HELP)> ",%KODSMB G:%KODSMB="" END I %KODSMB="?" D HELP G B I %KODSMB="??" D HELP1 G B W $C(%KODSMB) R " PRESS KEY > ",*%KEY G:%KEY=13 B I %KEY>31&(%KEY<160) W !,*7,"*** COD (",%KEY,") IS THE SIMBOL KOD ",$C(%KEY) S %Q("Z")="DO" D ^%S1ASK G:'YES B I $D(%UPRCOD(%KEY))#2 W !,*7,"*** COD (",%KEY,") USE IN EDITOR COMMAND ",%UPRCOD(%KEY) S %Q("Z")="DO" D ^%S1ASK G:'YES B S ^%MKOD(%KEY)=%KODSMB G B END S %Q("Z")="ERASE ALL UPDATE COD",%Q("U")="N" D ^%S1ASK I YES K ^%MKOD U $P:(NOECHO:NOWRAP) Q HELP ; W !! F I=176:1:191 W " ",$C(I) W ! F I=176:1:191 W $J(I,4) W !! F I=192:1:207 W " ",$C(I) W ! F I=192:1:207 W $J(I,4) W !! F I=208:1:223 W " ",$C(I) W ! F I=208:1:223 W $J(I,4) X %XCL Q HELP1 N N S N="" W !! F I=1:1 S N=$O(^%MKOD(N)) Q:N="" W:'(I#6) !! W $C(N)," ",$C(^(N))," " W ! Q %S2ERGS %S2ERGS ; [ 03.03.21 10:34 ] [ 06.07.03 09:03 ] [ 21.05.03 12:37 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C S RPCL=48,RCRT=20 K ^TMPS111($J) U $P:(NOECHO:NOWRAP) D ^%L1CERGS Z0 W #!!,"DEVICE (0,3):" S %S="0",%LS=1,CIST="03" D ^%ZMSL Q:%S="" S USTR=%S Z1 W !!,"PERIOD (DAYS) :" S %S="0",%LS=3 D ^%ZMSL G:$G(%TO)="END" Z0 G:%S="" Z0 I %S="?" W !?3,"ENTER NUMBER OF DAYS TO BACK FROM TODAY ( 0 - TODAY) " G Z1 I %S'?1N.N W *7," ???" G Z1 S DAY=%S Z2 S UCI=0 Z3 S %S="" W !!,"PROGRAMM NAME :" D ^%ZMSL G:$G(%TO)="END" Z2 S PROG=%S I $E(PROG,$L(PROG))="*" S PROG=$E(PROG,1,$L(PROG)-1) E S PROG=PROG_" " Z4 ; S DAT1=+$H-DAY-1 S %H=DAT1+1 K ^TMPS111($J) D W($J("",12)_$$^%L1DC(%H,1)_" - "_$$^%L1DC($H,1)) K ^s2ergs($P) S N=DAT1 F S N=$O(^%ERGS(N)) Q:N="" Q:N>+$H I $D(^(N))>9 D W(""),W($$^%L1DC(N,1),2) D .S N1="" F S N1=$O(^%ERGS(N,N1)) Q:N1="" I N1_" "[PROG D W(""),W(N1,5) D ..S ^s2ergs($P,N1)="" ..S N2="" F S N2=$O(^%ERGS(N,N1,N2)) Q:N2="" I $L($G(^(N2))) D W($G(^(N2)),15) S %S2V("NOHB")="" S %S2V("PROG")="VIEW^%S2ERGS" D ^%S2VIEW Q W(TXT,SM) ; S ^TMPS111($J,$O(^TMPS111($J,99999),-1)+1)=$J("",$G(SM))_TXT Q W1(TXT,SM) ; S ^S222($J,$O(^S222($J,99999),-1)+1)=$J("",$G(SM))_TXT Q ; VIEW ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,U) D ^%L1C K ^S999($J),^S222($J) M ^S999($J)=^TMPS111($J) N A,B,I,N,N1,N2,N3 S A=$$SPA^%L1FRM($G(^TMPS111($J,U))) ; I $P(A,".")'?."%"1U.UN Q S B="" F I=U:-1:1 S B=$$SPA^%L1FRM($G(^(I))) Q:B?2N1"."2N1"."2N Q:'B S %S2V("TXT1")=" "_A_" "_B_" " ; S N=$$^%L1DC(B,3),N1=A S N2="" F S N2=$O(^%ERGS(N,N1,N2)) Q:N2="" I $D(^(N2))>9 D W1($G(^(N2)),15) D .S N3="" F S N3=$O(^%ERGS(N,N1,N2,N3)) Q:N3="" S A=$G(^(N3)) D:$E(A)="[" W1("") D W1(A) K ^TMPS111($J) M ^TMPS111($J)=^S222($J) K ^S222($J) S %S2V("NOHB")="" D ^%S2VIEW K ^TMPS111($J) M ^TMPS111($J)=^S999($J) K ^S999($J) Q %S2ERGS0 %S2ERGS ; [ 27.02.01 9:40 AM ] [ 07/28/99 8:45 AM ] [ 02/03/96 1:13 PM ] S RPCL=48,RCRT=20 D ^%L1CERGS Z0 W #!!,"DEVICE (0,3):" S %S="0",%LS=1,CIST="03" D ^%ZMSL Q:%S="" S USTR=%S Z1 W !!,"PERIOD (DAYS) :" S %S="0",%LS=3 D ^%ZMSL G:$G(%TO)="END" Z0 G:%S="" Z0 I %S="?" W !?3,"ENTER NUMBER OF DAYS TO BACK FROM TODAY ( 0 - TODAY) " G Z1 I %S'?1N.N W *7," ???" G Z1 S DAY=%S Z2 W !! K %Q S %Q("Z")="UCI <"_$$^%L1ZU(0)_"> ONLY",%Q("U")="Y" D ^%S1ASK S UCI='YES S %S="" W !!,"PROGRAMM NAME :" D ^%ZMSL G:$G(%TO)="END" Z2 S PROG=%S I $E(PROG,$L(PROG))="*" S PROG=$E(PROG,1,$L(PROG)-1) E S PROG=PROG_" " I USTR O USTR::1 E S %SAY=" ! qetz "_USTR_" hxet " X %XMSGV(1) Q U USTR S DAT1=+$H-DAY-1 ; W !!!?20,$ZD(DAT1+1,"DD/MM/YY")," - ",$ZD($H,"DD/MM/YY"),!! K ^s2ergs($P) S N=DAT1 F S N=$O(^%ERGS(N)) Q:N="" Q:N>+$H S %DAT1=$ZD(N,"DD/MM/YY") W !?2,%DAT1,! D .S N1="" F S N1=$O(^%ERGS(N,N1)) Q:N1="" I N1_" "[PROG,$$FUNC^%UCASE($ZPARSE($G(^(N1)),"NAME"))=$P($$^%L1ZU(0),",")!($G(^(N1))="")!UCI W !?5,N1 D ..S ^s2ergs($P,N1)="" ..S N2="" F S N2=$O(^%ERGS(N,N1,N2)) Q:N2="" I $D(^(N2))#2,^(N2)'?.P W !?15,^(N2) ..I USTR=0!(USTR=$P),$Y>19 R !,"<>",YYY W # Q S N=DAT1 F S N=$O(^%ERGS(N)) Q:N="" Q:N>+$H S %DAT1=$ZD(N,"DD/MM/YY") D . S N1="" F S N1=$O(^%ERGS(N,N1)) Q:N1="" I N1_" "[PROG,$G(^(N1))=$P($$^%L1ZU(0),",")!($G(^(N1))="")!UCI D ..S N2="" F S N2=$O(^%ERGS(N,N1,N2)) Q:N2="" I $D(^(N2))#2,^(N2)'?.P S ^TEMP($P,I)=^(N2) ..I USTR=0!(USTR=$P),$Y>19 R !,"<>",YYY W # %S2GLSV %S2GLSV(MAC,FILE,PRM) ; [ 05.02.24 15:38 ] [ 04.02.24 15:12 ] [ 16.11.21 15:52 ] Q:$G(^S2GIB)'=1 D ^%S3GLSV($G(MAC),$G(FILE),$G(PRM)) ; Q %S2L %S2L N (%NMF) D ^%L1C ; [ 01/30/92 1:41 PM ] U 0 S PRT=$J I $D(%NMF) S %NMF1="" G IN Z1 G:$D(%NMF1) END S %S="" U 0 W !!,"FULL NAME OF HOST FILE (INPUT): " D ^%ZMSL G:%S="" END I %S="?" U $P:(ECHO:WRAP) D DIR^%OS U $P:(NOECHO:NOWRAP) G Z1 S %NMF=%S S USTR=3 O USTR::2 E U 0 W *7,"PRINTER IN USE !" G Z1 IN U USTR W !!?5,%NMF S %ER=$$^%L1ZOS(10,%NMF) I %ER<0 D ^%L1OS1 G Z1 O %NMF:(READONLY:REWIND):2 E U 0 W !,"*** FILE "_%NMF_" IN USE !" G Z1 I $ZC>0 D OE G Z1 F %I=1:1 U %NMF R %STRING Q:$ZC'=0 U USTR W %STRING,! C %NMF U USTR W !!! C USTR G:'$D(%NMF1) Z1 END K %NMF Q TE W *7,!,"TRANSFER ERROR $ZC=",$ZC Q OE W *7,"*** OPEN ERROR ! $ZC=",$ZC Q %S2LOADG %S2LOADG ; [ 08.04.03 3:20 PM ] [ 03.01.03 5:02 PM ] [ 27.02.01 9:44 AM ] W !,"D LOAD^%S2LOAD" Q 1 S $ZT="ERRRR^%S2ERG" X ^%ERG(4) F %E1=1:1 K:$G(TXT)'["ERROR " TXT W $C(27)_"[1;24r" D ^%S2ERG ZR X ^%ERG(6) I '%E D ^%L1C Q 101 K ^S000($P) S MAC1="^S200($P)",MAC2="^S000($P)" D ^%S1GC1 S %PR="$" 2 S $ZT="ER^%S2ERG" ZR ZL @%PR X ^%ERG(20),^%ERG(3),^%ERG(1) 20 S %TOP=$O(^ZE($P,""))-1 K:%TOP<1000 ^ZE($P) S:%TOP<1000 %TOP=100000 K ^ZE($P,%TOP+32) I $D(%PR) S ^ZE($P,%TOP)=%PR ZR ZL @%PR 3 K ^S000($P) S ^S000($P,1)="" F J=1:1 Q:$T(+J)="" S ^(J)=$T(+J) 4 K ^S222($P) M ^S222($P)=^S000($P) K L,R,TXT K:'$D(%L1ER) U S %TIP="R" I $D(^ZE($P))#2 S TXT=^ZE($P) 5 Q:$N(^S000($P,-1))=-1 F J=1:1 Q:'$D(^S000($P,J)) I ^(J)'="" S %LAB=$P($P(^(J)," ",1),"("),%E=^(J)'[" "!($L(%LAB)>8)!((%LAB'?.AN)&(%LAB'?1"%".AN)) ZI:'%E ^(J) I %E S U=J,L=0,R=80 W *7,!?20,"*** ERROR INTO ",J," LINE" K R H 2 ZR D ^%L1C X %XCL Q 6 S %E=0 Q:'$D(^S000($P,1)) X "F R !,""SAVE (Y/N) ?"",YES Q:""YyNnh""[$E(YES)&$L(YES)" I "Yyh"[$E(YES) S:$E(YES,2)=0 %ZS=0 X ^%ERG(10) X ^%ERG(7) I %E W *7 S TXT="ERROR IN LINE "_U_" COLUMN "_(L+1) S %SAY=TXT X %XMSGV K R H 2 ZR X %XCL Q 7 F W " NAME [ "_$G(%PR)_" ] :" R %PROG S:%PROG="" %PROG=%PR S %ER=$L(%PROG)>8!((%PROG'?1A.AN)&(%PROG'?1"%".AN)) W:%ER *7,!?30 I '%ER X ^%ERG(73) X ^%ERG(71) Q:%E X ^%ERG(9) S %PR=%PROG,^ZE($P)="^"_%PROG ZF Q 8 K %LS,CIST,%ECHO X ^%ERG(80) S:%TO="END" (%S,%PR)="^" X:%S="*"!(%TO="F7") ^%ERG(82) Q:%S="^" X:%S="?"!(%TO="F6") ^%ERG(85) Q:$G(FLAG)'="" X:%S="??" ^%ERG(83) X:%S?1U.E!(%S?1"%".E)&(%S["*"!(%S["?")) ^%ERG(84) X:%TO="UP"!(%TO="DW") ^%ERG(81) S %PR=%S 80 S %RP1=$S($E($ZE)="<":$P($P($ZE,"^",2),":"),1:$ZN) S:%RP1["%L1X"!(%RP1="") %RP1=$P($P($G(^ZE($P)),"^",2),":") S:$E(%RP1)="^" %RP1=$E(%RP1,2,9) S %FL="",$Y=23,$X=0,%GET="ROUTINE NAME [ NEW - <-> ] :++23,1,E,,,C#"_%RP1_"++8,E,I" N %BE D ^%L1GET 81 F X:'$D(%TOP) ^%ERG(20) X:%TO="UP" "I $D(^ZE($P,%TOP+1)) S %TOP=%TOP+1 S %S=^ZE($P,%TOP)" X:%TO="DW" "I $D(^ZE($P,%TOP+1)) S %TOP=%TOP+1 S %S=^ZE($P,%TOP)" S %S=%S_$J("",8-$L(%S)),$X=22,$Y=22,%TO="" D ^%ZMSL S %S=$TR(%S," ","") I %TO="" Q 82 K %L1 S (%S,%PR)="^" K ^L1ADR($J) X "N N S N="""" F S N=$O(^ZE($P,N)) Q:N="""" I $L($G(^ZE($P,N))) S ^L1ADR($J,^ZE($P,N))=""""" S %L1RM="" D ^%L1RGR1 K %L1RM S (%PR,%S)="^",%TO="" 83 D ^%L3RD 84 N %RS K %L1 S %L1RM="" D M^%L1RM K %L1RM S %S="a",%TO="" 85 S %S="",%PR="1" K %L1 S MAC="^ZE($P)",%L1("EU")=2,%L1("CD")=" " S %CLEAR=2 D ^%L1NU Q:FLAG'="" S %S=@MAC S %TO="" 9 W !,"COMMENT :",! S %S="" D ^%ZMSL S ^%ERGS(+$H,%PROG,$P($H,",",2))=%S M ^%ERGS(+$H,%PROG,$P($H,",",2))=^TMPS111($J) S ^%ERGS(+$H,%PROG)=$P($ZU(0),",") 10 X ^%ERG(102) S %CMM=$P(^S000($P,1)," ;",2,90) S %TIM=$ZD($H,"24:60") X ^%ERG(11) S %CMM=$P(%CMM," [ ")_" [ "_$$^%L1DC($H,1)_" "_%TIM1_" ] [ "_$P(%CMM,"[ ",2+%DFR,3+%DFR) S ^(1)=$P($G(^S000($P,1))," ;")_" ;"_%CMM 102 K ^UTILITY($J),^TMPS111($J) M ^UTILITY($J,1,"[ NEW ]")=^S000($P) M ^UTILITY($J,2,"[ OLD ]")=^S222($P) S ^UTILITY($J,1)="[ NEW ]",^UTILITY($J,2)="[ OLD ]" D ^%L2RCMP 11 S %DFR=0 S %DTOLD=$P($P(%CMM,"[ ",2)," ",1) I $$^%L1DC($H,1)=%DTOLD S %DFR=1 12 S %abc="",%ABC="" X "F %JJ=97:1:122 S %abc=%abc_$C(%JJ),%ABC=%ABC_$C(%JJ-32)" 71 ZR X ^%ERG(5) I '%E S:'$D(%ZS) %ZS=1 ZS @%PROG::%ZS S:%ZS (%E,U)=$ZA,L=$ZB-1 73 I $D(^ (%PROG)) ZR ZL @%PROG K ^S200($P) S ^S200($P,1)="" F J=1:1 Q:" "[$T(+J) S ^(J)=$T(+J) % D ^%L1C S %ZS=1 K %ECHO U 0:(0::::%OPT) D ^%S2ERGA W %ENG F %E=1:1 S $ZT="ER^%S2ERG" X ^%ERG(8),^%ERG(12) S %PR=$TR(%PR,%abc,%ABC) X %XCL K:%PR'="$" ^S000($P) Q:"^"[%PR X:%PR="$$" ^%ERG(101) I %PR?."%"."$".UN!(%PR="-") X ^%ERG("$-"'[%PR+1) LOAD K ^%ERG S ^%ERG=$P($T(%)," ",2,255) F I=3:1 S T=$T(+I) Q:T="" Q:$P(T," ")="%" I $P(T," ")?1N.N S ^%ERG($P(T," "))=$P(T," ",2,255) Q 1082 K %L1 S MAC="^ZE($P)",%L1("EU")=2,%L1("CD")=" " S %CLEAR=2 D ^%L1NU Q:FLAG'="" S %S=@MAC S %TO="" %S2V %S2V N (%NMF,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%S2V) D ^%L1C ; [ 04.01.04 12:04 ] [ 29.06.03 22:33 ] [ 18.06.03 09:06 ] S TS0=$C(96) F J=97:1:122 S TS0=TS0_$C(J) S TSS=$C(128) F J=129:1:154 S TSS=TSS_$C(J) U 0 S PRT=$J,%S="" I $D(%NMF) S %NMF1="" S:$E(%NMF,$L(%NMF))=">" %NMF1=">",%NMF=$E(%NMF,1,$L(%NMF)-1) G IN Z1 X %chista G:$D(%NMF1) END S %FL="" U 0 S %SAY=" VIEW FILE " X %XMSGV W !!,"FULL NAME OF HOST FILE (INPUT): " D ^%ZMSL G:%S=""!(%TO="END") END I %S="?" D O13^%L1OS S %S=$S($G(%PATH)'="":%PATH_"\",1:"")_$TR($E(%L2VNM,1,8)_"."_$E(%L2VNM,11,13)," ","") G Z1 S %NMF=%S IN U $P ;;W:'$L($G(%NMF1)) !!?5,%NMF ;;I '$L($ZSEARCH(%NMF)) G Z1 N $ZT S $ZT="ZG "_$ZL_":ER" K DOS C %NMF I $$^%L1ZOS(10,%NMF)<0 K ^TMPS111(PRT) G V O %NMF:(READONLY:REWIND) I %NMF'["LEVPC",'$L($G(%NMF1)),'$D(%S2V("TEXTFILE")) D Q:%S=""!(%TO="END") G @LAB .S %GET="LINUX FORMAT - 1 , DOS FORMAT - 2 , HEXA - 3++23,10,EE#1++1,E,I++123" .D ^%L1GET .I %S=3 D NOTEXT S LAB="V" .I %S=2 S DOS="" .S LAB="CYC" CYC K ^TMPS111(PRT) S %I1=0 F %I=1:1 U %NMF:(TERMINATOR=$C(13,10,26,27)) R %STRING Q:$ZEOF D I '(%I#500) U $P W "." W:'(%I#40000) ! U %NMF .N S S S=$E(%STRING,1,412) .S S=$TR(S,$C(12),"#") .N N S N="" F S N=$O(%CV(N)) Q:N="" S S=$$RPL^%L1FRM(S,%CV(N),"") .N N S N="" F S N=$O(%CV(N)) Q:N="" S S=$$RPL^%L1FRM(S,$TR(%CV(N),TS0,TSS),"") .S S=$$RPL^%L1FRM(S,"37m","") .S S=$$RPL^%L1FRM(S,$TR("37m",TS0,TSS),"") .I $D(DOS) S S=$P(S,$C(13)) .S %I1=%I1+1,^TMPS111(PRT,%I1)=$TR(S,TSS,TS0) C %NMF S $ZT="" V S U=1,%FLI=1 U $P:(NOECHO:NOWRAP:NOESC) D ^%S2VIEW I $G(%NMF1)=">" D ^%L1OUT K ^TMPS111(PRT) G:'$D(%NMF1) Z1 END C %NMF K %NMF Q ; NOTEXT ; U %NMF K ^TMPS111(PRT) F %I=1:1 S %ST="" D S ^TMPS111(PRT,%I)=%ST Q:$ZC'=0 I '(%I#50) U $P W "." U %NMF .F Q:$L(%ST)>47 U %NMF R *%A Q:$ZC'=0 S %ST=%ST_$TR($J($$^%L1ZH(%A),2)," ",0)_" " .S %ST1=%ST,%ST=%ST_$J("",50-$L(%ST1))_" ||" F %II=1:1:$L(%ST1," ") X "S %SMB=$$^%L1ZH("""_$P(%ST1," ",%II)_"#"")" S %SMB=$S(%SMB>31&(%SMB<128):$C(%SMB),1:" ") S %ST=%ST_%SMB C %NMF Q ER I $ZEOF!($ZS["IOEOF") C %NMF U $P G V U $P S %SAY=$$FUNC^%UCASE($ZS) X %XMSGV(1) S %OK=0 G CYC ;;Q:$D(%NMF1) K %Q S %Q("Z")="CONTINUE" D N^%S1ASK I 'YES Q:$D(%NMF1) G Z1 G V ; Z1 %S2VDB %S2VDB ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C X %chista S ^S2VDB=1 S %S2V("FIFO")="",%S2V("IND")=1,%S2V("TXT")="" O "S2VFIFO":FIFO RD H 1 Q:'$G(^S2VDB) U "S2VFIFO":(EXCEPTION="G RD") U "S2VFIFO" R %ZPOS:1 U $P:(NOECHO:NOWRAP) S %RNAME=$P($G(%ZPOS),"^",2) I %RNAME="" G RD S %S2V("RNAME")=%RNAME S %S2V("ZPOS")=%ZPOS D M1^%L1RV C "S2VFIFO" K ^S2VDB Q %S2VIEW %S2VIEW ;DJM;MAIN EDITOR; [ 03.03.21 10:19 ] [ 20.06.07 08:13 ] [ 08.03.07 08:00 ] ; INPUT: ^TMPS111($J, ; %S2V("TXT"),%S2V("TXT1") - HEADER ; %S2V("TXTN") - BOTTOM HEADER ; %S2V("VGR") - TOP SCREEN MARGIN ; %S2V("NGR") - BOTTOM SCREEN MARGIN ; %S2V("LEFT") - LEFT MARGIN ; %S2V("LAB") - ROUTINE LABEL(%TIP="R") OR LINE NUMBER (%TIP="G") ; %S2V("PRINT") - ASK FOR PRINT ; %S2V("PROG") - PROGRAMM NAME IF WAS PRESSED ; %S2V("IND") - LINE INDEX ON(=1) OR OFF (=0) ; %S2V("HBR") - VIEW DROM RIGHT SIDE ;---------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%S2V,%TIP,%Z,%JSP) D ^%L1C N $ZT,%ECHO S %HBRY="" I $D(%S2V("NOHB")) K %HBRY BEG ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" S %BG=1 I $D(%S2V("FIFO")) O "S2VFIFO":FIFO I '$D(^TMPS111($J,1)) S %SAY=" ! mipezp oi` " X %XMSGV(1) Q S %BEG=1 S %MOUSE=$$INIT^%L2MOUSE K %screen M1 D INIT M11 S:'$D(U) U=1 S:'$D(^TMPS111($J,U)) ^TMPS111($J,U)="" S:'$D(L) L=0 S:'$D(R) R=L+%S2GW S %XX=0,%YY=%S2V("VGR") I %S2V("VGR")=1!(%TYPCRT="PC") X %POSIC W %chists I $D(%S2V("FIFO")),$L($G(%S2V("ZPOS"))) U "S2VFIFO":(EXCEPTION="G M12") D I $L(%STROKA) G 1110 .S %ZPOS=%S2V("ZPOS"),%STROKA="" .S %RNAME=$P(%ZPOS,"^",2) Q:%RNAME="" .I %RNAME'=$G(%S2V("RNAME")) S %S2V("RNAME")=%RNAME D GETS1^%L1RV(%RNAME) .S %STROKA=$P(%ZPOS,"^") ; M12 S %X=0,%Y=%S2V("VGR"),RL=R-L+1,%K=L D USE I $D(%S2V("HBR")),%BG S %BG=0 G HOME D:'$D(%S2V("LAB")) P I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")),%BEG S %BEG=0 G VNIZE M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 S %K=L+%X K U1,Y1,X1 M2 I $G(TXT)'="" D STR1 I $G(TXT1)'="" D STR21 I $G(%S2V("TXTN"))'="" D STRN ;I $G(TXT)="" S %SAY=" - d`ivi , - mcew sc , - `ad sc " X %XMSGV I '$D(^TMPS111($J,U)) S ^(U)="" S %SS=^(U) D USE 3 K HOME,ENDS D USE I %FLI=1 W %vverxe,%CLI,"+",U,":",$L(^TMPS111($J,U)),":",%K+1,":",%Y,":",%X+1,%CCL ;,%chists ;X %XCL ;W ! I %FLI=2 W %vverxe,%LIGHT1,$S(%CVET&(%TYPCRT="PC"):%CV("CF"),%CVET:%CV("YF"),1:""),"LINE:",$J(U,3) W:$G(%S2V("IND"))'["." " POS:",$J(%K+1,3)," " W %CCL S %YY=%Y,%XX=%X X %POSIC READ ; I '$D(^TMPS111($J,1)) S ^(1)="" D ^%L1MSGBR I $D(%S2V("FIFO")) U "S2VFIFO":(EXCEPTION="G READ1") R %ZPOS:0 I $T D I $L(%STROKA) G 1110 .S %RNAME=$P(%ZPOS,"^",2) Q:%RNAME="" .I %RNAME'=$G(%S2V("RNAME")) S %S2V("RNAME")=%RNAME D GETS1^%L1RV(%RNAME) .S %STROKA=$P(%ZPOS,"^") READ1 D USE S C="" K C1,C2,C3,C4 G:$G(%PRKB) READ2 I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")) D G:C="ENTER"!(C="") 13 G:$A(C)<33 READ1 G:C'?1U.E READ G:$T(@C)="" READ G @C .S %L1NMB("VIEW")="" K %PRKB .W *27,7 S C=$$^%L1NMB("") W *27,8 .I $D(^TMPS111($J,1)) Q READ2 R *C:1 E K %PRKB G READ READ21 G:%TYPCRT="PC" C27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G:$T(@%UPRCOD(ZB))="" READ G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC ; C27 I C=27 D DELAY R:'$D(%FLL) *C1:%WAIT G:C1<0 ESC D I CC,$D(%UPRCOD(CC)),$T(@%UPRCOD(CC))'="" K %FLL G @%UPRCOD(CC) .S CC="" Q:C1=27 D DELAY R:'$D(%FLL) *C2:%WAIT Q:C2<0 Q:C2=27 S:C2>0 CC=C1_C2 Q:$D(%UPRCOD(CC)) .R:'$D(%FLL) *C3:%WAIT Q:C3<0 Q:C3=27 S:C3>0 CC=CC_C3 Q:$D(%UPRCOD(CC)) .R:'$D(%FLL) *C4:%WAIT Q:C4=27 S:C4>0 CC=CC_C4 I $G(C1)=27 K C1 S C=27 G C27 I $G(C2)=27 K C2 S C=27 G C27 I $G(C3)=27 K C3 S C=27 G C27 I $G(C4)=27 K C4 S C=27 G C27 I $G(C)=27 G C27 ; I C=0 R *C1:%WAIT I C1>0 S C="0"_C1 I C=2,$D(^%dbg)#2 S ^%dbg(+^%dbg,"B",U)="+"_U_"^"_$P(^%dbg(+^%dbg),"^",2) I $D(^TMPS111($J,1)) S ^(U)=%CLI_^(U) G M12 COM I $D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" G @%UPRCOD(C) I $C($E(C))="=" G ESC I C<127,C>31 G READ G ERCOM:C<32&(C-31)&(C-29) G READ PRAVO I %X<(RL-1) S %K=%K+1,%X=%X+1 G:%FLI 3 W %pravo G READ S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=%S2V("VGR") D P G M13 MET G 1 27 ; ESC S %XX=22,%YY=23 X %POSIC W:'$D(%S2V("PRINT")) ! I $D(%S2V("PRINT")),@(%L1DEV_">2") S %GET=" 99 - qitcdl , 96 - xenyl , 95 - xeciyl oikdl " D N^%L1GET I %S>94 D .X %chista S PRT=$J S USTR=3,%DEV="USTR",%L1OUT("PRINTER")="",%L1OUT("KOT")=$G(%S2V("TXT1")),%L1OUT("S2V")="" .I $D(%S2V("PRINT","KOT"))#2 S %L1OUT("KOT")=%S2V("PRINT","KOT") .N N S N="" F S N=$O(%S2V("PRINT","KOT",N)) Q:N="" S %L1OUT("KOT",N)=%S2V("PRINT","KOT",N) .S %L1OUT("DAF")="" S:$D(%S2V("PRINT","SMALL")) %L1OUT("PRINTER","SMALL")="" .I $D(%S2V("PRINT","SM"))#2 S %L1OUT("SM")=%S2V("PRINT","SM") .I %S=96!(%S=95) D ..N OTB S OTB=%S ..F S %GETHB="" S %GET=": dxrd #30" D N^%L1GET S HEARA=%S Q:$L(HEARA) ..K %GETHB ..N SUGM S @("SUGM="_%L1SUG) ..I OTB=95 K %L1LPT("SND") D Q:'$G(%L1LPT("SND")) ZM ...S %GET=": fkxnl xeciyl oikdl ++13,60,HH,,R#++4,E,I++++++^MRKZ\\\\VP" D ^%L1GET Q:%S=""!(%TO="END") ...S %L1LPT("SND")=%S I %L1LPT("SND")=$$^%L1MRK S %SAY=" ! jnvrl xcyl mrh oi` " X %XMSGV(1) G ZM ...S %L1LPT("SND","ARX")=$G(%S2V("TXT1"))_"\"_SUGM_"\"_HEARA ..I OTB=96 K %L1("ARX") S %L1LPT("ARX")=$G(%S2V("TXT1"))_"\"_SUGM_"\"_HEARA ..S %L1LPT("DEV")=54,USTR=3 .N %S2V D Z31^%L1OUT .U 0 S %GET="" D N^%L1GET ;;U 0 W $C(27,91),"1;1;24;80w" ;;W $C(27,91),"1;24r" I %TYPCRT'="PC" S %XX=1,%YY=%S2V("NGR") X %POSIC W ! X %XCL ;;I $D(%ECHO) U $P:(ECHO) I %TYPCRT["VT5" U 0 W $C(27),"[?3l" I $$HZGTOUCH^%L2MOUSE S %XX=0,%YY=22 X %POSIC,%chiste H .5 I $D(^TMPS111($J,1)) K %S2V,%L1NMB C:$D(%S2V("FIFO")) "S2VFIFO" Q HBR I '$D(%HBRY) S TXT="HEBREW" D STR1 S %HBRY="" S X1=%X,Y1=%Y,U1=U S U=U-(%Y-%S2V("VGR")+1)+1 G M12 I $D(%HBRY) K %HBRY S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-(%Y-%S2V("VGR")+1)+1 G M12 MOD G 3 FIND G 6 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^TMPS111($J,I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^TMPS111($J,I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 ; S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FOUND" D STR1 H 1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'230 S C=%K-%X,%K=%K\10+1*10,%X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=%S2V("VGR") D P S %X=R-L,%K=R G M13 END S S=$L(^TMPS111($J,U)),%K=$S(SR:R,1:S),%X=%K-L G 3 ENDS ; ENDL S ENDS="" I $D(%S2V("HBR")),'$D(HOME) G HOME S S=$L(^TMPS111($J,U)) I S>R S SDV=S-R D SPRAVO S %X=0,%Y=%S2V("VGR"),RL=1+R-L,%K=L D P S %X=0,%Y=%S2V("VGR"),RL=1+R-L,%K=L D P ;? S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 K U1,Y1 S %K=S,%X=%K-L S SDV=60 G 3 PGLN G 3:'L D SLEVO G M12 COR S %L1WE="" S %YY=19,%XX=0 X %POSIC W %chists,"<>" S %S=^TMPS111($J,U),%6=20 D ^%L2ERSTR R YYY S U1=U,U=U-(%Y-%S2V("VGR")+1)+1,Y1=%Y S:U<1 U=1 G M12 ;;D P G 3 13 ; BK S %K=L,%X=0 G VNIZ HOME S HOME="" I $D(%S2V("HBR"))&'$D(ENDS) G ENDL I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G M12 ;;3 PGUP I U'>(%Y-%S2V("VGR")+1) S %SAY=" ! mipezp zligz " X %XMSGV(1) G 3 S U=U-(%Y-%S2V("VGR")+1)-%S2V("RSTR")+1 S:U'>0 U=1 G M12 PGRG G 3:L>195 D SPRAVO G M12 SPRAVO S L=L+SDV,U1=U,Y1=%Y,U=U-(%Y-%S2V("VGR")+1)+1,R=R+SDV Q VNIZE D VNIZE1 G M2 VNIZE1 W %vverxe F I=1:1:%S2V("NGR")-1 Q:'$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+I)) W %vniz S:'$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+I)) I=I-1 S U=U-(%Y-%S2V("VGR")+1)+I,%Y=I,%K=L,%X=0 Q PRSC ; D ^%L1PRSC G M2 PGDW ; PGDN ; I '$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+%S2V("RSTR")+1)) S %SAY=" ! mipezpd seq " X %XMSGV(1) G 3 S U=U-(%Y-%S2V("VGR")+1)+%S2V("RSTR")+1 G BEG+2 VVERX G:%Y=%S2V("VGR1") VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ S U=U+1,%Y=%Y+1 G MAINA:(%Y+1)'<%S2V("NGR"),M2 LEVO G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 G M12 SLEVO S R=R-$S(L>SDV:SDV,1:L),L=$S(L>SDV:L-SDV,1:0) S U1=U,U=U-(%Y-%S2V("VGR")+1)+1,Y1=%Y Q SBROS G:^TMPS111($J,U)=%SS 13 S ^(U)=%SS D V G 13 V S %YY=%Y,%XX=$S(%TYPCRT="PC":0,1:%S2V("LEFT")) S:%XX<0 %XX=0 X %POSIC W %chists D W(U,L+1,R) Q VVERXE S %K=L,U=U-(%Y-%S2V("VGR1")+1)+1,%X=0,%Y=%S2V("VGR1") G M2 P S %XX=%S2V("LEFT") D I $O(^TMPS111($J,1)) .I $O(^TMPS111($J,1)) .;I %S2V("NGR")>23 S %XX=%S2V("LEFT"),%YY=%S2V("VGR") X %POSIC,%chiste Q .F I=%Y:1:%S2V("NGR") S %YY=I X %POSIC W $J("",%S2V("RIGHT")-%S2V("LEFT")) F I=0:1:%S2V("RSTR")-1 Q:'$D(^TMPS111($J,I+U)) S %YY=I+%Y,%XX=$S(%TYPCRT="PC":0,1:%S2V("LEFT")) X %POSIC D W(I+U,L+1,R) X %XCL W %chists ;W %vverxe,%chists Q Q MAINA G:'$D(^TMPS111($J,1)) 3 S:'$D(^TMPS111($J,U)) ^(U)="" X %XCL W ! S %XX=0,%YY=%S2V("VGR")-1 X %POSIC W %chists S %Y=%S2V("NGR")-1 D V G M2 ;;S U1=U,U=U-%S2V("RSTR")+1,Y1=%S2V("NGR") G M12 VIRA ; G:U<(%S2V("U1")+1) 3 S U=U-1 X %XCL I %TYPCRT="PC",%S2V("RIGHT")-%S2V("LEFT")<80 D D V G M2 .D GET^%VIDEO("%s2view",%S2V("LEFT"),%S2V("VGR1"),%S2V("RIGHT")-%S2V("LEFT")+1,%S2V("NGR1")-%S2V("VGR1")-1,2) .D PUT^%VIDEO("%s2view",%S2V("LEFT"),%S2V("VGR1")+1,%S2V("RIGHT")-%S2V("LEFT")+1,%S2V("NGR1")-%S2V("VGR1")-1,2) .k %s2view I $E(%TYPCRT,1,3)="VT5" D D V G M2 .W $C(27,91),(%S2V("VGR1")+1)_";"_%S2V("LEFT")_";"_(%S2V("NGR1")-1)_";"_%S2V("RIGHT")_";;"_(%S2V("VGR1")+2)_";"_%S2V("LEFT")_";$v" S:C=164 S=$L(^TMPS111($J,U)),%K=$S(SR:R,1:S),%X=%K-L ;G M2 D P G M2 Q ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 ;I $D(TXT) S %SAY=TXT X %XMSGV(1) K TXT Q ;W %vverxe,%chists S %YY=0,%XX=19 X %POSIC W %CLI,TXT K:'$D(TXT(1)) TXT X %XCL Q I $D(TXT) W %vverxe,%chists S %YY=0,%XX=19 X %POSIC W %CLI,$$^%L1HB(TXT)," " K:'$D(TXT(1)) TXT X %XCL Q STR21 S %SAY=$$^%L1HB(TXT1) X %XMSGV Q STRN S %SAY=$$^%L1HB(%S2V("TXTN")) X %XMSGN Q FINDS K %SIMB S TXT="SEARCH KEY . INPUT SIMBOL ( - END SEARCH):" D STR1 U $P:(ECHO) R %SIMB D USE I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ???" Q 1 W %vverxe,%chists G:%TIP'="R" 1111 S TXT=" LABEL <"_$P(^TMPS111($J,1)," ",1)_"> " D STR1 U $P:(ECHO) R %STROKA 1110 D USE I %STROKA="-" W %vverxe,%chists G 3 I $D(^TMPS111($J,1)) S:%STROKA="" %STROKA=$P(^TMPS111($J,1)," ",1) S %STROKA1=$P(%STROKA,":",1) S %=$S(%STROKA1["+":"+",%STROKA1["-":"-",1:" ") S %LAB=$P(%STROKA1,%,1) I %LAB="",%="+" S I=0,%SM=+$P(%STROKA,"^") G 11101 S:%LAB="" %LAB=$P(^TMPS111($J,1)," ",1) S %LAB=$P(%LAB,"(") S %E='(%LAB?1"%".UN!(%LAB?.UN)) I '%E S %SM=$P(%STROKA1,%,2) S:%SM="" %SM=0 S:%'=" " %SM=%_%SM S %E='(%SM?1"+"1N.N!(%SM?1"-"1N.N)!(%SM?1N.N)) I %E W *7," LABEL ISN'T RIGHT !" H 2 G 1 F I=1:1 Q:'$D(^TMPS111($J,I)) Q:$P($P(^(I)," ",1),"(")=%LAB I '$D(^(I)) W *7," LABEL NOT !" H 2 G 1 11101 I '$D(^TMPS111($J,I+%SM)) W *7," OFFSET TOO LARGE !" H 2 G 1 S U=I+%SM,L=0,R=L+%S2GW K %STROKA,%STROKA1,%LAB,%SM,%E,% G M12 ; 1111 U $P:(ECHO) R " LINE NUMBER <1> ",%STROKA D USE S:%STROKA="" %STROKA="1" I %STROKA="-" G 3 S %LAB=$P(%STROKA,":",1) S:%LAB="" %LAB=1 S %E='(%LAB?1"+"1N.N!(%LAB?1N.N)) I %E W *7," NUMBER ISN'T RIGHT !" H 2 G 1 I '$D(^TMPS111($J,%LAB)) W *7," NUMBER TOO LARGE !" H 2 G 1 S U=%LAB,L=0,R=L+%S2GW K %STROKA,%STROKA1,%LAB,%E G M1+2 Q 6 S TXT="FIND : " D STR1 U $P:(ECHO) S %LS=20,%S="" D ^%ZMSL S C=%S D USE I $D(^TMPS111($J,1)) I C="" G ERCOM:'$D(RAZ) S C=RAZ S RAZ=C,J=%K+2 F C=U:1 Q:'$D(^TMPS111($J,C)) S J=$F(^TMPS111($J,C),RAZ,J) Q:J W:'J *7," NOT" W " FOUND" G 3:'J S J=J-$L(RAZ)-1 S %Y=C-U+%Y,%X=J-%K+%X,U=C,%K=J I %X0)) S L=J,R=L+RL-1 G M12 I %X<0,J-RL<0 S L=0,R=L+RL-1,X1=J,Y1=1 G M12 S %Y=%S2V("VGR"),X1=%X G M12 ;;STR1 W %vverxe,%chists,! S %YY=0,%XX=5 X %POSIC W TXT K TXT Q ENDF F I=U+1:1 Q:'$D(^TMPS111($J,I)) S U=I-%S2V("RSTR") S:U<1 U=1 S L=0 G M11 BEGF S U=1,L=0 G M11 SAVE ; I $D(%S2V("PROG")) S U1=U,Y1=%Y,X1=%X D S U=U1-$S($G(%MET)="M2":0,1:Y1-$G(%S2V("VGR"))) K:%MET="M2" U1,Y1,X1 G @%MET .N U S U=U1 N U1 .I $D(%S2V("SV")) D SV .U 0 I %S2V("VGR")>1!(%S2V("NGR")<24) W $C(27,91),"1;1;24;80w" .X %XCL .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S2V,s2view,U,%MET) D ^%L1C ;;S %OPT=65 .I $D(%S2V("JSP")) S %JSP=%S2V("JSP") .S %N="" F S %N=$O(%S2V("PROG",%N)) Q:%N="" S @%N=%S2V("PROG",%N) .K ^S2VTMPS111($J,$ZL) M ^S2VTMPS111($J,$ZL)=^TMPS111($J) .I $O(^TMPS111($J,U)) S zl=$ZL .D @%S2V("PROG") X:'$D(%S2V("PROGNCA")) %chista .S %MET="BEG" D INIT .D:$D(%S2V("SV")) REST .K ^TMPS111($J) M ^TMPS111($J)=^S2VTMPS111($J,$ZL) K ^S2VTMPS111($J,$ZL) .I $O(^TMPS111($J,1)) S %GET=" SAVE LINE[,COLUMN] <1> #6" D VE^%L1GET S C=%S S:C="" C=1 G:C="-" 3 G SAVE:C'?.N.",".N G:C'=0 260 W " ERASE OLD ARRAY (Y/N) :" R "?",*I G 3:I=%S2GW,SAVE+2:I-89 W *I K %Z G 3 260 I $D(%Z) S YES=0 F %J=0:0 Q:"123"[YES&($L(YES)=1) W %vverxe,%chists U $P:(ECHO) R " OLD ARRAY: ERASE - 1,LOOK - 2,TO ADD - 3 <1> ",YES D USE S:YES="" YES=1 I $D(%Z) K:YES=1 %Z I YES=2 W # X "F J=1:1 Q:'$D(%Z(J)) W !,%Z(J)" R !!?40,"PRESS ",YES S U1=U,Y1=%Y,X1=%X,U=U-(%Y-%S2V("VGR")+1)+1,%Y=%S2V("VGR"),%X=0 D P S U=U1,%Y=Y1,%X=X1 K U1,Y1,X1 G 260 S:'$D(%Z) %Z=0 S I=999.3 S:C["," I=+$P(C,",",2) S C=+C F J=1:1:C Q:'$D(^TMPS111($J,U+J-1)) S %S=$E(^TMPS111($J,U+J-1),%K,%K+I) S:I'=999.3 %S=%S_$J("",I-$L(%S)) S %Z(%Z+J)=$TR(%S,$C(9)," ") S %Z=%Z+J-'$D(%Z(%Z+J)) K:'%Z %Z G 3 Q INIT S %FLV=1 S:$D(%S2V("IND")) %FLI=+%S2V("IND") I $D(^TMPS111($J,1)) S:'$D(%FLI) %FLI=0 S SDV=60 S:'$D(%TIP) %TIP="G" I '$D(%S2V("U1")) S %S2V("U1")=1 I $G(%S2V("U"))>1 S U=%S2V("U") I '$D(%S2V("NGR")) S %S2V("NGR")=24 I '$D(%S2V("VGR")) S %S2V("VGR")=1 I '$D(%S2V("LEFT")) S %S2V("LEFT")=0 I '$D(%S2V("RIGHT")) S %S2V("RIGHT")=79 ;;S %HBRY="" I $D(%S2V("NOHB")) K %HBRY I $E(%TYPCRT,1,3)="VT5",$D(%S2V("SMALL")) S %S2V("RIGHT")=132 W $C(27),"[?3h" I %S2V("VGR")<1 S %S2V("VGR")=1 I %S2V("NGR")>24 S %S2V("NGR")=24 I %S2V("NGR")>21,$$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")) S %S2V("NGR")=21 I $D(^TMPS111($J,1)) S TXT=$G(%S2V("TXT")) S TXT1=$G(%S2V("TXT1")) S %S2V("RSTR")=%S2V("NGR")-%S2V("VGR") S %S2GW=%S2V("RIGHT")-%S2V("LEFT") D USE W *27,"["_%S2V("VGR")_";"_%S2V("LEFT")_";"_%S2V("NGR")_";"_%S2V("RIGHT")_"w" S:'$D(%S2V("VGR1")) %S2V("VGR1")=%S2V("VGR") S:'$D(%S2V("NGR1")) %S2V("NGR1")=%S2V("NGR") W *27,"["_%S2V("VGR1")_";"_%S2V("NGR1")_"r" Q XEC ; D ^%L1CLC D USE G 3 ; SV D:'$D(%TYPCRT) ^%L1C I %TYPCRT="PC" D GET^%VIDEO("s2view",0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;;;;2$v" Q Q REST D:'$D(%TYPCRT) ^%L1C ; I %TYPCRT="PC" D PUT^%VIDEO("s2view",0,0,80,24,2) K s2view S %MET="M2" Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;2;;;$v" S %MET="M2" Q S %MET="BEG" Q W(U,L,R) I '$D(%HBRY) W $E(^TMPS111($J,U),L,R) Q N %A S %A=^TMPS111($J,U) S %A=$$RPL^%L1FRM(%A,%CLI,"<%CLI>") S %A=$$RPL^%L1FRM(%A,%CCL,"<%CCL>") ;;S %A=$TR($TR($E(%A,L,R),%TES1,%TES2),%TEN,%THB) S %A=$$W^%L1C(%A) S %A=$$RPL^%L1FRM(%A,"<%CLI>",%CLI) S %A=$$RPL^%L1FRM(%A,"<%CCL>",%CCL) W %A Q MDRG G HBR USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q DELAY ; N %II I %TYPCRT="PC1" F %II=1:1:6000 Q %S2VIEW0 %S2VIEW ;DJM;MAIN EDITOR; [ 10.04.09 12:17 ] [ 08.03.07 08:00 ] [ 24.10.06 07:57 ] ; INPUT: ^TMPS111($J, ; %S2V("TXT"),%S2V("TXT1") - HEADER ; %S2V("TXTN") - BOTTOM HEADER ; %S2V("VGR") - TOP SCREEN MARGIN ; %S2V("NGR") - BOTTOM SCREEN MARGIN ; %S2V("LEFT") - LEFT MARGIN ; %S2V("LAB") - ROUTINE LABEL(%TIP="R") OR LINE NUMBER (%TIP="G") ; %S2V("PRINT") - ASK FOR PRINT ; %S2V("PROG") - PROGRAMM NAME IF WAS PRESSED ; %S2V("IND") - LINE INDEX ON(=1) OR OFF (=0) ; %S2V("HBR") - VIEW DROM RIGHT SIDE ;---------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%S2V,%TIP,%Z) D ^%L1C N $ZT,%ECHO S %HBRY="" I $D(%S2V("NOHB")) K %HBRY BEG ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%L1X" S %BG=1 I $D(%S2V("FIFO")) O "S2VFIFO":FIFO I '$D(^TMPS111($J,1)) S %SAY=" ! mipezp oi` " X %XMSGV(1) Q S %BEG=1 S %MOUSE=$$INIT^%L2MOUSE K %screen M1 D INIT M11 S:'$D(U) U=1 S:'$D(^TMPS111($J,U)) ^TMPS111($J,U)="" S:'$D(L) L=0 S:'$D(R) R=L+%S2GW S %XX=0,%YY=%S2V("VGR") I %S2V("VGR")=1!(%TYPCRT="PC") X %POSIC W %chists I $D(%S2V("FIFO")),$L($G(%S2V("ZPOS"))) U "S2VFIFO":(EXCEPTION="G M12") D I $L(%STROKA) G 1110 .S %ZPOS=%S2V("ZPOS"),%STROKA="" .S %RNAME=$P(%ZPOS,"^",2) Q:%RNAME="" .I %RNAME'=$G(%S2V("RNAME")) S %S2V("RNAME")=%RNAME D GETS1^%L1RV(%RNAME) .S %STROKA=$P(%ZPOS,"^") ; M12 S %X=0,%Y=%S2V("VGR"),RL=R-L+1,%K=L D USE I $D(%S2V("HBR")),%BG S %BG=0 G HOME D:'$D(%S2V("LAB")) P I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")),%BEG S %BEG=0 G VNIZE M13 S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 S:$D(X1) %X=X1 S %K=L+%X K U1,Y1,X1 M2 I $G(TXT)'="" D STR1 I $G(TXT1)'="" D STR21 I $G(%S2V("TXTN"))'="" D STRN ;I $G(TXT)="" S %SAY=" - d`ivi , - mcew sc , - `ad sc " X %XMSGV I '$D(^TMPS111($J,U)) S ^(U)="" S %SS=^(U) D USE 3 K HOME,ENDS D USE I %FLI=1 W %vverxe,%CLI,"+",U,":",$L(^TMPS111($J,U)),":",%K+1,":",%Y,":",%X+1,%CCL ;,%chists ;X %XCL ;W ! I %FLI=2 W %vverxe,%LIGHT1,$S(%CVET&(%TYPCRT="PC"):%CV("CF"),%CVET:%CV("YF"),1:""),"LINE:",$J(U,3) W:$G(%S2V("IND"))'["." " POS:",$J(%K+1,3)," " W %CCL S %YY=%Y,%XX=%X X %POSIC READ ; I '$D(^TMPS111($J,1)) S ^(1)="" D ^%L1MSGBR I $D(%S2V("FIFO")) U "S2VFIFO":(EXCEPTION="G READ1") R %ZPOS:0 I $T D I $L(%STROKA) G 1110 .S %RNAME=$P(%ZPOS,"^",2) Q:%RNAME="" .I %RNAME'=$G(%S2V("RNAME")) S %S2V("RNAME")=%RNAME D GETS1^%L1RV(%RNAME) .S %STROKA=$P(%ZPOS,"^") READ1 D USE S C="" K C1,C2,C3,C4 G:$G(%PRKB) READ2 I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")) D G:C="ENTER"!(C="") 13 G:$A(C)<33 READ1 G:C'?1U.E READ G:$T(@C)="" READ G @C .S %L1NMB("VIEW")="" K %PRKB .W *27,7 S C=$$^%L1NMB("") W *27,8 .I $D(^TMPS111($J,1)) Q READ2 R *C:1 E K %PRKB G READ READ21 G:%TYPCRT="PC" C27 S ZB="",ZB0=$ZB F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27 G:$T(@%UPRCOD(ZB))="" READ G @%UPRCOD(ZB) I $A($E(ZB0))=27,ZB=113 G ESC ; C27 I C=27 D DELAY R:'$D(%FLL) *C1:%WAIT G:C1<0 ESC D I CC,$D(%UPRCOD(CC)),$T(@%UPRCOD(CC))'="" K %FLL G @%UPRCOD(CC) .S CC="" Q:C1=27 D DELAY R:'$D(%FLL) *C2:%WAIT Q:C2<0 Q:C2=27 S:C2>0 CC=C1_C2 Q:$D(%UPRCOD(CC)) .R:'$D(%FLL) *C3:%WAIT Q:C3<0 Q:C3=27 S:C3>0 CC=CC_C3 Q:$D(%UPRCOD(CC)) .R:'$D(%FLL) *C4:%WAIT Q:C4=27 S:C4>0 CC=CC_C4 I $G(C1)=27 K C1 S C=27 G C27 I $G(C2)=27 K C2 S C=27 G C27 I $G(C3)=27 K C3 S C=27 G C27 I $G(C4)=27 K C4 S C=27 G C27 I $G(C)=27 G C27 ; I C=0 R *C1:%WAIT I C1>0 S C="0"_C1 I C=2,$D(^%dbg)#2 S ^%dbg(+^%dbg,"B",U)="+"_U_"^"_$P(^%dbg(+^%dbg),"^",2) I $D(^TMPS111($J,1)) S ^(U)=%CLI_^(U) G M12 COM I $D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" G @%UPRCOD(C) I $C($E(C))="=" G ESC I C<127,C>31 G READ G ERCOM:C<32&(C-31)&(C-29) G READ PRAVO I %X<(RL-1) S %K=%K+1,%X=%X+1 G:%FLI 3 W %pravo G READ S SDV=1 D SPRAVO S SDV=60,%K=%K+1,RL=1+R-L,%Y=%S2V("VGR") D P G M13 MET G 1 27 ; ESC S %XX=22,%YY=23 X %POSIC W:'$D(%S2V("PRINT")) ! I $D(%S2V("PRINT")),@(%L1DEV_">2") S %GET=" 99 - qitcdl , 96 - xenyl , 95 - xeciyl oikdl " D N^%L1GET I %S>94 D .X %chista S PRT=$J S USTR=3,%DEV="USTR",%L1OUT("PRINTER")="",%L1OUT("KOT")=$G(%S2V("TXT1")),%L1OUT("S2V")="" .I $D(%S2V("PRINT","KOT"))#2 S %L1OUT("KOT")=%S2V("PRINT","KOT") .N N S N="" F S N=$O(%S2V("PRINT","KOT",N)) Q:N="" S %L1OUT("KOT",N)=%S2V("PRINT","KOT",N) .S %L1OUT("DAF")="" S:$D(%S2V("PRINT","SMALL")) %L1OUT("PRINTER","SMALL")="" .I $D(%S2V("PRINT","SM"))#2 S %L1OUT("SM")=%S2V("PRINT","SM") .I %S=96!(%S=95) D ..N OTB S OTB=%S ..F S %GETHB="" S %GET=": dxrd #30" D N^%L1GET S HEARA=%S Q:$L(HEARA) ..K %GETHB ..N SUGM S @("SUGM="_%L1SUG) ..I OTB=95 K %L1LPT("SND") D Q:'$G(%L1LPT("SND")) ZM ...S %GET=": fkxnl xeciyl oikdl ++13,60,HH,,R#++4,E,I++++++^MRKZ\\\\VP" D ^%L1GET Q:%S=""!(%TO="END") ...S %L1LPT("SND")=%S I %L1LPT("SND")=$$^%L1MRK S %SAY=" ! jnvrl xcyl mrh oi` " X %XMSGV(1) G ZM ...S %L1LPT("SND","ARX")=$G(%S2V("TXT1"))_"\"_SUGM_"\"_HEARA ..I OTB=96 K %L1("ARX") S %L1LPT("ARX")=$G(%S2V("TXT1"))_"\"_SUGM_"\"_HEARA ..S %L1LPT("DEV")=54,USTR=3 .N %S2V D Z31^%L1OUT .U 0 S %GET="" D N^%L1GET ;;U 0 W $C(27,91),"1;1;24;80w" ;;W $C(27,91),"1;24r" I %TYPCRT'="PC" S %XX=1,%YY=%S2V("NGR") X %POSIC W ! X %XCL ;;I $D(%ECHO) U $P:(ECHO) I %TYPCRT["VT5" U 0 W $C(27),"[?3l" I $$HZGTOUCH^%L2MOUSE S %XX=0,%YY=22 X %POSIC,%chiste H .5 I $D(^TMPS111($J,1)) K %S2V,%L1NMB C:$D(%S2V("FIFO")) "S2VFIFO" Q HBR I '$D(%HBRY) S TXT="HEBREW" D STR1 S %HBRY="" S X1=%X,Y1=%Y,U1=U S U=U-(%Y-%S2V("VGR")+1)+1 G M12 I $D(%HBRY) K %HBRY S TXT="ENGLISH" D STR1 S X1=%X,Y1=%Y,U1=U S U=U-(%Y-%S2V("VGR")+1)+1 G M12 MOD G 3 FIND G 6 IND I %FLI S %FLI=0 S TXT="INDEX OUT" D STR1 H 1 G 3 S %FLI=1 G 3 TABN G:'$D(%SIMB) 810 S %KK=%K F I=U:-1:1 S %OPOZ=0 S:U'=I %KK=$L(^TMPS111($J,I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^TMPS111($J,I),%SIMB,%OPOZ) Q:J>%KK!(J=0)!(%KK=0) S %OPOZ=J Q 802 ; S TXT="" S:I=1&'%OPOZ TXT=" NOT" S TXT=TXT_" FOUND" D STR1 H 1 G 3:'%OPOZ S %OPOZ=%OPOZ-$L(%SIMB)-1 S %Y=I-U+%Y,%X=%OPOZ-%K+%X,U=I,%K=%OPOZ I %X0 G 3 S L=%OPOZ,R=L+RL-1 G M12 810 G READ:'%K S C=%K-%X,%K=%K-.1\10*10,%X=%K-C G:%K'230 S C=%K-%X,%K=%K\10+1*10,%X=%K-C G:%K'>R 3 S SDV=%K-R D SPRAVO S SDV=60,RL=1+R-L,%Y=%S2V("VGR") D P S %X=R-L,%K=R G M13 END S S=$L(^TMPS111($J,U)),%K=$S(SR:R,1:S),%X=%K-L G 3 ENDS ; ENDL S ENDS="" I $D(%S2V("HBR")),'$D(HOME) G HOME S S=$L(^TMPS111($J,U)) I S>R S SDV=S-R D SPRAVO S %X=0,%Y=%S2V("VGR"),RL=1+R-L,%K=L D P S %X=0,%Y=%S2V("VGR"),RL=1+R-L,%K=L D P ;? S:$D(U1) U=U1 S:$D(Y1) %Y=Y1 K U1,Y1 S %K=S,%X=%K-L S SDV=60 G 3 PGLN G 3:'L D SLEVO G M12 COR S %L1WE="" S %YY=19,%XX=0 X %POSIC W %chists,"<>" S %S=^TMPS111($J,U),%6=20 D ^%L2ERSTR R YYY S U1=U,U=U-(%Y-%S2V("VGR")+1)+1,Y1=%Y S:U<1 U=1 G M12 ;;D P G 3 13 ; BK S %K=L,%X=0 G VNIZ HOME S HOME="" I $D(%S2V("HBR"))&'$D(ENDS) G ENDL I L>0 S SDV=L D SLEVO S SDV=60 G M12 S %K=0,%X=0 G M12 ;;3 PGUP I U'>(%Y-%S2V("VGR")+1) S %SAY=" ! mipezp zligz " X %XMSGV(1) G 3 S U=U-(%Y-%S2V("VGR")+1)-%S2V("RSTR")+1 S:U'>0 U=1 G M12 PGRG G 3:L>195 D SPRAVO G M12 SPRAVO S L=L+SDV,U1=U,Y1=%Y,U=U-(%Y-%S2V("VGR")+1)+1,R=R+SDV Q VNIZE D VNIZE1 G M2 VNIZE1 W %vverxe F I=1:1:%S2V("NGR")-1 Q:'$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+I)) W %vniz S:'$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+I)) I=I-1 S U=U-(%Y-%S2V("VGR")+1)+I,%Y=I,%K=L,%X=0 Q PRSC ; D ^%L1PRSC G M2 PGDW ; PGDN ; I '$D(^TMPS111($J,U-(%Y-%S2V("VGR")+1)+%S2V("RSTR")+1)) S %SAY=" ! mipezpd seq " X %XMSGV(1) G 3 S U=U-(%Y-%S2V("VGR")+1)+%S2V("RSTR")+1 G BEG+2 VVERX G:%Y=%S2V("VGR1") VIRA S U=U-1,%Y=%Y-1 G M2 VNIZ S U=U+1,%Y=%Y+1 G MAINA:(%Y+1)'<%S2V("NGR"),M2 LEVO G READ:'%K I %X>0 S %K=%K-1,%X=%X-1 G 3 S SDV=1 D SLEVO S SDV=60 G M12 SLEVO S R=R-$S(L>SDV:SDV,1:L),L=$S(L>SDV:L-SDV,1:0) S U1=U,U=U-(%Y-%S2V("VGR")+1)+1,Y1=%Y Q SBROS G:^TMPS111($J,U)=%SS 13 S ^(U)=%SS D V G 13 V S %YY=%Y,%XX=$S(%TYPCRT="PC":0,1:%S2V("LEFT")) S:%XX<0 %XX=0 X %POSIC W %chists D W(U,L+1,R) Q VVERXE S %K=L,U=U-(%Y-%S2V("VGR1")+1)+1,%X=0,%Y=%S2V("VGR1") G M2 P S %XX=%S2V("LEFT") D I $O(^TMPS111($J,1)) .I $O(^TMPS111($J,1)) .;I %S2V("NGR")>23 S %XX=%S2V("LEFT"),%YY=%S2V("VGR") X %POSIC,%chiste Q .F I=%Y:1:%S2V("NGR") S %YY=I X %POSIC W $J("",%S2V("RIGHT")-%S2V("LEFT")) F I=0:1:%S2V("RSTR")-1 Q:'$D(^TMPS111($J,I+U)) S %YY=I+%Y,%XX=$S(%TYPCRT="PC":0,1:%S2V("LEFT")) X %POSIC D W(I+U,L+1,R) X %XCL W %chists ;W %vverxe,%chists Q Q MAINA G:'$D(^TMPS111($J,1)) 3 S:'$D(^TMPS111($J,U)) ^(U)="" X %XCL W ! S %XX=0,%YY=%S2V("VGR")-1 X %POSIC W %chists S %Y=%S2V("NGR")-1 D V G M2 ;;S U1=U,U=U-%S2V("RSTR")+1,Y1=%S2V("NGR") G M12 VIRA ; G:U<(%S2V("U1")+1) 3 S U=U-1 X %XCL I %TYPCRT="PC",%S2V("RIGHT")-%S2V("LEFT")<80 D D V G M2 .D GET^%VIDEO("%s2view",%S2V("LEFT"),%S2V("VGR1"),%S2V("RIGHT")-%S2V("LEFT")+1,%S2V("NGR1")-%S2V("VGR1")-1,2) .D PUT^%VIDEO("%s2view",%S2V("LEFT"),%S2V("VGR1")+1,%S2V("RIGHT")-%S2V("LEFT")+1,%S2V("NGR1")-%S2V("VGR1")-1,2) .k %s2view I $E(%TYPCRT,1,3)="VT5" D D V G M2 .W $C(27,91),(%S2V("VGR1")+1)_";"_%S2V("LEFT")_";"_(%S2V("NGR1")-1)_";"_%S2V("RIGHT")_";;"_(%S2V("VGR1")+2)_";"_%S2V("LEFT")_";$v" S:C=164 S=$L(^TMPS111($J,U)),%K=$S(SR:R,1:S),%X=%K-L ;G M2 D P G M2 Q ERCOM S TXT="ISN'T FUNCTION" D STR1 G 3 STR1 ;I $D(TXT) S %SAY=TXT X %XMSGV(1) K TXT Q ;W %vverxe,%chists S %YY=0,%XX=19 X %POSIC W %CLI,TXT K:'$D(TXT(1)) TXT X %XCL Q I $D(TXT) W %vverxe,%chists S %YY=0,%XX=19 X %POSIC W %CLI,$$^%L1HB(TXT)," " K:'$D(TXT(1)) TXT X %XCL Q STR21 S %SAY=$$^%L1HB(TXT1) X %XMSGV Q STRN S %SAY=$$^%L1HB(%S2V("TXTN")) X %XMSGN Q FINDS K %SIMB S TXT="SEARCH KEY . INPUT SIMBOL ( - END SEARCH):" D STR1 U $P:(ECHO) R %SIMB D USE I %SIMB="" K %SIMB G 3 I $A(%SIMB)<32 W *7," *** ERROR !" H 2 G FINDS G 3 ER W " ???" Q 1 W %vverxe,%chists G:%TIP'="R" 1111 S TXT=" LABEL <"_$P(^TMPS111($J,1)," ",1)_"> " D STR1 U $P:(ECHO) R %STROKA 1110 D USE I %STROKA="-" W %vverxe,%chists G 3 I $D(^TMPS111($J,1)) S:%STROKA="" %STROKA=$P(^TMPS111($J,1)," ",1) S %STROKA1=$P(%STROKA,":",1) S %=$S(%STROKA1["+":"+",%STROKA1["-":"-",1:" ") S %LAB=$P(%STROKA1,%,1) I %LAB="",%="+" S I=0,%SM=+$P(%STROKA,"^") G 11101 S:%LAB="" %LAB=$P(^TMPS111($J,1)," ",1) S %LAB=$P(%LAB,"(") S %E='(%LAB?1"%".UN!(%LAB?.UN)) I '%E S %SM=$P(%STROKA1,%,2) S:%SM="" %SM=0 S:%'=" " %SM=%_%SM S %E='(%SM?1"+"1N.N!(%SM?1"-"1N.N)!(%SM?1N.N)) I %E W *7," LABEL ISN'T RIGHT !" H 2 G 1 F I=1:1 Q:'$D(^TMPS111($J,I)) Q:$P($P(^(I)," ",1),"(")=%LAB I '$D(^(I)) W *7," LABEL NOT !" H 2 G 1 11101 I '$D(^TMPS111($J,I+%SM)) W *7," OFFSET TOO LARGE !" H 2 G 1 S U=I+%SM,L=0,R=L+%S2GW K %STROKA,%STROKA1,%LAB,%SM,%E,% G M12 ; 1111 U $P:(ECHO) R " LINE NUMBER <1> ",%STROKA D USE S:%STROKA="" %STROKA="1" I %STROKA="-" G 3 S %LAB=$P(%STROKA,":",1) S:%LAB="" %LAB=1 S %E='(%LAB?1"+"1N.N!(%LAB?1N.N)) I %E W *7," NUMBER ISN'T RIGHT !" H 2 G 1 I '$D(^TMPS111($J,%LAB)) W *7," NUMBER TOO LARGE !" H 2 G 1 S U=%LAB,L=0,R=L+%S2GW K %STROKA,%STROKA1,%LAB,%E G M1+2 Q 6 S TXT="FIND : " D STR1 U $P:(ECHO) S %LS=20,%S="" D ^%ZMSL S C=%S D USE I $D(^TMPS111($J,1)) I C="" G ERCOM:'$D(RAZ) S C=RAZ S RAZ=C,J=%K+2 F C=U:1 Q:'$D(^TMPS111($J,C)) S J=$F(^TMPS111($J,C),RAZ,J) Q:J W:'J *7," NOT" W " FOUND" G 3:'J S J=J-$L(RAZ)-1 S %Y=C-U+%Y,%X=J-%K+%X,U=C,%K=J I %X0)) S L=J,R=L+RL-1 G M12 I %X<0,J-RL<0 S L=0,R=L+RL-1,X1=J,Y1=1 G M12 S %Y=%S2V("VGR"),X1=%X G M12 ;;STR1 W %vverxe,%chists,! S %YY=0,%XX=5 X %POSIC W TXT K TXT Q ENDF F I=U+1:1 Q:'$D(^TMPS111($J,I)) S U=I-%S2V("RSTR") S:U<1 U=1 S L=0 G M11 BEGF S U=1,L=0 G M11 SAVE ; I $D(%S2V("PROG")) S U1=U,Y1=%Y,X1=%X D S U=U1-$S($G(%MET)="M2":0,1:Y1-$G(%S2V("VGR"))) K:%MET="M2" U1,Y1,X1 G @%MET .N U S U=U1 N U1 .I $D(%S2V("SV")) D SV .U 0 I %S2V("VGR")>1!(%S2V("NGR")<24) W $C(27,91),"1;1;24;80w" .X %XCL .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S2V,s2view,U,%MET) D ^%L1C ;;S %OPT=65 .S %N="" F S %N=$O(%S2V("PROG",%N)) Q:%N="" S @%N=%S2V("PROG",%N) .K ^S2VTMPS111($J,$ZL) M ^S2VTMPS111($J,$ZL)=^TMPS111($J) .I $O(^TMPS111($J,U)) S zl=$ZL .D @%S2V("PROG") X:'$D(%S2V("PROGNCA")) %chista .S %MET="BEG" D INIT .D:$D(%S2V("SV")) REST .K ^TMPS111($J) M ^TMPS111($J)=^S2VTMPS111($J,$ZL) K ^S2VTMPS111($J,$ZL) .I $O(^TMPS111($J,1)) S %GET=" SAVE LINE[,COLUMN] <1> #6" D VE^%L1GET S C=%S S:C="" C=1 G:C="-" 3 G SAVE:C'?.N.",".N G:C'=0 260 W " ERASE OLD ARRAY (Y/N) :" R "?",*I G 3:I=%S2GW,SAVE+2:I-89 W *I K %Z G 3 260 I $D(%Z) S YES=0 F %J=0:0 Q:"123"[YES&($L(YES)=1) W %vverxe,%chists U $P:(ECHO) R " OLD ARRAY: ERASE - 1,LOOK - 2,TO ADD - 3 <1> ",YES D USE S:YES="" YES=1 I $D(%Z) K:YES=1 %Z I YES=2 W # X "F J=1:1 Q:'$D(%Z(J)) W !,%Z(J)" R !!?40,"PRESS ",YES S U1=U,Y1=%Y,X1=%X,U=U-(%Y-%S2V("VGR")+1)+1,%Y=%S2V("VGR"),%X=0 D P S U=U1,%Y=Y1,%X=X1 K U1,Y1,X1 G 260 S:'$D(%Z) %Z=0 S I=999.3 S:C["," I=+$P(C,",",2) S C=+C F J=1:1:C Q:'$D(^TMPS111($J,U+J-1)) S %S=$E(^TMPS111($J,U+J-1),%K,%K+I) S:I'=999.3 %S=%S_$J("",I-$L(%S)) S %Z(%Z+J)=$TR(%S,$C(9)," ") S %Z=%Z+J-'$D(%Z(%Z+J)) K:'%Z %Z G 3 Q INIT S %FLV=1 S:$D(%S2V("IND")) %FLI=+%S2V("IND") I $D(^TMPS111($J,1)) S:'$D(%FLI) %FLI=0 S SDV=60 S:'$D(%TIP) %TIP="G" I '$D(%S2V("U1")) S %S2V("U1")=1 I $G(%S2V("U"))>1 S U=%S2V("U") I '$D(%S2V("NGR")) S %S2V("NGR")=24 I '$D(%S2V("VGR")) S %S2V("VGR")=1 I '$D(%S2V("LEFT")) S %S2V("LEFT")=0 I '$D(%S2V("RIGHT")) S %S2V("RIGHT")=79 ;;S %HBRY="" I $D(%S2V("NOHB")) K %HBRY I $E(%TYPCRT,1,3)="VT5",$D(%S2V("SMALL")) S %S2V("RIGHT")=132 W $C(27),"[?3h" I %S2V("VGR")<1 S %S2V("VGR")=1 I %S2V("NGR")>24 S %S2V("NGR")=24 I %S2V("NGR")>21,$$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE!$D(%S2V("TOUCH")) S %S2V("NGR")=21 I $D(^TMPS111($J,1)) S TXT=$G(%S2V("TXT")) S TXT1=$G(%S2V("TXT1")) S %S2V("RSTR")=%S2V("NGR")-%S2V("VGR") S %S2GW=%S2V("RIGHT")-%S2V("LEFT") D USE W *27,"["_%S2V("VGR")_";"_%S2V("LEFT")_";"_%S2V("NGR")_";"_%S2V("RIGHT")_"w" S:'$D(%S2V("VGR1")) %S2V("VGR1")=%S2V("VGR") S:'$D(%S2V("NGR1")) %S2V("NGR1")=%S2V("NGR") W *27,"["_%S2V("VGR1")_";"_%S2V("NGR1")_"r" Q XEC ; D ^%L1CLC D USE G 3 ; SV D:'$D(%TYPCRT) ^%L1C I %TYPCRT="PC" D GET^%VIDEO("s2view",0,0,80,24,2) Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;;;;2$v" Q Q REST D:'$D(%TYPCRT) ^%L1C ; I %TYPCRT="PC" D PUT^%VIDEO("s2view",0,0,80,24,2) K s2view S %MET="M2" Q I $E(%TYPCRT,1,3)="VT5",'$D(%NOVIDEO) W $C(27,91),";;;;2;;;$v" S %MET="M2" Q S %MET="BEG" Q W(U,L,R) I '$D(%HBRY) W $E(^TMPS111($J,U),L,R) Q N %A S %A=^TMPS111($J,U) S %A=$$RPL^%L1FRM(%A,%CLI,"<%CLI>") S %A=$$RPL^%L1FRM(%A,%CCL,"<%CCL>") S %A=$TR($TR($E(%A,L,R),%TES1,%TES2),%TEN,%THB) S %A=$$RPL^%L1FRM(%A,"<%CLI>",%CLI) S %A=$$RPL^%L1FRM(%A,"<%CCL>",%CCL) W %A Q MDRG G HBR USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q DELAY ; N %II I %TYPCRT="PC1" F %II=1:1:6000 Q %S3BSG %S3BSG ; [ 17.04.01 9:35 AM ] [ 04/03/98 7:54 AM ] [ 10/01/92 9:35 PM ] N %ECHO,%BE S %MSCH="$P(^(%ST),%R,%SCH)" G BEGROU ;- DELAY I %OPT=65 F X=1:1:200 Q BEGGR ; I %SCH'>%KOLR,(%SCH'<1),MPOZ(%SCH)<80,%STR<25 S %XX=MPOZ(%SCH),%YY=%STR X %POSIC Q Q PNS W %vverxe,%chists,"--LINE:",%ST S %OLDS=$S($D(^(%ST)):^(%ST),1:"") D BEGGR Q STROKA ; W *13,%chists I $D(^(%ST)) F JJ=1:1:%KOLR Q:JJ>$L(^(%ST),%R) I $P(^(%ST),%R,JJ)'="" S %XX=MPOZ(JJ),%YY=%STR X %POSIC W $P(^(%ST),%R,JJ) Q NAZAD ; I %SCH>1 S %SCH=%SCH-1 D BEGGR Q VPERED ; I %SCH<%KOLR S %SCH=%SCH+1 D BEGGR Q VVERX ; I %ST=1 S %ST=0 W *13,%chists D VSTAV^%S3BSG1 Q S $P(^(%ST),%R,%SCH)=%S,%ST=%ST-1,%SCH=1,%S=$S($D(^(%ST)):$P(^(%ST),%R,%SCH),1:"") I %STR>1 S %STR=%STR-1 D PNS Q I %STR=1 D P S %SCH=1 D PNS Q VNIZ ; S:%SCH'>%KOLR $P(^(%ST),%R,%SCH)=%S S %ST=%ST+1,%SCH=1,%S=$S($D(^(%ST)):$P(^(%ST),%R,%SCH),1:"") I %STR<23 S %STR=%STR+1 D PNS Q I %STR'<23 W ! D STROKA S %SCH=1 D PNS Q VVERXE ; I %ST>%STR S %ST=%ST-%STR+1,%STR=1,%SCH=1 D PNS Q I %ST'>%STR S %STR=%STR-%ST+1,%ST=1,%SCH=1 D PNS Q ;- VVOD S %FLL=1,%FLV=1 I %C>31&(%C<127) S %S=$C(%C)_$E(%S,2,$L(%S)) S %LS=$S($D(MDLIN(%SCH,1)):MDLIN(%SCH,1),1:255) S:$D(MSIMB(%SCH))#10 CIST=MSIMB(%SCH) I $D(CIST)&(%C>31)&(%C<127) S %FLV=0 Q ; VIZ ; I '$D(%LS) S %LS=8 D ^%ZMSL ENDCYC I $D(MDLIN(%SCH,2)) I ($L(%S)<%LS)&(MDLIN(%SCH,2)=1) W *7,%vverxe,"***FORMAT*** !" D BEGGR S %FL=0 G VIZ S $P(^(%ST),%R,%SCH)=%S S %SCH=%SCH+1 Q ;- BEGROU ; S %SCH=1,%ST=1,%PRFIN=0 K CIST S:'$D(%STR) %STR=1 D PSHAP I '$D(MPOZ) F I=1:1:8 S MPOZ(I)=I*10-9 I $D(MDLIN)<10 F I=1:1:8 S MDLIN(I,1)=9 F I=1:1 Q:'$D(MPOZ(I)) S %KOLR=I-1 I '$D(%R) S %R="\" S:'$D(^MOTV($J,%ST)) ^(%ST)="" D BEGGR,P S %SCH=1,%ST=1 D PNS CVV ; K %TO S %S=$S($D(^(%ST)):$P(^(%ST),%R,%SCH),1:"") OBRVV ; S %D=0 R *%C I %C=13 S %SCH=%SCH+1 G ENDOBR I %C>31,%C<127 G M I %C=%DEL S %S=$E(%S,2,255),%FL=1 G M2 I %C=27 R *%C1:0 D DELAY D:%C1<0 NAZAD G:%C1<0 ENDOBR R *%C2:0 S %D=%C1_%C2 D:$T(@%UPRCOD(%D))'="" @%UPRCOD(%D) G CVV I %C=0 D DELAY R *%C1:0 D DELAY R *%C2:0 I %C1>0 S %D="0"_%C1 D:$T(@%UPRCOD(%D))'="" @%UPRCOD(%D) G CVV I %C=9!(%C=25) S %PRFIN=1 G ENDOBR I %C=30 D LNAZAD^%S3BSG1 G CVV I %C=14 D LVPERED^%S3BSG1 G CVV I %C=16 S RAZD=%R D PEREST^%S3BSG1 G CVV I %C=4 S ^(%ST)=$P(^(%ST),%R,1,%SCH-1) S:%SCH>1 %SCH=%SCH-1 D STROKA,BEGGR G CVV I %C=20 F I=1:1:23-%STR Q:'$D(^(%ST+I)) ; W %vniz I S %STR=%STR+I-'$D(^(%ST+I)),%ST=%ST+I-'$D(^(%ST+I)),%SCH=1 D PNS G CVV ; *** . I %C=21!(%C=22) D VSTAV^%S3BSG1:%C=22,UDAL^%S3BSG1:%C=21 G CVV I %C=26 D ZAP^%S3BSG1 G CVV I %C=18 D REST^%S3BSG1 G CVV I %C=27 S %PRFIN=1 G ENDOBR G:%C'>31 CVV M S %FLL=1,%I=1 I %C>31&(%C<127) S %A=$C(%C) M2 S %LS=$S($D(MDLIN(%SCH,1)):MDLIN(%SCH,1),1:255) S:$D(MSIMB(%SCH))#10 CIST=MSIMB(%SCH) S %L=$L(%S) D VIZ ENDOBR I %PRFIN S %XX=0,%YY=23 X %POSIC W ! G END I $G(%TO)="UP" S %S=$S($D(^(%ST)):$P(^(%ST),%R,%SCH),1:"") D VVERX G CVV I $G(%TO)="DW" S %S=$S($D(^(%ST)):$P(^(%ST),%R,%SCH),1:"") D VNIZ G CVV D:%SCH>%KOLR VNIZ D BEGGR G CVV END K %SCH,CIST,%FL,%LS,%C,%D,%REG,%KOLR,%I,%I1,%J S %CL0=44 X %XCL Q ; ;- PRAVO G M PGUP D LNAZAD^%S3BSG1 Q PGDN D LVPERED^%S3BSG1 Q ADDL D VSTAV^%S3BSG1 Q DELL D UDAL^%S3BSG1 Q SOOB W %vverxe s %pn=3 w %pravon,*7,TXT X %XCL D BEGGR Q STR1 W %vverxe s %pn=3 X %pravon W *7 Q CHISTE D STR1 W " HOW MATH OF LINES DELETE ? " R %COLUD X %XCL I %COLUD=0 D BEGGR Q I %COLUD="" S ^(%ST)=$P(^(%ST),%R,1,%SCH-1) F I=%ST+1:1 Q:'$D(^(I)) K ^(I) I %COLUD="" D BEGGR,P,PNS Q I %COLUD'?1N.N W *7," *** ERROR !" H 2 G CHISTE X "F I=%ST:1 Q:'$D(^(I+%COLUD)) S ^(I)=^(I+%COLUD) K ^(I+%COLUD)" S %SCH=1 D BEGGR,P,PNS Q SBROS D SBROS^%S3BSG1 Q P ; W *13 X %chiste F I=0:1:23-%STR Q:'$D(^(%ST+I)) D P1 Q P1 F JJ=1:1:%KOLR Q:JJ>$L(^(%ST+I),%R) I $P(^(%ST+I),%R,JJ)'="" S %XX=MPOZ(JJ),%YY=%STR+I X %POSIC W $P(^(%ST+I),%R,JJ) Q PSHAP G:$D(S1BDC) PSHAP1 G:'$D(KOD) EPS G:KOD="" EPS G:'$D(^SHP(KOD,1))#10 EPS W # F %STR=1:1 Q:'$D(^(%STR)) Q:$E(^(%STR))="R" W !,^(%STR) I '$D(^(%STR)),$D(^(%STR-2)),^(%STR-2)[":",$D(MPOZ)<10 S MPOZ(0)=0 F I=1:1 S MPOZ(I)=$F(^(%STR-2),":",MPOZ(I-1)) Q:MPOZ(I)=0 S:I>1&('$D(MDLIN(I-1,1))) MDLIN(I-1,1)=MPOZ(I)-MPOZ(I-1)-1 I K MPOZ(I),MPOZ(I-1),MPOZ(0) F I=1:1 Q:'$D(MPOZ(I)) S MPOZ(I)=MPOZ(I)-1 G EPS PSHAP1 K MPOZ(0) S PZ=0 D @$S($D(KOD):"APAK+1^L1PAK",1:"APAK^L1PAK") I PZ D ^L1777 G PSHAP1 G:'$D(^SHP(KOD,1))#10 EPS W # F %STR=1:1 Q:'$D(^(%STR)) Q:$E(^(%STR))="R" W !,^(%STR) I '$D(^(%STR)),$D(^(%STR-2)),^(%STR-2)[":",$D(MPOZ)<10 S MPOZ(0)=0 F I=1:1 S MPOZ(I)=$F(^(%STR-2),":",MPOZ(I-1)) Q:MPOZ(I)=0 S:I>1&('$D(MDLIN(I-1,1))) MDLIN(I-1,1)=MPOZ(I)-MPOZ(I-1)-1 I K MPOZ(I),MPOZ(I-1),MPOZ(0) F I=1:1 Q:'$D(MPOZ(I)) S MPOZ(I)=MPOZ(I)-1 Q I '$D(^(%STR)),$D(^(%STR-2)),^(%STR-2)["!",$D(MPOZ)<10 S MPOZ(0)=0 F I=1:1 S MPOZ(I)=$F(^(%STR-2),"!",MPOZ(I-1)) Q:MPOZ(I)=0 S:I>1&('$D(MDLIN(I-1,1))) MDLIN(I-1,1)=MPOZ(I)-MPOZ(I-1)-1 I K MPOZ(I),MPOZ(I-1),MPOZ(0) F I=1:1 Q:'$D(MPOZ(I)) S MPOZ(I)=MPOZ(I)-1 EPS X %XCL Q %S3BSG1 %S3BSG1 ; [ 10/01/92 8:04 PM ] VSTAV Q:%STR=23 F %LASTI=1:1 Q:'$D(^(%LASTI)) S %LASTI=%LASTI-1 F I=%LASTI:-1:%ST+1 S ^(I+1)=^(I) S %ST=%ST+1 S:%ST>1 %STR=%STR+1 S ^(%ST)="",%SCH=1 W %vniz D P,PNS^%S3BSG Q UDAL F I=%ST:1 Q:'$D(^(I+1)) S ^(I)=^(I+1) K ^(I) D P S %SCH=1 D PNS^%S3BSG Q SBROS S ^(%ST)=%OLDS D STROKA^%S3BSG,BEGGR^%S3BSG Q LNAZAD Q:%ST'>%STR S %ST=%ST-%STR-19 S:%ST<0 %ST=1 S %SCH=1,%STR=1 D:%ST=1 PSHAP^%S3BSG S %V=^MOTV($J,1) D BEGGR^%S3BSG,P,PNS^%S3BSG Q LVPERED I %ST'<%STR Q:'$D(^(%ST-%STR+21)) S %ST=%ST+21-%STR,%STR=1,%SCH=1 D BEGGR^%S3BSG,P,PNS^%S3BSG Q I %ST<%STR Q:'$D(^(21-%STR+%ST)) S %ST=21-%STR+%ST,%STR=1,%SCH=1 D BEGGR^%S3BSG,P,PNS^%S3BSG Q ZAP K %Z W %vverxe,%chists," HOW MATH LINE TO SAVE ? <1> " R %COLS S:%COLS="" %COLS=1 I %COLS'?1N.N W *7," *** !" G ZAP F J=1:1:%COLS Q:'$D(^(%ST+J-1)) S %Z(J)=^(%ST+J-1) S %Z=J-'$D(^(%ST+J-1)) D PNS^%S3BSG Q REST I $D(%Z)'=11 S TXT="HASN'T ARRAY !" D SOOB^%S3BSG Q I %Z'?1N.N!(%Z'>0) S TXT="ARRAY ISN'T GOOD !" D SOOB^%S3BSG Q F J=%ST:1 Q:'$D(^(J)) F J=J+%Z-1:-1:%ST+%Z+1 S ^(J)=^(J-%Z) F J=1:1:%Z S ^(%ST+J)=%Z(J) D P,PNS^%S3BSG Q SOOB W %vverxe,%chists,!,%vverx,?5,*7,TXT D BEGGR Q STR1 W %vverxe,%chists,!,%vverx,?5 Q P ; W *13 X %chiste F I=0:1:23-%STR Q:'$D(^(%ST+I)) D P1 Q P1 F JJ=1:1:%KOLR Q:JJ>$L(^(%ST+I),%R) I $P(^(%ST+I),%R,JJ)'="" S %XX=MPOZ(JJ),%YY=%STR+I X %POSIC W $P(^(%ST+I),%R,JJ) Q PSHAP Q:'$D(KOD) Q:'$D(^SHP(KOD,1))#10 W # F %STR=1:1 Q:'$D(^(%STR)) Q:$E(^(%STR))="R" W !,^(%STR) I '$D(^(%STR)),$D(^(%STR-2)),^(%STR-2)[":",$D(MPOZ)<10 S MPOZ(0)=0 F I=1:1 S MPOZ(I)=$F(^(%STR-2),":",MPOZ(I-1)) Q:MPOZ(I)=0 S:I>1&('$D(MDLIN(I-1,1))) MDLIN(I-1,1)=MPOZ(I)-MPOZ(I-1)-1 I K MPOZ(I),MPOZ(I-1),MPOZ(0) F I=1:1 Q:'$D(MPOZ(I)) S MPOZ(I)=MPOZ(I)-1 Q PEREST ; S NEWROU="%S3BSG1" S NEWNEW="GRAF,LINE,NGRAF,NG,LINE1" X XNEW1 S ERP=0 I $D(^MOTV($J,1)) W %vverxe,%chists R " GRAF NUMBER > ",NGRAF I NGRAF="" G EPER K NG F I=1:1:$L(NGRAF,",") S NG(I)=$P(NGRAF,",",I) I NG(I)'?1N,NG(I)'?2N,'$D(MPOZ(NG(I))) S ERP=1 I ERP W *7," ???" G PEREST F I=1:1 Q:'$D(^(I)) S LINE=^(I),LINE1="" D PE1 G PER1 PE1 F J=1:1 Q:'$D(NG(J)) S GRAF=$P(LINE,RAZD,NG(J)) S LINE1=LINE1_GRAF_RAZD S ^(I)=LINE1 K LINE S NEWROU="%S3BSG1" X XNEW2 Q PER1 S %ST=%ST-%STR+1,%STR=1,%SCH=1 S:%ST<0 %ST=1 D PSHAP^%S3BSG S %V=^MOTV($J,1) D BEGGR^%S3BSG,P,PNS^%S3BSG,BEGGR^%S3BSG EPER Q %S3BST %S3BST ; HEBREW [ 15.03.19 08:18 ] [ 15.02.04 14:21 ] [ 16.01.04 11:30 ] ;INP: %MBS("Z",I) - QUEST ; %MBS("O",I) - ANS ; %MBS("D",I,1) - MAX LENGTH OF ANS ; %MBS("D",I,2) - MAX LENGTH AFTER DOT ; %MBS("S",I) - SIMBOL COLLECTION ; %MBS("RGS",I) - TYPE ("E","H") ; %MBS("C",I) - TEST COMMAND (%FLOSH =1 - ERROR) ; %MBS("B",I) - TOP BOUND ; %MBS("N") - KOTERET ; %MBS("DO") - COMMAND FOR AZAGA OR FOR INIT ; %MBS("DZ",I) - ZAPR - DLINA ZAPR Q:'$D(%MBS("Z")) N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%MBS) D ^%L1C U $P:(NOECHO:NOWRAP) D:'$D(%POSIC) ^%L1C W %HBR S:'$D(%MBS("B")) %MBS("B")=0 S:%MBS("B")>15 %MBS("B")=15 S %MBS("F")=0 S:'$D(%MBS("DZ")) %MBS("DZ")=30 S %30V=%MBS("DZ") S:'$D(%RGR) %RGR=78 S %FL0=%RGR-%30V S %SH=0,%RST=20-%MBS("B") ; G VIV ;- OBRVV ; D BEGS I $D(%TO) D:%TO="UP" VVERX,VVERX K %TO Q U $P:(NOECHO:NOWRAP) ;R *%C VVOD S %S=$G(%MBS("O",%SH)) K CIST,%LS S %LS=%FL0-2 S:$D(%MBS("D",%SH,1))#10 %LS=%MBS("D",%SH,1) S:$D(%MBS("S",%SH))#10 CIST=%MBS("S",%SH) VIZ ; S $X=%XX,$Y=%YY;,%FLL="" K %FLINSO I $D(%FLINS) S %FLINSO=%FLINS I $D(%MBS("RGS",%SH)),%MBS("RGS",%SH)="E" S %XX=%XX-%LS+1 S:%XX<0 %XX=0 X %POSIC D ^%ZMSL U $P:(NOECHO:NOWRAP) G CONTR D ^%L1ZMS U $P:(NOECHO:NOWRAP) I $D(%FLINSO) S %FLINS=%FLINSO CONTR ; I %S=".",$D(%MBS(".")) S %TXT=" WITHOUT DOT !" D SOOB,BEGS G VIZ I %S="."!(%S="&") S %MBS("O",%SH)="",%SH=%SH+%KOLS+1-%SCH,%SCH=%KOLS+1 G ENDC I $G(%TO)="END" S %SH=%SH+%KOLS+1-%SCH,%SCH=%KOLS+1 G ENDC S %SOLD=%S I $D(%MBS("D",%SH,2)) I ($L(%S)<%LS)&(%MBS("D",%SH,2)=1) S %TXT="*** FORMAT !" D SOOB,BEGS G VIZ S %MC=$S($D(%MBS("C",%SH))#2:%MBS("C",%SH),$D(%MBS("C"))#2:%MBS("C"),1:"") I %MC'=""&(%S'="&") X "S %FLOSH=0,%TXT="""" "_%MC I %FLOSH D SOOB,BEGS K %MC G VIZ S %MBS("O",%SH)=%S S %MP=$S($D(%MBS("P",%SH))#2:%MBS("P",%SH),$D(%MBS("P"))#2:%MBS("P"),1:"") I %MP'="",%S'="&" X "S %FLOSH=0 S %XX=0,%YY=%MBS(""B"") X %POSIC x %chiste D @%MP" S:'$D(%SCH) %SCH=0 S %SH1=%SH,%SCH1=%SCH,%SH=%SH-%SCH D P S %SH=%SH1,%SCH=%SCH1,%MP="" K %SH1,%SCH1 D BEGS S %SH=%SH+1,%SCH=%SCH+1 ENDC S:%S="&" %MBS("F")=1 X %XCL K %FLL,%BEG,%I,%NP,%MC,%MP,%L,%C,%D,%LS,%J Q VIV ; D P S %SH=%SH-%SCH+1,%SCH=1 I $D(%MBS("LOOK")) G ZR CVV ; D OBRVV G CVV:%SCH'>%KOLS I %MBS("F") K %MBS("O") G END ZR S %XX=0,%YY=22 X %POSIC W %chists S %XX=5,%YY=22 X %POSIC W %HBR I '$D(%MBS("LOOK")) S %GET=" : 1 - oewiz ,"_$S($D(%MBS("O",%SH-%RST-1)):"2 - mcew jqn ,",1:"")_" "_$S('%PRFIN:"`ad jqn",1:"d`ivi") D N^%L1GET S %REG=%S I $D(%MBS("LOOK")) S %GET=" ywd",%REG="" D N^%L1GET S %SH=%SH+%KOLS+1-%SCH,%SCH=%KOLS+1 I %REG="" G:%PRFIN END S %SH=%SH-1 G VIV I %REG=2&($D(%MBS("Z",%SH-%RST-1))) S %SH=%SH-1.1\%RST-1*%RST G VIV I %REG'=1 W *7,%vverx x %chiste G ZR S %SH=%SH-%SCH+1,%SCH=1 D BEGS G CVV END S %XX=0,%YY=23 X %POSIC K %SH,%SCH,CIST,%FLL,%LS,%C,%D,%REG,%KOLS,%I,%I1,%J,%30V K %XX,%YY X %XCL ;I $D(%ECHO) U $P:(ECHO:WRAP:WIDTH=80) Q VVERX ; I %SCH>1 W %vverx S %SCH=%SCH-1,%SH=%SH-1 Q VNIZ ; W %vniz S %SCH=%SCH+1,%SH=%SH+1 Q BEGS ; S %XX=%RGR-%30V-2,%YY=%SCH+%MBS("B") X %POSIC Q SOOB S %SAY=TXT X %XMSGV(1) K TXT,%SAY Q SOOB1 W %vverxe,%chists S %XX=10,%YY=0 X %POSIC W $$W^%L1C(%TXT),%chists K %TXT Q ER S %TXT="*** CHECK COMMAND ERROR ! " K %MBS("C") D SOOB,BEGS S $ZS="ER^%S2BST" G VIV Q P ; I $D(%MBS("N")) S %SAY=%MBS("N") X %XMSGV S:%MBS("B")=0 %MBS("B")=1 S %YY=%MBS("B"),%XX=0 X %POSIC X %chiste F %SCH=1:1:%RST S %SH=%SH+1 Q:$D(%MBS("Z",%SH))=0 D .S %XX=1 .S %YY=%MBS("B")+%SCH X %POSIC .S:'$D(%MBS("O",%SH)) %MBS("O",%SH)="" W $J($$W^%L1C(%MBS("O",%SH)),%FL0-2) .S %XX=%RGR-%30V-1 X %POSIC W ":",$$HBR^%L1FRM($$W^%L1C(%MBS("Z",%SH)),%30V-1) S %KOLS=%SCH-'$D(%MBS("Z",%SH)) S %PRFIN='$D(%MBS("Z",%SH+1)) ; - I $D(%MBS("DO")) X %MBS("DO") Q %S3G %S3G ; [ 04/30/99 6:06 PM ] [ 06/18/98 10:25 AM ] [ 06/15/98 11:24 AM ] D ^%L1C X %chista W %LIGHT1,%CV("YF") I $H>57920 W !!," SORRY , YOUR EVALUATION TIME IS OVER " W !," IT'S EVALUATION VERSION OF FULL SCREEN GLOBAL EDITOR " W !," IF YOU WANT TO GET FULL VERSION , TECHNICAL SUPPORT" W !," AND NEW VERSIONS OF PROGRAMM SEND PLEASE "_%CV("RF")_"30$"_%CV("YF")_" USA (CASH) BY ADDRESS :" W !!,%CV("CF")," HAGVURA 15/30, QYRIAT-GAT , ISRAEL , 82000" W !," LEV FAINSTEIN" W !!,%CV("YF")," QUESTIONS OR/AND SUGGESTIONS YOU CAN SEND TO E-MAIL :" W !!,%CV("RF")," LEV1957@INTERNET-ZAHAV.NET " W %CV("YF") R !!," ",BK X %XCL I $H>57920 Q S %S3G="" D B^%S3GLKR Q %S3GLK1 %S3GLK1 ; [ 06/18/98 9:34 AM ] [ 06/13/98 9:41 AM ] [ 11/18/92 7:56 AM ] INSTR1 W !,"*****************************************************" W !,"********************************************************" Q INSTR W !,"********************************************************************" W !," ENTER GLOBAL REFERENCE F.EX. ^A(1,""BC"",""124-A"")" W !," OR REFERENCE & ':' TO SEARCH A NODE" W !," OR ?? FOR A LIST OF ALL GLOBALS" W !,"*******************************************************************",! Q HELP2 W !!,"" G YES^%S3GLKR HELP3 W ! G ZK^%S3GLKR Q %S3GLKR %S3GLKR ; [ 29.12.23 10:06 ] [ 10/04/2000 9:59 AM ] [ 06/18/98 10:42 AM ] W !!,"Routine not directly callable by user - use ^%S3G" Q B N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S3G,%S2ERG) N $ZT D ^%L1C X %chista S %SAY=" FULL SCREEN GLOBAL EDITOR " X %XMSGV W !!?2,"WARNING ! IF LENGTH OF GLOBAL REFERENCE + DATA MORE THAN 255 SYMBOLS" W !?2,"YOU'LL GET ERROR IN FULL SCREEN MODE ." ;;W !?2,"TO AVOID IT SET MODE FLAG TO GLOBAL DATA LENGTH UP TO 511 CHARACTERS",! ;;W !?2,"IF LENGTH OF DATA GREATER OF 255 SYMBOLS" ;;W !?2,"EDITOR IS NOT WORK PROPERLY !!!",! BG K (%S3G,%S2ERG) D ^%L1C I $S<(19*1024) W !!?10,"FREE MEMORY NOW IS "_$J($S/1024,1,1)_"K . MINIMUM MEMORY FOR EDITOR IS 36K " Q S MAC="^" N %HBRY KOD K (%Z,MAC,%S3G,%S2ERG) S %BEG=1,%BE="E" D:'$D(%POSIC) ^%L1C S %TIPT=1 S PZ="W $C(27,91),24,*59,1,*72" S $ZT="S zr=$R X ^ZT G ER^%S3GLKR" K %HBRY W %ENG ;;W !!,"HEBREW (Y/N) ? " D ^%ZMSL I "Nn"'[%S S %HBRY="" I $D(%S3G("MAC")) S MAC=%S3G("MAC") G REG4 W !!,"GLOBAL NAME (EXIT - , HELP - ? ) : " S %S=$S($D(MAC):MAC,1:"^") D ^%ZMSL G:($G(%TO)="END")!(%TO="UP") END S MAC=%S I MAC="?"!(MAC="^?") D INSTR^%S3GLK1 K MAC G KOD I MAC="??"!(MAC="^??")!(%TO="F7") D ^%GD K (%Z,%S3G,%S2ERG) G BG G:MAC=""!(MAC="^")!($G(%TO)="END") END I $E(MAC,$L(MAC))=":" S MAC=$E(MAC,1,$L(MAC)-1) D S MAC=$R D ^%L4NU G:FLAG="." REG0 G:FLAG'="" KOD .I $D(@MAC) I '($D(@MAC)#2) W !!,*7," <",MAC,"> - UNDEFINED !" G REG0 W !!,MAC," ",$E(@MAC,1,50),!?10,$E(@MAC,51,120),!?10,$E(@MAC,121,190) G:'%BEG REG REG0 W !!,"1 - EDIT THIS NODE" W !,"2 - FULL SCREEN GLOBAL'S EDITOR" W !,"- EXIT" REG S BD1=$S($F(MAC,"("):$E(MAC,1,$L(MAC)-1)_",""",1:MAC_"(""") S %BEG=0 W !!,"FUNCTION (? - HELP) > " S CIST="12?",%LS=1 K %S D ^%ZMSL S %REG=%S G:%REG="" KOD G:%REG="?" REG0 I '("12"[%REG) W ?40,*7," ???" G REG D @$S(%REG=1:"REG1",1:"REG4") G KOD END Q ER I $F($ZS,"CTRAP") W !,*7,"*** BYE ..." G END W *7," *** ERROR :",$ZS H 2 G KOD REG1 ; I '($D(@MAC)#10) W !!,*7,"*** THIS NODE IS UNDEFINED ! " S %S=$G(@MAC) W !!,"PLEASE...",!!! S %Y1=17 D ^%L1WE I %S="",'($D(@MAC)#10) Q S @MAC=%S W !!!! D COMM Q REG4 K %PRER4 W *27,7 I $D(%S2ERG) S %SAY=" YOU ALREADY IN EDITOR ! " X %XMSGV(1) W *27,8 Q W !!!?10,"WAIT PLEASE...",!!! K ^S000($P) D ^%S1GLSV I FLAG=1 W *7,!,"*** ARRAY TOO LARGE !",!," CHOOSE SUBGLOBAL ." H 2 K ^S000($P) Q S U=1 ERG I $D(%S2ERG) S %SAY=" YOU ALREADY IN EDITOR ! " X %XMSGV(1) Q I '$D(%S3G("VIEW")) S %TIP="G",%FLI=1 D ^%S2ERG I $D(%S3G("VIEW")) S %TIP="G",%FLI=1 K ^TMPS111($J) M ^TMPS111($J)=^S000($P) D ^%S2VIEW G END4 YES I '$D(%S3G("VIEW")) W # K %Q S %Q("Z")="SAVE " D ^%S1ASK I 'YES K ^S000($P) Q ZNAME S $ZT="ZG "_$ZL_":ER4" W !,"NEW GLOBAL'S NAME [ WITHOUT '()' ]:^" S %S=$P($P(MAC,"(",1),"^",2),%LS=9 D ^%ZMSL I %S=""!($G(%TO)="END") K ^S000($P) Q S NNAME=%S I $E(NNAME)'="[",NNAME'?1"%".UN&(NNAME'?1A.AN) W *7," ERROR !" G ZNAME I $E(NNAME)="[",$P(NNAME,"]",2,255)'?1"%".UN&($P(NNAME,"]",2,255)'?1A.AN) W *7," ERROR !" G ZNAME ZC S %Q("Z")="VERIFY INDEXES " D ^%S1ASK I 'YES G ZK W !!!?10,"INDEX VERIFICATION ...",!!! K %S0 S I1=1 Q:'$D(^S000($P,1)) CHECK S %PRD=0 K ^s3glkr($P) F I=I1:1 Q:'$D(^S000($P,I)) W:'(I#500) "." S %IX=$P($P(^(I),")=",1),"(",2,511) I %IX'="",$P($P(^(I),"="),"(",2)'="" X "I $D(@(""^s3glkr($P,""_%IX_"")"")) W *7,!?5,""DOUBLE INDEX !"" H 1 S U=I,%PRD=1" G:%PRD ERG S @("^s3glkr($P,"_%IX_")")="" ZK K %S0,%Q S %Q("Z")="KILL OLD GLOBAL " D ^%S1ASK I YES,NNAME=$P($P(MAC,"(",1),"^",2) D .K ^s3glkr1($P) W !!,"SAVING OLD GLOBAL TO GLOBAL ^s3glkr1($P) ..." .S MAC1=MAC,MAC2="^s3glkr1($P)" D ^%S1GC1 W !!?10," SAVING ^"_NNAME_" ... ",!! S I1=1 N A S A=$G(@MAC,"%s3glkr") K:YES @MAC ;;I A'="%s3glkr" S @MAC=A F I=I1:1 Q:'$D(^S000($P,I)) D .W:'(I#500) "." .S %IND=$S($P($P(^(I),"="),"(",2)'="":"("_$P($P(^(I),")="),"(",2)_")",1:"") .Q:MAC["("&(%IND="") .N %THN S %THN=$P(^S000($P,I),$S(%IND="":"=",1:")="),2,511) Q:%THN["<<<<>>>>" .S %THN=$$STW^%L1ED(%THN) .S @("^"_NNAME_%IND)=%THN K ^S000($P),^s3glkr($P) ;;ZF D COMM END4 Q ; ER4 S %PRER4="" I $ZS["",1)," > IN LINE ",I W:$D(%IND) !,"%IND=",%IND H 2 S $ZT="ZG "_$ZL_":ER4" S U=$S(I>0:I,1:1) G ERG Q COMM ; Q:$D(%S3G) S %GET="COMMENT :++23,1,EE#++60,E,I" D ^%L1GET ;;Q:%S=""!(%TO="END") S ^%ERGS(+$H,MAC,$P($H,",",2))=%S S ^%ERGS(+$H,MAC)=$ZG Q %S3GLSV %S3GLSV(MAC,FILE,PRM) ; [ 04.02.26 16:21 ] [ 04.02.24 15:12 ] [ Q:$G(^S3NOGIB)=1 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%S3GLSV" S MAC=$$^%S1MCIND(MAC) ; N %PR,%MAC1,%MAC2,%ORD,%DEV,FLAG N MSD0 S MSD0=$G(MSD) N MSD S MSD=MSD0 I '$G(MSD) S MSD=$$GET^%W1PRM("MSD") N DIR S DIR=$P(FILE,"/",1,$L(FILE,"/")-1) I $$^%L1ZOS(10,DIR)<0 D .ZSY "mkdir -p "_DIR ; C FILE O FILE:(APPEND) U FILE I $G(PRM)="K" W "#K "_MAC,! G END S %PR=0,FLAG=0 ; I $D(@MAC) S %MAC1=$R,%MAC2=$E($R,1,$L($R)-1)_$S(MAC["(":",",1:"") ; I ($D(@MAC)#10)'=0 S %PR=1 D .W MAC,!,$G(@MAC),! .D REM(MAC,@MAC) ; I $G(PRM)=1 G END I %MAC1["(" S %MAC1=$E(%MAC1,1,$L(%MAC1)-1)_","""")" I %MAC1'["(" S %MAC1=%MAC1_"("""")" S %MAC1=$Q(@%MAC1) I %MAC1="" G END ; PR F Q:%MAC1'[%MAC2 Q:%MAC1="" W %MAC1,!,$G(@%MAC1),! D REM(%MAC1,$G(@%MAC1)) S %MAC1=$Q(@%MAC1) Q:%MAC1="" ; END C FILE K %MAC1,%MAC2,%PR,%ZE,%IND,%IND1,%IND2 Q ; ER D SVER^%L1X G END ; REM(IND,TXT) ; Q:'$G(@$$^W4PRM@("REMGIB")) I '$D(MSD) S MSD=$$GET^%W1PRM("MSD") Q:'MSD N REMGIB,DT S DT=$$^W4DZ S REMGIB=$$REMGIB L +@REMGIB@(MSD,DT):2 N SH S SH=$O(@REMGIB@(MSD,DT,9999999),-1)+1 S @REMGIB@(MSD,DT,SH)=IND S @REMGIB@(MSD,DT,SH+1)=TXT L -@REMGIB@(MSD,DT) Q ; REMGIB(STAM) Q "^|$$^W3MAIN|REMGIB" %S4BSG %S4BSG ; [ 24.10.06 07:58 ] [ 26.10.05 18:27 ] [ 18.05.04 09:46 ] ; INPUT: ^S4B($P, ; %S4B("SHP") - HEADER CODE ; %S4B("TXT") - TOP MESSAGE ; %S4B("TXT1") - BOTTOM MESSAGE ; %S4B("RG",...) - REG-R ; %S4B("SUM",...)="" - SUM ; %S4B("FORM",...)="" - FORMULA ; %S4B("VGR") - TOP SCREEN MARGIN ; %S4B("NGR") - BOTTOM SCREEN MARGIN ; %S4B("LEFT") - LEFT MARGIN ; %S4B("LAB") - LINE NUMBER (%TIP="G") ; %S4B("PRINT") - ASK FOR PRINT ; %S4B("VIEW") - VIEW ONLY ; %S4B("IND") - LINE INDEX ON(=1) OR OFF (=0) ; %S4B("LINE1") - LINE INPUT ; %S4B("NEWST") - NEW LINE INPUT POSSIBLE ; %ST - COUNTER OF LINES IN FILE ; %STR - COUNTER OF LINES IN SCREEN ; %SCH - COUNTER OF GRAF ;---------------------------------------------------------------- N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%S4B,%S4BO) D ^%L1C K %S4BO D INIT W %HBR G BEGROU ;----------------------------------------------------------------- DELAY I %TYPCRT["VT" F X=1:1:200 Q BEGGR ; I %SCH'>%KOLR,%SCH'<1,MPOZ(%SCH)<80,%STR<25 S %XX=MPOZ(%SCH),%YY=%S4B("VGR1")+%STR-1 X %POSIC S %S=$P($G(^S4B($P,%ST)),%R,$$IX(%SCH)) Q PNS W %vverxe,"--LINE:",$J(%ST,3) S %OLDS=$G(^S4B($P,%ST)) ;;D BEGGR I $D(%S4B("INV")) W %CLI D STROKA(%ST,%STR) D BEGGR Q STROKA(%ST,%STR) ; N %XX,%YY,A I '$D(%R) S %R="\" I $D(%S4B("RZD")) S %R=%S4B("RZD") S A=$G(^S4B($P,%ST)) F JJ=1:1:%S4B("FIX") D .S %XX=MPOZ(JJ)-$L($P(A,%R,JJ))+1,%YY=%S4B("VGR1")+%STR-1 X %POSIC .W $TR($TR($P(A,%R,JJ),%TES1,%TES2),%TEN,%THB) F JJ=%S4B("FIX")+1:1:%KOLR D GRAFA(%ST,JJ,%STR) Q GRAFA(I,J,%STR) ; N A S A=$G(^S4B($P,I)) ;;S %XX=MPOZ(J)-$L($P(A,%R,$$IX(J)))+1 S %XX=MPOZ(J)-MDLIN(J)+1 S %YY=%S4B("VGR1")+%STR-1 X %POSIC W $J($TR($TR($P(A,%R,$$IX(J)),%TES1,%TES2),%TEN,%THB),MDLIN(J)) Q NAZAD ; I %SCH>(%S4B("FIX")+1) S %SCH=%SCH-1 D PSK1 D BEGGR Q VPERED ; I %SCH<%KOLR S %SCH=%SCH+1 D BEGGR Q VVERX ; I $D(%S4B("NOEXP")),%ST'>1 Q S $P(^S4B($P,%ST),%R,$$IX(%SCH))=$TR(%S,%R,"/") I %ST'>1,$G(%S4B("FIX")) Q I %ST'>1 S %ST=0,%SCH=1 W *13,%chists D VSTAV G EV I $D(%S4B("INV")) X %XCL D STROKA(%ST,%STR) S %ST=%ST-1 I %STR>1 S %STR=%STR-1 D PNS G EV I %STR'>1 S %STR=1 D P,PNS EV ;;I $D(%S4B("INV")) W %CLI D STROKA(%ST,%STR) Q VNIZ ; S:%SCH'>%KOLR $P(^S4B($P,%ST),%R,$$IX(%SCH))=$TR(%S,%R,"/") I '$D(^S4B($P,%ST+1)) Q:'$D(%S4B("NEWST")) S ^S4B($P,%ST+1)=%R,%SCH=$G(%S4B("FIX"))+1 I $D(%S4B("INV")) X %XCL D STROKA(%ST,%STR),BEGGR S %ST=%ST+1 I %STR<(%S4B("RSTR")-1) S %STR=%STR+1 D:$D(%S4B("INV")) D PNS Q .;;W %CLI D STROKA(%ST,%STR) I %STR'<(%S4B("RSTR")-1) D .S %XX=0,%YY=%S4B("VGR1") X %POSIC W %chists .D BEGGR W ! D PNS ;;W:$D(%S4B("INV")) %CLI .D STROKA(%ST,%STR) Q VVERXE ; I %ST>%STR S %ST=%ST-%STR+1,%STR=1,%SCH=$G(%S4B("FIX"))+1 D PNS Q I %ST'>%STR S %STR=%STR-%ST+1,%ST=1,%SCH=%S4B("FIX")+1 D PNS Q HELP D .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C .X "ZL %S4BSGH K ^TMPS111($J) N I F I=2:1 Q:$T(+I)="""" S ^TMPS111($J,I)=$T(+I)" S %S2V("LEFT")=1 X %chista W %CV("YF") D ^%S2VIEW D VIEW Q ;- VIZ ; I '$D(%LS) S %LS=8 N %BE S %ZMSF="",%FLL=1,%ZMSL="=" S %S=$P($G(^S4B($P,%ST)),%R,$$IX(%SCH)) I $G(MDLIN(%SCH))=1 S %GET(1)="" I $G(%S4B("RG",%SCH))="H" S $Y=%YY,$X=%XX S:%C>95&(%C<123) %BE="E" D ^%L1ZMS G ENDCYC S %XX=MPOZ(%SCH)-MDLIN(%SCH)+1 X %POSIC S %S=$C(%C) D ^%ZMSL ENDCYC I $D(MDLIN(%SCH,2)) I ($L(%S)<%LS)&(MDLIN(%SCH,2)=1) W *7,%vverxe,"***FORMAT*** !" D BEGGR S %FL=0 G VIZ S $P(^S4B($P,%ST),%R,$$IX(%SCH))=$TR(%S,%R,"/") Q ;------------------------- BEGIN OF ROUTINE ----------------------------- BEGROU ; ;;I $D(%S4B("VIEW")),$D(%S4B("SUM")) D SUM N %BEG S %PRFIN=0,%BEG=1 K CIST D VIEW CVV ; I $D(%S4B("CMD1")) X %S4B("CMD1") K %TO S %S=$P($G(^S4B($P,%ST)),%R,$$IX(%SCH)) D BEGGR OBRVV ; S %D=0 I $$HZGTOUCH^%L2MOUSE,'$$KB^%L2MOUSE,'$D(%L1NMB("NO")) S %ZMSF="" W *27,7 S %C=$$^%L1NMB("") W *27,8 S:%C="ENTER" %C="" S:$L(%C)<2 %C=$A(%C) G:%C?1N.N ENTER G:%C'?1U.E CVV G:$T(@%C)="" CVV D @%C G CVV R *%C G:%TYPCRT="PC" 27 S ZB="",ZB0=$ZB ;-- VT F %JJ=2:1:$L($ZB) S ZB=ZB_$A($E($ZB,%JJ)) I ZB=9191 R *C1:0 I C1>0 S ZB=ZB_C1 I $D(%UPRCOD(ZB)),$A($E(ZB0))=27,$T(@%UPRCOD(ZB))'="" D @%UPRCOD(ZB) G CVV ;OBRVV I $A($E(ZB0))=27 K ZB0 D ESC G OBRVV I $L($ZB)>3,$D(%UPRCOD($ZB))#2,$T(@%UPRCOD($ZB))'="" K %FLL D @%UPRCOD($ZB) G CVV ;OBRVV ; 27 I %C=27 D I %C1<0 D TABN G OBRVV .R *%C1:0 D DELAY ; I %C=27 D I C,$D(%UPRCOD(C)),$T(@%UPRCOD(C))'="" K %FLL G:$G(%UPRCOD(C))="LEVO"&('$D(%S4B("VIEW"))&($G(MDLIN(%SCH))>1)) LABTAB D @%UPRCOD(C) G CVV ;OBRVV .S C="" D DELAY R:'$D(%FLL) *%C2:%WAIT S:%C2>0 C=%C1_%C2 .R:'$D(%FLL) *%C3:%WAIT S:%C3>0 C=C_%C3 .R:'$D(%FLL) *%C4:%WAIT S:%C4>0 C=C_%C4 ; ENTER I %C=13,$$IX(%SCH+1)'<%SGR,$D(%S4B("LINE1")) D VNIZ,HOME G OBRVV I %C=13 S:$D(%S4B("LINE1")) %C=9 I %C=13 D PSK2 G CVV LABTAB I %C=9 G:$$IX(%SCH+1)'<%SGR CVV S %SCH=%SCH+1 D PSK1 I %SCH'>%KOLR G CVV I %C=9,%SCH>(%S4B("FIX")+1) S %FGR=%FGR+1 D VIEW G CVV I %C=8!(%C=127),'$D(%S4B("VIEW")) G M I %C=25!(%C=61) S %PRFIN=1 G ENDOBR I %C=1 D DELCOL G CVV I %C>31,%C<127,'$D(%S4B("VIEW")) G M I %C=%DEL,'$D(%S4B("VIEW")) S %S=$E(%S,2,255),%FL=1 G M2 I %C=15 D NAZAD G ENDOBR ; I %C=0,$L($ZB),$D(%UPRCOD($ZB)) G:$ZB=5147&'$D(%S4B("VIEW")) M I $T(@%UPRCOD($ZB))'="" S %B=$ZB D @%UPRCOD(%B) G:$G(%PRFIN) ENDOBR G CVV I %C=0 D DELAY R *%C1:0 D DELAY R *%C2:0 I %C1>0 S %D="0"_%C1 G:'$D(%UPRCOD(%D)) CVV D:$T(@%UPRCOD(%D))'="" @%UPRCOD(%D) G CVV I %C=30 D LNAZAD G CVV ;-- CTRL+^ I %C=14 D LVPERED G CVV ;---- CTRL+N ;;I %C=16 S RAZD=%R D PEREST G CVV ;CTRL+P ;;I %C=20 F I=1:1:%S4B("RSTR")-%STR Q:'$D(^S4B($P,%ST+I)) ; W %vniz ; CTRL+T ;;I S %STR=%STR+I-'$D(^S4B($P,%ST+I)),%ST=%ST+I-'$D(^S4B($P,%ST+I)),%SCH=%S4B("FIX")+1 D PNS G CVV ; *** . I %C=20 D POP G CVV I %C=21!(%C=22),'$D(%S4B("VIEW")) D VSTAV:%C=22,UDAL:%C=21 G CVV ;CTRL+U,CTRL+V I %C=24 D G CVV .W *27,7 N %XXZMS,%YYZMS S %XXZMS=%XX,%YYZMS=%YY .D ^%L1CLC .S:$D(%L1CLC("F"))&'$D(%S4B("VIEW")) %S=%L1CLC .W *27,8 S %XX=%XXZMS,%YY=%YYZMS X %POSIC S $X=%XX,$Y=%YY I %C=26 D SAVE G CVV ;--- CTRL+Z I %C=18,'$D(%S4B("VIEW")) D REST G CVV ;CTRL+R ;;I %C=126 D HELP G CVV ;CTRL+F1 I %C'>31 D G CVV .I $D(%UPRCOD(%C)),$T(@%UPRCOD(%C))'="" D @%UPRCOD(%C) G CVV ; TAB S %C=9 G LABTAB TABN ; I %SCH>(%S4B("FIX")+1) D NAZAD Q I %FGR>(%S4B("FIX")+1) S %FGR=%FGR-1,%SCH=%S4B("FIX")+1 D PSK1 D VIEW Q Q LEVO Q:$$IX(%SCH+1)'<%SGR S %SCH=%SCH+1 D PSK1 I %SCH'>%KOLR Q I %SCH>(%S4B("FIX")+1) S %FGR=%FGR+1 D VIEW Q PRAVO Q:$$IX(%SCH+1)'>(%S4B("FIX")+1) I %SCH>1 S %SCH=%SCH-1 D PSK1 I %SCH'>%KOLR Q I %SCH'>1 S %FGR=%FGR-1 D VIEW Q ; M S %FLL=1,%I=1 I %C>31&(%C<127) S %A=$C(%C) M2 S %LS=$S($D(MDLIN(%SCH)):MDLIN(%SCH),1:255) K CIST S:$D(MSIMB(%SCH))#10 CIST=MSIMB(%SCH) I $G(%C)=27,$G(%C1)=91,$G(%C2)=68,$G(MDLIN(%SCH))=1 S %TO="TAB" G ENDOBR I $G(%C)=27,$G(%C1)=91,$G(%C2)=67,$G(MDLIN(%SCH))=1 S %TO="TABN" G ENDOBR D VIZ ENDOBR I %PRFIN G END I $G(%TO)="UP" D VVERX G CVV I %TO="END" G ESC ;;I $G(%TO)="END" D I %TO="END" G END .I $D(%S4B("LINE1")),'$D(%S4B("VIEW")),%SCH>(%S4B("FIX")+1) S %TO="TABN" I $G(%TO)="DW" D VNIZ G CVV I $G(%TO)="PGUP" D LNAZAD G CVV I $G(%TO)="PGDW" D LVPERED G CVV I $G(%TO)="TABN"!($G(%TO)="RIGHT"&$D(%S4B("VIEW"))) D TABN G CVV I $G(%TO)="TAB"!($G(%TO)="LEFT"&$D(%S4B("VIEW")))!($G(%TO)=""&$D(%S4B("LINE1"))) S %TO="",%C=9 G LABTAB I $G(%TO)?1A.E,$T(@%TO)'="" D @%TO G CVV I $D(%TO),%TO="" D PSK2 G CVV G CVV ESC ; G TABN ;; I $D(%S4B("LINE1")),'$D(%S4B("VIEW")),%SCH>(%S4B("FIX")+1) S %C=15,%TO="TABN",%SCH=%SCH+1 G LABTAB S %PRFIN=1 ; END ; I $$HZGTOUCH^%L2MOUSE,$D(screen)!$D(^P1VIDEO($$POS^%L2MOUSE)),$D(%L1NMB("X0")) X %chista D PUT^%VIDEO("screen",%L1NMB("X0"),%L1NMB("Y0"),%L1NMB("X2"),%L1NMB("Y2"),2) U 0 W $C(27,91),"1;25r" I %TYPCRT'="PC" S %XX=1,%YY=23 X %POSIC W ! I $D(%S4B("PRINT")) S %GET="99 - qitcdl, 97 - EXCEL-l uaew oikdl" D N^%L1GET D PRINT:%S=99,EXCEL:%S=97 S %S4BO("ST")=%ST,%S4BO("SCH")=%SCH,%S4BO("STR")=%STR K %S4B X %XCL Q ; ;- HOME S %FGR=%S4B("FIX")+1,%SCH=%FGR D VIEW S %S=$P($G(^S4B($P,%ST)),%R,$$IX(%SCH)) Q ENDS ; S %FGR=%SGR-%KOLR+%S4B("FIX"),%SCH=%S4B("FIX")+1 D VIEW Q Q PGUP D LNAZAD Q PGDW ; PGDN D LVPERED Q MET I $D(%S4B("MET")) X %S4B("MET") Q F1 ; CHISTS I $D(%S4B("F1")) X %S4B("F1") Q S $P(^S4B($P,%ST),%R,$$IX(%SCH))="" D GRAFA(%ST,%SCH,%STR) Q F2 ; CHISTE I $D(%S4B("F2")) X %S4B("F2") Q Q ;;F3 ; ;;SBROS I $D(%S4B("F3")) X %S4B("F3") Q F4 ; IND I $D(%S4B("F4")) X %S4B("F4") Q Q INS D VSTAVS Q F5 ; ADDL I $D(%S4B("F5")) X %S4B("F5") Q D VSTAV Q MOD ; F6 ; DELL I $D(%S4B("F6")) X %S4B("F6") Q D UDAL Q F7 ; COR I $D(%S4B("F7")) X %S4B("F7") Q PGLN I %FGR+%KOLR'>%SGR S %FGR=%FGR+%KOLR-%S4B("FIX") D VIEW Q D ENDS Q F8 ; FIND I $D(%S4B("F8")),%S4B("F8")'="DEL" X %S4B("F8") Q Q:$D(%S4B("VIEW")) Q:$G(%S4B("F8"))'="DEL" N %S,%TO,%L1GET,%C,%FLL S %GET="3-(dl`ny onqn) dxey ,2 -(dhnl onqn) dcenr ,1 -(dl`ny onqn) zecenrd lk zewpl" D N^%L1GET I %S=1 D D VIEW G CVV .N %I,%J F %I=1:1 Q:'$D(^S4B($P,%I)) D ..F %J=$$IX(%SCH):1:%SGR S $P(^S4B($P,%I),%R,%J)="" I %S=2 D D VIEW G CVV .N %I F %I=%ST:1 Q:'$D(^S4B($P,%I)) S $P(^S4B($P,%I),%R,$$IX(%SCH))="" I %S=3 D D VIEW G CVV .N %I F %J=$$IX(%SCH):1:%SGR S $P(^S4B($P,%ST),%R,%J)="" Q PGRG I %FGR-%KOLR+1'<(%S4B("FIX")+1) S %FGR=%FGR-%KOLR+1 D VIEW Q D HOME Q VNIZE D POP Q PRSC D ^%L1PRSC Q PSK1 ; Q:'$G(%S4B("FIX")) Q:$P($G(^S4B($P,%ST)),%R,1)'?.P I $D(%S4B("INV")) X %XCL D STROKA(%ST,%STR) N I F I=%ST:-1:1 Q:$P($G(^S4B($P,I)),%R,1)'?.P I $P($G(^S4B($P,I)),%R,1)'="" D .I %ST-I+1>%STR S %ST=I D P,PNS Q .S %STR=%STR+I-%ST,%ST=I D PNS Q PSK2 ; I $P($G(^S4B($P,%ST+1)),%R,1)?.P D VNIZ Q I $P($G(^S4B($P,%ST)),%R,1)'?.P D VNIZ Q Q:$D(%S4B("NOEXP")) Q:'$G(%S4B("FIX")) D VSTAV Q SOOB W %vverxe s %pn=3 w %pravon,*7,TXT X %XCL D BEGGR Q STR1 W %vverxe s %pn=3 X %pravon W *7 Q P ; D BEGGR W *13 X %chiste W %HBR F I=0:1:%S4B("RSTR")-%STR-1 Q:'$D(^S4B($P,%ST+I)) D STROKA(%ST+I,%STR+I) D NIZ I $D(%S4B("TXT1")) S %SAY=%S4B("TXT1") X %XMSGN Q PSHAP ; G:'$D(KOD) EPS G:KOD="" EPS G:'$D(^SHP(KOD,1))#10 EPS N %STR X %chista F %STR=1:1 Q:'$D(^SHP(KOD,%STR)) Q:$E($TR(^(%STR)," ",""))="$" W ^(%STR),! I $E($TR($G(^(%STR))," ",""))="$" S %S4B("PRM")=$E($$SPA^%L1FRM(^SHP(KOD,%STR)),2,255) D GETPAR(%S4B("PRM")) G EP EPS I $D(%S4B("PRM")) D GETPAR(%S4B("PRM")) D:'$D(%NOPC) WS EP X %XCL Q ; GETPAR(PRM) ; S %SGR=$L(%S4B("PRM"),%RSH)-1,SPZ=0 S %SHP=$$DEFSHP(%FGR),%KOLR=$L(%SHP,%RSH)-2 K MPOZ,MDLIN,MSIMB F I=$L(%SHP):-1:1 I $E(%SHP,I)=%RSH D .S SPZ=SPZ+1,MPOZ(SPZ)=I-2+%S4B("LEFT") .I $D(MPOZ(SPZ-1)) S MDLIN(SPZ-1)=MPOZ(SPZ-1)-MPOZ(SPZ)-1 F I=$L(%SHP,"|"):-1:1 D .I $D(%S4B("CIST")) D ..I $D(%S4B("CIST",I)) S MSIMB(I)=%S4B("CIST",I) Q ..I $D(%S4B("CIST"))#2 S MSIMB(I)=%S4B("CIST") .I $D(%S4B("DLIN")) D ..I $D(%S4B("DLIN",I)) S MDLIN(I)=%S4B("DLIN",I) Q ..I $D(%S4B("DLIN"))#2 S MDLIN(I)=%S4B("DLIN") K MPOZ(SPZ) Q ;-------- DEFSHP(%FGR) ; N A1,SPZ,RGR,I,SPZ,B,%SHP N B S B=$P(PRM,%RSH,$L(PRM,%RSH)-%S4B("FIX"),255) S B=$P(PRM,%RSH,1,$L(PRM,%RSH)-%FGR)_%RSH_B S B=$$SPA^%L1FRM($E(B,$L(B)-%S4GW+1,$L(B))) S %SHP=B I $E(%SHP)'=%RSH S %SHP=%RSH_$P(%SHP,%RSH,2,255) Q %SHP ; VSTAV Q:$D(%S4B("NOEXP")) F %LASTI=%ST+1:1 Q:'$D(^S4B($P,%LASTI)) S %LASTI=%LASTI-1 I $D(%S4B("INV")) X %XCL D STROKA(%ST,%STR) F I=%LASTI:-1:%ST+1 S ^(I+1)=$G(^S4B($P,I)) S ^S4B($P,%ST+1)=%R I '%ST S %ST=1,%S="" D P,PNS Q D P,VNIZ,PNS Q VSTAVS Q:$D(%S4B("NOEXP")) F %LASTI=%ST:1 Q:'$D(^S4B($P,%LASTI)) S %LASTI=%LASTI-1 I $D(%S4B("INV")) X %XCL D STROKA(%ST,%STR) F I=%LASTI:-1:%ST S ^(I+1)=$G(^S4B($P,I)) S ^S4B($P,%ST)=%R D P,PNS Q Q UDAL Q:$D(%S4B("NOEXP")) F I=%ST:1 Q:'$D(^S4B($P,I+1)) S ^(I)=^(I+1) K ^S4B($P,I) X %XCL D P S %SCH=%S4B("FIX")+1 D PNS Q SBROS S ^S4B($P,%ST)=%OLDS D STROKA(%ST,%STR),BEGGR Q LNAZAD Q:%ST'>%STR X %XCL S %ST=%ST-%STR-%S4B("RSTR")+2 S:%ST'>0 %ST=1 S %STR=1 D:%ST=1 PSHAP S %V=$G(^S4B($P,1)) D BEGGR,P,PNS Q LVPERED X %XCL I %ST'<%STR Q:'$D(^S4B($P,%ST-%STR+%S4B("RSTR"))) S %ST=%ST+%S4B("RSTR")-%STR,%STR=1 D BEGGR,P,PNS Q I %ST<%STR Q:'$D(^S4B($P,%S4B("RSTR")-%STR+%ST)) S %ST=%S4B("RSTR")-%STR+%ST,%STR=1 D BEGGR,P,PNS Q SAVE I $D(%S4B("F9")) X %S4B("F9") D:$D(%S4B("F9","REST")) D:'$D(%S4B("F9","REST")) PNS,BEGGR Q .D VIEW K %S4B("F9","REST") K %Z S %GET="zexey xenyl++24,70,HH,,,C#1++3,E,I" D ^%L1GET I %TO="END"!(%S'>0) S %SAY=%S4B("TXT1") X %XMSGN Q S %LINES=%S S %GET="zecenr++24,50,HH#1++2,E,I" D ^%L1GET G:%TO="END"!(%S'>0) SAVE S %COLS=%S F J=1:1:%LINES Q:'$D(^S4B($P,%ST+J-1)) S %Z(J)=$P(^(%ST+J-1),%R,$$IX(%SCH),$$IX(%SCH)+%COLS-1) S %Z=J-'$D(^(%ST+J-1)) SAVE1 S %GET="wegnl++24,30,HH#l++1,H,I" D ^%L1GET G:%TO="END"!(%S="") SAVE I %S'="k",%S'="l",%S'="F",%S'="K" W *7 G SAVE Q:%S'="F"&(%S'="k") I %SCH>%S4B("FIX") F J=0:1:%Z-1 S $P(^S4B($P,%ST+J),%R,$$IX(%SCH),$$IX(%SCH)+$L(%Z(J+1),%R)-1)=$TR($J("",$L(%Z(J+1),%R)-1)," ",%R) D P Q REST I $D(%S4B("F10")) X %S4B("F10") Q I $D(%Z)'=11 W *7 Q I %Z'?1N.N!(%Z'>0) W *7 Q F J=0:1:%Z-1 S $P(^S4B($P,%ST+J),%R,$$IX(%SCH),$$IX(%SCH)+$L(%Z(J+1),%R)-1)=$G(%Z(J+1)) X %XCL D P,PNS Q PEREST ; S NEWROU="%S4BSG" S NEWNEW="GRAF,LINE,NGRAF,NG,LINE1" X XNEW1 S ERP=0 I $D(^S4B($P,1)) W %vverxe,%chists R " GRAF NUMBER > ",NGRAF I NGRAF="" G EPER K NG F I=1:1:$L(NGRAF,",") S NG(I)=$P(NGRAF,",",I) I NG(I)'?1N,NG(I)'?2N,'$D(MPOZ(NG(I))) S ERP=1 I ERP W *7," ???" G PEREST F I=1:1 Q:'$D(^S4B($P,I)) S LINE=^(I),LINE1="" D PE1 G PER1 PE1 F J=1:1 Q:'$D(NG(J)) S GRAF=$P(LINE,RAZD,NG(J)) S LINE1=LINE1_GRAF_RAZD S ^S4B($P,I)=LINE1 K LINE S NEWROU="%S4BSG" X XNEW2 Q PER1 S %ST=%ST-%STR+1,%STR=1,%SCH=%S4B("FIX")+1 S:%ST<0 %ST=1 D PSHAP S %V=$G(^S4B($P,1)) D BEGGR,P,PNS,BEGGR EPER ; Q INIT D USE K U1,Y1 N I S %FLV=1 S:$D(%S4B("IND")) %FLI=%S4B("IND") S:'$D(%FLI) %FLI=0 S %FLH=0,SDV=60 S:'$D(%TIP) %TIP="G" ; S %RSH="|" I $D(%S4B("RSH")) S %RSH=%S4B("RSH") S %R="\" I $D(%S4B("RZD")) S %R=%S4B("RZD") K KOD I $D(%S4B("SHP"))#2 S KOD=%S4B("SHP") I '$D(%S4B("U1")) S %S4B("U1")=1 I '$D(%S4B("FGR")) S %S4B("FGR")=1 I '$D(%S4B("NGR")) S %S4B("NGR")=23 I '$D(%S4B("VGR")) S %S4B("VGR")=1 I '$D(%S4B("LEFT")) S %S4B("LEFT")=0 I '$D(%S4B("RIGHT")) S %S4B("RIGHT")=79 I $E(%TYPCRT,1,3)="VT5",$D(%S4B("SMALL")) S %S4B("RIGHT")=125 W $C(27),"[?3h" I %S4B("VGR")<1 S %S4B("VGR")=1 I %S4B("NGR")>24 S %S4B("NGR")=24 I '$D(%S4B("FIX")) S %S4B("FIX")=0 S %S4GW=%S4B("RIGHT")-%S4B("LEFT") ;;U $P:(NOECHO:NOWRAP) S:'$D(%S4B("VGR1")) %S4B("VGR1")=%S4B("VGR") S:'$D(%S4B("NGR1")) %S4B("NGR1")=%S4B("NGR") I %S4B("VGR1")<1 S %S4B("VGR1")=1 I %S4B("NGR1")>24 S %S4B("NGR1")=24 S %S4B("RSTR")=%S4B("NGR1")-%S4B("VGR1")+1 W *27,"["_(%S4B("VGR1")+1)_";"_%S4B("NGR1")_"r" ; S %FGR=%S4B("FGR")+%S4B("FIX") IN1 S %NOPC="" D PSHAP K %NOPC I '$D(MPOZ) F I=1:1:8 S MPOZ(I)=I*10-9 I $D(MDLIN)<10 F I=1:1:8 S MDLIN(I)=9 I $D(%S4B("VRB")) D .N %N S %N="" F S %N=$O(%S4B("VRB",%N)) Q:%N="" S @%N=$G(%S4B("VRB",%N)) F I=1:1 Q:'$D(MPOZ(I)) S %ST=1 I $G(%S4B("ST")) S %ST=%S4B("ST") S %SCH=$G(%S4B("FIX"))+1 I $G(%S4B("SCH")) S %SCH=%S4B("SCH") S %STR=1 I $G(%S4B("STR")) S %STR=%S4B("STR") Q W(A) ; ;;W:%TYPCRT="PC" ! W ?%S4B("LEFT"),A W:%TYPCRT'="PC" ! W !?%S4B("LEFT") I A'[%RSH W A Q N I W $P(A,%RSH) F I=2:1:$L(A,%RSH)-1 D .W %CV("RF")_%RSH_%CV("CF")_$TR($TR($P(A,%RSH,I),%TES1,%TES2),%TEN,%THB)_%CV("RF") W %RSH Q WS X %chista I $D(%S4B("TXT")) S %SAY=%S4B("TXT") X %XMSGV D KAV D W(%SHP) D KAV Q KAV I %TYPCRT["VT" W $C(27),"(0" W %LIGHT1 W %CV("RF") D W($TR($J("",$L(%SHP))," ",$S(%TYPCRT["VT":$C(113),1:"-"))) I %TYPCRT["VT" W $C(27),"(B" Q VIEW ; N %STRO,%STO S %STRO=%STR,%STO=%ST S %STR=1,%ST=%ST-%STRO+1 S:%ST<1 %ST=1 D PSHAP S:%SCH>%KOLR %SCH=%KOLR D P S %STR=%STRO,%ST=%STO D PNS,BEGGR ;;I $D(%S4B("INV")) W %CLI D STROKA(%ST,%STR) Q NIZ Q:'$D(^S4B($P,99999)) S %XX=0,%YY=%S4B("NGR1") X %POSIC D KAV X %XCL,%LIGHT D STROKA(99999,23-%S4B("VGR1")) Q SUM Q:'$D(%S4B("SUM")) N SUM N I,J,K F I=1:1 Q:'$D(^S4B($P,I)) D .F K=1:1:$L(%S4B("SUM"),",") S J=$P(%S4B("SUM"),",",K) S SUM(J)=$G(SUM(J))+$P(^(I),%R,J) S J="" F S J=$O(SUM(J)) Q:J="" S $P(^S4B($P,99999),%R,J)=SUM(J) Q IX(A) Q %FGR-%S4B("FIX")+A-1 POP ; I $G(^zms($P))?1"^"."%"1U.E W *27,7 S:$D(^msphzs($P)) ^($P)=%S D ^%L1ZMST S $X=%XX,$Y=%YY Q PRINT ; S %DEV="USTR" D ^%L1LPT Q:$G(%EROP) D INIT^%S4BSG S %S4GW=125,%FGR=%S4B("FIX")+1,DAF=0 ;;I %MDPSUG=7 S %GET=" ""CONDENSED"" zixep wlciy cr ""FONT"" ywn lr ugl " D N^%L1GET BPC D GETPAR^%S4BSG(%S4B("PRM")) S %SHP=$E(%SHP,1,$L(%SHP)-1) U USTR W %L1OUT("MDP","COND") D PCSHP F I=1:1 Q:'$D(^S4B($P,I)) D .D WPC(I) .I '(I+SHSHP#56) W # D PCSHP W $J($TR($J("",$L(%SHP))," ","-"),%S4GW),! D WPC(99999) I %FGR+%KOLR>%SGR D CLOSE^%L1LPT U 0 X %chista Q H 1 S %FGR=%FGR+%KOLR-1 W # G BPC Q PCSHP ; I '$D(TSS)!'$D(TS0) D ^%L1TS S SHSHP=0 I '$G(%S4B("LOGO")) S %AT=$$SPA^%L1FRM($$^%L1HEAD("")) I $L(%AT) D .I $G(%MDPSUG)=7 D Q ..S %AT=$$SPC^%L1FRM(%AT) ..S %ST=%L1OUT("MDP","B")_$$CENTR^%L1FRM($$TR($TR(%AT,"#_","")),%L1OUT("MDP","GWPC"))_%L1OUT("MDP","N") ..W ?(145-($L(%ST)*2)\2),%ST,!! . .S %ST=%L1OUT("MDP","B")_$$CENTRB^%L1FRM($$TR($TR(%AT,"#_","")),%L1OUT("MDP","GWPC"))_%L1OUT("MDP","N") .W ?(145-($L(%ST)*2)\2),%ST,!! ; I $G(%S4B("LOGO")) F I=1:1:%S4B("LOGO") W ! S SHSHP=SHSHP+1 S DAF=DAF+1 S $X=0 I '$D(TSS) D ^%L1TS W ?10,DAF,$TR(" sc",TS0,TSS) I $D(%S4B("TXT")) W ?(145-($L(%S4B("TXT"))*2)\2),%L1OUT("MDP","B")_$TR(%S4B("TXT"),TS0,TSS)_%L1OUT("MDP","N") N I F I=1:1 Q:'$D(%S4B("TXT",I)) W !?(145-($L(%S4B("TXT",I))*2)\2),%L1OUT("MDP","B")_$TR(%S4B("TXT",I),TS0,TSS)_%L1OUT("MDP","N") W ! W $J($TR($J("",$L(%SHP))," ","-"),%S4GW),! W $J($TR(%SHP,TS0,TSS),%S4GW),! W $J($TR($J("",$L(%SHP))," ","-"),%S4GW),! S SHSHP=SHSHP+I Q WPC(I) ; N ST Q:'$D(^S4B($P,I)) S ST=^S4B($P,I)_$TR($J("",%FGR+%KOLR-%S4B("FIX"))," ",%R) S ST=$P(ST,%R,1,%S4B("FIX"))_%R_$P(ST,%R,%FGR,%FGR+%KOLR-%S4B("FIX")-1) W $J($TR($$MCH^%L1FRM(ST,%R,%SHP,%RSH),TS0,TSS),%S4GW-1),! Q MIUN(J) ; N I,IND,N,MAC1,MAC2,PRZ,STR S PRZ=1 I $G(%S4B("RG",J))="H" G MIUN1 S %GETIN=2 S %GET="2 - dlrnln, 1 - dhnln oein " D N^%L1GET Q:%TO="END"!(%S="") S PRZ=(%S=1) MIUN1 K ^s4bmn($P),^s4bmn1($P) N %REFH1 S %REFH1="^S4B($P)" S %SAY=" ... oeinl oznd `p` " X %XMSGN K ^s4bmn($P),^s4bmn1($P) F I=1:1 Q:'$D(^S4B($P,I)) S STR=$G(^(I)) D .I $G(%S4B("RG",J))="H" D G SORT ..S IND=$$INV^%L1FRM($$SPA^%L1FRM($P(STR,%R,J))) ..S IND=$E(IND_$J("",10-$L(IND)),1,10)_$J(I,5) .I 'PRZ D G SORT ..I $G(%S4B("RG",J))="D" S IND=$E($J(99999-$$^%L1DC($P(STR,%R,J),3),10),1,10)_$J(I,5) Q ..S IND=$E($J(1000000000-$P($P(STR,%R,J),"."),10),1,10)_$J(I,5) .I PRZ D G SORT ..I $G(%S4B("RG",J))="D" S IND=$$^%L1DC($P(STR,%R,J),3)_$J(I,5) Q ..;S IND=$E($J($P($P(STR,%R,J),"."),10),1,10)_$J(I,5) ..S IND=$P($P(STR,%R,J),".")*10000+I SORT .S ^s4bmn($P,IND)=I N SUM S SUM=$G(^S4B($P,99999)) S MAC1=%REFH1 I $E(%REFH1,$L(%REFH1))="," S MAC1=$E(%REFH1,1,$L(%REFH1)-1) S:$E(MAC1,$L(MAC1))'=")" MAC1=MAC1_")" S MAC2="^s4bmn1($P)" D ^%S1GC1 K @MAC1 S N="",I=0 F S N=$O(^s4bmn($P,N)) Q:N="" D .S I=I+1,IND=+^(N) .S ^S4B($P,I)=^s4bmn1($P,IND) I $L(SUM) S ^S4B($P,99999)=SUM K ^s4bmn($P),^s4bmn1($P) S %S4B("FGR")=$G(%FGR)-$G(%S4B("FIX")) D INIT D VIEW Q DELCOL ; Q:$D(%S4B("VIEW")) N I F I=%ST:1 Q:'$D(^S4B($P,I)) D .S $P(^S4B($P,I),%R,$$IX(%SCH))="" S %V=$G(^S4B($P,%ST)) D P,PNS Q TR(%ST) ; Q $TR(%ST,TS0,TSS) ; EXCEL ; K ^TREPK($P) N MDLIN,MPOZ,%SHP D PSHAPEX N PRM,I,J,DL,RGS,DOT,%S S PRM(1)="~" F J=1:1 Q:'$D(MDLIN(J)) D .S PRM(1)=PRM(1)_"H,"_MDLIN(J)_",0*" S PRM(1)=$E(PRM(1),1,$L(PRM(1))-1) S PRM(2)="!*"_$G(%S4B("TXT"))_"*1" S PRM(3)="#*0*0*" F I=1:1 Q:'$D(%S4B("TXT",I)) S PRM(I+3)="?*"_%S4B("TXT",I) I $D(^S4B($P,99999)) D .N IT .S IT="" F I=1:1:$L(^S4B($P,99999),%R) S IT=$P(^S4B($P,99999),%R,I)_"*"_IT .S IT=$E(IT,1,$L(IT)-1) .N LZ S LZ=$L(IT,"*") .S LZ=$L(%SHP,"*")-LZ-1 .I LZ>0 S IT=$TR($J(" ",LZ)," ","*")_IT .S PRM($O(PRM(99999),-1)+1)="&&"_IT ; N %R S %R="\" I $D(%S4B("RZD")) S %R=%S4B("RZD") S ^TREPK($P,1)="!"_%SHP F I=1:1 Q:'$D(^S4B($P,I)) D .S ^TREPK($P,I+1)=$TR(^S4B($P,I),%R,"*") .N LZ S LZ=$L(^TREPK($P,I+1),"*") .S LZ=$L(%SHP,"*")-LZ-2 .I LZ>0 S ^TREPK($P,I+1)=^TREPK($P,I+1)_$TR($J(" ",LZ)," ","*") D ^%L1PCEX Q PSHAPEX ; N %S4B1,%STR,I G:'$D(KOD) EPEX G:KOD="" EPEX G:'$D(^SHP(KOD,1))#10 EPEX M %S4B1("TXT")=%S4B("TXT") F %STR=1:1 Q:'$D(^SHP(KOD,%STR)) Q:$E($TR(^(%STR)," ",""))="$" S %S4B("TXT",%STR)=^(%STR) F I=1:1 Q:'$D(%S4B1("TXT",I)) S %S4B($O(%S4B("TXT",999),-1)+1)=%S4B1("TXT",I) I $E($TR($G(^(%STR))," ",""))="$" S %S4B("PRM")=$E($$SPA^%L1FRM(^SHP(KOD,%STR)),2,255) G EPEX EPEX ; N SPZ S %SHP="" F I=1:1:$L(%S4B("PRM"),%RSH) S %SHP=$P(%S4B("PRM"),%RSH,I)_"*"_%SHP S %SHP=$E(%SHP,1,$L(%SHP)-1) S SPZ=0 F I=$L(%SHP):-1:1 I $E(%SHP,I)="*" D .S SPZ=SPZ+1,MPOZ(SPZ)=I-2+%S4B("LEFT") .I $D(MPOZ(SPZ-1)) S MDLIN(SPZ-1)=MPOZ(SPZ-1)-MPOZ(SPZ)-1 Q USE ; I %TYPCRT="PC" U $P:(NOWRAP:NOECHO:NOESC) Q U $P:(NOWRAP:NOECHO:ESC) Q %S4BSGH %S4BSGH ; [ 06/16/98 11:44 AM ] ;-------------------------------------------------------------------; ; - dxfrn z`vl ; ;-------------------------------------------------------------------; ; - `ad xeh ; ; + - mcew xeh ; ; - `ad sc ; ; - mcew sc ; ; - dl`ny sc ; ; - dpini sc ; ; - dxey seq ; ; - dxey zligz ; ; ; ; - zvayn wegnl ; ; ; ; - mixehe zexey xenyl ; ; - mixehe zexey xfgyl ; ; ; ; - d`ivi ; ;-------------------------------------------------------------------; %W1ALIGN %W1ALIGN(STAM) ; [ 10.08.17 20:20 ] [ 30.07.10 19:42 ] [ 26.06.09 11:06 ] Q " align="""_$S($$^%W1DIR="RTL":"right",1:"left")_"""" INV(STAM) ; Q " align="""_$S($$^%W1DIR="RTL":"left",1:"right")_"""" NUM(STAM) ; Q " dir=""LTR"" align=""right""" %W1ARG %W1ARG ; [ 27.03.23 10:35 ] [ 18.02.21 13:39 ] [ 08.08.17 15:09 ] N %NN S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" D .S %ARG(%NN)=$$CLR($G(%ARG(%NN))) ; S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" I %NN?."%"1U.E D .I $G(%ARG(%NN))?2N1"."2N1"."2N S %ARG(%NN,"D")="" Q .I $G(%ARG(%NN))?2N1"/"2N1"/"2N S %ARG(%NN,"D")="" Q .I %NN?1U.U1"IDdd" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-4)),1,2)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"IDmm" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-4)),3,4)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"IDyy" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-4)),5,6)=%ARG(%NN) K %ARG(%NN) ..S %ARG($E(%NN,1,$L(%NN)-4),"D")="" .I %NN?1U.U1"mnid" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-4)),3,4)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"hrid" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-4)),1,2)=%ARG(%NN) K %ARG(%NN) ..S %ARG($E(%NN,1,$L(%NN)-4),"T")="" . .I %NN?1U.U1"dd" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),1,2)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"mm" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),3,4)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"yy" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),5,6)=%ARG(%NN) K %ARG(%NN) ..S %ARG($E(%NN,1,$L(%NN)-2),"D")="" .I %NN?1U.U1"mn" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),3,4)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"hr" D Q ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),1,2)=%ARG(%NN) K %ARG(%NN) ..S %ARG($E(%NN,1,$L(%NN)-2),"T")="" . S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" I %NN?."%"1U.E D .I $D(%ARG(%NN,"D")),%ARG(%NN)?6N S @%NN=$E(%ARG(%NN),1,2)_"."_$E(%ARG(%NN),3,4)_"."_$E(%ARG(%NN),5,6) Q .I $D(%ARG(%NN,"T")),%ARG(%NN)?4N S @%NN=$E(%ARG(%NN),1,2)_":"_$E(%ARG(%NN),3,4) Q .;;W " %ARG("_%NN_")="_%ARG(%NN),! .S @%NN=%ARG(%NN) Q KILL ; N %NN S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" I %NN?."%"1U.E I %NN'="JB" K @%NN K %ARG Q PCPRM(JB) ; N %NN ;;M ^AA("ARG")=%ARG S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" D .I %NN?1U.U1"dd" D ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),1,2)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"mm" D ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),3,4)=%ARG(%NN) K %ARG(%NN) .I %NN?1U.U1"yy" D ..S $E(%ARG($E(%NN,1,$L(%NN)-2)),5,6)=%ARG(%NN) K %ARG(%NN) ..S %ARG($E(%NN,1,$L(%NN)-2),"D")="" ; S %ERRDATE="" S %NN="" N DT F S %NN=$O(%ARG(%NN)) Q:%NN="" I $D(%ARG(%NN,"D")) D S %ARG(%NN)=DT .S DT=%ARG(%NN) .I $E(%NN,1,2)="ME",DT="" Q .I $E(%NN,1,2)="AD",DT=99999 Q .I DT?5N Q .S DT=$TR(DT,"./","") .I DT'?6N D ..I $E(DT,1,2)'?2N!($E(DT,1,2)<1)!($E(DT,1,2)>31)!($L(DT)<6) S %ERRDATE=%NN_"IDdd" Q ..I $E(DT,3,4)'?2N!($E(DT,3,4)<1)!($E(DT,3,4)>12) S %ERRDATE=%NN_"IDmm" Q ..I $E(DT,5,6)'?2N S %ERRDATE=%NN_"IDyy" .. .S DT=$$^%L1DC(DT,3) ; S %NN="" F S %NN=$O(%ARG(%NN)) Q:%NN="" D .S @$$^%W1GLPRM@("VAL",%NN)=$G(%ARG(%NN)) .S @%NN=%ARG(%NN) ; S %NN="" F S %NN=$O(@$$^%W1GLPRM@("VAL",%NN)) Q:%NN="" D .I %NN?1"AD".E D ..N ME S ME="ME"_$E(%NN,3,100) ..I $G(%ARG(ME))?1"S"1N.N D ...S @$$^%W1GLPRM@("VAL",%NN)=$G(%ARG(ME)) Q ; ; CLR(ARG) ; S ARG=$G(ARG) I $A(ARG,1)>126 S ARG=$E(ARG,2,255) I $A(ARG,1)<32 S ARG=$E(ARG,2,255) I $A(ARG,1)=63 S ARG=$E(ARG,2,255) I $A(ARG,1)=34 S ARG=$E(ARG,2,$L(ARG)-1) Q ARG %W1CLRCH %W1CLRCLH ; [ 01.02.08 15:25 ] [ R !!,"DAYS : ",DAYS Q:DAYS="" S N="" F S N=$O(^CacheTempJSP(N)) Q:N="" D .S DT=$E(N,1,5) .I DT<($H-DAYS) K ^CacheTempJSP(N) Q %W1CLRCS %W1CLRCLH ; [ 01.02.08 15:22 ] [ R !!,"DAYS",DAYS Q:DAYS="" S N="" F S N=$O(^CacheTempJsp(N)) Q:N="" D .S DT=$E(N,1,5) .I DT<($H-DAYS) K ^CacheTempJSP(N) Q %W1COOK %W1COOK ; [ 10.04.07 14:01 ] [ 09.04.07 21:13 ] [ W "",! Q %W1CSS %W1CSS ; [ 24.07.07 07:36 ] [ Q %W1D2U %W1D2U(VL) ; [ 09.07.26 11:50 ] [ 08.07.26 13:36 ] [ N OSMAC S OSMAC=$$GETP^%W1PRM("OSMAC") I 'OSMAC S OSMAC=$G(@$$^W4PRM@("EX2UTF")) I OSMAC Q $$D2U^%L1CNV($$INVH^%L1FRM(VL)) ; I '$D(TS0)!'$D(TS1) D ^%L1TS Q $TR($$INVH^%L1FRM(VL),TS0,TS1) %W1DAT %W1DAT(COD,DT,TXT) ; [ 08.12.25 17:26 ] [ 29.08.25 12:33 ] [ 11.08.25 13:07 ] N WD,DD,MM,YY,DAT S WD=$$WD ; S (DD,MM,YY)="" S DT=$G(DT) S TXT=$G(TXT) ; I $G(DT)="",$$OLDDAT D .S DD="" S MM=$ZD($H,"MM"),YY=$ZD($H,"YY") .N DN S DN=$ZD($H,"DD") I DN<11 S MM="" .I DN<11,+MM=1 S MM="" ; I $G(DT)="",'$$OLDDAT S DT=+$H ; I $G(DT)="-" S (DD,MM,YY)="" ; S DT=$TR(DT,"/",".") ; I $G(DT)?2N1"."2N1"."2N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $G(DT)?2N1"."2N1"."4N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$E($P(DT,".",3),3,4) ; I $G(DT)?1"."2N1"."2N D .S DD="" .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $P($G(DT),",")?5N D .S DD=$ZD(DT,"DD") .S MM=$ZD(DT,"MM") .S YY=$ZD(DT,"YY") ; S ^AA("W1DAT","DT")=DT S DAT=DD_"."_MM_"."_YY S ^AA("W1DAT","DAT0")=DAT ; I $D(%W1DAT("TD")) D ; -- TEXT .W:$G(TXT)'="" "  "_$G(TXT)_"" ; I DT'?5N S DT=$$^%L1DC(DT,3) ; I $$^W4TABLET=2 S %W1DAT("CLND")=2 G CLND2 I '$G(%W1DAT("CLND")) G INP ; -- !!! ; ; ; --------- CALENDER ------- ; W "",! I '$D(%W1DAT("TD")) W $G(TXT)_" " W "",! ; I DT'?5N S DT=$$^%L1DC(DT,3) ; I $G(%W1DAT("CLND"))=1 D .W " " ; CLND2 ; I +$G(%W1DAT("CLND"))=2 D .N DAYS S DAYS=$P(%W1DAT("CLND"),";",2) .N SM S SM=$P(%W1DAT("CLND"),";",3) .I 'DAYS S DAYS=$S($$^W4TABLET:540,1:30),SM=$S($$^W4TABLET:360,1:10) .W "" ; I $$^W4TABLET=2 G END G ED1 ; ; ------------ INPUT DAT ; INP ; ;;W "INP:COD="_COD_" TXT="_TXT_" DD="_DD_" MM="_MM_" YY="_YY_" WD="_WD,! ; I $D(%W1DAT("TD")) W "" N STDT S STDT=$$STDT(COD,TXT,DD,MM,YY,WD) W STDT ED ; ED1 ; ; I $D(%W1DAT("TD")) W "",! ; END ; K %W1DAT Q ; ; ONCHANGE ; I $D(%W1DAT("W3ORDHD")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" I $D(%W1DAT("CHANGE")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" Q ; TIME(COD,TM,TXT) ; N HR,MN S HR="",MN="00" I $L(TM) D .I TM[":" S HR=$P(TM,":"),MN=$P(TM,":",2) Q .I TM?1N.N S TM=$P($H,",")_","_TM .S HR=$ZD(TM,"24") .S MN=$ZD(TM,"60") ; N WD S WD=$$WD ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG'="H":$G(TXT)_" ",1:"") I $D(%W1DAT("TDTM")) D .I $L($G(TXT)) D ..W "",$G(TXT),"" .W "",! ; W " ",! W ! ; W " " ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG="H":$G(TXT),1:"") I $D(%W1DAT("TDTM")) W "" K %W1DAT Q ; INPPRM(VL) ; W $$INPPRM1(VL) I $D(%W1DAT("W3ORDHD")) D .W "onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')"" " Q ; ; STDT(COD,TXT,DD,MM,YY,WD) ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"."2N1"."2N N DT S DT=DD D .S MM=$P(DD,".",2) .S YY=$P(DD,".",3) .S DD=$P(DD,".") ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"/"2N1"/"2N N DT S DT=DD D .S MM=$P(DD,"/",2) .S YY=$P(DD,"/",3) .S DD=$P(DD,"/") ; S:'$G(WD) WD=$$WD S:'$D(TXT) TXT="" S:'$D(DD) DD="" S:'$D(MM) MM="" S:'$D(YY) YY="" ; N STDT S STDT="" ; I '$$OLDDAT D G STDTE .N DT S DT=0 I DD S DT=$$^%L1DC(DD_MM_YY,3) .I DD="" D ..S DT=$S($$^W4ELPOS:$$^W4DZ,1:$H) ..N DAT S DAT=$ZD(DT,"DDMMYY") ..S DD=$E(DAT,1,2) ..S MM=$E(DAT,3,4) ..S YY=$E(DAT,5,6) .;;W "NOOLD: DD="_DD_" MM="_MM_" YY="_YY,! ; .D STDTSEL ; ; S STDT=STDT_"" I '$D(%W1DAT("TD")),$L($G(TXT)) D .S STDT=STDT_"" ; D EQ S STDT=STDT_"" D DAY ; ;;D EQ ; S STDT=STDT_"
"_$G(TXT)_"" S STDT=STDT_" " ; S STDT=STDT_" " ; S STDT=STDT_" " S STDT=STDT_"
" ; STDTE ; Q STDT ; ; INPPRM1(VL) ; N A S A=" maxlength=""2"" style=""width:"_WD_";text-align:center" I $$1024^W4WDSCR S A=A_";font-size:"_$$^W3FSZ(10) s A=A_"""" S A=A_" value="""_VL_""" " S A=A_" onClick=""this.select()"" " S A=A_" onKeyUp=""OnDateKeyUp(this,event)"" " I $D(%W1DAT("W3ORDHD")) D .S A=A_"onKeyPress=""OnKeyPress(event)"" " .S A=A_"onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')""" Q A ; STDTRP(COD,TXT,DD,MM,YY,WD) ; Q $$RPL^%L1FRM($$STDT(COD,TXT,DD,MM,YY,WD),"'","\'") ; CHANGE(COD) ; I $L($G(%W1DAT("CHANGE"))) S STDT=STDT_" onChange="""_$TR(%W1DAT("CHANGE"),"""","'")_"""" Q S STDT=STDT_" "_$$CHNDT(COD) Q ; TIMENEW(COD,TM,TXT,PR) ; ; PR '< 1 - MINUTES ;-------------------------- W "",! W "",! I $L($G(TXT)),$$^%W1DIR="LTR" D TMNTXT D .N HR,MN,I .S HR=$P(TM,":",1),MN=$P(TM,":",2) .W "",! . .I $G(PR)'<1 D ..W "",! W "
" .W "",! .W "" ..W "",! ; I $L($G(TXT)),$$^%W1DIR="RTL" D TMNTXT W "
",! Q TMNTXT ; W "" W $$H2U^%L1FRM(TXT) W "" Q ; ONKEYPRESS ; W " onKeyPress=""OnKeyPress(event,this)"" " Q ; WD(STAM) ; Q $$^W4KF(25) ;;I $$^W4TABLET Q 32 Q 25 ; STDTSEL ; N DAT S DAT=$G(DT) I DAT?5N S DAT=$ZD(DAT,"DDMMYY") I DAT="" S DAT=$ZD($H,"DDMMYY") ;;W "STDTSEL.DAT="_DAT_" DD="_DD_" MM="_MM_" YY="_YY,! ; *** ;;S STDT=STDT_"" S STDT=STDT_"
" ; I $G(TXT)'="",'$D(%W1DAT("TD")) D .S STDT=STDT_"" ; D EQ S ^AA("W1DAT","DAT")=DAT S STDT=STDT_" " ; I '$D(%W1DAT("NODAY")) D DAY ;;D EQ S STDT=STDT_"
"_$G(TXT)_" " S STDT=STDT_"" ; S STDT=STDT_"" ; S STDT=STDT_"
" Q ; ; DAY ; N DAY S DAY="" I $G(DT) S DAY=$$^W3DAY(DT) S STDT=STDT_""_DAY_"" Q ; DOP(J) ; Q $TR($J(J,2)," ",0) ; SEL(J,DAT,IND) ;;W "SEL.DAT="_DAT_" J="_J ; *** N DD,MM,YY S DAT=$TR(DAT,"./","") S DD=$E(DAT,1,2) S MM=$E(DAT,3,4) S YY=$E(DAT,5,6) I IND="DD",+J=+DD Q " selected=""selected"" " I IND="MM",+J=+MM Q " selected=""selected"" " I IND="YY",+J=+YY Q " selected=""selected"" " Q "" ; LM(DAT) ; Q $$LMM^%L1DC(DAT) ; OLDDAT(STAM) ; I $$OLDDAT^W4PRM!$G(%ARG("OLDDAT"))!$G(%W1DAT("OLDDAT")) Q 1 Q 0 ; CHNDT(COD) ; N ST S ST="onChange=""OnChangeW1Dat('"_COD_"')"" " Q ST ; EQ ; ;;I $E(COD,1,3)="ADD",'$D(%W1DAT("NOEQ")),$D(%W1DAT("="))!$$DELIS^W4PRM!'$$NOEQDAT^W4PRM D I $E(COD,1,2)="AD"!(COD?1"DAT2".E),'$D(%W1DAT("NOEQ")),$D(%W1DAT("="))!$$DELIS^W4PRM!'$$NOEQDAT^W4PRM D .;;I $$1024^W4WDSCR,'$D(%W1DAT("=")) Q .N MEDAT,ADDAT .S ADDAT=COD .I $E(COD,1,2)="AD" S MEDAT="ME"_$E(COD,3,20) .I $E(COD,1,4)="DAT2" S MEDAT="DAT1"_$E(COD,5,20) .S STDT=STDT_" " .S STDT=STDT_"" Q %W1DAT0 %W1DAT(COD,DT,TXT) ; [ 25.02.20 14:08 ] [ 24.02.20 16:59 ] [ 01.02.19 08:27 ] N WD,DD,MM,YY,DAT S WD=$$WD ; S (DD,MM,YY)="" S DT=$G(DT) S TXT=$G(TXT) ; I $G(DT)="",$$OLDDAT D .S DD="" S MM=$ZD($H,"MM"),YY=$ZD($H,"YY") .N DN S DN=$ZD($H,"DD") I DN<11 S MM="" .I DN<11,+MM=1 S MM="" ; I $G(DT)="",'$$OLDDAT S DT=+$H ; I $G(DT)="-" S (DD,MM,YY)="" ; S DT=$TR(DT,"/",".") ; I $G(DT)?2N1"."2N1"."2N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $G(DT)?2N1"."2N1"."4N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$E($P(DT,".",3),3,4) ; I $G(DT)?1"."2N1"."2N D .S DD="" .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $P($G(DT),",")?5N D .S DD=$ZD(DT,"DD") .S MM=$ZD(DT,"MM") .S YY=$ZD(DT,"YY") ; S DAT=DD_"."_MM_"."_YY ; I $D(%W1DAT("TD")) D .W:$G(TXT)'="" "  "_$G(TXT)_"" ; I DT'?5N S DT=$$^%L1DC(DT,3) I $$^W4TABLET=2 S %W1DAT("CLND")=2 G CLND2 I '$G(%W1DAT("CLND")) G OLD ; ; ; --------- NEW ------- ; W "",! I '$D(%W1DAT("TD")) W $G(TXT)_" " W "",! ; I DT'?5N S DT=$$^%L1DC(DT,3) ; I $G(%W1DAT("CLND"))=1 D .W " " ; CLND2 ; I +$G(%W1DAT("CLND"))=2 D .N DAYS S DAYS=$P(%W1DAT("CLND"),";",2) .N SM S SM=$P(%W1DAT("CLND"),";",3) .I 'DAYS S DAYS=$S($$^W4TABLET:540,1:30),SM=$S($$^W4TABLET:360,1:10) .;;I $$^W4TABLET S SM=360 .W "" ; I $$^W4TABLET=2 G END G ED1 ; ------------ OLD OLD ; ;;W "OLD:COD="_COD_" TXT="_TXT_" DD="_DD_" MM="_MM_" YY="_YY_" WD="_WD,! ; N STDT S STDT=$$STDT(COD,TXT,DD,MM,YY,WD) W STDT ED ; ED1 ; I $P($G(DAT),"."),'$D(%W1DAT("NODAY")),+$G(%W1DAT("CLND"))'=2 D .W "" .W "" .W $$^W3DAY(DAT) ; I $D(%W1DAT("TD")) W "",! ; END ; K %W1DAT Q ; ; ONCHANGE ; I $D(%W1DAT("W3ORDHD")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" I $D(%W1DAT("CHANGE")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" Q ; TIME(COD,TM,TXT) ; N HR,MN S HR="",MN="00" I $L(TM) D .I TM[":" S HR=$P(TM,":"),MN=$P(TM,":",2) Q .I TM?1N.N S TM=$P($H,",")_","_TM .S HR=$ZD(TM,"24") .S MN=$ZD(TM,"60") ; N WD S WD=$$WD ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG'="H":$G(TXT)_" ",1:"") I $D(%W1DAT("TDTM")) D .I $L($G(TXT)) D ..W "",$G(TXT),"" .W "",! ; W " ",! W ! ; W " " ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG="H":$G(TXT),1:"") I $D(%W1DAT("TDTM")) W "" K %W1DAT Q ; INPPRM(VL) ; W $$INPPRM1(VL) I $D(%W1DAT("W3ORDHD")) D .W "onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')"" " Q ; ; STDT(COD,TXT,DD,MM,YY,WD) ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"."2N1"."2N N DT S DT=DD D .S MM=$P(DD,".",2) .S YY=$P(DD,".",3) .S DD=$P(DD,".") ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"/"2N1"/"2N N DT S DT=DD D .S MM=$P(DD,"/",2) .S YY=$P(DD,"/",3) .S DD=$P(DD,"/") ; S:'$G(WD) WD=$$WD S:'$D(TXT) TXT="" S:'$D(DD) DD="" S:'$D(MM) MM="" S:'$D(YY) YY="" ; N STDT S STDT="" I '$D(%W1DAT("TD")) S STDT=STDT_$S($$^%W1LNG="H":"",1:$G(TXT))_" " ; I '$$OLDDAT D G STDTE .N DT S DT=$$^%L1DC(DD_MM_YY,3) .I 'DD D ..S DT=$S($$^W4ELPOS:$$^W4DZ,1:$H) ..N DAT S DAT=$ZD(DT,"DDMMYY") ..S DD=$E(DAT,1,2) ..S MM=$E(DAT,3,4) ..S YY=$E(DAT,5,6) .;;W "NOOLD: DD="_DD_" MM="_MM_" YY="_YY,! ; .D STDTSEL ; ; S STDT=STDT_" " ; S STDT=STDT_" " ; S STDT=STDT_" " ; STDTE ; I '$D(%W1DAT("TD")) S STDT=STDT_$S($$^%W1LNG="H":" "_$G(TXT),1:"") Q STDT ; ; INPPRM1(VL) ; N A S A=" maxlength=""2"" style=""width:"_WD_";text-align:center"" " S A=A_" value="""_VL_""" " S A=A_" onClick=""this.select()"" " S A=A_" onKeyUp=""OnDateKeyUp(this,event)"" " I $D(%W1DAT("W3ORDHD")) D .S A=A_"onKeyPress=""OnKeyPress(event)"" " .S A=A_"onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')""" Q A ; STDTRP(COD,TXT,DD,MM,YY,WD) ; Q $$RPL^%L1FRM($$STDT(COD,TXT,DD,MM,YY,WD),"'","\'") ; CHANGE ; Q:'$D(%W1DAT("CHANGE")) I $L($G(%W1DAT("CHANGE"))) S STDT=STDT_" onChange="""_$TR(%W1DAT("CHANGE"),"""","'")_"""" Q TIMENEW(COD,TM,TXT,PR) ; ; PR '< 1 - MINUTES ;-------------------------- W "",! W "",! I $L($G(TXT)),$$^%W1DIR="LTR" D TMNTXT D .N HR,MN,I .S HR=$P(TM,":",1),MN=$P(TM,":",2) .W "",! . .I $G(PR)'<1 D ..W "",! W "
" .W "",! .W "" ..W "",! ; I $L($G(TXT)),$$^%W1DIR="RTL" D TMNTXT W "
",! Q TMNTXT ; W "" W $$H2U^%L1FRM(TXT) W "" Q ; ONKEYPRESS ; W " onKeyPress=""OnKeyPress(event,this)"" " Q ; WD(STAM) ; I $$^W4TABLET Q 32 Q 25 ; STDTSEL ; N DAT S DAT=$G(DT) I DAT?5N S DAT=$ZD(DAT,"DDMMYY") I 'DAT S DAT=$ZD($H,"DDMMYY") ;;W "DAT="_DAT_" DD="_DD_" MM="_MM_" YY="_YY,! S STDT=STDT_" " ; S STDT=STDT_"" ; S STDT=STDT_" " Q ; DOP(J) ; Q $TR($J(J,2)," ",0) ; SEL(J,DAT,IND) N DD,MM,YY S DAT=$TR(DAT,"./","") S DD=$E(DAT,1,2) S MM=$E(DAT,3,4) S YY=$E(DAT,5,6) I IND="DD",+J=+DD Q " selected=""selected"" " I IND="MM",+J=+MM Q " selected=""selected"" " I IND="YY",+J=+YY Q " selected=""selected"" " Q "" ; LM(DAT) ; Q $$LMM^%L1DC(DAT) ; OLDDAT(STAM) ; I $$OLDDAT^W4PRM!$G(%ARG("OLDDAT")) Q 1 Q 0 %W1DAT1 %W1DAT(COD,DT,TXT) ; [ 26.02.20 10:41 ] [ 25.02.20 17:49 ] [ 24.02.20 16:59 ] N WD,DD,MM,YY,DAT S WD=$$WD ; S (DD,MM,YY)="" S DT=$G(DT) S TXT=$G(TXT) ; I $G(DT)="",$$OLDDAT D .S DD="" S MM=$ZD($H,"MM"),YY=$ZD($H,"YY") .N DN S DN=$ZD($H,"DD") I DN<11 S MM="" .I DN<11,+MM=1 S MM="" ; I $G(DT)="",'$$OLDDAT S DT=+$H ; I $G(DT)="-" S (DD,MM,YY)="" ; S DT=$TR(DT,"/",".") ; I $G(DT)?2N1"."2N1"."2N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $G(DT)?2N1"."2N1"."4N D .S DD=$P(DT,".",1) .S MM=$P(DT,".",2) .S YY=$E($P(DT,".",3),3,4) ; I $G(DT)?1"."2N1"."2N D .S DD="" .S MM=$P(DT,".",2) .S YY=$P(DT,".",3) ; I $P($G(DT),",")?5N D .S DD=$ZD(DT,"DD") .S MM=$ZD(DT,"MM") .S YY=$ZD(DT,"YY") ; S DAT=DD_"."_MM_"."_YY ; I $D(%W1DAT("TD")) D ; -- TEXT .W:$G(TXT)'="" "  "_$G(TXT)_"" ; I DT'?5N S DT=$$^%L1DC(DT,3) ; I $$^W4TABLET=2 S %W1DAT("CLND")=2 G CLND2 I '$G(%W1DAT("CLND")) G INP ; -- !!! ; ; ; --------- CALENDER ------- ; W "",! I '$D(%W1DAT("TD")) W $G(TXT)_" " W "",! ; I DT'?5N S DT=$$^%L1DC(DT,3) ; I $G(%W1DAT("CLND"))=1 D .W " " ; CLND2 ; I +$G(%W1DAT("CLND"))=2 D .N DAYS S DAYS=$P(%W1DAT("CLND"),";",2) .N SM S SM=$P(%W1DAT("CLND"),";",3) .I 'DAYS S DAYS=$S($$^W4TABLET:540,1:30),SM=$S($$^W4TABLET:360,1:10) .W "" ; I $$^W4TABLET=2 G END G ED1 ; ; ------------ INPUT DAT ; INP ; ;;W "INP:COD="_COD_" TXT="_TXT_" DD="_DD_" MM="_MM_" YY="_YY_" WD="_WD,! ; I $D(%W1DAT("TD")) W "" N STDT S STDT=$$STDT(COD,TXT,DD,MM,YY,WD) W STDT ED ; ED1 ; ;;I $P($G(DAT),"."),'$D(%W1DAT("NODAY")),+$G(%W1DAT("CLND"))'=2 D .W "" .W "" .W $$^W3DAY(DAT) ; I $D(%W1DAT("TD")) W "",! ; END ; K %W1DAT Q ; ; ONCHANGE ; I $D(%W1DAT("W3ORDHD")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" I $D(%W1DAT("CHANGE")) W " onChange=""ChangeDat('"_$$GET^%W1PRM("CODE")_"')""" Q ; TIME(COD,TM,TXT) ; N HR,MN S HR="",MN="00" I $L(TM) D .I TM[":" S HR=$P(TM,":"),MN=$P(TM,":",2) Q .I TM?1N.N S TM=$P($H,",")_","_TM .S HR=$ZD(TM,"24") .S MN=$ZD(TM,"60") ; N WD S WD=$$WD ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG'="H":$G(TXT)_" ",1:"") I $D(%W1DAT("TDTM")) D .I $L($G(TXT)) D ..W "",$G(TXT),"" .W "",! ; W " ",! W ! ; W " " ; I '$D(%W1DAT("TDTM")) W $S($$^%W1LNG="H":$G(TXT),1:"") I $D(%W1DAT("TDTM")) W "" K %W1DAT Q ; INPPRM(VL) ; W $$INPPRM1(VL) I $D(%W1DAT("W3ORDHD")) D .W "onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')"" " Q ; ; STDT(COD,TXT,DD,MM,YY,WD) ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"."2N1"."2N N DT S DT=DD D .S MM=$P(DD,".",2) .S YY=$P(DD,".",3) .S DD=$P(DD,".") ; I $G(MM)="",$G(YY)="",$G(DD)?2N1"/"2N1"/"2N N DT S DT=DD D .S MM=$P(DD,"/",2) .S YY=$P(DD,"/",3) .S DD=$P(DD,"/") ; S:'$G(WD) WD=$$WD S:'$D(TXT) TXT="" S:'$D(DD) DD="" S:'$D(MM) MM="" S:'$D(YY) YY="" ; N STDT S STDT="" ; I '$$OLDDAT D G STDTE .N DT S DT=$$^%L1DC(DD_MM_YY,3) .I 'DD D ..S DT=$S($$^W4ELPOS:$$^W4DZ,1:$H) ..N DAT S DAT=$ZD(DT,"DDMMYY") ..S DD=$E(DAT,1,2) ..S MM=$E(DAT,3,4) ..S YY=$E(DAT,5,6) .;;W "NOOLD: DD="_DD_" MM="_MM_" YY="_YY,! ; .D STDTSEL ; ; S STDT=STDT_"" I '$D(%W1DAT("TD")),$L($G(TXT)) D .S STDT=STDT_"" ; S STDT=STDT_"" D DAY S STDT=STDT_"
"_$G(TXT)_"" S STDT=STDT_" " ; S STDT=STDT_" " ; S STDT=STDT_" " S STDT=STDT_"
" ; STDTE ; Q STDT ; ; INPPRM1(VL) ; N A S A=" maxlength=""2"" style=""width:"_WD_";text-align:center"" " S A=A_" value="""_VL_""" " S A=A_" onClick=""this.select()"" " S A=A_" onKeyUp=""OnDateKeyUp(this,event)"" " I $D(%W1DAT("W3ORDHD")) D .S A=A_"onKeyPress=""OnKeyPress(event)"" " .S A=A_"onChange=""CallTfr('"_$$GET^%W1PRM("CODE")_"')""" Q A ; STDTRP(COD,TXT,DD,MM,YY,WD) ; Q $$RPL^%L1FRM($$STDT(COD,TXT,DD,MM,YY,WD),"'","\'") ; CHANGE(COD) ; I $L($G(%W1DAT("CHANGE"))) S STDT=STDT_" onChange="""_$TR(%W1DAT("CHANGE"),"""","'")_"""" Q S STDT=STDT_" "_$$CHNDT(COD) Q ; TIMENEW(COD,TM,TXT,PR) ; ; PR '< 1 - MINUTES ;-------------------------- W "",! W "",! I $L($G(TXT)),$$^%W1DIR="LTR" D TMNTXT D .N HR,MN,I .S HR=$P(TM,":",1),MN=$P(TM,":",2) .W "",! . .I $G(PR)'<1 D ..W "",! W "
" .W "",! .W "" ..W "",! ; I $L($G(TXT)),$$^%W1DIR="RTL" D TMNTXT W "
",! Q TMNTXT ; W "" W $$H2U^%L1FRM(TXT) W "" Q ; ONKEYPRESS ; W " onKeyPress=""OnKeyPress(event,this)"" " Q ; WD(STAM) ; I $$^W4TABLET Q 32 Q 25 ; STDTSEL ; N DAT S DAT=$G(DT) I DAT?5N S DAT=$ZD(DAT,"DDMMYY") I 'DAT S DAT=$ZD($H,"DDMMYY") ;;W "DAT="_DAT_" DD="_DD_" MM="_MM_" YY="_YY,! S STDT=STDT_"" ; I $G(TXT)'="",'$D(%W1DAT("TD")) D .S STDT=STDT_"" ; S STDT=STDT_" " ; I '$D(%W1DAT("NODAY")) D DAY S STDT=STDT_"
"_$G(TXT)_" " S STDT=STDT_"" ; S STDT=STDT_"" ; S STDT=STDT_"
" Q ; ; DAY ; N DAY S DAY="" I $G(DT) S DAY=$$^W3DAY(DT) S STDT=STDT_""_DAY_"" Q ; DOP(J) ; Q $TR($J(J,2)," ",0) ; SEL(J,DAT,IND) N DD,MM,YY S DAT=$TR(DAT,"./","") S DD=$E(DAT,1,2) S MM=$E(DAT,3,4) S YY=$E(DAT,5,6) I IND="DD",+J=+DD Q " selected=""selected"" " I IND="MM",+J=+MM Q " selected=""selected"" " I IND="YY",+J=+YY Q " selected=""selected"" " Q "" ; LM(DAT) ; Q $$LMM^%L1DC(DAT) ; OLDDAT(STAM) ; I $$OLDDAT^W4PRM!$G(%ARG("OLDDAT"))!$G(%W1DAT("OLDDAT")) Q 1 Q 0 ; CHNDT(COD) ; N ST S ST="onChange=""OnChangeW1Dat('"_COD_"')"" " Q ST %W1DECOD %W1DECOD(STR) ; [ 11.03.10 20:03 ] [ N (STR) S I=0 S SOU="" CYC S I=I+1 I I>$L(STR) G END I $E(STR,I)="%" D G CYC .S SMB=$E(STR,I+1,I+2) .I SMB="D7",$E(STR,I+3)="%" D S I=I+5 Q ..S SMB2=$E(STR,I+4,I+5) ..S SOU=SOU_$C($$H2D(SMB2)-48) .S SMBOU=$C($$H2D(SMB)) .I SMBOU="`" S SMBOU="'" .S SOU=SOU_SMBOU .S I=I+2 S SOU=SOU_$E(STR,I) G CYC END Q SOU ; H2D(NMB) ; S NMB=$$FUNC^%UCASE(NMB) N A,B S A=$E(NMB),B=$E(NMB,2) I A?1U S A=9+$A(A)-64 I B?1U S B=9+$A(B)-64 Q A*16+B %W1DICT %W1DICT(KEY,PRM,LNG) ; [ 06.09.26 13:06 ] [ 24.06.26 12:59 ] [ 14.04.26 01:31 ] ;;D PUT^%W3DEB("%W1DICT","KEY=KEY & PRM=PRM") N TXT I $G(KEY)="" Q "" ; S KEY=$$SPA^%L1FRM(KEY) S PRM=$$SPA^%L1FRM($G(PRM)) S LNG=$$SPA^%L1FRM($G(LNG)) ; I $G(KEY)="" Q "" I $G(LNG)="" S LNG=$$^%W1LNG ; I $E(KEY,1,3)="" Q $$H2U^%L1FRM($E(KEY,4,255)) ; I $G(PRM)="",KEY["<>" D .S PRM=$P(KEY,"<>",2,200) .S KEY=$P(KEY,"<>") ; I $G(PRM)="" S PRM=" " ; N HZM S HZM=$$GETP^%W1PRM("HZM") N NMB S NMB=$$GETP^%W1PRM("NMB") ; I KEY="MOVINGITEMSFROMTABLE",$$^W4CP S KEY="COPYITEMSFROMTABLE" ; I KEY="RECEIVER",$$DELIS^W4PRM S KEY="ORDERMGR" ; I KEY="KK",$$PAPJ^W4PRM S KEY="GIFTCARD" ; I $G(NMB),$$^W4MSD(NMB) D .I KEY="CHNDLV" S KEY="CHNSRV" .I KEY="CHNDLVP" S KEY="CHNSRVP" .I KEY="DLVPAYCHANGE" S KEY="SRVPAYCHANGE" .I KEY="DLVPAYPRCCHANGE" S KEY="SRVPAYPRCCHANGE" ; I $$^W4DLVCSR,$$SDMSL^W4PRM,$$SDSAK^W4PRM D .I $G(NMB),$$^W4MSD(NMB) Q .I KEY="SOAD"!(KEY="SD") S KEY="SAKN" Q .I KEY="SOADIM"!(KEY="GUESTS") S KEY="SAKIOT" Q .I KEY="CHANGEGUESTSQN" S KEY="CHANGESAKQN" Q .I KEY="GUESTNUMBERNOTVALID" S KEY="SAKNUMBERNOTVALID" Q .I KEY="GUESTSQN"!(KEY="QNMSD") S KEY="SAKSQN" Q .I KEY="GUESTSTOTAL" S KEY="SAKSTOTAL" Q .I KEY="SSOAD"!(KEY="TOTALGUESTS") S KEY="SSAKS" Q ; I KEY="MYESEK",$G(@$$^W4PL@("ESEK",1))["n""ra" S KEY="MYHP" I KEY="PAYERTEL",$$GETP^%W1PRM("TLDFLT") S KEY="PAYERNMB" ; I $$KUPA^W4PLUK D REST2POS G TX I $$DLV=1 D REST2DLV G TX I $$DLV=.5 D REST2DLV5 G TX I $$TAW D REST2POS ; TX S TXT=$$TV(LNG,KEY,$G(PRM)) ;;S ^AA("%W1DICT","LNG")=LNG ;;S ^AA("%W1DICT","KEY")=KEY ;;S ^AA("%W1DICT","PRM")=$G(PRM) ; I LNG="H" S TXT=$$H2U^%L1FRM(TXT) I LNG="R" S TXT=$$R2U^%L1FRM(TXT) ;;S ^AA("%W1DICT","TXT")=TXT Q TXT ; TV(LNG,KEY,PRM) ; I $G(LNG)=""!($G(KEY)="") Q "" S PRM=$G(PRM) N KBENG S KBENG=0 I LNG="H",$$KBENG,'$$GETP^%W1PRM("W4BO") S LNG="E",KBENG=1 ;;S ^AA("%W1DICT-TV","KEY")=KEY ;;S ^AA("%W1DICT-TV","LNG")=LNG ;;S ^AA("%W1DICT-TV","MAIN")=$$^W3MAIN ;;S ^AA("%W1DICT-TV","GL")=$$^W4GL("W1DICT") ;;S ^AA("%W1DICT-TV","$D")=$D(^[$$^W3MAIN]W1DICT(KEY,LNG)) ; I '$D(^[$$^W3MAIN]W1DICT(KEY,LNG)) Q KEY ; N TXT S TXT=$G(^[$$^W3MAIN]W1DICT(KEY,LNG)) ;;S ^AA("%W1DICT-TV","TXT")=TXT I KBENG S TXT=$$FUNC^%UCASE(TXT) D CHPRM Q TXT ; TVTXT(TXT,PRM) ; S PRM=$G(PRM) D CHPRM Q TXT ; CHPRM ; I TXT["$" D .N PRM1 S PRM1=PRM N PRM S PRM=PRM1_"<><><><><><><><><><><><><>" .N I F I=1:1:$L(PRM,"<>") D ..Q:TXT'[("$"_I) ..N VL S VL=$P(PRM,"<>",I) ..S TXT=$P(TXT,"$"_I)_VL_$P(TXT,"$"_I,2,255) Q ; REST2POS ; ; I $$MTAW^W4MTAW D .I KEY="TABLENUMBER" S KEY="CSRNUMBER" .I KEY="FROMTABLE" S KEY="FROMCSR" .I KEY="UNTILTABLE" S KEY="UNTILCSR" .I KEY="CHOICETABLE" S KEY="CHOICECSR" .I KEY="ERASETABLE" S KEY="ERASECSR" .I KEY="NOTTABLE" S KEY="CSRNOTEXIST" .I KEY="TABLENOTBUSY" S KEY="CSRNOTBUSY" .I KEY="WRONGTABLENUMBER" S KEY="WRONGCSRNUMBER" .I KEY="ERSTBL" S KEY="ERSCSR" .I KEY="TABLEREPORT" S KEY="CSRREPORT" .I KEY="TABLERANGEWRONG" S KEY="CSRRANGEWRONG" .I KEY="SOADIM" S KEY="CUSTOMERSNUMBER" .I KEY="GUESTSQN" S KEY="CUSTOMERSNUMBER" .I KEY="TOTAVMSD" S KEY="TOTAVCSR" .I KEY="AVMSD" S KEY="AVCUST" ; I KEY="CHOICEWAITER" S KEY="CHOICECASHIER" I KEY="ITEMSSALEPERWAITERSREPORT" S KEY="ITEMSSALEPERCASHIERSREPORT" I KEY="ONEWAITERREPORT" S KEY="ONECASHIERREPORT" I KEY="WAITERNAME" S KEY="CASHIERNAME" I KEY="WAITER" S KEY="CASHIER" I KEY="WAITERNUMBER" S KEY="CASHIERNUMBER" I KEY="WAITERSREPORT" S KEY="CASHIERSREPORT" I KEY="WAITERSTABLE" S KEY="CASHIERSTABLE" I KEY="TOREST" S KEY="TOCSR" ; Q ; ; REST2DLV ; I KEY="TABLENUMBER" D .S KEY="CUSTOMNUMBER" I KEY="FROMTABLE" S KEY="FROMCUSTOM" I KEY="UNTILTABLE" S KEY="UNTILCUSTOM" I KEY="CHOICETABLE" S KEY="CHOICECUSTOM" I KEY="TABLEREPORT" S KEY="CUSTOMREPORT" I KEY="TABLERANGEWRONG" S KEY="CUSTOMSRANGEWRONG" ; I KEY="CHOICEWAITER" S KEY="CHOICERECEIVER" I KEY="ITEMSSALEPERWAITERSREPORT" S KEY="ITEMSSALEPERRECEIVERSREPORT" I KEY="ONEWAITERREPORT" S KEY="ONERECEIVERREPORT" I KEY="WAITERNAME" S KEY="RECEIVERNAME" I KEY="WAITER" D .S KEY="RECEIVER" Q I KEY="WAITERNUMBER" D .S KEY="RECEIVERNUMBER" Q ; I KEY="WAITERSREPORT" S KEY="RECEIVERSREPORT" I KEY="WAITERSTABLE" S KEY="RECEIVERSTABLE" ; I KEY="SOADIM" S KEY="CUSTOMERSNUMBER" I KEY="GUESTSQN" S KEY="CUSTOMERSNUMBER" Q DLV(STAM) ; I $$^W4DLVCSR Q 1 I $$^W4DLVCSR="AND" Q .5 Q 0 ; REST2DLV5 ; I KEY="TABLENUMBER" D .S KEY="CUSTOMNUMBERORTABLE" I KEY="WAITER" D .S KEY="WAITERORCOURIER" .I $$TAW S KEY="CASHIERORCOURIER" I KEY="WAITERNUMBER" D .S KEY="WAITERORCOURIERNUMBER" .I $$TAW S KEY="CASHIERORCOURIERNUMBER" I KEY="WAITERNAME" D .S KEY="WAITERORCOURIERNAME" .I $$TAW S KEY="CASHIERORCOURIERNAME" Q ; TAW(STAM) ; I $$POS^W4MTAW!($$^W4MTAW) Q 1 Q 0 ; KBENG(STAM) ; I $$GETP^%W1PRM("KBENG") Q 1 Q +$$KBENG^W4PRM %W1DIR %W1DIR(STAM) ; [ 25.02.20 04:46 ] [ 03.10.08 15:30 ] [ 06.05.07 08:12 ] [ N A S A=$$^%W1LNG I A="H" Q "RTL" Q "LTR" ; DRC(DRC) ; I $G(DRC)="" S DRC=$$%W1DIR Q "direction:"_$$FUNC^%LCASE(DRC) ; STYLE(DRC) ; Q "style='"_$$DRC($G(DRC))_"'" %W1ED %W1ED ; [ 28.07.25 10:45 ] [ 13.06.08 11:35 ] [ 12.09.07 14:39 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C MF X %chista R !!,"FILE :" S %LS=40 D ^%ZMSL Q:%S=""!(%TO="END") S FILE=%S D ED(FILE) Q ; ; ED(FFILE) ; I FFILE'[".m" S FFILE=FFILE_".m" I FFILE'["/" S FFILE=$ZDIR_FFILE N YES,%Q c FFILE o FFILE:(readonly:record=4096:rewind) ;;S $ZT="g REOF" N I,X S I=0 K ^S000($P) f u FFILE r X Q:$ZEOF D .F J1=1:1:$L(X,$C(9)) D ..S X1=$P(X,$C(9),J1) ..F J2=1:1:$L(X1,$C(10)) D ...S X2=$P(X1,$C(10),J2) ...S I=I+1,^S000($P,I)=X2 REOF ; c FFILE N %W1JSP,%TIP S %W1JSP="",%TIP="G" D ^%S2ERG K %Q S %Q("Z")="SAVE" D N^%S1ASK I 'YES G END O FFILE:(WRITE:NEWVERSION:REWIND) U FFILE N I F I=1:1 Q:'$D(^S000($P,I)) W ^(I),! C FFILE END K ^S000($P) Q ; VW(FFILE) ; K ^TMPS111($J) N YES,%Q c FFILE o FFILE:(readonly:record=2048:rewind) S $ZT="g REOFVW" N I,X S I=0 f u FFILE r X S I=I+1,^TMPS111($J,I)=$TR(X,$C(9)," ") REOFVW c FFILE Q %W1EDIT %W1EDIT ; [ 06.08.26 09:47 ] [ 03.05.26 10:43 ] [ 29.04.26 14:40 ] N (JB,%ARG,%REM) I $L($G(%ARG("TXTPROG"))) ZWR %ARG Q ;;G SAVE ; S LABEL="" S PRG=$G(%ARG("PROG")) I PRG["^" S LABEL=$P(PRG,"^"),PRG=$P(PRG,"^",2) S FILE=$$FUNC^%UCASE(PRG) S PROG=FILE I PROG["/" S PROG=$P(FILE,"/",$L(FILE,"/")) I PROG["." S PROG=$P(PROG,".") S PROG=$TR(PROG,"%","_") ; D PUT^%W1PRM("PROG",PROG) ; I FILE'[".m" S FILE=FILE_".m" I FILE'["/" S FILE=$ZDIR_FILE D ED(FILE) Q ; ; ED(FFILE) ; D PUT^%W1PRM("PROGFILE",FFILE) ; N A,ER S A="",ER=0 I '$$EXIST^%L1ZOS(FFILE) G ED1 ; c FFILE o FFILE:(readonly:record=4096:rewind) ; S ER=0 f u FFILE r X Q:$ZEOF D .I X["&" S ER=1 .S A=A_X_$C(10) REOF ; c FFILE ; ED1 ; W "

",! Q .W "

 

",! .W "

PROGRAMM HAS [AMP] SYMBOLS - EDITING FORBIDDEN !

",! ; W "
",! W $$^%W1DICT("SEARCHLABEL")_" :" W $$NBSP^%L1FRM(3) W "" W $$NBSP^%L1FRM(1) W "" W $$NBSP^%L1FRM(10) W $$^%W1DICT("SEARCHLINENUMBER")_" :" W $$NBSP^%L1FRM(3) W "" W $$NBSP^%L1FRM(1) W "" W "
",! ; D CHN ; S A=$$RPL^%L1FRM(A,"&","&") ;;S A=$$RPL^%L1FRM(A,"<","<") ;;S A=$$RPL^%L1FRM(A,">",">") ; W "",! W "

",! W "",! ; DIVBTN ; W "",! W "" W "" W "" W "" W "" W "" W "" W "" W "" W "
" W " " D ^W4BTN("SHOWHEBREW","ShowHebrew()") W "" D ^W4BTN("INVERSTEXT","InversText()") W " " D ^W4SBM W "" D ^W4BCK W "
",! W "",! Q ; ; SAVE ; N FILE,TX,I S TX=$$CNWEB^%L1FRM(%ARG("TXTPROG")) S FILE=$$GETP^%W1PRM("PROGFILE") I FILE="" G END ; O FILE:(WRITE:NEWVERSION:REWIND) U FILE F I=1:1:$L(TX,"$10$") D .S T=$P(TX,"$10$",I) .S T=$TR(T,$C(13,10,27,8,9),"") .S T=$$CNWEB^%L1FRM(T) .W T,! C FILE ; W "",! END Q %W1EDJS %W1EDJS ; [ 03.05.26 10:44 ] [ 21.04.26 11:29 ] [ 15.04.26 20:12 ] N (JB,%ARG,%REM) I $L($G(%ARG("TXTPROG"))) ZWR %ARG Q ;;G SAVE ; S FILE=$$FUNC^%LCASE($G(%ARG("PROG"))) S PROG=FILE I PROG["/" S PROG=$P(FILE,"/",$L(FILE,"/")) I PROG["." S PROG=$P(PROG,".") S PROG=$TR(PROG,"%","_") ; D PUT^%W1PRM("PROG",PROG) ; I FILE'["." S FILE=FILE_".jsp" N PATH S PATH=$$PATHJSP^%L1WEBJS I $E(PATH,$L(PATH))'="/" S PATH=PATH_"/" I FILE'["/" S FILE=PATH_FILE D ED(FILE) Q ; ; ED(FFILE) ; D PUT^%W1PRM("PROGFILE",FFILE) ; N A,ER S A="",ER=0 I '$$EXIST^%L1ZOS(FFILE) G ED1 ; c FFILE o FFILE:(readonly:record=4096:rewind) ; f u FFILE r X Q:$ZEOF D .I X["&" S ER=1 .S A=A_X_$C(10) REOF ; c FFILE ; ED1 ; W "
",! ; I ER D W "
",! Q .W "

 

",! .W "

PROGRAMM HAS [AMP] SYMBOLS - EDITING FORBIDDEN !

",! ; D CHN ; S A=$$RPL^%L1FRM(A,"&","&") ; W "",! W "

",! W "",! ; DIVBTN ; D DIVBTN^%W1EDIT Q ; ; PREP(SCR) ; N %PR,%MAC1,%MAC2,%ORD,FLAG,%PR,VRM N MAC S MAC=$$^W4GL("SCR")_"("""_SCR_""")" ; S VRM=$$^W4MAIN("VRM") K @VRM N I F I=1:1 Q:'$D(@MAC@(I)) D .S @VRM@(I)=$$H2U^%L1FRM($G(@MAC@(I))) Q ; ; VRM ; S VRM=$$^W4MAIN("VRM") Q ; ; SCR(SCR) S SCR=$$RPL^%L1FRM(SCR,"$28","(") S SCR=$$RPL^%L1FRM(SCR,"$29",")") S SCR=$$RPL^%L1FRM(SCR,"$22","""") S SCR=$$RPL^%L1FRM(SCR,"$2B","+") S SCR=$$RPL^%L1FRM(SCR,"0g","") Q SCR ; ; GETSCR(STAM) N A S A=$$GETP^%W1PRM("SCR") Q A %W1SV %W1SV(%MC,%PRM) ; [ 22.12.13 13:44 ] [ N %I,%FLD,%RG,%VL,%A,%A1,%J,%SMB F %I=1:1:$L(%MC,"~") D .S %FLD=$P(%MC,"~",%I) .S %RG=$P(%FLD,"!",2),%FLD=$P(%FLD,"!") .S %VL=$TR($P(%PRM,"~",%I),$C(160)_"?","") .S %VL=$$CLEAR^%L1FRM(%VL) .S %VL=$$CNWEB^%L1FRM(%VL) .I %RG="H"&($$^%W1DIR="RTL") S %VL=$$INVH^%L1FRM(%VL) .S %A=$$SPA^%L1FRM(%VL) .S %A1="" F %J=1:1:$L(%A) D ..S %SMB=$E(%A,%J) ..I $A(%SMB)<32!($A(%SMB)>122) Q ..S %A1=%A1_%SMB .S @%FLD=%A1 Q %W1SsID %W1SsID(%PKG) ; [ 19.04.16 06:25 ] [ 04.10.15 17:36 ] [ 09.01.13 19:01 ] N GLD S GLD=$$^%L1GLD L +^[GLD]W1SsID:2 CYC N SSID S SSID=$O(^[GLD]W1SsID(999999999999),-1) I SSID<20 S SSID=20 S SSID=SSID+$R(10)+1 I $D(^[GLD]W1SsID(SSID)) G CYC S ^[GLD]W1SsID=SSID S ^[GLD]W1SsID1=SSID S ^[GLD]W1SsID(SSID)=$G(%REM)_"*"_$G(%SSUSER)_"*"_$G(%PKG)_"*"_$H_"*"_$J L -^[GLD]W1SsID S %ARG("JB")=SSID Q SSID %W1SsID0 %W1SsID(%PKG) ; [ 17.07.12 15:45 ] [ 22.06.10 12:54 ] [ 09.04.07 13:07 ] [ N GLD S GLD=$$^%L1GLD L +^[GLD]W1SsID:2 L +^[GLD]W1SsID1:2 N SSID S SSID=$G(^[GLD]W1SsID,1000)+1 I SSID'>$G(^[GLD]W1SsID1) S SSID=$G(^[GLD]W1SsID1)+1 S ^[GLD]W1SsID=SSID S ^[GLD]W1SsID1=SSID S ^[GLD]W1SsID(SSID)=$G(%REM)_"*"_$G(%SSUSER)_"*"_$G(%PKG)_"*"_$H_"*"_$J L -^[GLD]W1SsID L -^[GLD]W1SsID1 Q SSID %W1TBLSL %W1TBLSL ; [ 04.05.07 18:05 ] [ W "function CellSel(IDC,SEL)",! W " {",! W " var i,sel",! W " sel=""""",! W " for (i=2;i<=LenDlm(SEL,""~"");i++)",! W " { sel=sel+"""" }",! W " document.getElementById(IDC).innerHTML=" W "''",! W " }",! W "function SetCellSel()",! W " {",! W " var x=document.getElementById(""SelMenu"")",! W " var y=document.getElementById(""td1"")",! W " y.innerHTML=x.options[x.selectedIndex].text",! W " }",! Q %W1TXTJS %W1TXTJS(TXT) ; [ 24.06.07 20:02 ] [ 22.06.07 17:26 ] [ 09.06.07 13:49 ] I $$^%W1LNG="E" Q TXT I $$^%W1LNG="H" N TXTH D Q TXTH .S TXTH="" .S TXTH=$$H2U^%L1FRM(TXT) .S TXTH=$$D2H(TXTH) Q "" D2H(TXTH) ; S TXTH=$TR(TXTH,"&#;","\u") Q $$D2H1(TXTH) D2H1(TXTH) ; N PZ S PZ=0 F S PZ=$F(TXTH,"\u",PZ) Q:'PZ D .S PZ1=$F(TXTH,"\u",PZ) .I 'PZ1 S PZ1=$L(TXTH)+3 .S $E(TXTH,PZ,PZ1-3)=$TR($J($$^%L1ZH($E(TXTH,PZ,PZ1-3)),4)," ",0) Q TXTH %W1U2H %W1U2H(TXT) ; [ 04.12.07 07:45 ] [ 13.10.07 12:15 ] [ 02.10.07 19:13 ] N I,I1,OU,HB,W,W1,PRHB S HB=0 F I=1:1:$L(TXT) I $$HB($E(TXT,I)) S HB=1 Q I 'HB Q TXT ; S OU="",PRHB="",I=1 CYC S I1=I I $$HB($E(TXT,I)) D .S W="" .F I1=I:1:$L(TXT)+1 Q:$E(TXT,I1)?.P&'$$HB($E(TXT,I1)) D ..S W=$E(TXT,I1)_W .S OU=OU_W .I $E(TXT,I1)?.P,"{[(<>)]}"'[$E(TXT,I1) S OU=OU_$E(TXT,I1),I1=I1+1 ; I I1=($L(TXT)+1) G END S I=I1 I $E(TXT,I)=" " S OU=OU_" ",I=I+1 G CYC ; I '$$HB($E(TXT,I)),")]}"[$E(TXT,I),$$PRHB(I) D G:I<1 END G CYC .S OU=OU_$$SCB($E(TXT,I)),I=I+1 ; I '$$HB($E(TXT,I)),")]}"[$E(TXT,I),'$$PRHB(I) D G:I<1 END G CYC .N W S W="" .N SK S SK(")")="(" .S SK("]")="[" .S SK("}")="{" .F I1=I:1:$L(TXT) Q:$E(TXT,I1)=SK($E(TXT,I)) S W=$E(TXT,I1)_W .S W=W_$E(TXT,I1),I=I1+1 .S OU=OU_W,PRHB=0 ; ; I '$$HB($E(TXT,I)),"([{"[$E(TXT,I) D G CYC .S OU=OU_$$SCB($E(TXT,I)),I=I+1 ; S PREN=0,W1="" I '$$HB($E(TXT,I)) D MET .I $E(TXT,I)=">",$E(TXT,I+1)="E",$E(TXT,I+2)="<" D S OU=OU_W1 Q ..S W1="",I=I+3 ..F I1=I:1:$L(TXT)+1 Q:$E(TXT,I1)=">"&($E(TXT,I1+1)="E")&($E(TXT,I1+2)="<") D ...S W1=W1_$E(TXT,I1) ..I I1>2 S W1=""_W1,I1=I1+3 Q . .S W="",PREN=0 .F I1=I:1:$L(TXT)+1 Q:$E(TXT,I1)=" " Q:$$HB($E(TXT,I1)) Q:$E(TXT,I1)=">"&($E(TXT,I1+1)="E")&($E(TXT,I1+2)="<") D ..S W=W_$E(TXT,I1) .S OU=OU_W .I $E(TXT,I1)=">",$E(TXT,I1+1)="E",$E(TXT,I1+2)="<" S I=I1 G MET .I I1'>$L(TXT),$E(TXT,I1)?.P,$E(TXT,I1)'="" S OU=OU_$$SCB($E(TXT,I1)),I1=I1+1 I I1'>$L(TXT) S I=I1 G CYC END Q OU ; HB(SMB) ; I $A(SMB)<96 Q 0 I $A(SMB)>122 Q 0 Q 1 SCB(SMB) ; I SMB="(" Q ")" I SMB=")" Q "(" I SMB="[" Q "]" I SMB="]" Q "[" I SMB="{" Q "}" I SMB="}" Q "{" I SMB="<" Q ">" I SMB=">" Q "<" Q SMB PRHB(I) ; N PRHB S PRHB=0 N J I $E(TXT,I)="" Q 0 N SK S SK(")")="(" S SK("]")="[" S SK("}")="{" S SK(">")="<" I '$D(SK($E(TXT,I))) Q 0 F J=I+1:1:$L(TXT) Q:$E(TXT,J)=SK($E(TXT,I)) D Q:PRHB .I $$HB($E(TXT,J)) S PRHB=1 Q PRHB %W1UCI %W1UCI(JB) ; [ 24.03.20 08:58 ] [ 14.09.17 11:28 ] [ 02.02.11 06:57 ] N MSD ; S MSD=$G(%ARG("MSD")) I 'MSD S MSD=+$G(^[$$^W3MAIN]W3LINK(+JB)) I 'MSD S MSD=$$GETP^%W1PRM("MSD") I 'MSD Q $$^W3MAIN Q $$TV(MSD) ; TV(MSD) ; I '$D(^[$$^W3MAIN]UCI(MSD)) Q $$^W3MAIN Q ^[$$^W3MAIN]UCI(MSD) %W1VLDDT %W1VLDDT ; [ 22.06.07 09:53 ] [ 12.06.07 12:12 ] [ W "function VldDD(DID)",! W " {",! W " var dd=document.getElementById(DID)",! W " if ( dd.value>31 ) {",! ;W " dd.value="""";",! W " dd.select();",! W " }",! W " }",! W "function VldMM(MID)",! W " {",! W " var mm=document.getElementById(MID)",! W " if (mm.value>12 ) {",! ;W " mm.value="""";",! W " mm.select();",! W " }",! W " }",! W "function VldYY(YY)",! W " {",! W " }",! Q %W1WEBM0 %W1WEBMN(MENU) ; [ 24.06.23 05:35 ] [ 23.06.23 05:51 ] [ 11.06.23 19:00 ] N (MENU,JB,%ARG,%REM) I $G(MENU)="" Q ;;W "%REM="_%REM,! ;;W "POS="_$$POS^W4MTAW,! N I,N,MN,IM,A S NOMENUCOUNT=0 I $$GET^%W1PRM("NOMENUCOUNT") S NOMENUCOUNT=1 ; S ZERO=0 I $O(^[$$^W3MAIN]W4OPT(MENU,""))=0 S ZERO=1 ; I MENU="LKH",$$GETP^%W1PRM("MSD")=7001,$G(%REM) D .S @$$^W4GL("ISHUR")@(%REM,+$H)=1 ; D PREPMENU(MENU) ; D WMN(.MN,.MA,MENU,"",.MA0) Q ; WMN(MN,MA,MENU,NODICT,MA0) ; I $G(%ARG("PRSNLPROC"))'="" D Q .N PROC S PROC=%ARG("PRSNLPROC") .W "
",! .W "

",! .W "

"_$$^%W1DICT("WAIT")_"

",! .W "",! .W "
",! ;;D NOSELECT^%W1JS W "",! N CUR S CUR=0 S ZERO=+$G(ZERO) I $L($G(MENU)) S CUR=$G(@$$^W4MAIN("TMPCURMENU")@(MENU)) N MN1,MA1 M MN1=MN N I,CLSMN,HREF,IM S IM=$O(MN(999),-1) ; D SCRIPT(MENU) ; W "
",! D SRV W "",! W "" W "" W "",! W "

",! ; W "",! Q ; ALL(STAM) ; I $G(%ARG("OPENMENU"))="ALL" Q 1 Q 0 ; BACK2MAIN(STAM) ; ;;I $G(%ARG("BO1")) Q 0 ;;I $$GETP^%W1PRM("BO1") Q 0 I $$GETP^%W1PRM("W4BO") Q 1 I $G(%ARG("BACK2MAIN")) Q 1 ;;I $$GETP^%W1PRM("BACK2MAIN") Q 1 Q 0 ; CLOSE(STAM) ; I $G(%ARG("BO1")) Q 1 I $$GETP^%W1PRM("BO1") Q 1 Q 0 ; CSCARDS ; W "" ; W "" ; W "" Q ; ; BOCARDS ; ; I '$$PRTNET^W4PRM D .W "" .W "" ; D .W "",! .W "" ; W "" ; I $$MENU^W4PRSMNU D .N IND S IND=$O(@$$GL^W4PRSMNU@(0)) Q:'IND .W "" ; Q ; ; SHOWORD ; I $$PRSNL D Q .W ""_$$^%W1DICT("CREATEPRSNLAREA")_"",! ; W "
" I MENU="BO",$$^W4TABLET'=2 D .I $$NOCHKPSW^W4CHKPSW(3)!$$US23^W4LVL!($$BO^W4LVL=3) D SIDEMENU("SIDE") Q .D SIDEMENU("SIDE1") Q W "" D BODYMENU(MENU) W "" W "" W " " W "" W "" . W "" .W " " .W "" .W " " W "" W "" . W "" .W "
",! W "" W "" W "" W "" W "",! W "
" W $$^%W1DICT("ORDERNUMBER")_" " W "" W "",! W "" W "" W "
",! Q ; FIND ; I $$^W4TABLET Q W $$^%W1DICT("SEARCH")_" " W " " W """ onClick=""FindTxt('findtxt',false)"" style=""text-align:center;width:"_$S($$1024^W4WDSCR:25,1:25)_"px;height:"_$S($$1024^W4WDSCR:25,1:25)_"px;background-color:lightgree;padding:3px"" />" W " " W "" I $G(MENU)="BO",'$$PRSNL D .W " " .W "" Q ; PRSNLSET(STAM) ; Q $$GETP^%W1PRM("PRSNLSET") ; ; SETPERS(PRM) ; N (JB,%ARG,%REM,PRM) S FL=$P(PRM,";",1) S NM=$P(PRM,";",2) S PROC=$P(PRM,";",3) S PROC=$$RPL^%L1FRM(PROC,"'","\'") S ACT=$P(PRM,";",4) ; S GL=$$GL^W4PRSMNU ; S ACT=1 I $$PRSNLFIND(NM) S ACT=0 ; I ACT D .S LAST=$O(@GL@(9999),-1)+1 .I LAST=1 D ..S @GL@(0)="EXIT;w4prsmnu.jsp;Back();" . .S @GL@(LAST)=NM_";"_FL_";"_PROC ; I 'ACT D .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S A=$G(^(N)) ..I $P(A,";")=NM,$P(A,";",2)=FL,$P(A,";",3)=PROC K ^(N) Q ; ISPERS(NM,PROC) ; N OK S OK=0 N A,N S N="" F S N=$O(@$$GL^W4PRSMNU@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .S NMMN=$P(A,";") .S PROCMN=$P(A,";",3) .I NM=NMMN,PROC=PROCMN S OK=1 Q OK ; PRSNL(STAM) ; N MN S MN=$$GETP^%W1PRM("CURMENU") I $E(MN,1,7)="FINDALL" Q 0 I $$PRSNLSET!$$GETP^%W1PRM("PRSNLMENU") Q 1 Q 0 ; SRV ; W "" W "" N WD1 S WD1=15 I $$1024^W4WDSCR S WD1=22 N WD2 S WD2=35 I $$1024^W4WDSCR S WD2=50 N WD3 S WD3=20 I $$1024^W4WDSCR S WD3=10 I $$^W4TABLET=2 S WD3=5 ; W "" .I '$$PRSNL W " " Q .D ^W4BUTTON("showprsmnu","SHOWPRSNLAREA","ShowPrsnlArea()") ; W "" W "",! W "
" D SHOWORD W "" W " " W "" D FIND W "" W "" D W "" ;;W "Session "_JB_" [ "_$$^W4MYDVN_" ]",! W "JB "_JB_" [ "_$$^W4MYDVN_" ]",! W $$NBSP^%L1FRM(3) W ""_$ZD($H,"24:60")_"" W "
",! Q ; PREPMENU(MENU) ; N (JB,MENU,MA,MA0,MN) S N="",I=0 F S N=$O(^[$$^W3MAIN]W4OPT(MENU,N)) Q:N="" D .S A=$G(^(N)) .S US=$P(A,";") X "I "_US I D ..S RKV=$P(A,";",2) ..S PROC=$P(A,";",3) ..S I=I+1,MN(I)=RKV,MA0(I)=PROC,MA(I)=PROC ..I N D ; I $$PSWDRG^W4PRM D ...N LVL S LVL=$G(^[$$^W3MAIN]W4OPT(MENU,N,"PSWLVL")) Q:LVL<2 ...I LVL<4,$$US23^W4LVL Q ...I LVL<4,$$^W4LVL("BO","EXIT")>2 Q ...S MA(I)="PswLvl('"_LVL_"','"_PROC_"')" Q ; BODYMENU(MENU) ; I $$PRSNL,$$SIDE Q S CLSMN=$S($$^%W1DIR="RTL":"menuh",1:"menu") N WDT S WDT=70 ;;I $$SIDE S WDT=70 W "",! ; N I1,K S I1=0,K=0 N OPMN S OPMN=$G(%ARG("OPENMENU")) ; N ONCLICK,ONCLICKDIR,CURSORDIR ; F I=1:1:IM D .S PRARR=0 .S MN1(I)=$$SPA^%L1FRM(MN1(I)) . .I $E(MN1(I),$L(MN1(I)))=">" D ..S PRARR=1 ..S MN1(I)=$E(MN1(I),1,$L(MN1(I))-1) . .N JSP,PRM S JSP=$P(MA(I),"?") .S HREF="",ONCLICK="" . .I MENU="TELMENU" S JSP=$$RPL^%L1FRM(JSP,"\'","'") . .I $$FUNC^%LCASE(MA(I))[".jsp" D ..S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_IND_"')",1:"")_";self.location.replace(unescape('"_MA(I)_"'))""" . .I ONCLICK="" S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_I1_"');",1:"")_JSP_"""" . .I $$PRSNLSET,'$G(PRARR),$G(MA(I))'="Back()",$G(MA(I))'="Exit()" S ONCLICK="" . .I MN1(I)["~" S K=K+1 . .S CURSORDIR="" .I $L(OPMN),OPMN'="ALL",OPMN'=K D ..S CURSORDIR=";cursor:pointer" . .S ONCLICKDIR="" .I $L(OPMN),OPMN'=K D ..S ONCLICKDIR=" onClick=""OnClickDirMenu('"_K_"')"" " . .I MN1(I)["~" D Q ..W "" ..W "" ..W "",! . .I $L(OPMN),OPMN'="ALL",OPMN'=K,I1>0 Q . .I 'ZERO S I1=I1+1 . .I I1=(1-ZERO),'$$SIDE D S:ZERO I1=I1+1 Q ; --- BACK ..Q:$G(%ARG("NOBACK")) ..W "" ..W "" ..W "",! . . .W "" . . W "" . . W "" . .W "" .W "",! .I ZERO S I1=I1+1 W "
" ..W "

"_$$^%W1DICT($TR(MN1(I),"~>",""))_"

" ..N STYLE S STYLE=" style=""background-color:white;color:brown;text-align:center;cursor:pointer;border:ridge 1px brown;" .. W "" N WDP S WDP=0 .. I $L(OPMN) S WDP=6+WDP D ... W " ",! .. .. I $$BACK2MAIN S WDP=WDP+6 .. .. I $$^W4LKH S WDP=WDP+30 .. .. W " ",! .. .. I $$^W4TABLET=2 W "" .. .. I $$^W4LKH D CSCARDS .. .. I $$GETP^%W1PRM("W4BO"),'$$GETP^%W1PRM("SUPPL"),'$$PRSNL,'$$SIDE D BOCARDS .. .. I $$BACK2MAIN,'$$PRSNL,'$$SIDE D ... W " ",! .. W "
"_$S($$ALL:"-",1:"+")_"" .. I $G(NODICT) S MN1=$$H2U^%L1FRM(MN1(I)) .. E S MN1=$$^%W1DICT(MN1(I)) .. W MN1 .. W "  ^ 
",! ..W "
" . I PRARR W "" . I 'PRARR,$$PRSNLSET D .. W "" . W "" . I '$G(NOMENUCOUNT) W I1_"." .W "1 D .. W " onMouseOver=""OnMouseOverMenu(this)"" " .. W " onMouseOut=""OnMouseOutMenu(this)"" " . I $G(NODICT) S MN1=$$H2U^%L1FRM(MN1(I)) . E S MN1=$$^%W1DICT(MN1(I)) . W ONCLICK_" >"_MN1_"
",! Q ; SIDEMENU(SIDE) ; N (JB,SIDE) S ZERO=1,CUR=0,NOMENUCOUNT=1 S %ARG("SIDE")=1 D PREPMENU(SIDE) S IM=$O(MN(999),-1) M MN1=MN D BODYMENU(SIDE) Q ; SIDE(STAM) ; Q $G(%ARG("SIDE")) ; SCRIPT(MENU) ; W "",! Q ; ; PRSNLFIND(NM) ; N GL S GL=$$GL^W4PRSMNU N OK,A S OK=0 N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .I $P(A,";")=NM S OK=1 Q OK ; ; PREPFINDALL(SRC) ; N (JB,%ARG,SRC) S SRC=$$CNWEB^%L1FRM(SRC) I $G(SRC)?.P Q 0 S PATH=^W3MAIN("WEBL") ; N TMPFA D TMPFA I '$D(@TMPFA) D .S HIP="" .S FL=$ZSEARCH(HIP) .S HIP=PATH_"w*.jsp" CYCFA .F S FL=$ZSEARCH(HIP) Q:FL="" D CRTMPFA(FL) ; S SRC=$$INVH^%L1FRM(SRC) ;;S ^AA("FINDALL","SRC")=SRC N MENU S MENU="FINDALL"_JB ;;S ^AA("FINDALL","MENU")=MENU D PUT^%W1PRM("CURMENU",MENU) K @$$^W4GL("W4PRSMNU")@(MENU) ; N A,US S N0="",I=0 F S N0=$O(^[$$^W3MAIN]W4OPT(N0)) Q:N0="" D .I '$$ELPOS(N0) Q .S N=0 F S N=$O(^[$$^W3MAIN]W4OPT(N0,N)) Q:N="" D ..S A=$G(^(N)) ..S US=$P(A,";") X "I "_US I D ...S RKV=$P(A,";",2) ...I RKV[">" S RKV=$P(RKV,">") ...N RKV1 S RKV1=$$TV^%W1DICT($$^%W1LNG,RKV) ...I '$$SRCH(RKV1,SRC) Q ...S PROC=$P(A,";",3) ...;;S ^AA("FINDALL",N0,N,"A")=A ...;;S ^AA("FINDALL",N0,N,"PROC")=PROC ...N JSP S JSP=$$JSP(N0,PROC) Q:JSP="" ...;;S ^AA("FINDALL",N0,N,"JSP")=JSP ...S I=I+1 D ....M @$$^W4GL("W4PRSMNU")@(MENU,I)=^[$$^W3MAIN]W4OPT(N0,N) ....N A1 S A1=$G(^[$$^W3MAIN]W4OPT(N0,N)) ....;;S ^AA("FINDALL",N0,N,"A1")=A ....N PROC S PROC=$P(A1,";",3) ....N NM,PRARR S NM=$P(A,";",2),PRARR=0 I NM[">" S NM=$P(NM,">"),PRARR=1 ....S @$$^W4GL("W4PRSMNU")@(MENU,I)=NM_";"_JSP_";"_PROC_";"_PRARR ; S @$$^W4GL("^W4PRSMNU")@(MENU,0)="EXIT;w4prsmnu.jsp;Back();" S @$$^W4GL("^W4PRSMNU")@(MENU)=SRC Q 1 ; ; JSP(MN,PROC) ; N TMPFA D TMPFA ; I PROC["(" S PROC=$P(PROC,"(") I $G(@TMPFA@(MN_"~"_PROC))'="" Q @TMPFA@(MN_"~"_PROC) Q "" ; ; CRTMPFA(FL) ; N TMPFA D TMPFA N M,MN,A ; N FLN S FLN=$P(FL,"/",$L(FL,"/")) Q:FLN="" Q:FLN'[".jsp" N FLN0 S FLN0=$P(FLN,".") I $E(FLN0,$L(FLN0))="0" Q O FL:(REWIND:READONLY) ; F U FL R A Q:$ZEOF D .S A=$$SPA^%L1FRM(A) .I A?1"function ".E D ..S FUNC=$P(A,"function ",2) ..I FUNC'["()" Q ..I FUNC["OnLoad(" Q ..I FUNC["OnUnload(" Q ..S FUNC=$P(FUNC,"(") ..I FUNC'="" S M(FUNC)="" .I A["D ^%W1WEBMN(" D ..S MN=$P(A,"D ^%W1WEBMN(",2) ..S MN=$P(MN,")") ..; ..I $E(MN)="""" S MN=$P(MN,"""",2) ..I $$GETP^%W1PRM("ELPOS"),'$$ELPOS(MN) Q ..Q:MN="" ..N FN S FN="" F S FN=$O(M(FN)) Q:FN="" D ...S @TMPFA@(MN_"~"_FN)=FLN C FL Q ; ; TMPFA ; S TMPFA=$$^W4MAIN("TMPFA") Q ; ELPOS(MN) ; I MN="ASHRAM"!(MN="ASHRSRV")!(MN="BO1")!(MN="LKH")!(MN="REPNET")!(MN="SIDE")!(MN="LKHSYS") Q 0 Q 1 ; SRCH(RKV1,SRC) ; S RKV1=$$SPA^%L1FRM(RKV1) S SRC=$$SPA^%L1FRM(SRC) I RKV1[" " S RKV1=$$SP1^%L1FRM(RKV1) I SRC[" " S SRC=$$SP1^%L1FRM(SRC) I SRC'[" ",RKV1[SRC Q 1 N OK S OK=1 N J F J=1:1:$L(SRC," ") D Q:'OK .I RKV1'[$P(SRC," ",J) S OK=0 Q OK ; ; RESETPOS ; W "function ResetPos()",! W "{",! W " self.getSelection().empty()",! ;W "var a=true",! ;W "while ( a )",! ;W "{ a= self.find("" "",false,true) }",! W "FindTxt('findtxt',false)",! W "}",!! Q ; FINDTXT ; W "function FindTxt(txtid,back,win)",! W "{",! W "if ( typeof win == 'undefined' ) win=self;",! W "if ( typeof back == 'undefined' ) back=false;",! W "var txt=GetVl(txtid);",! W "if ( txt == """" ) return;",! ;;W "var proc='FindTxt(""'+txtid+'"",'+back+')';",! ;;W "alert('txt='+txt+' txtid='+txtid+' proc='+proc)",! ;;W "if ( endres == '0' ) { setTimeout(proc,200); return }",! W "win.find(txt,false,back);",! W "}",!! Q %W1WEBMN %W1WEBMN(MENU) ; [ 09.09.26 10:55 ] [ 05.08.26 13:55 ] [ 19.04.26 12:19 ] N (MENU,JB,%ARG,%REM) ; I $$NEWMENU^W4PRM,'$$PRSNLSET D Q .D ^%W2WEBMN($G(MENU)) ; I $G(MENU)="" Q ;;W "%REM="_%REM,! ;;W "POS="_$$POS^W4MTAW,! ; S MENU=$P(MENU,"^") S FSZ=$$FSZ ; N I,N,MN,IM,A S NOMENUCOUNT=0 I $$GET^%W1PRM("NOMENUCOUNT") S NOMENUCOUNT=1 ; S ZERO=0 I $O(^[$$^W3MAIN]W4OPT(MENU,""))=0 S ZERO=1 ; I $G(%ARG("HDOPT")) D PUT^%W1PRM("HDOPT",1) ; I MENU="LKH",$$GETP^%W1PRM("MSD")=7001,$G(%REM) D .S @$$^W4GL("ISHUR")@(%REM,+$H)=1 ; D PREPMENU(MENU) ; D WMN(.MN,.MA,MENU,"",.MA0) Q ; ; WMN(MN,MA,MENU,NODICT,MA0) ; I $G(%ARG("PRSNLPROC"))'="" D Q .N PROC S PROC=%ARG("PRSNLPROC") .W "
",! .W "

",! .W "

"_$$^%W1DICT("WAIT")_"

",! .W "",! .W "
",! ; W "",! N CUR S CUR=0 S ZERO=+$G(ZERO) I $L($G(MENU)) S CUR=$G(@$$^W4MAIN("TMPCURMENU")@(MENU)) N MN1,MA1 M MN1=MN N I,CLSMN,HREF,IM S IM=$O(MN(999),-1) ; D SCRIPT(MENU) ; W "
",! D SRV W "",! W "" N SIDEPRSN S SIDEPRSN=0 I $$^W4TABLET'=2 D .W "" ; I SIDEPRSN D .W "" W "",! W "
" .I '$$PRSNLSET D ..N MN,DARGA S MN=$$GETP^%W1PRM("MNL") S DARGA="" ..I MN D ...D PUT^%W1PRM("CURMENU",MN) ...S DARGA=+$G(@$$^W4GL("W4PSWDRG")@(MN)) ..I $$VIP S DARGA=4 ..N LVL S LVL=$G(@$$^W4GL("W4OPT")@("BO",8,"PSWLVL")) ; -- REPORTS & QUERIES ..;;S ^AA("W4BO","DARGA")=DARGA ..Q:'$$^W4ELPOS ..I DARGA,DARGA" ; I MENU="BO",$$^W4TABLET'=2,$$MENU^W4PRSMNU,'$$PRSNLSET S SIDEPRSN=1 ; W "" D BODYMENU(MENU) W "" . D SIDEPRSN .W "
",! W "
",! W "

",! ; W "",! Q ; ; ALL(STAM) ; I $G(%ARG("OPENMENU"))="ALL" Q 1 Q 0 ; BACK2MAIN(STAM) ; ;;I $G(%ARG("BO1")) Q 0 ;;I $$GETP^%W1PRM("BO1") Q 0 I $$GETP^%W1PRM("W4BO") Q 1 I $G(%ARG("BACK2MAIN")) Q 1 ;;I $$GETP^%W1PRM("BACK2MAIN") Q 1 Q 0 ; CLOSE(STAM) ; I $G(%ARG("BO1")) Q 1 I $$GETP^%W1PRM("BO1") Q 1 Q 0 ; CSCARDS ; W "" W "" W "" ; W " " ; W "" W "" W "" Q ; ; BOCARDS ; ; I '$$PRTNET^W4PRM D .W "" . W "" .W "" .W " " ; D .W "" .W "" .W "",! .W " " ; W "" W "" W "" ; I $$MENU^W4PRSMNU D .N IND S IND=$O(@$$GL^W4PRSMNU@(0)) Q:'IND .W "" . W "" .W "" ; Q ; ; SHOWORD ; I $$PRSNL D Q .W ""_$$^%W1DICT("CREATEPRSNLAREA")_"",! ; W "",! W "" W "" W "" W "" W "",! W "
" W $$^%W1DICT("ORDERNUMBER")_" " W "" W "",! W "" W "" W "
",! Q ; FIND ; I $$^W4TABLET Q W $$^%W1DICT("SEARCH")_" " W " " W """ onClick=""FindTxt('findtxt',false)"" style=""text-align:center;width:"_$S($$1024^W4WDSCR:25,1:25)_"px;height:"_$S($$1024^W4WDSCR:25,1:25)_"px;background-color:lightgree;padding:3px"" />" W " " W "" I $G(MENU)="BO",'$$PRSNL D .W " " .W "" Q ; PRSNLSET(STAM) ; Q $$GETP^%W1PRM("PRSNLSET") ; ; SETPERS(PRM) ; N (JB,%ARG,%REM,PRM) S FL=$P(PRM,";",1) S NM=$P(PRM,";",2) S PROC=$P(PRM,";",3) S PROC=$$RPL^%L1FRM(PROC,"'","\'") S ACT=$P(PRM,";",4) ; S GL=$$GL^W4PRSMNU ; S ACT=1 I $$PRSNLFIND(NM) S ACT=0 ; I ACT D .S LAST=$O(@GL@(9999),-1)+1 .I LAST=1 D ..S @GL@(0)="EXIT;w4prsmnu.jsp;Back();" . .S @GL@(LAST)=NM_";"_FL_";"_PROC ; I 'ACT D .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S A=$G(^(N)) ..I $P(A,";")=NM,$P(A,";",2)=FL,$P(A,";",3)=PROC K ^(N) Q ; ISPERS(NM,PROC) ; N OK S OK=0 N A,N S N="" F S N=$O(@$$GL^W4PRSMNU@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .S NMMN=$P(A,";") .S PROCMN=$P(A,";",3) .I NM=NMMN,PROC=PROCMN S OK=1 Q OK ; PRSNL(STAM) ; N MN S MN=$$GETP^%W1PRM("CURMENU") I $E(MN,1,7)="FINDALL" Q 0 I $$PRSNLSET!$$GETP^%W1PRM("PRSNLMENU") Q 1 Q 0 ; ; SRV ; W "" W "" N WD1 S WD1=15 I $$1024^W4WDSCR S WD1=22 N WD2 S WD2=35 I $$1024^W4WDSCR S WD2=50 N WD3 S WD3=20 I $$1024^W4WDSCR S WD3=10 I $$^W4TABLET=2 S WD3=5 ; W "",! W "",! W "",! W "",! .I '$$PRSNL W " " Q .D ^W4BUTTON("showprsmnu","SHOWPRSNLAREA","ShowPrsnlArea()") ; W "",! W "",! W "
" D SHOWORD W " " D FIND W "" D W "",! ;;W "Session "_JB_" [ "_$$^W4MYDVN_" ]",! W "JB "_JB_" [ "_$$^W4MYDVN_" ]",! W $$NBSP^%L1FRM(3) W ""_$ZD($H,"24:60")_"" W "
",! Q ; PREPMENU(MENU) ; N (JB,MENU,MA,MA0,MN) S N="",I=0 F S N=$O(^[$$^W3MAIN]W4OPT(MENU,N)) Q:N="" D .S A=$G(^(N)) .D PREPMENU1(A) Q ; PREPMENU1(A) ; N (JB,MENU,MA,MA0,MN,A,I,N) S US=$P(A,";") X "I "_US I D .S RKV=$P(A,";",2) .S PROC=$P(A,";",3) .S I=I+1,MN(I)=RKV,MA0(I)=PROC,MA(I)=PROC .I N D ; I $$PSWDRG^W4PRM D ..N LVL S LVL=$G(^[$$^W3MAIN]W4OPT(MENU,N,"PSWLVL")) ..I $E(LVL)="@" S LVL=@($E(LVL,2,255)) ..Q:LVL<2 ..I LVL<4,$$US23^W4LVL Q ..I LVL<4,$$^W4LVL("BO","EXIT")>2 Q ..S MA(I)="PswLvl('"_LVL_"','"_PROC_"')" Q ; BODYMENU(MENU) ; ;;I $$PRSNL,$$SIDE Q S CLSMN=$S($$^%W1DIR="RTL":"menuh",1:"menu") N WDT S WDT=$S($$^W4TABLET=2:90,1:70) ;;I $$SIDE S WDT=70 W "",! ; N I1,K S I1=0,K=0 N OPMN S OPMN=$G(%ARG("OPENMENU")) ; N ONCLICK,ONCLICKDIR,CURSORDIR ; F I=1:1:IM D .S PRARR=0 .S MN1(I)=$$SPA^%L1FRM(MN1(I)) . .I $E(MN1(I),$L(MN1(I)))=">" D ..S PRARR=1 ..S MN1(I)=$E(MN1(I),1,$L(MN1(I))-1) . .N JSP,PRM S JSP=$P(MA(I),"?") .S HREF="",ONCLICK="" . .I MENU="TELMENU" S JSP=$$RPL^%L1FRM(JSP,"\'","'") . .I $$FUNC^%LCASE(MA(I))[".jsp" D ..S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_IND_"')",1:"")_";self.location.replace(unescape('"_MA(I)_"'))""" .; .I ONCLICK="" S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_I1_"');",1:"")_JSP_"""" . .I $$PRSNLSET,'$G(PRARR),$G(MA(I))'="Back()",$G(MA(I))'="Exit()" S ONCLICK="" . .I MN1(I)["~" S K=K+1 . .S CURSORDIR="" .I $L(OPMN),OPMN'="ALL",OPMN'=K D ..S CURSORDIR=";cursor:pointer" . .S ONCLICKDIR="" .I $L(OPMN),OPMN'=K D ..S ONCLICKDIR=" onClick=""OnClickDirMenu('"_K_"')"" " . .I MN1(I)["~" D Q ..W "",! ..W "" ..W "",! . .I $L(OPMN),OPMN'="ALL",OPMN'=K,I1>0 Q . .I 'ZERO S I1=I1+1 . .I I1=(1-ZERO),'$$SIDE D S:ZERO I1=I1+1 Q ; --- BACK ..Q:$G(%ARG("NOBACK")) ..W "",! ..W "" ..W "",! . . .W "",! . . W "" . . W "" . .W "" .W "",! .I ZERO S I1=I1+1 W "
" ..W "

"_$$^%W1DICT($TR(MN1(I),"~>",""))_"

" ..N STYLE S STYLE=" style=""background-color:white;color:brown;text-align:center;cursor:pointer;border:ridge 1px brown;" .. W "" N WDP S WDP=0 .. I $L(OPMN) S WDP=6+WDP D ... W " ",! .. .. I $$BACK2MAIN S WDP=WDP+6 .. .. I $$^W4LKH S WDP=WDP+30 .. .. W " ",! .. .. I $$^W4TABLET=2 W "" .. .. I $$^W4LKH D CSCARDS .. .. I $$GETP^%W1PRM("W4BO"),'$$GETP^%W1PRM("SUPPL"),'$$PRSNL,'$$SIDE D BOCARDS .. .. I $$BACK2MAIN,'$$PRSNL,'$$SIDE D ... W " ",! .. .. W "
"_$S($$ALL:"-",1:"+")_"" .. I $G(NODICT) S MN1=$$H2U^%L1FRM(MN1(I)) .. E S MN1=$$^%W1DICT(MN1(I)) .. W MN1 .. W "  ^ 
",! ..W "
" . I PRARR W "" . I 'PRARR,$$PRSNLSET D .. W "" . W "" . I '$G(NOMENUCOUNT) W I1_"." .W "1 D .. W " onMouseOver=""OnMouseOverMenu(this)"" " .. W " onMouseOut=""OnMouseOutMenu(this)"" " . I $G(NODICT) S MN1=$$H2U^%L1FRM(MN1(I)) . E S MN1=$$^%W1DICT(MN1(I)) . W ONCLICK_" >"_MN1_"
",! Q ; ; SIDEMENU(SIDE) ; N (JB,SIDE) S ZERO=1,CUR=0,NOMENUCOUNT=1 S %ARG("SIDE")=1 D PREPMENU(SIDE) S IM=$O(MN(999),-1) M MN1=MN D BODYMENU(SIDE) Q ; SIDEPRSN ; D PUT^%W1PRM("PRSNLBO",1) D ^W4PRSMNU(1) Q ; ; SIDE(STAM) ; Q $G(%ARG("SIDE")) ; SCRIPT(MENU) ; W "",! Q ; ; PRSNLFIND(NM) ; N GL S GL=$$GL^W4PRSMNU N OK,A S OK=0 N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .I $P(A,";")=NM S OK=1 Q OK ; ; PREPFINDALL(SRC) ; N (JB,%ARG,SRC) S SRC=$$CNWEB^%L1FRM(SRC) I $G(SRC)?.P Q 0 S PATH=^W3MAIN("WEBL") ; N TMPFA D TMPFA I '$D(@TMPFA) D .S HIP="" .S FL=$ZSEARCH(HIP) .S HIP=PATH_"w*.jsp" CYCFA .F S FL=$ZSEARCH(HIP) Q:FL="" D CRTMPFA(FL) ; S SRC=$$INVH^%L1FRM(SRC) ;;S ^AA("FINDALL","SRC")=SRC N MENU S MENU="FINDALL"_JB ;;S ^AA("FINDALL","MENU")=MENU D PUT^%W1PRM("CURMENU",MENU) K @$$^W4GL("W4PRSMNU")@(MENU) ; N A,US S N0="",I=0 F S N0=$O(^[$$^W3MAIN]W4OPT(N0)) Q:N0="" D .I '$$ELPOS(N0) Q .S N=0 F S N=$O(^[$$^W3MAIN]W4OPT(N0,N)) Q:N="" D ..S A=$G(^(N)) ..S US=$P(A,";") X "I "_US I D ...S RKV=$P(A,";",2) ...I RKV[">" S RKV=$P(RKV,">") ...N RKV1 S RKV1=$$TV^%W1DICT($$^%W1LNG,RKV) ...I '$$SRCH(RKV1,SRC) Q ...S PROC=$P(A,";",3) ...;;S ^AA("FINDALL",N0,N,"A")=A ...;;S ^AA("FINDALL",N0,N,"PROC")=PROC ...N JSP S JSP=$$JSP(N0,PROC) Q:JSP="" ...;;S ^AA("FINDALL",N0,N,"JSP")=JSP ...S I=I+1 D ....M @$$^W4GL("W4PRSMNU")@(MENU,I)=^[$$^W3MAIN]W4OPT(N0,N) ....N A1 S A1=$G(^[$$^W3MAIN]W4OPT(N0,N)) ....;;S ^AA("FINDALL",N0,N,"A1")=A_"\"_I_"\"_MENU ....N PROC S PROC=$P(A1,";",3) ....N NM,PRARR S NM=$P(A,";",2),PRARR=0 I NM[">" S NM=$P(NM,">"),PRARR=1 ....S @$$^W4GL("W4PRSMNU")@(MENU,I)=NM_";"_JSP_";"_PROC_";"_PRARR ; S @$$^W4GL("^W4PRSMNU")@(MENU,0)="EXIT;w4prsmnu.jsp;Back();" S @$$^W4GL("^W4PRSMNU")@(MENU)=SRC Q 1 ; ; JSP(MN,PROC) ; N TMPFA D TMPFA ; I PROC["(" S PROC=$P(PROC,"(") N A S A="" I $G(@TMPFA@(MN_"~"_PROC))'="" S A=@TMPFA@(MN_"~"_PROC) I A["=",$P(A,"=",2)[".jsp" S A=$P(A,"=",2) Q A ; ; CRTMPFA(FL) ; N TMPFA D TMPFA N M,MN,A ; N FLN S FLN=$P(FL,"/",$L(FL,"/")) Q:FLN="" Q:FLN'[".jsp" N FLN0 S FLN0=$P(FLN,".") I $E(FLN0,$L(FLN0))="0" Q O FL:(REWIND:READONLY) ; F U FL R A Q:$ZEOF D .S A=$$SPA^%L1FRM(A) .I A?1"function ".E D ..S FUNC=$P(A,"function ",2) ..I FUNC'["()" Q ..I FUNC["OnLoad(" Q ..I FUNC["OnUnload(" Q ..S FUNC=$P(FUNC,"(") ..I FUNC'="" S M(FUNC)="" .I A["D ^%W1WEBMN(" D ..S MN=$P(A,"D ^%W1WEBMN(",2) ..I MN["^" S MN=$P(MN,"^") ..S MN=$P(MN,")") ..; ..I $E(MN)="""" S MN=$P(MN,"""",2) ..I $$GETP^%W1PRM("ELPOS"),'$$ELPOS(MN) Q ..Q:MN="" ..I MN="WORKCC" Q ..N FN S FN="" F S FN=$O(M(FN)) Q:FN="" D ...S @TMPFA@(MN_"~"_FN)=FLN C FL Q ; ; TMPFA ; S TMPFA=$$^W4MAIN("TMPFA") Q ; ELPOS(MN) ; I MN="ASHRAM"!(MN="ASHRSRV")!(MN="BO1")!(MN="LKH")!(MN="REPNET")!(MN="SIDE")!(MN="LKHSYS") Q 0 Q 1 ; SRCH(RKV1,SRC) ; S RKV1=$$SPA^%L1FRM(RKV1) S SRC=$$SPA^%L1FRM(SRC) I RKV1[" " S RKV1=$$SP1^%L1FRM(RKV1) I SRC[" " S SRC=$$SP1^%L1FRM(SRC) I SRC'[" ",RKV1[SRC Q 1 N OK S OK=1 N J F J=1:1:$L(SRC," ") D Q:'OK .I RKV1'[$P(SRC," ",J) S OK=0 Q OK ; ; RESETPOS ; W "function ResetPos()",! W "{",! W " self.getSelection().empty()",! ;W "var a=true",! ;W "while ( a )",! ;W "{ a= self.find("" "",false,true) }",! W "FindTxt('findtxt',false)",! W "}",!! Q ; FINDTXT ; W "function FindTxt(txtid,back,win)",! W "{",! W "if ( typeof win == 'undefined' ) win=self;",! W "if ( typeof back == 'undefined' ) back=false;",! W "var txt=GetVl(txtid);",! W "if ( txt == """" ) return;",! ;;W "var proc='FindTxt(""'+txtid+'"",'+back+')';",! ;;W "alert('txt='+txt+' txtid='+txtid+' proc='+proc)",! ;;W "if ( endres == '0' ) { setTimeout(proc,200); return }",! W "win.find(txt,false,back);",! W "}",!! Q ; FSZ() ; I $$^W4TABLET=2 Q 18 I $$1024^W4WDSCR Q 13 Q 14 ; VIP() ; I $$MGR^W4OPT!($$GETP^%W1PRM("HDOPT")!$$GETP^%W1PRM("SISALL")) Q 1 Q 0 %W2MSG %W2MSG ; [ 03.05.07 17:20 ] [ W "function PopMsg(MSG)",! W "{",! W "var p=window.createPopup()",! W "var pbody=p.document.body",! W "pbody.style.backgroundColor=""ffffcc""",! W "pbody.style.border=""solid black 2px""",! W "pbody.innerHTML=""

""+MSG+""

""",! W "p.show(200,120,400,60,document.body)",! W "}",! Q %W2WEBMN %W2WEBMN(MENU) ; [ 11.05.26 09:34 ] [ 26.04.26 02:05 ] [ 20.04.26 15:51 ] N (MENU,JB,%ARG,%REM) I $G(MENU)="" S MENU="BO" S FSZ=$$FSZ ; N I,N,MN,IM,A S NOMENUCOUNT=0 I $$GET^%W1PRM("NOMENUCOUNT") S NOMENUCOUNT=1 ; I MENU'="BO" D G END .D MAINMENU(MENU) ; D PREPMENU(MENU) ; D WMN(.MN,.MA,MENU,"",.MA0) END Q ; ; WMN(MN,MA,MENU,NODICT,MA0) ; I $G(%ARG("PRSNLPROC"))'="" D PRSNLPROC Q ; D STYLE ; N CUR S CUR=0 S ZERO=+$G(ZERO) I $L($G(MENU)) S CUR=$G(@$$^W4MAIN("TMPCURMENU")@(MENU)) N MN1,MA1 M MN1=MN N I,CLSMN,HREF,IM S IM=$O(MN(999),-1) ; D SCRIPT(MENU) ; W "
",! D SRV ;; -- TOP SERVICE LINE W "
",! ; W "
",! W "",! W "",! W "" ; S TO2=$$GETP^%W1PRM("BOTO2") W "" ; S TO3=$$GETP^%W1PRM("BOTO3") W "" ; S TO4=$$GETP^%W1PRM("BOTO4") W "" W "",! W "
",! S TO="w5bomenu.jsp?JB="_JB D IFR("ifrbo",TO) W "",! W "",! D IFR("ifr2",TO2) W "",! W "",! D IFR("ifr3",TO3) W "",! W "",! D IFR("ifr4",TO4) W "",! W "
",! W "
",! ; W "

",! W "
",! D SHOWSIDEMENU W "
",! W "

",! ; W "",! Q ; ; ALL(STAM) ; I $G(%ARG("OPENMENU"))="ALL" Q 1 Q 0 ; BACK2MAIN(STAM) ; I $$GETP^%W1PRM("W4BO") Q 1 I $G(%ARG("BACK2MAIN")) Q 1 Q 0 ; CLOSE(STAM) ; I $G(%ARG("BO1")) Q 1 I $$GETP^%W1PRM("BO1") Q 1 Q 0 ; CSCARDS ; W "" W "" W "" ; W " " ; W "" W "" W "" Q ; ; BOCARDS ; ; I '$$PRTNET^W4PRM D .W "" . W "" .W "" .W " " ; D .W "" .W "" .W "",! .W " " ; I '$$GETP^%W1PRM("KUP") D .W "" . W "" .W "" .; .I $$MENU^W4PRSMNU D ..N IND S IND=$O(@$$GL^W4PRSMNU@(0)) Q:'IND ..W "" .. W "" ..W "" ; Q ; ; SHOWORD ; I $$PRSNL D Q .W ""_$$^%W1DICT("CREATEPRSNLAREA")_"",! ; W "",! W "" W "" W "" W "" W "",! W "
" W $$^%W1DICT("ORDERNUMBER")_" " W "" W "",! W "" W "" W "
",! Q ; FIND ; I $$^W4TABLET Q W $$^%W1DICT("SEARCH")_" " W " " ;;W """ onClick=""FindTxt('findtxt',false)"" style=""text-align:center;width:"_$S($$1024^W4WDSCR:25,1:25)_"px;height:"_$S($$1024^W4WDSCR:25,1:25)_"px;background-color:lightgree;padding:3px"" />" ;;W " " ;;W "" I $G(MENU)="BO",'$$PRSNL D .W " " .W "" Q ; PRSNLSET(STAM) ; Q $$GETP^%W1PRM("PRSNLSET") ; ; SETPERS(PRM) ; N (JB,%ARG,%REM,PRM) S FL=$P(PRM,";",1) S NM=$P(PRM,";",2) S PROC=$P(PRM,";",3) S PROC=$$RPL^%L1FRM(PROC,"'","\'") S ACT=$P(PRM,";",4) ; S GL=$$GL^W4PRSMNU ; S ACT=1 I $$PRSNLFIND(NM) S ACT=0 ; I ACT D .S LAST=$O(@GL@(9999),-1)+1 .I LAST=1 D ..S @GL@(0)="EXIT;w4prsmnu.jsp;Back();" . .S @GL@(LAST)=NM_";"_FL_";"_PROC ; I 'ACT D .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S A=$G(^(N)) ..I $P(A,";")=NM,$P(A,";",2)=FL,$P(A,";",3)=PROC K ^(N) Q ; ISPERS(NM,PROC) ; N OK S OK=0 N A,N S N="" F S N=$O(@$$GL^W4PRSMNU@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .S NMMN=$P(A,";") .S PROCMN=$P(A,";",3) .I NM=NMMN,PROC=PROCMN S OK=1 Q OK ; PRSNL(STAM) ; N MN S MN=$$GETP^%W1PRM("CURMENU") I $E(MN,1,7)="FINDALL" Q 0 I $$PRSNLSET!$$GETP^%W1PRM("PRSNLMENU") Q 1 Q 0 ; ; SRV ; W "" W "" N WD1 S WD1=15 I $$1024^W4WDSCR!($$^W4TABLET=1) S WD1=20 N WD2 S WD2=35 I $$1024^W4WDSCR S WD2=35 I $$^W4TABLET=1 S WD2=25 N WD3 S WD3=10 I $$1024^W4WDSCR!($$^W4TABLET=1) S WD3=3 ; W "" ; W "" ; W "" ; D BOCARDS ; W "" .I '$$PRSNL D Q ..D ^W4BUTTON("createprsmnu","CREATEPRSNLAREA","CreatePrsnlArea()","font-size:"_$$^W3FSZ($$FSZ)) .D ^W4BUTTON("showprsmnu","SHOWPRSNLAREA","ShowPrsnlArea()") ; W "" ; W "" W "",! W "
" D SHOWORD W "" W "" W "" D FIND W "" D W "" D . N WD,HG S WD=35,HG=35 I $$1024^W4WDSCR S WD=30,HG=30 . W "" W "" W "JB "_JB_" ["_$$^W4MYDVN_"]",! W $$NBSP^%L1FRM(3) W ""_$ZD($H,"24:60")_"" W "
",! Q ; ; PREPMENU(MENU) ; N (JB,MENU,MA,MA0,MN) S N="",I=0 F S N=$O(^[$$^W3MAIN]W4OPT(MENU,N)) Q:N="" I N D .S A=$G(^(N)) .D PREPMENU1(A) Q ; PREPMENU1(A) ; N (JB,MENU,MA,MA0,MN,A,I,N) S US=$P(A,";") X "I "_US I D .S RKV=$P(A,";",2) .S PROC=$P(A,";",3) .S I=I+1,MN(I)=RKV,MA0(I)=PROC,MA(I)=PROC .I N D ..N LVL S LVL=$G(^[$$^W3MAIN]W4OPT(MENU,N,"PSWLVL")) Q:LVL<2 ..I LVL<4,$$US23^W4LVL Q ..I LVL<4,$$^W4LVL("BO","EXIT")>2 Q ..S MA(I)="PswLvl('"_LVL_"','"_PROC_"')" Q ; ; BODYMENU(MENU,PARENT) ; S MENU=$G(MENU) N MENUHD S MENUHD="" N IDCUREL S IDCUREL="" ; I MENU["^" D .S MENUHD=$$SPA^%L1FRM($P(MENU,"^",2)) .S MENU=$$SPA^%L1FRM($P(MENU,"^")) ; I MENU="BO",MENUHD="" S MENUHD="MAINMENU" ; I $L(MENU) S CUR=$G(@$$^W4MAIN("TMPCURMENU")@(MENU)) N WDT S WDT=98 ; W "",! ; I $L(MENUHD) D .W "",! . W "" .W "",! ; N I1,K S I1=0,K=0 N OPMN S OPMN=$G(%ARG("OPENMENU")) ; N ONCLICK,ONCLICKDIR,CURSORDIR ; N IM S IM=$O(MN1(9999),-1) ; F I=1:1:IM D .S PRARR=0 .S MN1(I)=$$SPA^%L1FRM(MN1(I)) . .I $E(MN1(I),$L(MN1(I)))=">" D ..S PRARR=1 ..S MN1(I)=$E(MN1(I),1,$L(MN1(I))-1) . .N JSP,PRM S JSP=$P(MA(I),"?") .S HREF="",ONCLICK="" . .I MENU="TELMENU" S JSP=$$RPL^%L1FRM(JSP,"\'","'") . .N WIN S WIN="self" I $G(PARENT) S WIN="parent" .N IND S IND=I1 I 'ZERO S IND=I1+1 . .I $$FUNC^%LCASE(MA(I))[".jsp" D ..S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurNewMenu(this,'"_MENU_"','"_IND_"')",1:"")_";"_WIN_".location.replace(unescape('"_MA(I)_"'))""" .; .I ONCLICK="" S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurNewMenu(this,'"_MENU_"','"_IND_"');",1:"")_JSP_"""" . .I $$PRSNLSET,'$G(PRARR),$G(MA(I))'="Back()",$G(MA(I))'="Exit()" S ONCLICK="" . .I MN1(I)["~" S K=K+1 . .S CURSORDIR="" .I $L(OPMN),OPMN'="ALL",OPMN'=K D ..S CURSORDIR=";cursor:pointer" . .S ONCLICKDIR="" .I $L(OPMN),OPMN'=K D ..S ONCLICKDIR=" onClick=""OnClickDirNeMenu(this,'"_K_"')"" " . .I MN1(I)["~" D Q ..W "" .. W "" ..W "",! . .I $L(OPMN),OPMN'="ALL",OPMN'=K,I1>0 Q . .I 'ZERO S I1=I1+1 . .W "" . W "" . . N FSZ S FSZ=$$FSZ-2 . W "" . .W "" .W "",! . .I ZERO S I1=I1+1 ; W "",! W "
",! . W $$^%W1DICT(MENUHD) . . I $G(MENU)'="BO" D .. N SZ S SZ=22 I $$1024^W4WDSCR S SZ=18 .. W "",! . W "
",! .. W "

"_$$^%W1DICT($TR(MN1(I),"~>",""))_"

" .. W "
" . N HG,WD S (WD,HG)="20px" I $$1024^W4WDSCR S (WD,HG)="14px" . I PRARR W "" .W "" . I '$G(NOMENUCOUNT) W I1 ;;_"." .W "1 D .. W " onMouseOver=""OnMouseOverMenu(this)"" " .. W " onMouseOut=""OnMouseOutMenu(this)"" " . . I $G(NODICT) S MN1=$$H2U^%L1FRM(MN1(I)) . E S MN1=$$^%W1DICT(MN1(I)) . W ONCLICK_" >"_MN1_"
 
",! ; Q ; ; MAINMENU(MENU) ; N (JB,MENU) I $G(MENU)="" S MENU="BO" S ZERO=0,CUR=0 ;;,NOMENUCOUNT=1 D PREPMENU($P(MENU,"^")) S IM=$O(MN(999),-1) M MN1=MN D BODYMENU(MENU) Q ; SIDEMENU(SIDE) ; N (JB,SIDE) S ZERO=1,CUR=0,NOMENUCOUNT=1 S %ARG("SIDE")=1 D PREPMENU(SIDE) S IM=$O(MN(999),-1) M MN1=MN D BOTTOMMENU(SIDE) Q ; SIDEPRSN ; D PUT^%W1PRM("PRSNLBO",1) D ^W4PRSMNU(1) Q ; ; SIDE(STAM) ; Q $G(%ARG("SIDE")) ; ; SCRIPT(MENU) ; W "",! Q ; ; PRSNLFIND(NM) ; N GL S GL=$$GL^W4PRSMNU N OK,A S OK=0 N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .S A=$G(^(N)) .I $P(A,";")=NM S OK=1 Q OK ; ; PREPFINDALL(SRC) ; Q $$PREPFINDALL^%W1WEBMN(SRC) ; ; ELPOS(MN) ; I MN="ASHRAM"!(MN="ASHRSRV")!(MN="BO1")!(MN="LKH")!(MN="REPNET")!(MN?1"SIDE".E)!(MN="LKHSYS")!(MN["POP") Q 0 Q 1 ; ; RESETPOS ; W "function ResetPos()",! W "{",! W " self.getSelection().empty()",! ;W "var a=true",! ;W "while ( a )",! ;W "{ a= self.find("" "",false,true) }",! W "FindTxt('findtxt',false)",! W "}",!! Q ; FINDTXT ; W "function FindTxt(txtid,back,win)",! W "{",! W "FindText(txtid,back)",! W "}",! Q W "if ( typeof win == 'undefined' ) win=self;",! W "if ( typeof back == 'undefined' ) back=false;",! W "var txt=GetVl(txtid);",! W "if ( txt == """" ) return;",! W "}",!! Q ; FSZ() ; I $$1024^W4WDSCR Q 11 Q 13 ; VIP() ; I $$MGR^W4OPT!($$GETP^%W1PRM("HDOPT")!$$GETP^%W1PRM("SISALL")) Q 1 Q 0 ; PRSNLPROC ; N PROC S PROC=%ARG("PRSNLPROC") W "
",! W "

",! W "

"_$$^%W1DICT("WAIT")_"

",! W "",! W "
",! Q ; STYLE ; W "",! Q ; ; SHOWSIDEMENU ; ; N SIDEPRSN S SIDEPRSN=0 ; I '$$PRSNLSET D .N MN,DARGA S MN=$$GETP^%W1PRM("MNL") S DARGA="" .I MN D ..D PUT^%W1PRM("CURMENU",MN) ..S DARGA=+$G(@$$^W4GL("W4PSWDRG")@(MN)) .; .I $$VIP S DARGA=4 .N LVL S LVL=$G(@$$^W4GL("W4OPT")@("BO",8,"PSWLVL")) ; -- REPORTS & QUERIES .; .I DARGA,DARGA100 S WDT=100 ; W "",! ; N I1,K S I1=0,K=0 ; W "" F I=1:1:IM D .S PRARR=0 .S MN1(I)=$$SPA^%L1FRM(MN1(I)) . .I $E(MN1(I),$L(MN1(I)))=">" D ..S PRARR=1 ..S MN1(I)=$E(MN1(I),1,$L(MN1(I))-1) . .N JSP,PRM S JSP=$P(MA(I),"?") .S HREF="",ONCLICK="" . .I $$FUNC^%LCASE(MA(I))[".jsp" D ..S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_IND_"')",1:"")_";self.location.replace(unescape('"_MA(I)_"'))""" .; .I ONCLICK="" S ONCLICK=" onClick="""_$S($L($G(MENU)):"SetCurMenu('"_MENU_"','"_I1_"');",1:"")_JSP_"""" . .I $$PRSNLSET,'$G(PRARR),$G(MA(I))'="Back()",$G(MA(I))'="Exit()" S ONCLICK="" . .I MN1(I)["~" S K=K+1 . .S CURSORDIR=";cursor:pointer" . .S ONCLICKDIR="" . .W "" ; W "",! W "
" . W MN1 .W "
",! Q ; IFR(ID,TO) ; S TO=$G(TO) W "",! W "

",! W " ",! W " ",! W "
",! END Q ; ; SEARCH ; W "
" W $$^%W1DICT("SEARCH")_$$NBSP^%L1FRM(2) W " " D ^W4BUTTON("SrchDn",">","FindText('search',false,GetId('ifrgl').contentWindow)","width:25px;height:25px;background-color:lightgrey") W " " D ^W4BUTTON("SrchUp","<","FindText('search',true,self.frames[0])","width:25px;height:25px;background-color:lightgrey") W "
",! Q ; ; SAVE(STAM) ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W1GLED" S VRM=$$^W4MAIN("VRM") N I F I=1:1 Q:'$D(@VRM@(I)) D .N A S A=$G(^(I)) .I $D(@VRM@(I,"CHN")) D ..S IND=$P(A,"=") ..S CONT=$P(A,"=",2,200) ..S @IND=CONT K @VRM Q 1 ; COMMAND ; ER ; Q $ZS W1GLED1 W1GLED1 ; [ 06.01.26 10:12 ] [ 22.10.25 13:14 ] [ 30.07.25 13:11 ] N (JB,%ARG,%REM) S VRM=$$^W4MAIN("VRM") ; I $G(%ARG("CHNLNG"))="" K @VRM D PREP ; W "
",! W "",! W "" W "" W "",! ; F I=1:1 Q:'$D(@VRM@(I)) D .S A=$G(^(I)) .S IND=$P(A,"=") .S CONT=$P(A,"=",2,200) . .I $G(%ARG("DLM"))="" D ..S CONT=$$VW(CONT) ..S DIR="LTR" ;;S DIR="RTL" ..S INP="" . .I $G(%ARG("DLM"))'="" D ..N DLM S DLM=$G(%ARG("DLM")) ..N NUMDLM S NUMDLM=$L(CONT,DLM) I NUMDLM<20 S NUMDLM=20 ..I $G(%ARG("COLS")) S NUMDLM=%ARG("COLS") ..S INP="
Global Name Content
" ..N OU S OU="" ..N J F J=1:1:NUMDLM D ...N W S W=$P(CONT,DLM,J) ...S SZ=$L(W) I SZ<10 S SZ=10 ...S INP=INP_"" ..S INP=INP_"
"_J_"
" ...S INP=INP_"
" . .W "" . W "" . W ""_INP_"" .W "",! W "",! W "
",! Q ; ; PREP ; N %PR,%MAC1,%MAC2,%ORD,FLAG,%PR,VRM N MAC S MAC=$G(%ARG("GL")) I $E(MAC)'="^" S MAC="^"_MAC S VRM=$$^W4MAIN("VRM") K @VRM S %ORD=1 S %PR=0,FLAG=0 I ($D(@MAC)#10)'=0 S %PR=1 S %MAC2=$E($R,1,$L($R)-1)_$S($E(MAC,$L(MAC))=")":",",1:"") S @VRM@(1)=MAC_"=<<<<>>>>" S @VRM=MAC I %PR S @VRM@(1)=MAC_"="_@MAC S %MAC1=MAC I $E(%MAC1,$L(%MAC1))=")" S %MAC1=$E(%MAC1,1,$L(%MAC1)-1)_","""")" I $E(%MAC1,$L(%MAC1))'=")" S %MAC1=%MAC1_"("""")" S %MAC1=$Q(@%MAC1) ;;I %MAC1="" W:%PR=0 *7,!?15,"*** ARRAY ",MAC," HASN'T DESCENDANTS !" H 2 Q F I=2:1:100000 Q:%MAC1'[%MAC2 Q:%MAC1="" S @VRM@(I)=%MAC1_"="_@%MAC1 S %MAC1=$Q(@%MAC1) I I=100000 S FLAG=1 Q ; CHN(PRM) ; S VRM=$$^W4MAIN("VRM") N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER" N IND,VL1,VL2,DLM S DLM="<>" S IND=$P(PRM,DLM,1) S VL1=$P(PRM,DLM,2) I VL1="" Q "NOIND" S VL2=$P(PRM,DLM,3,200) S VL2=$$CNWEB^%L1FRM(VL2) S VL2=$$INVH^%L1FRM(VL2) S @VRM@(IND)=(VL1_"="_VL2) S @VRM@(IND,"CHN")=1 Q 1 ; VW(TX) I $G(%ARG("CHNLNG"))="E" Q TX Q $$H2U^%L1FRM(TX) ; CHNTD(PRM) ; N (JB,%ARG,PRM) S VRM=$$^W4MAIN("VRM") N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER" S DLM="<>" S IND=$P(PRM,DLM,1) S INDST=$P(PRM,DLM,2) I INDST="" Q "NOIND" S DLMST=$P(PRM,DLM,3) S GLST=$P(PRM,DLM,4) S VL=$P(PRM,DLM,5) S VL=$$CNWEB^%L1FRM(VL) S VL=$$INVH^%L1FRM(VL) S ST=$G(@VRM@(IND)) S STVL=$P(ST,"=",2,200) S $P(STVL,DLMST,INDST)=VL S @VRM@(IND)=(GLST_"="_STVL) S @VRM@(IND,"CHN")=1 Q 1 ER Q $ZS W1GRAPH W1GRAPH ; [ 14.01.19 22:26 ] [ 18.08.18 19:39 ] [ 06.05.18 15:42 ] N (JB,%ARG,%REM) W "",! S WD=96 I $G(%ARG("PRINT")) S WD=42 W "
",! W "" W "",! W "
",! ; S COLG=$$COLG I COLG<1 S COLG=1 I COLG=1 D .S NG=$G(%ARG("NG")) .I NG<1 S NG=1 ; S COLX=$$COLX ; W "",! Q ; ; TYPE(STAM) ; N TYPE S TYPE=$G(%ARG("TYPE")) I $G(%ARG("PIE")) Q "pie" I TYPE="" S TYPE="bar" Q TYPE ; COLG(STAM) ; Q $G(@$$GLGR@("COLG")) ; COLX(STAM) ; Q $G(@$$GLGR@("COLX")) ; LAB(I) Q $G(@$$GLGR@("LAB",I)) ; VL(NG,I) Q $G(@$$GLGR@("VL",NG,I)) ; BGCOLOR(NG) Q $G(@$$GLGR@("BGC",NG)) ; BORDCOLOR(NG) Q $G(@$$GLGR@("BRDC",NG)) ; LB(NG) Q $G(@$$GLGR@("LB",NG)) ; ;rgba(255,99,132,1) ;rgba(54, 162, 235, 1) ;rgba(255, 206, 86, 1) ;rgba(75, 192, 192, 1) ;rgba(153, 102, 255, 1) ;rgba(255, 159, 64, 1) Q ; GLGR(STAM) ; Q $$^W4MAIN("TMPG") ; ; TV ; N I,NG N GLGR S GLGR=$$GLGR K @GLGR S COLX=30 S COLG=3 S @GLGR@("COLX")=COLX S @GLGR@("COLG")=COLG S %ARG("TYPE")="bar" S @GLGR@("TYPE")="bar" ; F I=1:1:COLX S @GLGR@("LAB",I)=I F NG=1:1:COLG D .F I=1:1:COLX S @GLGR@("VL",NG,I)=I*10*NG ; S @$$GLGR@("BGC",1)="rgba(255,99,132,.4)" S @$$GLGR@("BRDC",1)="rgba(255,99,132,1)" ; S @$$GLGR@("BGC",2)="rgba(54, 162, 235, .4)" S @$$GLGR@("BRDC",2)="rgba(54, 162, 235, 1)" ; S @$$GLGR@("BGC",3)="rgba(255, 206, 86, .4)" S @$$GLGR@("BRDC",3)="rgba(255, 206, 86, 1)" ; D W1GRAPH Q ; ; PREP(NG,COLX) ; W " var arrdata"_NG_"=new Array() ",! W " var arrcolor"_NG_"=new Array() ",! W " var arrbordcolor"_NG_"=new Array() ",! W ! N I F I=1:1:COLX D .W " arrdata"_NG_"["_I_"]='"_$$VL(NG,I)_"' ",! ; W "arrcolor"_NG_"='"_$$BGCOLOR(NG)_"' ",! W "arrbordcolor"_NG_"='"_$$BORDCOLOR(NG)_"'",! W ! Q ; PREPPIE(COLG) ; W " var arrdata=new Array() ",! W " var arrcolor=new Array() ",! W " var arrbordcolor=new Array() ",! W " var arrlabels=new Array() ",! W ! N I F I=1:1:COLG D .W " arrdata["_I_"]='"_$$VL(I,1)_"' ",! .W "arrcolor["_I_"]='"_$$BGCOLOR(I)_"' ",! .W "arrbordcolor["_I_"]='"_$$BORDCOLOR(I)_"'",! .W "arrlabels["_I_"]='"_$$LB(I)_"'",! W ! Q ; ; ; DEF(NG,COLG) ; W " {",! N LB S LB=$$H2UG^%L1FRM($G(@$$GLGR@("LB",NG))) W " label : '"_LB_"',",! W " data : arrdata"_NG_",",! W " backgroundColor: arrcolor"_NG_",",! W " borderColor: arrbordcolor"_NG_",",! W " borderWidth: 1",! W " }" I NG1 D .S W1GS("GLOB")=$P(A," ") .W W1GS("FILE")=$P(A," ",2) ; I $G(W1GS("GLOB"))="" W " GLOBAL NOT DEFINED !",! Q I $G(W1GS("FILE"))="" W " FILE NOT DEFINED !",! Q ; I W1GS("GLOB")'["S-" S %L1GS("SV",W1GS("GLOB"))="" ; I W1GS("GLOB")["S-" D .S SET=$P(W1GS("GLOB"),"S-",2) .F I=1:1 Q:'$D(^SHP("%GS"_SET,I)) D ..I ^(I)?1U.UN S %L1GS("SV",^(I))="" ; D .S %L1GS("TO")=W1GS("FILE") .I W1GS("FILE")'["/" S %L1GS("TO")="/home/gtmuser/"_W1GS("FILE") ; D ^%L1GS Q W1GSBS W1GSBS ; [ 19.02.25 18:32 ] [ N (JB,%ARG) D NOKILL^KILLZ S %ZD="" F I=1:1:$L(NOKILL,",") D .S P=$P(NOKILL,",",I) Q:P="" .S %ZG(P)="" ; D BGW^%L1GS Q W1HBED W1HBED ; [ 08.10.25 14:05 ] [ W "


",! W " TEXT IN : ",! W " ",! ; W "

TEXT OUT :

",! Q W1KK W1KK ; [ 20.08.25 05:49 ] [ 03.12.18 06:59 ] [ S FILE="/home/gtmuser/contacts.csv" O FILE:(READONLY:REWIND) ; K ^LK F U FILE R A Q:$ZEOF D .S A1=A .U 0 W A1,! .S FNAME=$$HB($P(A1,",")) .S LNAME=$$HB($P(A,",",2)) .S NAME=FNAME_" "_LNAME .S EMAIL=$$FUNC^%UCASE($P(A,",",3)) .S TEL=$$TEL($P(A,",",5)) .S PELE=$$TEL($P(A1,",",6)) . .S KTV=$$HB($P(A1,",",15)) .S IR=$$HB($P(A1,",",16)) .I TEL'?4N.N Q .S ST="LKH="_NAME_"<>TEL="_TEL_"<>PELE="_PELE_"<>KTV="_KTV_"<>IR="_IR_"<>EMAIL="_EMAIL .D PUT2^W4L(TEL,ST) C FILE Q ; HB(TX) ; S TX=$$U2D^%L1CNV(TX) S TX=$$KV(TX) Q $$INVH^%L1FRM(TX) ; TEL(TEL) ; S TEL=$TR(TEL,"'+- ","") D .I $E(TEL,1,3)="972" S TEL="0"_$E(TEL,4,30) Q .I $E(TEL)=5 S TEL="0"_TEL Q TEL ; KV(TX) ; I $E(TX)="""" S TX=$E(TX,2,$L(TX)) I $E(TX,$L(TX))="""" S TX=$E(TX,1,$L(TX)-1) I $E(TX)="'" S TX=$E(TX,2,$L(TX)) I $E(TX,$L(TX))="'" S TX=$E(TX,1,$L(TX)-1) Q TX W1KLPAR W1KLPAR ; [ 23.04.26 14:26 ] [ N (JB,%ARG) D SVPAR ; F I=1:1 Q:'$D(^SHP("%GSPAR",I)) D .I ^(I)?1U.UN K @("^"_^(I)) Q ; ; SVPAR ; K %L1GS F I=1:1 Q:'$D(^SHP("%GSPAR",I)) D .I ^(I)?1U.UN S %L1GS("SV",^(I))="" ; S %L1GS("TO")="/home/gtmuser/SVPAR.OLD" D ^%L1GS Q W1LINCOM W1LINCOM ; [ 25.10.25 13:46 ] [ N (JB,%ARG) W "
",! W "

 

",! W "
",! S WEBL=$$WEBL^W3MAIN I $E(WEBL,$L(WEBL))="/" S WEBL=WEBL_"/" S FL=WEBL_"w1lincom.txt" O FL:(REWIND:READONLY) F U FL R A Q:$ZEOF D .U $P W A_"
",! C FL W "
",! W "
",! Q W1MSG W1MSG(MSG) ; [ 14.07.26 14:35 ] [ I '$D(TSS) D ^%L1TS S MSG=$$SPA^%L1FRM(MSG) S MSG=$$SP1^%L1FRM(MSG) N PRHB S PRHB=0 N J F J=1:1:$L(MSG) I $A(MSG,J)>127 S PRHB=1 Q I 'PRHB Q $$FUNC^%UCASE(MSG) S MSG=$$INVH^%L1FRM($TR(MSG,TSS,TS0)) Q MSG W1MVDT W1MVDT(DATO,DATN) ; [ 02.06.38 08:37 ] [ S DTO=$$^%L1DC(DATO,3) S DTN=$$^%L1DC(DATN,3) S DAT2N=$ZD(DTN,"YYMMDD") S DAT2O=$ZD(DTO,"YYMMDD") ; M ^P1H(DTN)=^P1H(DTO) K ^P1H(DTO) S N="" F S N=$O(^P1HI(N)) Q:N="" D .M ^P1HI(N,DTN)=^P1HI(N,DTO) K ^P1HI(N,DTO) . .M ^Z(DTN)=^Z(DTO) K ^Z(DTO) .M ^Z1(DAT2N)=^Z1(DAT2O) K ^Z1(DATO) .M ^TOT(DAT2N)=^TOT(DAT2O) K ^TOT(DAT2O) .M ^PLUTOT(DAT2N)=^PLUTOT(DAT2O) K ^PLUTOT(DAT2O) ; S N1="" F S N1=$O(^KLIN("DT",N1)) Q:N1="" D .S DT="" M ^KLIN("DT",N1,DTN)=^KLIN("DT",N1,DTO) K ^KLIN("DT",N1,DTO) ; S N="" F S N=$O(^DUMP(N)) Q:N="" D .I $$^%L1DC($P(^(N),"|",7),3)=DTO S $P(^DUMP(N),"|",7)=$ZD(DTN,"DD/MM/YYYY") ; S N="" F S N=$O(^DUMP1(N)) Q:N="" I $E(N,1,5)=DTO D .S ^DUMP1(DTN_$E(N,6,30))=^DUMP1(N) .K ^DUMP1(N) ; S N="" F S N=$O(^P1HL(N)) Q:N="" D .S N1="" F S N1=$O(^P1HL(N,N1)) Q:N1="" I ^(N1)=DTO S ^(N1)=DTN ; S N="" F S N=$O(^P1HL1(N)) Q:N="" D .S N1="" F S N1=$O(^P1HL1(N,N1)) Q:N1="" I ^(N1)=DTO S ^(N1)=DTN ; S N="" F S N=$O(^P1HL2(N)) Q:N="" D .S N1="" F S N1=$O(^P1HL2(N,N1)) Q:N1="" I ^(N1)=DTO S ^(N1)=DTN ; S N="" F S N=$O(^P1HL3(N)) Q:N="" D .S N1="" F S N1=$O(^P1HL3(N,N1)) Q:N1="" I ^(N1)=DTO S ^(N1)=DTN ; S N="" F S N=$O(^P1LHB(N)) Q:N="" D .S N1="" F S N1=$O(^P1LHB(N,N1)) Q:N1="" I $P(^(N1),"\",7)=DTO S $P(^(N1),"\",7)=DTN ; S N="" F S N=$O(^TIPMZ(N)) Q:N="" D .N IND S IND=DTN_"^"_$P(N,"^",2,10) .I $P(N,"^")=DTO M ^TIPMZ(IND)=^TIPMZ(N) K ^TIPMZ(N) ; M ^P1HBI(DTN)=^P1HBI(DTO) K ^P1HBI(DTO) S N="" F S N=$O(^P1HB(N)) Q:N="" D .I $P($G(^(N)),"\",2)=DTO S $P(^(N),"\",2)=DTN ; M ^P1HB2I(DTN)=^P1HB2I(DTO) K ^P1HB2I(DTO) S N="" F S N=$O(^P1HB2(N)) Q:N="" D .I $P($G(^(N)),"\",2)=DTO S $P(^(N),"\",2)=DTN ; M ^P1HB5I(DTN)=^P1HB5I(DTO) K ^P1HB5I(DTO) M ^P1TMI(DTN)=^P1TMI(DTO) K ^P1TMI(DTO) ; ; S N="" F S N=$O(^KLF(N)) Q:N="" D .S KPMH=0,KPMZ=0 .S N1="" F S N1=$O(^KLF(N,N1)) Q:N1="" D ..S N2="" F S N2=$O(^KLF(N,N1,N2)) Q:N2="" D ...I N1="CB"!(N1="H") D ....S A=$G(^(N2)) ....I $$^%L1DC($P(A,"\",4),4)=DTO S $P(^KLF(N,N1,N2),"\",4)=DAT2N ...I N1="KP" D ....I $$^%L1DC($E(N2,1,6),4)=DTO D .....S ^KLF(N,N1,DAT2N_$E(N2,7,20))=^KLF(N,N1,N2) K ^KLF(N,N1,N2) Q W1NMEX W1NMEX ; [ 12.12.18 18:36 ] [ 09.12.18 18:50 ] [ N GL S GL="^NAME1" K @GL F I=2:1 Q:'$D(^AAA(I)) D .S A=$G(^(I)) .S OV=$P(A,","),OV=$TR($J(OV,5)," ",0) .S NAME=$$INVH^%L1FRM($P(A,",",2)) .S KV=+$P(A,",",3) .S SUGMS=+$P(A,",",4) .S TIPS=$P(A,",",5) .S TIPS=$S(TIPS="":0,1:1) .S KTV=$$INVH^%L1FRM($P(A,",",6)) .S TZ=$TR($P(A,",",7),"-","") .S TEL=$P(A,",",8) .S DATS=$$DAT($P(A,",",9)) .S DATLD=$$DAT($P(A,",",10)) . .S @GL@(OV)=KV_"\"_SUGMS .S @GL@(OV,1)=NAME .S @GL@(OV,2)=KTV .S @GL@(OV,3)=TZ .S @GL@(OV,4)=TEL .S @GL@(OV,5)=DATS .S @GL@(OV,11)=TIPS .S @GL@(OV,13)=DATLD .S @GL@(OV,21)=1 Q ; D ^%L1TS S FILE="/home/gtmuser/NAME.csv" O FILE:(REWIND:READONLY) S I=0 F U FILE R A Q:$ZEOF D .S I=I+1 .S ^AAA(I)=$TR(A,TS1,TS0) C FILE Q ; DAT(DAT) ; S DAT=$TR(DAT,$C(13,10),"") S DAT=$TR(DAT,"/",".") S DAT=$P(DAT,".",1,2)_"."_$E($P(DAT,".",3),3,4) Q DAT W1PC W1PC(UID,OID,SUM,SUME,CNAME,CNC) ; [ 03.09.10 12:01 ] [ Q N (JB,%ARG,%REM,OID,UID,SUM,SUME,CNAME,CNC,WCC) D ^%L1TS,^W4MDPPC S MKR=1 PC ; S MAS(1)=MKR S MAS(5)=$S(MKR:" xewn",1:"gewll wzrd") S MAS(7)="" I CNC="Y" S MAS(7)="dpnfd lehia" S MAS(10)=$$^%L1DC($H,1)_" "_$$T^%L1TIME($P($H,",",2)) S MAS(15)=$G(@$$^WCG@("RSNAME")) S MAS(20)=$G(@$$^WCG@("RSPHONE")) S MAS(25)=UID S MAS(30)=CNAME S MAS(35)=901 S MAS(40)=OID S MAS(50)=$J(SUM,2,2) S MAS(55)=$J(SUME,2,2) S MAS("EHAD")="" S LAB="WCPC" D ^W4CB I MKR S MKR=0 G PC I MKR,$G(WCG("RCOPY")) S MKR=0 G PC Q W1PCBACK W1PCBACK ; [ 26.04.22 08:40 ] [ Q ; USFIND() ; I $$1024^W4WDSCR Q 0 I $G(@$$^%W1GLPRM@("REPN"))="W4LEVD" Q 0 I $G(@$$^%W1GLPRM@("REPN"))="W4LVDT" Q 0 I $G(@$$^%W1GLPRM@("REPN"))="HZH" Q 0 Q 1 W1PCZ W1PCZ ; [ 06.08.26 09:42 ] [ 05.08.26 20:29 ] [ 19.07.26 16:42 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; D GREP ; S (GLSTART,GLFIN,VARLIST,REPNAME,PREPPROG)="" S STAGE=$G(%ARG("STAGE")) ; S REPN=$G(%ARG("REPN")) ; I REPN="" D .D KILL^%W1PRM("W1PCZREPN") .D KILL^%W1PRM("W1PCZSTG") .K @$$^%W1GLPRM ; I REPN'="" D .I STAGE="" S STAGE=1 .D PUT^%W1PRM("W1PCZSTG",STAGE) .D DEFGL(REPN) .D PUT^%W1PRM("W1PCZREPN",REPN) . .I STAGE'=5 D ..K @$$^%W1GLPRM("CT") ..K @$$^%W1GLPRM("SIK") ..K @$$^%W1GLPRM("MIUN") ..K @$$^%W1GLPRM("QUERY") ..K @$$^%W1GLPRM("FLD0") ; W "
",! ; W "",! W "" W "" W "" N STYLE S STYLE="display:none" I $L($G(REPN)),'$D(@GREP@(REPN)) S STYLE="display:block" W "" W "" W "
" W $$^%W1DICT("REPCODE")_"  " W "" W $$NBSP^%L1FRM(3) I '$G(%ARG("STAGE")) W "",! W "",! W " " W $$^%W1DICT("COPYFROM")_"  " W "" W $$NBSP^%L1FRM(3) W "",! W "
",! ; I '$G(%ARG("STAGE")) G END ; W "",! W "" W "" W "" W "",! ; W "" W "" W "" W "",! ; W "" W "" W "" W "",! ; W "" W "" W "" W "",! ; W "" W "" W "" W "",! W "
" W "REPORT NAME" W $$NBSP^%L1FRM(3) W "" W "" W "
" W "GLOBAL START" W $$NBSP^%L1FRM(3) W "" W "" W "
" W "GLOBAL FINISH" W $$NBSP^%L1FRM(3) W "" W "" W "
" W "VARIABLE LIST" W $$NBSP^%L1FRM(3) W "" W "" W "
" W "PROGRAMM FOR PREPARING OF DATA" W $$NBSP^%L1FRM(3) W "" W "" W $$NBSP^%L1FRM(3) W "",! W "
",! ; W "

",! D TBOPT W "

",! ; I STAGE=1 D .D TBCODE(REPN) ; I STAGE=2 D TBNUM(REPN) I STAGE=4 D TBCOM(REPN) I STAGE=5 D ^W1PCZQRY(REPN) ; END ; W "
",! Q ; ; COPY(PRM) ; N FROM,REPN S FROM=$P(PRM,"~") S REPN=$P(PRM,"~",2) D GREP I FROM="" Q "REPFROMNOTDEFINED" I REPN="" Q "REPNNOTDEFINED" I $D(@GREP@(FROM))<10 Q "REPFROMNOTEXIST" M @GREP@(REPN)=@GREP@(FROM) Q 1 ; ; TBOPT ; W "",! W "" W "" ; W "" ; W "" ; W "" ; W "" ; W "",! W "
",! W $$H2U^%L1FRM("micew") W "",! W $$H2U^%L1FRM("miizenk mipezp") W "",! W $$H2U^%L1FRM("zecewt") W "",! W $$H2U^%L1FRM("zezli`y") W "",! W $$^%W1DICT("BACK") W "
",! Q ; ; TBOPTSTYLE(IND) N BGCOLOR S BGCOLOR="" ;;I IND=1&(STAGE<2)!(IND=STAGE) S BGCOLOR="background-color:white" I $G(STAGE)'="",IND=STAGE S BGCOLOR="background-color:white" Q "style="""_$S($G(IND)=0:"color:red;",1:"")_"cursor:pointer;border:double 3px brown;"_BGCOLOR_""" " ; ; TBCODE(%REPN) ; N (JB,%ARG,%REPN,STAGE) ; D GREP ; Q:$G(%REPN)="" W "
",! W "",! W "" W "" W "" W "" W "" W "" W "" W "" ;W "" W "" W "",! ; S COD=$G(@GREP@(%REPN,"COD")) S GLOB2=$G(@GREP@(%REPN,"GLOB2")) ; F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" Q:$E(A)="x" S COLPR=I D .N PRM .W "",! .S PRM=$G(@GREP@(%REPN,0,A)) .W "" .W "",!; -- FIELD NAME .W "",! .S TYP=$S($P(PRM,";",2)["H":"H",$P(PRM,";",2)["D":"D",$P(PRM,";",2)["N":"N",1:"E") .W "",! .;;I ","_$P($P(GLOB2,")"),"(",2)_","[(","_A_",") S @GREP@(%REPN,0,A,"SET")=1 .W "",! .W "",! .W "",! .;;W "",! .W "",! .W "",! W "
" W $$H2U^%L1FRM("[lbp`] dcy cew") W "" W $$H2U^%L1FRM("zixara dcy my") W "" W $$H2U^%L1FRM("dcy jxe`") W "" W $$H2U^%L1FRM("dcy beq") W "" W $$H2U^%L1FRM("yetigl laelb") W "" W $$H2U^%L1FRM("dpyn dcy") W "" W $$H2U^%L1FRM("dpyn dcyl qtn`n zcewt") W "" ; W $$H2U^%L1FRM("d zli`y") ;W "" W $$H2U^%L1FRM("hq") W "
" . W $$INP(A,I_"_1","8L") .W ""_$$INP($$H2U^%L1FRM($P(PRM,";")),I_"_2","16R")_""_$$INP(+$P(PRM,";",2)_$S($P(PRM,";",2)[".":".",1:""),I_"_3","3R","S")_"" . W "",! .W ""_$$INP($$GL4($G(@GREP@(%REPN,0,A,"FILE"))),I_"_5","9L")_""_$$INP($G(@GREP@(%REPN,0,A,"OUT")),I_"_6","8L")_""_$$INP($S($D(^("M2")):^("M2"),1:""),I_"_7","30L")_""_$$INP($G(^("SH"),1),I_"_8","B")_""_$$INP($G(^("SET")),I_"_9","B")_"
",! W "

",! D ^W4SBMBCK W "
",! Q ; ; TBNUM(%REPN) ; N (JB,%ARG,%REPN,STAGE) ; D GREP ; Q:$G(%REPN)="" W "
",! W "",! W "" W "" W "" W "" W "" W "" W "",! ; S COD=$G(@GREP@(%REPN,"COD")) S GLOB2=$G(@GREP@(%REPN,"GLOB2")) ; W "

",! ; S COD=@GREP@(%REPN,"COD") K ^MBG($P) S COLPR=0 F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" Q:$E(A)="x" S COLPR=I Q:COLPR'<$L(COD,"*") ; S JJ=0 F I=COLPR+1:1:$L(COD,"*") S JJ=JJ+1 N MAX S MAX=JJ ; S JJ=0 F I=COLPR+1:1:$L(COD,"*") S A=$P(COD,"*",I) Q:A="" D .W "" .N PRM .S PRM=$G(@GREP@(%REPN,0,A)) .S JJ=JJ+1 .W "" . W "" . W "" . W "" . W "" .W "",! W "
" W $$H2U^%L1FRM("zixara my") W "" W $$H2U^%L1FRM("jxe`") W "" W $$H2U^%L1FRM("dcewp ixg`") W "" W $$H2U^%L1FRM("mekiq oniq") W "" W $$H2U^%L1FRM("n""rn oniq") W "
" .W JJ_$$NBSP^%L1FRM(3) . D .. W "1 D ... W " value=""cp"" " ... W " onClick=""CopyLine("_JJ_")"" " .. W "/>",! . . W $$INP($$H2U^%L1FRM($P(PRM,";")),JJ_"_1","16R")_""_$$INP(+$P(PRM,";",2),JJ_"_2","2C","S")_""_$$INP(+$P($P(PRM,";",2),",",2),JJ_"_3","1C","S")_""_$$INP($P($G(@GREP@(%REPN,"SIK")),"*",JJ),JJ_"_4","B")_""_$$INP($P($G(@GREP@(%REPN,"MAM")),"*",JJ),JJ_"_5","B")_"
",! ; W "

 

",! D ^W4SBMBCK W "
",! Q ; ; TBCOM(%REPN) ; N (JB,%ARG,%REPN) I $G(%REPN)="" Q D DEFGL(%REPN) S %GLOB2=GLFIN ; F II=1:1:$L(%GLOB2,",") S GLOB=$P(%GLOB2,",",1,II) Q:GLOB="" S:GLOB'[")" GLOB=GLOB_")" D .W "

"_GLOB_"
",! .S VL=$G(@GREP@(%REPN,"US",II)) .S VL=$$RPL^%L1FRM(VL,"""",""") .W "" .W $$NBSP^%L1FRM(2) .W "",! .W "

",! .W "

",! ; W "

 

",! D ^W4SBMBCK Q ; ; DEFGL(REPN) ; D GREP S GLSTART=$$GL4($G(@GREP@(REPN,"GLOB1"))) S GLFIN=$$GL4($G(@GREP@(REPN,"GLOB2"))) S VARLIST=$G(@GREP@(REPN,"COD")) S REPNAME=$G(@GREP@(REPN)) S REPNAME=$$CNWEB^%L1FRM(REPNAME) S PREPPROG=$G(@GREP@(REPN,"MIUN","PROG")) Q ; GL4(GL) ; I $G(GL)="" Q "" Q $$GL4^%W1PCZ(GL) ; GL2(GL) ; I $G(GL)="" Q "" Q $$GL2^%W1PCZ(GL) ; GREP ; S GREP="^[$$^W3MAIN]W1REP(""H"")" S GREPBG="^[$$^W3MAIN]W1REP(""H""," Q ; INP(VL,IND,LN,PRSEL) ; N ST I $G(LN)="B" D Q ST .S ST="" ; I '$G(LN) S LN=8 N STYLE S STYLE="" N ALGN S ALGN=$E(LN,$L(LN)) S STYLE=$S(ALGN="R":"text-align:right",ALGN="C":"text-align:center",ALGN="L":"text-align:left",1:"") I '$G(LN) S LN=5 S ST="" Q ST ; ; SAVE(PRM) ; S DLM1="<>",DLM2="~" S %REPN=$P(PRM,DLM1) S STAGE=$P(PRM,DLM1,2) ; I STAGE=1 D SAVE1(PRM) I STAGE=2 D SAVE2(PRM) I STAGE=4 D SAVE4(PRM) Q 1 ; ; SAVE1(PRM) ; N (JB,%ARG,PRM) D GETSVPRM Q:$G(%REPN)="" Q:$G(PRM)="" ; F I=1:1:$L(PRM,DLM1) D .S ST=$P(PRM,DLM1,I) Q:ST="" .S A=$P(ST,DLM2) Q:A="" K @GREP@(%REPN,0,A) .S @GREP@(%REPN,0,A)=$$HB($P(ST,DLM2,2))_";"_$P(ST,DLM2,3)_$S($P(ST,DLM2,4)="H":"H",$P(ST,DLM2,4)="D":"D",$P(ST,DLM2,4)="N":"N",1:"") .I $P(ST,DLM2,5)'="" S @GREP@(%REPN,0,A,"FILE")=$$GL2($S($P(ST,"~",5)'["^"&($E($P(ST,"~",5))'="+"):"^",1:"")_$P(ST,"~",5)) .I $P(ST,DLM2,6)'="" D S:$P(ST,DLM2,7)'="" @GREP@(%REPN,0,A,"M2")=$P(ST,DLM2,7) S:$P(ST,DLM2,9)'="" @GREP@(%REPN,0,A,"SET")=$P(ST,DLM2,9) Q ..S @GREP@(%REPN,0,A,"OUT")=$P(ST,DLM2,6) ..S OUT($P(ST,DLM2,6))="" .I $P(ST,DLM2,7)'="" S @GREP@(%REPN,0,A,"M2")=$P(ST,DLM2,7) .;;I $P(ST,DLM2,8)'="" S @GREP@(%REPN,0,A,"SH")=$P(ST,DLM2,8) .S @GREP@(%REPN,0,A,"SH")=1 .I $P(ST,DLM2,9)'="" S @GREP@(%REPN,0,A,"SET")=$P(ST,DLM2,9) ; D SETFLD(%REPN,VARLIST) Q ; ; SAVE2(PRM) ; N (JB,%ARG,PRM) D GETSVPRM Q:$G(%REPN)="" Q:$G(PRM)="" S DLM3="*" ; F I=1:1:$L(PRM,DLM1) D .S ST=$P(PRM,DLM1,I) S A="x"_I K @GREP@(%REPN,0,A) .S @GREP@(%REPN,0,A)=$$HB($P(ST,DLM2))_";"_$P(ST,DLM2,2)_","_$P(ST,DLM2,3) .S $P(@GREP@(%REPN,"SIK"),DLM3,I)=$P(ST,DLM2,4) .S $P(@GREP@(%REPN,"MAM"),DLM3,I)=$P(ST,DLM2,5) Q ; ; SAVE4(PRM) ; N (JB,%ARG,PRM) D GETSVPRM Q:$G(%REPN)="" Q:$G(PRM)="" ; F II=1:1:$L(PRM,DLM1) D .S @GREP@(%REPN,"US",II)=$P(PRM,DLM1,II) Q ; ; SEL(TYP1,TYP2) ; I TYP1=TYP2 Q "selected=""selected"" " Q "" ; D(REPN) ; N GREP,GREPBG I $G(REPN)="" Q 0 D GREP Q $D(@GREP@(REPN)) ; ; SETHD(PRM) ; N (JB,%ARG,PRM) S REPN=$$GET^%W1PRM("W1PCZREPN") I REPN="" Q "NOTREPN" D GREP S GLSTART=$P(PRM,"~") S GLFIN=$P(PRM,"~",2) S VARLIST=$P(PRM,"~",3) S PREPPROG=$P(PRM,"~",4) S REPNAME=$$HB($P(PRM,"~",5)) ; S @GREP@(REPN,"GLOB1")=GLSTART S @GREP@(REPN,"GLOB2")=GLFIN S @GREP@(REPN,"COD")=VARLIST S @GREP@(REPN)=$G(REPNAME) S @GREP@(REPN,"MIUN","PROG")=PREPPROG ; S ST="" F I=1:1:$L(VARLIST,"*") S VAR=$P(VARLIST,"*",I) Q:VAR?1"x"1N.N D .I $G(@GREP@(REPN,0,VAR,"OUT"))'="" D ..S VL=^("OUT"),OUT(VL)="" ; F I=1:1:$L(VARLIST,"*") S VAR=$P(VARLIST,"*",I) Q:VAR?1"x"1N.N D .I $L(VAR),'$D(OUT(VAR)) S ST=ST_VAR_"*" ; D SETFLD(REPN,VARLIST) ; S %REPN=REPN D ^%W1PCIN Q 1 ; ; SETFLD(%REPN,VARLIST) ; N I,COD,FLD S COD=VARLIST S FLD="" F I=1:1:$L(COD,"*") S A=$P(COD,"*",I) I A'="",'$D(OUT(A)) S FLD=FLD_A_"*" ;N XX S XX=$P(VARLIST,"x",2,200) ;I XX'="" S FLD=FLD_"x"_XX ;E S FLD=$E(FLD,1,$L(FLD)-1) S FLD=$E(FLD,1,$L(FLD)-1) S @GREP@(%REPN,"FLD")=FLD Q ; ; GETSVPRM ; D GREP ; S DLM1="<>",DLM2="~" ; S %REPN=$P(PRM,DLM1) Q:%REPN="" S GLOB1=$P(PRM,DLM1,3) S GLOB2=$P(PRM,DLM1,4) S VARLIST=$P(PRM,DLM1,5) S REPNAME=$P(PRM,DLM1,6) ; S @GREP@(%REPN,"GLOB1")=$$GL2(GLOB1) S @GREP@(%REPN,"GLOB2")=$$GL2(GLOB2) S @GREP@(%REPN,"COD")=VARLIST S @GREP@(%REPN)=$$HB(REPNAME) ; S PRM=$P(PRM,DLM1,7,200) ; ;;S ^AA("W1PCZ-SVPRM","REPN")=%REPN ;;S ^AA("W1PCZ-SVPRM","GLOB1")=GLOB1 ;;S ^AA("W1PCZ-SVPRM","GLOB2")=GLOB2 ;;S ^AA("W1PCZ-SVPRM","VARLIST")=VARLIST ;;S ^AA("W1PCZ-SVPRM","REPNAME")=REPNAME ;;S ^AA("W1PCZ-SVPRM","PRM")=PRM Q ; ; HB(TX) ; S TX=$$CNWEB^%L1FRM(TX) Q $$INVH^%L1FRM(TX) W1PCZQRY W1PCZQRY(%REPN) ; [ 05.08.26 20:32 ] [ 29.05.26 10:17 ] [ 22.05.26 05:24 ] N (JB,%ARG,%REPN) I $G(%REPN)="" Q N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D GREP ; S MAC=GREPBG_"%REPN,""QUERY"")" W "",! W "

",! ; S QUERY=$G(%ARG("QUERY")) D PUT^%W1PRM("W1PCZ",1) D PUT^%W1PRM("W1PCZQRY",QUERY) D ^%W1HD("!"_$$REPNAME^%W1PCS) D SETPRMQ^%W1PC(QUERY) ; I $G(%ARG("FLDLIST")) D G END .W "

",! .D QRYNAME^%W1PCS .D FLDLIST(%REPN,QUERY) ; D V0^%W1PC ; END ; Q ; ; FLDLIST(%REPN,QUERY) ; N IJK,COD,NM,FLDS S FLDS=$$FIELDS(%REPN) D GREP^W1PCZ W "",! F IJK=1:1:$L(FLDS,"*") S COD=$P(FLDS,"*",IJK) I COD'="" D .W "" .S NM=$P($G(@GREP@(%REPN,0,COD)),";") . W "" . W "" .W "",! ; N ST S ST=$G(@GREP@(%REPN,"FLD")) F IJK1=IJK+1:1:$L(ST,"*") S COD=$P(ST,"*",IJK1) I COD'="" D .W "" .S NM=$P($G(@GREP@(%REPN,0,COD)),";") . W "" . W "" .W "",! ; W "
"_$$H2U^%L1FRM(NM)_"
"_$$H2U^%L1FRM(NM)_"
",! W "

 

" D ^W4SBMBCK Q ; ; CHECKED(%REPN,QUERY,I) I $G(QUERY)="" Q " checked=""checked"" " I $G(I)="" Q "" N FLDS S FLDS=$G(@GREP@(%REPN,"QUERY",QUERY,"FLD0")) I $P(FLDS,"*",I)="-" Q "" Q " checked=""checked"" " ; ; GREP ; D GREP^W1PCZ Q ; FIELDS(%REPN) ; I $G(%REPN)="" Q "" N GREP,FLDS,SIGN D GREP N ST S ST=$G(@GREP@(%REPN,"FLD")) Q $P(ST,"*x") ; SVFLDLST(PRM) ; N ST,QRY,REPN S ST="" S REPN=$$GETP^%W1PRM("W1PCZREPN") I REPN="" Q "NOTREPN" S QRY=$P(PRM,"<>") I $L(QRY)<3 Q "NOTQRY" S QRY=$$INVH^%L1FRM(QRY) S PRM=$P(PRM,"<>",2) ;;S ^AA("W1PCZQRY-SVFLDLST","REPN")=REPN ;;S ^AA("W1PCZQRY-SVFLDLST","QRY")=QRY ;;S ^AA("W1PCZQRY-SVFLDLST","PRM")=PRM D GREP S @GREP@(REPN,"QUERY",QRY,"FLD0")=PRM Q 1 ; ; DELQUERY() N REPN,QRY S REPN=$$GETP^%W1PRM("W1PCZREPN") I REPN="" Q "NOTREPN" S QRY=$$GETP^%W1PRM("W1PCZQRY") I QRY="" Q "NOTQRY" D GREP K @GREP@(REPN,"QUERY",QRY) K @$$^%W1GLPRM@("QUERY") Q 1 ; ; SAVE(PRM) ; N (JB,%ARG,PRM) S REPN=$$GETP^%W1PRM("W1PCZREPN") I REPN="" Q "NOTREPN" D GREP S QUERY=$P(PRM,"<>") I QUERY="" Q "NOTQRY" S QUERY=$$INVH^%L1FRM(QUERY) ; S FLD0=$G(@GREP@(REPN,"QUERY",QUERY,"FLD0")) ;;S ^AA("W1PCZQRY-SAVE","QUERY")=QUERY ;;S ^AA("W1PCZQRY-SAVE","FLD0")=FLD0 ; S PRM=$P(PRM,"<>",2) S MSORT=$P(PRM,"^") S MSIK=$P(PRM,"^",2) S MCT=$P(PRM,"^",3) ; S I=0,J=0,MSORT1="" ;;S ^AA("W1PCZQRY-SAVE","MSORT")=MSORT CYC1 ; S I=I+1,J=J+1 I I>$L(MSORT,"*") D G CYC20 .;;S ^AA("W1PCZQRY-SAVE","MSORT1")=MSORT1 I $P(FLD0,"*",J)="-" S J=J+1 S $P(MSORT1,"*",J)=$P(MSORT,"*",I) G CYC1 ; CYC20 ; ;;S ^AA("W1PCZQRY-SAVE","MSIK")=MSIK S I=0,J=0,MSIK1="" CYC2 ; S I=I+1,J=J+1 I I>$L(MSIK,"*") D G CYC30 .;;S ^AA("W1PCZQRY-SAVE","MSIK1")=MSIK1 I $P(FLD0,"*",J)="-" S J=J+1 S $P(MSIK1,"*",J)=$P(MSIK,"*",I) ;;S ^AA("W1PCZQRY-SAVE","MSIK")=MSIK ;;S ^AA("W1PCZQRY-SAVE","MSIK1")=MSIK1 G CYC2 ; CYC30; ;;S ^AA("W1PCZQRY-SAVE","MCT")=MCT S I=0,J=0,MCT1="" CYC3 ; S I=I+1,J=J+1 I I>$L(MCT,"*") D G CYCE .;;S ^AA("W1PCZQRY-SAVE","MCT1")=MCT1 I $P(FLD0,"*",J)="-" S J=J+1 S $P(MCT1,"*",J)=$P(MCT,"*",I) G CYC3 ; CYCE ; N SORT,OKSORT S OKSORT=1 F J=1:1:$L(MSORT1,"*") D Q:'OKSORT .I $P(FLD0,"*",J)="-" Q .S SORT=+$P(MSORT1,"*",J) .I $G(MS(SORT)),MS(SORT)'=J S OKSORT=0 Q .I SORT S MS(SORT)=J ; I 'OKSORT Q "SAMESORT" ; S @GREP@(REPN,"QUERY",QUERY,"MIUN")=MSORT1 S @GREP@(REPN,"QUERY",QUERY,"SIK0")=MSIK1 S @GREP@(REPN,"QUERY",QUERY,"CT")=MCT1 Q 1 W1PRN2G W1PRN2G ; [ 19.02.20 18:23 ] [ M ^PARO=^PAR S N="" F S N=$O(^PAR(N)) Q:N="" D .S $P(^PAR(N),"**",11)="G" Q W1RDEX W1RDEX ; [ 03.12.18 06:59 ] [ D ^%L1TS S FILE="/home/gtmuser/W4PAR.SF.csv" O FILE:(READONLY:REWIND) ; K ^PARSF F U FILE R A Q:$ZEOF D .S A1=$TR(A,TS1,TS0) .U 0 W A1,! .S CD=$P(A1,",",3) Q:'CD .F J=1:1:$L(A1,",") D ..S A2=$P(A1,",",J) ..I J=2!(J=4)!(J=6) S A2=$$INVH^%L1FRM(A2) ..S ^PARSF(CD,J)=A2 C FILE W1REST W1REST ; [ 16.11.25 12:23 ] [ S SM=21704 ; S LK="" F S LK=$O(^KLF1(LK)) Q:LK="" D .S DAT="" F S DAT=$O(^KLF1(LK,"KP",DAT)) Q:DAT="" D ..S HZ="" F S HZ=$O(^KLF1(LK,"KP",DAT,"HZ",HZ)) Q:HZ="" D ...M ^KLF(LK,"KP",DAT,"HZ",HZ+SM)=^KLF1(LK,"KP",DAT,"HZ",HZ) ; S N="" F S N=$O(^P1HZ1(N)) Q:N="" M ^P1HZ(N+SM)=^P1HZ1(N) ; S DT="" F S DT=$O(^P1H1(DT)) Q:DT="" D .S N="" F S N=$O(^P1H1(DT,N)) Q:N="" D ..M ^P1H(DT,N+SM)=^P1H1(DT,N) ; S SHL="" F S SHL=$O(^P1HL01(SHL)) Q:SHL="" D .S N="" F S N=$O(^P1HL01(SHL,N)) Q:N="" D ..M ^P1HL(SHL,N+SM)=^P1HL01(SHL,N) ; S SHL="" F S SHL=$O(^P1HL011(SHL)) Q:SHL="" D .S N="" F S N=$O(^P1HL011(SHL,N)) Q:N="" D ..M ^P1HL1(SHL,N+SM)=^P1HL011(SHL,N) ; S SHL="" F S SHL=$O(^P1HL021(SHL)) Q:SHL="" D .S N="" F S N=$O(^P1HL021(SHL,N)) Q:N="" D ..M ^P1HL2(SHL,N+SM)=^P1HL021(SHL,N) ; ; TV ; ;;S SM=21704 S SM1=14912 S N="" F S N=$O(^P1HB1(N)) Q:N="" D .M ^P1HB(N+SM1)=^P1HB1(N) ; S DT="" F S DT=$O(^P1HBI1(DT)) Q:DT="" D .S N="" F S N=$O(^P1HBI1(DT,N)) Q:N="" D ..M ^P1HBI(DT,N+SM1)=^P1HBI1(DT,N) ; S SM2=6948 S N="" F S N=$O(^P1HB21(N)) Q:N="" D .S ST=^P1HB21(N) .S $P(ST,"\")=$P(ST,"\")+SM .M ^P1HB2(N+SM2)=ST ; S DT="" F S DT=$O(^P1HB2I1(DT)) Q:DT="" D .S N="" F S N=$O(^P1HB2I1(DT,N)) Q:N="" D ..M ^P1HB2I(DT,N+SM2)=^P1HB2I1(DT,N) ; W1RRNET W1RRNET(PROG,SSH) ; [ 29.12.24 12:05 ] [ 31.01.24 06:43 ] [ 30.01.24 21:11 ] N (JB,%ARG,%REM,PROG,SSH) I '$G(JB) S JB=$$^%W1SsID("W1RR") ; I $L($G(SSH)) S SSH=$$FUNC^%LCASE(SSH) D GL S GLTMP=$$^W4MAIN("TMP") S GLRR="^|$$^W3MAIN|W1RR(+$H)" ; K @GLRR,@GLTMP ; S $ZT="G ER^W1RRNET" S N=1 ; CYC S N=$O(@GL@(N)) G:N<1 ENDCYC D SNDRR(N) G CYC ENDCYC ; K @GLTMP S $ZT="",N="" Q ; ; SNDRR(N) ; ; I N<1 S N="" Q D GL S A=$G(@GL@(N,1)) S IND=$P(A,"\",7) Q:IND="" ; S REF=$P(A,"\",2) Q:REF="" Q:REF'["/w4main.jsp" I $L($G(SSH)),IND'[("ssh2"_SSH) Q S PAIL=$P(A,"\",4) Q:'PAIL S REF=$P(REF,"/",1,$L(REF,"/")-1)_"/w1rr.jsp?JB="_JB_"&PROG="_PROG U 0 W !,N_" "_IND S FLOU="/home/www2order/w1rr" C FLOU:(DELETE) S CMD="curl -s -m 25 """_REF_""" -o "_FLOU ; ZSY CMD ; I $ZSY U 0 W " -- $ZSY="_$ZSY,! Q I '$$EXIST^%L1ZOS(FLOU) U 0 W " -- FLOU NOT EXIST",! Q ; C FLOU ; O FLOU:(REWIND:READONLY) S OU="",SH=0,END=0 ; N OK S OK=0 F U FLOU R ST Q:$ZEOF D Q:END .;;U 0 W ST,! .I ST[""!(OU["") S END=1 Q ...I OU["Restored " S OK=1 I 'OK S ^|$$^W3MAIN|W1RR(+$H,"NOK",PROG,N)=IND ; C FLOU:(DELETE) Q ; ; ER ; U 0 W N_": "_$ZS,! S ^|$$^W3MAIN|W1RR(+$H,"ER",N)=$ZS_"\"_$G(IND) G CYC ; ; GL ; S GL="^|"""_$$^W3MAIN_"""|NEWCSR1" Q W1RSTG W1RSTG ; [ 05.04.26 21:35 ] [ 28.03.26 16:20 ] [ N (JB) S $ZGBLDIR="/home/gtmuser/app/mumps/mumps.gld" S $ZDIR="/home/gtmuser/app/mumps/" ; S A=$ZCMD S MEDAT=$P(A," "),ADDAT=$P(A," ",2) S DT1=$$^%L1DC(MEDAT,3) S DT2=$$^%L1DC(ADDAT,3) I '$G(JB) S JB=$$^%W1SsID("W1RSTG") F DT=DT1:1:DT2 D ^W4RSTGSN(JB,DT) W $ZD(DT,"DD.MM.YY"),! H 3 Q W1SCR W1SCR ; [ 03.05.26 11:17 ] [ 14.04.26 13:27 ] [ 26.02.26 10:18 ] N (JB,%ARG,%REM) K @$$^W4MAIN("W1SCR") D ^%W1ARG ; S SCR=$G(%ARG("SCR")) ; I $L(SCR) D .D PUT^%W1PRM("SCR",SCR) . I $G(%ARG("OPT"))="" D .I $L(SCR),$D(@$$GL@(SCR)) S %ARG("OPT")=2 Q .S %ARG("OPT")=1 ; S OPT=$G(%ARG("OPT")) ; W "",! ; W "
",! W "",! W "",! W "",! W "" W "" W "" D .N SHP S SHP=SCR_"s" .I '$D(@$$^W4GL("SHP")@(SHP)) D Q ..W "" .W "" .W "" W "",! W "
",! ; I $L($G(%ARG("SCR"))) D .I $G(%ARG("OPT"))=1 D ED(SCR) Q . .I $G(%ARG("OPT"))=2 D EDPRM(SCR) Q . .I $G(%ARG("OPT"))=4 D EDSHP(SCR) Q ; W "
",! Q ; ; ED(SCR) ; D PREP(SCR) D VRM S A="" S N="" F S N=$O(@VRM@(N)) Q:N="" I N D .S X=$G(^(N)) .S A=A_X_$C(10) ; W "
",! ; S %ARG("TXBOX")="scr" D CHN^%W1EDIT ; ;;S A=$$RPL^%L1FRM(A,"&","&") ; K %ARG("TXBOX") ; W "",! W "

",! W "
",! ; DIVBTN ; D DIVBTN^%W1EDIT Q ; ; PREP(SCR) ; N %PR,%MAC1,%MAC2,%ORD,FLAG,%PR,VRM N MAC S MAC=$$GL_"("""_SCR_""")" ; S VRM=$$^W4MAIN("VRM") K @VRM N I F I=1:1 Q:'$D(@MAC@(I)) D .S @VRM@(I)=$$H2U^%L1FRM($G(@MAC@(I))) Q ; ; VRM ; S VRM=$$^W4MAIN("VRM") Q ; ; SCR(SCR) S SCR=$$RPL^%L1FRM(SCR,"$28","(") S SCR=$$RPL^%L1FRM(SCR,"$29",")") S SCR=$$RPL^%L1FRM(SCR,"$22","""") S SCR=$$RPL^%L1FRM(SCR,"$2B","+") S SCR=$$RPL^%L1FRM(SCR,"0g","") Q SCR ; ; GETSCR(STAM) N A S A=$$GETP^%W1PRM("SCR") Q A ; ; EDPRM(SCR) ; N (JB,%ARG,SCR) N GL S GL=$$GL W "
",! W "",! S ST="" F I=1:1 Q:'$D(@GL@(SCR,I)) S ST=$G(^(I)) Q:ST["$" D EDPRM1(ST) W "
",! ; I ST["$" D .N LN S LN=0 .F I1=I+1:1 Q:'$D(@GL@(SCR,I1)) S ST=$G(^(I1)) Q:ST["$" I ST[":" S LN=$L(ST,":") .S WD=8*LN I WD>100 S WD=100 .I LN D ..W "

",! ..W "",! ..F I1=I+1:1 Q:'$D(@GL@(SCR,I1)) S ST=$G(^(I1)) Q:ST["$" D ...N J ...W "" ... I ST[":" D Q .... D EDPRM2(ST) ... ... F J=LN-2:-1:1 W "" ..W "",! .. ..I ST["$" D ...W "
 
",! ...W "

",! .. ..W "",! ..F I2=I1+1:1 Q:'$D(@GL@(SCR,I2)) S ST=$G(^(I2)) D EDPRM1(ST) ..W "
",! W "
",! Q ; ; EDPRM1(ST) N (JB,ST,SCR) I ST'["}" W ""_$$H2U^%L1FRM(ST)_"",! Q W "" S J=$L(ST,"}") W $$H2U^%L1FRM($P(ST,"}",J)) EDPRMC ; S PRM=$P($P(ST,"{",J),"}") D BTN(PRM) S J=J-1 W $$H2U^%L1FRM($P($P(ST,"}",J),"{")) I J'>1 W "",! Q G EDPRMC ; ; EDPRM2(ST) ; N GL S GL=$$GL S @GL@(SCR,"G","STG")=ST ; N J,K S K=0 F J=LN-2:-1:1 D .S K=K+1 .W "" . N SHEM S SHEM=$P(ST,":",J+1) . S @GL@(SCR,"G",K,"SHEM")=SHEM . W $$H2U^%L1FRM(SHEM) . .W "" W "",! ; S K=0 W "" F J=LN-2:-1:1 D .W "" . S K=K+1 . S BGCOLOR="lightyellow" . I $G(@$$GL@(SCR,"G","NM",K))'="" S BGCOLOR="yellow" . W "",! .W "" W "",! Q ; ; BTN(PRM) ; I $G(SCR)="" Q N LN S LN=$L(PRM)+2 N NOM S NOM=$TR(PRM," ","") Q:'NOM N BGCOLOR S BGCOLOR="lightgrey" I $G(@$$GL@(SCR,"P","NM",+NOM))'="" S BGCOLOR="white" W "",! Q ; STLBUT(OPT,I) ; I OPT=I Q "style=""background-color:yellow"" " Q "" ; GL() ; Q $$^W4GL("SCR") ; GLSHP() ; Q $$^W4GL("SHP") ; EDSHP(SCR) ; N A,N,X,SHP S SHP=SCR_"s" D PREPSHP(SHP) D VRM S A="" S N="" F S N=$O(@VRM@(N)) Q:N="" I N D .S X=$G(^(N)) .S A=A_X_$C(10) ; W "
",! ; N GLED S GLED="" S %ARG("TXBOX")="shp" D CHN^%W1EDIT ; ;;S A=$$RPL^%L1FRM(A,"&","&") ; K %ARG("TXBOX") ; W "",! W "

",! W "
",! ; D ^W4SBMBCK("SubmitShp()") Q ; ; PREPSHP(SHP) ; N %PR,%MAC1,%MAC2,%ORD,FLAG,%PR,VRM N MAC S MAC=$$GLSHP_"("""_SHP_""")" ; S VRM=$$^W4MAIN("VRM") K @VRM N I F I=1:1 Q:'$D(@MAC@(I)) D .S @VRM@(I)=$$H2U^%L1FRM($G(@MAC@(I))) Q ; DELSHP() N SCR S SCR=$$GETP^%W1PRM("SCR") I SCR="" Q "SCREEN NAME NOT DEFINED !" N SHP S SHP=SCR_"s" K @$$^W4GL("SHP")@(SHP) Q 1 W1SCRGNP W1SCRGNP ; [ 24.02.26 11:19 ] [ N (JB,%ARG,%REM,NOM,SUG) S SCR=$$GETP^%W1PRM("SCR") ; I SCR="" D Q .W "

",! . W "SCREEN NOT DEFINED !" .W "

",! ; W "
",! W "

" W $$^%W1DICT("GENERAL G-PARAMETERS") W "

" W "

",! ; W "" ; W "" W " " N GLOB S GLOB=$$GLOB W " " W "",! ; W "" W " " W " " W "",! ; W "
" W "GLOBAL" W " " W "" W "
" W "DELIMETER" W " " W "" W "
",! ; W "
",! W "
",! W "",! W "" W "" W "",! W "
" D ROUNDBUT^%W1JS("Submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green",",,,70") W "
",! W "
",! Q ; ; SUBMIT(PRM) ; N (JB,%ARG,%REM,PRM) Q ; ; GLOB(NOM) N GLOB S GLOB=$G(@$$GL@(SCR,"G","REF")) Q GLOB ; DLM() N DLM S DLM=$G(@$$GL@(SCR,"G","RZD")) Q DLM ; GL() ; Q $$^W4GL("SCR") ; ; SAVE(PRM) ; N (JB,PRM) S SCR=$$GETP^%W1PRM("SCR") I SCR="" Q "SCREEN NOT DEFINED !" ; D PRS^%L1FRM(PRM,"GLOB<<>>DLM","<<>>") I GLOB="" Q "GLOBAL NAME IS NOT DEFINED !" ; S @$$GL@(SCR,"G","REF")=GLOB S @$$GL@(SCR,"G","RZD")=DLM Q 1 W1SCRPRM W1SCRPRM(SUG,NOM) ; [ 04.06.26 09:56 ] [ 12.04.26 09:19 ] [ 09.03.26 03:56 ] N (JB,%ARG,%REM,NOM,SUG) S SCR=$$GETP^%W1PRM("SCR") ; W "
",! I SCR="" D Q .W "

",! . W "SCREEN NOT DEFINED !" .W "

",! ; I 'NOM D Q .W "

",! . W "FIELD NUMBER NOT DEFINED !" . D PUT^%W1PRM("SCRFLDNOM",NOM) .W "

",! ; W "

" W $$^%W1DICT(SUG_"-PARAMETER NUMBER")_" : "_NOM W "

" W "

",! ; W "",! ; W "" ; I SUG="G" D HEADER ; W "" W " " N NM S NM=$$NAME(NOM) W " " W "",! ; W "" W " " W " " W "",! ; W "" W " " W " " W "",! ; W "" W " " W " " W "",! ; W "" W " " W " " W "",! ; W "" W " " W " " W "",! ; ; F I=1:1:2 D .W "" .W " " .W " " .W "",! ; W "
" W "NAME" W " " W "" W "
" W "TYPE" W " " D TYPE(NOM) W "
" W "LENGTH" W " " D LENGTH(NOM) W "
" W "AFTER DOT" W " " D DR(NOM) W "
" W "OUTPUT" W " " W " " W "
" W "MUST" W " " W " " W "
" . W "MUMPS COMMAND "_I .W " " . D COMMAND(NOM,I) .W "
",! ; W "
",! W "
",! W "",! W "" W "" W "",! W "
" D ROUNDBUT^%W1JS("Submit",$$^%W1DICT("SUBMIT"),"Submit('"_SUG_"','"_NOM_"')","color:green",",,,70") W "
",! W "
",! Q ; ; SUBMIT(PRM) ; N (JB,%ARG,%REM,PRM) Q ; ; HEADER ; W "" W " " W "HEADER" W " " W " " S SHEM=$G(@$$GL@(SCR,SUG,NOM,"SHEM")) W $$H2U^%L1FRM(SHEM) W " " W "",! Q ; ; NAME(NOM) N NM S NM=$G(@$$GL@(SCR,SUG,"NM",NOM)) Q NM ; TYPE(NOM) N TYP S TYP=$G(@$$GL@(SCR,SUG,NOM,"TYP")) N I W "",! Q ; LENGTH(NOM) N LN S LN=$G(@$$GL@(SCR,SUG,NOM,"LMAX")) N I W "",! Q ; DR(NOM) N DR S DR=+$P($G(@$$GL@(SCR,SUG,NOM,"CRD")),",",5) N I W "",! Q ; CHOUT(NOM) I $D(@$$GL@(SCR,SUG,NOM,"OUTPUT")),^("OUTPUT")="" S ^("OUTPUT")=1 N OUT S OUT=$G(@$$GL@(SCR,SUG,NOM,"OUTPUT")) I OUT=1!(OUT="Y") Q "checked=""checked"" " Q "" ; CHMUST(NOM) N MUST S MUST=$G(@$$GL@(SCR,SUG,NOM,"MUST")) I MUST=1!(MUST="Y") Q "checked=""checked"" " Q "" ; COMMAND(NOM,I) N CMD S CMD=$G(@$$GL@(SCR,SUG,NOM,"MUMPS"_I)) W "",! W "",! Q ; GL() ; Q $$^W4GL("SCR") ; ; SAVE(PRM) ; N (JB,PRM) S SCR=$$GETP^%W1PRM("SCR") I SCR="" Q "SCREEN NOT DEFINED !" ; D PRS^%L1FRM(PRM,"SUG<<>>NOM<<>>NAME<<>>TYP<<>>LN<<>>DR<<>>OUT<<>>MUST<<>>CMD1<<>>CMD2","<<>>") I SUG="" Q "PARAMETER KIND IS NOT DEFINED !" I NOM="" Q "FIELD NUMBER IS NOT DEFINED !" I NAME="" Q "FIELD NAME IS NOT DEFINED !" ; S @$$GL@(SCR,SUG,"NM",NOM)=NAME S @$$GL@(SCR,SUG,"NAME",NAME)=NOM S @$$GL@(SCR,SUG,NOM,"TYP")=TYP S @$$GL@(SCR,SUG,NOM,"LMAX")=LN S @$$GL@(SCR,SUG,NOM,"OUTPUT")=OUT I OUT=1!(OUT="Y") S MUST="" S @$$GL@(SCR,SUG,NOM,"MUST")=MUST S @$$GL@(SCR,SUG,NOM,"MUMPS1")=CMD1 S @$$GL@(SCR,SUG,NOM,"MUMPS2")=CMD2 ; S $P(@$$GL@(SCR,SUG,NOM,"CRD"),",",3)=TYP S $P(@$$GL@(SCR,SUG,NOM,"CRD"),",",4)=LN S $P(@$$GL@(SCR,SUG,NOM,"CRD"),",",5)=$G(DR) Q 1 ; W1SCRSHP W1SCRSHP(%SCRN,%COLS) ; SCR --> SHP [ 26.02.26 10:55 ] [ 25.04.13 12:28 ] [ 001/19/00 3:12 PM ] N A,%ST,%I,%I1,%SHP,%FLDR,SMB1,SMB2,%ENGLISH S %SHP=%SCRN_"s" N %GLSCR S %GLSCR=$$^W4GL("SCR") N %GLSHP S %GLSHP=$$^W4GL("SHP") K @%GLSHP@(%SHP) S %FLDLR=0,%I1=0 S A=$G(@%GLSCR@(%SCRN)) S %ENGLISH=(A="E") ; F %I=1:1 Q:'$D(@%GLSCR@(%SCRN,%I)) D .S %ST=@%GLSCR@(%SCRN,%I) .I %ST["$" S %FLDLR='%FLDLR S (SMB1,SMB2)="$" D FIG Q .I %ST[":" I %FLDLR S SMB1=":" S %JJJ1=0 D:$G(@%GLSCR@(%SCRN,%I+1))[":" WW D:$G(@%GLSCR@(%SCRN,%I+1))'[":" KOT D D:$G(@%GLSCR@(%SCRN,%I+1))'[":" FP Q ..I @%GLSCR@(%SCRN,%I+1)["\" S %I=%I+1 S %ST=^(%I) S SMB1="\" D KOT Q .I %ST'["{",%ST'["}",%ST'["[",%ST'["]" D W Q .S SMB1="{",SMB2="}" D FIG1 .S SMB1="[",SMB2="]" D FIG .D W .Q Q ; ; W S %I1=%I1+1 S @%GLSHP@(%SHP,%I1)=%ST Q ; WW N %STO S %STO=%ST S %STK=":"_$P(%ST,":",2,$L(%ST,":")-1)_":" S (KAV,%ST)=$J("",$L($P(%STO,":")))_$TR($J("",$L(%STK))," ","-") D W S %ST=$TR(%STO,":","|") D W Q ; FIG N P1,P2,P3 F S P1=$F(%ST,SMB1) S:'P1 P1=1000 S P2=$F(%ST,SMB2) S:'P2 P2=1000 Q:P1+P2=2000 D .I P1(P1+2) $E(%ST,P1-2+P10)=">" Q ..I %SMBN1 S $E(%ST,P1-1)="&",$E(%ST,P2-1)=">" Q ..I %SMBN2 S $E(%ST,P2-3,P2-1)=" >",$E(%ST,P1-1,P1+$L(%SMBN2)-1)="&"_%SMBN2 Q .I %SMBN2 S $E(%ST,P2-3,P2-1)=">" .I %SMBN2 S P3=P2-$P(@%GLSCR@(%SCRN,"P",+%SMBN2,"CRD"),",",4)-1 S $E(%ST,P3,P3+$L(%SMBN2)-1)="&"_%SMBN2 Q ; KOT ; S %ST=$TR(%ST,"\",":") S %STO=%ST S %STK=":"_$P(%ST,":",2,$L(%ST,":")-1)_":" I SMB1=":",$G(@%GLSCR@(%SCRN,%I-1))'[":" S (KAV,%ST)=$J("",$L($P(%STO,":")))_$TR($J("",$L(%STK))," ","-") D W I SMB1=":" S %ST=%STO,%KG=$L(%ST,":"),%ST=$TR(%ST,":","|") D W I @%GLSCR@(%SCRN,%I+1)["\" S %ST=$TR(^(%I+1),"\","|") D W I SMB1=":" S %ST=KAV D W S %STB=$P(%STO,":")_$S(SMB1="\":" ",1:"$") S %ST="" I '%ENGLISH F %JJJ=$L(%STK,":")-1:-1:2 D CRD I %ENGLISH F %JJJ=2:1:$L(%STK,":")-1 D CRD I $E(%ST)=":" S %ST=$E(%ST,2,255) I $E(%ST,$L(%ST))'=":" S %ST=%ST_":" S %ST=%STB_%ST_$S(SMB1="\":2,1:"1") D W Q ; FP S %ST="" F %JJJ=1:1:%COLS-2 D W S %ST=$J("",$L($P(%STO,":")))_$J("",$L(%STK)) S $E(%ST,$L(%ST)-1)="$" D W S %ST=$G(KAV) D W Q ; CRD ; S %JJJ1=%JJJ1+1 S CRD=@%GLSCR@(%SCRN,"G",%JJJ1,"CRD"),LMAX=@%GLSCR@(%SCRN,"G",%JJJ1,"LMAX") I $P(CRD,",",3)="H"!($P(CRD,",",3)="E") S %ST=$$ST($TR($J("",LMAX)," ","T"),%ST) Q I $P(CRD,",",5)>0 S %ST=$$ST($J($TR($J("",$P(CRD,",",4)-$P(CRD,",",5)-1)," ",9)_"."_$TR($J("",$P(CRD,",",5))," ",9),LMAX),%ST) Q S %ST=$$ST($J($TR($J("",$P(CRD,",",4))," ",9),LMAX),%ST) Q Q ; ST(ST2,ST1) I %ENGLISH Q ST1_":"_ST2 Q ST2_":"_ST1 W1SETMS W1SETMS ; [ 27.07.26 10:48 ] [ K ^NAME1 M ^NAME1=^NAME F I=1,2 D .S $P(^LEVKVZ(I,1),"\",9)=8 .S $P(^LEVKVZ(I,1),"\",10)=10 .S $P(^LEVKVZ(I,1),"\",12)=20 ; S N="" F S N=$O(^NAME(N)) Q:N="" D .I N?5N,$P($G(^NAME(N)),"\",2)<2 S $P(^NAME(N),"\",2)=2 Q W1SHELL W1SHELL ; [ 18.01.26 08:55 ] [ 11.01.26 08:32 ] [ 05.01.24 12:55 ] N (JB,%ARG,%REM) S RZ=100 W "
",! W "",! W "",! W " " W "" W "" W "" W "
" W "Session "_JB_" [ "_$$^W4MYDVN_" ]",! W $$NBSP^%L1FRM(3) W ""_$ZD($H,"24:60")_"" W "  " D ^W4BCK W "
",! ; W "
",! ; S WD=60 N LENSZ S LENSZ=120 I $$1024^W4WDSCR S LENSZ=90 I $$^W4TABLET=2 S LENSZ=40 ; ;;S VL1="mumps -r ^%L3RI 'PROG.R'" ;;S VL2="mumps -r ^%L3GI 'GLOB.G'" ;;S VL3="unzip /home/gtmuser/ZIP -d /home/gtmuser/jsp/" ;;S VL4="find / -type f -size +100M -exec ls -lh {} \; 2>/dev/null" ;;S VL5="find . -type f | wc -l" ; W "",! S K=0 F I=1:2:RZ D .S K=K+1 .W "" . S NN=I\2+1 . W " " . W "" . W "" . W "" .W "",! .W "" .W "" . W "" .W "",! W "
"_NN_"
  
",! W "
",! Q ; CMD(PRM) ; N (JB,%ARG,%REM,PRM) D TMP K @TMP S NN=$P(PRM,";") S PRM=$P(PRM,";",2,255) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W1SHELL" D FL(NN) I $$EXIST^%L1ZOS(FL) ZSY "rm "_FL C FL:(DELETE) S CMD=$P(PRM," ") I CMD="cd"!(CMD="vi")!(CMD="top") Q "COMMAND IS NOT AVAILABLE FROM THIS PROGRAMM !" ; ZSY PRM_" >> "_FL D FL(NN) I '$$EXIST^%L1ZOS(FL) Q " " O FL:(REWIND:READONLY) S OU="" F II=1:1:1000 U FL R A Q:$ZEOF S @TMP@(II)=A C FL S:OU="" OU=" " Q "$ZSY="_$ZSY_";"_II ; FL(NN) ; S FL="/tmp/w1shell"_JB_"."_NN Q ; TMP ; S TMP=$$^W4MAIN("TMP") Q ; OU(II) N (JB,%ARG,%REM,II) D TMP S OU=$$RPL^%L1FRM($G(@TMP@(II)),"<","[OP]") S OU=$$RPL^%L1FRM(OU,">","[CL]") S O1="" F J=1:1:$L(OU) D .I $A(OU,J)<32!($A(OU,J)>126) Q .S O1=O1_$E(OU,J) Q O1 ; ER() ; Q "ERROR "_$ZS W1SRCH W1SRCH(SRCH,PAR,NM,PR) ; [ 22.06.23 11:03 ] [ 31.08.21 08:23 ] [ 06.03.17 13:57 ] N (JB,%ARG,SRCH,PAR,NM,PR) I '$L($G(SRCH)) Q 1 N SRCOK S SRCOK=0 I $$ISCODE^%L1FRM(SRCH),PAR=SRCH S SRCOK=1 G ES ; S NML="" I $G(NM)="" D .I $G(PR)="ML" S NM=$$MLNAME^W4MLPRT(PAR) Q .S NM=$$SHEM^W4P(PAR) .S NML=$$SHEML^W4P(PAR) ; ;;D PUT^%W3DEB("W1SRCH","NM=NM & SRCH=SRCH") N OK S OK=$$SRCH(NM,SRCH) I 'OK,NML'="" S OK=$$SRCH(NML,SRCH) Q OK ; ; SRCH(NM,SRCH,PR) ; S NM=$TR(NM,"-,;."," ") S SRCH=$TR(SRCH,"-,;."," ") I SRCH?1"="1N.N S SRCH=$E(SRCH,2,$L(SRCH)) I $E(SRCH,1,$L(SRCH)-1)?1N.N,$E(SRCH,$L(SRCH))="=" S SRCH=$E(SRCH,1,$L(SRCH)-1) ; I $$^%W1DIR="RTL",'$G(PR) S NM=$$INVH^%L1FRM(NM) ;;,SRCH=$$INVH^%L1FRM(SRCH) I $$^%W1DIR="LTR" S NM=$$FUNC^%UCASE(NM),SRCH=$$FUNC^%UCASE(SRCH) N SRCOK I $E(NM,1,$L(SRCH))=SRCH S SRCOK=1 G ES I (" "_NM_" ")[(" "_SRCH_" ") S SRCOK=1 G ES ; N J,OK,MF S OK=1 I SRCH?1N.N S NM=NM_" " ; F J=1:1:$L(SRCH," ") D Q:'OK .S SRCJ=$P(SRCH," ",J) .I SRCH?1N.N S SRCJ=SRCJ_" " .N FND,FND1 S FND=$F(" "_NM," "_SRCJ) I FND<1 S OK=0 Q .S FND1=FND-$L($P(SRCH," ",J)) .I $D(MF(FND1)) S FND=$F(" "_NM," "_SRCJ,MF(FND1)) I FND<1 S OK=0 Q .S MF(FND1)=FND D PUT^%W3DEB("W1SRCH","MF=[MF") S SRCOK=OK ES Q SRCOK W1SUM W1SUM ; [ 29.03.26 02:13 ] [ 28.03.26 16:46 ] [ N (JB) S $ZGBLDIR="/home/gtmuser/app/mumps/mumps.gld" S $ZDIR="/home/gtmuser/app/mumps/" ; I '$G(JB) S JB=$$^%W1SsID("W1SUM") S A=$ZCMD S MEDAT=$P(A," ") S ADDAT=$P(A," ",2) ; S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) ; D SUM^W4HSVDT(MEDT,ADDT,1) Q W1SVGL W1SVGL(ST,ER) ; [ 05.01.26 04:05 ] [ 22.10.25 15:05 ] [ N FILE,TX,I ;;S ^AA("W1SVGL-ST")=ST; *** S GLOB=$P(ST,"<<>>") S GLOB=$$RPL^%L1FRM(GLOB,"0g","") S TX=$P(ST,"<<>>",2,2000) D .I GLOB["(" S GLOB0=$P(GLOB,"(")_"0g"_"("_$P(GLOB,"(",2,20) Q .S GLOB0=GLOB_"0g" ; K @GLOB0 ; S I=0 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W1SVGL" SAVECYC S I=I+1 I I>$L(TX,"$10$") G SAVEND S T=$P(TX,"$10$",I) S T=$TR(T,$C(13,10,27,8,9),"") S T=$$CNWEB^%L1FRM(T) S IND="" I T="" G SAVECYC D .I T[")=" S IND=$P(T,")=")_")" Q .I T["=" S IND=$P(T,"=") ; D .I IND["(" S IND=$P(IND,"(")_"0g"_"("_$P(IND,"(",2,20) Q .S IND=IND_"0g" ; D .I T[")=" S CONT=$P(T,")=",2,200) Q .S CONT=$P(T,"=",2,200) ; I $E(IND)="^",$L(IND)>1 S @IND=CONT G SAVECYC ; SAVEND ; S $ZT="" D .I $E(GLOB)'="^" S GLOB="^"_GLOB .I $E(GLOB0)'="^" S GLOB0="^"_GLOB0 .K @GLOB .N GL S GL=$P(GLOB,"(") .N N S N=$P(GLOB0,"(")_"("""")" .F S N=$Q(@N) Q:N="" D ..N IND S IND=$P(N,"(",2,200) ..S @(GL_"("_IND)=$G(@N) .K @GLOB0 ; END Q ; ; ER ; W $ZS_"~"_$$GETP^%W1PRM("GLOB")_"~"_I_"~IND="_$G(IND)_"~CONT="_$G(CONT)_"~"_$H,! S @$$^W4MAIN("W1G")@(+$G(I))=$ZS_"~"_$G(I)_"~IND="_$G(IND)_"~CONT="_$G(CONT) G SAVECYC W1SVJSP W1SVJSP(ST,ER) ; [ 17.06.26 10:50 ] [ 22.10.25 10:46 ] [ 20.10.25 16:46 ] N (ST,ER) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S PROG=$P(ST,"<<>>") S TX=$P(ST,"<<>>",2,2000) ; S FILE=PROG ;;S ^AA("W1SVJSP","FILE")=FILE ; D RED1(FILE); --> S000($P) - OLD VERSION ; O FILE:(WRITE:NEWVERSION:REWIND) U FILE F I=1:1:$L(TX,"$10$") D .S T=$P(TX,"$10$",I) .S T=$TR(T,$C(13,10,27,8,9),"") .S T=$$CNWEB^%L1FRM(T) .W T,! .S ^S222($J,I)=T ; C FILE ; D SVCHN(FILE) Q ; ; SVCHN(%PR) ; ; N DIR,%PROG,DIR,%L1DIR ; S %PROG=%PR I %PR["/" S %PROG=$P(%PR,"/",$L(%PR,"/")) S %PROG=$P(%PROG,".")_".jsp" S %L1DIR=$$DIR^%L1ED(%PR) K ^UTILITY($J),^TMPS111($J) M ^UTILITY($J,1,"[ NEW ]")=^S222($J) M ^UTILITY($J,2,"[ OLD ]")=^S000($P) S ^UTILITY($J,1)="[ NEW ]" S ^UTILITY($J,2)="[ OLD ]" D ^%L2RCMP S DIR=$ZGBLDIR I %L1DIR="/usr/local/mumps/" S DIR="/usr/local/mumps/mumps.gld" M ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=^TMPS111($J) S ^[DIR]%ERGS(+$H,%PROG)=$$^%L1ZU(0) ;K ^S000($P),^S222($J),^TMPS111($J) Q ; ; RED1(%PR) ; K ^S000($P) I '$$EXIST^%L1ZOS(%PR) Q S $ZT="g RNOOPEN" S %L1DIR=$$PATHJSP^%L1WEBJS I $L(%L1DIR),%PR'["/" D .I $E(%L1DIR,$L(%L1DIR))'="/" S %L1DIR=%L1DIR_"/" .S %PR=%L1DIR_%PR c %PR o %PR:(readonly:record=2048:rewind) S $ZT="g REOF" N I,X S I=0 f u %PR r X S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") REOF ; c %PR Q W1SVPROG W1SVPROG(ST,ER) ; [ 17.06.26 10:50 ] [ 29.04.26 14:44 ] [ 22.10.25 11:04 ] N (ST,ER) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S PROG=$P(ST,"<<>>") S TX=$P(ST,"<<>>",2,2000) ; S FILE=PROG ;;S ^AA("W1SVPROG","FILE")=FILE ; D RED1(FILE); --> S000($P) - OLD VERSION ; O FILE:(WRITE:NEWVERSION:REWIND) U FILE F I=1:1:$L(TX,"$10$") D .S T=$P(TX,"$10$",I) .S T=$$RPL^%L1FRM(T,"$26$","&") .I I=1 S T=$$CHNDAT(T) .S T=$TR(T,$C(13,10,27,8,9),"") .S T=$$CNWEB^%L1FRM(T) .W T,! .S ^S222($J,I)=T ; C FILE ; D SVCHN(FILE) Q ; ; CHNDAT(T) ; N NOW S NOW=$ZD($H,"DD.MM.YY 24:60") N NEWDAT S NEWDAT="[ "_NOW_" ]" N FIRSTOLD S FIRSTOLD=$$SPA^%L1FRM($P($P(T,"[",2),"]")) N T1 I $P(FIRSTOLD," ")=$P(NOW," ") S T1=$P(T,"[")_" "_NEWDAT_$S(T["[":"["_$P(T,"[",3,5),1:"") E S T1=$P(T,"[")_NEWDAT_$S(T["[":"["_$P(T,"[",2,5),1:"") Q T1 ; ; SVCHN(%PR) ; ; N DIR,%PROG,DIR,%L1DIR ; S %PROG=%PR I %PR["/" S %PROG=$P(%PR,"/",$L(%PR,"/")) S %PROG=$P(%PROG,".") S %PROG=$TR(%PROG,"_","%") S %L1DIR=$$DIR^%L1ED(%PR) K ^UTILITY($J),^TMPS111($J) M ^UTILITY($J,1,"[ NEW ]")=^S222($J) M ^UTILITY($J,2,"[ OLD ]")=^S000($P) S ^UTILITY($J,1)="[ NEW ]" S ^UTILITY($J,2)="[ OLD ]" D ^%L2RCMP S DIR=$ZGBLDIR I %L1DIR="/usr/local/mumps/" S DIR="/usr/local/mumps/mumps.gld" M ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=^TMPS111($J) S ^[DIR]%ERGS(+$H,%PROG)=$$^%L1ZU(0) S ^[DIR]%ERGS(+$H,%PROG)=$ZROU K ^S000($P),^S222($J),^TMPS111($J) Q ; ; RED1(%PR) ; K ^S000($P) I '$$EXIST^%L1ZOS(%PR) Q S $ZT="g RNOOPEN" S %L1DIR=$$DIR^%L1ED(%PR) I $L(%L1DIR),%PR'["/" D .I $E(%L1DIR,$L(%L1DIR))'="/" S %L1DIR=%L1DIR_"/" .S %PR=%L1DIR_%PR c %PR o %PR:(readonly:record=2048:rewind) S $ZT="g REOF" N I,X S I=0 f u %PR r X S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") REOF ; c %PR Q W1SVSCR W1SVSCR(ST,ER) ; [ 04.06.26 06:33 ] [ 02.02.26 16:20 ] [ 05.01.26 04:05 ] N FILE,TX,I ;;S ^AA("W1SVSCR","GBLDIR")=$ZGBLDIR ;;S ^AA("W1SVSCR-ST")=ST; *** ;;S ^AA("W1SVSCR","MAIN")=$$^W3MAIN S SCR=$P(ST,"<<>>") S TX=$P(ST,"<<>>",2,2000) ; I '$G(JB) S JB=$$^%W1SsID("W1SVSCR") ; S I=0 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W1SVSCR" SAVECYC S I=I+1 I I>$L(TX,"$10$") G SAVEND S T=$P(TX,"$10$",I) S T=$TR(T,$C(13,10,27,8,9),"") S T=$$CNWEB^%L1FRM(T) S IND=$$^W4GL("SCR")_"("""_SCR_""","_I_")" ;;S ^AA("W1SVSCR","GBLDIR",I)=$ZGBLDIR ;;S ^AA("W1SVSCR","IND",I)=IND ;;S ^AA("W1SVSCR","JB",I)=JB ;;S ^AA("W1SVSCR","UCI",I)=$$^%W1UCI(JB) I T="" G SAVECYC S CONT=$$INVH^%L1FRM(T) S @IND=CONT G SAVECYC ; SAVEND ; S %SCRN0=SCR D SV^%L1SF(SCR) END Q ; ; ER ; W $ZS_"~"_$$GETP^%W1PRM("SCR")_"~"_I_"~IND="_$G(IND)_"~CONT="_$G(CONT)_"~"_$H,! S @$$^W4MAIN("W1SCR")@(+$G(I))=$ZS_"~"_$G(I)_"~IND="_$G(IND)_"~CONT="_$G(CONT) G SAVECYC W1SVSHP W1SVSHP(ST,ER) ; [ 26.02.26 09:56 ] [ 02.02.26 16:20 ] [ 05.01.26 04:05 ] N FILE,TX,I ;;S ^AA("W1SVSHP-ST")=ST; *** S SHP=$P(ST,"<<>>") S TX=$P(ST,"<<>>",2,2000) ; S I=0 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W1SVSHP" SAVECYC S I=I+1 I I>$L(TX,"$10$") G SAVEND S T=$P(TX,"$10$",I) S T=$TR(T,$C(13,10,27,8,9),"") S T=$$CNWEB^%L1FRM(T) S IND=$$^W4GL("SHP")_"("""_SHP_""","_I_")" I T="" G SAVECYC S CONT=$$INVH^%L1FRM(T) S @IND=CONT G SAVECYC ; SAVEND ; END Q ; ; ER ; W $ZS_"~"_SHP_"~"_I_"~IND="_$G(IND)_"~CONT="_$G(CONT)_"~"_$H,! S @$$^W4MAIN("W1SHP")@(+$G(I))=$ZS_"~"_$G(I)_"~IND="_$G(IND)_"~CONT="_$G(CONT) G SAVECYC W1T W1T ; [ 17.06.26 10:50 ] [ 02.12.25 11:57 ] [ 01.12.25 19:29 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; W "
",! D ^%W1HD("!TABLE GENERATOR") S GLNM=$G(%ARG("GLNM")) W "

",! W "

" W $$H2U^%L1FRM("MUMPS uaew")_$$NBSP^%L1FRM(2) W "" W $$NBSP^%L1FRM(2) W "",! W $$NBSP^%L1FRM(2) W "",! W $$NBSP^%L1FRM(5) W $$H2U^%L1FRM("dlah my")_$$NBSP^%L1FRM(2) W "" W "

",! W "",! W "",! W "" ; W "" ; W "" W "",! ; W "",! W "" ; W "" ; W "" W "",! W "
"_$$H2U^%L1FRM("gztn `hli`y")_$$NBSP^%L1FRM(2) W "" W ""_$$H2U^%L1FRM("gztn jxe`")_$$NBSP^%L1FRM(2) W "" W ""_$$H2U^%L1FRM("beq")_$$NBSP^%L1FRM(2) W "",! W "
"_$$H2U^%L1FRM("oezpl dzli`y")_$$NBSP^%L1FRM(2) W "" W ""_$$H2U^%L1FRM("oezp jxe`")_$$NBSP^%L1FRM(2) W "" W ""_$$H2U^%L1FRM("beq")_$$NBSP^%L1FRM(2) W "",! W "
",! ; I GLNM'="" D .W "",! .W "" . W "" . W "" . W "" . W "" . W "" . W "" .W "",! . .S RZD=$G(@$$GL(GLNM)@("RZD")) I RZD="" S RZD="\" . F N=1:1:15 D ..N A S A=$G(^(N)) ..W "" ..N VL S VL=$$H2U^%L1FRM($P(A,RZD,1)) .. W "",! .. .. S VL=$P(A,RZD,2) .. W "",! .. .. W "",! .. .. S VL=$P(A,RZD,4) .. W "",! .. .. S VL=$P(A,RZD,5) .. W "",! .. .. S VL=$P(A,RZD,6) .. W "",! .. ..W "",! .W "
"_$$H2U^%L1FRM("sqep oezp my")_""_$$H2U^%L1FRM("jxe`")_""_$$H2U^%L1FRM("beq")_""_$$H2U^%L1FRM("laelb")_""_$$H2U^%L1FRM("daeg dcy")_""_$$H2U^%L1FRM("lcgn zxixa")_"
" .. W "" .. W "" .. W "" .. W "" .. W "",! .. W "" .. W "" .. W "" .. W "" .. W "" .. W "" .. W "
",! . .W "

 

",! .D ^W4SBMBCK W "
",! Q ; ; SAVE(PRM) ; N (JB,%ARG,%REM,PRM) ;;S ^AA("W1T-SAVE","PRM")=PRM S PRMDOP=$P(PRM,"<>",2,200) S PRM=$P(PRM,"<>") S GLNM=$P(PRM,"~") I GLNM="" Q "!GLOBAL NOT DEFINED;glob" S TBNM=$$CNWEB^%L1FRM($P(PRM,"~",2)) I TBNM="" Q "TABLE NAME NOT DEFINED;tbname" S KEY=$$CNWEB^%L1FRM($P(PRM,"~",3)) I KEY="" Q "KEY NAME NOT DEFINED;key" S KEYLN=$P(PRM,"~",4) I 'KEYLN Q "MAX KEY LENGTH NOT DEFINED;keyln" S KEYSUG=$P(PRM,"~",5) S DATA=$$CNWEB^%L1FRM($P(PRM,"~",6)) I DATA="" Q "NAME OF MAIN FIELD NOT DEFINED;data" S DATALN=$P(PRM,"~",7) I DATALN="" Q "MAX LENGTH OF MAIN FIELD NOT DEFINED;dataln" S DATASUG=$P(PRM,"~",8) S RZD=$P(PRM,"~",9) I RZD="" S RZD="\" ; N GL S GL=$$GL(GLNM) S @GL=$$HB(TBNM)_RZD_$$HB(KEY)_RZD_KEYLN_RZD_$$HB(DATA)_RZD_DATALN_RZD_RZD_KEYSUG_RZD_DATASUG S @GL@("RZD")=RZD ; S ER="" F I=1:1:$L(PRMDOP,"<>") D Q:$L(ER) .S DP=$P(PRMDOP,"<>",I) .S NM=$$HB($$CNWEB^%L1FRM($P(DP,"~",1))) .S DL=$P(DP,"~",2) .S SUG=$P(DP,"~",3) .S GLOB=$P(DP,"~",4) .I (DL!(GLOB'=""))&(NM="") S ER="NAME FIELD NOT DEFINED;name"_I Q .I NM'=""&'DL S ER="LENGTH FIELD NOT DEFINED;ln"_I Q .I NM="" Q .S MUST=$P(DP,"~",5) S MUST=$S(MUST=1!(MUST="Y"):"Y",1:"N") .S DFLT=$P(DP,"~",6) .S ST=NM_RZD_DL_RZD_SUG_RZD_GLOB_RZD_MUST_RZD_DFLT .S @GL@(I)=ST ; I ER'="" Q ER Q 1 ; ; NAME(GLNM) ; I $G(GLNM)="" Q "" Q $$H2U^%L1FRM($P($G(@$$GL(GLNM)),"\")) ; KEY(GLNM) ; I $G(GLNM)="" Q "" Q $$H2U^%L1FRM($P($G(@$$GL(GLNM)),"\",2)) ; KEYLN(GLNM) ; I $G(GLNM)="" Q "" Q $P($G(@$$GL(GLNM)),"\",3) ; DATA(GLNM) ; I $G(GLNM)="" Q "" Q $$H2U^%L1FRM($P($G(@$$GL(GLNM)),"\",4)) ; DATALN(GLNM) ; I $G(GLNM)="" Q "" Q $P($G(@$$GL(GLNM)),"\",5) ; KEYSUG(GLNM,IND) ; I $G(GLNM)="" Q "" N VL S VL=$P($G(@$$GL(GLNM)),"\",7) I VL=IND Q " selected=""selected"" " Q "" ; DATASUG(GLNM,IND) ; I $G(GLNM)="" Q "" N VL S VL=$P($G(@$$GL(GLNM)),"\",8) I VL=IND Q " selected=""selected"" " Q "" ; DOPSUG(GLNM,IND,I) ; I $G(GLNM)="" Q "" N VL S VL=$P($G(@$$GL(GLNM)@(I)),"\",3) I VL=IND Q " selected=""selected"" " Q "" ; GL(GLNM) ; Q $$^W4GL("TABLs")_"("""_GLNM_""")" ; CLRKV(VL) Q $$RPL^%L1FRM(VL,"""",""") ; HB(TX) ; Q $$INVH^%L1FRM(TX) W1TMPL ; [ 20.06.22 17:23 ] [     W1TOMST W1TOMST ; [ 16.01.26 06:44 ] [ N (JB) S ^|$$^W3MAIN|W1TOMST="" S DT=+$H,SEC=$P($H,",",2) J LAB(DT,SEC) ; W "
",! W "

",! W "WAIT 20 SEC ...",! W "
",! Q ; ; ; LAB(DT,SEC) ; S $P(^|$$^W3MAIN|W1TOMST,"\")=DT_","_SEC ZSY "/home/gtmuser/app/sbin/tomstop.sh" S $P(^|$$^W3MAIN|W1TOMST,"\",3)=$ZSY H 1 ZSY "/home/gtmuser/app/sbin/tomstart.sh" S $P(^|$$^W3MAIN|W1TOMST,"\",4)=$ZSY S $P(^|$$^W3MAIN|W1TOMST,"\",2)=$H D ^W4RLD Q ; RES() ; N TSTOP,TSTART S TSTOP=$P($G(^|$$^W3MAIN|W1TOMST),"\",3) S TSTART=$P($G(^|$$^W3MAIN|W1TOMST),"\",4) ; I TSTOP=0,TSTART=0 Q "SUCCESS" Q "NOK" W1TOT W1TOT ; [ 18.05.22 17:03 ] [ 01.09.18 18:55 ] [ 09.05.09 18:26 ] N (%ARG,%REM,JB) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" 0 K (%L2MN,JB) D ^P1IN S J=0 K MM F I=1:1 S T=$T(MENU+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" zegece zezli`y " K ^W1PCPRM(JB) D WMN^%W1WEBMN(.MM,.MM1) Q 1 ; K (P1TOTI,JB,%ARG) D ^%L1C,^P1IN S %SCRN=$S($G(^PL("MATB")):"P1TOTMT",$G(^P1PRM("TOTNA")):"P1TOTNA",1:"P1TOT") S %SCVA=1 D A^%L1SC K %SCVA P1 D CA^%L1SC S TIPPS=$$TIPPS("") D P1^%L1SCSAY("TIPPS") S DAT1=$TR($$^%L1DC(P1DZ,1),"/","") S %FNAME="DAT1",FRST=1,%FNAME("END")="DAT2" D GETF^%L1SC Q:%BS S DAT01=$$^%L1DC(DAT1,3),DAT02=$$^%L1DC(DAT2,3) D 100 U 0 W *7,! S %S="l",%SAY="" X %XMSGN W *13 ;;S %GETIN="l" S %GET=" ? mcew aeyig ze`vez bivdl " D N^%L1GET K %GETIN G:$G(%TO)="END" P1 K SUMMTB S (SUMMSD,SUMMSL,SUMDLP,SUMAMSD,SUMAMSL,SUMADLP,SSOAD,SMSH,TIP1,HAVT,CASHD)=0 I %S="l" F DATT=DAT01:1:DAT02 W "." S DAT=$$^%L1DC(DATT,2) D ^P1SUM F DATT=DAT01:1:DAT02 S DAT=$$^%L1DC(DATT,2) D 101 S CASHD=$$^P1SUMV(DAT01,DAT02) D 102 D A^%L1SC ZP S %GETIN="",%GET=" z`vl ,4- xeciyl oikdl ,3- xenyl ,2- zegec zqtcnl ,1- dtew zqtcnl qitcdl" D N^%L1GET G:%TO="END" 1 I %S=1 S P1TOT=$S(DAT02'=DAT01:$$^%L1DC(DAT02,1)_" - "_$$^%L1DC(DAT01,1),1:$$^%L1DC(DAT02,1)) D ^P1PCTOT K P1TOT G 1 I %S'=2,%S'=3,%S'=4,%S'=97 W *7 G ZP K %L1SCPC S %L1SCPC(92)=MSDAMSL S %L1SCPC(52)=$G(SUMB) I %S=3!(%S=4) D .N OTB S OTB=%S .F S %GETHB="" S %GET=": dxrd #30" D N^%L1GET S HEARA=%S Q:$L(HEARA) .K %GETHB .N SUGM S @("SUGM="_%L1SUG) .I OTB=4 K %L1SCPC("SND") D Q:'$G(%L1SCPC("SND")) ZM ..S %GET=": fkxnl xeciyl oikdl ++13,60,HH,,R#++4,E,I++++++^MRKZ\\\\VP" D ^%L1GET Q:%S=""!(%TO="END") ..S %L1SCPC("SND")=%S I %L1SCPC("SND")=$$^%L1MRK S %SAY=" ! jnvrl xcyl mrh oi` " X %XMSGV(1) G ZM ..S %L1SCPC("SND","ARX")=$G(^SCR(%SCRN,"NAME"))_"\"_SUGM_"\"_HEARA .I OTB=3 K %L1("ARX") S %L1SCPC("ARX")=$G(^SCR(%SCRN,"NAME"))_"\"_SUGM_"\"_HEARA .S %L1SCPC("USTR")=54,USTR=3 I %S=97 D .S %L1SCPC("EXCEL")="itqk g""ec" .;S %L1SCPC("EXCEL","NOSP1")="" .S %L1SCPC("EXCEL","FRM")="" .S %L1SCPC("EXCEL","DLM")="|" .S %L1SCPC("EXCEL","FF",1)="T,10" .S %L1SCPC("EXCEL","FF",2)="T,14" .S %L1SCPC("EXCEL","FF",3)="T,10" .S %L1SCPC("EXCEL","FF",4)="T,10" D ^%L1SCPC S %GET="" D N^%L1GET G ZP ; DAT2 ; S:DAT2?.P DAT2=DAT1 I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) S %SC("ER")=1 Q Q 100 K M S M("MZM")="F",M("CHK")="G",M("VIZ")="V2",M("ISR")="V1",M("DNR")="V3",M("AEX")="V4",M("JCB")="V5",M("ALPHA")="V6" S M("CHKO")="GO",M("CHKM")="GM" S M("ASR")="H",M("HTK")="D",M("TL")="Z",M("HTL")="ZD" S M("HMZM")="FD",M("HCHK")="GD",M("HVIZ")="V2D",M("HISR")="V1D" S M("HDNR")="V3D" S M("HAEX")="V4D" S M("HJCB")="V5D" S M("HALPHA")="V6D" S M("HCHKM")="GDM",M("HCHKO")="GDO" S M("HNHS")="MIN",M("DMSHS")="DMSH" S M("HNHT")="MINT" S M("HNHCIB")="CIBHN" S M("HNHS2")="MIN2" S M("MIN3")="MIN3" S M("BIT")="BIT" S M("TIP")="T" S N="" F S N=$O(M(N)) Q:N="" K @N S @N=0 Q ;---------------------------------------------------------------- 101 S GLBL=$S(MRK:"^TOT(DAT,MRK)",1:"^TOT(DAT)") 1011 F EMT="MZM","CHK","CHKM","CHKO","VIZ","ISR","DNR","AEX","JCB","ALPHA","ASR","TL","DMSHS","HNHS","HNHS2","HNHT","HNHCIB","MIN3","BIT","TIP" D .S @EMT=$J($G(@EMT)+$G(@GLBL@(M(EMT),1)),2,2) .S @EMT@("S")=$J($G(@EMT@("S"))+$G(@GLBL@(M(EMT)_"S",1)),2,2) .S @EMT@("L")=$J($G(@EMT@("L"))+$G(@GLBL@(M(EMT)_"L",1)),2,2) F EMT="CHK","CHKM","CHKO","VIZ","ISR","DNR","AEX","JCB","ALPHA","ASR","TL" D .S @EMT@(1)=$J($G(@EMT@(1))+$G(@GLBL@(M(EMT)_"#",1)),2,2) .S @EMT@("S1")=$J($G(@EMT@("S1"))+$G(@GLBL@(M(EMT)_"S1",1)),2,2) .S @EMT@("L1")=$J($G(@EMT@("L1"))+$G(@GLBL@(M(EMT)_"L1",1)),2,2) F EMT="HMZM","HCHK","HVIZ","HISR","HDNR","HAEX","HJCB","HALPHA","HCHKM","HCHKO","HTL" S @EMT=$J($G(@EMT)+$G(@GLBL@(M(EMT),1)),2,2) F EMT="HCHK","HVIZ","HISR","HDNR","HAEX","HJCB","HALPHA","HCHKM","HCHKO","HTL" S @EMT@(1)=$J($G(@EMT@(1))+$G(@GLBL@(M(EMT)_"#",1)),2,2) N SHUMDAY S SHUMDAY=0 F EMT="MZM","CHK","VIZ","ISR","DNR","AEX","ALPHA" D .S SHUMDAY=SHUMDAY+$G(@GLBL@(M(EMT),1)) S SHUMDAY=SHUMDAY-$S('$$^P1TIPMIN:0,1:$G(@GLBL@("T",1))) S MAMD=$$MAMD^P1L($$^%L1DC(DAT,4)) S MAMS=$G(MAMS)+(SHUMDAY*MAMD/(100+MAMD)) ; I $G(^PL("MATB")) S CHKO=$G(CHKO)+$G(CHKM) S CHKM=0 I $G(^PL("MATB")) S HCHKO=$G(HCHKO)+$G(HCHKM) S HCHKM=0 ;;S TIPPS=$G(^P1PRM("TIPPS"),"mitih") Q 102 ;--------------------------------------------------------------- S SCA=$J(VIZ+ISR+DNR+AEX+JCB+ALPHA,2,2) S SCA(1)=$J(VIZ(1)+ISR(1)+DNR(1)+AEX(1)+JCB(1)+ALPHA(1),2,2) ;;I $G(^P1PRM("TIPNO")) S MZM=MZM-TIP I '$G(^P1PRM("TOTNA")) S SHUM=$J(MZM+CHKM+CHKO+SCA+ASR-$S('$G(^P1PRM("TIPNT")):0,1:TIP),2,2) E S SHUM=$J(MZM+CHKM+CHKO+SCA-$S('$G(^P1PRM("TIPNT"))!$G(^P1PRM("TIPNO")):0,1:TIP),2,2) S HSCA=$J(HVIZ+HISR+HDNR+HAEX+HJCB+HALPHA,2,2) S HSCA(1)=$J(HVIZ(1)+HISR(1)+HDNR(1)+HAEX(1)+HJCB(1)+HALPHA(1),2,2) S HSHUM=$J(HMZM+HCHKM+HCHKO+HSCA,2,2) ;;S MAMS=$J(SHUM*RMAM/(100+RMAM),2,2) S VIZS=$J(VIZ+HVIZ,2,2) S ISRS=$J(ISR+HISR,2,2) S MZMS=$J(MZM+HMZM,2,2) S TLS=$J(TL+HTL,2,2) S TIPS=$J(TIP,2,2) S CAS=$J(SCA+HSCA,2,2) S DNRS=$J(DNR+HDNR,2,2) S AEXS=$J(AEX+HAEX,2,2) S JCBS=$J(JCB+HJCB,2,2) S ALPHAS=$J(ALPHA+HALPHA,2,2) S CHKS=$J(CHKO+HCHKO,2,2) S CHKMS=$J(CHKM+HCHKM,2,2) ;;S SHUMS=$J(SHUM+HSHUM-ASR,2,2) S SHUMS=$J(SHUM+HSHUM,2,2) I '$G(^P1PRM("TOTNA")) S SHUMS=$J(SHUMS-ASR,2,2) S ASRS=$J(ASR,2,2) I '$D(P1PCTOT) S HNHS=$J(HNHS+HNHS2-$G(HNHT)-$G(HNHCIB),2,2) S SMHIRA=$J(SHUM+TL,2,2) S SUMP=$J(SHUM+TL+$G(HNHS)+$G(HNHCIB)+$G(HNHT)+$G(MIN3)-$G(DMSHS)-$S('$G(^P1PRM("TIPNT")):TIP,1:0),2,2) I $G(^P1PRM("TOTNA")) S SUMP=$J(SUMP+ASR,2,2),SMHIRA=$J(SMHIRA+ASR,2,2) S SUMB=$J(SUMP+$G(BIT),2,2) ;;I $G(^P1PRM("TIPNT")) S SUMB=SUMB+TIP I $G(^P1PRM("BRTDM")) S SUMB=SUMB+$G(DMSHS)+$G(TIP) I $G(^P1PRM("TIPNO")) S (TIP,TIPS,TIP1,TIPPS1)="" I $G(^P1PRM("TIPNT")) S TIP1="",TIPPS1="" I '$G(^P1PRM("TIPNT")) S TIPPS="",TIPPS1=$$TIPPS("") S:TIP TIP1=TIP S (TIP,TIPS)=0 S MSDMSL="" I $G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")),MISHL D S MSDMSL=$$SPR^%L1FRM(MSDMSL) .I SUMDLP S MSDMSL=MSDMSL_$J(SUMDLP,8,2)_" : wtlc ehp oeict " .S MSDMSL=MSDMSL_$J(SUMMSL,8,2)_" : migelyn ehp oeict " .S MSDMSL=MSDMSL_$J(SUMMSD,8,2)_" : dcrqn ehp oeict " S MSDAMSL="" I $G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")),MISHL D S MSDAMSL=$$SPR^%L1FRM(MSDAMSL) .I SUMADLP S MSDAMSL=MSDAMSL_$J(SUMADLP,8,2)_" : wtlc ly dtwd " .S MSDAMSL=MSDAMSL_$J(SUMAMSL,8,2)_" : migelyn ly dtwd " .S MSDAMSL=MSDAMSL_$J(SUMAMSD,8,2)_" : dcrqn ly dtwd " S SMSL="" I MISHL S SMSL=SMSH_" migelyn 'qn" I $G(^PL("MATB")) D .N N,I,SHAAR .S N="",I=0 ;;S MTB01="g""y",MTB1=$J(MZMS-SUMMTB,7,2)_$J("",15) .S SMTB=MZMS .F S N=$O(SUMMTB(N)) Q:N="" D ..S I=I+1 S @("MTB0"_I)=$P($G(^P1SUGM(N)),"\",2) ..S SHAAR=1 I $G(SUMMTB(N)) S SHAAR=$P(SUMMTB(N),"!",2)/SUMMTB(N) ..S @("MTB"_I)=$J(SUMMTB(N)*SHAAR,8,2)_"="_$J(SHAAR,8,4)_"*"_$J(SUMMTB(N),6,1) .S I=I+1,@("MTB0"_I)="g""y",@("MTB"_I)=$J(MZMS-$G(SUMMTB),8,2)_$J("",16) Q 3 D ^P1S Q 4 D ^P1DP Q 5 D ^P1DL Q 6 D Q .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C,^P1IN .;;D 1^P1DHB .D ^P1HBMK 7 D ^P1MLZ Q 8 X %chista S %GET=":jix`z++3,70,HH#"_" "_$E($TR($$^%L1DC($H,1),"/.",""),3,6)_"++8,D,I" D ^%L1GET Q:%S=""!($G(%TO)="END") S (DAT,DATJ)=%L1DAT,DAT1=%L1DAT1 P10 S (SUMA,SUMT,SUMS)=0 K ^VRMS($J) S DATH=$$^%L1DC(DAT,4) I 'DATH S %SAY=" ! d`iby " X %XMSGV(1) G P1 D P11^P1S S MEK="wzrd" S SGIRATJOM="" D DJ^P1S K SGIRATJOM Q 9 D INIT^P1KL,M1^P1KL Q 10 ;;S DAT1=$$^%L1DC(P1DZ,1),DAT01=$$^%L1DC(DAT1,2) S %SCRN="P1AVD",(%SCVA,%SCVG)=1 D A^%L1SC K %SCVA,%SCVG S %FNAME="",FRST=1 ;;D GETF^%L1SC Q:%BS S DAT01=$$^%L1DC(DAT1,2) ;;D ^P1AVD Q D ^LEVTYP Q 11 D ^P1DTM Q 12 D Q .N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) D ^%L1C,^P1IN .D 1^P1DTZ 13 D ^P1DCB Q 14 D ^P1DMVC Q 15 S FIRSTTIME="" D ^P1DL K FIRSTTIME Q 16 D ^P1DMVC1 Q 17 N DATZ ;;X %chista S %GET=":jix`z++3,70,HH# "_$E($TR($$^%L1DC($H,1),"/.",""),3,6)_"++8,D,I++++ - Z xtqn itl yetig " S DATZ=$$^%L1DC(P1DZ-1,1) 171 X %chista S %GET=": ( F8 - Z xtqn itl yetig ) jix`z++3,70,HH#"_$G(DATZ)_"++8,D,I" D ^%L1GET I %TO="F8" D G 171 .N %S .S %GET=": Z xtqn++5,70,HH#++5,E,I" D ^%L1GET Q:%S=""!(%TO="END") .N N S N="" F S N=$O(^Z(N)) Q:N="" I $D(^Z(N,%S)) S DATZ=$$^%L1DC(N,1) Q .I $G(DATZ)="" S %SAY=" ! wted `l "_%S_" xtqn mr Z " X %XMSGV(1) I ($G(%TO)="END")!(%S="") L Q S (DAT,DATJ)=%L1DAT,DAT1=%L1DAT1,DH=$$^%L1DC(DAT1,3) S %GET=": 2 - zegec zqtcn "_$S($G(^PLUK(%L3MYDVN,"LP"))>2:", 1 - dtew zqtcn ",1:"")_", 0 - jqn ++5,70,HH#0++1,E,I++012" D ^%L1GET G:%S=""!($G(%TO)="END") 17 I %S=1 D G 17 .N %S S %GETIN="3",%GET="4 - Y, 3 - Z ly itqk oeict wx, 2 - Z , 1 - lkd qitcdl" D N^%L1GET Q:%S=""!(%TO="END") .S %SAY=" ... dlerta zqtcn " X %XMSGN .N Z,PRZ,TXT,TXTOLD I %S>1 S Z=%S .D ^PLUINP,MDP^P1PC S SM1=4 Q:'$G(PRINT) L ^[$$^%L1GLD]pc(PRINT):2 E S %SAY=" ! xg` seqnn miqitcn " X %XMSGV(1) Q .S ZBG="" .S N="" F S N=$O(^Z(DH,N)) Q:N="" S N1="",TXT=%MDP("B")_" wzrd "_%MDP("N") D S1^P1PCMLZ F S N1=$O(^Z(DH,N,N1)) Q:N1="" D ..S TXT=^(N1) ..I $TR(TXT," ","")["-Z-" S PRZ="" K PRY ..I $TR(TXT," ","")["-X-" K PRZ,PRY ..I $TR(TXT," ","")["-Y-" K PRZ S PRY="" ..;;I $G(Z)=3,$D(PRZ),TXT["zexikn g""ec" S TXTOLD=TXT S TXT=$J("",11)_%MDP("B")_"- Z -"_%MDP("N") S PRZ=3 D S1^P1PCMLZ S TXT=TXTOLD ..I $G(Z)=3,$D(PRZ),TXT["zexikn g""ec" S PRZ=3 K ZBG ..I $G(Z)=3,$D(PRZ),TXT["ehexa k""dq" K PRZ D S1^P1PCMLZ Q ..I $G(Z)=2!($G(Z)=3),'$D(PRZ) Q ..I $G(Z)=3,$G(PRZ)'=3,'$D(ZBG) Q ..I $G(Z)=4,'$D(PRY) Q ..D S1^P1PCMLZ .I $D(^Z(DH))>9 D ^P1CUT(PRINT,%MDP("CUT")) L ; I %S=0!(%S=2) D G 17 ;---- MASAH, MADP. REHAVA .N Z,PRZ,PC I %S=2 S PC="" D ^%L1TS .I $D(PC) S %GETIN="3",%GET="3 - Z ly itqk oeict wx, 2 - Z , 1 - lkd qitcdl" D N^%L1GET Q:%S=""!(%TO="END") I %S>1 S Z=%S .N Z,PRZ I %S>1 S Z=%S .K ^TMPS111($J) S N="",I=0 S SM=24 I $$ZBIG^W4PRM S SM=0 .F S N=$O(^Z(DH,N)) Q:N="" S I=I+1,^TMPS111($J,I)=$J("",SM)_%CLI_" wzrd"_$C(27,91,48,109) S N1="" F S N1=$O(^Z(DH,N,N1)) Q:N1="" D ..S TXT=$G(^(N1)) ..I '$D(PC) D ...S TXT=$$RPL^%L1FRM($$RPL^%L1FRM(TXT,$C(27)_"W1",%CLI),$C(27)_"W0",%CCL) ...S TXT=$$RPL^%L1FRM(TXT,$C(12),$C(10,10)) ..I $TR(TXT," ","")["-Z-" S PRZ="" ..I $TR(TXT," ","")["-X-" K PRZ ..I $G(Z)=3,$D(PRZ),$TR(TXT,TSS,TS0)["zexikn g""ec" S PRZ=3 ..I $G(Z)=3,$D(PRZ),$TR(TXT,TSS,TS0)["ehexa k""dq" K PRZ S I=I+1,^TMPS111($J,I)=$J("",SM)_TXT Q ..I $D(Z),'$D(PRZ) Q ..I $G(Z)=3,$G(PRZ)'=3 Q ..S I=I+1,^TMPS111($J,I)=$J("",SM)_TXT .I $D(PC) K %L1OUT S %L1OUT("PRINTER")=3 D ^%L1OUT Q .S %HBRY="",TXT1=" - z`vl " D ^%S2VIEW K ^TMPS111($J) Q S1 ; D S1^P1PCMLZ Q 19 D ^P1DHZHB Q 20 D ^P1DMZPR Q 21 D ^P1JOM Q 22 D ^P1DHB2 Q 23 D ^P2HZGHZM Q 24 D ^P1POISKV Q 25 D ^P1DOTH Q 26 D ^P1Z Q 27 D ^P1PRHZ Q 28 D ^P1MZP Q 29 K PRMKBL D ^P1MSH Q 30 D ^P1MLZT Q 31 D ^P1MSHT Q 32 S PRMKBL=1 D ^P1MSH K PRMKBL Q 33 D ^P1HZCA Q 40 D ^P1TOTSV Q 41 D ^P1DPSV Q 42 D ^%L1REP Q 43 D ^%L1REPS Q 44 D ^P1ZMRK Q 45 S %GETIN=1 S %GET=" 2 - agexl , 1 - jxe`l g""ec qitcdl / bivdl " D N^%L1GET Q:%S=""!(%TO="END") I %S=1 D ^L2MHIRA("MHMK") Q I %S=2 D ^P1DPMRK Q 46 D ^P1JOMAN("^P1HRZ") Q 47 D ^P1YEAR Q 48 D ^KLMDSV2 Q 49 D ^P1MRKM Q 50 ; N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY) 51 K (%L2MN,JB,%ARG) D ^%L1C,^P1IN S J=0 K MM F I=1:1 S T=$T(MN+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" miiz`eeyd z""ec " S MAC="MM" D ^%L2MENU I %I=1 Q K %L1SCPC,%L2 S P1TOTI=%I D @MM1(%I) K %L2MN S:$G(P1TOTI)&'$G(^P1PRM("EXIT")) %L2MN("IND")=P1TOTI G 51 52 D ^P1DCIBML Q 53 D ^P1DOHTIP Q 56 D ^P1DSNIF Q 57 D ^P1DCIB Q 58 N P1HY S P1HY="" D ^P1MLZ Q Q 60 ; K (%L2MN,JB,%ARG) D ^%L1C,^P1IN S J=0 K MM F I=1:1 S T=$T(MNMSH+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" migelyn zegece " S MAC="MM" D ^%L2MENU I %I=1 Q K %L1SCPC,%L2 S P1TOTMSH=%I D @MM1(%I) K %L2MN S:$G(P1TOTMSH)&'$G(^P1PRM("EXIT")) %L2MN("IND")=P1TOTMSH G 60 Q ; 70 ; K (%L2MN,JB,%ARG) D ^%L1C,^P1IN S J=0 K MM F I=1:1 S T=$T(MNMSD+I) Q:T="" Q:T["Q ;" I @$P(T,";",2) S J=J+1 S MM(J)=$P(T,";",3),MM1(J)=$P(T,";",4) S MM(0)=" dcrqn zegec " S MAC="MM" D ^%L2MENU I %I=1 Q K %L1SCPC,%L2 S P1TOTMSD=%I D @MM1(%I) K %L2MN S:$G(P1TOTMSD)&'$G(^P1PRM("EXIT")) %L2MN("IND")=P1TOTMSD G 70 Q TIPPS(DUMP) I $G(^P1PRM("TIPNO")) Q "" N MIN S MIN=$S($G(^P1PRM("TIPNT")):"(-) ",1:"") I $L($G(^P1PRM("TIPPS"))) Q MIN_$G(^P1PRM("TIPPS")) Q MIN_"mitih" END K D ^%L1C Q MENU ; ;1; ~ zeillk zeg"ec ;1; itqk g"ec;1; ;1; mihixt zexikn zeg"ec;W1DP.JSP; ;1; miiz`eeyd zexikn zeg"ec;50 ;0; melyz irvn` itl zexikn z`eeyd;40; ;0; mihixt itl zexikn z`eeyd;41; ;0; miyceg itl zexikn z`eeyd;47; ;'$G(^P1PRM("NODBIT")); milehia zbvd;^P1DHNH("B"); ;'$G(^P1PRM("NODBIT"));dzxibq ixg` elheay zepnfd zniyx;^P1CTL; ;'$G(^P1PRM("NODHNH")); zegpd zbvd;^P1DHNH("H"); ;1;"0" hixt ly zexikn zbvd;^P1DHNH(0); ;1; dlaw/qn zeipeayg g"ec;6; ;0; i`xy` zepeayg g"ec;22; ;1; dtwdd zegec;9; ;1; miekif g"ec;12; ;0; zelaw g"ec;13; ;1; zery itl zeipeayge zepnfd g"ec;19; ;1; reay ini itl iyceg zexikn g"ec;21; ;1; mi-Z fekix g"ec;26; ;$G(^PLUK)["MLY";FOOD COST g"ec;56; ;1; zepnfd itl `"k g"ec;33; ;1;zewacn,zepnfd 'qn itl zegewl g"ec;5; ;1; rvana mihixt zxikn g"ec;16; ;1; rvana ekf `l cery zeipw;14; ;MISHL;~ migelyn ;99; ;MISHL; zepnfd g"ec;^P1HZHC("HZH"); ;MISHL;melyz ibeq itl migily g"ec;31; ;MISHL;(fekix) migily g"ec;29; ;MISHL;(fekix) zepnfd ilawn g"ec;32; ;$G(^P1PRM("MM"))!$G(^P1PRM("MMZZ")); zecrqn itl migelyn g"ec;^P1DMM;^P1SUMM ;MISHL; gelyn zecerz g"ec;11; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));~ dcrqn ;99; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")); (dcrqn) zepnfd g"ec;^P1HZHC("HZHM"); ;$G(^P1PRM("MSD"))&$G(^P1PRM("MLZ"));mihixte zepnfd itl mixvln g"ec;28; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));melyz ibeq itl g"ec;30; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));(fekix) mixvln g"ec;7; ;$D(^P1HY)&($G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")));(fekix) miy"ng` g"ec;58; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));'qeaiq' zegewl oecren g"ec;52; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));mitih g"ec;53; ;1;~ zepey ;99; ;1; micaer zeg"ec;10; ;1; `"k yetig;24; ;1;zxewia hxq zbvd;23; ;1; (wzrd) mei zxibq g"ec;17; ;1;zexnyn zeira g"ec;46; ;1; z"egec oeikx`;42; ;1;zexnyne mifkxn itl zeqpkd fekix;49; ;$G(^P1PRM("MRKZ"))="S";xeciyl mipken zeg"ec zbvd;43 ;$G(^P1PRM("MRKZ"))="M"; ~ mifkxndn zeg"ec fekix ;$G(^P1PRM("MRKZ"))="M"; mifkxndn Z-im fekix;44 ;$G(^P1PRM("MRKZ"))="M"; mifkxndn mihixt zexikn fekix;45 ;$G(^P1PRM("CIBUS"));'qeaiq' zegewl ly minelyz g"ec;57; Q ; MN ; ;1; d ` i v i; ;1; melyz irvn` itl zexikn z`eeyd;40; ;1; mihixt itl zexikn z`eeyd;41; ;1; miyceg itl zexikn z`eeyd;47; ;MISHL; (migelyn) zegewl itl zexikn z`eeyd;48; Q ; MNMSH ; ;1; d ` i v i; ;1; zepnfd g"ec;^P1HZHC("HZH"); ;1;melyz ibeq itl migily g"ec;31; ;1;(fekix) migily g"ec;29; ;1;(fekix) zepnfd ilawn g"ec;32; ;$G(^P1PRM("MM"))!$G(^P1PRM("MMZZ")); zecrqn itl migelyn g"ec;^P1DMM;^P1SUMM ;1; gelyn zecerz g"ec;11; Q ; MNMSD ; ;1; d ` i v i; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")); (dcrqn) zepnfd g"ec;^P1HZHC("HZHM"); ;$G(^P1PRM("MSD"))&$G(^P1PRM("MLZ"));mihixte zepnfd itl mixvln g"ec;28; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));melyz ibeq itl g"ec;30; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));(fekix) mixvln g"ec;7; ;$D(^P1HY)&($G(^P1PRM("MSD"))!$G(^P1PRM("MTAW")));(fekix) miy"ng` g"ec;58; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));'qeaiq' zegewl oecren g"ec;52; ;$G(^P1PRM("MSD"))!$G(^P1PRM("MTAW"));mitih g"ec;53; Q ; 99 Q W1UPL W1UPL(ST) ; [ 14.10.25 13:24 ] [ N (ST) S FILE=$P(ST,"<<>>") S TX=$P(ST,"<<>>",2,2000) ; O FILE:(WRITE:NEWVERSION:REWIND) U FILE F I=1:1:$L(TX,"$10$") D .S T=$P(TX,"$10$",I) .S T=$TR(T,$C(13,10,27,8,9),"") .S T=$$CNWEB^%L1FRM(T) .W T,! C FILE Q W1VERDAT W1VERDAT ; [ 07.08.25 12:01 ] [ 29.12.24 12:05 ] [ 07.01.24 16:31 ] S GL="^|"""_$$^W3MAIN_"""|NEWCSR1" K ^|$$^W3MAIN|W1VERDAT(+$H) ; S $ZT="G ER^W1VERDAT" S N=1 CYC S N=$O(@GL@(N)) G:N<1 END D .I N<1 S N="" Q .S A=$G(^(N,1)) .S REF=$P(A,"\",2) Q:REF="" Q:REF'["/w4main.jsp" .I $P(A,"\",4)'=1 Q .S REF=$P(REF,"/",1,$L(REF,"/")-1)_"/w1flp.jsp" .S FLOU="/home/www2order/w4spxflp" .;;I $$EXIST^%L1ZOS(FLOU) ZSY "rm "_FLOU .C FLOU:(DELETE) .S CMD="curl -k -s -m 25 -d'FL=/home/gtmuser/W.R' "_REF_" -o "_FLOU .; .ZSY CMD .I '$$EXIST^%L1ZOS(FLOU) S ^|$$^W3MAIN|W1VERDAT(+$H,"ER",N)="FLOU NOTEXIST" Q .I $$SIZE^%L1ZOS(FLOU)<10 S ^|$$^W3MAIN|W1VERDAT(+$H,"ER",N)="FLOU 0" Q .I $ZSY S ^|$$^W3MAIN|W1VERDAT(+$H,"ER",N)="ZSY="_$ZSY Q .I $ZSY=0 D ..U 0 W N,! ..O FLOU:(REWIND:READONLY) ..S OU="",OK=0 ..F U FLOU R ST Q:$ZEOF D Q:$L(OU) ...I ST["",! ; S DT="" F S DT=$O(@VERSION@(DT),-1) Q:DT="" D .W "Version Date "_$ZD(DT,"DD.MM,YY")_"
",! .W "",! .S N="" F S N=$O(@VERSION@(DT,N)) Q:N="" D ..S TXT=$G(^(N)) ..W " ",! ..W " ",! ..I $G(%ARG("EDIT")) D ...W " " ..I '$G(%ARG("EDIT")) D ...W $$H2U^%L1FRM(TXT) .W " ",! .W " ",! W "
",! ..W N ..W "
",! ; W "
" W "
" W "",! W "" I $$EDIT D .W "" .W "" W "" W "",! ETB ; W "
" . D ROUNDBUT^%W1JS("Submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green",",,,100") .W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
",! W "
",! Q ; SAVE(PRM) ; D PUT^%W3DEB("W1VERS-SAVE","PRM=PRM") N IND,TXT,LNG S IND=$P(PRM,";") Q:IND="" S TXT=$P(PRM,";",2) S TXT=$$CNWEB^%L1FRM(TXT) I $$^%W1LNG="H" S TXT=$$INVH^%L1FRM(TXT) S ^[$$^W3MAIN]W1VERS(DT,LNG,IND)=TXT Q W1ZEROS W1ZEROS ; [ 23.04.26 14:15 ] [ N (JB,%ARG,%REM) S P1NEWYR="" D 2^KILLZ ; S %X=^PL("PATHM") S %L1OS("NOVIEW")="" K ^TEMPo($P) D O13M^%L1OS F I=1:1 Q:'$D(^TEMPo($P,I)) S A=^(I) S NM=$$SPA^%L1FRM($E(A,1,8))_"."_$$SPA^%L1FRM($E(A,11,13)) S B=$$^%L1ZOS(2,^PL("PATHM")_NM) K ^TEMPo($P) Q W2BDIKA W3BDIKA ; [ 04.05.07 18:42 ] [ W "

",! W "
",! W "",! W "",! W " ",! W "",! W " ",! W " ",! W " ",! W " ",! W "",! W "",! W " ",! W " ",! W " ",! W "",! W " ",! W " ",! W "",! W "",! W " "_$$INP1("WCHR")_$$INP1("TERMTRANS"),! W "",! W "",! W " "_$$INP1("WCHS")_$$INP1("UNMIN"),! W "",! W "",! W " "_$$INP1("WCHC")_$$INP1("MAAS"),! W "",! W "",! W " ",! W "",! W "",! W " ",! W "",! W "",! W " ",! W "",! W "",! W " ",! W "",! W "",! W " ",! W "",! W "",! W " ",! W " ",! W "",! W "
picture"_$$INP("NORD","",10)_"
"_$$INPD("DATE")_""_$$INP("AIRLINE")_""_$$INP("FLIGHTNO")_""_$$INPT("DEPARRTM")_"
"_$$INP("SURNAME",146)_""_$$INP("INITIAL","",8)_"",! W " ",! W " "_$$INP1("MR",18),! W " "_$$INP1("MRS",18),! W " ",! W " ",! W " "_$$INP1("MISS",18),! W " "_$$INP1("MSTR",18),! W " ",! W "
",! W "
"_$$INP("TIMEJOBDET")_""_$$INP("TIMEJOBCOMP")_""_$$INP("ONOFFJET")_""_$$INP("STANDNO")_"

"_$$^%W1DICT("LANDSIDE")_"

"_$$INP("MSCP")_""_$$INP("UNGD","",6)_""_$$INP("HTLBUS")_""_$$INP("BUS","",11)_"
"_$$INP("TAXI","",3)_""_$$INP("CARHIRE")_""_$$INP("HEX","",9)_""_$$INP("LTCPBUS")_"
"_$$INP("ONWARDFLIGHT")_"
"_$$INP("COMMENTS",600)_"
"_$$INP("STAFFNO","",4)_"" W " ",! W "
"_$$INP("STAFFNAME",136)_""_$$INP("AUTHOR",136)_"
",! W "

",! W "",! W "
",! Q ; INP(NAME,WIDTH,DOP) ; I '$G(WIDTH) S WIDTH=64 I '$D(DOP) S DOP=1 Q $$^%W1DICT(NAME)_$$DOP(DOP)_"" ; INP1(NAME,WIDTH) ; I '$D(WIDTH) S WIDTH=48 Q ""_$$^%W1DICT(NAME)_"" ; INP2(NAME,WIDTH) ; I '$D(WIDTH) S WIDTH=48 Q ""_$$^%W1DICT(NAME)_"" ; INPD(NAME) ; N FLD S FLD=$$^%W1DICT(NAME)_" " S FLD=FLD_" " S FLD=FLD_" " S FLD=FLD_" " Q FLD ; INPT(NAME) ; N FLD S FLD=$$^%W1DICT(NAME)_" " S FLD=FLD_" " S FLD=FLD_" " Q FLD ; DOP(N) ; N J,SP S SP="" F J=1:1:N S SP=SP_" " Q SP W2ORDSV W2ORDSV ; [ 25.04.07 10:35 ] [ ; 1 2 3 4 5 6 7 8 9 10 D STRUCT ; D ^%W2ARG ; I 'NORD S NORD=$O(^W2ORD(99999999),-1)+1 ; 1 2 3 4 N DT S DT=$$^%L1DC(DATEdd_"."_DATEmm_"."_DATEyy,3) N ST S ST="" ; F J=1:1:$L(STRUCT,"\") D .N NM S NM=$P(STRUCT,"\",J) Q:NM'?."%"1U.E .S ST=$G(@NM)_"\" ; S ^W2ORD(NORD)=ST ; D KILL^%W2ARG Q STRUCT ; S STRUCT="DT\AIRLINE\FLIGHTNO\DEPARRTM\SURNAME\INITIAL\MR\MRS\MISS\MSTR\" ; 11 12 13 14 S STRUCT=STRUCT_"TIMEJOBDET\TIMEJOBCOMP\ONOFFJET\STANDNO\" ; 15 16 17 18 19 20 S STRUCT=STRUCT_"WCHR\TERMTRANS\WCHS\UNMIN\WCHC\MAAS\" ; 21 22 23 24 25 26 27 28 S STRUCT=STRUCT_"MSCP\UNGD\HTLBUS\BUS\TAXI\CARHIRE\HEX\LCTPBUS\" ; 29 30 31 32 33 S STRUCT=STRUCT_"ONWARDFLIGHT\COMMENTS\STAFFNO\STAFFNAME\AUTHOR" ; Q W2REST W2REST ; [ 24.06.26 16:16 ] [ D ^%L1TS K ^PARSUG01 K ^PAR01 S FILE="/home/gtmuser/lhof.csv" O FILE:(REWIND:READONLY) S GR0=100 S PAR0=2000 F D Q:$ZEOF .U FILE R A Q:$ZEOF .S A=$TR(A,TS1,TS0) .S GR1=$$INVH^%L1FRM($P(A,";")) .S NM1=$$INVH^%L1FRM($P(A,";",2)) .S MH=$P(A,";",7) Q:$E(MH)'?1N .S PAR=$O(^PAR01(999999),-1)+1 .I PAR SET MISSADOT ( TO EXAMPLE 4: - SO ) ; I $$MSDR(MSD),PSW'=$$PSW^W3MSDR(+MSD) D ERR("PASSWORDISWRONG") Q I $$MSDR(MSD) G BG ; ---- ( DVOETOCHIE - SET MSD ) ; I MSD[";" S SNIF=$P(MSD,";",2),MSD=$P(MSD,";") ;; TOCHKA S ZAP ; ; S UCI=$G(^[$$^W3MAIN]UCI(+MSD)) I UCI="" D ERR("UCINOTFOUND") Q ; I $G(^[UCI]W3PRM("PSW"))="" D ERR("PASSWORDNOTDEFINED") Q ; I PSW'=^[UCI]W3PRM("PSW") D ERR("PASSWORDISWRONG") Q ; BG S FLAG=0 ; D GETMSTR(MSD) ; --> MSTR --> MASSIV ULIC (SF) ; U 0:(NOECHO:NOWRAP) ; ;;I MSD=1 S SNIF=2 ; W "",! ; S DT0=$H-1 S DT=DT0 F S DT=$O(^[$$^W3MAIN]W3LINKD(DT)) Q:DT="" D .S HZ="" F S HZ=$O(^[$$^W3MAIN]W3LINKD(DT,HZ)) Q:HZ="" D ..S MSDORD=$G(^(HZ)) I $$THISMSD(MSDORD,MSD) D ...I $$NOAUTOSEND^W3PRM(HZ),'$D(@$$^W3ORD(HZ)@(HZ,"S")) Q ...Q:$P($G(@$$^W3ORD(HZ)@(HZ,"S")),";",2)>1 ...;;Q:$D(@$$^W3ORD(HZ)@(HZ,"DEMO")) ...Q:$D(@$$^W3ORD(HZ)@(HZ,"F"))&'$D(@$$^W3ORD(HZ)@(HZ,"HZRSD")) ;-- BYL FAX ... ...I SNIF=$G(@$$^W3ORD(HZ)@(HZ,"SNIF")) G MET ...I $$CITY^W3HZMST(HZ)["TAKEAWAY",+MSD=1 G MET ...I $$CITY^W3HZMST(HZ)["TAKEAWAY",SNIF'=$$STREET^W3HZMST(HZ) Q ...I $$CITY^W3HZMST(HZ)["TAKEAWAY",SNIF=$$STREET^W3HZMST(HZ) G MET ... ...N OKHRZ,A,CD,CDN ;----------- DLYA SF VYBOR KUDA POS-T' ...S OKHRZ=0 ...I (MSD=1) D BDKSTR(HZ,MSD) I SNIF=1,$P($G(@$$^W3ORD(HZ)@(HZ)),"~",31)'="aia` lz" Q ...I (MSD=1),SNIF=1,$P($G(@$$^W3ORD(HZ)@(HZ)),"~",31)="aia` lz",OKHRZ Q ...I (MSD=1),SNIF=2,$P($G(@$$^W3ORD(HZ)@(HZ)),"~",31)="aia` lz",'OKHRZ Q ...I (MSD=1),SNIF'=1,SNIF'=2 Q ... MET ...S @$$^W3ORD(HZ)@(HZ,"S")=$$T^%L1TIME($H)_";1" ...S $P(@$$^W3ORD(HZ)@(HZ),"~",35)=$$T^%L1TIME($H) ...S $P(@$$^W3ORD(HZ)@(HZ),"~",36)=$H ...S @$$^W3ORD(HZ)@(HZ,"CS")=$$CSS(HZ) ... ...W "",! ...W ""_HZ_"",! ...W ""_$G(@$$^W3ORD(HZ)@(HZ))_"",! ... ...W "",! ...S N="" F S N=$O(@$$^W3ORD(HZ)@(HZ,N)) Q:N="" D ....W N_"||"_$G(^(N)),! ....S N1="" F S N1=$O(@$$^W3ORD(HZ)@(HZ,N,N1)) Q:N1="" D .....S A=$G(^(N1)) .....S CD=$P(A,"~",2) .....I CD,$G(^[UCI]W3TRIT(HZ,CD)) D ......S CDN=$G(^(CD)) S $P(A,"~",2)=CDN .....W N_"|"_N1_"|"_A,! ...W "",! ...W "",! ... ...S FLAG=1 ; I 'FLAG D ERR("NOTORD") G ORDEND D ERR("OK") ORDEND W "",! ; HZ2MSD ; W "",! ; S MSDTO="" F S MSDTO=$O(^[$$^W3MAIN]HZ2MSDA(MSD,MSDTO)) Q:MSDTO="" D .S HZM="" F S HZM=$O(^[$$^W3MAIN]HZ2MSDA(MSD,MSDTO,HZM)) Q:HZM="" D ..N A S A=$G(^(HZM)) I $$^%L1DC($P(A,"\",5),3)<($H-1) K ^[$$^W3MAIN]HZ2MSDA(MSD,MSDTO,HZM) Q ..I $D(^[$$^W3MAIN]HZ2MSDA(MSD,MSDTO,HZM,"SENDED")) Q ..W ""_HZM_"",! ..S ^[$$^W3MAIN]HZ2MSDA(MSD,MSDTO,HZM,"SENDED")=$H ; W "",! ; W "",! ; N DT,TO,HZM,FROMMSD S DT=$H-2 N GL2MM S GL2MM="^[$$^W3MAIN]HZ2MMA" F S DT=$O(@GL2MM@(DT)) Q:DT="" D .S FROMMSD="" F S FROMMSD=$O(@GL2MM@(DT,FROMMSD)) Q:FROMMSD="" D ..S TO="" F S TO=$O(@GL2MM@(DT,FROMMSD,TO)) Q:TO="" D ...I '$$THISMSD(TO,MSD) Q ...S HZM="" F S HZM=$O(@GL2MM@(DT,FROMMSD,TO,HZM)) Q:HZM="" D ....I $D(@GL2MM@(DT,FROMMSD,TO,HZM,"SENDED")) Q ....W ""_HZM_"",! ....S @GL2MM@(DT,FROMMSD,TO,HZM,"SENDED")=$H ; W "",! Q ; ; ERR(MSG) W ""_MSG_"",! Q ; CSS(HZW) Q $$CSS^W3RCVORD(HZW) ; BDKSTR(HZ,MSD) ; S OKHRZ=1 Q ; S OKHRZ=0 S MSD=+$G(MSD) Q:'MSD I '$D(GLORD) S GLORD=$$^W3ORD N STR S STR=$$STREET^W3HZMST(HZ,GLORD) I STR["micizr z" S OKHRZ=1 Q N JB S JB=HZ I '$D(MSTR) D GETMSTR(MSD) N INVSTR S INVSTR=$$INVH^%L1FRM($$STREET^W3HZMST(HZ,GLORD)) Q:INVSTR="" ; I $D(MSTR(INVSTR)) S OKHRZ=1 S ^[$$^W3MAIN]W3AN2ASK(HZ)=OKHRZ_";"_INVSTR Q ; THISMSD(MSDORD,MSD) ; I MSDORD=MSD&(MSD?1N.N) Q 1 I $$MSDR(MSD),$D(^[$$^W3MAIN]W3MSDR(+MSD,MSDORD)) Q 1 Q 0 ; GETMSTR(MSD) ; S MSD=+$G(MSD) Q:'MSD N UCI S UCI=$$TV^%W1UCI(MSD) S N="" F S N=$O(^[UCI]W3AZS("IS","zl `aia",N)) Q:N="" I $G(^(N))="70-20" D .N STR S STR=$$SPA^%L1FRM($P(N,":")) Q:STR="" .S MSTR(STR)="" Q ; MSDR(MSD) ; I MSD?1N.N1":" Q 1 I MSD?1N.N1"R" Q 1 Q 0 W3AN2ASK W3AN2ASK ; [ 12.07.26 16:47 ] [ 17.06.26 11:02 ] [ 30.11.20 12:05 ] N (JB,%ARG,%REM) ;;D PUT^%W3DEB("W3AN2ASK","ARG=[%ARG") ;;M ^AA("W3AN2ASK","ARG")=%ARG I '$G(%ARG("MSD")) D ERR("NOTREST") Q S MSD=%ARG("MSD") S SNIF="" ; I $G(%ARG("PSW"))="" D ERR("NOTPASSWORD") Q S PSW=%ARG("PSW") ; ;--------- MSD[":" --> SET MISSADOT ( TO EXAMPLE 4: - SO ) ; I $$MSDR(MSD),PSW'=$$PSW^W3MSDR(+MSD) D ERR("PASSWORDISWRONG") Q I $$MSDR(MSD) G BG ; ---- ( DVOETOCHIE - SET MSD ) ; I MSD[";" S SNIF=$P(MSD,";",2),MSD=$P(MSD,";") ;; TOCHKA S ZAP ; ; S UCI=$G(^[$$^W3MAIN]UCI(+MSD)) I UCI="" D ERR("UCINOTFOUND") Q ; ;;I $G(^[UCI]W3PRM("PSW"))="" D ERR("PASSWORDNOTDEFINED") Q ; ;;I PSW'=^[UCI]W3PRM("PSW") D ERR("PASSWORDISWRONG") Q ; BG S FLAG=0 ; D GETMSTR(MSD) ; --> MSTR --> MASSIV ULIC (SF) ; U 0:(NOECHO:NOWRAP) ; W "",! ; S DT0=$H-2 S DT=DT0 F S DT=$O(^[$$^W3MAIN]W3LINKD(DT)) Q:DT="" D .S HZ="" F S HZ=$O(^[$$^W3MAIN]W3LINKD(DT,HZ)) Q:HZ="" D ..S MSDORD=$G(^(HZ)) I $$THISMSD(MSDORD,MSD) D ...I $$NOAUTOSEND^W3PRM(HZ),'$D(@$$^W3ORD(HZ)@(HZ,"S")) Q ...Q:$P($G(@$$^W3ORD(HZ)@(HZ,"S")),";",2)>1 ...Q:$D(@$$^W3ORD(HZ)@(HZ,"F"))&'$D(@$$^W3ORD(HZ)@(HZ,"HZRSD")) ;-- BYL FAX ... ...;;I SNIF=$G(@$$^W3ORD(HZ)@(HZ,"SNIF")) G MET ...;;I $$CITY^W3HZMST(HZ)["TAKEAWAY",SNIF'=$$STREET^W3HZMST(HZ) Q ...;;I $$CITY^W3HZMST(HZ)["TAKEAWAY",SNIF=$$STREET^W3HZMST(HZ) G MET ...N TRH,SHAA S TRH=$$DAT^W3HZMST(HZ),SHAA=$$SHAA^W3HZMST(HZ) ...N DTHZ S DTHZ=$$^%L1DC(TRH,3) ...I DT<$H,SHAA<22&(SHAA>5) Q ...I DT<$H,DTHZ<$H,SHAA<6 Q ...N OKHRZ,A,CD,CDN ;----------- DLYA SF VYBOR KUDA POS-T' ... MET ...S @$$^W3ORD(HZ)@(HZ,"S")=$$T^%L1TIME($H)_";1" ...S $P(@$$^W3ORD(HZ)@(HZ),"~",35)=$$T^%L1TIME($H) ...S $P(@$$^W3ORD(HZ)@(HZ),"~",36)=$H ...S @$$^W3ORD(HZ)@(HZ,"CS")=$$CSS(HZ) ... ...W "",! ...W ""_HZ_"",! ...W ""_$G(@$$^W3ORD(HZ)@(HZ))_"",! ... ...W "",! ...S N="" F S N=$O(@$$^W3ORD(HZ)@(HZ,N)) Q:N="" D ....W N_"||"_$G(^(N)),! ....S N1="" F S N1=$O(@$$^W3ORD(HZ)@(HZ,N,N1)) Q:N1="" D .....S A=$TR($G(^(N1)),$C(10)," ") .....S CD=$P(A,"~",2) .....;;I CD,$G(^[UCI]W3TRIT(HZ,CD)) D ......S CDN=$G(^(CD)) S $P(A,"~",2)=CDN .....W N_"|"_N1_"|"_A,! ...W "",! ...W "",! ... ...S FLAG=1 ; I 'FLAG D ERR("NOTORD") G ORDEND D ERR("OK") ORDEND W "",! ; HZ2MSD ; W "",! ; S MSDTO="" F S MSDTO=$O(^[$$^W3MAIN]HZ2MSDA(+MSD,MSDTO)) Q:MSDTO="" D .S HZM="" F S HZM=$O(^[$$^W3MAIN]HZ2MSDA(+MSD,MSDTO,HZM)) Q:HZM="" D ..N A S A=$G(^(HZM)) I $$^%L1DC($P(A,"\",5),3)<($H-1) K ^[$$^W3MAIN]HZ2MSDA(+MSD,MSDTO,HZM) Q ..I $D(^[$$^W3MAIN]HZ2MSDA(+MSD,MSDTO,HZM,"SENDED")) Q ..W ""_HZM_"",! ..S ^[$$^W3MAIN]HZ2MSDA(+MSD,MSDTO,HZM,"SENDED")=$H ; W "",! ; W "",! ; N DT,TO,HZM,FROMMSD S DT=$H-2 N GL2MM S GL2MM="^[$$^W3MAIN]HZ2MMA" F S DT=$O(@GL2MM@(DT)) Q:DT="" D .S FROMMSD="" F S FROMMSD=$O(@GL2MM@(DT,FROMMSD)) Q:FROMMSD="" D ..S TO="" F S TO=$O(@GL2MM@(DT,FROMMSD,TO)) Q:TO="" D ...I '$$THISMSD(TO,MSD) Q ...S HZM="" F S HZM=$O(@GL2MM@(DT,FROMMSD,TO,HZM)) Q:HZM="" D ....I $D(@GL2MM@(DT,FROMMSD,TO,HZM,"SENDED")) Q ....W ""_HZM_"",! ....S @GL2MM@(DT,FROMMSD,TO,HZM,"SENDED")=$H ; W "",! Q ; ; ERR(MSG) W ""_MSG_"",! Q ; CSS(HZW) Q $$CSS^W3RCVORD(HZW) ; BDKSTR(HZ,MSD) ; S OKHRZ=1 Q ; THISMSD(MSDORD,MSD) ; I MSD[",",(","_MSD_",")[(","_MSDORD_",") Q 1 I MSDORD=MSD&(MSD?1N.N) Q 1 I $$DLVWEB^W4DLVCSR,+MSDORD=+MSD Q 0 I $$MSDR(MSD),$D(^[$$^W3MAIN]W3MSDR(+MSD,MSDORD)) Q 1 Q 0 ; GETMSTR(MSD) ; Q S MSD=+$G(MSD) Q:'MSD N UCI S UCI=$$TV^%W1UCI(MSD) S N="" F S N=$O(^[UCI]W3AZS("IS","zl `aia",N)) Q:N="" I $G(^(N))="70-20" D .N STR S STR=$$SPA^%L1FRM($P(N,":")) Q:STR="" .S MSTR(STR)="" Q ; MSDR(MSD) ; I MSD?1N.N1":" Q 1 I MSD?1N.N1"R" Q 1 Q 0 W3ANRSTG W3ANRSTG ; [ 05.07.26 11:56 ] [ 17.06.26 11:02 ] [ 21.06.23 04:51 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ;;M ^AA("W3ARSTG","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) ; F I=1:1:$L(FDB,"^") D .S A=$P(FDB,"^",I) .S DT=$P(A,"~") Q:DT="" .F I1=2:1:$L(A,"~") D ..S A1=$P(A,"~",I1) ..S SUG=$P(A1,":") Q:SUG="" ..S RES=$P(A1,":",2) ..S ^|$$^W3MAIN|W4RSTGNET(MSDR,DT,MSD,SUG)=RES Q W3ANSCLK W3ANSCLK ; [ 12.07.26 16:53 ] [ 05.07.26 11:33 ] [ 23.10.23 03:23 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSCLK","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DLM="*" ; F I=1:1:$L(FDB,"^")-1 D .S ST=$P(FDB,"^",I) .S DT=$P(ST,DLM) Q:'DT .S OV=$P(ST,DLM,2) Q:'OV .S K=$O(^[$$^W3MAIN]W4CLKNET(MSDR,DT,MSD,OV,99999),-1)+1 .S WAS=0 .N KK S KK="" F S KK=$O(^[$$^W3MAIN]W4CLKNET(MSDR,DT,MSD,OV,KK)) Q:KK="" D ..I $G(^(KK))=ST S WAS=1 .I 'WAS S ^[$$^W3MAIN]W4CLKNET(MSDR,DT,MSD,OV,K)=ST Q W3ANSFDB W3ANSFDB ; [ 05.07.26 11:33 ] [ 09.01.13 19:16 ] [ 19.06.12 12:04 ] N (JB,%ARG,%REM) ;;M ^[$$^W3MAIN]LEVDB($H)=%ARG S FDB=$G(%ARG("FDB")) I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) N I F I=1:1:$L(FDB,";") D .S ANS=$P(FDB,";",I) .S HZW=$P(ANS,":") .S HZR=$P(ANS,":",2) .I 'HZW!'HZR Q .S $P(@$$^W3ORD(HZW)@(HZW,"S"),";",2)=2 .S ^[$$^W3MAIN]W3ORDSND(HZW)=$H_";OK;;;"_HZR .;;D SNDMSH(HZW) Q ; SNDMSH(HZW) ; N MSHORD,FLMSH,CMD S FLMSH="/pos/tmp/tmpmsh"_$R(10000000) S MSHORD=$$MSHORD(HZW) ; I MSHORD D .O FLMSH:(NEWVERSION:REWIND) U FLMSH .W "url=https://www.mishloha.co.il/rashad/approve_order.php?real_order_id="_MSHORD .C FLMSH .S CMD="curl -s -k -K "_FLMSH_" -o /tmp/mshou" .S ^[$$^W3MAIN]W3CMD($O(^W3CMD(99999999),-1)+1)=CMD .ZSY CMD .ZSY "rm -f "_FLMSH Q ; MSHORD(HZW) ; N ASM S ASM=$$HZMLAK^W3HZMST(HZW) I ASM["/",$P(ASM,"/",2) S ASM=$P(ASM,"/",2) I $$MKR^W3HZMST(HZW)=12 Q ASM Q "" W3ANSGAP W3ANSGAP ; [ 05.07.26 11:34 ] [ 29.06.26 11:32 ] [ 09.06.26 16:01 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D ^%W1ARG S FDB=$G(%ARG("FDB")) ;;S ^AA("W3ANSGAP","FDB")=$E(FDB,1,2000) I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) ; S DLM="," S MKT="MSDR,MSD,DT,MHIROT,SWEB,SWEBDLV,SDLV,SREST,SMAM,SBIT,ORDQ,WEBQ,DLWEBQ,RESTQ" S MKT=MKT_",SMIN,DLVNET,BRUTTO,SDISC,STAW,TAWQ,WEBDLVWQ,WEBTAWQ" D PRS^%L1FRM(FDB,MKT,DLM) ;;S ^AA("W3ANSGAP","MSDR")=$G(MSDR) ;;S ^AA("W3ANSGAP","MSD")=$G(MSD) ; F J=31:1:$L(FDB,",") D .S MKR=$P(FDB,",",J) .S M=$P(MKR,"~") Q:'M .S MQ(M)=$P(MKR,"~",2) .S MS(M)=$P(MKR,"~",3) ; ;;S ^AA("W3ANSGAP","DT")=$G(DT) I MSDR=""!(DT="")!(MSD="") Q S H=+$H S GL="^|"""_$$^W3MAIN_"""|W4GAPNET" S @GL@(MSDR,DT,MSD)=FDB S ^|$$^W3MAIN|W4NETSND(MSDR,MSD,H,DT)=$H_"\"_$ZD($H,"DD.MM.YY 24:60") S DD="",N="" F S N=$O(^|$$^W3MAIN|W4NETSND(MSDR,MSD,H,N)) Q:N="" S DD=DD_N_"," S ^|$$^W3MAIN|W4NETSND(MSDR,MSD)=$H_"\"_$ZD($H,"DD.MM.YY 24:60")_"\"_$P(DD,",",1,$L(DD,",")-1) Q W3ANSIT W3ANSIT ; [ 31.12.23 16:15 ] [ 06.02.23 13:50 ] [ 05.01.23 18:05 ] ; -- W4PRTNET - WHAT ITEMS ACT IN EITHER BRANCH N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSIT","ARG")=%ARG I '$G(%ARG("MSD")) D ERR("NOTREST") Q S MSD=$P(%ARG("MSD"),",") S MSDR=$G(%ARG("MSDR")) ; I MSDR="" D .N N S N="" F S N=$O(^[$$^W3MAIN]W3MSDR(N)) Q:N="" I $D(^(N,MSD)) S MSDR=N Q ; I 'MSDR D ERR("NOTMSDR") Q ; D INIT^W4PRTNET ; -- 31.12.23 K @$$^W4MAIN("TMPMA") ; D WRITEIT(MSDR,MSD) Q ; ; WRITEIT(MSDR,MSD) ; N MSDF,UCI S MSDF=$O(^[$$^W3MAIN]W3MSDR(MSDR,"")) S UCI=$G(^[$$^W3MAIN]UCI(+MSDF)) I UCI="" D ERR("UCINOTFOUND") Q ; N N S FLAG=0 ; U 0:(NOECHO:NOWRAP) ; D WRITEFLIT(UCI,MSD) D WRITEFLGR(UCI,MSD) ; Q ; ; WRITEFLIT(UCI,MSD) ; W "",! ; S N="" F S N=$O(^[$$^W3MAIN]SHP("%GSPAR",N)) Q:N="" D .N GL S GL=$$SPA^%L1FRM($G(^(N))) Q:$E(GL)'?1U .N GL1 S GL1="ITSRV"_GL .N CMD .S CMD="K ^|"""_UCI_"""|"_GL1 X CMD .S CMD="M ^|"""_UCI_"""|"_GL1_"=^|"""_UCI_"""|"_GL .X CMD .N GL11 S GL11="^|"""_UCI_"""|"_GL1 .I '$D(@GL11) Q .D WR^W3G2F(GL11) ; --> SEND TO CLIENT .S FLAG=1 ; I $G(^|UCI|P1PRM("LKNETSND")) D .N GL S GL="LKH" .N GL1 S GL1="LKSRV" .N CMD .S CMD="K ^|"""_UCI_"""|"_GL1 X CMD .S CMD="M ^|"""_UCI_"""|"_GL1_"=^|"""_UCI_"""|"_GL .X CMD .N GL11 S GL11="^|"""_UCI_"""|"_GL1 .I '$D(@GL11) Q .D WR^W3G2F(GL11) ; --> SEND TO CLIENT .S FLAG=1 ; I 'FLAG D ERR("NOTGLOBALS") G ITEND D .N GL1 S GL1="ITNET" .N GL11 S GL11="^|"""_UCI_"""|"_GL1 .K @GL11 .S CMD="M ^|"""_UCI_"""|"_GL1_"=^|"""_$$^W3MAIN_"""|W4PRTNET("""_MSD_""")" .X CMD .S @GL11=MSD .M ^|UCI|ITNET0(MSD)=@GL11 .I '$D(@GL11) Q .D WR^W3G2F(GL11) ; -- SEND 2 CLIENT .S FLAG=2 ; D ERR("OK") ITEND W "",! Q ; ; WRITEFLGR(UCI,MSD) ; W "",! D .N GL1 S GL1="GRNET" .N CMD S CMD="K ^|"""_UCI_"""|"_GL1 X CMD .S CMD="M ^|"""_UCI_"""|"_GL1_"=^|"""_$$^W3MAIN_"""|W4KVZNET("""_MSD_""")" .X CMD .N GL11 S GL11="^|"""_UCI_"""|"_GL1 .I '$D(@GL11) Q .D WR^W3G2F(GL11) ; -- SEND 2 CLIENT .S FLAG=2 ; D ERR("OK") GREND W "",! Q ; ; ERR(MSG) W ""_MSG_"",! Q ; SEND(PRM) ; --- SEND 2 NET N DIR S DIR=$G(@$$^W4PRM@("IT2NET","DIR")) I DIR="" S DIR="/tmp/" N UCI,MSD S MSD=$G(@$$^W4PRM@("IT2NET","MSD")) I MSD="" S MSD=1 S UCI=$G(^[$$^W3MAIN]UCI(MSD)) I UCI="" Q "UCINOTFOUND" S FL=DIR_"w4it4net" C FL:(DELETE) O FL:(WRITE:NEWVERSION) U FL D WRITEFLIT(UCI,MSD) ; C FL ; N ADR S ADR=$G(@$$^W4PRM@("IT2NET","ADR")) I ADR="" Q "ADDRESSNOTDEFINED" N DIR2 S DIR2=$G(@$$^W4PRM@("IT2NET","DIR2")) I DIR2="" S DIR2="/tmp/" N PSW S PSW="" I $G(@$$^W4PRM@("IT2NET","PSW")) S PSW="-P 2222" N CMD S CMD="scp "_PSW_" "_FL_" "_ADR_":"_DIR2 ZSY CMD I $ZSY'=0 Q "ERROR $ZSY="_$ZSY ZSY "rm "_FL Q 1 W3ANSITS W3ANSITS ; [ 29.09.21 15:22 ] [ 11.07.21 15:27 ] [ 26.05.21 09:45 ] ; N (JB,%ARG,%REM) M ^AA("W3ANSITS","ARG")=%ARG I '$G(%ARG("MSD")) D ERR("NOTREST") Q ; S MSD=$P(%ARG("MSD"),",") S MSDR=$G(%ARG("MSDR")) ; I 'MSDR D ERR("NOTMSDR") Q ; S DIR="/tmp/" S FL=DIR_"w4it4web."_MSDR_"-"_MSD ; I $$EXIST^%L1ZOS(FL) D .O FL:(REWIND:READONLY) .F U FL R A Q:$ZEOF D ..U 0 W A,! .C FL .ZSY "rm "_FL Q ; ; ERR(PRM) ; D ERR^W3ANSIT($G(PRM)) Q W3ANSLK W3ANSLK ; [ 05.07.26 11:53 ] [ 24.11.25 09:46 ] [ 11.08.24 12:36 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSLK","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,"^") Q:'DZ ; F I=2:1:$L(FDB,"^") D .S A=$P(FDB,"^",I) .S LKR=$P(A,"~") Q:LKR="" .S LKR1=$P(A,"~",2) .S LK=$P(A,"~",3) Q:LK="" .S LK1=$P(A,"~",4) .S HZ=$P(A,"~",5) .S HV=$P(A,"~",6) .S MAZM=$P(A,"~",7) .S TEL=$P(A,"~",8) .S SUGL=$P(A,"~",9) .S SUGL1=$P(A,"~",10) . .I MSDR=""!(DZ="")!(MSD="")!(LKR="")!(LK="")!(HZ="") Q .S DTTO=DZ .I HV["\" D ..S DTTO=$P(HV,"\",2),HV=+HV .S ^[$$^W3MAIN]W4LKTN(MSDR,DZ,MSD,LKR,LK,HZ)=HV_"*"_MAZM_"*"_TEL_"*"_SUGL_"*"_SUGL1_"*"_DTTO .I $G(LK1)'="" S ^[$$^W3MAIN]W4LK(LK,MSD)=LK1 .I $G(LKR1)'="" S ^[$$^W3MAIN]W4LK(LKR,MSD)=LKR1 Q W3ANSLKM W3ANSLKM ; [ 05.07.26 11:53 ] [ 28.09.25 06:44 ] [ 26.09.25 09:17 ] N (JB,%ARG) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; M ^W3ANSLKM(+$H,$P($H,",",2),"ARG")=%ARG ; S SH=0,ST="" S DLM=$$DLM S GL=$$GL ; S FUNC=$G(%ARG("FUNC")) I FUNC="" Q S MSDR=$G(%ARG("MSDR")) I MSDR="" Q S MSD=$G(%ARG("MSD")) I MSD="" Q S FDB=$G(%ARG("FDB")) Q:FDB="" S FDB=$$CNWEB^%L1FRM(FDB) ; I FUNC="SETLKH" D .S LK=$$GET(FDB,"CODE",DLM) Q:LK="" .;;S ^AA("W3ANSLKM","ST")=ST .S ST=$$RPL^%L1FRM(FDB,"%20"," ") .S LKH1=$$GET(FDB,"LKMNAME",DLM) .;;S ^AA("W3ANSLKM","LKH1")=LKH1 .Q:LKH1?.P .D ..I '$D(@GL@(LK)) S @GL@(LK)=ST D GIB(LK) Q ..D UPD(ST,DLM,MSDR,MSD) . .S ST=$G(@GL@(LK)) .W ""_$$SP(ST)_"",! .D PROT("CUSTOMDATA",ST) ; I FUNC="GETLKH" D W $$SP(ST),! .S ST="" .S LK=$$GET(FDB,"CODE",DLM) Q:LK="" .S ST=$G(@GL@(LK)) .W ""_$$SP(ST)_"",! .D PROT("CUSTOMDATA",ST) ; I FUNC="UPD" D UPD(FDB,DLM,MSDR,MSD) ; I FUNC="SRCH" D SRCH(FDB,DLM,MSDR) Q ; ; GET(ST,RKV,DLM); I $G(DLM)="" S DLM=$$DLM N VL S ST=DLM_ST_DLM S VL=$P($P(ST,DLM_RKV_"=",2),DLM) Q VL ; GETL(LK,RKV,DLM) I $G(DLM)="" S DLM=$$DLM I $G(MSDR)="" S MSDR=$$MSDR N GL S GL=$$GL N ST S ST=$G(@GL@(LK)) Q $$GET(ST,RKV,DLM); ; GL() ; Q "^|$$^W3MAIN|WLKMNET(MSDR)" ; GL0() ; Q "^|$$^W3MAIN|WLKMNET0(MSDR)" ; ; UPD(FDB,DLM,MSDR,MSD) N (JB,%ARG,FDB,DLM,MSDR,MSD) I $G(DLM)="" S DLM=$$DLM ; S LK=$$GET(FDB,"CODE",DLM) Q:LK="" S GL=$$GL N STOLD S STOLD=$G(@GL@(LK)) S FDB=$$DELRKV(FDB,"CODE",DLM) ; F I=1:1:$L(FDB,DLM) D .S COUPL=$P(FDB,DLM,I) .S NM=$P(COUPL,"=") .S VL=$P(COUPL,"=",2) .I NM="LKMNKD" S VL0=VL,VL=+VL .S OK=0 .I NM?1U.E D ..F J=1:1:$L(STOLD,DLM) D ...S NMOLD=$P($P(STOLD,DLM,J),"=") ...I NMOLD=NM D ....S STOLD=$P(STOLD,DLM,1,J-1)_DLM_NM_"="_VL_DLM_$P(STOLD,DLM,J+1,$L(STOLD,DLM)) ....I NM="LKMNKD" D SETLKMNKD(LK,MSD,VL0) ....S OK=1 ..I 'OK S STOLD=STOLD_DLM_NM_"="_VL I NM="LKMNKD" D SETLKMNKD(LK,MSD,VL0) ; S @GL@(LK)=STOLD D GIB(LK) W ""_$$SP(STOLD)_"",! D PROT("CUSTOMDATA",STOLD) Q ; ; SRCH(FDB,DLM,MSDR) N (JB,%ARG,FDB,DLM,MSDR) I $G(DLM)="" S DLM=$$DLM S GL=$$GL ; F I=1:1:$L(FDB,DLM) D .S COUPL=$P(FDB,DLM,I) .S NM=$P(COUPL,"=") .S NM=$$SPA^%L1FRM(NM) .S VL=$P(COUPL,"=",2) .S VL=$$SPA^%L1FRM(VL) .I NM?1U.E,VL'="" S M(NM)=VL ; S ANS="" S LK="" F S LK=$O(@GL@(LK)) Q:LK="" D .S STGL=$G(^(LK)),OK=1 .F J=1:1:$L(STGL,DLM) D Q:'OK ..S NMGL=$P($P(STGL,DLM,J),"=") ..S NMGL=$$SPA^%L1FRM(NMGL) ..S VLGL=$P($P(STGL,DLM,J),"=",2) ..S VLGL=$$SPA^%L1FRM(VLGL) ..I $G(M("LKMNAME"))'="",NMGL="LKMNAME",'$$SRCH^W1SRCH(VLGL,M("LKMNAME"),1) S OK=0 Q ..I $G(M("TEL"))'="",NMGL="TEL",M("TEL")'=VLGL,M("PELE")'=VLGL S OK=0 Q ..I $G(M("TZ"))'="",NMGL="TZ",M("TZ")'=VLGL S OK=0 Q .I OK S ANS=ANS_"CODE="_LK_DLM_STGL_"^" ; W ""_$$SP(ANS)_"",! D PROT("SRCHRES",ANS) Q ; ; DELRKV(STOLD,RKV,DLM) ; N (JB,%ARG,STOLD,RKV,DLM) ; I $G(DLM)="" S DLM=$$DLM ; F I=1:1:$L(RKV,DLM) D .S NM=$P(RKV,DLM,I) .S OK=0 .I NM?1U.E D ..F J=1:1:$L(STOLD,DLM) D ...S NMOLD=$P($P(STOLD,DLM,J),"=") ...I NMOLD=NM D ....S STOLD=$P(STOLD,DLM,1,J-1)_DLM_$P(STOLD,DLM,J+1,$L(STOLD,DLM)) ; Q STOLD ; ; DELRKVLK(LK,RKV,DLM) ; I $G(LK)="" Q "" S GL=$$GL I $G(DLM)="" S DLM=$$DLM N STOLD S STOLD=$G(@GL@(LK)) I $G(RKV)="" Q STOLD S STOLD=$$DELRKV(STOLD,RKV,DLM) Q STOLD ; ; DELRKVLKS(LK,RKV,DLM) ; I $G(LK)="" Q I $G(DLM)="" S DLM=$$DLM N STOLD S STOLD=$$DELRKVLK(LK,RKV,DLM) S @GL@(LK)=STOLD D GIB(LK) W ""_$$SP(STOLD)_"",! D PROT("CUSTOMDATA",STOLD) Q ; SETLKMNKD(LK,MSD,RKV) N HZ,BON,H,NKDHZ,NKD D PRS^%L1FRM(RKV,"NKD~NKDHZ~BON~HZ~DZ~H","~") S @GL@(LK,"LKMNKD",+DZ,+MSD,+HZ)=NKDHZ_"*"_BON_"*"_H D GIB(LK) Q ; MSDR() ; I $G(%ARG("MSDR")) Q %ARG("MSDR") Q $$GETP^%W1PRM("MSDR") ; DLM() Q "<>" ; GIB(LK) ; N GL0 S GL0=$$GL0 M @GL0@(LK)=@GL@(LK) Q ; PROT(TAG,ST) ; I $G(TAG)="" Q S ^W3ANSLKM(+$H,$P($H,",",2),TAG)=$E($G(ST),1,3000) Q ; SP(ST) ; Q $$RPL^%L1FRM(ST," ","%20") W3ANSMNY W3ANSMNY ; [ 05.07.26 11:54 ] [ 29.09.21 15:23 ] [ 27.12.20 12:14 ] N (JB,%ARG,%REM) S FDB=$G(%ARG("FDB")) S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,"\") Q:'DZ S ^[$$^W3MAIN]W4MNYALL(DZ,MSD)=$P(FDB,"\",2,200) Q W3ANSMSL W3ANSMSL ; [ 05.07.26 11:54 ] [ 22.10.17 18:48 ] [ 04.11.09 12:55 ] N (JB,%ARG,%REM) S FDB=$G(%ARG("FDB")) I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) N I F I=1:1:$L(FDB,";") D .S ANS=$P(FDB,";",I) .S HZW=$P(ANS,"-") .S HZR=$P(ANS,"-",2) .S TIME=$P(ANS,"-",3) I TIME="" S TIME=$$T^%L1TIME($H) .S PSLN=$P(ANS,"-",4) .I 'HZW!'HZR Q .I $D(^[$$^W3MAIN]W3ORD(HZW,"M")) Q .S ^[$$^W3MAIN]W3ORD(HZW,"M")=TIME .S ^[$$^W3MAIN]W3ORD(HZW,"PSLN")=PSLN Q W3ANSMZB W3ANSMZB ; [ 14.08.24 03:50 ] [ 12.08.24 07:11 ] [ 06.08.24 15:33 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSMZB","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S DZ=$P(FDB,"^") Q:'DZ ; F I=2:1:$L(FDB,"^") D .S A=$P(FDB,"^",I) .S HZ=$P(A,"~") Q:HZ="" .S MZB=$P(A,"~",2) .S SHAA=$P(A,"~",3) .S MAZMIN=$P(A,"~",4) .S TEL=$P(A,"~",5) . .S ^[$$^W3MAIN]W4MZB(MSDR,DZ,MSD,HZ)=MZB_"*"_SHAA_"*"_MAZMIN_"*"_TEL Q W3ANSMZV W3ANSMZV ; [ 05.07.26 11:56 ] [ 29.09.21 15:21 ] [ 18.02.18 10:14 ] N (JB,%ARG,%REM) S FDB=$G(%ARG("FDB")) S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,"~") Q:'DZ ;;S IND=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) S ^[$$^W3MAIN]W4MSDMZV(MSD,DZ)=FDB Q W3ANSPAY W3ANSPAY ; [ 05.07.26 11:54 ] [ 01.08.24 11:49 ] [ 01.02.11 23:21 ] N (JB,%ARG,%REM) S FDB=$G(%ARG("FDB")) I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) N I F I=1:1:$L(FDB,";") D .S PRPAY=1 .S ANS=$P(FDB,";",I) .S HZW=$P(ANS,":") .I HZW["!" S HZW=+HZW,PRPAY=0 .S HZR=$P(ANS,":",2) .I 'HZW!'HZR Q .I HZR["D",'$D(^[$$^W3MAIN]W3ORD(HZW,"D")) D Q ..S ^[$$^W3MAIN]W3ORD(HZW,"D")=$P(HZR,"-",2)_"~"_$P(HZR,"-",3) .I PRPAY S ^[$$^W3MAIN]HZLINKWI(HZW)=HZR_"\"_$H Q W3ANSPOS W3ANSPOS ; [ 05.07.26 11:55 ] [ 29.06.26 08:18 ] [ 14.06.26 19:01 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSPOS","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,"^") Q:'DZ ; F I=2:1:$L(FDB,"^") D .S A=$P(FDB,"^",I) .S EMDA=$P(A,"~") S:EMDA="" EMDA="-" .S NMB=$P(A,"~",2) S:NMB="" NMB="-" .S HZ=$P(A,"~",3) S:HZ="" HZ="-" .S DATCB=$P(A,"~",4) .S SHAA=$P(A,"~",5) .S MKBL1=$P(A,"~",6) .S TS=$J($P(A,"~",7),2,2) .S MZ=$J($P(A,"~",8),2,2) .S AV=$J($P(A,"~",9),2,2) .S CA=$J($P(A,"~",10),2,2) .S ASR=$J($P(A,"~",11),2,2) .S ^[$$^W3MAIN]W4POSNET(MSDR,DZ,MSD,EMDA,HZ)=NMB_"*"_DATCB_"*"_SHAA_"*"_MKBL1_"*"_TS_"*"_MZ_"*"_AV_"*"_CA_"*"_ASR Q W3ANSPRP W3ANSPRP ; [ 05.07.26 11:55 ] [ 01.08.23 12:08 ] [ 31.07.23 15:10 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSPRP","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,";") Q:'DZ S TIM=$P(FDB,";",2) Q:'TIM ; S ^[$$^W3MAIN]W4DLVPRP(MSDR,DZ,MSD)=TIM Q W3ANSSL W3ANSSL ; [ 23.07.25 12:04 ] [ 29.05.25 08:59 ] [ 23.10.23 03:23 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ;;M ^AA("W3ANSSL","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S DLM="*" ; F I=1:1:$L(FDB,"^")-1 D .S ST=$P(FDB,"^",I) .S DT=$P(ST,DLM) Q:'DT .S SL=$P(ST,DLM,2) Q:'SL .S HZ=$P(ST,DLM,5) Q:'HZ .S ^[$$^W3MAIN]W4SLNET(MSDR,DT,MSD,SL,HZ)=ST Q W3ANSTFK W3ANSTFK ; [ 05.07.26 11:57 ] [ 08.04.24 15:55 ] [ 23.10.23 03:23 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSTFK","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DLM="~" S DT=$P(FDB,"~",2) Q:DT="" ; F I=2:1:$L(FDB,"^") D .S ST=$P(FDB,"^",I) Q:ST="" .S ^[$$^W3MAIN]W4TFKNET(MSDR,DT,MSD,I)=$TR(ST,"~","*") Q W3ANSTIM W3ANSTIM ; [ 05.07.26 11:57 ] [ 09.02.22 09:33 ] [ 03.02.22 11:57 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSTIM","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DZ=$P(FDB,";") Q:'DZ ; F I=2:1:$L(FDB,";") D .S A=$P(FDB,";",I) .S IR=$P(A,"~") Q:IR="" .S TIM=$P(A,"~",2) .S SHZ=$P(A,"~",3) .S ^[$$^W3MAIN]W4DLVTIM(MSDR,DZ,MSD,IR)=TIM_"~"_SHZ Q W3ANSZ W3ANSZ ; [ 05.07.26 11:58 ] [ 14.05.23 11:24 ] [ N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSZ","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DT=$P(FDB,"~") Q:'DT S ST=$P(FDB,"~",2,200) S ^[$$^W3MAIN]W4MNYZ(DT,MSD)=ST Q W3ANSZ4W W3ANSZ4W ; [ 22.09.26 09:23 ] [ 05.07.26 11:57 ] [ 28.05.26 09:20 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSZ4W","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DT=$P(FDB,"~") S FDB=$P(FDB,"~",2,200) S DLM="*" ; F I=1:1:$L(FDB,"^")-1 D .S ST=$P(FDB,"^",I) Q:ST="" .D PRS^%L1FRM(ST,"HZM*SUGT*NOM*OK*SUM*TRID*ER*ER1*HZBIT","*") .Q:HZM="" .I SUGT="" S SUGT="-" .I NOM="" S NOM="-" .S ^[$$^W3MAIN]W4NETZ4W(MSDR,DT,MSD,HZM,SUGT,NOM)=OK_"\"_SUM_"\"_TRID_"\"_ER_"\"_ER1_"\"_HZBIT Q W3ANSZIC W3ANSZIC ; [ 05.07.26 11:57 ] [ 28.05.26 09:20 ] [ N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" M ^AA("W3ANSZIC","ARG")=%ARG ; S FDB=$G(%ARG("FDB")) S MSDR=$G(%ARG("MSDR")) Q:'MSDR S MSD=$P($G(%ARG("MSD")),",") Q:MSD="" ; I '$L(FDB) Q S FDB=$$CNWEB^%L1FRM(FDB) S DT=$P(FDB,"~") S FDB=$P(FDB,"~",2,200) S DLM="*" ; F I=1:1:$L(FDB,"^")-1 D .S ST=$P(FDB,"^",I) Q:ST="" .D PRS^%L1FRM(ST,"HZM*SUGT*NOM*OK*SUM*NCA*TRID*ER*ER1*REFID*MNL*NAME*SIBA1*H","*") .Q:HZM="" .I SUGT="" S SUGT="-" .I NOM="" S NOM="-" .S ^[$$^W3MAIN]W4NETZIC(MSDR,DT,MSD,HZM,SUGT,NOM)=OK_"\"_SUM_"\"_NCA_"\"_TRID_"\"_ER_"\"_ER1_"\"_REFID_"\"_MNL_"\"_NAME_"\"_SIBA1_"\"_H Q W3AS W3AS ; [ 31.08.23 14:09 ] [ 03.02.18 20:18 ] [ 10.02.14 19:06 ] S ^flag("ASK")=0 K ^flag("ASK") D ^W3ASK Q W3ASK W3ASK ; [ 14.07.26 09:59 ] [ 07.07.26 04:34 ] [ 25.06.26 15:44 ] N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$D(JB) S JB=$$^%W1SsID I $$^%L1FLAG("^flag(""ASK"")") Q D SETFLAG N (JB) D INIT S SHASK=0,SHER=0 ;;D ^W3ASKFDN ; ASK S $ZT="ZG "_$ZL_":ER^W3ASK" I $G(^STLOOP("PC")) K ^flag("ASK") Q I $$^%L1FLAG("^flag(""ASK"")") Q D SETFLAG ; K @GL,@GL1 S NOMTB=$O(^[$$^W3MAIN]TMPASKA(999999),-1)+1 ; S SHASK=SHASK+1 I '(SHASK#3) H ; -- NEW LOAD PROGRAMM ; D READITEMS ; D READRSTG ; D RESTSTATUS ; D READASKSND ; D DOCMD ; D ^W3ASKFDN ; I $$^W3ASKGET<0 S SHER=SHER+1 H 20 G ASK ; --- GET ORDERSLIST --> GL (^TMPASK) ; S I=0 CYC S I=I+1 ;------ READ ORDERS WAS GETTING FROM SERVER I $G(^STLOOP("PC")) K ^flag("ASK") Q I '$D(@GL@(I)) G END S A=$G(^(I)) I A[("<"_ListOrd) D READORDS G END G CYC ; END D KILLTMP Q ;;H 60 G ASK ; *** 03/09/23 ; ; KILLTMP ; K ^[$$^W3MAIN]TMPASK(MYDVN) Q ; MYDVN ; S MYDVN=$$^%L3MYDVN Q ; GET(I,EL,PARENT) Q $$GET^W3ASKORD($G(I),$G(EL),$G(PARENT)) ; FIND(I,EL,PARENT,PR) ; Q $$FIND^W3ASKORD($G(I),$G(EL),$G(PARENT),$G(PR)) ; FINDEND(I,EL,PARENT) ; Q $$FINDEND^W3ASKORD($G(I),$G(EL),$G(PARENT)) ; INIT ; D PUT^%W1PRM("ELPOS",1) D MYDVN D KILLTMP D INITTAG D GL,GL1 Q ; INITTAG ; S ListOrd="OrdersList" S Header="OrderHeader" S Order="Order" S OrdId="OrderNumber" S Content="OrderContent" S Error="Error" ; S Rest2Rest="Rest2RestOrders" S RestStatus="RestStatus" S DlvSends="DlvSends" S Rest2MM="Rest2MMOrders" S SendedOrder="SendedOrder" S Items4Web="ItemsGlobals" Q ; GL S GL="^[$$^W3MAIN]TMPASK(MYDVN)" Q GL1 S GL1="^[$$^W3MAIN]TMPASK1(MYDVN)" Q ; SENDOK ; D ^W3ASKFDB Q ; ER ; K ^flag("ASK") D SVER^%L1X ;H 20 ;G ASK ; SETFLAG ; I '$G(^flag("ASK")) S ^flag("ASK")=$J,^flag("ASK","TIME")=$H Q ; ; READORDS ; S BGLO=I S ERR=$$GET(BGLO,Error,ListOrd) I ERR'="OK" S I=$$FINDEND(BGLO,ListOrd,"") Q ; S BGOI=BGLO CYCORD S BGOI=$$FIND(BGOI,Order,ListOrd) I 'BGOI D S I=$$FINDEND(BGOI,Order,ListOrd) Q .D SENDOK ; S ORDNMB=$$GET(BGOI,OrdId,Order) Q:'ORDNMB D ^W3ASKORD(ORDNMB,BGOI) ; ENDORD S BGOI=$$FINDEND(BGOI,Order,ListOrd) G CYCORD Q ; ; REST2REST S BGOI=I ; CYC11 S BGOI=$$FIND(BGOI,SendedOrder,Rest2Rest) I 'BGOI S I=$$FINDEND(BGOI,SendedOrder,Rest2Rest) Q S A=$G(^(BGOI)) S ORDNMB=$P($P(A,"<"_SendedOrder_">",2),"") I ORDNMB,'$$^P1TFN D .S $P(^P1HZ2MSD(ORDNMB),"\",3)="OK" .N NUM S NUM=$P($G(^P1HZ2MSD(ORDNMB)),"\",2) Q:'NUM .I $D(^TXTFAX(NUM)) D ..M ^TXTFAXA(NUM)=^TXTFAX(NUM) ..K ^TXTFAX(NUM) ; I ORDNMB,$$^P1TFN,$D(^ZKUCI)>9 D .N OK S OK=0 ; .S INDZK="" F S INDZK=$O(^ZKUCI(INDZK)) Q:INDZK="" D Q:OK ..S UCI=$P(^(INDZK),"\") Q:UCI="" ..N DAT S DAT=$P($G(^[UCI]P1HZ2MSD(ORDNMB))," ") I $$^%L1DC(DAT,3)'=+$H Q ..; ..N NUM S NUM=$P($G(^[UCI]P1HZ2MSD(ORDNMB)),"\",2) Q:'NUM ..I $D(^[UCI]TXTFAX(NUM)) D ...M ^[UCI]TXTFAXA(NUM)=^[UCI]TXTFAX(NUM) ...K ^[UCI]TXTFAX(NUM) ...S $P(^[UCI]P1HZ2MSD(ORDNMB),"\",3)="OK" ...S OK=1 ; G CYC11 Q ; ; REST2MM ; S BGOI=I ; CYC12 S BGOI=$$FIND(BGOI,SendedOrder,Rest2MM) I 'BGOI S I=$$FINDEND(BGOI,SendedOrder,Rest2MM) Q S A=$G(^(BGOI)) ; S ORDNMB=$P($P(A,"<"_SendedOrder_">",2),"") ; I ORDNMB D .N IND S IND=($H-3)_"00000" .F S IND=$O(^P1SND2MA(IND)) Q:IND="" I $G(^(IND))'="OK" D ..I $E(IND,11,20)=ORDNMB S ^(IND)="OK" G CYC12 Q ; ; ITEMS4WEB(GL) ; ;;N NOKILLGL S NOKILLGL="" D IT4WEB^W3ASKIT(GL) Q ; READITEMS ; N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$G(@$$^W4PRM@("IT4WEB")) Q I '$G(@$$^W4PRM@("IT4WEB","MSD")) Q I '$G(@$$^W4PRM@("IT4WEB","MSDR")) Q ; S FILEINI=$$INDBI^W3ASKPTH S URLI=$$^W3ASKURL_"w3ansits.jsp" S PRM="MSD="_$G(@$$^W4PRM@("IT4WEB","MSD"))_"&MSDR="_$G(@$$^W4PRM@("IT4WEB","MSDR")) N FDB S FDB="" ; D SEND^W3ASKFD1(FILEINI,URLI,PRM,FDB) ; --> FILE ; ;;I $$EXIST^%L1ZOS(FILEINI) C FILEINI:(DELETE) ;;O FILEINI:(NEWVERSION:REWIND) ;;U FILEINI W "url="_URLI_PRM C FILEINI ; ;;N FILE S FILE=$$OU^W3ASKPTH ;;I $$^%L1ZOS(2,FILE) ;;ZSY "curl -s -m 25 -o "_FILE_" -K "_FILEINI ;;I $ZSY'=0 S @$$^W4GL("W4ITPROT")@(+$H,"W3ASK-READITEMS",$P($H,",",2))=$ZSY Q ; I '$$EXIST^%L1ZOS(FILE) D Q .S @$$^W4GL("W4ITPROT")@(+$H,"W3ASK-READITEMS",$P($H,",",2))=$ZSY_"\NOT ANSWER" ; D GL^W3ASK D READFILE^W3ASKGET(FILE,GL) ; I $D(@GL)<10 Q D ITEMS4WEB(GL) K @GL Q ; ; READRSTG ; N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$G(@$$^W4PRM@("IT4WEB")) Q I '$G(@$$^W4PRM@("IT4WEB","MSD")) Q I '$G(@$$^W4PRM@("IT4WEB","MSDR")) Q ; S FILEINI=$$INDBI^W3ASKPTH S URLI=$$^W3ASKURL_"w3rstgask.jsp" S PRM="MSD="_$G(@$$^W4PRM@("IT4WEB","MSD"))_"&MSDR="_$G(@$$^W4PRM@("IT4WEB","MSDR")) ; ;;I $$EXIST^%L1ZOS(FILEINI) C FILEINI:(DELETE) ;;O FILEINI:(NEWVERSION:REWIND) ;;U FILEINI W "url="_URLI_PRM C FILEINI ;; ;;N FILE S FILE=$$OU^W3ASKPTH ;;I $$^%L1ZOS(2,FILE) ;;N CMD S CMD="curl -s -m 25 -o "_FILE_" -K "_FILEINI ;;ZSY CMD ; N FDB S FDB="" D SEND^W3ASKFD1(FILEINI,URLI,PRM,FDB) ; --> FILE ; ;;S @$$^W4GL("W4RDRSTG")@(+$H,"W3ASK-READRSTG",$P($H,",",2),"CMD")=CMD I '$$EXIST^%L1ZOS(FILE) D .S @$$^W4GL("W4RDRSTG")@(+$H,"W3ASK-READRSTG",$P($H,",",2))=$ZSY_"\NOT ANSWER" ; D GL^W3ASK D READFILE^W3ASKGET(FILE,GL) N N I '$G(JB) S JB=1 ; ;;M ^AA("W3ASK-READRSTG",GL)=@GL S N="" F S N=$O(@GL@(N)) Q:N="" D .S A=$G(^(N)) .I A["" D ..S DAT=$P(A,"",2) ..S DAT=$P(DAT,"") ..I DAT,DAT'["^" D ^W4RSTGSN(JB,DAT) H 3 D ^W4ZRSTG(JB,DAT,DAT,1) Q .. ..I DAT,DAT["^" J RSTGSND(JB,DAT) Q ; ; RESTSTATUS ; N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$G(@$$^W4PRM@("IT4WEB")) Q I '$G(@$$^W4PRM@("IT4WEB","MSD")) Q I '$G(@$$^W4PRM@("IT4WEB","MSDR")) Q ; S FILEINI=$$INDBI^W3ASKPTH S URLI=$$^W3ASKURL_"w3getstat.jsp" ; S MYMSD=$G(@$$^W4PRM@("IT4WEB","MSD")) S MYMSDR=$G(@$$^W4PRM@("IT4WEB","MSDR")) I MYMSD="" S MYMSD=$G(@$$^W4PRM@("WEB","MSD")) I MYMSDR="" S MYMSDR=$G(@$$^W4PRM@("WEB","MSDR")) I MYMSD=""!(MYMSDR="") Q ; S PRM="MSD="_MYMSD_"&MSDR="_MYMSDR S PRM=PRM_"&FDB="_$$^W4DZ ; ;;I $$EXIST^%L1ZOS(FILEINI) C FILEINI:(DELETE) ;;O FILEINI:(NEWVERSION:REWIND) ;;U FILEINI W "url="_URLI_PRM C FILEINI ;; N FILE S FILE=$$OU^W3ASKPTH ; ;;I $$^%L1ZOS(2,FILE) ;;ZSY "curl -s -m 25 -K "_FILEINI_" -o "_FILE ;;I $ZSY'=0 S @$$^W4GL("W4ITPROT")@(+$H,"W3ASK-READITEMS",$P($H,",",2))=$ZSY Q ; N FDB S FDB="" D SEND^W3ASKFD1(FILEINI,URLI,PRM,FDB) ; --> FILE ; D GL^W3ASK D READFILE^W3ASKGET(FILE,GL) ; S RestStatus="RestStatus" N A,A1,DT,TM,N,OKEND S DT=$$^W4DZ S TM=$ZD($H,"24:60") S OKEND=0 ; S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OKEND .S A=$G(^(N)) .I A[("") S OKEND=1 Q .I A["" D ..S A1=$P(A,"",2) ..S A1=$P(A1,"") ..I $P(A1,"~")'=MYMSD Q ..S ^W4MSDSTA(DT,TM)=A1 ; S OKEND=0 S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OKEND .S A=$G(^(N)) .I A[("") S OKEND=1 Q .I A["" D ..S A1=$P(A,"",2) ..S A1=$P(A1,"") ..I $P(A1,"~")'=MYMSD Q ..S ^W4MSLSTA(DT,TM)=A1 Q ; ; READASKSND ; N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$G(@$$^W4PRM@("IT4WEB")) Q I '$G(@$$^W4PRM@("IT4WEB","MSD")) Q I '$G(@$$^W4PRM@("IT4WEB","MSDR")) Q ; S FILEINI=$$INDBI^W3ASKPTH S URLI=$$^W3ASKURL_"w3netsndask.jsp" S PRM="MSD="_$G(@$$^W4PRM@("IT4WEB","MSD"))_"&MSDR="_$G(@$$^W4PRM@("IT4WEB","MSDR")) ; ;;I $$EXIST^%L1ZOS(FILEINI) C FILEINI:(DELETE) ;;O FILEINI:(NEWVERSION:REWIND) ;;U FILEINI W "url="_URLI_PRM C FILEINI ; N FILE S FILE=$$OU^W3ASKPTH ;;I $$^%L1ZOS(2,FILE) ;;N CMD S CMD="curl -s -m 25 -o "_FILE_" -K "_FILEINI ;;ZSY CMD ;;Q:$ZSY ; N FDB S FDB="" D SEND^W3ASKFD1(FILEINI,URLI,PRM,FDB) ; --> FILE ; D GL^W3ASK D READFILE^W3ASKGET(FILE,GL) N N I '$G(JB) S JB=1 ; ;;M ^AA("W3ASK-NTSND",GL)=@GL ;;N NOAMER S NOAMER=0 ;;I '$G(AMER) S NOAMER=1 S N="" F S N=$O(@GL@(N)) Q:N="" D .S A=$G(^(N)) .I A["" D ..S DAT=$P(A,"",2) ..S DAT=$P(DAT,"") .. ..I DAT,DAT["^" D ...N D1,D2 ...S D1=$$^%L1DC($P(DAT,"^",1),3) ...S D2=$$^%L1DC($P(DAT,"^",2),3) ...S AMER=$P(DAT,"^",3) ...I D2 FILE ; D GL^W3ASK D READFILE^W3ASKGET(FILE,GL) ; S OKEND=0 ; S N="" F S N=$O(@GL@(N)) Q:N="" D .S A=$G(^(N)) .I A["" D ..S A1=$P(A,"",2) ..S A1=$P(A1,"") ..I A1="" Q ..S REST=$P(A1,"<>") I REST'=MYMSD Q ..S A1=$P(A1,"<>",2,200) ..I A1="" Q ..S ^W4DOCMD(+$H,$P($H,",",2))=A1 ..X A1 Q ; ; RSTGSND(JB,DAT) N D1,D2 S D1=$$^%L1DC($P(DAT,"^",1),3) S D2=$$^%L1DC($P(DAT,"^",2),3) ; I D2 FILE-- not now ! N $ZT S $ZT="ZG "_$ZL_":ERR^W3ASKDUP" I $G(^P1PRM("WEB","DUAL_SEND_NEW"))="" Q N SRV,TOKEN S SRV=$G(^P1PRM("WEB","SRVADDR_NEW")) Q:SRV="" S TOKEN=$G(^P1PRM("WEB","SYNC_TOKEN_NEW")) Q:TOKEN="" N EP S EP=$P(URL,"/",$L(URL,"/")) Q:EP="" N PRM0 S PRM0="" I EP["?" S PRM0=$P(EP,"?",2) I EP["?" S EP=$P(EP,"?") I $L(PRM0),$L($G(PRM)) S PRM=PRM0_"&"_PRM N URLN S URLN=$$BASE(SRV)_EP ; N FILE2 S FILE2=FILEIN_".new" C FILE2:(DELETE) O FILE2:(NEWVERSION:REWIND) U FILE2 I $E(PRM)="&" S PRM=$E(PRM,2,2000) I $L($G(PRM)) W PRM_"&" W "FDB="_FDB,! C FILE2 ; S FILE=FILEIN_".ou" ; N CMD S CMD="curl -m 45 -N -s -S " S CMD=CMD_"-H 'X-ELPOS-SYNC-TOKEN: "_TOKEN_"' " S CMD=CMD_" -X POST -d@"_FILE2_" """_URLN_""" -w ""\n%{http_code}""" S CMD=CMD_" -o "_FILE ; *** 07.7.26 ; ZSY CMD D LOG(CMD,$ZSY) H 1 C FILE2:(DELETE) Q ; ; BASE(SRV) ; I $E(SRV,1,4)="http" Q SRV_$S($E(SRV,$L(SRV))="/":"",1:"/")_"mumps-examples/jsp/" Q "https://"_SRV_"/mumps-examples/jsp/" ; LOG(CMD,RC) ; S @$$^W4GL("W3ASKDUP")@(+$H,$P($H,",",2))=CMD_"~"_RC Q ; SET(SRV,TOKEN) ; I $G(SRV)'="" S ^P1PRM("WEB","SRVADDR_NEW")=SRV I $G(TOKEN)'="" S ^P1PRM("WEB","SYNC_TOKEN_NEW")=TOKEN S ^P1PRM("WEB","DUAL_SEND_NEW")=1 W "DUAL_SEND_NEW=",^P1PRM("WEB","DUAL_SEND_NEW"),! W "SRVADDR_NEW=",^P1PRM("WEB","SRVADDR_NEW"),! W "SYNC_TOKEN_NEW is set",! Q ; OFF ; S ^P1PRM("WEB","DUAL_SEND_NEW")=0 W "DUAL_SEND_NEW=0",! Q ; ERR ; D LOG("ERR",$ZSTATUS) Q W3ASKE W3ASKE ; [ 11.08.13 15:23 ] [ 31.10.12 15:08 ] [ 17.10.12 14:15 ] N (%ARG,%REM) S JB=$$^%W1SsID("W3ASKE") I $$^%L1FLAG("^flag(""ASK"")") Q D SETFLAG N D INIT S SHASK=0,SHER=0 D ^W3ASKFDE ; ASK S $ZT="ZG "_$ZL_":ER^W3ASKE" I $G(^STLOOP("PC")) K ^flag("ASK") Q I $$^%L1FLAG("^flag(""ASK"")") Q D SETFLAG ; K @GL,@GL1 S NOMTB=$O(^[$$^W3MAIN]TMPASKA(999999),-1)+1 ; S SHASK=SHASK+1 I '(SHASK#3) H D ^W3ASKFDE ; I $$^W3ASKGET<0 S SHER=SHER+1 H 60 G ASK ; --- GET ORDERSLIST --> GL (^TMPASK) ; S I=0 CYC S I=I+1 ;------ READ ORDERS WAS GETTING FROM SERVER I $G(^STLOOP("PC")) K ^flag("ASK") Q I '$D(@GL@(I)) G BG1 S A=$G(^(I)) ; I A[("<"_ListOrd) D .S BGLO=I . .S ERR=$$GET(BGLO,Error,ListOrd) .I ERR'="OK" S I=$$FINDEND(BGLO,ListOrd,"") Q . .S BGOI=BGLO CYCORD .S BGOI=$$FIND(BGOI,Order,ListOrd) .I 'BGOI D S I=$$FINDEND(BGOI,Order,ListOrd) Q ..D SENDOK . .S ORDNMB=$$GET(BGOI,OrdId,Order) Q:'ORDNMB .D ^W3ASKORD(ORDNMB,BGOI) . ENDORD .S BGOI=$$FINDEND(BGOI,Order,ListOrd) .G CYCORD ; G CYC ; BG1 S I=0 CYC1 S I=I+1 ;------ READ FEEDBACK ABOUT ORDERS REST2REST ; I '$D(@GL@(I)) G BG2 S A=$G(^(I)) ; I A[("<"_Rest2Rest) D .S BGOI=I ; CYC11 .S BGOI=$$FIND(BGOI,SendedOrder,Rest2Rest) .I 'BGOI S I=$$FINDEND(BGOI,SendedOrder,Rest2Rest) Q .S A=$G(^(BGOI)) .S ORDNMB=$P($P(A,"<"_SendedOrder_">",2),"") .I ORDNMB D ..S $P(^P1HZ2MSD(ORDNMB),"\",3)="OK" ..N NUM S NUM=$P($G(^P1HZ2MSD(ORDNMB)),"\",2) Q:'NUM ..I $D(^TXTFAX(NUM)) D ...M ^TXTFAXA(NUM)=^TXTFAX(NUM) ...K ^TXTFAX(NUM) . .G CYC11 G CYC1 ; BG2 S I=0 CYC2 S I=I+1 ;------ READ FEEDBACK ABOUT ORDERS REST2MM I '$D(@GL@(I)) G END S A=$G(^(I)) ; I A[("<"_Rest2MM) D .S BGOI=I ; CYC12 .S BGOI=$$FIND(BGOI,SendedOrder,Rest2MM) .I 'BGOI S I=$$FINDEND(BGOI,SendedOrder,Rest2MM) Q .S A=$G(^(BGOI)) .; .S ORDNMB=$P($P(A,"<"_SendedOrder_">",2),"") .; .I ORDNMB D ..N IND S IND=($H-3)_"00000" ..F S IND=$O(^P1SND2MA(IND)) Q:IND="" I $G(^(IND))'="OK" D ...I $E(IND,11,20)=ORDNMB S ^(IND)="OK" .G CYC12 G CYC2 ; END D KILLTMP H 60 G ASK ; ; KILLTMP ; K ^[$$^W3MAIN]TMPASK(MYDVN) Q ; MYDVN ; S MYDVN=$$^%L3MYDVN Q ; GET(I,EL,PARENT) Q $$GET^W3ASKORD($G(I),$G(EL),$G(PARENT)) ; FIND(I,EL,PARENT,PR) ; Q $$FIND^W3ASKORD($G(I),$G(EL),$G(PARENT),$G(PR)) ; FINDEND(I,EL,PARENT) ; Q $$FINDEND^W3ASKORD($G(I),$G(EL),$G(PARENT)) ; INIT ; D MYDVN D KILLTMP D INITTAG D GL,GL1 Q ; INITTAG ; S ListOrd="OrdersList" S Header="OrderHeader" S Order="Order" S OrdId="OrderNumber" S Content="OrderContent" S Error="Error" ; S Rest2Rest="Rest2RestOrders" S Rest2MM="Rest2MMOrders" S SendedOrder="SendedOrder" Q ; GL S GL="^[$$^W3MAIN]TMPASK(MYDVN)" Q GL1 S GL1="^[$$^W3MAIN]TMPASK1(MYDVN)" Q ; SENDOK ; D ^W3ASKFDB Q ; ER ; K ^flag("ASK") D SVER^%L1X ;H 20 ;G ASK ; SETFLAG ; I '$G(^flag("ASK")) S ^flag("ASK")=$J,^flag("ASK","TIME")=$H Q W3ASKFD1 W3ASKFD1 ; [ 22.07.26 06:59 ] [ 07.07.26 04:24 ] [ 06.07.26 14:55 ] D ^W3ASKFDN Q ; -- !!!!!!!!!!!!! ; N (NOMTB) S MYDVN=$$^%L3MYDVN ; S FILEIN=$$INDB^W3ASKPTH S FILEINP=$$INDBP^W3ASKPTH S FILEINM=$$INDBM^W3ASKPTH ;;S FILEINS=$$INDBS^W3ASKPTH ; S URL=$$^W3ASKURL_"w3ansfdb.jsp?" S URLP=$$^W3ASKURL_"w3anspay.jsp?" S URLM=$$^W3ASKURL_"w3ansmsl.jsp?" ; S PRM="MSD="_$G(^P1PRM("WEB","MSD"))_"&PSW="_$G(^P1PRM("WEB","PSW")) ; S FDB="",FDBP="",FDBM="" D ^P1IN S MAX=2000 ; S DT=P1DZ-1 F S DT=$O(^P1H(DT)) Q:DT="" D .S HZ="" F S HZ=$O(^P1H(DT,HZ)) Q:HZ="" D ..S ASM=$$HZMLAK^P3HZMST(HZ) Q:ASM="" ..Q:$E(ASM)'="W" ..S ASM=$E(ASM,2,20) ..I $L(FDB)DT,SHAA<$$SHAAZ^W4PRM Q .I SHAA<6 S SHAA=SHAA+24 .; .I $$HZM^W4MSL(N) D ..S MT(SHAA,"QD")=$G(MT(SHAA,"QD"))+1 ..S MT(SHAA,"SD")=$G(MT(SHAA,"SD"))+TSHL .; .I $$HZM^W4MSD(N) D ..S MT(SHAA,"QR")=$G(MT(SHAA,"QR"))+1 ..S MT(SHAA,"SR")=$G(MT(SHAA,"SR"))+TSHL ; ; I SND,'PRTAW D .S QNSP=QNSP+1 .S TMSP=TMSP+DIF .I $G(@$$^W4ORD@(N,"SINGLE")) S SINGLE=$G(SINGLE)+1 . .I SND,'DIF S QNSP0=QNSP0+1 . .I SND'>17 D ..S QNSP17=QNSP17+1 ..S TMSP17=TMSP17+SND . .I DIF,DIF'>30 D ..S QNSP30=QNSP30+1 ..S TMSP30=TMSP30+DIF . .I RDTM,RDTM'>5 D ..S QNRD5=QNRD5+1 ..S TMRD5=TMRD5+RDTM ; I '$$^W4CLOSE(N) D .S QNORD=QNORD+1 . .I HZMSL S QNORD("D")=$G(QNORD("D"))+1 .I HZMSD S QNORD("R")=$G(QNORD("R"))+1 .I HZMSL,PRTAW S QNORD("TAW")=$G(QNORD("TAW"))+1 .S SSUM=SSUM+TSHL .I HZMSL S SSUM("D")=$G(SSUM("D"))+TSHL .I HZMSD S SSUM("R")=$G(SSUM("R"))+TSHL .I HZMSL,PRTAW S SSUM("TAW")=$G(SSUM("TAW"))+TSHL .S SSOAD=SSOAD+SOAD .I HZMSL S SSOAD("D")=$G(SSOAD("D"))+SOAD .I HZMSD S SSOAD("R")=$G(SSOAD("R"))+SOAD .I HZMSL,PRTAW S SSOAD("TAW")=$G(SSOAD("TAW"))+SOAD . .S SDLV=SDLV+DLVTIM ; I $$^W4CLOSE(N) D .S QNORDS=QNORDS+1 .S SSUMS=SSUMS+TSHL .S SSOADS=SSOADS+SOAD .I HZMSL S QNORDS("D")=$G(QNORDS("D"))+1 .I HZMSD S QNORDS("R")=$G(QNORDS("R"))+1 .I HZMSL S SSUMS("D")=$G(SSUMS("D"))+TSHL .I HZMSD S SSUMS("R")=$G(SSUMS("R"))+TSHL .I HZMSL S SSOADS("D")=$G(SSOADS("D"))+SOAD .I HZMSD S SSOADS("R")=$G(SSOADS("R"))+SOAD ; I SSOAD S AVRG=$J(SSUM/SSOAD,3,3) I SSOADS S AVRGS=$J(SSUMS/SSOADS,3,3) I (SSOAD+SSOADS) S SAVRG=$J((SSUM+SSUMS)/(SSOAD+SSOADS),3,3) ; Q ; ; MIN(SHAA) ; Q SHAA*60+$P(SHAA,":",2) ; TIMEPREP(DT) ; N D1,D2,TMS,REST S (D1,D2)=DT N TMP S TMP=$$^W4MAIN("TMP") K @TMP S REST="" D FRM^W4TMPREP N I,STM S I=0,STM=0,TMS=0 N N S N="" F S N=$O(@TMP@(DT,N)) Q:N="" D .N A S A=$G(^(N)) .S TM=$P(A,"\",4) .I TM>0,TM<50 S I=I+1,STM=STM+TM I I>0 S TMS=$J(STM/I,2,2) Q I_"^"_STM_"^"_TMS W3ASKGET W3ASKGET(STAM) ; [ 14.01.25 15:54 ] [ 29.12.24 12:06 ] [ 27.05.21 08:48 ] N (NOMTB) D ^%L1TS D MYDVN N FILE S FILE=$$OU^W3ASKPTH I $$^%L1ZOS(2,FILE) N FILEIN S FILEIN=$$IN^W3ASKPTH ; O FILEIN:(NEWVERSION:REWIND) ;;S URL="https://www.2order.org/mumps-examples/jsp/w3ans2ask.jsp?" S URL=$$^W3ASKURL_"w3ans2ask.jsp?" S PRM="MSD="_$G(^P1PRM("WEB","MSD"))_"&PSW="_$G(^P1PRM("WEB","PSW")) U FILEIN W "url="_URL_PRM C FILEIN ; ZSY "curl -s -m 35 -o "_FILE_" -K "_FILEIN ; I $ZSY'=0 D Q -.5 .D MSG1^P1PC(" ADSL CONNECTION ERROR ! CALL R.S.D. ") ; I $$^%L1ZOS(10,FILE)=-1 Q -1 ; N A S A="" ;;S $ZT="G ER" ; D GL^W3ASK D READFILE(FILE,GL) ; I $G(NOMTB) M ^[$$^W3MAIN]TMPASKA(NOMTB)=@GL ; Q 1 ; ; READFILE(FILE,GL) ; D MYDVN,^%L1TS N I K @GL S I=0 ; N BL S BL=1800 I '$$EXIST^%L1ZOS(FILE) Q O FILE:(READONLY:REWIND) ; U FILE F R A Q:$ZEOF D .S A1=$E(A,1,BL) Q:A1="" .S I=I+1,@GL@(I)=$TR(A1,TSS,TS0) .S I1=0 I $L(A)>BL F D Q:(BL*(I1+1))>$L(A) ..S I1=I1+1,@GL@(I,I1)=$TR($E(A,BL*I1+1,BL*(I1+1)),TSS,TS0) ; C FILE Q ; ; MYDVN ; S MYDVN=$$^%L3MYDVN Q W3ASKIT W3ASKIT(STAM) ; [ 27.07.26 11:43 ] [ 19.05.26 15:51 ] [ 29.12.24 12:04 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$G(JB) S JB=$$^%W1SsID("ASKIT") D ^%L1TS S MYDVN=$$^%L3MYDVN N FILE S FILE=$$OU^W3ASKPTH I $$^%L1ZOS(2,FILE) N FILEIN S FILEIN=$$IN^W3ASKPTH ; ;--- FORM-E ZAPROSA O FILEIN:(NEWVERSION:REWIND) S SRVADR=$$^W3ASKURL S URL=SRVADR_"w3ansit.jsp?" S PRM="MSDR="_$$MSDR_"&MSD="_$$MSD_"&PSW="_$$PSW U FILEIN W "" ;;url="_URL_PRM C FILEIN ; D SEND^W3ASKFD1(FILEIN,URL,PRM,"") ; ; ;;ZSY "curl -s -m 90 -o "_FILE_" -K "_FILEIN ; I $ZSY'=0 D Q "CONNECTERROR<>"_$ZSY .S ^W3ASKIT($$IND)=$ZSY ; Q $$READIT(FILE) ; ; READIT(FILE) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D ^%L1TS N A,A0,A1,I,I1,N,GLP,GLP1,MAC S A="" ; N GL S GL=$$^W4MAIN("TMPIT") K @GL S I=0 ; N BL S BL=1800 O FILE:(READONLY:REWIND) ; ;---- RECEIVE ITEMS INTO TEMPORARY FILE TMPIT U FILE F R A Q:$ZEOF D .S A1=$E(A,1,BL) Q:A1="" .S I=I+1,@GL@(I)=$TR(A1,TSS,TS0) .S I1=0 I $L(A)>BL F D Q:(BL*(I1+1))>$L(A) ..S I1=I1+1,@GL@(I,I1)=$TR($E(A,BL*I1+1,BL*(I1+1)),TSS,TS0) C FILE ; D IT4WEB(GL) Q 1 ; ; IT4WEB(GL) ; ; ---- FORM-E %L1GS("SV") & ZACHISTKA STARYH ITSRV* GLOBALS ; N N S N="" F S N=$O(^[$$^W3MAIN]SHP("%GSPAR",N)) Q:N="" D .N GLP S GLP=$$SPA^%L1FRM($G(^(N))) S:$E(GLP)="^" GLP=$E(GL,2,20) Q:$E(GLP)'?1U .S GLP=$$SPA^%L1FRM(GLP) .S %L1GS("SV",GLP)="" .K @("ITSRV"_GLP) ; N GLLK,GLLKNET S GLLK="^LKH",GLLKNET="^LKSRV" K @GLLKNET ; ;--- READ FROM SERVER ITSTRV* GLOBALS ; N A,PR,PR1,IND,CONT,FLBACK S PR=0,PR1=0 ; S N="" F S N=$O(@GL@(N)) Q:N="" D .S A=$G(^(N)) .I A["" S PR=1 Q .I A["" S PR=2 Q .I A["" S PR=0 Q .I A["" S PR=0 Q .Q:'PR .S IND=$P(A,"=") .S CONT=$P(A,"=",2,255) .I $E(IND,1,2)="^|" D ..S IND="^"_$P(IND,"|",3) .I $E(IND)'="^" Q .S @IND=CONT .I PR=1 S PR1=1 .I PR=2 S PR1=2 ; I 'PR1 Q ; I PR1=2 D K ^GRNET ;; Q ; -- GROUPS .I $D(^GRNET)>9 D ..S CD="" F S CD=$O(^GRNET(CD)) Q:CD="" D ...N A,ACT ...S A=$G(^(CD)) ...S ACT=$P(A,"\",2) ...I ACT=1!(ACT="") S ^W3SUG(CD)=1 ...I ACT=0 S ^W3SUG(CD)=0 ; I '$D(NOKILLGL) K @GL ; ; -- SAVE OLD GLOBALS ; S FLBACK="/home/gtmuser/PARG.OLD" O FLBACK:(WRITE:NEWVERSION) U FLBACK W "%GO Global Output Utility",! W "GT.M "_$ZD($H,"DD-MM-YEAR 24:60"),! S GLP="" F S GLP=$O(%L1GS("SV",GLP)) Q:GLP="" D .S GLP1="^"_GLP .I $D(@GLP1)=0 Q .S MAC=GLP1_"("""")" .F S MAC=$Q(@MAC) Q:MAC="" Q:MAC'[GLP1 D ..W MAC,! ..W $G(@MAC),! W "",!,"",! C FLBACK ; ; -- ITSRV* GLOBALS --> GLOBALS ; S GLP="" F S GLP=$O(%L1GS("SV",GLP)) Q:GLP="" D .Q:GLP="PAR" .Q:GLP="PARSUG" .Q:GLP="W3PAR" .Q:GLP="W3SUG" .Q:GLP="PARLKH" .Q:GLP="PARSLK" .;;I $D(@("^ITSRV"_GLP))<10 Q .K @("^"_GLP) .X "M ^"_GLP_"=^ITSRV"_GLP .K @("^ITSRV"_GLP) ; S N="" F S N=$O(^ITSRVPAR(N)) Q:N="" D .S A=$G(^(N)) .S A0=$G(^PAR(N)) .I $$PAPJ^W4PRM S ^PAR(N)=A Q ; -- 28.08.22 .S ^PAR(N)=$P(A,"**",1,10)_"**"_$P(A0,"**",11)_"**"_$P(A,"**",12,255) ; K ^ITSRVPAR ; S N="" F S N=$O(^ITSRVPARSUG(N)) Q:N="" D .N A1 S A1=$G(^PARSUG(N,1)) .M ^PARSUG(N)=^ITSRVPARSUG(N) .I $$PAPJ^W4PRM Q .S $P(^PARSUG(N,1),"\",7)=$P(A1,"\",7) ; I $D(^ITSRVPARSUG)>9 D .S N="" F S N=$O(^PARSUG(N)) Q:N="" I '$D(^ITSRVPARSUG(N)) K ^PARSUG(N) .K ^ITSRVPARSUG ; I $D(^ITNET)>9 D .M ^MHT0=^MHT .K ^W3PAR,^MHT N CD,CDT .S CD="" F S CD=$O(^ITNET(CD)) Q:CD="" D ..N A,A1,MH,ACT ..S A=$G(^(CD)) ..S MH=$P(A,"\"),ACT=$P(A,"\",2) ..I ACT=1!(ACT="") S ^W3PAR(CD)=1 ..I ACT=0 S ^W3PAR(CD)=0 ..S $P(^PAR(CD),"**",2)=MH ; S N="" F S N=$O(^PAR(N)) Q:N="" S:$P(^(N),"**",11)="" $P(^(N),"**",11)="G" ; ;;S N="" F S N=$O(^P1SETA(N)) Q:N="" D UPDATE^W3SETIDK(N) ; S CD="" F S CD=$O(^ITNET(CD)) Q:CD="" D .S CDT="" F S CDT=$O(^ITNET(CD,CDT)) Q:CDT="" D ..S A1=$G(^(CDT)) ..S ^MHT(CD,CDT)=A1 ; K ^ITNET ; N DP,DP1,DP2 S DP=$G(@$$^W4PRM@("NETLK")) S DP1=$P(DP,":"),DP2=$P(DP,":",2) ; I DP1,DP2,$D(^LKSRV)>9 D .S FLBACK="/home/gtmuser/LKHG.OLD" .O FLBACK:(WRITE:NEWVERSION) .U FLBACK . W "%GO Global Output Utility",! . W "GT.M "_$ZD($H,"DD-MM-YEAR 24:60"),! . S GLP1="^LKH" . I $D(@GLP1)=0 Q . S MAC=GLP1_"("""")" . F S MAC=$Q(@MAC) Q:MAC="" Q:MAC'[GLP1 D . .W MAC,! . .W $G(@MAC),! . W "",!,"",! .C FLBACK .; .N GL S GL="^LKH" .N N S N=999 F S N=$O(^LKSRV(N)) Q:N="" D ..I N'DP2 D ...N ITRA S ITRA=$$ITRA^W4L(N) ...M ^LKH(N)=^LKSRV(N) ...S $P(^LKH(N,2),"*",4)=ITRA .K ^LKSRV ; S ^W3ASKIT($$IND)="OK" ; Q ; ; IND(STAM) ; Q +$H_$TR($J($P($H,",",2),5)," ",0) ; SRVADR(STAM) ; N A S A=$G(^P1PRM("IT4WEB","SRVADR")) I A="",$L($G(^P1PRM("WEB","SRVADR"))) S A=^("SRVADR") Q A ; MSDR(STAM) ; N A S A=$G(^P1PRM("IT4WEB","MSDR")) I A="",$L($G(^P1PRM("WEB","MSDR"))) S A=^("MSDR") Q A ; MSD(STAM) ; N A S A=$G(^P1PRM("IT4WEB","MSD")) I A="",$L($G(^P1PRM("WEB","MSD"))) S A=^("MSD") Q A ; PSW(STAM) ; N A S A=$G(^P1PRM("IT4WEB","PSW")) I A="",$L($G(^P1PRM("WEB","PSW"))) S A=^("PSW") Q A W3ASKITP W3ASKITP ; [ 28.04.26 01:35 ] [ 27.05.21 07:23 ] [ 26.08.20 13:00 ] N (JB,%ARG,%REM) D ^%W1HD("RCVITPROTOCOL") W "
",! W "
" D BACK W "

",! ;;W "" ;; W $$^%W1DICT("RCVITPROTOCOL") ;;W "" ;;W "

" S GL=$$^W4GL("W3ASKIT") W "",! S N="" F S N=$O(@GL@(N),-1) Q:N="" D .S RES=$G(^(N)) .W "" .W " " . .W " " .W "",! ; W "
" . W $ZD($E(N,1,5),"DD.MM.YY") . W $$NBSP^%L1FRM(3) . W $$T^%L1TIME(+$E(N,6,10)) .W " " . W $S(RES:"ERROR "_RES,1:"OK") .W "
",! ; W "
" D BACK W "
" W "
",! Q ; ; BACK ; D ^W4BCK Q W3ASKORD W3ASKORD(NMBORD,BGOI) ; [ 17.09.18 06:15 ] [ 15.09.17 13:37 ] [ 14.09.17 12:02 ] N (JB,%ARG,%REM,NMBORD,BGOI) ; S MYDVN=$$^%L3MYDVN D GL,GL1 S WEBORD="^W3ORD" ; D INITTAG^W3ASK ; S FINORD=$$FINDEND(BGOI,Order,ListOrd) I 'FINORD S I=$$FINDEND(BGOI,Order,"") S ER="NOTFINORD" G ENDORD ; S HD=$$GET(BGOI,Header,Order) I HD="" S ER="NOTHD" G ENDORD ; I '$G(NMBORD) S ER="NOTNMBORD" G ENDORD ; K @WEBORD@(NMBORD) S @WEBORD@(NMBORD)=HD ; S BGOI=$$FIND(BGOI,Content,Order) ; S FINCONT=$$FINDEND(BGOI,Content,Order) I 'FINCONT S ER="NOTFINCONT" G ENDORD ; F I=BGOI+1:1:FINCONT-1 D .S A=$G(@GL@(I)) Q:A="" .S IND=$P(A,"|") Q:IND="" .S IND1=$P(A,"|",2) .I IND1="" S @WEBORD@(NMBORD,IND)=$P(A,"||",2,200) Q .S @WEBORD@(NMBORD,IND,IND1)=$P(A,"|",3,200) Q ; I $D(@WEBORD@(NMBORD,"F")) G ENDORD ; -- WAS FAX ; S HZM=$$^W3NEWHZN(NMBORD) I HZM<0 S ERR=HZM G ENDORD ; D OKORD(HZM) ; ENDORD S I=FINORD END Q ; ; GET(I,EL,PARENT) N IND S IND=$$FIND(I,EL,PARENT) I 'IND Q "" Q $$GETVL(+IND,EL) ; FIND(I,EL,PARENT,PR) ; N OK,A,J S OK=0 D GL F J=I+1:1 Q:'$D(@GL@(J)) S A=$G(^(J)) Q:A[("") D Q:OK .I '$G(PR)!($G(PR)=2),A[("<"_EL_">") S OK=J .I $G(PR),A[("<"_EL_" ") S OK=J ;;W "FIND: I="_I_" EL="_EL_" PARENT="_PARENT_" OK="_OK,! Q OK ; FINDEND(I,EL,PARENT) ; N OK,J S OK=0 D GL F J=I+1:1 Q:'$D(@GL@(J)) S A=$G(^(J)) Q:A[("") I A[("") S OK=J Q ;;W "FINDEND: I="_I_" EL="_EL_" PARENT="_PARENT_" OK="_OK,! I 'OK Q 99999 Q OK ; GETVL(I,EL) ; N A,ZN S A=$G(@GL@(I)) I A="" Q "" S ZN=$P(A,"<"_EL_">",2) S ZN=$P(ZN,"") Q $$SPA^%L1FRM(ZN) ; OKORD(HZM) ; S @GL1@(NMBORD)=HZM Q ; GL ; D GL^W3ASK Q GL1 ; D GL1^W3ASK Q W3ASKPTH W3ASKPTH(STAM) ; [ 23.12.24 12:30 ] [ 31.12.23 16:28 ] [ 03.02.22 09:10 ] ;;Q "/usr/local/mumps/1/tmp/" Q $ZDIR_"1/tmp/" Q "/pos/tmp/" ; IN(STAM) Q $$^W3ASKPTH_"tmpin"_$G(JB) OU(STAM) Q $$^W3ASKPTH_"tmpou"_$G(JB) INDB(STAM) Q $$W3ASKPTH_"tmpfdb"_$G(JB) INDBP(STAM) Q $$W3ASKPTH_"tmpfdbp"_$G(JB) INDBM(STAM) Q $$W3ASKPTH_"tmpfdbm"_$G(JB) INDBS(STAM) Q $$W3ASKPTH_"tmpfdbs"_$G(JB) INDBT(STAM) Q $$W3ASKPTH_"tmpfdbt"_$G(JB) INDBI(STAM) Q $$W3ASKPTH_"tmpfdbi"_$G(JB) INDGS(STAM) Q $$W3ASKPTH_"tmpfdbgs"_$G(JB) W3ASKURL W3ASKURL(STAM) ; [ 19.05.26 13:42 ] [ 23.06.23 14:48 ] [ 21.03.22 10:47 ] N SRVADR S SRVADR=$G(^P1PRM("WEB","SRVADDR")) I $L(SRVADR),$TR(SRVADR,".","")'?.N,$E(SRVADR,1,4)'="www.",$E(SRVADR,1,4)'="http" S SRVADR="www."_SRVADR I SRVADR["212.179.112.43" Q "http://212.179.112.43/mumps-examples/jsp/" Q "https://"_SRVADR_"/mumps-examples/jsp/" ;; new adress 2order.org ; ; OU() N SRVOU S SRVOU=$G(^P1PRM("WEB","SRVOU")) I SRVOU="" Q $$W3ASKURL ; I $L(SRVOU),$TR(SRVOU,".","")'?.N,$E(SRVOU,1,4)'="www.",$E(SRVOU,1,4)'="http" S SRVOU="www."_SRVOU I SRVOU["212.179.112.43" Q "http://212.179.112.43/mumps-examples/jsp/" Q "https://"_SRVOU_"/mumps-examples/jsp/" ;; new adress 2order.org W3AZOR W3AZOR ; [ 24.09.08 10:13 ] [ 28.04.08 11:11 ] [ D ^W3TBL1("H","W3AZOR") Q W3AZR W3AZR ; [ 19.08.26 10:30 ] [ 10.04.22 08:17 ] [ 17.01.21 06:17 ] AZOR(COUNTRY,CITY,STREET,HOME) ; N (JB,%ARG,%REM,COUNTRY,CITY,STREET,HOME) N CITYI,STREETI S CITYI=CITY S STREETI=STREET ; I COUNTRY=""!(CITYI="") Q "" ; I $$^%W1DIR="RTL" D .S CITYI=$$INVH^%L1FRM(CITY) .S STREETI=$$INVH^%L1FRM(STREET) ; I $$^%W1DIR="LTR" S STREETI=$$FUNC^%UCASE(STREETI) ; N AZ,STREETN,MEHOME,ADHOME S AZ="" N N S N="" F S N=$O(@$$^W4GL("W3AZS")@(COUNTRY,CITYI,N)) Q:N="" D Q:AZ .S AZN=$G(^(N)) .S STREETN=$$SPA^%L1FRM($P(N,":")) .I $$^%W1DIR="LTR" S STREETN=$$FUNC^%UCASE(STREETN) .S MEHOME=$$SPA^%L1FRM($P(N,":",2)) .S ADHOME=$$SPA^%L1FRM($P(N,":",3)) .I STREETI=STREETN,HOME'ADHOME S AZ=AZN Q AZ ; AZOR1(COUNTRY,CITY,STREET,HOME) ; N (JB,%ARG,%REM,COUNTRY,CITY,STREET,HOME) S AZOR=$$AZOR(COUNTRY,CITY,STREET,HOME) I AZOR?.P Q "" Q $G(@$$^W4GL("W3AZR")@(COUNTRY,CITY,AZOR)) ; EXAZ(PRM) ; N CITY S CITY=$P(PRM,"^") I CITY="" Q "NOCITY" N STREET S STREET=$P(PRM,"^",2) I STREET="" Q "NOSTREET" N HOME S HOME=$P(PRM,"^",3) I HOME="" Q "NOHOME" N I F I="CITY","STREET","HOME" D .S @I=$$CNWEB^%L1FRM(@I) .S @I=$$INVH^%L1FRM(@I) N STRHOME S STRHOME=STREET_"^"_HOME N AZ S AZ=$G(@$$^W4GL("W3EXAZ")@(CITY,STRHOME)) ;;S ^AA("W3AZR-EXAZ","AZ")=AZ I AZ,$$ACT^W4PLGN(1,AZ)=0 Q "NOACT" Q AZ ; ; SETAZ(PRM) ; N CITY S CITY=$P(PRM,"^") I CITY="" Q "NOCITY" N STREET S STREET=$P(PRM,"^",2) I STREET="" Q "NOSTREET" N HOME S HOME=$P(PRM,"^",3) I HOME="" Q "NOHOME" N I F I="CITY","STREET","HOME" D .S @I=$$CNWEB^%L1FRM(@I) .S @I=$$INVH^%L1FRM(@I) ; N STRHOME S STRHOME=STREET_"^"_HOME N AZ S AZ=$P(PRM,"^",4) I AZ[";" S AZ=$P(AZ,";",2,20) I 'AZ Q "NOAREA" ; S @$$^W4GL("W3EXAZ")@(CITY,STRHOME)=AZ Q 1 W3AZRIDK W3AZRIDK ; [ 27.03.26 13:03 ] [ 27.07.22 11:09 ] [ 27.03.22 20:59 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q Q:$G(%ARG("SHOW"))=0 ; I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q I '$D(%ARG("NIR")) W "A city code is not defined ! " Q ; I $$MSDR^W4PRM=8005 D PUT^%W1PRM("MSDR",8004) ; *** 27.03.26 ; D W3AZR ; S NIR=%ARG("NIR") S IRI=$$IRI(%ARG("NIR")) Q:IRI="" ; W "
",! ; I $$POLYGON^W4PRM,$$PLGNNOTEXIST D Q .W "" . W $$^%W1DICT("PAINTDISTRICTFIRST") .W "",! ; W "
",! ; W ""_$$^%W1DICT("DLVDEFAULTTIME") W $$NBSP^%L1FRM(3) W "",! W "",! W "

",! ; W "",! W "" I '$$POLYGON^W4PRM W "" W "" W "" W "" W "" W "" W "" ; I $$POLYGON^W4PRM,$$MSDR^W4PRM,'$$MM^W4PRM D .W "" ; W "" W "" W "",! ; N N,I S N="",I=0 F S N=$O(@W3AZR@(N)) Q:N="" I N D .W "" S I=I+1 . .I '$$POLYGON^W4PRM D ..W "" . .W "" . .W "" . .W "" . .W "" . .W "" . .W "" . .I $$POLYGON^W4PRM,$$MSDR^W4PRM,'$$MM^W4PRM D ..W "" . .S CHECKED=1,DIS=0 .I $$AZRSHOW(IRI,N)=0 S CHECKED=0,DIS=0 . .W "" . .W "" . .W "",! ; W "
 "_$$^%W1DICT("DISTRICTCODE")_""_$$^%W1DICT("DISTRICTNAME")_""_$$^%W1DICT("DLVPAY")_""_$$^%W1DICT("DLVTIME")_""_$$^%W1DICT("DELDLVPAY")_""_$$^%W1DICT("PRICEMINIMUM")_""_$$^%W1DICT("SNIFIM")_""_$$^%W1DICT("DISTRICTACTIVE")_""_$$^%W1DICT("CHANGED")_"
" .. W " +
" .. W " - 		 "_N_" " . W "  " . W "" .W " " . W "" .W " " . W "" .W " " . W "" .W " " .. W $$SHOWSNIFIM(N) ..W "" . W "" .W "" . W "" .W "
",! W "
",! Q ; ; SAVE(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D PUT^%W3DEB("W3AZRIDK-SAVE","PRM=PRM") D W3AZR N CD,NM,MH,DESC,GR,SHOW S NIR=$P(PRM,";",1) I NIR="" Q 0 S CD=$P(PRM,";",2) I CD="" Q 0 S IRI=$$IRI(NIR) Q:IRI="" 0 ; I $D(^[$$^W3MAIN]TMPDEL(JB,CD)) D Q 1 .K ^[$$^W3MAIN]TMPDEL(JB,CD) .K @W3AZR@(CD) ; S NM=$$CLEAR^%L1FRM($$CNWEB^%L1FRM($P(PRM,";",3))) S DLVP=$$CLEAR^%L1FRM($P(PRM,";",4)) S DLVTM=$$CLEAR^%L1FRM($P(PRM,";",5)) S DLVCNC=$$CLEAR^%L1FRM($P(PRM,";",6)) S MHMIN=$$CLEAR^%L1FRM($P(PRM,";",7)) S SHOW=+$P(PRM,";",8) S SNIFIM=$P(PRM,";",9) ; S @W3AZR@(CD)=$S($$^%W1DIR="RTL":$$INVH^%L1FRM(NM),1:NM) S $P(@W3AZR@(CD,1),"\",1,4)=$J(DLVP,2,2)_"\"_DLVTM_"\"_$J(DLVCNC,2,2)_"\"_SHOW S $P(@W3AZR@(CD,1),"\",5)=SNIFIM S $P(@W3AZR@(CD,1),"\",6)=MHMIN Q 1 ; SAVEND(PRM) ; D W3AZR N NIR,IRI,DO,DFLT S PRM=$$CLEAR^%L1FRM(PRM) S DFLT=$P(PRM,"~") S @$$^W4PRM@("TIMEHZ")=DFLT S NIR=$P(PRM,"~",2) Q:NIR="" S IRI=$$IRI(NIR) Q:IRI="" S DO=$P(PRM,"~",3) S @W3AZR=DO ; K ^[$$^W3MAIN]TMPDEL(JB) K ^[$$^W3MAIN]TMPLAST(JB) Q ; EXIST(NIR) N W3AZR D W3AZR N IRI S IRI=$$IRI(NIR) I IRI="" Q 0 I $D(@W3AZR)>9 Q 1 Q 0 ; D(PRM) ; N NIR,CD,COUNTRY,MSD D W3AZR S NIR=$P(PRM,";") Q:NIR="" 0 S IRI=$$IRI(NIR) S CD=$P(PRM,";",2) Q:CD="" 0 I '$D(@W3AZR@(CD)) Q 0 Q 1 ; DELROW(PRM) ; D W3AZR D PUT^%W3DEB("W3AZRIDK-DELROW","JB=JB & PRM=PRM") Q:'$G(JB) N NIR,CD,IRI S NIR=$P(PRM,";") Q:NIR="" S CD=$P(PRM,";",2) Q:CD="" S IRI=$$IRI(NIR) I $D(^[$$^W3MAIN]TMPDEL(JB,CD)) K ^(CD) Q S ^[$$^W3MAIN]TMPDEL(JB,CD)=$G(@W3AZR@(CD)) Q ; NEWCOD(NIR) ; Q:$G(NIR)="" "NOK" N IRI,W3AZR D W3AZR S IRI=$$IRI(NIR) Q:IRI="" "NOK" N A S A=$O(@W3AZR@(9999999),-1)+1 I A'>$G(^[$$^W3MAIN]TMPLAST(JB)) D .S A=^[$$^W3MAIN]TMPLAST(JB)+1 S ^[$$^W3MAIN]TMPLAST(JB)=A Q A ; SELCITY ; W "",! Q ; SELMAP ; W "",! Q ; CITYMAP(N) ; N A S A=$G(@$$^W4GL("W4MAPPRM")@(N,1)) Q $P(A,"\") ; IR(NIR) ; N IR S IR=$G(@$$^W4GL("P1IR")@(NIR)) Q IR ; IRI(NIR) I $$POLYGON^W4PRM Q +NIR Q $$INV($$IR(NIR)) ; NM(IRI,CD) ; D W3AZR Q $G(@W3AZR@(CD)) ; NAME(IRI,CD) ; D W3AZR Q $$H2U^%L1FRM($G(@W3AZR@(CD))) ; DLVPAY(IRI,CD) ; D W3AZR Q +$P($G(@W3AZR@(CD,1)),"\") ; DLVTM(IRI,CD) ; D W3AZR Q +$P($G(@W3AZR@(CD,1)),"\",2) ; AZRSHOW(IRI,CD) D W3AZR Q $P($G(@W3AZR@(CD,1)),"\",4) ; DLVCNC(IRI,CD) ; D W3AZR Q +$P($G(@W3AZR@(CD,1)),"\",3) ; DLVDMS(IRI,CD) ; D W3AZR ; Q +$P($G(@W3AZR@(CD,1)),"\",1) ; MHMIN(IRI,CD) ; D W3AZR Q $P($G(@W3AZR@(CD,1)),"\",6) ; SNIF(IRI,CD,J) ; D W3AZR Q $E($$SNIFIM(+$G(IRI),CD),J) ; SNIFIM(IRI,CD) ; I '$$MSDR^W4PRM Q +$$GETP^%W1PRM("MSD") D W3AZR Q $P($G(@W3AZR@(CD,1)),"\",5) ; W3AZR S W3AZR=$$^W4GL("W3AZR")_"($$COUNTRY,IRI)" I $$POLYGON^W4PRM D .S W3AZR=$$^W4GL("W4PLGN")_"(IRI,""DESCR"")" .Q:'$G(IRI) .N N S N="" F S N=$O(@W3AZR@(N)) Q:N="" D ..I '$D(@$$^W4GL("W4PLGN")@(IRI,N)) D ...K @W3AZR@(N) Q ; COUNTRY(STAM) ; S MSD=$$GET^%W1PRM("MSD") I 'MSD Q "IS" Q $$COUNTRY^W3R(MSD) ; INV(TXT) ; I $$^%W1DIR="LTR" Q TXT Q $$INV^%L1FRM(TXT) ; DISTRICTONLY(IRN) ; D W3AZR Q +$G(@W3AZR) ; PUTPRM(PRM) ; D W3AZR N NIR,IRI,DO S NIR=$$CLEAR^%L1FRM($P(PRM,";")) Q:NIR="" S IRI=$$IRI(NIR) Q:IRI="" S DO=$$CLEAR^%L1FRM($P(PRM,";",2)) D PUT^%W1PRM("NIR",NIR) D PUT^%W1PRM("DO",DO) Q ; SHOWSNIFIM(N) ; N -- MISP AZOR ( POLYGON ) N NMAP S NMAP=+$$GETP^%W1PRM("NIR") ;-- MAPA I 'NMAP S NMAP=1 ;Q ""; *** 27.03.26 N ST,QNSN,MRK,MRKLST S QNSN=$$MRKQN^W4PLGN(NMAP) S MRKLST=$$MRKLST^W4PLGN(NMAP) ; S ST="" N DLM S DLM="," N J F J=1:1:QNSN D .S MRK=$P(MRKLST,DLM,J) .S ST=ST_MRK_" " .S ST=ST_"  " Q ST ; PLGNNOTEXIST(STAM) ; N I,J,OK S NOK=1 F I=1:1:10 D Q:'NOK .F J=1:1:10 D Q:'NOK ..I $D(@$$^W4GL("W4PLGN")@(I,J))>9 S NOK=0 Q NOK W3AZSIDK W3AZSIDK ; [ 30.10.17 20:59 ] [ 20.10.17 21:48 ] [ 20.12.10 14:57 ] N (JB,%ARG,SRCH) I '$G(JB) W " JB number is not defined ! " Q N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D PUT^%W3DEB("W3AZSIDK","%ARG=[%ARG") ;;I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q ;;D PUT^%W1PRM("MSD",%ARG("MSD")) ; I $L($$MV2STRPRM) D MV2STR($$MV2STRPRM) D KILLSTRPRM ; I $L($$MV2AZORPRM) D MV2AZOR($$MV2AZORPRM) D KILLAZORPRM ; I $L($$SAVEPRM) D SAVE($$SAVEPRM) D KILLSAVE ; S NIR=$$NIR Q:NIR="" S AZOR=$$AZOR ;;Q:AZOR="" ; D PUT^%W3DEB("W3AZSIDK","NIR=NIR & AZOR= AZOR") I NIR D PUT^%W1PRM("CITY",NIR) I AZOR D PUT^%W1PRM("AZOR",AZOR) ; N N,I D TMPAZS,TMPAZSI ; W "
",! W ""_$$^%W1DICT("DISTRICTSTREETSTABLE")_"",! W "

",! W "" W ""_$$^%W1DICT("DISTRICT")_" " W "",! W "",! ; I $G(%ARG("SHOW"))=0 W "
",! Q ; W "

",! ; W "",! W "" W "" W "" W "" W "" W "",! ; N NP S NP="",I=0 F S NP=$O(@TMPAZS@(NP)) Q:NP="" D .N A S A=$G(^(NP)) Q:A="" .W "" . .W "" . .W "" . .W "",! . .W "",! .W "",! . .W "",! W "
"_$$^%W1DICT("STREETNAME")_""_$$^%W1DICT("MEHOME")_""_$$^%W1DICT("ADHOME")_""_$$^%W1DICT("SIGN")_"
 "_$$H2U^%L1FRM($$NAME(A))_" " .W "" . W "" .W "" . W "" . W "
",! W "
",! Q ; NIR(STAM) ; I $G(%ARG("CITY")) Q $G(%ARG("CITY")) N NIR S NIR=$$GET^%W1PRM("CITY") I NIR=""!(NIR["UNDEF") Q "" Q NIR ; FIRSTNIR(STAM) ; N W3AZR,OK D W3AZR S OK=0 N NN,II S NN="",II=0 F S NN=$O(@$$^W4GL("P1IR")@(NN)) Q:NN="" D Q:OK .N IRI S IRI=$$INV($G(^(NN))) Q:IRI="" .I $D(@W3AZR)>9 S OK=NN Q NN ; NEW(NIR,AZOR) ; D TMPAZS,TMPAZSI K @TMPAZS,@TMPAZSI N NP S NP=0 N IRI S IRI=$$IRI(NIR) Q:IRI="" D W3AZS D PUT^%W3DEB("W3AZSIDK-NEW","NIR=NIR&AZOR=AZOR&IRI=IRI&W3AZS=W3AZS") ; N IND S IND="" F S IND=$O(@W3AZS@(IND)) Q:IND="" D .N A S A=$G(^(IND)) Q:A'=AZOR .S NP=NP+1,@TMPAZS@(NP)=IND_":"_A .S @TMPAZSI@(IND)=NP Q ; AZOR(STAM) ; N AZOR I $G(%ARG("AZOR")) Q %ARG("AZOR") S AZOR=$$GET^%W1PRM("AZOR") I AZOR=""!(AZOR["UNDEF") Q "" Q AZOR ; SAVE(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) N NIR,OLDAZOR S NIR=$P(PRM,";") Q:NIR="" S OLDAZOR=$P(PRM,";",2) Q:OLDAZOR="" D PUT^%W3DEB("W3AZSIDK-SAVE","OLDAZOR=OLDAZOR & NIR=NIR") Q:$G(OLDAZOR)="" N IRI S IRI=$$IRI(NIR) Q:IRI="" D TMPAZS,W3AZS N NP,NAME,MEHOME,ADHOME ; N N S N="" F S N=$O(@W3AZS@(N)) Q:N="" D .I $G(^(N))=OLDAZOR K ^(N) ; S NP="" F S NP=$O(@TMPAZS@(NP)) Q:NP="" D .N A S A=$G(^(NP)) .S NAME=$$NAME(A),MEHOME=$$MEHOME(A),ADHOME=$$ADHOME(A) .N IND S IND=$$IND(NAME,MEHOME,ADHOME) .S @W3AZS@(IND)=OLDAZOR Q ; MV2STR(PRM) ; D TMPAZS,TMPAZSI S PRM=$$CLEAR^%L1FRM(PRM) I $E(PRM,$L(PRM))=";" S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q D PUT^%W3DEB("W3AZSIDK-MV2STR","PRM=PRM") N I,CD F I=1:1:$L(PRM,";") D .N NP S NP=$P(PRM,";",I) Q:NP="" .K @TMPAZS@(NP) D KILLTMPAZSI(NP) D CRTMPAZS Q ; MV2AZOR(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D TMPAZS,TMPAZSI I $E(PRM,$L(PRM))=";" S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q D PUT^%W3DEB("W3AZSIDK-MV2AZOR","PRM=PRM") N I,STR,NS F I=1:1:$L(PRM,";") D .S NS=$P(PRM,";",I) .S STR=$G(^[$$^W3MAIN]TMPSTR(JB,NS)) Q:STR="" .S MEHOME=1,ADHOME=999 .S IND=$$IND(STR,MEHOME,ADHOME) .S @TMPAZSI@(IND)="" ; D CRTMPAZS Q ; NAME(A) ; Q $$INV($$SPA^%L1FRM($P(A,":",1))) ; MEHOME(A) ; Q $P(A,":",2) ; ADHOME(A) ; Q $P(A,":",3) ; MV2STRPRM(STAM) ; Q $G(%ARG("MV2STR")) ; N MV S MV=$$GET^%W1PRM("MV2STR") I MV["UNDEF" S MV="" Q MV ; KILLSTRPRM ; D KILL^%W1PRM("MV2STR") Q ; KILLAZORPRM ; D KILL^%W1PRM("MV2AZOR") Q ; KILLSAVE ; D KILL^%W1PRM("SAVE") Q ; MV2AZORPRM(STAM) ; Q $G(%ARG("MV2AZOR")) ; N MV S MV=$$GET^%W1PRM("MV2AZOR") I MV["UNDEF" S MV="" Q MV ; SAVEPRM(STAM) ; Q $G(%ARG("SAVE")) ; N SV S SV=$$GET^%W1PRM("SAVE") I SV["UNDEF" S SV="" Q SV ; IND(NAME,MEHOME,ADHOME) Q $$INV(NAME)_$J("",25-$L(NAME))_":"_MEHOME_":"_ADHOME ; TMPAZS S TMPAZS="^[$$^W3MAIN]TMPAZS(JB)" Q ; TMPAZS0 S TMPAZS0="^[$$^W3MAIN]TMPAZS0(JB)" Q ; TMPSV ; D TMPAZS0,TMPAZS K @TMPAZS0 M @TMPAZS0=@TMPAZS Q ; TMPAZSI S TMPAZSI="^[$$^W3MAIN]TMPAZSI(JB)" Q ; KILLTMPAZSI(NP) ; D TMPAZSI N N S N="" F S N=$O(@TMPAZSI@(N)) Q:N="" I ^(N)=NP K ^(N) Q ; CRTMPAZS ; D TMPAZS,TMPAZSI K @TMPAZS N NP S NP=0 N N S N="" F S N=$O(@TMPAZSI@(N)) Q:N="" D .S NP=NP+1 .S @TMPAZS@(NP)=N_":"_$$AZOR .I $G(@TMPAZSI@(N))="" S @TMPAZS@(NP,"NEW")="" .S @TMPAZSI@(N)=NP Q ; ; SELCITY ; W "",! Q ; FIRSTAZOR(STAM) ; N NIR S NIR=$$FIRSTNIR I NIR="" Q "" N IRI S IRI=$$IRI(NIR) I IRI="" Q "" N W3AZR D W3AZR^W3AZRIDK ; N N S N="" F S N=$O(@W3AZR@(N)) Q:N="" Q:N'="" Q N ; ; GETAZOR ; N NIR S NIR=$$NIR Q:NIR="" D GETLIST(JB_";"_NIR) Q ; GETLIST(PRM) ; D PUT^%W3DEB("W3AZSIDK-GETLIST","PRM=PRM") N I,A S I=0,A="" N AZOR S AZOR=$$AZOR N JB,NIR S JB=$P(PRM,";"),NIR=$P(PRM,";",2) I JB=""!(NIR="") Q "" ; N AZ S AZ="" N IRI S IRI=$$IRI(NIR) Q:IRI="" N W3AZR D W3AZR ; F S AZ=$O(@W3AZR@(AZ)) Q:AZ="" D .S NM=$$H2U^%L1FRM(^(AZ)) .S A="" .W A,! Q ; NEWAZOR(PRM) ; D PUT^%W3DEB("W3AZSIDK-NEWAZOR","PRM=PRM") N CITY,AZOR S CITY=$P(PRM,";",1),AZOR=$P(PRM,";",2) I 'CITY Q D PUT^%W1PRM("CITY",CITY) I 'AZOR Q D PUT^%W1PRM("AZOR",AZOR) D NEW(CITY,AZOR) Q ; INV(TXT) ; I $$^%W1DIR="LTR" Q TXT Q $$INV^%L1FRM(TXT) ; KILLGL(PRM) ; N TMPAZS,TMPAZSI,TMPSTR D TMPAZS K @TMPAZS D TMPAZSI K @TMPAZSI D TMPSTR^W3AZSSTR K @TMPSTR D KILLSTRPRM D KILLAZORPRM D KILLSAVE D KILL^%W1PRM("AZOR") D KILL^%W1PRM("CITY") Q ; INIT ; D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) N NIR S NIR=$$FIRSTNIR D PUT^%W1PRM("CITY",NIR) N AZOR S AZOR=$$FIRSTAZOR ; D PUT^%W1PRM("AZOR",AZOR) D PUT^%W1PRM("OLDAZOR",AZOR) I NIR,AZOR D NEW(NIR,AZOR) Q ; SETHOME(PRM) ; N ID,VL,NS D TMPAZS S ID=$P(PRM,";") Q:ID="" S VL=$P(PRM,";",2) S NS=$E(ID,7,20) Q:'NS I ID["mehome" S $P(@TMPAZS@(NS),":",2)=VL I ID["adhome" S $P(@TMPAZS@(NS),":",3)=VL Q ; IR(NIR) N IR S IR=$G(@$$^W4GL("P1IR")@(NIR)) Q IR ; IRI(NIR) Q $$INV($$IR(NIR)) ; W3AZS S W3AZS=$$^W4GL("W3AZS")_"($$COUNTRY,IRI)" Q ; COUNTRY(STAM) ; S MSD=$$GET^%W1PRM("MSD") I 'MSD Q "IS" Q $$COUNTRY^W3R(MSD) ; W3AZR ; D W3AZR^W3AZRIDK Q W3AZSSTR W3AZSSTR ; [ 25.02.12 15:06 ] [ 20.12.10 14:05 ] [ 30.10.10 08:00 ] N (JB,%ARG,%REM) I '$G(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W3AZSSTR","%ARG=[%ARG") D TMPSTR ; W "
",! W ""_$$^%W1DICT("STREETSTABLE",$$IR)_"",! ; W "",! W "" W "" W "" W "",! N N,I ; I $G(%ARG("SHOW"))=0 W "
"_$$^%W1DICT("STREETNAME")_""_$$^%W1DICT("SIGN")_"

"_$$^%W1DICT("WAIT")_"
",! Q N IRI S IRI=$$IRI Q:IRI="" ;;W "IRI="_IRI,! ; D STREET2TMP(IRI) ; N A F NP=1:1 Q:'$D(@TMPSTR@(NP)) D .S A=$G(^(NP)) .W "" . .W " "_$$H2U^%L1FRM(A)_" " . .W "" .W "",! W "",! W "
",! Q ; TMPSTR ; S TMPSTR="^[$$^W3MAIN]TMPSTR(JB)" Q ; TMPSTR0 ; S TMPSTR0="^[$$^W3MAIN]TMPSTR0(JB)" Q ; W3AZS ; D W3AZS^W3AZSIDK Q ; COUNTRY(STAM) ; Q $$COUNTRY^W3AZSIDK ; TMPAZS ; D TMPAZS^W3AZSIDK Q ; TMPAZS0 ; D TMPAZS0^W3AZSIDK Q ; TMPS ; S TMPS="^[$$^W3MAIN]TMPS(JB)" Q ; AZOR(STAM) ; I $G(%ARG("AZOR")) Q %ARG("AZOR") N AZ S AZ=$$GET^%W1PRM("AZOR") I AZ["UNDEF" S AZ="" Q AZ ; IR(STAM) ; N IRN,IR S IRN=$G(%ARG("CITY")) I IRN="" S IRN=$$GET^%W1PRM("IR") I IRN=""!(IRN["UNDEF") Q "" S IR=$G(@$$^W4GL("P1IR")@(IRN)) Q IR ; IRI(STAM) ; Q $$INV($$IR) ; INV(TXT) ; I $$^%W1DIR="LTR" Q TXT Q $$INV^%L1FRM(TXT) ; NOSHOW(IRN,STRI) ; N N,I,OK I STRI["%" Q 1 S STRI=$$SPA(STRI) ; N IND,OK,ISTR,A D TMPSTR,TMPAZS,TMPS S OK=0 ; I $D(@TMPS@(STRI)) S OK=1 ; Q OK ; MV2STRPRM(STAM) ; Q $G(%ARG("MV2STR")) ;;Q $$GET^%W1PRM("MV2STRS") ; MV2AZORPRM(STAM) ; Q $G(%ARG("MV2AZOR")) ;;Q $$GET^%W1PRM("MV2AZORS") ; KILLSTRPRM ; ;;D KILL^%W1PRM("MV2STRS") Q ; KILLAZORPRM ; ;;D KILL^%W1PRM("MV2AZORS") Q ; SPA(TXT) ; Q $$SPA^%L1FRM(TXT) ; NEWTMP(PRM) ; N IR,CDMV S IR=$P(PRM,";") Q:IR="" S CDMV=$P(PRM,";",2) S %ARG("MV2AZOR")=CDMV D STREET2TMP($$INV(IR)) Q ; STREET2TMP(IRI) ; N A,N,I,J,OK,IRN,STRI D TMPAZS,TMPSTR,TMPS,W3AZS S OK=0,IRN=0 S IR=$$SPA($$INV(IRI)) S N="" F S N=$O(@$$^W4GL("P1IR")@(N)) Q:N="" I $$SPA($G(^(N)))=IR S IRN=N Q I 'IRN Q ; K @TMPS ; S N="" F S N=$O(@W3AZS@(N)) Q:N="" D .S STRI=$$SPA($P(N,":")) Q:STRI="" .S @TMPS@(STRI)="" ; S N="" F S N=$O(@TMPAZS@(N)) Q:N="" D .S A=$P($G(^(N)),":") .S STRI=$$SPA(A) Q:STRI="" .S @TMPS@(STRI)="" ; ;;W "MV2STRPRM="_$$MV2STRPRM I $L($$MV2STRPRM) D D KILLSTRPRM .D TMPAZS0 .N PRM S PRM=$$MV2STRPRM .I $E(PRM,$L(PRM))=";" S PRM=$E(PRM,1,$L(PRM)-1) .N J,NS,RHVI .F J=1:1:$L(PRM,";") D ..S NS=$P(PRM,";",J) Q:NS="" ..S RHVI=$$SPA($P($G(@TMPAZS0@(NS)),":")) Q:RHVI="" ..K @TMPS@(RHVI) ; I $L($$MV2AZORPRM) D D KILLAZORPRM .N PRM S PRM=$$MV2AZORPRM .I $E(PRM,$L(PRM))=";" S PRM=$E(PRM,1,$L(PRM)-1) .N J,NS,RHV,RHVI .F J=1:1:$L(PRM,";") D ..S NS=$P(PRM,";",J) Q:NS="" ..S RHV=$$SPA($G(@TMPSTR@(NS))) Q:RHV="" ..S RHVI=$$INV(RHV) ..S @TMPS@(RHVI)="" ; S N="",I=0 K @TMPSTR F S N=$O(^[$$^W3MAIN]P1STREET($$COUNTRY^W3PRM,IRI,N)) Q:N="" D .;;W !,"N="_N .I $$NOSHOW(IRN,N) Q .S I=I+1,@TMPSTR@(I)=$$INV($$SPA(N)) .;;W "I="_I,! ; ;;K @TMPS Q ; ; NOCHANGE(IRI) ; N N,OK D TMPSTR0 K @TMPSTR0 M @TMPSTR0=@TMPSTR K @TMPSTR D STREET2TMP(IRI) S OK=1 S N="" F S N=$O(@TMPSTR@(N)) Q:N="" I '$D(@TMPSTR0(N))!($G(@TMPSTR0(N))'=$G(@TMPSTR(N))) S OK=0 Q S N="" F S N=$O(@TMPSTR0@(N)) Q:N="" I '$D(@TMPSTR(N))!($G(@TMPSTR0(N))'=$G(@TMPSTR(N))) S OK=0 Q K @TMPSTR0 Q OK W3BDIKA W3BDIKA ; [ 04.05.07 18:59 ] [ W "",! Q W3BDKADD W3BDKADD(TXT) ; [ 09.01.08 11:47 ] [ 07.01.08 11:36 ] [ 19.07.07 08:32 ] [ N OK,MAIN,MAX,OK,CODP,CMAIN N GL S GL="^[$$^W3MAIN]TMPORD(JB)" S OK=1,MAIN="",MAX=0,CMAIN=0 ; I $P(TXT,"~")>0 D .N LAST S LAST=$O(@GL@(99999),-1) .N I F I=LAST:-1:1 Q:$P(@GL@(I),"~")=0 .Q:'$D(@GL@(I)) .I $P(@GL@(I),"~")=0 D ..S MAIN=$P(^(I),"~",2) ..S CMAIN=$P(^(I),"~",5) .Q:MAIN="" .S CODP=$P(TXT,"~",2) .K ^[$$^W3MAIN]TMPTSF(JB),^[$$^W3MAIN]TMPSET(JB) . .F I=LAST:-1:1 Q:'$D(@GL@(I)) Q:$P(@GL@(I),"~")=0 D ..N CD S CD=$P(@GL@(I),"~",2) Q:CD="" ..S ^[$$^W3MAIN]TMPTSF(JB,CD)=$G(^[$$^W3MAIN]TMPTSF(JB,CD))+1 ;$P(@GL@(I),"~",5) ..S ^[$$^W3MAIN]TMPSET(JB,$$SET(MAIN,CD))=$G(^[$$^W3MAIN]TMPSET(JB,$$SET(MAIN,CD)))+1 ;$P(@GL@(I),"~",5) .Q:'$D(@GL@(I)) . .I $D(@$$^W4GL("P1EZA")@(MAIN)) D Q ..N N S N="" F S N=$O(@$$^W3GL@("P1EZA")@(MAIN,N)) Q:N="" D Q:MAX ...S SET=$E(N,2,5) Q:SET="" ...I $D(@$$^W4GL("P1SETA")@(SET,CODP)) S MAX=$P($G(@$$^W4GL("P1SETA")@(SET)),"\",2) S:'MAX MAX=1 ..I $G(^[$$^W3MAIN]TMPSET(JB,$$SET(MAIN,CODP)))'31) S VD=-9.1 I $E(DAT,4,5)<1!($E(DAT,4,5)>12) S VD=-9.2 I $E(DAT,7,8)'?2N S VD=-9.3 I $E(DAT,7,8)<$$GG^%L1DC($H) S VD=-9.3 ;;I $E(DAT,7,8)>$$GG^%L1DC($H),$$MM^%L1DC($H)<11 S VD=-9.3 I '$$^%L1DC(DAT,3) S VD=-9.4 I DAT'?2N1"." I VD<-1 Q VD S VD=$$^W3VLDDT(DAT) I VD<1 Q VD S VT=1 ;;I SHAA>23 S VT=-10.1 I $P(SHAA,":")'?2N S VT=-10.1 I $P(SHAA,":",2)>59 S VT=-10.2 I SHAA'?2N1":"2N S VT=-10.3 I VT<0 Q VT ; N VT S VT=$$^W3VLDTM(DAT,SHAA) I VT<1 Q (VT-10) Q 1 ; ; VLD(PRM) ; N DAT,SHAA,ADSHAA,RES S DAT=$P(PRM,";") S SHAA=$P(PRM,";",2) S ADSHAA=$P(PRM,";",3) S RES=$$BDKDTTM(JB,DAT,SHAA) I '$$ADSHAA^W4PRM Q RES I RES<1 Q RES S RES=$$BDKDTTM(JB,DAT,SHAA) Q RES W3BDKTM W3BDKTM ; [ 04.03.17 08:33 ] [ 30.03.10 16:00 ] [ 11.11.07 15:27 ] [ I $$CLOSE^W3HZMST(JB) Q 1 N DAT,SHAA S DAT=$$DAT^W3HZMST(JB) S SHAA=$$SHAA^W3HZMST(JB) Q $$BDKDTTM(JB,DAT,SHAA) ; BDKDTTM(JB,DAT,SHAA) ; I $$CLOSE^W3HZMST(JB) Q 1 N VD S VD=$$^W3VLDDT(DAT) I VD<1 Q VD N VT S VT=$$^W3VLDTM(DAT,SHAA) I VT<1 Q (VT-10) Q 1 ; VLD(PRM) ; N DAT,SHAA,ADSHAA,RES S DAT=$P(PRM,";") S SHAA=$P(PRM,";",2) S ADSHAA=$P(PRM,";",3) S RES=$$BDKDTTM(JB,DAT,SHAA) I '$$ADSHAA^W4PRM Q RES I RES<1 Q RES S RES=$$BDKDTTM(JB,DAT,SHAA) Q RES W3BOR W3BOR ; [ 01.04.22 11:47 ] [ 28.03.22 07:54 ] [ 27.03.22 15:56 ] INIT ; D KILL^%W1PRM("W4BO") D:(+$$^W4DLVCSR=0) PUT^%W1PRM("DLVCSR","WEB") ; I $G(%ARG("MSDR")) D .D PUT^%W1PRM("MSDR",%ARG("MSDR")) D PUT^%W1PRM("BOR",1) .D COUNTRY^W3MSDRG D PUT^%W1PRM("LNG",%W1LNG) ; I $G(%ARG("MMCC")),$G(%ARG("MSDR")),$G(%ARG("MSD"))=%ARG("MSDR") D .D PUT^%W1PRM("MSDR0",%ARG("MSDR")) .D PUT^%W1PRM("MSD0",%ARG("MSD")) .D PUT^%W1PRM("MMCC",%ARG("MMCC")) ; I $G(%ARG("MSD")) D PUT^%W1PRM("MSD",%ARG("MSD")) I '$G(%ARG("MSD")),$G(%ARG("MSDR")) D .N MSD S MSD=0 .N N S N="" F S N=$O(^|$$^W3MAIN|W3MSDR(%ARG("MSDR"),N)) Q:N="" D Q:MSD ..I N,$G(^(N)) S MSD=N .I MSD D PUT^%W1PRM("MSD",MSD) ; I $L($G(%ARG("COLOR"))) D PUT^%W1PRM("COLOR",%ARG("COLOR")) ; I $$OUTCOMP^W3VHOD D PUT^%W1PRM("OUTCOMP",$$OUTCOMP^W3VHOD) ; I $G(%ARG("DLVCSR")) D PUT^%W1PRM("DLVCSR",%ARG("DLVCSR")) ; I $G(%ARG("CALLCENTER"))!($G(%ARG("CALLCENTER"))=0) D .D PUT^%W1PRM("CALLCENTER",%ARG("CALLCENTER")) .I +$G(%ARG("CALLCENTER"))=.5 D ..D PUT^%W1PRM("DLVCSR",2) Q ; ; CHNREST(MSD) ; D PUT^%W1PRM("MSD",MSD) Q ; SHOWOPT(STAM) ; I '$$MMCC^W4PRM Q 1 I $G(%ARG("MSDR"))'=$$GETP^%W1PRM("MSDR0") Q 1 I $$CC Q 0 Q 1 ; SHOWMAIN() ; I '$$MMCC^W4PRM Q 1 I $$GETP^%W1PRM("MSDR")'=$$GETP^%W1PRM("MSDR0") Q 0 Q 1 ; CC(STAM) I '$$MMCC^W4PRM Q 1 N MSD S MSD=$G(%ARG("MSD")) I MSD="" S MSD=$$GETP^%W1PRM("MSD") I MSD="ALL"!(MSD="")!(MSD=$G(%ARG("MSDR"))) Q 1 Q 0 ; MAINCC(STAM) ; I $$SHOWMAIN&$$CC Q 1 Q 0 W3C2M W3C2M ; [ 08.07.19 10:18 ] [ 06.01.08 12:04 ] [ 29.12.07 11:07 ] S FL=$$WEBL^W3MAIN_"cities.htm" O FL:(READONLY:REWIND) ;;S $ZT="G CFL" F U FL R A Q:A["1392&(IND<(1392+123)) ST1=ST1_$C(IND-1392) S IND="" Q .I FL S IND=IND_$E(ST,J) Q .S ST1=ST1_$E(ST,J) Q ST1 W3CHRST W3CHRST ; [ 18.12.25 17:07 ] [ 21.12.17 17:20 ] [ 12.09.17 13:59 ] N (JB,%ARG,%REM) N PAD S PAD=6 I $$^W4TABLET=2 S PAD=8 S MSDR=$$MSDR^W4PRM Q:'MSDR ; W "
",! W "
" W ""_$$^%W1DICT("CHOICEBRANCH")_"",! W "

" ; W "",! S N="" F S N=$O(^[$$^W3MAIN]W3MSDR(MSDR,N)) Q:N="" D .I $$DLVWEB^W4DLVCSR,+N=+MSDR Q .S A=$G(^(N)) .W " " .N BGCOLOR,COLOR S BGCOLOR="white",COLOR="green" .I +N=+$$CUR S BGCOLOR="white",COLOR="red" .W " ",! .W " ",! W "
" . W $$H2U^%L1FRM($$MSDN^W3R(N)) .W "
" W "
" ;;D BACK W "
" W "
",! Q ; ; BACK ; W " ",! W " " W " ",! W "
" W "" W "
",! Q ; CUR(STAM) ; I $$GETP^%W1PRM("MRKTO") Q $$GETP^%W1PRM("MRKTO") Q $$MSD^W3HZMST(JB) W3CIB W3CIB ; [ 25.02.12 15:06 ] [ 26.04.11 17:12 ] [ 21.04.11 17:51 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D ^%L1TS CYC ; ; D GL K @GL S %W1LNG="H" ; S DAT=$ZD($H,"YYMMDD") L +^W3CIB(DAT):2 S K=0 S ENDSMB=4 ; S ^LLL($J)=0 U 0 S ST="" ; F R *A:1 Q:A>-1 ; S ST=$C(A) F R *A:1 Q:A=ENDSMB Q:A=-1 D .S ST=ST_$C(A) .I $C(A)=">" D S ST="" ..D SETST ; S ^LLL($J)=.1 I $L(ST) D SETST ; S ^LLL($J)=.2 L -^W3CIB(DAT) ; S ^LLL($J)=1 ; D ^W3CIBORD ; S ^LLL($J)=2_";"_$G(RES)_";"_$H K @GL ; S RES=RES_$C(13) U $P:(NOWRAP:NOWRAP) W RES,!,# Q ; DCD(A) ; N J,B,CHR S B="",J=0 DCDC S J=J+1 I J>$L(A) G DCDE S CHR=$A(A,J) I CHR'=215 D G DCDC .S B=B_$C(CHR) S J=J+1 I J>$L(A) G DCDE S CHR=$A(A,J) S B=B_$C(CHR-16) G DCDC DCDE ; Q B ; GL ; S GL="^[$$^W3MAIN]TMPCIB(MYDVN,UR)" S MYDVN=$J ;$$^%L3MYDVN S UR=1 Q SETST ; I ST="" Q N ST1 S ST1=ST I ST["<" S ST1=$P(ST,"<") D SETST1 S ST1="<"_$P(ST,"<",2,200) D SETST1 Q SETST1 ; I ST1="" Q N B,C,LI,J S LI=$O(^W3CIB(DAT,999999),-1)+1 S B=$$DCD(ST1) S B=$TR(B,$C(13,10),"") S K=K+1,@GL@(K)=B S ^W3CIB(DAT,LI)=B Q W3CIBORD W3CIBORD ; [ 25.02.12 15:23 ] [ 21.04.11 17:31 ] [ 20.04.11 23:48 ] ;---- MEMSHAK LE CIBUS N (%ARG,%REM,RES) D GL^W3CIB N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S RES="NOK" S %W1LNG="H" ; S TMPORD="^[$$^W3MAIN]TMPORD(JB)" ; S ORDERINFO="ORDERS_INFO" S ORDER="ORDER" S RESTINFO="REST_INFO" S COMPINFO="COMPANY_INFO" S ADDRESS="ADDRESS" S DISHES="ORDER" S DISHEL="DISH" S SUBEL="SDISH" S SUBS="SIDE_GROUP" ; GROUP ORDERS -- ???????????????? S I=0,BGOIO=0 CYC S I=I+1 I '$D(@GL@(I)) G END S A=$G(^(I)) ;;U 0 W A,! I A[("<"_ORDERINFO) D .S BGSNG=I .S REST=$$GET(BGSNG,"ID",RESTINFO) I 'REST S RES="NOREST" Q .S MSD=$G(^[$$^W3MAIN]W3CIB2M(REST)) I MSD="" S RES="NOMSD" Q . .S CITY=$$GET(BGSNG,"CITY",ADDRESS,"H") .S STREET=$$GET(BGSNG,"STREET",ADDRESS,"H") .S HOME=$$GET(BGSNG,"NUMBER",ADDRESS,"H") .S COMP=$$GET(BGSNG,"NAME",COMPINFO,"H") ; ??????? .S PHONE01=$TR($$GET(BGSNG,"PHONE",COMPINFO)," ","") .S BGOI=$$FIND(BGSNG,ORDER,ORDERINFO) CYCORD . .I 'BGOI G CYC .I BGOI=99999 S I=BGOIO+1 G CYC .S JB=$$^%W1SsID("TCIB") .D PUT^%W1PRM("MSD",MSD) .K @TMPORD S K=0 .S PHONE02=$$GET(BGOI,"USER_PHONE",ORDER) .S NAME=$$GET(BGOI,"USER_NAME",ORDER,"H") .S CODE=$S(PHONE01:PHONE01,PHONE02:PHONE02,1:"1111111") .I CODE="" S RES="NOPHONE" Q .D PUT^%W1PRM("CODE",CODE) . .S ZMANK=$ZD($H,"DD.MM.YY 24:60") . .S ASM=$$GET(BGOI,"ORDER_ID",ORDER) . .S TOTIME=$$GET(BGOI,"TIME",ORDER) .D ..S DAT=$ZD($H,"DD.MM.YY"),SHAA="" ..I TOTIME?.E2N1"/"2N1"/"4N1" "2N1":"2N1":"2N.E D Q ...S DAT=$P(TOTIME," ") ...S DAT=$E(DAT,1,2)_"."_$E(DAT,4,5)_"."_$E(DAT,9,10) ...S SHAA=$P($P(TOTIME," ",2),":",1,2) ..I TOTIME?.E2N1":"2N1":"2N.E D ...S DAT=$ZD($H,"DD.MM.YY") ...S SHAA=$P(TOTIME,":",1,2) . .I DAT=$ZD($H,"DD.MM.YY"),SHAA*3600+($P(SHAA,":",2)*60)-$P($H,",",2)<1800 D ..S SHAA=$$TM^W3TIME($H,CITY) . .D PUT^W3HZMST(JB,"NAME",NAME) .D PUT^W3HZMST(JB,"NMB",CODE) .D PUT^W3HZMST(JB,"CODE",CODE) .D PUT^W3HZMST(JB,"PELE",PHONE02) .D PUT^W3HZMST(JB,"DAT",DAT) .D PUT^W3HZMST(JB,"SHAA",SHAA) .D PUT^W3HZMST(JB,"DATCB",ZMANK) .D PUT^W3HZMST(JB,"HZMLAK",ASM) . .D PUT^W3HZMST(JB,"MKR",5) ; . .S CODTS=5 .S CIBCARD=$$GET(BGOI,"USER_CARD",ORDER) .D PUT^W3HZMST(JB,"CODTS",CODTS) .D PUT^W3HZMST(JB,"CIBCARD",$$^W3ENCR(JB_";"_CIBCARD)) . .S COMMENT="" .S CMHD=$$GET(BGOI,"COMMENTS",ORDER,"H") .S FLAT="" .S ENTRANCE="" ;$$GET(BGSNG,"entrance",ORDER,"H") ; ??????????? .S FLOOR="" ;$$GET(BGSNG,"floor",ORDER,"H") ; ??????????? . .D PUT^W3HZMST(JB,"CITY",CITY) .D PUT^W3HZMST(JB,"STREET",STREET) .D PUT^W3HZMST(JB,"COMMENT",COMMENT) .D PUT^W3HZMST(JB,"HOME",HOME) .D PUT^W3HZMST(JB,"FLAT",FLAT) .D PUT^W3HZMST(JB,"FLOOR",FLOOR) .D PUT^W3HZMST(JB,"ENTRANCE",ENTRANCE) .D PUT^W3HZMST(JB,"COMP",COMP) .D PUT^W3HZMST(JB,"CMHD",ASM_":CIB "_CMHD) . .S DMSH="" ;$$GET(BGSNG,"delivery_price",ORDER) ??????????? .S HNH="" ; $$GET(BGSNG,"discount",ORDER) ????????????? .S TSHL=$$GET(BGOI,"TOTAL_PRICE",ORDER) . .D PUT^W3HZMST(JB,"DMSH",DMSH) ; .D PUT^W3HZMST(JB,"HNH",HNH) .D PUT^W3HZMST(JB,"TSHL",TSHL) . .;;D SENDOK^W3CIB(MSADDR_"/InProcess",MSD) ; ???????????? .S BGDI=BGOI CYCD .S BGDI=$$FIND(BGDI,DISHEL,ORDER) .I 'BGDI D NEWHZ S BGOIO=BGOI,BGOI=$$FIND(BGOI+1,ORDER,ORDERINFO) G CYCORD .; .S CD=$$GET(BGDI,"ID",DISHEL) .;;U 0 W "CD="_CD,! .S NM=$$GET(BGDI,"NAME",DISHEL) .I $$CDTXT S CD=$$CD(NM,CD),NM=$$DESC(NM) .;;S CD=$$CONVCD(CD) .S PRC="" I CD D ..S PRC=$$MH^W3P(CD) .S QN=$$GET(BGDI,"MULTIPLY",DISHEL) .S CMNT="" ;$$GET(BGDI,"user_food_comments",DISHEL) ; ????????????? .S CMNT=$TR(CMNT,"*!","") .S CMNT=$$SPA^%L1FRM(CMNT) .S CMNT=$$SP1^%L1FRM(CMNT) .S MAZMIN="" ;$$GET(BGDI,"AssignedUserName",DISHEL) ; - ????????? .I MAZMIN'="" S CMNT=CMNT_" [ "_MAZMIN_" ]" .S K=K+1 .S @TMPORD@(K)="0~"_CD_"~"_$$INVH^%L1FRM(NM)_"~"_$J(PRC,2,2)_"~"_QN_"~~"_$$INVH^%L1FRM(CMNT) . .S BGSI=BGDI CYCSUBS .S BGSI=$$FIND(BGSI,SUBEL,DISHEL) .I 'BGSI S BGDI=$$FINDEND(BGDI,DISHEL,ORDER) G CYCD .; .S CDT=$$GET(BGSI,"ID",SUBEL) .S NMT=$$GET(BGSI,"NAME",SUBEL) .I $$CDTXT S CDT=$$CD(NMT,CDT),NMT=$$DESC(NMT) .S PRCT=0 ;;$$GET(BGSI,"extra_price",SUBEL) ; ???????? .I $G(CD),$G(CDT),$G(@$$^W4GL("MHT")@(CD,CDT)) D ..S PRCT=^(CDT) .S K=K+1 .S:'$G(QNT) QNT=1 .S @TMPORD@(K)="1~"_CDT_"~"_$$INVH^%L1FRM(NMT)_"~"_$J(PRCT,2,2)_"~"_QNT .S BGSI=$$FINDEND(BGSI,SUBEL,DISHEL) .G CYCSUBS ; G CYC END Q ; GET(I,EL,PARENT,PRHB,FORW) N IND S IND=$$FIND(I,EL,PARENT,"",$G(FORW)) I 'IND Q "" Q $$GETVL(IND,EL,$G(PRHB)) ; FIND(I,EL,PARENT,PR,FORW) ; N OK,A,J,J1,START S OK=0 S START=I+1 ; I $G(FORW)="F" D .F J1=START:1 Q:'$D(@GL@(J1)) S A=$G(^(J1)) Q:A[("<"_PARENT_">") Q:A[("<"_PARENT_" ") .I $D(@GL@(J1)) S START=J1+1 Q .S START="END" I START="END" Q 0 ; F J=START:1 Q:'$D(@GL@(J)) S A=$G(^(J)) Q:A[("") D Q:OK .I '$G(PR)!($G(PR)=2),A[("<"_EL_">") S OK=J ;;+1 .I $G(PR),A[("<"_EL_" ") S OK=J ;;W "FIND: I="_I_" EL="_EL_" PARENT="_PARENT_" OK="_OK,! Q OK ; FINDEND(I,EL,PARENT) ; N OK,J S OK=0 F J=I+1:1 Q:'$D(@GL@(J)) S A=$G(^(J)) Q:A[("") I A[("") S OK=J Q ;;W "FINDEND: I="_I_" EL="_EL_" PARENT="_PARENT_" OK="_OK,! I 'OK Q 99999 Q OK ; GETVL(I,EL,PR) ; N A,A1,ZN S A=$G(@GL@(I)) S A1=$G(@GL@(I+1)) I A1["<",A1[">" Q "" I A="" Q "" S ZN=A1 I A1[("<"_EL) D .S ZN=$P(A,"<"_EL_">",2) .S ZN=$P(ZN,"") S ZN=$$REG(ZN) S ZN=$$SPA^%L1FRM(ZN) I ZN="UNDEFINED" Q "" I $G(PR)="H" D .S ZN=$$INVH^%L1FRM(ZN) Q ZN ; NEWHZ ; S HNH=$J($$TOTORD^W3HZMST(JB)-TSHL,2,2) D PUT^W3HZMST(JB,"HNH",HNH) ; D TERM^W3ORDVW S RES="OK" ;;S ^[$$^W3MAIN]W3CIBORD(ASM,JB)=MSD_";"_$ZD($H,"DD.MM.YY 24:60") K ^[$$^W3MAIN]TMPORD(JB) Q ; CD(TXT,CD) ; I TXT?1N.N1" - ".E Q $P(TXT," - ") I TXT?1N.N1"-".E Q $P(TXT,"-") I TXT?1N.N1" . ".E Q $P(TXT," . ") I TXT?1N.N1".".E Q $P(TXT,".") Q "0-"_CD ; DESC(TXT) ; I TXT?1N.N1" - ".E Q $P(TXT," - ",2,20) I TXT?1N.N1"-".E Q $P(TXT,"-",2,20) I TXT?1N.N1".".E Q $P(TXT,".",2,20) I TXT?1N.N1" . ".E Q $P(TXT," . ",2,20) Q TXT ; REG(TXT) ; N ENG S ENG=0 I '$D(TSS) D ^%L1TS I $G(TXT)="" Q $G(TXT) S TXT=$$RPL^%L1FRM(TXT,"&","&") S TXT=$$RPL^%L1FRM(TXT,"&qout;","'") S TXT=$$RPL^%L1FRM(TXT," "," ") S TXT=$TR(TXT,"`","'") S TXT=$$FUNC^%UCASE(TXT) S TXT=$TR(TXT,TSS,TS0) Q TXT ; CDTXT(STAM) ; Q 1 ;I MSD=1!(MSD=99999) Q 1 Q 0 ; CONVCD(CD) ; I CD="" Q 0 I $P(CD,"=",2) S CD=$P(CD,"=",2) Q CD Q "0-"_$P(CD,"=") W3CLND W3CLND ; [ 17.02.09 20:46 ] [ 14.11.08 04:16 ] [ 27.10.08 09:34 ] N I,DD,DD0,DH,BGC,MEDT S:'$D(JB) JB=0 S MEDT=+$H I $$GET^%W1PRM("FUTDAT") S MEDT=$$GET^%W1PRM("FUTDAT") F I=MEDT:1:$H+27 D .S ^[$$^W3MAIN]TMPCLN(JB,I-MEDT+1)=I_"~"_$P($$^%L1DC(I,1),".")_"~"_$$^%W1DICT("DAY"_$$^%L1DC(I,8)) VIEW ; S BGC="white" W "",! F I=1:1 Q:'$D(^[$$^W3MAIN]TMPCLN(JB,I)) D .S DH=$P($G(^(I)),"~") .S DD=$P($G(^(I)),"~",2) .S DD0=$P($G(^(I-1)),"~",2) .I I>1&(DD" .N HR S HR=0 .I $$^W3VLDDT(DH)>0 W "" S HR=1 .W DD .I HR W "" .W "",! W " ",! S BGC="white" W " ",! F I=1:1 Q:'$D(^[$$^W3MAIN]TMPCLN(JB,I)) D .S DD=$P($G(^(I)),"~",2) .S DD0=$P($G(^(I-1)),"~",2) .I I>1&(DD"_$P($G(^[$$^W3MAIN]TMPCLN(JB,I)),"~",3)_"",! W " ",! W "
",! Q W3CLOSEM W3CLOSEM(MSD) ; [ 02.12.12 13:00 ] [ I '$G(MSD) Q 0 I $G(^[$$^W3MAIN]W3CLOSEM(MSD)) Q 1 Q 0 W3CLSET W3CLSET ; [ 23.04.12 21:36 ] [ 25.06.08 12:54 ] [ S MSDR=1 S $ZT="CYC" S N="" CYC F S N=$O(^W3MSDR(MSDR,N)) Q:N="" D:$G(^(N)) .S UCI=$G(^UCI(N)) Q:UCI="" .D SETA Q SETA ; W !,N," ",UCI,! K MS N N,NS,SET S N="" F S N=$O(^[UCI]P1EZA(N)) Q:N="" D .S NS="" F S NS=$O(^[UCI]P1EZA(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" ; S N="" F S N=$O(^[UCI]P1EZT(N)) Q:N="" D .S NS="" F S NS=$O(^[UCI]P1EZT(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" ; S SET="" F S SET=$O(^[UCI]P1SETA(SET)) Q:SET="" I '$D(MS(SET)) K ^[UCI]P1SETA(SET) Q W3CNTRY W3CNTRY ; [ 13.05.08 22:28 ] [ LNG(COUNTRY) ; Q $P($G(^[$$^W3MAIN]W3CNTRY(COUNTRY)),"\") MTB(COUNTRY) ; Q $P($G(^[$$^W3MAIN]W3CNTRY(COUNTRY)),"\",2) W3CODE W3CODE(STAM) ; [ 21.10.18 08:55 ] [ 07.01.08 11:42 ] [ 12.07.07 09:58 ] [ Q +$G(@$$^W4GL("W3CODE")) W3COLOR W3COLOR ; [ 09.01.10 16:27 ] [ 23.12.07 20:21 ] [ W "",! W "",! W3COLORG W3COLORG(SCR,KEY,ID,VL) ; [ 25.09.18 07:19 ] [ 24.09.18 12:42 ] [ 25.04.12 18:44 ] N VL S VL="" I $G(SCR)=""!($G(KEY)="")!($G(ID)="") Q VL ; I SCR["W3COLOR",ID="CL1" Q $G(^[$$^W3MAIN]W3COLOR(KEY)) ; I SCR="W3COLOR" D ;------ HEADER PARTITION --------------- .I ID="FONTFM" S VL=$$FUNC^%LCASE($P($$FONTFM^W3CSS,":",2)) .I ID="BORD" D ..S VL='$$NOBORD^W3CSS(KEY) . .I ID="BGHDORD" D ..S VL=$$BGHDORD^W3CSS(KEY) ..D GETBG . .F I="PSWCOLOR","FORGPSW","FGSC","FGPHONE","BGINP","FRINP","PHONEIMG" I ID=I D ..S VL=$$GETVL(I) . .I ID="WELCOME" S VL=$$WELCOMECOLOR^W3CSS(KEY) .I ID="MEMBHERE" S VL=$$CONTRAST^W3CSS(KEY) .I ID="PHONEIMG" S VL=$$PHONEIMG^W3CSS(KEY) .I ID="BTNWH" S VL=$G(^[$$^W3MAIN]W3COLOR(KEY,"BTNWH")) . .F I="USRCOLOR","RMBME","SUBMBTN","SIGNBTN","SRCHBTN","LOGO" I ID=I D ..S VL=$$GETVL(I) ; ; I SCR="W3COLORG" D ;----------------- GROUPS ---------------------------- .N I F I="BGGROUP","BGTRGR","FGGROUP","FGPRINT","FGMENU","BCURGR","FGCURGR","HGTRGR","BGSUBHD","FGSUBHD" D ..I ID=I S VL=$$GETVL(I) ; ; I SCR="W3COLORI" D ;--------------- ITEMS ------------------------------- .N I F I="BGITEMS","BGGRIT","FGITEMS","FGCD","FGMH","FGDET","BGCHOOS","FGLINE","FGLEV","FONTIT","FONTDET","FONTCD","FONTMH","BCGRIT","FGGRIT","FGPRESS","BGITSHOW","FGHDITS","FONTHITS" D ..I ID=I S VL=$$GETVL(I) .I ID="CODE" S (VL,CODE)=+$$CODE^W3PRM .I ID="ITORDBRD" S VL=$$PRM^W3IMG("ITORDBRD") .I ID="FGDETITS" S VL=$$PRM^W3IMG("FGDETITS") .I ID="PICTURE" S (VL,PICTURE)=+$$PICTURE^W3PRM ; ; I SCR="W3COLORA" D ;--------------- ADDITIONS ------------------------------ .N I F I="BGADD","FGADD","BGADDIT","FGADDIT","ADDBOLD","FGADDTO","FGHDADD","FGMHADD","FGMAXADD","FGTOTADD","FGADDCHS","FGPLUS","FGMIN" D ..I ID=I S VL=$$GETVL(I) .I ID="CLKAVADD" S VL=$$PRM^W3IMG("CLKAVADD") ; ; I SCR="W3COLORO" D ;--------------- ORDER ------------------------------- .N I F I="BGBDORD","BGTBLORD","BGORDHD","FGORDHD","BGTDORD","FGORDCD","FGORDIT","FGORDMH","FGORDADD","FGORDCMN" D ..I ID=I S VL=$$GETVL(I) ; I SCR="W3COLORB" D ;-------------- BOTTOM ------------------------------ .N I F I="BGORDB","FGBOT","FG2PAY" D ..I ID=I S VL=$$GETVL(I) .F I="BACK2ENT","FGDLVPAY","FGDISC","TERMORD" D ..I ID=I S VL=$$PRM^W3IMG(I) ; I SCR="W3COLORV" D ;-------------- NEXT ------------------------------ .N I F I="BGNEXT","BGHD","BGBODY","FGBODY","FGHD","FRHD","FGHDUS","FGHDMSD","FRHDFLD","WGHDFLD","FGFLD","WGFLD","BGTB","FRTB","MENUBO" D ..I ID=I S VL=$$GETVL(I) I $E(I,1,2)="BG" .; .N I F I="FGODHD1","FGODHD2","FGITVW","FGADDVW","FGCMNTVW","FGENCR","FGSUGT","FGDLVPAY","FGTOT" D ..I ID=I S VL=$$GETVL(I) ; Q VL ; ; GETBG ; I VL?1"background-color:".e S VL=$P(VL,":",2,50) I VL?1"background-image:".e S VL=$P(VL,":",2,50) I VL["url('" S VL=$P($P(VL,"url('",2),"'") I VL["url(""" S VL=$P($P(VL,"url(""",2),"""") Q ; GETVL(I) ; N VL S VL=$G(^[$$^W3MAIN]W3COLOR(KEY,I)) I $E(I,1,2)="BG"!(I="BCURGR") D GETBG Q VL W3COLORS W3COLORS(SCR,KEY,ID,VL) ; [ 24.09.18 11:25 ] [ 25.04.12 18:44 ] [ 23.01.12 18:11 ] N (SCR,KEY,ID,VL) S OK=0 I SCR["W3COLOR" N CL S CL=KEY ; I SCR["W3COLOR",ID="CL1" S ^[$$^W3MAIN]W3COLOR(CL)=VL ; I SCR="W3COLOR" D .F I="FONTFM","PSWCOLOR","FORGPSW","FGSC","FGPHONE","PHONEIMG","BGINP","FRINP","BTNWH" I ID=I D ..S:VL[":" VL=$P(VL,":",2) ..I VL'["." S VL=$$FUNC^%UCASE(VL) ..S ^[$$^W3MAIN]W3COLOR(CL,I)=VL . .I ID="BORD" S ^[$$^W3MAIN]W3COLOR(CL,"NOBORD")='VL . .I ID="BGHDORD" D SVBG S ^[$$^W3MAIN]W3COLOR(CL,"BGHDORD")=VL . .I ID="WELCOME" S:VL[":" VL=$P(VL,":",2) S ^[$$^W3MAIN]W3COLOR(CL,"WELCOMECOLOR")=VL . .I ID="MEMBHERE" S:VL[":" VL=$P(VL,":",2) S ^[$$^W3MAIN]W3COLOR(CL,"CONTRAST")=VL . .F I="USRCOLOR","RMBME","SUBMBTN","SIGNBTN","SRCHBTN","LOGO" I ID=I D ..S ^[$$^W3MAIN]W3COLOR(CL,I)=VL ; ; I SCR="W3COLORG" D .F I="BGGROUP","BGTRGR","FGGROUP","FGPRINT","FGMENU","BCURGR","FGCURGR","HGTRGR","BGSUBHD","FGSUBHD" D ..D SETCOLOR ; ; I SCR="W3COLORI" D ;---------------------------------------------- .N I F I="CODE","PICTURE","BGITEMS","BGGRIT","FGITEMS","FGCD","FGMH","FGDET","BGCHOOS","FGLINE","FGLEV","FONTIT","FONTDET","FONTCD","FONTMH","BCGRIT","FGGRIT","FGPRESS","BGITSHOW","FGHDITS","FONTHITS" D ..D SETCOLOR .I ID="CODE" S @$$^W4GL("W3PRM")@("CODE")=+VL .I ID="PICTURE" S @$$^W4GL("W3PRM")@("PICTURE")=+VL .I ID["FONT" S ^[$$^W3MAIN]W3COLOR(CL,ID)=+VL_"pt" .I ID="ITORDBRD" S ^[$$^W3MAIN]W3COLOR(CL,ID)=+VL .I ID="FGDETITS" S ^[$$^W3MAIN]W3COLOR(CL,ID)=VL ; ; I SCR="W3COLORA" D ;---------------------------------------------- .N I F I="BGADD","FGADD","BGADDIT","FGADDIT","ADDBOLD","FGADDTO","FGHDADD","FGMHADD","FGMAXADD","FGTOTADD","FGADDCHS","FGPLUS","FGMIN" D ..D SETCOLOR .I ID="CLKAVADD" S ^[$$^W3MAIN]W3COLOR(CL,ID)=VL ; ; I SCR="W3COLORO" D ;---------------------------------------------- .N I F I="BGBDORD","BGTBLORD","BGORDHD","FGORDHD","BGTDORD","FGORDCD","FGORDIT","FGORDMH","FGORDADD","FGORDCMN" D ..D SETCOLOR ; ; I SCR="W3COLORB" D ;---------------------------------------------- .N I F I="BGORDB","FGBOT","FG2PAY" D ..D SETCOLOR .F I="BACK2ENT","FGDLVPAY","FGDISC","TERMORD" I ID=I D ..S:VL[":" VL=$P(VL,":",2) ..S ^[$$^W3MAIN]W3COLOR(CL,I)=VL ; ; I SCR="W3COLORV" D ;---------------------------------------------- .F I="BGNEXT","BGBODY","BGHD","FRHD","FGHDUS","FGHDMSD","FRHDFLD","WGHDFLD","FGFLD","WGFLD","BGTB","FRTB","FGITVW","FGADDVW","FGCMNTVW","FGENCR","FGODHD1","FGODHD2","FGSUGT","FGDLVPAY","FGBODY","FGTOT","MENUBO" D ..I ID=I D ...I $E(I,1,2)="BG",I'="BGHD" D SVBG S ^[$$^W3MAIN]W3COLOR(CL,I)=VL Q ...I $E(I,1,2)="FG"!(I'="FR") S:VL[":" VL=$P(VL,":",2) S ^[$$^W3MAIN]W3COLOR(CL,I)=VL Q ...S ^[$$^W3MAIN]W3COLOR(CL,I)=VL ; S OK=1 Q OK ; ; SETCOLOR ; I ID=I D .S:VL[":" VL=$P(VL,":",2) .I $E(I,1,2)="BG",I'="BGHD" D SVBG .I I="BCURGR" D SVBG .S ^[$$^W3MAIN]W3COLOR(CL,I)=VL Q ; GETBG ; I VL[":" S VL=$P(VL,":",2) I VL["url" S VL=$P($P(VL,"url('",2),"'") Q ; SVBG ; I VL[":" Q I VL["." S VL="background-image:url('"_$$FUNC^%LCASE(VL)_"')" Q I VL["-" Q I VL["^" Q S VL="background-color:"_VL Q W3COMP W3COMP(PRM,CODE) ; [ 18.12.25 17:07 ] [ 17.10.18 12:24 ] [ 06.06.12 16:35 ] N (JB,%ARG,CODE,PRM) N TDWIDTH,TDALIGN,TDDIR D KILL^%W3DEB("W3COMP") D PUT^%W3DEB("W3COMP","CODE=CODE & PRM=PRM & %ARG=[%ARG") S PR800=$$GET^%W1PRM("PR800") ; N MSD S MSD=$$GET^%W1PRM("MSD") ;;I $G(MSD) S $ZGBLDIR=$$^W3UCI(MSD) D PUT^%W3DEB("W3COMP","MSD=MSD") ; N GL D GL I '$D(CODE) S CODE="" N PRNEW S PRNEW=0 I $G(CODE)["NEW" S CODE="",PRNEW=1 ; W "
",! W "
"_$$^%W1DICT("CHOICECOLOR")_"
",! W "",! W "
" W $$^%W1DICT("MAINCUSTOMER")_"
",! ; W ""_$$^%W1DICT("FLDMUSTASTR")_"",! W "
",! ; W "",! W "" ;S TDSPAN=2 D CODE,NAME,PSW W "",! W "
",! ; W "",! ; I '$$OUTCOMP^W3VHOD D .W "",! .D GROUP,MAZAV .W "",! ; W "",! D NMB,FAX W "",! ; W "",! D EMAIL("EMAIL") W "",! ; W "" D CONTACTMAN,PELE W "",! ; W "" D CITY D STREET W "",! ; W "",! D HOME D ENTRANCE W "",! W "",! D FLOOR D MIKUD W "",! ; W "",! D COMMENT W "",! ; W "",! D TZ,DMSHNIS W "",! ; W "
",! W "",! W "
",! ; ; W "
",! ; W "",! ; W "
",! D ROUNDBUT^%W1JS("rbtsubm",$$^%W1DICT("SUBMIT"),"Submit('"_PRNEW_"','"_MSD_"')","color:green","wh,22") W "",! D ROUNDBUT^%W1JS("rbtback",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") W "
",! W "
",! ;W "",! Q ; ; CODE S TDWIDTH="18%" D TD W " "_$$^%W1DICT("COMPANYCODE")_"
" ; I $$OUTCOMP^W3VHOD D Q .W "" .W $$OUTCOMP^W3VHOD W "",! ; D INPC("CODE",100,12) W "  ",! W "",! Q ; PSW S TDWIDTH="18%" S TDALIGN=$S($$^%W1DIR="RTL":"left",1:"right") D TD W " "_$$ZW_$$^%W1DICT("PASSWORD")_" " W ""_$$^%W1DICT("NUMBERONLY")_" " W "" D INP("PSW",100,12,"LTR") Q ; GROUP D TD W " "_$$^%W1DICT("CUSTGROUP")_"" W " " W "",! W "  " W ""_$$^%W1DICT("DISCONT")_" "_$S($G(CODE):$$AH^W4L(CODE)_" %",1:"")_"" W "",! Q ; GROUPSEL(CODE) ; N SELECTED,SEL S SEL="" N N S N="" F S N=$O(@$$^W4GL("SUGL")@(N)) Q:N="" D .S SELECTED="" .I $G(CODE),$$SUGL^W4L(CODE)=N S SELECTED=" selected=""selected""" .S SEL=SEL_"