%RO Routine Output Utility GT.M 27-APR-2025 17:17:32 %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 ; [ 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 %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 ^S111($J,%I)=%LIGHT1_%N_%CCL_"" LINE:""_$J(%ZA,4)_"" ,COL: ""_%ZB S %I=%I+1 S ^S111($J,%I)=$T(+%ZA) S %I=%I+1 S ^S111($J,%I)=""""" K ^S111($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 ^S111($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 ; [ 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????????¨????????¦????????²????????€š?¬?????¬???????¬??????‚¬????¬??????¬?????????????©????????°/" 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????????¨????????¦????????²????????€š?¬?????¬???????¬??????‚¬????¬??????¬?????????????©????????°/" ; 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) ; [ 14.04.24 14:03 ] [ 03.07.23 06:35 ] [ 05.02.15 16:39 ] 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 %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) ; [ 10.12.24 09:54 ] [ 10.11.24 11:06 ] [ 29.10.24 07:26 ] 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 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),^S111($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))=^S111($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),^S111($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),^S111($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))=^S111($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),^S111($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 ^S111($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 ^S111($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,^S111($J,%SH)=TXT K TXT Q VIEW Q:'$G(U) N %RN S %RN=$P($P($E(^S111($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="^S111($J)",MAC2="^S999($J)" D ^%S1GC1 .K ^S111($J) .F I=1:1 U %RN R A Q:$ZEOF S ^S111($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 ^S111($J) .S MAC2="^S111($J)",MAC1="^S999($J)" D ^%S1GC1 .K ^S999($J) EVIEW Q ; ERG ; Q:'$G(U) N %PR S %PR=$P($P($E(^S111($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 ; [ 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 I NAME'="" S CMD=CMD_" -name """_NAME_""" " I SIZE'="" S CMD=CMD_" -size "_SIZE_" " 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 ; [ 05.02.25 11:34 ] [ 02.01.25 07:42 ] [ 12.11.24 17:55 ] 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 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 $$^%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 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,%CHAST(%NR,%KSS)=$J(%FRAZA,%DLG) 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) ; K %ARG N I,COUP,A,B F I=1:1:$L(TX,"&") D .S COUP=$P(TX,"&",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 ;service@greystone.com %GO;19920722 21:35;global input [ 09.05.06 06:50 ] [ 26.04.06 12:50 ] [ 24.04.06 07:11 ] ;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 ; 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,%ZD,fmt s (sel,rest,glg)="" ZI f d q:$l(%ZD) . r !,"Input file: ",%ZD,! . 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 ZS r !,"Selective restore ? (y/n) ",sel i sel="^" g ZI 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 [ 06.06.10 11:31 ] [ 03.08.05 11:01 ] [ 20.04.05 11:37 ] ;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 %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) [ 14.04.22 17:52 ] [ 01.04.20 04:56 ] [ 20.04.07 18:28 ] 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 .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 ^S111($J) F U %NMF R A Q:$ZEOF D .S ^S111($J,$O(^S111($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 ^S111($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(^S111($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(^S2VS111($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 ^S111($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,^S111($J,I)=""<<""_N_""+""_J_"">>"",I=I+1,^S111($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 ^S111($J) S N="",I=0 F S N=$O(^msg("I",N)) Q:N="" D .S I=I+1,^S111($J,I)=$J($G(^msg("I",N,1)),70)_"."_$J(N,3) .S ^S111($J,I+1)=$J($G(^msg("I",N,0)),70) .S ^S111($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(^S111($J)) D .K ^TEMPo($P) N I,A,A1,%NM,%DT,%SZ,%TM .F I=1:1 Q:'$D(^S111($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 ^S111($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 ^S111($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,^S111($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 ; ^S111 --> 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(^S111($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(^S111(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(^S111(PRT,I1)) Q:^(I1)'?.P .Q:'$D(^S111(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(^S111($J)) ; S %S2V("TXT")=" mifkxnn zegec zxardd lewehext " D ^%S2VIEW K ^S111($J) Q ; S1(TXT) ; S ^S111($J,$O(^S111($J,999999),-1)+1)=$J("",SM)_TXT Q FORM ; Q:'$D(^L1PCSND($P)) K ^S111($J) S SM=5 S ^S111($J,1)=$J("",SM)_"-------------------------------------------------------------" S ^S111($J,2)=$J("",SM)_": d`vez : zxeywz onf : fkxn my : fkxn :" S ^S111($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(^S111($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 ^S111($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 ^S111($J,I)=$$CL^%L1LPT(A) ..I $L(^S111($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 ^S111($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 ^S111($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 ^S111($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 ^S111($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 ^S111($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(^S111($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 ^S111($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 ^S111($J,I)=$$CL^%L1LPT(A) ..I $L(^S111($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 ^S111($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 ^S111($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 ^S111($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 ^S111($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 ^S111($J,I)=$$CL^%L1LPT(A) ..I $L(^S111($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 ^S111($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 ^S111($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 ^S111($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; [ 05.03.21 12:43 ] [ 21.05.03 17:01 ] [ 11/26/95 9:38 PM ] 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 D ^%RO Q 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) 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^%RO 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 %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 ;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 %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 ^S111($J) S I=0 f u %R r X S I=I+1,^S111($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 ^S111($J,$ZP(^S111($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 ^S111($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,^S111($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 ^S111($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(^S111($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="^S111($J)",MAC2="^S999($J)" D ^%S1GC1 .K ^S111($J) D ^%L1TS .S %S2V("NOHB")="" .S %S2V("TXT1")=" PRESS TO EXIT " .S PRT=$J D IN^%S2V .K ^S111($J) .S MAC2="^S111($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(^S111($J,U),1,5)," ","") .I $G(zl) S $E(^S2VS111($J,zl,U),66,79)="-- KILLED --" .S %MET="S111" 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 ^S111($J),^l1ss($J) S ^S111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^S111($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 ^S111($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 ^S111($J) D FRM S U=0 ; F I=1:1 Q:'$D(^S111($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(^S111($J,U)) K ^S111($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 [ 27.10.24 16:29 ] [ 07.02.23 17:01 ] [ 01.05.22 16:46 ] 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) ; N (T1,T2,SEC) S T1=$$T2S(T1) S T2=$$T2S(T2) S DIF=T1-T2 I $G(SEC) Q DIF 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 %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 ^S111($J) F I=1:1 Q:'$D(^SHP("TCH",I)) S ^S111($J,I)=^(I) S %S2V("PRINT")="" D ^%S2VIEW K ^S111($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 ; [ 29.12.21 12:30 ] [ 06.09.21 15:13 ] [ 02.04.19 18:56 ] N (MCOM,I000,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%Z,%S2ERG,SYSMAN,%W1JSP) I $P'["/vc/2" K ^zcmd($P) ;;D ^%L1DEFWS D ^%L1C ;;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 ^S111($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 ^S111($J,$O(^S111($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 ; GTM ROUTINE RESTORE [ 31.01.24 09:33 ] [ 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 ; I '$D(%zdebug) n $et s $et="zg "_$zl_":ERR^%L2RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI") ; I $G(%L2RI("PROG"))="" G BG ; n sel,dir,ff,%ZD s sel=0,dir="",ff="" s %ZD="/home/gtmuser/"_%L2RI("PROG") 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/"_$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 ^S111($J) M ^S111($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 ; N 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 ^S111($J),^l1ss($J) S ^S111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^S111($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,^S111($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 $$^%L1ZOS(2,%NMF) O %NMF:(NEWVERSION:WRITE) U %NMF F I=1:1 Q:'$D(^S111($J,I)) W ^(I),! C %NMF ZSY "vi "_%NMF I $$^%L1ZOS(2,%NMF) END K ^S111($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 ^S111($J) X "ZL @PROG F I=1:1 Q:$T(+I)="""" S ^S111($J,I)=$T(+I)" D ^%S2VIEW K ^S111($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 ^S111($J) N N,J .S J=0,N="" F S N=$O(^L1TRPRM(JOB,"MSG",N)) Q:N="" D ..S J=J+1,^S111($J,J)=$J(^(N),70) .D ^%S2VIEW K ^S111($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 %L3GR %L3GR ;CDS;GLOBAL RESTORE [ 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 ; 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 ^S111($J) N I F I=2:1 Q:$T(+I)="""" S ^S111($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 ^S111($J) N I F I=2:1 Q:$T(+I)="""" S ^S111($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 ^S111($J) N I F I=2:1 Q:$T(+I)="""" S ^S111($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 ^S111($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 ^S111($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 ^S111($J,$O(^S111($J,9999999),-1)+1)=TXT Q S2 ; S ^S111($J,$O(^S111($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 %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 ^S111($J),^l1ss($J) S ^S111($J,1)="PID STIME TTY ROUTINE NAME GLOBAL REFERENCE OWN DEVICES " S ^S111($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,^S111($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(^S111($J,I)) W ^(I),! K ^S111($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 ^S111($J) D FRM S U=0 F I=1:1 Q:'$D(^S111($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(^S111($J,U)) K ^S111($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(^S111($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 ^S111($J) D KOT S ^S111($J,1)=$J("",SM)_KAV S ^S111($J,2)=$J("",SM)_KOT S ^S111($J,3)=$J("",SM)_KAV D STR1 S ^S111($J,4)=$J("",SM)_STR1 S ^S111($J,5)="" D STR2 S ^S111($J,6)=$J("",SM)_STR2 W ! ZSY "uptime" X %XCL W ! F I=1:1:6 W !,^S111($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 ^S111($J) F I=1:1 Q:'$D(^SHP(KOD,I)) S ^S111($J,I)=^SHP(KOD,I) K R,L,U S TXT=" EXIT - " S:%XMSG(0)'>1 %HBRY="" D ^%S2VIEW K ^S111($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 ^S111($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,^S111($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 ^S111($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,^S111($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 ^S111($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,^S111($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 ^S111($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 ^S111($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 ^S111($J,$O(^S111($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)=^S111($J) N A,B,I,N,N1,N2,N3 S A=$$SPA^%L1FRM($G(^S111($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 ^S111($J) M ^S111($J)=^S222($J) K ^S222($J) S %S2V("NOHB")="" D ^%S2VIEW K ^S111($J) M ^S111($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))=^S111($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),^S111($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 ^S111(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 ^S111(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,^S111(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 ^S111(PRT) G:'$D(%NMF1) Z1 END C %NMF K %NMF Q ; NOTEXT ; U %NMF K ^S111(PRT) F %I=1:1 S %ST="" D S ^S111(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: ^S111($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(^S111($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(^S111($J,U)) ^S111($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(^S111($J,U)) S ^(U)="" S %SS=^(U) D USE 3 K HOME,ENDS D USE I %FLI=1 W %vverxe,%CLI,"+",U,":",$L(^S111($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(^S111($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(^S111($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(^S111($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(^S111($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(^S111($J,I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^S111($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(^S111($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(^S111($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=^S111($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(^S111($J,U-(%Y-%S2V("VGR")+1)+I)) W %vniz S:'$D(^S111($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(^S111($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:^S111($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(^S111($J,1)) .I $O(^S111($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(^S111($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(^S111($J,1)) 3 S:'$D(^S111($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(^S111($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(^S111($J,1)," ",1)_"> " D STR1 U $P:(ECHO) R %STROKA 1110 D USE I %STROKA="-" W %vverxe,%chists G 3 I $D(^S111($J,1)) S:%STROKA="" %STROKA=$P(^S111($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(^S111($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(^S111($J,I)) Q:$P($P(^(I)," ",1),"(")=%LAB I '$D(^(I)) W *7," LABEL NOT !" H 2 G 1 11101 I '$D(^S111($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(^S111($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(^S111($J,1)) I C="" G ERCOM:'$D(RAZ) S C=RAZ S RAZ=C,J=%K+2 F C=U:1 Q:'$D(^S111($J,C)) S J=$F(^S111($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(^S111($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 ^S2VS111($J,$ZL) M ^S2VS111($J,$ZL)=^S111($J) .I $O(^S111($J,U)) S zl=$ZL .D @%S2V("PROG") X:'$D(%S2V("PROGNCA")) %chista .S %MET="BEG" D INIT .D:$D(%S2V("SV")) REST .K ^S111($J) M ^S111($J)=^S2VS111($J,$ZL) K ^S2VS111($J,$ZL) .I $O(^S111($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(^S111($J,U+J-1)) S %S=$E(^S111($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(^S111($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(^S111($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(^S111($J,U),L,R) Q N %A S %A=^S111($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: ^S111($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(^S111($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(^S111($J,U)) ^S111($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(^S111($J,U)) S ^(U)="" S %SS=^(U) D USE 3 K HOME,ENDS D USE I %FLI=1 W %vverxe,%CLI,"+",U,":",$L(^S111($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(^S111($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(^S111($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(^S111($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(^S111($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(^S111($J,I)) D 801 Q:%OPOZ>0&(%KK>0) G 802 801 F JJ=0:0 S J=$F(^S111($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(^S111($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(^S111($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=^S111($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(^S111($J,U-(%Y-%S2V("VGR")+1)+I)) W %vniz S:'$D(^S111($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(^S111($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:^S111($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(^S111($J,1)) .I $O(^S111($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(^S111($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(^S111($J,1)) 3 S:'$D(^S111($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(^S111($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(^S111($J,1)," ",1)_"> " D STR1 U $P:(ECHO) R %STROKA 1110 D USE I %STROKA="-" W %vverxe,%chists G 3 I $D(^S111($J,1)) S:%STROKA="" %STROKA=$P(^S111($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(^S111($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(^S111($J,I)) Q:$P($P(^(I)," ",1),"(")=%LAB I '$D(^(I)) W *7," LABEL NOT !" H 2 G 1 11101 I '$D(^S111($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(^S111($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(^S111($J,1)) I C="" G ERCOM:'$D(RAZ) S C=RAZ S RAZ=C,J=%K+2 F C=U:1 Q:'$D(^S111($J,C)) S J=$F(^S111($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(^S111($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 ^S2VS111($J,$ZL) M ^S2VS111($J,$ZL)=^S111($J) .I $O(^S111($J,U)) S zl=$ZL .D @%S2V("PROG") X:'$D(%S2V("PROGNCA")) %chista .S %MET="BEG" D INIT .D:$D(%S2V("SV")) REST .K ^S111($J) M ^S111($J)=^S2VS111($J,$ZL) K ^S2VS111($J,$ZL) .I $O(^S111($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(^S111($J,U+J-1)) S %S=$E(^S111($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(^S111($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(^S111($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(^S111($J,U),L,R) Q N %A S %A=^S111($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 ^S111($J) M ^S111($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.24 15:12 ] [ Q:$G(^S3NOGIB)=1 N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^%S2GLSV" 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 ^S111($J) N I F I=2:1 Q:$T(+I)="""" S ^S111($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 %W1DAT %W1DAT(COD,DT,TXT) ; [ 06.04.25 00:18 ] [ 19.12.24 16:08 ] [ 28.12.22 13:38 ] 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"" " 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_"" ; 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) ; [ 28.06.23 14:58 ] [ 18.05.23 09:17 ] [ 18.12.22 13:23 ] ;;D PUT^%W3DEB("%W1DICT","KEY=KEY & PRM=PRM") N TXT 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 $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)) I LNG="H" S TXT=$$H2U^%L1FRM(TXT) I LNG="R" S TXT=$$R2U^%L1FRM(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 I '$D(^[$$^W3MAIN]W1DICT(KEY,LNG)) Q KEY ; N TXT S TXT=$G(^[$$^W3MAIN]W1DICT(KEY,LNG)) I KBENG S TXT=$$FUNC^%UCASE(TXT) 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 ; [ 13.06.08 11:35 ] [ 12.09.07 14:39 ] [ 28.06.07 07:23 ] 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) ; N YES,%Q c FFILE o FFILE:(readonly:record=2048:rewind) ;;S $ZT="g REOF" N I,X S I=0 K ^S000($P) f u FFILE r X Q:$ZEOF S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") 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 ^S111($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,^S111($J,I)=$TR(X,$C(9)," ") REOFVW c FFILE Q %W1EDIT %W1ED ; [ 22.10.09 18:43 ] [ 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) ; N YES,%Q c FFILE o FFILE:(readonly:record=2048:rewind) ;;S $ZT="g REOF" N I,X S I=0 K ^S000($P) f u FFILE r X Q:$ZEOF S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") 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 ^S111($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,^S111($J,I)=$TR(X,$C(9)," ") REOFVW c FFILE Q %W1ENCRL %W1ENCRL(PRM) ; [ 29.06.16 18:14 ] [ 27.06.15 14:31 ] [ 27.11.14 15:00 ] N ENCR,I,SMB S ENCR="" F I=1:1:$L(PRM) D .;S SMB=$TR($J($A(PRM,I)-11,3)," ",0) .S ENCR=ENCR_$C($A(PRM,I)+1) Q ENCR ; DCR(PRM) ; N I,SMB,DCR S DCR="" F I=1:1:$L(PRM) D .S SMB=$C($A(PRM,I)-1) .S DCR=DCR_SMB ; S DCR=$$RPL^%L1FRM(DCR,"$15","%") S DCR=$$RPL^%L1FRM(DCR,"$2@","9") S DCR=$$RPL^%L1FRM(DCR,"$4A","Z") S DCR=$$RPL^%L1FRM(DCR,"$6A","z") S DCR=$$RPL^%L1FRM(DCR,"$4a","Z") S DCR=$$RPL^%L1FRM(DCR,"$6a","z") ; Q DCR %W1ENG %W1ENG() ; [ 02.11.23 07:48 ] [ I $$^%W1LNG="E",'$D(NOPCLOAZ) Q 1 Q 0 %W1ENTCN %W1ENTCN(SITE,HRF) ; [ 02.01.08 10:29 ] [ I $G(SITE)="" Q I $G(HRF)="" Q N GL S GL="^[$$^W3MAIN]W1ENTCN("""_SITE_""")" S @GL=$G(@GL)+1 S @GL@(HRF)=$G(@GL@(HRF))+1 S @GL@(HRF,$P($H,",")_$TR($J($P($H,",",2),5)," ",0))=$ZD($H,"DD/MM/YY 24:60") Q %W1FRBE0 %W1FRBEX(COD) ; [ 20.11.11 08:11 ] [ 19.11.11 21:09 ] [ N (JB,%ARG,%REM,COD) D ^%L1TS D TMPREP^%W1FREP N DIR S DIR=$$DIRL N FL S FL=DIR_COD_JB I $G(TOT) S FL=FL_"S" S FLCSV=FL_".txt" N A,B,I,J,RZD C FLCSV:(DELETE) O FLCSV:(REWIND:NEWVERSION:WRITE) ; K MRKV S PRG=0,BEGG=0,ENDG=0,MC="" D STRG^%W1FREPB(COD) N GREP S GREP="^[$$^W3MAIN]W4REP" S LNG=$$^%W1LNG S:LNG="" LNG="H" ; S B="" F J=1:1 Q:'$D(@GREP@(COD,"REP",LNG,J)) D .N A S A=$G(^(J)) .S ZN=$P(A,";",2) .S ZN=$$SPA^%L1FRM(ZN) .S B=B_$TR($$INVH^%L1FRM(ZN),TS0,TS1)_$C(9) ; S B=$E(B,1,$L(B)-1) Q:B="" ;;U 0 W B,! H 1 U FLCSV W B,! ; S BG="",RZD="\" F S BG=$O(@$$^W4MAIN("S4B")@(BG)) Q:BG="" Q:BG>90000 D .S B="" .N A S A=$G(^(BG)) .N J,F S J=0,F=0 .N N S N="" F S N=$O(MRKV("G",N)) Q:N="" D ..S J=J+1 ..N MCF S MCF=$$SPA^%L1FRM($G(MRKV("G",N))) ..N FLD S FLD=0 ..I $G(MRKV("G",N,"FLD")) S FLD=1 ..I FLD S F=F+1 ..I FLD D ...N ZN S ZN=$TR($$INVH^%L1FRM($$SPA^%L1FRM($P(A,RZD,F))),TS0,TS1) ...I $L(MCF),MCF["9",MCF["." D ....S DR=$L($P(MCF,".",2)) ....S ZN=$J(ZN,DR,DR) ....S B=B_ZN_$C(9) .S B=$E(B,1,$L(B)-1) .;;U 0 W B,! H 1 ; .U FLCSV W B,! ; C FLCSV ; ZSY "unix2dos "_FLCSV ZSY "zip -j "_FL_" "_FLCSV Q ; ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; DIRWEB(STAM) ; N DIR S DIR=$$WEB^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; KAVSIK(A) I A?1"=="."="1"*"1"=".E,A?.P Q 1 Q 0 %W1FRBEX %W1FRBEX(COD,FMT) ; [ 03.02.18 04:45 ] [ 13.05.14 11:59 ] [ 28.10.12 07:58 ] N (JB,%ARG,%REM,COD,FMT) N $ZT S $ZT="G ER" D ^%L1TS S FMT=$G(FMT) D TMPREP^%W1FREP S FL=$$FL^%W1FREPX(COD,FMT) I $G(TOT) S FL=FL_"S" S FLCSV=FL_"."_$$FMT^%W1PCEX(FMT) S MAXHD=79 S CODS=COD_"s" S GLHD=$$BG^W4SHP_"CODS)" ; N A,B,I,J,RZD C FLCSV:(DELETE) O FLCSV:(REWIND:NEWVERSION:WRITE) ; K MRKV S PRG=0,BEGG=0,ENDG=0,MC="" ; F I=1:1 Q:'$D(@GLHD@(I)) D .N A S A=$G(^(I)) S B="" .D STR^%W1FREPB(I) .S RKV="" F S RKV=$O(MRKV(I,RKV)) Q:RKV="" D ..S ZN=$G(MRKV(I,RKV)) ..I $G(MRKV(I,RKV,"FLD")) D ...S ZN=$G(@TMPREP@("P",+ZN)) ..S B=B_$$RKV^%W1PCEX(ZN,FMT) .S B=$E(B,1,$L(B)-1) Q:B="" .U FLCSV W B,! . ; D STRG^%W1FREPB(COD) N GREP S GREP="^[$$^W3MAIN]W4REP" S LNG=$$^%W1LNG S:LNG="" LNG="H" ; S B="" F J=1:1 Q:'$D(@GREP@(COD,"REP",LNG,J)) D .N A S A=$G(^(J)) .S ZN=$P(A,";",2) .S ZN=$$SPA^%L1FRM(ZN) .S B=B_$$RKV^%W1PCEX(ZN,FMT) ; S B=$E(B,1,$L(B)-1) Q:B="" ;;U 0 W B,! H 1 U FLCSV W B,! ; S BG="",RZD="\" F S BG=$O(@$$^W4MAIN("S4B")@(BG)) Q:BG="" Q:BG>90000 D .S B="" .N A S A=$G(^(BG)) .N J,F S J=0,F=0 .F F=1:1:$L(A,RZD) D ..S ZN=$P(A,RZD,F) ..S B=B_$$RKV^%W1PCEX(ZN,FMT) .S B=$E(B,1,$L(B)-1) .;;U 0 W B,! H 1 ; .U FLCSV W B,! ; C FLCSV ; ;ZSY "unix2dos "_FLCSV ;ZSY "zip -j "_FL_" "_FLCSV END ; Q ; ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; DIRWEB(STAM) ; N DIR S DIR=$$WEB^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; KAVSIK(A) I A?1"=="."="1"*"1"=".E,A?.P Q 1 Q 0 ; ER ; D SVER^%L1X G END %W1FREP %W1FREP(COD) ; [ 17.11.23 05:23 ] [ 10.07.23 12:09 ] [ 12.10.22 15:54 ] ; -------------------- PARAMETERS FROM GLOBAL ^W4REPSCR N (JB,%ARG,%REM,COD) N MAX,MRKV,%PGNMB S PRINT=+$$GETP^%W1PRM("PRINTREPBACK") S %PGNMB=0 D TMPREP ; I $$GETP^%W1PRM("CURSORT")="" D .D TMPREPB .K @TMPREPB .M @TMPREPB=@TMPREP ; D INIT ; N TYPREP S TYPREP=$$TYPREP(COD) ; D GLHD(COD) D GETMRKV(COD) ; --> MRKV,GI,BEGG,ENDG ; I '$G(%ARG("NOEXCEL")) D .D DIVEXC^%W1PC1(COD,"%W1FREPX") ; I $D(@TMPREP@("KOT")) D .W ^("KOT") ;;_"
" ;; *** LEV 14/01/17 ; S MAXG1=MAXG0-BEGG ; -- MAX KOL CTROK V GR TBL PC W "

",! ;;I $G(PRINT) W "
",! ; I BG'="",GI D S BG=BG-1 G PC .N BG1 S BG1=$O(MRKV(9999),-1) .I ENDG S BG1=ENDG .W $$^%W1DICT("CONTINUENEXTPAGE"),! .D PAGEBREAK .;;F I=BG1+3:1:44 W "
" Q ; ; GETMRKV(COD) D INIT D TMPREP N GLHD,I,MC,PRG,A ; D GLHD(COD) ; K MRKV S PRG=0,BEGG=0,ENDG=0,MC="",GI=0 ; F I=1:1 Q:'$D(@GLHD@(I)) D .S A=$G(^(I)) .I A["$" S PRG=1-PRG D ..I PRG S BEGG=I,MC=A D STRG(A) D Q ...N N S N="" F S N=$O(MRKV("G",N)) Q:N="" D ....N L S L=$L($G(MRKV("G",N))) ....S MRKV("G")=$G(MRKV("G"))_L_"," ...D GETMRKVGN(COD,I) ... ..I 'PRG S GI=I-BEGG+1,ENDG=I+1 . .I PRG Q .; .D STR(I) . .N N S N="" F S N=$O(MRKV(I,N)) Q:N="" D ..N L S L=$L($G(MRKV(I,N))) ..I $G(MRKV(I,N,"FLD")) S L=L+2 ..I $G(MRKV(I,N,"BIG")) S L=L*2 ..S MRKV(I)=$G(MRKV(I))_L_"," .I $D(@TMPREP@("M",I))#2 S MRKV(I)=^(I) Q ; ; GETMRKVGN(COD,I) K MRKVGN N ST,NM D GLHD(COD) N I2 S I2=0 N I1 F I1=I-2:-1:1 Q:'$D(@GLHD@(I1)) Q:$$SPA^%L1FRM($G(@GLHD@(I1)))?1"-"."-" I $$SPA^%L1FRM($G(@GLHD@(I1)))?1"-"."-" D .F I3=I1+1:1 Q:'$D(@GLHD@(I3)) Q:$$SPA^%L1FRM($G(@GLHD@(I3)))?1"-"."-" D ..S ST=$G(@GLHD@(I3)) ..N K S K=0 ..N J S I2=I2+1 ..I $$TYPREP(COD)'="H" F J=2:1:$L(ST,"|")-1 S K=K+1 D GETNM(ST,J,K,I2) ..I $$TYPREP(COD)="H" F J=$L(ST,"|")-1:-1:2 S K=K+1 D GETNM(ST,J,K,I2) ; I $$TYPREP(COD)="H" D .S K="" F S K=$O(NM(K)) Q:K="" D ..S I2="" F S I2=$O(NM(K,I2)) Q:I2="" D ...S NM(K)=NM(K,I2)_" "_$G(NM(K)) ..S NM(K)=$$SPA^%L1FRM($$SP1^%L1FRM($G(NM(K)))) ..S MRKVGN(K)=NM(K) ; I $$TYPREP(COD)'="H" D .S K="" F S K=$O(NM(K)) Q:K="" D ..S I2="" F S I2=$O(NM(K,I2)) Q:I2="" D ...S NM(K)=$G(NM(K))_" "_$G(NM(K,I2)) ..S NM(K)=$$SPA^%L1FRM($$SP1^%L1FRM($G(NM(K)))) ..S MRKVGN(K)=NM(K) ; Q ; GETNM(ST,J,K,I2) ; S NM(K,I2)=$$SPA^%L1FRM($P(ST,"|",J)) Q ; SHAP(ST) ; Q:'ST D TMPREP S PRM=MRKV(ST) ;;W "PRM="_PRM I $$KAV(ST) S PRKAV=1-PRKAV,PRVHD=0 Q ;;I $G(PRINT) W "
",! W "" D W "",! ;;I $G(PRINT) W "
",! .S J=0 .S RKV="" F S RKV=$O(MRKV(ST,RKV)) Q:RKV="" D ..S J=J+1 ..N BIG S BIG=0 I $G(MRKV(ST,RKV,"BIG")) S BIG=1 ..N FLD S FLD=0 ..I $G(MRKV(ST,RKV,"FLD")) S FLD=MRKV(ST,RKV,"FLD") ; RKV LENGTH ..N WD ..S WD=$J($P(PRM,",",J)/MAX*100,0,0) ..I $G(@GLHD@(ST))["|" S MWD(J)=WD ..I $G(@GLHD@(ST))'["|",WD>50 S WD=WD\4 ..W "" ..D ...N ZN,TYP S TYP="" S ZN=$G(MRKV(ST,RKV)) ...I BIG!FLD S ZN=$$SPA^%L1FRM(ZN) ...I FLD D ....S TYP=$G(@TMPREP@("P",+ZN,"TYP")) ....S ZN=$G(@TMPREP@("P",+ZN)) ....;;S ZN=$$HBR^%L1FRM(ZN,FLD) ; -- FLD - RKV LENGTH ...W "ENDG)) W ";font-weight:bold" ...W """>" ...I TYP="N",ZN["." S ZN=$$ZPT^%L1FRM(ZN) ...W $$H2U^%L1FRM(ZN) ..W "" ..W "" ; I MRKV(ST)'=$G(MRKV(ST+1)) D .W "",! .I $D(@GLHD@(ST+1)) W "" D TBL1 ; Q ; STR(I) ; N A,J,NRKV,FLD,BTW S A=$G(@GLHD@(I)) S NRKV=1,J=MAX+1,FLD=0,PRSP=1,BIG=0,PRKAV=0,PRVERT=0 CYC S J=J-1 Q:J<1 S BTW=$$BETWEEN(A,J,"|") I $E(A,J)=">" S:'BTW NRKV=NRKV+1 S FLD=$$FLDLEN(A,J),PRSP=0,PRKAV=0 G CYC I $E(A,J)="&" S:'BTW NRKV=NRKV+1,FLD=0 S PRSP=$S(PRVERT:0,1:1),PRKAV=0 G CYC I $E(A,J)="|" S NRKV=NRKV+1,FLD=0,PRSP=0,PRKAV=0 G CYC I $E(A,J)="#" S NRKV=NRKV+1,BIG=1-BIG S PRSP=0,PRKAV=0 G CYC I $E(A,J)="-",$TR(A,"- ","")="",PRSP S NRKV=NRKV+1,PRSP=0,PRKAV=1 I $E(A,J)'=" ",PRSP S NRKV=NRKV+1,PRSP=0 I $E(A,J)'="-" S PRKAV=0 I $E(A,J)=" ",PRKAV S NRKV=NRKV+1,PRKAV=0 ; ;;I PRVERT,$E(A,J)'?1N S PRVERT=0 ; S MRKV(I,NRKV)=$E(A,J)_$G(MRKV(I,NRKV)) ; I '$G(MRKV(I,NRKV,"FLD")) S MRKV(I,NRKV,"FLD")=FLD I '$G(MRKV(I,NRKV,"BIG")) S MRKV(I,NRKV,"BIG")=BIG I '$G(MRKV(I,NRKV,"PRKAV")) S MRKV(I,NRKV,"PRKAV")=PRKAV ; I '$G(MRKV(I,NRKV,"PRVERT")) S MRKV(I,NRKV,"PRVERT")=BTW ; G CYC ; ; FLDLEN(A,J) N J1,K S K=0 F J1=J:-1:1 S K=K+1 Q:$E(A,J1)="&" I $E(A,J1,J1+1)'?1"&"1N S K=0 Q K ; TBL1 ; W " " Q ; KAV(ST) ; N N S N="" N PRKAV S PRKAV=0 F S N=$O(MRKV(ST,N)) Q:N="" D .I $TR(MRKV(ST,N)," ","")?1"-"."-",'PRKAV S PRKAV=1 Q .I $TR(MRKV(ST,N)," ","")'?1"-"."-",$TR(MRKV(ST,N)," ","")'="" S PRKAV=-1 I PRKAV<1 S PRKAV=0 Q PRKAV ; NOSPACE(ST,RKV) ; I $TR($G(MRKV(ST,RKV))," ","")'="" Q 1 N NRKV S NRKV=$O(MRKV(ST,RKV)) N PRKV S PRKV=$O(MRKV(ST,RKV),-1) I NRKV,$TR($G(MRKV(ST,NRKV))," ","")'="",PRKV,$TR($G(MRKV(ST,PRKV))," ","")'="" Q 1 Q 0 ; HDSTYLE ; S BCL=$$BGHD^W3CSS("DRW") W " style=""background-color:"_BCL_";text-align:center;color:white;font-weight:bold;font-size:"_$$^W3FSZ(FSZ)_"""" Q ; STRG(A) ; N J,NRKV S J=MAX+1 S NRKV=0 STRGC S J=J-1 Q:J<1 I $E(A,J)=":" S NRKV=NRKV+1 G STRGC I $E(A,J)="$" G STRGC S MRKV("G",NRKV)=$E(A,J)_$G(MRKV("G",NRKV)) I $$BETWEEN(A,J,":") S MRKV("G",NRKV,"FLD")=1 I $$BETWEEN1(A,J,"$",":") S MRKV("G",NRKV,"FLD")=1 G STRGC ; BETWEEN(A,J,RZD) ; N PR S PR=0 N K F K=J-1:-1:1 I $E(A,K)=RZD S PR=1 Q N K1 F K1=J+1:1:$L(A) I $E(A,K1)=RZD S PR=PR+1 Q I PR=2 Q 1 Q 0 ; BETWEEN1(A,J,RZD1,RZD2) ; N PR S PR=0 N K F K=J-1:-1:1 I $E(A,K)=RZD1 S PR=1 Q N K1 F K1=J+1:1:$L(A) I $E(A,K1)=RZD2 S PR=PR+1 Q I PR=2 Q 1 Q 0 ; SELSORT ; N (JB,%ARG,%REM) N COD S COD=$$GET^%W1PRM("REPN") Q:COD="" Q:COD["UNDEF" N SCR S SCR=COD I $D(@$$^W4REPSCR@(COD)) S SCR=$$SCR^W4REPSCR(COD) D TMPREP N CURSORT S CURSORT=+$$GET^%W1PRM("CURSORT") ; I $D(^[$$^W3MAIN]W4REP(COD))=11 D G SELSORT1 .N LNG S LNG=$$^%W1LNG I LNG="" S LNG="H" .N N S N="" F S N=$O(^[$$^W3MAIN]W4REP(COD,"REP",LNG,N)) Q:N="" D ..N A S A=$G(^(N)) ..S MRKVGN(N)=$P(A,";",2) ; D GETMRKV(SCR) ; I $D(MRKVGN)<10 Q ; SELSORT1 ; W "",! Q ; ASCDESC ; N CURAD S CURAD=$P($$GET^%W1PRM("CURSORT"),"~",2) W "",! Q ; SORT(COD,NOM) ; N K,N,A,SH,SORTVL,MG,BEGG,END D TMPREP,TMPREPB,VRM K @VRM N AD S AD=$P(NOM,"~",2) S NOM=+NOM I 'NOM D Q .I '$D(@TMPREPB) Q .K @TMPREP .M @TMPREP=@TMPREPB ; S RZD=$$RZD ; D GETMRKV(COD) S F=0 S N="" F S N=$O(MRKV("G",N)) Q:N="" D .I $G(MRKV("G",N,"FLD")) D ..S F=F+1 ..S MG(F)=$$SPA^%L1FRM(MRKV("G",N)) ; I '$D(MG(NOM)) Q ; I MG(NOM)?1"T"."T" D .S MG(NOM,"L")=$L(MG(NOM)) .S MG(NOM,"T")="TX" .I $G(@$$^W4SCR@(COD,"G",NOM,"TYP"))'="" D ..S MG(NOM,"T")=^("TYP") ..S MG(NOM,"L")=$G(@$$^W4SCR@(COD,"G",NOM,"LMAX")) ; I MG(NOM)?1"9"."9" D .S MG(NOM,"L")=$L(MG(NOM)) .S MG(NOM,"T")="9" .S MG(NOM,"DR")="0" ; I MG(NOM)?1"9"."9"1".9"."9" D .S MG(NOM,"L")=$L(MG(NOM)) .S MG(NOM,"T")="9" .S MG(NOM,"DR")=$L($P(MG(NOM),".",2)) ; S K=0,SH="" F S SH=$O(@TMPREP@("G",SH)) Q:SH="" S K=K+1 D .;;W "SH="_SH,! .N A S A=$G(^(SH)) .S SORTVL=$P(A,RZD,NOM) .I SORTVL="" S SORTVL="-" .I MG(NOM,"T")="TX" D ..S SORTVL=$$ENG^%L1FRM($S($$^%W1DIR="RTL":$$INV^%L1FRM(SORTVL),1:SORTVL),MG(NOM,"L")) ..D SORTVLI .I MG(NOM,"T")="E"!(MG(NOM,"T")="T") D ..S SORTVL=$TR(SORTVL,"-:","") ..S SORTVL=$$ENG^%L1FRM(SORTVL,MG(NOM,"L")) ..D SORTVLI .I MG(NOM,"T")="H" D ..S SORTVL=$$ENG^%L1FRM($$INV^%L1FRM(SORTVL),MG(NOM,"L")) ..D SORTVLI .I MG(NOM,"T")="D" D ..S SORTVL=$$^%L1DC(SORTVL,3) ..D SORTVLI .I MG(NOM,"T")="9",MG(NOM,"DR")=0 D ..;S SORTVL=$$HBR^%L1FRM(SORTVL,MG(NOM,"L")) ..S SORTVL=+SORTVL ..D SORTVLIN .I MG(NOM,"T")="9",MG(NOM,"DR") D ..S SORTVL=$J(SORTVL,MG(NOM,"DR"),MG(NOM,"DR")) ..I SORTVL=0 S SORTVL="" ..D SORTVLIN .S @VRM@(SORTVL)=A ; K @TMPREP@("G") S SH=0 S AD=$S(AD:-1,1:1) ; S N="" F S N=$O(@VRM@(N),AD) Q:N="" D .S A=$G(^(N)) .S SH=SH+1 .S @TMPREP@("G",SH)=A K @VRM Q ; SORTVLI ; ;;W " SORTVLI",! N J F J=1:1 Q:'$D(@VRM@(" "_$TR(SORTVL,"-","")_$TR($J(J,4)," ",0))) S SORTVL=" "_$TR(SORTVL,"-","")_$TR($J(J,4)," ",0) ;;W " ENDSORTVLI",! Q ; SORTVLIN ; ;;W " SORTVLIN",! N J N BG S BG=15*(10**16) ; S BG=BG+$TR($J(SORTVL,2,2),".","") ;;F J=BG:1 Q:'$D(@VRM@(BG+J*.0001)) ;;S SORTVL=BG+(J*.0001) S SORTVL="0"_BG_$TR($J(SH,5)," ",0) ;;W " ENDSORTVLIN",! Q ; INIT ; S MAX=79,MAXG0=45,BG="" D FSZ Q ; FSZ S FSZ=10 Q ; RZD(STAM) Q "\" ; GLHD(COD) ; S GLHD=$$BG^W4SHP_""""_COD_"s"")" Q ; TMPREP ; S TMPREP=$$^W4MAIN("TMPREP") Q ; TMPREPB ; S TMPREPB=$$^W4MAIN("TMPREPB") Q ; VRM ; S VRM=$$^W4MAIN("VRM") Q ; TYPREP(COD) ; Q $G(@$$^W4SCR@(COD)) ; PAGEBREAK ; W "

",! Q ; ; SHOWZN(ZN,MCF) ; N PRBOLD S PRBOLD=0 I $L(MCF),MCF["9",MCF["." D .I $E(ZN,1,3)="" S ZN=$P(ZN,"",2) S PRBOLD=1 .I ZN["[" Q .S DR=$L($P(MCF,".",2)) .S ZN=$J(ZN,DR,DR) .S ZN=$$ZPT^%L1FRM(ZN) ; --- LEV 08/02/18 .I 'ZN S ZN=" " ; D .I $TR(ZN,"[] ","")<0 W " "_ZN_" " Q .I PRBOLD W " "_ZN_" " Q .W " "_ZN_" " Q %W1FREPA %W1FREPA(COD,SBMBCK) ; [ 24.04.24 15:04 ] [ 10.06.23 14:23 ] [ 24.04.23 15:45 ] N (JB,%ARG,%REM,COD,SBMBCK) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; D PUT^%W3DEB("W1FREPA","COD=COD") S %ARG("SRCH")=$$CNWEB^%L1FRM($G(%ARG("SRCH"))) N SRCH S SRCH=$$INVH^%L1FRM($G(%ARG("SRCH"))) ; N MAX,MRKV,MRKVZ,%PGNMB ; D FRMRKV(COD) ; PC ;;D NOSELECT^%W1JS W "

",! ; I $G(%ARG("FIRST")) D KILL^%W1PRM("VIRTKB") ; I $G(%ARG("VIRTKB")) D .W "
",! .W "",! .W "
",! . W "
",! ; I $L($G(%ARG("SEARCH"))) D SEARCH(SRCH,$G(SBMBCK)) ; W "
",! ; F K=1:1 Q:'$D(MRKVZ(K)) D .N VL S VL=MRKVZ(K,1) .W "" .W "" .N DRC S DRC=$S($$TYP(K)="D"!($$TYP(K)="T"):"style='direction:ltr'",1:"") .W "",! ; W "
"_$$H2U^%L1FRM(VL) .W "" .N VV S VV=$$VV(K) .W VV .W "
",! ; I $L($G(%ARG("SEARCH"))) D .W "",! ; I $$KBVRT^W4PRM D ^W4KBABCL Q ; ; FRMRKV(COD) ; N (JB,%ARG,%REM,COD,MAX,MRKVZ) Q:$G(COD)="" S MAX=79 D ^%W1ARG N GLHD,I,BEGG,MC,PRG,GI D GLHD ; K MRKV S PRG=0,BEGG=0,ENDG=0,MC="" ; S OK=0 ; F I=1:1 Q:'$D(@GLHD@(I)) S A=$G(^(I)) Q:A["$" Q:A["-"&($TR(A,"- ","")="") D Q:OK .I A["#" S KOT=$P(A,"#",$L(A,"#")-1) S OK=1 I OK S MRKV("KOT")=$$SPA^%L1FRM(KOT) ; F I=1:1 Q:'$D(@GLHD@(I)) S A=$G(^(I)) Q:A["$" Q:A["-"&($TR(A,"- ","")="") D .I A'["{" Q .D STR(I) .N N S N="" F S N=$O(MRKV(I,N)) Q:N="" D ..N L S L=$L($G(MRKV(I,N))) ..I $G(MRKV(I,N,"FLD")) S L=L+2 D ...N FLD S FLD=MRKV(I,N,"FLD") ...N ZN S ZN=$$SPA^%L1FRM(MRKV(I,N)) Q:'ZN ...N ZPR S ZPR=MRKV(I,N-1) ...I ZPR["(",ZPR[")",ZPR["," D ....N SEL S SEL=$P($P(ZPR,"(",2),")") ....S MRKV(I,N-1)=$$SPA^%L1FRM($P(MRKV(I,N-1),")",2,20)) ....N J,K S K=0 F J=$L(SEL,","):-1:1 D .....N OPT S OPT=$P(SEL,",",J) .....N VL,TX S VL=$P(OPT,"-"),TX=$P(OPT,"-",2) .....S VL=$$SPA^%L1FRM(VL),TX=$$SPA^%L1FRM(TX) .....I $$GCOUPIT^W4PRM,COD="W4PRMMSD",ZPR["dpzn yelz ynnl",VL=1 Q .....I TX?1N.N D ......N X S X=TX,TX=VL,VL=X .....S K=K+1,MRKV(I,N,"SEL",K)=VL_"="_TX ...I $D(@GLHD@("P",+ZN,"OUTPUT")) D ....S MRKV(I,N,"OU")="" ....;;S MRKV(I,N)=$J("",FLD) ....;;K MRKV(I,N,"FLD") ..S MRKV(I)=$G(MRKV(I))_L_"," ; ; D GET(COD) ; K MRKVZ S K=0 S NST="" F S NST=$O(MRKV(NST)) Q:NST="" D .S NRKV="" F S NRKV=$O(MRKV(NST,NRKV)) Q:NRKV="" D ..I $G(MRKV(NST,NRKV,"FLD")) D ...S K=K+1 ...S MRKVZ(K,1)=$TR($G(MRKV(NST,NRKV-1)),":","") ...S MRKVZ(K,"NID")=$$SPA^%L1FRM($G(MRKV(NST,NRKV))) ...S MRKVZ(K,"TYP")=$$TYP(K) ...S MRKVZ(K,"LEN")=$$LEN(K) ...S MRKVZ(K,"GL")=$$GLB(K) ...S MRKVZ(K,"ID")=$$ID(K) ...S MRKVZ(K,"VL")=$$VL(K) ...S MRKVZ(K,"MUMPS1")=$$MUMPS1(K) ...S MRKVZ(K,"MUMPS2")=$$MUMPS2(K) ...I $D(MRKV(NST,NRKV,"OU")) S MRKVZ(K,"OU")=1 ...I $D(MRKV(NST,NRKV,"SEL")) M MRKVZ(K,"SEL")=MRKV(NST,NRKV,"SEL") ; S MRKVZ("KOT")=$G(MRKV("KOT")) Q ; STR(I) ; N A,J,NRKV,FLD S A=$G(@GLHD@(I)) ; S NRKV=1,J=MAX+1,FLD=0,PRSP=1 CYC S J=J-1 Q:J<1 I $E(A,J)="}" S NRKV=NRKV+1 S FLD=$$FLDLEN(A,J),PRSP=0 G CYC I $E(A,J)="{" S NRKV=NRKV+1,FLD=0 S PRSP=1 G CYC I $E(A,J)="#" G CYC ; I $E(A,J)'=" ",PRSP S NRKV=NRKV+1,PRSP=0 ; S MRKV(I,NRKV)=$E(A,J)_$G(MRKV(I,NRKV)) ; I '$G(MRKV(I,NRKV,"FLD")) S MRKV(I,NRKV,"FLD")=FLD ; G CYC ; ; FLDLEN(A,J) N J1,K S K=0 F J1=J:-1:1 S K=K+1 Q:$E(A,J1)="{" N FLD S FLD=$$SPA^%L1FRM($E(A,J1+1,J-1)) I FLD'?1N.N Q 0 I $$OUTZ(FLD) Q 0 Q K ; KAV(ST) ; N N S N="" N PRKAV S PRKAV=0 F S N=$O(MRKV(ST,N)) Q:N="" D .I $TR(MRKV(ST,N)," ","")?1"-"."-",'PRKAV S PRKAV=1 Q .I $TR(MRKV(ST,N)," ","")'?1"-"."-",$TR(MRKV(ST,N)," ","")'="" S PRKAV=-1 I PRKAV<1 S PRKAV=0 Q PRKAV ; VV(K) ; N ZN,TYP,LEN S ZN=$$ZN(K) Q:ZN="" "" S TYP=$$TYP(K) Q:TYP="" "" S LEN=$$LEN(K) Q:LEN="" "" S GLB=$$GLB(K) S ID=$$ID(K) Q:ID="" "" N VV S VV="" S @ID=$G(MRKVZ(K,"VL")) I $$MUMPS1(K)'="" X $$MUMPS1(K) ; I TYP="N"!(TYP="E")!(TYP="H"),GLB=""!'$$SMALLG(GLB) D .I $D(MRKVZ(K,"SEL")),GLB="" S VV=$$SELRKV(ID,$$VLC(K)) Q .I LEN["*" D VVA Q .D BEGVV .I $D(VWPRM) S VV=VV_" disabled=""disabled"" " .S VV=VV_" value="""_$$VLC(K)_""">" .I GLB'="",'$D(VWPRM) D ..S VV=VV_"    " ; I TYP="N"!(TYP="E")!(TYP="H"),GLB'="",$$SMALLG(GLB) D .S VV="" ; I TYP="B" D .S VV="" ; I TYP="D" D .I $D(VWPRM) S VV=$G(@ID) Q .S %W1DAT("=")="" .S %W1DAT("NODAY")=1 D ^%W1DAT(ID,$G(@ID)) ; I TYP="T" D .I $$MUMPS1(K)'="" X $$MUMPS1(K) .I $D(VWPRM) S VV=$$VLC(K) Q .D TIMENEW^%W1DAT(ID,$$VLC(K),"",.5) ; I TYP="C" D .N BG,FG .S BG=$G(@ID) I BG?6N S BG="#"_BG .S FG="black" .I BG="#000000" S FG="red" .S VV="") ; READONLY(K) N ID S ID=$$ID(K) I ID="" Q "" N VL S VL=$G(@ID) ;;W "RO-VL="_VL,! I VL["<>READONLY" Q 1 Q 0 ; DISABLE(K) N ID S ID=$$ID(K) I ID="" Q "" N VL S VL=$G(@ID) I VL["<>DISABLE" Q 1 Q 0 ; ZN(K) Q $G(MRKVZ(K,"NID")) ; SMALLG(GLB) ; I $G(GLB)="" Q 0 I $E(GLB)="^" S GLB=$E(GLB,2,20) N GLB1 S GLB1=$$GLB1(GLB) N I,N S N="" F I=1:1:20 S N=$O(@GLB1@(N)) Q:N="" I N="" Q 1 Q 0 ; GLHD S GLHD=$$BG^W4SCR_"COD)" I '$D(COD) S COD=$$COD Q ; COD(STAM) ; Q $G(@$$^W4MAIN("TMPARG")@("SCR")) ; GLB1(GLB) ; N GLB1 S GLB1=GLB I $E(GLB)="^" S GLB1=$E(GLB1,2,200) Q $$^W4GL(GLB1) ; FIRST(GLB) ; N FIRST S FIRST="" I $E(GLB)="^" S GLB=$E(GLB,2,200) I $D(@$$^W4TABL@(GLB,"FIRST")) S FIRST=$G(^("FIRST")) Q FIRST ; US(COD,GLB,%NXN) ; N US S US=1 I $D(@$$^W4TABL@(GLB,"US",COD)) S US=$G(@^(COD)) G EUS I $D(@$$^W4TABL@(GLB,"US"))#2 S US=$G(@^("US")) G EUS EUS Q US ; GET(COD) ; Q:$G(COD)="" D W4SP^W4SPIDK I $D(@W4SP@(COD,"GET"))#2 X @W4SP@(COD,"GET") Q ; SAVE(PRM) ; N (JB,%ARG,%REP,PRM,%REM) D PUT^%W3DEB("W1FREPA-SAVE","PRM=PRM") S COD=$P(PRM,";") I COD="" Q "0:NOSCR" S PRM=$P(PRM,";",2,200) F II=1:1:$L(PRM,";") D .N COUP S COUP=$P(PRM,";",II) .N A,B S A=$P(COUP,"="),B=$P(COUP,"=",2) .Q:$E(A)'?1A S @A=B ; D W4SP^W4SPIDK I $D(@W4SP@(COD,"PUT"))#2 X @W4SP@(COD,"PUT") I $D(%SC("ER")) Q "0;"_%SC("ER") Q 1 ; SELRKV(ID,VLK) N VV S VV="" Q VV ; BEGVV ; N LENSZ S LENSZ=LEN I $$^W4TABLET=2,LENSZ>30 S LENSZ=30 S VV="8):"",1:" onClick=""this.select()""") S VV=VV_$S(TYP="EN"!(ID["EMAIL"):" onKeyUp=""EnglishOnly(event,'"_ID_"')"" ",1:"") I $D(MRKVZ(K,"OU"))!$$READONLY(K) S VV=VV_" readonly=""readonly""" I $$DISABLE(K) S VV=VV_" disabled=""disabled""" I '$$OU(K) D .S VV=VV_"onFocus=""ShowVirtKB(this,'"_COD_"','"_TYP_"','"_LEN_"','"_K_"')" .S VV=VV_"""" .S VV=VV_" onBlur =""this.style.backgroundColor='white'"" " S VV=VV_" name="""_ID_""" id="""_ID_"""" Q ; VVA ; S VV="" Q ; VIRTKB(STAM) ; ;;I $G(%ARG("VIRTKB")) Q 1 I $$GETP^%W1PRM("VIRTKB") Q 1 Q 0 ; SWITCHVIRTKB(STAM) ; N VKB S VKB=$$GETP^%W1PRM("VIRTKB") S VKB=1-VKB D PUT^%W1PRM("VIRTKB",VKB) I VKB=1 Q "HIDEVIRTKB" Q "SHOWVIRTKB" ; OU(K) ; I $D(MRKVZ(K,"OU"))!$$READONLY(K)!$$DISABLE(K) Q 1 Q 0 ; GETPREV(PRM) ; N (JB,%ARG,PRM) S COD=$P(PRM,";") I COD="" Q 0 S K=$P(PRM,";",2) D FRMRKV(COD) S OK=0 N K1 F K1=K-1:-1:0 Q:'$D(MRKVZ(K1)) D FINDEL(K1) Q:OK I OK S OK=$$ID(OK)_";"_$$TYP(OK)_";"_$$LEN(OK)_";"_OK Q OK ; GETNEXT(PRM) ; N (JB,%ARG,PRM) S COD=$P(PRM,";") I COD="" Q 0 S K=$P(PRM,";",2) D FRMRKV(COD) S OK=0 N K1 F K1=K+1:1 Q:'$D(MRKVZ(K1)) D FINDEL(K1) Q:OK I OK S OK=$$ID(OK)_";"_$$TYP(OK)_";"_$$LEN(OK)_";"_OK Q OK ; FINDEL(K1) ; N TYP,GLB S TYP=$$TYP(K1) S GLB=$$GLB(K) I TYP="N"!(TYP="E")!(TYP="H"),GLB=""!'$$SMALLG(GLB) D .I $D(MRKVZ(K1,"SEL")) Q .S OK=K1 Q ; FIRSTID(COD) ; N (JB,%ARG,COD) D FRMRKV(COD) S OK="" S K="" F S K=$O(MRKVZ(K)) S ID=$$ID(K) I $L(ID) S OK=ID Q Q OK ; SEARCH(SRCH,SBMBCK) W "
",! W " " W "   " D ^W4BUTTON("srch","SEARCH","SearchPrm()","font-size:"_$$^W3FSZ(12)) I $G(SBMBCK) D SBMBCK W "
",! W "
",! Q ; SBMBCK ; W $$NBSP^%L1FRM(10) D ^W4BTN("SUBMIT","Submit()","green","",12,4) W $$NBSP^%L1FRM(5) D ^W4BTN("BACK","Back()","red","",12,4) Q %W1FREPB %W1FREPB(COD) ; [ 08.10.20 11:22 ] [ 06.09.20 09:32 ] [ 08.02.18 05:53 ] N MAX,MRKV,%PGNMB S %PGNMB=0 S CODS=COD_"s",MAX=$$SWG(COD),BG="",MAXG0=57 S MAXHD=79 N GLHD,I,BEGG,MC,PRG,GI S GLHD=$$BG^W4SHP_"CODS)" ; K MRKV S PRG=0,BEGG=0,ENDG=0,MC="" ; D DIVEXC^%W1PC1(COD,"%W1FRBEX") ; D STRG(COD) ; N N S N="" F S N=$O(MRKV("G",N)) Q:N="" D .N L S L=$L($G(MRKV("G",N))) .S MRKV("G")=$G(MRKV("G"))_L_"," ; F I=1:1 Q:'$D(@GLHD@(I)) D .N A S A=$G(^(I)) .; .D STR(I) .N N S N="" F S N=$O(MRKV(I,N)) Q:N="" D ..N L S L=$L($G(MRKV(I,N))) ..I $G(MRKV(I,N,"FLD")) S L=L+2 ..I $G(MRKV(I,N,"BIG")) S L=L*2 ..S MRKV(I)=$G(MRKV(I))_L_"," .;;ZWR MRKV .I $D(@$$^W4MAIN("TMPREP")@("M",I))#2 S MRKV(I)=^(I) ; S BEGG=I S MAXG=MAXG0-(BEGG*2)-2 S ENDG=BEGG+MAXG ; PC ;;D NOSELECT^%W1JS N CURSORT S CURSORT=$$GETP^%W1PRM("CURSORT") I CURSORT D SORT(CURSORT) ; W "
" ;;W " style=""page-break-before:always;filter: progid:DXImageTransform.Microsoft.BasicImage(Rotation=1);"">",! S %PGNMB=%PGNMB+1 S @$$^W4MAIN("TMPREP")@("P",98)=%PGNMB W "",! W "
" D TBL1(0,FSZHD) ; N PRKAV,ST,PRM,PRVHD S PRKAV=0,PRVHD=1 S ST="" F S ST=$O(MRKV(ST)) Q:ST="" D SHAP(ST) W "
" ; W "" D PCHD(COD) W "",! ; W "" D TBL1(0,FSZ) S RZD="\" ; S K=0 F S BG=$O(@$$^W4MAIN("S4B")@(BG)) Q:BG="" Q:BG>90000 S K=K+1 Q:K>MAXG D .N A S A=$G(^(BG)) .I $D(@$$^W4MAIN("S4B")@(BG,"B")) D PCRKVG(A,2) Q .D PCRKVG(A,0) ; W "",! ; I BG=""!(BG=99999) D .W "" .D TBL1(0,FSZ) .D PCRKVG($G(@$$^W4MAIN("S4B")@(99999)),1) .W "",! ; W "
",! ; I BG'="",BG<99999 D S BG=BG-1 G PC .W $$^%W1DICT("CONTINUENEXTPAGE"),! Q ; ; PCRKVG(A,PRTOT) W "" N J,F S J=0,F=0 N PRM S PRM=$G(MRKV("G")) ;;Q:PRM="" ; N N S N="" F S N=$O(MRKV("G",N)) Q:N="" D .S J=J+1 .N MCF S MCF=$$SPA^%L1FRM($G(MRKV("G",N))) .N FLD S FLD=0 .I $G(MRKV("G",N,"FLD")) S FLD=1 .I FLD S F=F+1 .W "" .W " " .I FLD D ..N ZN S ZN=$$H2U^%L1FRM($P(A,RZD,F)) ..I ZN="" Q ..I $L(MCF),MCF["9",MCF["." D ...I ZN["[" Q ...S DR=$L($P(MCF,".",2)) ...S ZN=$J(ZN,DR,DR) ...S ZN=$$ZPT^%L1FRM(ZN) ..I $$CLRZN(ZN)?1"0"."."."0" W "" ..I $$CLRZN(ZN)<0 W "" ..W ZN ..I $$CLRZN(ZN)<0 W "" .W "" W "",! Q ; SHAP(ST) ; Q:'ST S PRM=MRKV(ST) ;;I $$KAV(ST) S PRKAV=1-PRKAV,PRVHD=0 Q W "" D W "",! .S J=0 .S RKV="" F S RKV=$O(MRKV(ST,RKV)) Q:RKV="" D ..S J=J+1 ..N BIG S BIG=0 I $G(MRKV(ST,RKV,"BIG")) S BIG=1 ..N FLD S FLD=0 I $G(MRKV(ST,RKV,"FLD")) S FLD=MRKV(ST,RKV,"FLD") ..W "" ..D ...N ZN,TYP S TYP="" S ZN=$G(MRKV(ST,RKV)) ...I BIG!FLD S ZN=$$SPA^%L1FRM(ZN) ...I FLD D ....S TYP=$G(@$$^W4MAIN("TMPREP")@("P",+ZN,"TYP")) ....S ZN=$G(@$$^W4MAIN("TMPREP")@("P",+ZN)) ....S ZN=$$HBR^%L1FRM(ZN,FLD) ...W "ENDG)) W ";font-weight:bold" ...W """>" ...W $$H2U^%L1FRM(ZN) ..W "" ..W "" ; I MRKV(ST)'=$G(MRKV(ST+1)) D .W "",! .I $D(@GLHD@(ST+1)) W "" D TBL1(0,FSZHD) ; Q ; STR(I) ; N A,J,NRKV,FLD,BTW S A=$G(@GLHD@(I)) S NRKV=1,J=MAXHD+1,FLD=0,PRSP=1,BIG=0 CYC S J=J-1 Q:J<1 I $E(A,J)=">" S NRKV=NRKV+1 S FLD=$$FLDLEN(A,J),PRSP=0 G CYC I $E(A,J)="&" S NRKV=NRKV+1,FLD=0 S PRSP=1 G CYC I $E(A,J)="#" S NRKV=NRKV+1,BIG=1-BIG S PRSP=0,PRKAV=0 G CYC I $E(A,J)'=" ",PRSP S NRKV=NRKV+1,PRSP=0 ; S MRKV(I,NRKV)=$E(A,J)_$G(MRKV(I,NRKV)) ; I '$G(MRKV(I,NRKV,"FLD")) S MRKV(I,NRKV,"FLD")=FLD I '$G(MRKV(I,NRKV,"BIG")) S MRKV(I,NRKV,"BIG")=BIG ; G CYC ; ; FLDLEN(A,J) N J1,K S K=0 F J1=J:-1:1 S K=K+1 Q:$E(A,J1)="&" I $E(A,J1,J1+1)'?1"&"1N S K=0 Q K ; TBL1(BORDER,FSZ) ; ;;S BORDER=1 W " ",! Q ; ; HDSTYLE ; S BCL=$$BGHD^W3CSS("DRW") W " style=""background-color:"_BCL_";color:white;font-weight:bold;text-align:center""" Q ; ; BETWEEN(A,J,RZD) ; N PR S PR=0 N K F K=J-1:-1:1 I $E(A,K)=RZD S PR=1 Q N K1 F K1=J+1:1:$L(A) I $E(A,K1)=RZD S PR=PR+1 Q I PR=2 Q 1 Q 0 ; STRG(COD) ; N GREP S GREP="^[$$^W3MAIN]W4REP" D LNG F J=1:1 Q:'$D(@GREP@(COD,"REP",LNG,J)) D .N A S A=$G(^(J)) .N TYP S TYP=$P(A,";",3) .N L S L=$P(A,";",4) .N DR S DR=$P(L,",",2) .I TYP="D" S MRKV("G",J)="DD.DD.DD" .I TYP="E"!(TYP="H") S MRKV("G",J)=$TR($J("",L)," ","T") .I TYP="N" D ..S MRKV("G",J)=$TR($J("",L-DR-1)," ","9") ..I DR D ...S MRKV("G",J)=MRKV("G",J)_"."_$TR($J("",DR)," ","9") ...S MRKV("G",J)=$$ZPT^%L1FRM(MRKV("G",J)) .S MRKV("G",J,"FLD")=1 .I $D(@GREP@(COD,"REP",LNG,J,"PROC")) S MRKV("G",J,"PROC")=$G(^("PROC")) Q ; PCHD(COD) ; N PRM S PRM=$G(MRKV("G")) Q:PRM="" S SWG=$$SWG(COD) D TBL1(0,FSZ) W "" N GREP S GREP="^[$$^W3MAIN]W4REP" S LNG=$$^%W1LNG S:LNG="" LNG="H" F J=1:1 Q:'$D(@GREP@(COD,"REP",LNG,J)) D .N A S A=$G(^(J)) .W "" W "
"_$$H2U^%L1FRM($P(A,";",2))_"
",! Q ; SWG(COD) ; N GREP S GREP="^[$$^W3MAIN]W4REP" S LNG=$$^%W1LNG S:LNG="" LNG="H" N L S L=0 F J=1:1 Q:'$D(@GREP@(COD,"REP",LNG,J)) D .N A S A=$G(^(J)) .S L=L+$P(A,";",4)+1 Q L ; CLRZN(VL) ; Q $TR(ZN,"[] ","") ; SORT(CURSORT) ; N (JB,%ARG,CURSORT,COD,GREP,LNG) ;;S ^AA("W1FREPB-SORT")=CURSORT S INDTOT=99999 S SORT=+CURSORT S:$G(LNG)="" LNG="H" S ASDS=$S($P(CURSORT,"~",2):-1,1:1) S GREP="^[$$^W3MAIN]W4REP" S TYP=$G(@GREP@(COD,"REP",LNG,SORT)) S S4B=$$^W4MAIN("S4B") S VRM=$$^W4MAIN("vrm") K @VRM S I=0 ; S DL=20 S N="" F S N=$O(@S4B@(N)) Q:N="" I N,N9 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 M ; i %ZG=0 D W("No globals selected") q D SPACE(1) S %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="^" 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 . D 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 !! D W("Total of "_n_" node"_$s(n=1:"",1:"s")_" in "_m_" global"_$s(m=1:".",1:"s."),"color:green") c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q ; ERR D 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 %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)="" D W(" no such device") s %ZD="" q ; o %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0 i '$t D 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 ; W(TXT,DOPSTYLE) ; I $D(%NOSHOW) Q N A S A="
" S A=A_TXT S A=A_"
" S SH=$O(@TMP@(9999999),-1)+1 D TMP S @TMP@(SH)=A Q SPACE(COUNT) ; D TMP N I F I=1:1:COUNT S SH=SH+1,@TMP@(SH)="
" Q TMP ; S TMP=$$^W4MAIN("TMP") Q %W1H2U %W1H2U(TXT) ; [ 04.03.19 18:30 ] [ 08.10.15 19:33 ] [ 13.05.13 10:18 ] 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 ; ;;N DMLS S DLMS="=-)(*&^%$#@!\[]';?><|" ;;N J F J=1:1:$L(DLMS) S TXT=$$RPL^%L1FRM(TXT,$E(DLMS,J)," "_$E(DLMS,J)_" ") ; S I=$L(TXT) S OU="",PRHB="" CYC S I1=I I $$HB($E(TXT,I)) D .S W="",W1="",EN=0 .F I1=I:-1:0 Q:$E(TXT,I1)=" " D ;?.P&'$$HB($E(TXT,I1)) D ..N CMB S SMB=$E(TXT,I1) ..I $$HB(SMB)!("<([{"[SMB) S:EN W=W_W1,EN=0,W1="" S W=W_$$PROC(SMB) Q ..I '$$HB(SMB),"<([{"'[SMB S W1=$$PROC(SMB)_W1,EN=1 Q .I $L(W1) S W=W_W1 .S OU=OU_W ; I I1<1 G END ; S I=I1 I $E(TXT,I)=" " S OU=OU_" ",I=I-1 G:I<1 END 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:1 Q:$E(TXT,I1)=SK($E(TXT,I)) S W=$E(TXT,I1)_W .S W=$E(TXT,I1)_W,I=I1-1 .S OU=OU_W,PRHB=0 ; ; I '$$HB($E(TXT,I)),"([{"[$E(TXT,I) D G:I<1 END 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:0 Q:$E(TXT,I1)=">"&($E(TXT,I1-1)="E")&($E(TXT,I1-2)="<") D ...S W1=$E(TXT,I1)_W1 ..I I1>2 S W1=""_W1,I1=I1-3 Q . .S W="",PREN=0 .F I1=I:-1:0 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=$E(TXT,I1)_W .S OU=OU_W .I $E(TXT,I1)=">",$E(TXT,I1-1)="E",$E(TXT,I1-2)="<" S I=I1 Q:I<1 G MET .I I1>0,$E(TXT,I1)?.P,$E(TXT,I1)'="" S OU=OU_$$SCB($E(TXT,I1)),I1=I1-1 ; I I1>0 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:1 Q:$E(TXT,J)=SK($E(TXT,I)) D Q:PRHB .I $$HB($E(TXT,J)) S PRHB=1 Q PRHB ; PROC(SMB) ; I "{[(<>)]}"'[SMB Q SMB Q $$SCB(SMB) %W1H2U0 %W1H2U(TXT) ; [ 22.12.12 21:16 ] [ 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 I=$L(TXT) S OU="",PRHB="" CYC S I1=I I $$HB($E(TXT,I)) D .S W="" .F I1=I:-1:0 Q:$E(TXT,I1)?.P&'$$HB($E(TXT,I1)) D ..S W=W_$E(TXT,I1) .S OU=OU_W .;;I $E(TXT,I1)=">" I $E(TXT,I1-1)="E",$E(TXT,I1-2)="<" Q .I $E(TXT,I1)?.P,"{[(<>)]}"'[$E(TXT,I1) S OU=OU_$E(TXT,I1),I1=I1-1 ; I I1=0 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:1 Q:$E(TXT,I1)=SK($E(TXT,I)) S W=$E(TXT,I1)_W .S W=$E(TXT,I1)_W,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:0 Q:$E(TXT,I1)=">"&($E(TXT,I1-1)="E")&($E(TXT,I1-2)="<") D ...S W1=$E(TXT,I1)_W1 ..I I1>2 S W1=""_W1,I1=I1-3 Q . .S W="",PREN=0 .F I1=I:-1:0 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=$E(TXT,I1)_W .S OU=OU_W .I $E(TXT,I1)=">",$E(TXT,I1-1)="E",$E(TXT,I1-2)="<" S I=I1 G MET .I I1>0,$E(TXT,I1)?.P,$E(TXT,I1)'="" S OU=OU_$$SCB($E(TXT,I1)),I1=I1-1 I I1>0 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:1 Q:$E(TXT,J)=SK($E(TXT,I)) D Q:PRHB .I $$HB($E(TXT,J)) S PRHB=1 Q PRHB %W1HB %W1HB(STAM) ; [ 01.11.23 22:57 ] [ 11.07.17 16:35 ] [ I ($$^%W1LNG="H")!$D(NOPCLOAZ) Q 1 Q 0 %W1HD %W1HD(PRM,REP,FUNC) ; [ 08.04.25 13:02 ] [ 04.04.25 03:41 ] [ 29.03.25 06:33 ] N (JB,%ARG,PRM,REP,FUNC) S WD=4 S COLOR="#EAEAEA" ; W "
",! W "",! W "" W "" ; I $G(FUNC) D .N PROC S PROC="SaveAndBack()" .I FUNC=2 S PROC="Save()" .W "" W "",! W "
" D NAME($G(PRM),$G(REP)) W "" . W "" . W $$NBSP^%L1FRM(5) . W "" .W "
",! w "
",! Q ; NAME(PRM,REP) ; N MSD S MSD=$$GETP^%W1PRM("MSD") I MSD D .W "" . W $$H2U^%L1FRM($$^W3MSDG(MSD))_" "_$$NBSP^%L1FRM(2) D .I $E(PRM)="!" W $$H2U^%L1FRM($E(PRM,2,255)) Q .I '$G(REP) W $$^%W1DICT(PRM) Q .W $$REPNAME^W4REPSCR(PRM) Q ; ; STYLE1(WD,COLOR) ; Q "" ; STYLE2(WD,COLOR) ; Q "" %W1HD0 %W1HD(PRM,REP,FUNC) ; [ 29.03.25 06:25 ] [ 26.03.25 17:13 ] [ 11.11.24 11:19 ] N (JB,%ARG,PRM,REP,FUNC) S WD=2 S COLOR="#EAEAEA" ;"#A35232" ; W "
",! W "",! W "" W "" ; I $G(FUNC) D .W "" W "",! W "
" D NAME($G(PRM),$G(REP)) W "" . W "" . W $$NBSP^%L1FRM(5) . W "" .W "
",! w "
",! Q ; NAME(PRM,REP) ; N MSD S MSD=$$GETP^%W1PRM("MSD") I MSD D .W "" . W $$H2U^%L1FRM($$^W3MSDG(MSD))_" "_$$NBSP^%L1FRM(2) D .I $E(PRM)="!" W $$H2U^%L1FRM($E(PRM,2,255)) Q .I '$G(REP) W $$^%W1DICT(PRM) Q .W $$REPNAME^W4REPSCR(PRM) Q ; ; STYLE1(WD,COLOR) ; I $G(WD)="" S WD=2 I $G(COLOR)="" S COLOR="white" Q "style=""border-bottom:"_WD_"px inset "_COLOR_" ; border-top:"_WD_"px inset "_COLOR_" ; border-right:"_WD_"px inset "_COLOR_""" " ; STYLE2(WD,COLOR) ; I '$G(WD) S WD=2 I $G(COLOR)="" S COLOR="white" Q "style=""border-bottom:"_WD_"px inset "_COLOR_" ; border-top:"_WD_"px inset "_COLOR_" ; border-left:"_WD_"px inset "_COLOR_""" " %W1JB %W1JB(STAM) ; [ 15.06.13 18:13 ] [ 16.04.12 12:31 ] [ 07.08.07 07:08 ] [ I $$^W4GLLIN Q $J Q "JB"_+JB %W1JS %W1JS ; [ 31.10.24 15:35 ] [ 08.06.23 07:35 ] [ 13.08.17 10:58 ] D ADDROW,PARSE,LEN,BDIKA,CLRNMB Q ADDROW ; --> LenDlm(), Parse() W "function AddRowOrd(Tbl,Str,Dlm)",! W " {",! ;;W " alert(""Tbl=""+Tbl+"" Str=""+Str+"" Dlm=""+Dlm)",! W " var t=document.getElementById(Tbl);",! W " var last=t.rows.length;",! W " var newrow=t.insertRow(last);",! W " for (i=1;i<=LenDlm(Str,Dlm);i++)",! W " {",! W " x=newrow.insertCell(0);",! W " }",! W " for (i=0;i1) {return '';}",! W " if (Start<1) {Start=1;}",! W " if (Fin>arr.length) {Fin=arr.length;}",! W " if (Start>arr.length) {return '';}",! W " st=arr[Start-1];",! W " for (i=Start;i Parse(), LenDlm(), SetCellSel() W "function CellSel(IDC,SEL)",! W " {",! W " var i,sel;",! W " sel="""";",! W " for (i=2;i<=LenDlm(SEL,""~"");i++)",! W " { sel=sel+""""; }",! ;;W " alert('sel='+sel);",! W " document.getElementById(IDC).innerHTML=" W "'';",! W " }",! W ! W "function SetCellSel(IDC)",! W " {",! W " var x=document.getElementById(""SelMenu"");",! W " var y=document.getElementById(IDC);",! W " y.innerHTML=x.options[x.selectedIndex].text;",! W " }",! W ! Q DELROW ; -- no call W "function DelRow(Tbl,NRow)",! W " {",! W " var t=document.getElementById(Tbl);",! W " if (t !== null)",! W " { t.deleteRow(NRow); }",! W " }",! W ! Q BDIKA ; --> Msg(),ClearFld(),Parse() W "function BDIKA(FLD,NMFLD,MIN,SUG)",! W " {",! W " var sug=Parse(SUG,""-"",1,1);",! W " var fld=document.getElementById(FLD);",! W " if (fld===null) { Msg('FLDNOTDEF',FLD) ; return false; }",! W " var fldvl=ClearFld(FLD);",! W " fldvl=fldvl.replace(/-/g,'')",! ; I $$POLYGON^W4PRM D .W " if ( FLD == 'STREET' ) {",! . W " if (fldvl.indexOf(',')<0) { MsgFoc(FLD,'FLDMUST',NMFLD+'!D','font-size:"_$$^W3FSZ(18)_";background-color:yellow');return false; }",! . W " if (ParseTxt(fldvl,',',1,1)=='' || ParseTxt(fldvl,',',2,2)=='') { MsgFoc(FLD,'FLDMUST',NMFLD+'!D','font-size:"_$$^W3FSZ(18)_";background-color:yellow');return false; }",! .W " }",!! ; W " if (sug==='TEL') {",! W " fldvl=fldvl.replace(/!/g,'')",! W " }",! W " var fldvl1=fldvl.replace(/ /g,'')",! ;;W " alert(FLD+'='+Asc(fldvl))",! W " var fldlen=fldvl1.length;",! W " if (fldlen<1 && SUG.indexOf(""\-M"")>-1 ) { MsgFoc(FLD,'FLDMUST',NMFLD+'!D','font-size:"_$$^W3FSZ(18)_";background-color:yellow');return false; }",! W " if (fldlen<1 && SUG.indexOf(""\-M"")===-1 ) {return true;}",! W " var MAX=999;",! W ! I $$^%W1LNG="H" D .W " if (sug==='TEL') {",! .W " if (fldlen<7 ) { MsgFoc(FLD,'FLDMIN',NMFLD+'!D;7');return false; }",! .W " if (fldlen>"_$S($$^%W1LNG="H":11,1:14)_") { MsgFoc(FLD,'FLDMAX',NMFLD+'!D;"_$S($$^%W1LNG="H":11,1:14)_"');return false;}",! .W " var vln=Parse(fldvl,'-',1,1)+Parse(fldvl,'-',2,2);",! .W " if (isNaN(vln)===true) { MsgFoc(FLD,'FLDNUM',NMFLD+'!D');return false;}",! .W " return true;",! .W " }",! W ! W " if (sug==='EM') {",! W " if (fldlen<7 ) { MsgFoc(FLD,'FLDMIN',NMFLD+'!D;7');return false; }",! W " var pre=Parse(fldvl,'@',1,1);",! W " var post=Parse(fldvl,'@',2,2);",! W " if (post.length === 0) { MsgFoc(FLD,'FLDERR',NMFLD+'!D');return false; }",! W " var post1=Parse(post,'.',1,1);",! W " var post2=Parse(post,'.',2,2);",! W " if (post1.length === 0) { MsgFoc(FLD,'FLDERR',NMFLD+'!D');return false; }",! W " if (post2.length === 0) { MsgFoc(FLD,'FLDERR',NMFLD+'!D');return false; }",! W " return true;",! W " }",! W ! W " if (sug==='TX') {",! W " if (isNaN(fldvl)===false) { MsgFoc(FLD,'FLDTXT',NMFLD+'!D');return false; }",! W " }",! W ! W " if (sug==='N') {",! W " if (isNaN(fldvl)===true) { MsgFoc(FLD,'FLDNUM',NMFLD+'!D');return false; }",! W " }",! W ! W " if (sug==='NA') {",! W " if (isNaN(fldvl.substr(0,1))===true && fldvl !== ""."" ) { MsgFoc(FLD,'FLDNUM',NMFLD+'!D');return false; }",! W " }",! W ! W " var MINS=MIN+'';",! W " if (MINS.indexOf('-')>-1)",! W " { MAX=Parse(MINS,'-',2,2);",! W " MIN=Parse(MINS,'-',1,1);",! W " }",! W " if (isNaN(MAX) === false ) ",! W " { ",! W " if (fldlen>MAX) ",! W " { MsgFoc(FLD,'FLDMAX',NMFLD+'!D;'+MAX);",! W " return false;",! W " }",! W " }",! W ! W " if (isNaN(MIN)===false)",! W " {",! W " if ( MIN>0 ) {",! W " if (fldlen31 && smb < 127 || smb>1000 )",! W " {a1=a1+a.substr(i,1)}",! W " }",! ;;W " alert('CLRFLD2: '+FLD+'='+fld)",! W " return a1;",! W "}",! W ! ASC ; W "function Asc(VL)",! W " {",! W " VL=VL+'';",! W " var st='';",! W " for (var j=0; j 57 ) continue ;",! W " if (Vl.charCodeAt(i) == 47 ) continue ;",! W " a1=a.substr(i)",! W " break;",! W " }",! W " return a1;",! W "}",! Q DT ; W "function VldDD(DID)",! W " {",! W " var dd=document.getElementById(DID);",! W " if ( dd.value>31 ) {",! ;W " dd.value="""";",! W " dd.select();",! W " dd.focus();",! W " }",! 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 " mm.focus();",! W " }",! W " }",! W ! W "function VldYY(YY)",! W " {",! W " }",! W ! Q READONLY ; W ! W "function ReadOnly(RKV)",! W "{",! W "var rkv=document.getElementById(RKV);",! W "if (rkv===null) {return;}",! W "rkv.readOnly=true;",! W "}",! W ! Q DISABLE ; W ! W "function Disable(RKV)",! W "{",! W "var rkv=document.getElementById(RKV);",! W "if (rkv===null) {return;}",! W "rkv.disabled=true;",! W "}",! W ! Q SETFOCUS ; W ! W "function SetFocus(RKV)",! W "{",! W "var rkv=document.getElementById(RKV)",! W "if (rkv===null) {return;}",! W "rkv.focus();",! W "}",! W ! Q FORMAT ; W ! W "function Format(NMB,DEC)",! W "{",! W " if (NMB == null || NMB == undefined ) return ''",! W " if (typeof DEC =='undefined' ) DEC=2",! W " if (NMB.length===0) {NMB=""0.0"";}",! W " if (isNaN(NMB)) {NMB=""0.0"";}",! W " var integ=ParseTxt(NMB,""."",1,1);",! W " var drob=ParseTxt(NMB,""."",2,2);",! W " var lendr=drob.length;",! W ! W " if (DEC===0) return Math.round(NMB);",! W " if (DEC<0) return Math.round(NMB);",! W ! W " if (lendrDEC) ",! W " {",! W " var dr=drob.substr(0,DEC);",! W " var drl=+drob.substr(DEC,1);",! W " if (drl>4) {dr=+dr+1;}",! W " dr=dr+''",! W " lendr=dr.length",! W " if (lendrDEC) ",! W " {",! W " integ=+integ+1;",! W " dr='0000000000000'",! W " dr=dr.substr(0,DEC);",! W " }",! W " return (integ+"".""+dr);",! W " }",! W " return NMB;",! W "}",! W ! Q MSG ; --> LenDlm(),ParseTxt() W "function Message(txt)",! W " {",! W " var a=""""",! W " for (var i=0;i= 0)",! W " {",! W " Nmb1=Nmb1-Nmb2;",! W " }",! W " return Nmb1;",! W " }",! W ! Q ROUNDBUT(ID,TXT,ONCLICK,STYLE,DOP) ; D ^W4BUTTON(ID,TXT,ONCLICK,$G(STYLE),$G(DOP)) Q W $$ROUNDTB(ID,$G(TXT),$G(ONCLICK),$G(STYLE),$G(DOP)) ; Q ; ROUNDTB(ID,TXT,ONCLICK,STYLE,DOP) ; N DOPIMG,DOPHEIGHT,BG,WD,FS S BG="",FS="" S DOPIMG="",HG=20,WD="" ; I $G(DOP)="",$$GET^%W1PRM("COLOR")'["" S TB=TB_"" ; I $$^%W1DIR="RTL" D .S TB=TB_"" I $$^%W1DIR="LTR" D .S TB=TB_"" ; S TB=TB_" "_TXT_" " ; I $$^%W1DIR="RTL" D .S TB=TB_"" I $$^%W1DIR="LTR" D .S TB=TB_"" ; S TB=TB_"" Q TB ; ; NOSELECT ; Q ; -- 08/06/23 ; W "",! Q CLEARSEL ; W "",! Q ; NOSELTBL(TBL) ; W "",! Q %W1JSP %W1JSP ; [ 03.03.21 10:29 ] [ 25.10.09 19:30 ] [ 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 S FFILE=$$FULL^%L1WEBJS(FILE) I $$^%L1ZOS(10,FFILE)>0 U 0 W !!," FILE "_FFILE_" EXIST ! " H 3 G MF MT R !!,"TITLE:" S %LS=40,%S="" D ^%ZMSL G:%S=""!(%TO="END") MF S TITLE=%S R !!,"CAPTION :" W ! S %LS=40,%S="",%XX=50,%YY=$Y X %POSIC S %INV="" D ^%L1ZMS G:%S=""!(%TO="END") MT S HD=%S ; D ^%L1WEBJS(FILE,TITLE,HD) ; D ED(FILE) Q ED(FILE) ; N FFILE,YES,%Q,%W1JSP S FFILE=$$FULL^%L1WEBJS(FILE) c FFILE o FFILE:(readonly:record=2048:rewind) ;;S $ZT="g REOF" N I,X S I=0 K ^S000($P) f u FFILE r X Q:$ZEOF S I=I+1,^S000($P,I)=$TR(X,$C(9)," ") REOF ; c FFILE K ^S222($J) M ^S222($J)=^S000($P) ; -- OLD VERSION 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 ; S %PROG=$$FUNC^%UCASE(FILE) K ^UTILITY($J),^S111($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 M ^[DIR]%ERGS(+$H,%PROG,$P($H,",",2))=^S111($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 K ^S111($J),^S222($J) END K ^S000($P) Q ; VW(FILE) ; K ^S111($J) N FFILE,YES,%Q S FFILE=$$FULL^%L1WEBJS(FILE) 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,^S111($J,I)=$TR(X,$C(9)," ") REOFVW c FFILE Q %W1JSPID %W1JSPID(%PKG) ; [ 09.04.07 14:57 ] [ W "",! W " ",! W " ",! W "",! W "",! W " ",! W " ",! W "",! W "
",! W "",! Q %W1KILL %W1KILL ; [ 09.04.07 10:26 ] [ K Q KS(JB) ; I $G(JB)="" Q Q %W1LNG %W1LNG(STAM) ; [ 22.07.17 13:24 ] [ 16.07.17 18:32 ] [ 08.07.17 10:56 ] N (JB,%W1LNG) I $G(%W1LNG)?1U.U Q %W1LNG S %LNG=$$GET^%W1PRM("LNG") I $L(%LNG),%LNG'["UNDEF" S %W1LNG=%LNG G END N MSD S MSD=$$GETP^%W1PRM("MSD") ; I MSD,$L($$LNG^W3PRM(MSD)) S %LNG=$$LNG^W3PRM(MSD) G END ; N MSDR S MSDR=$$GET^%W1PRM("MSDR") I MSDR Q $$LNG^W3MSDR(MSDR) S %LNG=$G(^[$$^%W1UCI(+$G(JB))]W1LNG,"H") END I %LNG'?1U.U S %LNG="H" Q %LNG ; SHIFT(STAM) ; I $$%W1LNG="H" Q 1392 I $$%W1LNG="E" Q 0 Q 0 ; ENG ; S %W1LNG="E" D ^%L1TS Q HBR ; S %W1LNG="H" D ^%L1TS Q %W1MN %W1MN ; [ 22.06.10 03:47 ] [ MENUCOLOR ; W " style=""cursor:pointer;color:"_$$BGHD^W3CSS($$COLOR^W3CSS)_";font-size:"_$$^W3FSZ(12)_";font-weight:bold""" W " onMouseOver=""this.style.color='blue'""" W " onMouseOut=""this.style.color='"_$$BGHD^W3CSS($$COLOR^W3CSS)_"'""" Q %W1MSG %W1MSG ; [ 03.05.07 14:39 ] [ ;;W "",! Q %W1PC %W1PC(%REPN) ; [ 19.03.25 14:11 ] [ 18.03.25 10:31 ] [ 16.03.25 18:15 ] ;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(%L3MYDVN)) ; ^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 ;------------------------------------------------------------------- BG ; K (%REPN,%L1PC,MAS,JB,%ARG,%REM) I %REPN["m" S %REPN=$P(%REPN,"m") Q ; ISQUERY(STAM) ; I $G(%REPN)="" S %REPN=$G(@$$^%W1GLPRM("REPN")) I %REPN="" Q "NOREPN" D GLREP I $D(@GLREP@("QUERY")),$O(@GLREP@("QUERY",$O(@GLREP@("QUERY",""))))'="" Q 1 Q 0 ; QUERYMN ; N GLREP D GLREP K MN N N,I S I=0 I $G(NEWMENU),'$$NEWMENU^W4PRM K NEWMENU ; I '$G(NEWMENU) D .S I=I+1,MN(I)=$$^%W1DICT("BACK") ; S MA(I)=$$GET^W4STACK("REPBACK",1) ;;$$GETP^%W1PRM("REPBACK") I $$US^W4PRSMNU D .S MA(I)="Back()" ; S N="" F S N=$O(@GLREP@("QUERY",N)) Q:N="" D .S I=I+1,MN(I)=$$SPA^%L1FRM(N) .I MN(I)?1N.N." "."-".E D ..S MN(I)=$$CLR(MN(I)) .S MA(I)="w1query.jsp?JB="_JB_"&QUERY="_$$CLWEB^%L1FRM(N)_"&FIRST=1" ; N ZERO S ZERO=1 I '$$NEWMENU^W4PRM!$D(NONEWMENU) D .D WMN^%W1WEBMN(.MN,.MA,"",1) ; I $$NEWMENU^W4PRM,'$D(NONEWMENU) D .N MN1 M MN1=MN .N CUR,ZERO S CUR=0,ZERO=0 .N MENU S MENU="-" .I $L($G(%ARG("REPN"))) S MENU="-^"_$$REPNAME^W4REP($G(%ARG("REPN"))) .D BODYMENU^%W2WEBMN(MENU,1) ; Q ; SETPRMQ(QUERY) ; I $G(QUERY)="" Q I $G(%REPN)="" Q M %REPN=@$$^%W1GLPRM@("REPN") D GLREP N I F I="MIUN","SIK0","CT","FLD0" D .S @GLREP@(I)=$G(@GLREP@("QUERY",QUERY,I)) Q ; V0 ; D ^%W1PCIN D SHEIL ; ----- VISV. SHEIL. D SAVE^%W1PCIN(JB) ; I $$KBVRT^W4PRM D ^W4KBABC Q ; KAV S %STRING="" F JJ=1:1:3 S %STRING=%STRING_"-----------------------------------*" D SAVST S PRSUM=1 Q ; SHEIL D SHEIL^%W1PCS Q ; LPT ; S %EROP=0 I $$^%L1DISP(USTR) Q S %DEV="USTR" D ^%L1LPT Q ; SHEIL2 D SHEIL2^%W1PCS ; Q SHEIL3 D SHEIL3^%W1PCS Q ; SAVST S MONE=$O(@$$^W4MAIN("TREPK")@(999999),-1)+1 S @$$^W4MAIN("TREPK")@(MONE)=%STRING S @$$^W4MAIN("TREPK")=MONE Q GLREP ; S GLREP=$$^%W1GLREP Q ; INIT ; K (JB,%ARG,%REM,%REPN) I '$G(%ARG("NOKILLPRM")) K @$$^%W1GLPRM K @$$^W4MAIN("TREP") K @$$^W4MAIN("TREPK") K @$$^W4MAIN("TMPREP") K @$$^W4MAIN("TMPREPB") Q ; CLR(MN) ; N J F J=1:1 Q:$E(MN,J)'?1N&($E(MN,J)'=" ")&($E(MN,J)'="-") S MN=$E(MN,J,255) Q MN %W1PC0 %W1PC(%REPN) ; [ 12.06.09 09:41 ] [ 11.06.09 21:12 ] [ 10.06.09 16:40 ] ;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(%L3MYDVN)) ; ^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 ;------------------------------------------------------------------- BG ; K (%REPN,%L1PC,MAS,JB,%ARG,%REM) I %REPN["m" S %REPN=$P(%REPN,"m") Q ; ISQUERY(STAM) ; I '$D(%REPN) S %REPN=$G(@$$^%W1GLPRM("REPN")) D GLREP I $D(@GLREP@("QUERY")),$O(@GLREP@("QUERY",$O(@GLREP@("QUERY",""))))'="" Q 1 Q 0 ; QUERYMN ; N GLREP D GLREP K MN N N,I S I=0 S I=I+1,MN(I)=$$^%W1DICT("BACK") S MA(I)=$$GET^%W1PRM("REPBACK") S N="" F S N=$O(@GLREP@("QUERY",N)) Q:N="" D .S I=I+1,MN(I)=N .S MA(I)="w1query.jsp?JB="_JB_"&QUERY="_$$CLWEB^%L1FRM(N)_"&FIRST=1" ; D WMN^%W1WEBMN(.MN,.MA,"",1) Q ; SETPRMQ(QUERY) ; M %REPN=@$$^%W1GLPRM@("REPN") D GLREP N I F I="MIUN","SIK0","CT","FLD0" D .S @GLREP@(I)=$G(@GLREP@("QUERY",QUERY,I)) Q ; V0 ; D ^%W1PCIN D SHEIL ; ----- VISV. SHEIL. D SAVE^%W1PCIN(JB) Q ; ; Z(STAM) N (%ARG,JB,%REM) D GLREP I $D(%L1PC("SHEIL")) G S0 ; S D SHEIL1^%W1PCS K %L1GET ; ---- VERXN. SHEILTA ; S0 S MM=0,ER=0 F I=1:1:MAXMIUN I $G(MIUN(I))>MM,$G(MIUN(I))MAXMIUN S ER="-1;SORTTOOBIG" Q I ER<0 Q ER ; F I=1:1:MAXMIUN F J=I+1:1:MAXMIUN I +MIUN(I),+MIUN(I)=+MIUN(J) S ER="-3;DOUBLESORT" Q I ER<0 Q ER ; S3 D SHEIL31^%W1PCS ; S31 S SIKUM="" 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 ; ---------- HITUHIM NOSAFIM -------- S %L1GET="" D SHEIL2 K %L1GET D SHEIL2 ; M1 ; S J=0 F I=1:1:MAXMIUN D .S J=J+1 M2 .I $P($G(@GLREP@("FLD0")),"*",J)="-" S J=J+1 G M2 .N K F K="MIUN","SIK0","CT" D ..S:$P($G(@GLREP@(K)),"*",J)'=$S(K="SIK0":SIK(I),1:@K@(I)) FLMODIF=FLMODIF+1 ..S $P(@GLREP@(K),"*",J)=$S(K="SIK0":SIK(I),1:@K@(I)) ; ZU K %L1PC("L1PCPRM") I $$^%L1MRK=1000,$$ADSL^%L1PORT D ^%W1PCSND G:'$G(%L1PCOK) BG I %L1PCOK=1 S %L1PC("L1PCPRM")="" ; S %GETIN=0 ; I '$D(%L1PC("L1PCPRM")) D ^%W1PCP ; S KOTNUM=1 I '$D(@$$^W4MAIN("TREPK")) Q "-3;NODATA" ; ALDSP S %L1PC("FILE")=$$^W4MAIN("TREPK") D ^%W1PC1 END K @$$^W4MAIN("TREP"),@$$^W4MAIN("TREPK"),@$$^W4MAIN("TREPK0") Q 1 ; KAV S %STRING="" F JJ=1:1:3 S %STRING=%STRING_"-----------------------------------*" D SAVST S PRSUM=1 Q ; SHEIL D SHEIL^%W1PCS Q ; LPT ; S %EROP=0 I $$^%L1DISP(USTR) Q S %DEV="USTR" D ^%L1LPT Q ; SHEIL2 D SHEIL2^%W1PCS ; Q SHEIL3 D SHEIL3^%W1PCS Q ; SAVST S MONE=$O(@$$^W4MAIN("TREPK")@(999999),-1)+1 S @$$^W4MAIN("TREPK")@(MONE)=%STRING S @$$^W4MAIN("TREPK")=MONE Q GLREP ; S GLREP=$$^%W1GLREP Q INIT ; K @$$^%W1GLPRM K @$$^W4MAIN("TREP") K @$$^W4MAIN("TREPK") K %L1PC K MAXMIUN K COLG,COLGM,SIK,CT,MIUN,QUERY K GLOB1,GLOB2 Q %W1PC1 W1PC1 ; [ 13.02.25 14:40 ] [ 15.01.25 13:47 ] [ 09.12.24 11:36 ] N SHLN0 S SHLN0=0 N ADD N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I '$$FL D NOSELECT^%W1JS D UFL W "
",! ; S %REPN=$G(@$$^%W1GLPRM@("REPN")) I %REPN="" Q I '$$FL D .I $$GETP^%W1PRM("P1PCBACK")'="NOBACK" D DIVEXC(%REPN,"%W1PCEX") D UFL ; W "",! I $$^W4TABLET'=2 D TRISSUE W "",! W "",! ; D GET^%W1PCIN(JB) ; ;;S ^AA("REPMAM","REPN")=$G(%REPN) ;;S ^AA("REPMAM","REPMAM")=$$REPMAM($G(%REPN)) ; I $$REPMAM($G(%REPN)) D .W "" . W "" .W "",! .S SHLN0=SHLN0+1 ; I $G(%REPN)="W4PRHL" D .N PRASR S PRASR=$$GETP^%W1PRM("PRASR") . .W "" . W "" .W "",! ; I $G(%REPN)="W4DPMH" D .N PRTIP S PRTIP=+$$GETP^%W1PRM("W4DPNHTIP") . .W "" . W "" .W "",! ; I $$DATREP D .W "" .W "",! .W "",! .W "",! .S SHLN0=SHLN0+2 ; W "
" W $$H2U^%L1FRM($$REPNAME^%W1PCS) I %REPN="DLVLK" D .S KINDDAT1=$$^%W1DICT($$HEADDAT^W4DLVLK) .S SHLN0=1 .W "
" . W KINDDAT1 .W "" W "
" . D TBMAM . W "
" . W $$^%W1DICT($S(PRASR:"CREDITSALESONLY",1:"ALLSALES")) . W "
" . W $$^%W1DICT($S(PRTIP:"SHOWDMSHNTIPS",1:"NOSHOWDMSHNTIPS")) . W "
" . D SHOWDAYS .W "
 
",! ; ; N I,J,A,PRTOT,PRHEAD D GETPRM S RSIZE=42,SHLN1=$G(SHLN0),SHLN=0 I $G(%REPN)="W4CLKT",$$DELIS^W4PRM S RSIZE=36 N HGLOGO S HGLOGO=$G(@$$^W4PL@("LOGO","HEIGHT")) I HGLOGO>20,'$G(@$$^W4PRM@("NOPCLOGO")) S SHLN1=SHLN1+(HGLOGO\30)+5 E S SHLN1=SHLN1+8 ; ;---------------------- REPORT PARAMETERS ---------------- W "",! N IJK,%RNG,DL,TYP,MCOD D REPPRM ; F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D SHOWRNG(COD) S MCOD(COD)="" ; F %I=1:1:$L(%FLDMIN,"*") D .S COD=$P(%FLDMIN,"*",%I) Q:COD?.P Q:$D(MCOD(COD)) .D SHOWRNG(COD) S MCOD(COD)="" ; F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) D SHOWRNG(COD) S MCOD(COD)="" ; W "
",! W "
",! ; ; ;---------------- REPORT TABLE --------------------- D OPTBL(1) S FIRSTCOL=COL01+1 ; ;--------------------- BODY ---------------- N AO S AO="",PRHD2=0 N A,I,J,OKEQ ; N GLPRM S GLPRM=$$^%W1GLPRM ; N DTPC1 S DTPC1=$G(@$$^%W1GLPRM@("VAL","METRH")) I 'DTPC1 S DTPC1=$G(@$$^%W1GLPRM@("VAL","MEDAT")) I 'DTPC1 S DTPC1=+$H N AHMAM S AHMAM=$$MAMD^W4L(DTPC1) ; ; F I=1:1 Q:'$D(@GLPRM@("GLOUT",I)) D .S A=$G(^(I)) . .I A?.P1"#"."#".P D NEWPAGE(I+1) Q . .I A?.P,A'?.P1"="."=".P,PRTOT S PRHEAD=1,PRTOT=0 D Q ..K ADD ; --- 04.10.22 ..D SHLN(0) ..W "",! ..F J=FIRSTCOL:1:$L(STO,"*") D ...W " ",! ..W "",! . .I A?.P1"="."=".P S PRTOT=$S($G(PRTOT):2,1:1) Q . .I $G(%ARG("SIK")),'$G(PRTOT) Q . .I 'PRTOT,'PRHD2 D ..S OKEQ=1 ..F J=1:1:COL01 I $P(A,"*",J)'=$P(AO,"*",J) S OKEQ=0 Q ..I 'OKEQ D HEAD2(I) . .S PRHD2=0 .; .D SHLN(1) .W "",! .S TD=" "_SHLN_"" . .F J=FIRSTCOL:1:$L(STO,"*") D ..W " "_TD ..N FLD S FLD=$P(STO,"*",J) ..I $G(PRM(FLD,"DR"))?1N W " dir=""LTR"" align=""right""" ..I $G(PRM(FLD,"DR"))="" W " dir="""_$$^%W1DIR_""" "_$$^%W1ALIGN ..D ...I $$ORD(FLD),%REPN="W4LKTN" D Q ....N ORD,SNIF,URL ....S SNIF=$P(A,"*",8) Q:'SNIF ....S ORD=$P(A,"*",10) Q:'ORD ....S URL=$$SITE^W3R(SNIF) ....I URL'[".",URL'["/" Q ....I $E(URL,$L(URL))'="/" S URL=URL_"/" ....W " onClick=""ShowSnifOrder('"_ORD_"','"_URL_"',this)"" style=""cursor:pointer"" " Q ... ...I $$ORD(FLD),%REPN="W4MZB" D Q ....N ORD,SNIF,URL ....S SNIF=$P(A,"*",2) Q:'SNIF ....S ORD=$P(A,"*",4) Q:'ORD ....S URL=$$SITE^W3R(SNIF) ....I URL'[".",URL'["/" Q ....I $E(URL,$L(URL))'="/" S URL=URL_"/" ....W " onClick=""ShowSnifOrder('"_ORD_"','"_URL_"',this)"" style=""cursor:pointer"" " Q ... ...I $$ORD(FLD),%REPN="HZHMM" W " onClick=""ShowCCOrder('"_$P(A,"*",J)_"',this)"" style=""cursor:pointer"" " Q ... ...I $$ORD(FLD) W " onClick=""ShowOrder('"_$P(A,"*",J)_"',this)"" style=""cursor:pointer"" " Q ...I $$CUST(FLD) D Q ....I $G(@GLPRM@("REPN"))="DLVLK" D Q .....N MEDAT S MEDAT=$ZD($G(@GLPRM@("VAL","METRH")),"DD.MM.YY") .....N ADDAT S ADDAT=$ZD($G(@GLPRM@("VAL","ADTRH")),"DD.MM.YY") .....W " onClick=""ShowDlvCustReport('"_$P(A,"*",J)_"',this,'"_MEDAT_"','"_ADDAT_"')"" style=""cursor:pointer"" " ....W " onClick=""ShowCust('"_$P(A,"*",J)_"',this)"" style=""cursor:pointer"" " ...I $$INVOICE(FLD) D TRG^W4DHB($P(A,"*",J)) Q ... ...N REPNAME S REPNAME=$G(@GLPRM@("REPN")) ...I REPNAME="MLTNIN" D Q ....I $G(PRM(FLD))'["hixt cew" Q ....N PAR S PAR=$P(A,"*",J) ....N MEDAT S MEDAT=$ZD($G(@GLPRM@("VAL","MEDAT")),"DD.MM.YY") ....N ADDAT S ADDAT=$ZD($G(@GLPRM@("VAL","ADDAT")),"DD.MM.YY") ....W " style=""cursor:pointer"" " ....W " onClick=""CurrentBorder(this);ShowItemReport('"_PAR_"','"_MEDAT_"','"_ADDAT_"','ifr')""" ... ...;;S ^AA("W1PC1","REPNAME",I,J)=REPNAME ...;;S ^AA("W1PC1",I,"A")=A ...;;S ^AA("W1PC1",I,J,"FLD")=FLD ...I $E(REPNAME,1,2)="ML"!($E(REPNAME,1,4)="W4ML")!(REPNAME="W4RMMLY"),FLD="PAR"!(FLD="PRT") D Q ....N PAR S PAR=$P(A,"*",J) ....W " style=""cursor:pointer"" " ....W " onClick=""CurrentBorder(this);ShowMlyItemCard('"_PAR_"',this)""" ... ...I $$OVED(FLD) D ....I $G(@GLPRM@("REPN"))'="W4CLKT" Q ....N MEDAT S MEDAT=$G(@GLPRM@("REPN","MEDAT")) ....N ADDAT S ADDAT=$G(@GLPRM@("REPN","ADDAT")) ....N FLSLR S FLSLR=$G(@GLPRM@("REPN","FLSLR")) ....D DHOV^W4CLKT($P(A,"*",J),MEDAT,ADDAT,FLSLR) Q ... ...I %REPN="W4DCB",FLD="CB" D ....W " style=""cursor:pointer"" " ....W " onClick=""CurrentBorder(this);ShowReceipt('"_$P(A,"*",2)_"','"_$P(A,"*",5)_"','ifr')""" ... ...D ....N DLD,VL S VL=$P(A,"*",J) ....I VL?."+"."-".1N.N.".".N D .....S DLD=$G(PRM(FLD,"DLD")) .....I DLD,+VL=0 W " style=""color:grey"" " .....I VL<0 W " style=""color:red"" " .. ..N VL S VL=$P(A,"*",J) ..N VL0 S VL0=VL ..; ..I $$LMAM,'$$EILAT(A),$$RKVMAM(J) D ...S VL=$J(VL*100/(100+AHMAM),5,5) ..; ..I $$LMAM,$$EILAT(A),$$RKVMAM(J),'PRTOT D ...S ADD(J)=$G(ADD(J))+(VL0*AHMAM/(100+AHMAM)) .. ..I $$LMAM,$$RKVMAM(J),PRTOT D ...S VL=VL+$G(ADD(J)) .. ..W "> "_$$OUT(FLD,VL)_" ",! .W "",! . .S AO=A ; W "",! D PGBREAK W "
",! Q ; ; OUT(FLD,VL) ; I $G(FLD)="" Q " " N NM,DL,DLD,TP,I,J,OU ;;M ^AA("W1PC1-OUT","PRM")=PRM S NM=$G(PRM(FLD)) S DL=$G(PRM(FLD,"DL")) S DLD=$G(PRM(FLD,"DLD")) S TP=$G(PRM(FLD,"TP")) ; I VL?1"-"."-".P Q " " ; I TP="D",$TR(VL,"./","")?4N.N Q $$^%L1DC(VL,1)_""_$$H2U^%L1FRM($$^%L1DC(VL,9))_"'" ; I VL?."+"."-".1N.N.".".N D Q OU .S OU=VL ;;S OU=$S(DLD:$J(VL,DL,DLD),1:$J(VL,DL,0)) .I $G(DLD) S OU=$J(VL,DL,DLD) .I OU["." S OU=$$ZPT^%L1FRM(OU) .I $G(%REPN)="W4LEVD"!($G(%REPN)="W4LVDT"),NM["zery k""dq",VL,VL[".",'$$GETP^%W1PRM("DECHOUR") D ..N DR S DR=$P(VL,".",2) I $L(DR)=1 S DR=DR_"0" ..S OU=$P(VL,".")_":"_$TR($J(DR*.6,2,0)," ",0) .;;I DLD,+VL=0 S OU=""_OU_"" .;;I VL<0 S OU=""_OU_"" ; I VL?1U.P.U Q VL Q $$H2U^%L1FRM(VL) ; ; GETPRM ;--> STO,PRM K PRM S LENST=0 D GET^%W1PCIN(JB) S STO=$G(@$$^%W1GLPRM@("COD")) ;W "STO="_STO_" L1PC(COD)="_$G(%L1PC("COD")) N FLD,I F I=1:1:$L(STO,"*") D .S FLD=$P(STO,"*",I) Q:FLD="" .N NM,DL,DLD,TP S NM=$$NM^%W1PCRKV(%REPN,FLD) .S DL=$$DL^%W1PCRKV(%REPN,FLD) .S DLD=$$DR^%W1PCRKV(%REPN,FLD) .S TP=$$TYP^%W1PCRKV(%REPN,FLD) .S PRM(FLD)=NM .S PRM(FLD,"DL")=DL .S PRM(FLD,"DLD")=DLD .S PRM(FLD,"TP")=TP .S PRM(FLD,"DR")=$P($P(TP,";",2),",",2) .S LENST=LENST+DL+1 Q ; NEWPAGE(I) S PRTOT=0,PRHEAD=0 I '$D(@$$^%W1GLPRM@("GLOUT",I)) Q W "",! D PGBREAK D OPTBL(I) Q ; OPTBL(NEWLN) ; S COL0=$G(@$$^%W1GLPRM@("COL0")) S COL01=$G(@$$^%W1GLPRM@("COL01")) N ST S ST=$G(@$$^%W1GLPRM@("GLOUT",NEWLN)) ;;Q:ST="" ; I COL0 D HEAD1 ; --- HEADER 1 ; ; S PRTOT=0,PRHEAD=0 ;-------------------- TABLE GROUP HEADER -------------- D HEADG ; Q ; HEAD1 ; W "" D SHLN(0) W "" N J F J=1:1:COL0 D .N FLD S FLD=$P(STO,"*",J) .W "" .W "" W "",! ; D SHLN(0) W "" N J F J=1:1:COL0 D .W "" .W "" W "",! W "
"_$$H2U^%L1FRM($G(PRM(FLD)))_" 
"_$$OUT($P(STO,"*",J),$P(ST,"*",J))_" 
",! Q ; HEAD2(NEWLN) ; N ST S ST=$G(@$$^%W1GLPRM@("GLOUT",NEWLN)) Q:ST="" I COL01>COL0 D .D SHLN(0) .W "" .W "" . W "" . D SHLN(0) W "" . N WD S WD=20 I COL01>COL0 S WD=100/(COL01-COL0) I WD>33 S WD=33 . N J F J=COL0+1:1:COL01 D .. N FLD S FLD=$P(STO,"*",J) .. W "" . W "" . W "
" .. W " "_$$H2U^%L1FRM($G(PRM(FLD)))_" : " .. W ""_$$OUT(FLD,$P(ST,"*",J))_" " .. W " 
" .W "",! Q ; HEADG ; N J,FLD,WD N COLGR S COLGR=$L(STO,"*")-COL01 I COLGR<7 S WD=COLGR*15_"%" E S WD="100%" ; N SDL,FLDJ S SDL=0 F J=COL01+1:1:$L(STO,"*") D .S FLDJ=$P(STO,"*",J) .S SDL=SDL+$G(PRM(FLDJ,"DL")) ; W "",! D SHLN(0) W "",! N TH S TH="" ; N WDJ F J=COL01+1:1:$L(STO,"*") D .S FLDJ=$P(STO,"*",J) .I FLDJ="" S FLD=" " .E S FLD=$$OUT(FLDJ,PRM(FLDJ)) .S WDJ=0 I SDL S WDJ=$J($G(PRM(FLDJ,"DL"))/SDL*100,0,0) .I WDJ<5 S WDJ=5 .W TH_";width:"_WDJ_"%"">"_FLD_"",! W "",! Q ; FSZ(LENST,PR) ; ;;N SZ S SZ=$S($G(LENST)>120:7,$G(LENST)>100:8,$G(LENST)>80:9,1:10) N SZ S SZ=$S($G(LENST)>120:9,$G(LENST)>100:10,1:11) I $$1024^W4WDSCR S SZ=SZ-1 S SZ=SZ+$G(PR) Q $$^W3FSZ(SZ) ; SHLN(PR) ; I SHLN1+1>RSIZE D .W "
"_$$^%W1DICT("LINE")_"
",! .D PGBREAK .I '$$FL W "

" .S SHLN1=2 D HEADG ; I $G(PR) S SHLN=SHLN+1 S SHLN1=SHLN1+1 Q ; PGBREAK ; I $$FL W "
",! S SHLN1=0 Q W "

",! S SHLN1=0 Q ; SHOWRNG(COD) ; I '$D(@$$^%W1GLREP@(0,COD)) Q N VLME,VLAD,NM,DL,TYP S DL=$$DL^%W1PCRKV(%REPN,COD) S TYP=$$TYP^%W1PCRKV(%REPN,COD) S VLME=$G(@("ME"_COD)) S VLAD=$G(@("AD"_COD)) I TYP="D",VLME?5N D .S VLME=$ZD(VLME,"DD.MM.YY"),VLAD=$ZD(VLAD,"DD.MM.YY") S NM=$$NM^%W1PCRKV(%REPN,COD) ; I VLME=""!(VLME?1"-9"."9"),VLAD?1"9"."9"!(VLAD="") Q D SHOWRNG1(NM,VLME,VLAD) Q ; ; SHOWRNG1(NM,VLME,VLAD) ; D SHLN(0) W "" W " "_$$H2U^%L1FRM(NM)_"",! W "  "_$$^%W1DICT("FROM")_" "_VLME_"",! W "  "_$$^%W1DICT("TO")_" "_VLAD_"",! W "",! Q ; REPPRM ; N MAS,ME,AD,NM,IJK,MCOD,COD,IJK F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) S MCOD(COD)="" F IJK=1:1:$L(%FLDMIN,"*") D .S COD=$P(%FLDMIN,"*",IJK) Q:COD?.P S MCOD(COD)="" ; N N S N="" F S N=$O(%REPN(N)) Q:N="" D .S COD=$E(N,3,20) Q:COD="" I $D(MCOD(COD)) Q .I $E(N,1,2)="ME" S MAS(COD,"ME")=$G(%REPN(N)) .I $E(N,1,2)="AD" S MAS(COD,"AD")=$G(%REPN(N)) ; S N="" F S N=$O(MAS(N)) Q:N="" D .S NM=$G(%REPN(N,"NM")) .S ME=MAS(N,"ME") .S AD=MAS(N,"AD") .D SHOWRNG1(NM,ME,AD) Q ; SELSORT ; D GETPRM N CURSORT S CURSORT=+$G(@$$^%W1GLPRM@("CURSORT")) W "",! Q ; SORT(%SORT) ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D PUT^%W3DEB("%W1PC1-SORT","%SORT=%SORT") N GLTMP,GLCUR,GLBASE S GLTMP=$$BG^%W1GLPRM_"""GLTMP"")" S GLCUR=$$BG^%W1GLPRM_"""GLOUT"")" S GLBASE=$$BG^%W1GLPRM_"""GLBASE"")" S @$$^%W1GLPRM@("CURSORT")=%SORT ; I $P(%SORT,"~",3)?1N D PUT^%W1PRM("DECHOUR",$P(%SORT,"~",3)) ; N AD S AD=$P(%SORT,"~",2) S AD=$S(AD:-1,1:1) S %SORT=+%SORT ; D GETPRM ; K @GLCUR ; I %SORT=0 Q:'$D(@GLBASE) D Q .M @GLCUR=@GLBASE ; N COL01 S COL01=$G(@$$^%W1GLPRM@("COL01")) ; N J F J=1:1:$L(STO,"*") Q:$P(STO,"*",J)?1"x"1N.N N COLRKV S COLRKV=J-1 ; N I,I1,FL,A,IJ,IND S I=0,I1=0,FL=0 ; -- FL - PR. PROST.STR K @GLTMP F101 S I=I+1 I '$D(@GLBASE@(I)) D TMP2CUR(AD) Q S A=$G(@GLBASE@(I)) I A="" S I1=I,FL=0 D TMP2CUR(AD),A2CUR(A) G F101 ; I A?1"#"."#" S FL=0,I1=I D TMP2CUR(AD),A2CUR(A) G F101 ; I A?1"="."="1"*".P D S FL=1 G F101 .D TMP2CUR(AD),A2CUR(A) .S I=I+1 S A=$G(@GLBASE@(I)) D A2CUR(A) ; I A?1"-"."-"1"*".P D TMP2CUR(AD),A2CUR(A) S FL=1 G F101 ; I 'FL,$G(@GLBASE@(I-1))'?.P,$G(@GLBASE@(I))'?.P D .F IJ=COL01:-1:1 I $P(@GLBASE@(I),"*",IJ)'=$P($G(@GLBASE@(I-1)),"*",IJ) D TMP2CUR(AD) S I1=I-1 Q ; I 'FL D G F101 .S IND=$P(A,"*",COLRKV+%SORT) .I IND?.E1A.E D ..I $$^%W1DIR="RTL",$$HBR(IND) D Q ...S IND=$$INV^%L1FRM(IND) ...S IND=$E(IND_$J("",12-$L(IND)),1,12) ..S IND=$$ENG^%L1FRM(IND,12) .I IND'?.E1A.E S IND=150000000000+$P(IND,".") .S IND="0"_$J(IND,12)_$J(I,5) .S @GLTMP@(IND)=A ; G F101 ; ; TMP2CUR(AD) N II,N S A=$G(@GLBASE@(I)) S N="" ; F S N=$O(@GLTMP@(N),AD) Q:N="" D .S II=$$LASTIND+1 .S @GLCUR@(II)=$G(@GLTMP@(N)) ; K @GLTMP Q ; ; A2CUR(A) ; S @GLCUR@($$LASTIND+1)=A Q ; LASTIND(STAM) ; Q $O(@GLCUR@(99999999),-1) ; HBR(STR) ; N OK S OK=0 N J F J=1:1:$L(STR) I $$INVHB^%L1FRM($A(STR,J)) S OK=1 Q Q OK ; DIVEXC(COD,PROG,BCK) ; W "

",! ; I $L($G(PROG)) D .D @("^"_PROG_"(COD,0)") .D @("^"_PROG_"(COD,1)") ; N FLCSV,FLTXT,DIR,FL S DIR=$$DIRWEB^%W1PCEX N IND S IND=COD_$$^W4MYDVN S FL=COD_$$^W4MYDVN_"_"_$O(@$$^W4MAIN("TMPCSV")@(IND,"csv",9999999),-1) S FLCSV=DIR_FL_".csv" S FLTXT=DIR_FL_".txt" ; W "" W "" W "" I $G(BCK) D .W "" .W "" W "",! W "
",! W " "_FL_".csv",! W " " D BUT^W4BCK W "
",! ; W "
",! ; ;;W "",! Q ; ORD(FLD) ; I $$^W4LKH Q 0 N NM I $G(PRM(FLD))="" Q 0 S NM=$$SPA^%L1FRM(PRM(FLD)) S NM=$$SP1^%L1FRM(NM) S NM=$TR(NM,"'.","") I NM="dpnfd"!(NM="dpnfd qn") Q 1 Q 0 ; CUST(FLD) ; N NM I $G(PRM(FLD))="" Q 0 S NM=$$SPA^%L1FRM(PRM(FLD)) S NM=$$SP1^%L1FRM(NM) S NM=$TR(NM,"'.","") I NM="gewl 'qn"!(NM="gewl qn")!(NM="gewl xtqn")!(NM="gewl cew") Q 1 Q 0 ; INVOICE(FLD) ; N NM I $G(PRM(FLD))="" Q 0 S NM=$$SPA^%L1FRM(PRM(FLD)) S NM=$$SP1^%L1FRM(NM) S NM=$TR(NM,"'.","") I NM="zipeayg"!(NM="zipeayg qn") Q 1 Q 0 ; OVED(FLD) ; N NM I $G(PRM(FLD))="" Q 0 S NM=$$SPA^%L1FRM(PRM(FLD)) S NM=$$SP1^%L1FRM(NM) S NM=$TR(NM,"'.","") I $TR(NM," ","")="caerqn" Q 1 Q 0 ; MLPRT(FLD) ; N NM I $G(PRM(FLD))="" Q 0 S NM=$$SPA^%L1FRM(PRM(FLD)) S NM=$$SP1^%L1FRM(NM) S NM=$TR(NM,"'.","") I $TR(NM," ","")="hixt" Q 1 Q 0 ; FL(STAM) ; Q +$L($G(%W1PC1("FL"))) ; UFL(STAM) ; I $$FL U %W1PC1("FL") Q ; TBMAM ; ;;N OK S OK=0 ; ;;I 'OK,$G(@$$^%W1GLPRM@("VAL","MEDAT")) S OK=1 ;;I 'OK,$G(@$$^%W1GLPRM@("VAL","METRH")) S OK=1 ;;Q:'OK D PUT^%W1PRM("PCLMAM",+$G(%ARG("LMAM"))) W "
",! W "" W "" W "" W "" W "" W "",! W "" W "" W "",! W "
" W $$^%W1DICT("AFTERTAX")_"  " W "" W "" W $$^%W1DICT("BEFORETAX")_"  " W "" W "
" W $$^%W1DICT("MUSTEQTAX") W "
",! Q ; LMAM() ; Q $$GETP^%W1PRM("PCLMAM") ; REPMAM(%REPN) ; I $$^W4ELPOS,$$^W4DPNMAM Q 0 N OK S OK=0 N A S A=$G(%L1PC("MAM")) N JJ F JJ=1:1:$L(A,"*") I $P(A,"*",JJ) S OK=1 Q Q OK ; RKVMAM(J) ; N JJ,K,OK S K=0,OK=0 N STO S STO=$G(@$$^%W1GLPRM@("COD")) F JJ=1:1:J D Q:OK .I $P(STO,"*",JJ)?1"x"1N.N,$P($G(%L1PC("FLD0")),"*",JJ)'="-" D ..S K=K+1 I K=J S OK=1 Q +$P($G(%L1PC("MAM")),"*",K) ; EILAT(A) ; I $G(%REPN)["W4GAP",$P(A,"*",2)["zli`"!($P(A,"*",3)["zli`") Q 1 Q 0 ; DATREP(STAM) ; Q $$GETP^%W1PRM("REPDAYS") ; SHOWDAYS ; N DAYS S DAYS=$$GETP^%W1PRM("REPDAYS") N J F J=1:1:7 D .W $$^%W1DICT("DAY"_J) .W "" Q ; TRISSUE ; W "" W "" W "" W "" W "" I $G(%ARG("SIK")) D .W "",! I '$G(%ARG("SIK")) D .W "" ; W "" W "" W "
SessionID="_$G(JB)_""_$$^%W1DICT("CONCENTRATEDREPORT")_" " W $$^%W1DICT("ISSUETIME")_" : "_$ZD($H,"DD.MM.YY 24:60") W "
",! W "" W "",! Q ; SETDAYS ; D KILL^%W1PRM("REPDAYS") N A S A="" N J F J=1:1:7 D .I $G(%ARG("day"_J))="on" S A=A_1 Q .S A=A_0 I A="0000000" S A="" D PUT^%W1PRM("REPDAYS",A) Q %W1PCBEG %W1PCBEG(JB) ; [ 11.03.18 19:19 ] [ 13.06.09 00:15 ] [ 05.06.09 14:50 ] I '$D(@$$^%W1GLPRM@("START")) Q 1 Q 0 ; START(JB) S @$$^%W1GLPRM@("START")=$H Q ; FIN(JB) S @$$^%W1GLPRM@("FINISH")=$H Q %W1PCEX %W1PCEX(%REPN,FMT) ; [ 12.03.25 11:44 ] [ 20.09.22 07:22 ] [ 13.09.22 10:33 ] N (JB,%ARG,%REM,%REPN,FMT,TOT,FLCSV,%W1PCEX) S %W1LAHMAM=$S($G(%ARG("LMAM")):$G(^|$$^W3MAIN|P1PRM("MAM")),1:0) D ^%L1TS S FL=$$FL^%W1FREPX(%REPN,FMT) ;N DIR S DIR=$$DIRL ;N FL S FL=DIR_%REPN_$$^W4MYDVN I $G(TOT) S FL=FL_"S" S FLCSV=FL_"."_$$FMT(FMT) ;;U 0 W "FLCSV="_FLCSV,! N A,B,I,J,RZD S RZD="*" C FLCSV:(DELETE) zsy "rm -f "_FLCSV D OPEN^%W1FREPX(FLCSV) ; D HEAD ; N STO S STO=$G(@$$^%W1GLPRM@("COD")) ; I '$D(%W1PCEX("NOHD1")) D .N FLD,I,I1,J .S B="" .F J=1:1:$L(STO,"*") D ..S FLD=$P(STO,"*",J) Q:FLD="" ..N NM S NM=$$NM^%W1PCRKV(%REPN,FLD) ..S B=B_$$RKV(NM,FMT) .U FLCSV W B,! ; N STMAM S STMAM=$G(@$$^%W1GLREP@("MAM")) ; N K F I=1:1 Q:'$D(@$$^%W1GLPRM@("GLOUT",I)) D .S A=$G(^(I)),B="" .I '$G(TOT),$$KAVSIK(A) D Q ..F I1=I:1 Q:'$D(@$$^%W1GLPRM@("GLOUT",I1)) S A=$G(^(I1)) Q:'$$KAVSIK(A)&(A?.P) ..S I=I1 .S K=0 .S EILAT=0 .I $P(A,"*",2)["zli`" S EILAT=1 .F J=1:1:$L(A,RZD) D ..N COD S COD=$P(STO,"*",J) ..I COD?1"x"1N.N S K=K+1 ..S VL=$P(A,RZD,J) ..S TYP=$$TYP^%W1PCRKV(%REPN,COD) ..S RKVMAM=+$P(STMAM,"*",K) ..;;U 0 W "COD="_$P(STO,"*",J)_" TYP="_TYP_" ",! ..I TYP="D" S VL=$TR(VL,".","/") ..;;S ^AAA(I,J,"VL0")=VL ..;;S ^AAA(I,J,"RKVMAM")=RKVMAM ..;;S ^AAA(I,J,"W1LAHMAM")=%W1LAHMAM ..I RKVMAM,$G(%W1LAHMAM),'EILAT S VL=$J(VL*100/(100+%W1LAHMAM),2,2) ..;;S ^AAA(I,J,"VL")=VL ..I TYP="N" S VL=$J(VL,2,2) ..S B=B_$$RKV(VL,FMT) . .S B=$E(B,1,$L(B)-1) .;;U 0 W B,! .U FLCSV W B,! ; C FLCSV ; ;;ZSY "unix2dos "_FLCSV ; 23/01/17 ;;ZSY "zip -j "_FL_" "_FLCSV Q ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; DIRWEB(STAM) ; N DIR S DIR=$$WEB^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; KAVSIK(A) I A?1"=="."="1"*"1"=".E,A?.P Q 1 Q 0 ; RKV(VL,FMT) I '$D(TS0)!'$D(TS1) D ^%L1TS N DLM S DLM=$G(%W1PCEX("DLM")) S:DLM="" DLM="," S VL=$$SPA^%L1FRM(VL) I VL?2N1"."2N1"."2N!(VL?2N1"."2N1"."4N) S VL=$TR(VL,".","/") S VL=$TR(VL,","," ") ; D .I VL?9N.N S VL="'"_VL_"'" Q .I $L($TR(VL," ",""))<6,$TR(VL," ","")?1N.N1"-"1N.N S VL="'"_VL_"'" Q .S VL=$TR($$INVH^%L1FRM(VL),TS0,TS1) ; I $G(FMT)=1 Q VL_$C(9) Q VL_DLM ; ; FMT(FMT) ; I $G(FMT) Q "txt" Q "csv" ; HEAD ; Q:$D(%W1PCEX("NOHD")) D GETPRM^%W1PC1 ; ;---------------------- REPORT PARAMETERS ---------------- N IJK,%RNG,DL,TYP D REPPRM ; F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D SHOWRNG(COD) ; F %I=1:1:$L(%FLDMIN,"*") D .S COD=$P(%FLDMIN,"*",%I) Q:COD?.P .D SHOWRNG(COD) ; Q ; REPPRM ; N MAS,ME,AD,NM N N S N="" F S N=$O(%REPN(N)) Q:N="" D .I $E(N,1,2)="ME" S MAS($E(N,3,20),"ME")=$G(%REPN(N)) .I $E(N,1,2)="AD" S MAS($E(N,3,20),"AD")=$G(%REPN(N)) ; S N="" F S N=$O(MAS(N)) Q:N="" D .S NM=$G(%REPN(N,"NM")) .S ME=MAS(N,"ME") .S AD=MAS(N,"AD") .D SHOWRNG1(NM,ME,AD) Q ; SHOWRNG(COD) ; S B="" I '$D(@$$^%W1GLREP@(0,COD)) Q N VLME,VLAD,NM,DL,TYP S DL=$$DL^%W1PCRKV(%REPN,COD) S TYP=$$TYP^%W1PCRKV(%REPN,COD) S VLME=$G(@("ME"_COD)) S VLAD=$G(@("AD"_COD)) I TYP="D" S VLME=$ZD(VLME,"DD.MM.YY"),VLAD=$ZD(VLAD,"DD.MM.YY") I VLME=""!(VLME?1"-9"."9"),VLAD?1"9"."9" Q S NM=$$NM^%W1PCRKV(%REPN,COD) D SHOWRNG1(NM,VLME,VLAD) Q ; SHOWRNG1(NM,VLME,VLAD) ; S B=$$RKV(NM,FMT) S B=B_$$RKV($$TV^%W1DICT($$^%W1LNG,"FROM"),FMT) S B=B_$$RKV(VLME,FMT) S B=B_$$RKV($$TV^%W1DICT($$^%W1LNG,"TO"),FMT) S B=B_$$RKV(VLAD,FMT) S B=$E(B,1,$L(B)-1) U FLCSV W B,! Q %W1PCIN %W1PCIN ; [ 13.02.25 13:06 ] [ 27.03.23 10:38 ] [ 23.08.22 18:35 ] ; IN : %REPN ; OUT : %L1PC("FLD") ; %L1PC("MIUN") ; %L1PC("SIK0") ; %L1PC("SIK") ; %L1PC("CT") ; ; MIUN,SIK,CT,MAXMIUN ; COLG,COLGM,GLOB1,GLOB2 ; ; ME... AD... ;;K (JB,%ARG,%REM,%L1PC,QUERY,%REPN) ; ;;S ^AA("W1PCIN","JB")=JB D GLREP D GLPRM N %N,%I,%J,I ; ;;I '$D(%REPN),$D(@GLPRM@("REPN")) M %REPN=@GLPRM@("REPN") I $D(@GLPRM@("REPN")) M %REPN=@GLPRM@("REPN") ; S %N="" F S %N=$O(%REPN(%N)) Q:%N="" D .I $D(%REPN(%N))#2 S @%N=%REPN(%N) D ..I $D(%REPN(%N,"VIEW")) S %L1PC("VAL",%N)=%REPN(%N) ; ;---- CREATE %L1PC("FLD"),%L1PC("MIUN") ;---- %L1PC("SIK0"),%L1PC("CT"),%L1PC("SIK") ; S %L1PC("FLD")="",%L1PC("MIUN")="",%L1PC("SIK0")="",%L1PC("CT")="" S %L1PC("SIK")="" S %L1PC("MAM")="" D FLD0 ; ;;S ^AA("W4PCIN","GLREP")=GLREP F %I=1:1:$L(@GLREP@("FLD"),"*") D .N %FLD S %FLD=$P(@GLREP@("FLD"),"*",%I) Q:%FLD="" .; .I $G(@GLREP@(0,%FLD,"SET")) S %L1PC("S0",%FLD)="" . .I $P($G(@GLREP@("FLD0")),"*",%I)'="-" D ..S %L1PC("FLD")=%L1PC("FLD")_%FLD_"*" ..N MIUNI S MIUNI=$P($G(@GLREP@("MIUN")),"*",%I) ..I $G(@GLREP@(0,%FLD,"SH"))=0 S MIUNI=$P($G(@GLREP@("MIUN")),"*",%I-1)+1 ..S %L1PC("MIUN")=%L1PC("MIUN")_MIUNI_"*" ..S %L1PC("SIK0")=%L1PC("SIK0")_$P($G(@GLREP@("SIK0")),"*",%I)_"*" ..N CTI S CTI=$P($G(@GLREP@("CT")),"*",%I) ..I $G(@GLREP@(0,%FLD,"SH"))=0 S CTI=$P($G(@GLREP@("CT")),"*",%I-1) ..S %L1PC("CT")=%L1PC("CT")_CTI_"*" . .I $P($G(@GLREP@("FLD0")),"*",%I)="-" D ..N A S A=$P(@GLREP@("FLD"),"*",%I) Q:A?.P ..I '$D(%L1PC("VAL",A))!'$D(@("ME"_A)) S @("ME"_A)="" ..I '$D(%L1PC("VAL",A))!'$D(@("AD"_A)) D ...S @("AD"_A)=$TR($J("",+$P(@GLREP@(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(@GLREP@("FLD"),"*") D .N A S A=$P(^("FLD"),"*",%I) I $E(A)="x",$P($G(^("FLD0")),"*",%I)'="-" D ..S %L1PC("SIK")=%L1PC("SIK")_$P($G(@GLREP@("SIK")),"*",$E(A,2,3))_"*" S %L1PC("SIK")=$E(%L1PC("SIK"),1,$L(%L1PC("SIK"))-1) ; S %L1PC("MAM")="" S %J=0 F %I=1:1:$L(@GLREP@("FLD"),"*") D .N A S A=$P(^("FLD"),"*",%I) I $E(A)="x",$P($G(^("FLD0")),"*",%I)'="-" D ..S %L1PC("MAM")=%L1PC("MAM")_$P($G(@GLREP@("MAM")),"*",$E(A,2,3))_"*" S %L1PC("MAM")=$E(%L1PC("MAM"),1,$L(%L1PC("MAM"))-1) ;---------------------------------------------------------------------- ; S ONLYSIK=0,MONE=0 ; ;------------ MAXMIUN - SPISOK PRIZN.REKV, COLG - SPISOK KOL. REKV. ; F I=1:1:$L(%L1PC("FLD"),"*") S A=$P(%L1PC("FLD"),"*",I) Q:A["x" ; S MAXMIUN=I-(%L1PC("FLD")["*x") S COLG=$L(%L1PC("FLD"),"*")-MAXMIUN S COLGM=$L($P(@GLREP@("FLD"),"*x1*",2),"*")+1 ; S GLOB1=@GLREP@("GLOB1"),GLOB2=@GLREP@("GLOB2") S GLOB1=$$GLOB2W4(GLOB1) S GLOB2=$$GLOB2W4(GLOB2) D .N J F J="FLD","S0","MIUN","SIK0","SIK","CT" S @GLPRM@(J)=$G(%L1PC(J)) .F J="MAXMIUN","COLG","COLGM","GLOB1","GLOB2" S @GLPRM@(J)=@J ; S %BS=0,FRST=1 V ;------------------------ ; %L1PC("MIUN") -> MIUN() ; %L1PC("SIK0") --> SIK() ; %L1PC("CT") --> CT ; 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 ; ; SAVE(JB) ; ------------------------------------------------------------ D GLPRM S:'$D(@GLPRM)#2 @GLPRM=$H M @GLPRM@("REPN")=%REPN D .N N S N="" F S N=$O(%REPN(N)) Q:N="" M @GLPRM@("VAL",N)=%REPN(N) ; N %J,%FLD,%MIUN,%CT,%SIK,%SIK0 ; N %N S %N="" F S %N=$O(MIUN(%N)) Q:%N="" D .S @GLPRM@("MIUN",%N)=$G(MIUN(%N)) ; S %N="" F S %N=$O(CT(%N)) Q:%N="" D .S @GLPRM@("CT",%N)=$G(CT(%N)) ; S %N="" F S %N=$O(SIK(%N)) Q:%N="" D .S @GLPRM@("SIK",%N)=$G(SIK(%N)) ; S %N="" F S %N=$O(SIK0(%N)) Q:%N="" D .S @GLPRM@("SIK0",%N)=$G(SIK0(%N)) ; I $L($G(QUERY))>0 S @GLPRM@("QUERY")=$G(QUERY) ;-------------------------- END SAVE ----------------------------------- Q ; ; MEAD(%FLD) ; Q:$G(%FLD)="" ; I $G(@("ME"_%FLD))="" D .S @("ME"_%FLD)=$S($E(%FLD)="x":-99999999,1:"") .S @GLPRM@("VAL","ME"_%FLD)=@("ME"_%FLD) ; I $G(@("AD"_%FLD))="" D .S @("AD"_%FLD)=$TR($J("",+$P(@GLREP@(0,%FLD),";",2))," ",9) .S @GLPRM@("VAL","AD"_%FLD)=@("AD"_%FLD) Q ; ; GET(JB) ;------------------- START GET ---------------------------------- ; ^W1PCPRM -> %L1PC, MIUN, MAXMIUN ,SIK, SIK0 , CT , D GLPRM,GLREP M %REPN=@GLPRM@("REPN") I $G(%REPN)="" S @GLPRM@("ER")="NOREPN" G GETE ; ;;D %W1PCIN ; ---> ; S %FLDMIN=$G(@GLPRM@("FLDMIN")) ; I $D(@GLPRM@("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(@GLREP@("QUERY",N)) Q:N="" ..I N'="" S QUERY=N .Q:QUERY="" .Q:$D(@GLREP@("QUERY",QUERY))<10 .N I F I="MIUN","SIK0","CT","FLD0" S @GLREP@(I)=$G(@GLREP@("QUERY",QUERY,I)) ; D %W1PCIN ; --- !!! ; I $D(@GLPRM@("SHEIL")) S %L1PC("SHEIL")=$G(^("SHEIL")) N N ; I $D(@GLPRM@("VAL"))>9 D .S N="" F S N=$O(@GLPRM@("VAL",N)) Q:N="" D ..N A S A=$G(@GLPRM@("VAL",N)) Q:N="QUERY" ..S @N=A ; K SIK I $D(@GLPRM@("SIK"))>9 D .;;K SIK .S N="" F S N=$O(@GLPRM@("SIK",N)) Q:N="" D ..S SIK(N)=$G(@GLPRM@("SIK",N)) ; K SIK0 I $D(@GLPRM@("SIK0"))>9 D .;;K SIK0 .S N="" F S N=$O(@GLPRM@("SIK0",N)) Q:N="" D ..S SIK0(N)=$G(@GLPRM@("SIK0",N)) ; I $D(@GLPRM@("CT"))>9 D .K CT .S N="" F S N=$O(@GLPRM@("CT",N)) Q:N="" D ..S CT(N)=$G(@GLPRM@("CT",N)) ; F I=1:1:MAXMIUN D .S A=$P(%L1PC("FLD"),"*",I) .D MEAD(A) ; I $L($G(%FLDMIN)) F I=1:1:$L(%FLDMIN,"*") D .S A=$P(%FLDMIN,"*",I) .D MEAD(A) GETE Q ; ; REST(JB) ; D GLARX S MAC=GLARX S %L1("EU")=3 S %L1("BE",2)=4 S %L1("BE",3)=6 D ^%L1NU Q:FLAG'="" S %REPN=$$^%L1IND(MAC,2) S QUERY=$$^%L1IND(MAC,3) I %REPN=""!(QUERY="") S %SAY=" RESTORE ERROR ! " X %XMSGV(1) Q K @$$^%W1GLPRM M @$$^%W1GLPRM=@GLARX@(%REPN,QUERY) Q GLREP ; S GLREP=$$^%W1GLREP Q GLPRM ; S GLPRM=$$^%W1GLPRM Q GLARX ; S GLARX=$$^%W1GLARX Q GLOB2W4(GLOB) ; Q $$FILE2W4^%W1PCP(GLOB) ; FLD0 ; ;;I %REPN="W4DPMH" D .N TIP S TIP=$$GETP^%W1PRM("W4DPMHTIP") .S ^LV("FLD0")=@GLREP@("FLD0") .S $P(@GLREP@("FLD0"),"*",12)=$S(TIP:"",1:"-") ; S %L1PC("FLD0")=$G(@GLREP@("FLD0")) Q %W1PCNMR %W1PCNMR(STAM) ; [ 31.05.13 18:37 ] [ 20.06.09 14:42 ] [ I $$GETP^%W1PRM("REPNET") Q $$H2U^%L1FRM($$NAME^W4GFUCI) I $G(%ARG("MSD")) Q $$H2U^%L1FRM($$^W3MSDG(%ARG("MSD"))) I $G(%ARG("MSDR")) Q $$H2U^%L1FRM($$NAME^W3MSDR(+$G(%ARG("MSDR")))) N MSD S MSD=$$GET^%W1PRM("MSD") I MSD Q $$H2U^%L1FRM($$^W3MSDG(MSD)) N MSDR S MSDR=$$GET^%W1PRM("MSDR") I MSDR Q $$H2U^%L1FRM($$NAME^W3MSDR(MSDR)) Q "" %W1PCP %W1PCP(JB,CURSORT) ; [ 08.12.24 15:51 ] [ 26.12.23 03:20 ] [ 27.03.23 10:36 ] ; ; 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 (JB,%ARG,CURSORT,%REM,%REPN) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N A,I,II,J,JJ,N,N1,SEDM,SEDSM,MCT,MCT2,COL0,COL01,OK,IN ; D PUT^%W1PRM("PCPEND",0) ; D GET^%W1PCIN(JB) ; I $G(%ARG("SIK")) S SIKUM=99 I $G(%ARG("SIK"))=0 K SIKUM ; I '$D(%GLOU) S %GLOU=$$BG^%W1GLPRM_"""GLOUT"")" I '$D(%GLWORK) S %GLWORK=$$BG^%W1GLPRM_"""GLWORK""" ; ;;W "%GLOU="_%GLOU_" %GLWORK="_%GLWORK ; K @%GLOU,@(%GLWORK_")") Q:'$G(MAXMIUN) ; M1 N 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(@$$^%W1GLREP@("FLD0")),"*",J)="-" S J=J+1 G M2 ; I $G(SIKUM)=99 S ONLYSIK=1 F I=1:1:MAXMIUN D .S A=$P(%L1PC("FLD"),"*",I) .N MEA S MEA=$G(@("ME"_A)) .S:MEA?.P @("ME"_A_"=0") .I MEA?1"S"1N.N D ..N SET S SET=$E(MEA,2,200) Q:SET="" ..Q:$D(@$$^W4GL("P1SET")@(SET))<9 ..M @("ME"_A)@("SET")=@$$^W4GL("P1SET")@(SET) .S:$G(@("AD"_A))?.P @("AD"_A_"=$TR($J("""",$P($G(@$$^%W1GLREP@(0,A)),"";"",2)),"" "",9)") ; I $L($G(%FLDMIN)) F I=1:1:$L(%FLDMIN,"*") D .S A=$P(%FLDMIN,"*",I) .S:$G(@("ME"_A))?.P @("ME"_A_"=0") .S:$G(@("AD"_A))?.P @("AD"_A_"=$TR($J("""",$P($G(@$$^%W1GLREP@(0,A)),"";"",2)),"" "",9)") ; 11 ; ; --------------- CHECK FOR DFLT ( MIUN - POSLEDN ) S N="" F S N=$O(SIK(N)) Q:N="" I $G(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))=$S(+$G(SIK(JJ))=0:0,1:1) ; S N="" F S N=$O(CT(N)) Q:N="" D .I $G(CT(N))=1 D Q ..S N1="" F S N1=$O(CT(N1)) Q:N1="" I $G(MIUN(N1)),MIUN(N1)9,'$D(@%MEIN@("SET",A1)) S OK=0 Q .I $L(A1),$D(@%MEIN@("SET"))>9,$D(@%MEIN@("SET",A1)) G LP2 .I %MEINV'="",'%PRTIME I A<%MEINV S OK=0 Q .I %ADINV'="",'%PRTIME I A>%ADINV S OK=$S(%NMB:2,1:0) Q .;;S ^AA("MEIN",K)=%MEIN,^AA("ADIN",K)=%ADIN .;;S ^AA("MEINV",K)=%MEINV,^AA("ADINV",K)=%ADINV,^AA("A",K)=A .I %PRTIME S OK=$$VIBTIME(%MEINV,%ADINV,A) I 'OK Q LP2 .I $D(@$$^%W1GLREP@("US",$L(GLOB,","))) D Q:OK'=1 ..N JJ F JJ=1:1:20 S @("x"_JJ)="" ..X @$$^%W1GLREP@("US",$L(GLOB,",")) ; -------- PROG !!!!!!!!!!!! . .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=%GLWORK_"," .. ..F II=1:1:MAXMIUN S %IND="@$P(SEDM,""*"","_II_")" D ...N FLD S FLD=$P(SEDM,"*",II) S:FLD="" FLD=" " ...N LL S LL=$P($G(@$$^%W1GLREP@(0,FLD)),";",2) ...S:$G(@%IND)="" @%IND=" - " S @%IND=$TR(@%IND,",*""()"," X'[]") ...S @%IND=$E(@%IND,1,128) ...I $L(FLD),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)["!",$L($$FILE(FLD)) D ....S A=$$OUFL($$FILE(FLD),$G(@FLD)) ....S A=$E(A,$L(A)-9,$L(A)) ....S A1="" F JJ=1:1:10 S A1=$E(A,JJ)_A1 ....S A1=A1_$J("",10-$L(A1))_$J(@FLD,+LL) ....S @%IND=A1 S:@%IND="" @%IND=" " ...S:@%IND="" @%IND=" " ...S GLO=GLO_""""_$G(@%IND)_"""," ; --- WAS _%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)) D ....I A1["." S A1=$J(A1,2,2) ....I $L(A1)>16 Q ....I $G(@("MEx"_JJ))'="",A1<@("MEx"_JJ) S OK=0 Q ....I $G(@("ADx"_JJ))'="",A1>@("ADx"_JJ) S OK=0 Q ..Q:'OK ..S ST="" S:'$D(@GLO) @GLO="" ..; ..F JJ=1:1:COLG D ...S A1=$G(@$P(%L1PC("FLD"),"*",MAXMIUN+JJ)); -- xJJ ...N %W1PCPMAM S %W1PCMAM=$$MAM(GLO) ...;;I $P($G(%L1PC("MAM")),"*",JJ),%W1PCMAM'<0 S A1=$J(A1*100/(100+%W1PCMAM),2,2) ; *** 04.10.22 ...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=$L(%GLWORK,",")+1:1:$L(IND,",") D .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,OUTFL,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=$G(@IN(JJ)),A=IN(JJ) D OUTFL ;;W "GLOB="_GLOB_" @GLOB="_$G(@GLOB),! S JJ1=0 S %STRING=%STRING_$G(@GLOB) D SAVST Q ; SAVST S MONE=$O(@%GLOU@(999999),-1)+1 S @%GLOU@(MONE)=%STRING S @%GLOU=MONE Q ; SIK ; K - UR, LASTFN - STR. KODOV DLQ PECH, SUMFL - STR. SUM N ST,KK,JJ S ST=$G(@GLOB) F KK=0:1:K F JJ=1:1:COLG D .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 ; Q:$D(%W1PCP("EXP")) N %STRING S %STRING="#############" D SAVST Q ; ; STRSIK ; ;------------------- FORM ITOG STROKI DLQ PECHATI ( FROM "K" UR). Q:$D(%W1PCP("EXP")) Q:($P(SEDSM,"*",K)'[1)&(K>0) ;-- NET PR. SIK N %STRING,INFL,A,I,J,JJ,JJ1,JJJ,IND,SP 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 G ESS N SEDMK S SEDMK=$P(SEDM,"*",K) ; I SEDMK'="" D .S $P(%STRING,"*",FLDNUM-COLG-2)=$TR($J("",16)," ","-") .N A,D S A=$G(@$$^%W1GLREP@(0,SEDMK)),D=$P(A,";",2) .S $P(%STRING,"*",FLDNUM-COLG-1)=$P(A,";") .N ST S ST=$S(D["D"&($TR(INO(K),"./","")?5N.E):$$^%L1DC(INO(K),1),$G(MIUN1(K))["!":$$INV^%L1FRM(INO(K)),1:INO(K)) .I $L($$FILE(SEDMK)),$L($G(INO(K))) D ..S OU=$$OUFL($$FILE(SEDMK),INO(K)) ..S ST=OU_" "_ST .S $P(%STRING,"*",FLDNUM-COLG)=ST ESS ; I $D(@$$^%W1GLREP@("SIX")) D ;-- PKUDA L SHURA SIKUMIM ( HORIZ ) .N CMD S CMD=$G(^("SIX")) Q:CMD="" .N JJ,JJ1,ER .F JJ=1:1:$L(@$$^%W1GLREP@("FLD"),"*") Q:$E($P(^("FLD"),"*",JJ))="x" .S ER=0 N MSUM,M,MJ S M=0,MJ=0 .F JJ1=JJ:1:$L(@$$^%W1GLREP@("FLD"),"*") D ..;;I $E($P($G(^("FLD0")),"*",JJ1))="-" S ER=1 Q ..S MJ=MJ+1 ..I $E($P($G(^("FLD0")),"*",JJ1))="-" Q ..S M=M+1 ..S M(MJ)=M .S CMD=$$CNVCMD(CMD) .;;S ^DEB("CMD")=CMD .X CMD ; 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 F J=K:1:MAXMIUN K SUM(J) Q ; ; OUTFL ;-- INFL --> OUTFL (FORM-E VIX. REKV IZ VX. V ZAVIS. OT @$$^%W1GLREP@(0,A,..)) ; @$$^%W1GLREP@(0,A,"OUT")=, -> INFL*F(INFL) ;; F(INFL)= X @$$^%W1GLREP@(0,A,"M2") -> VRB ;----------------------------------------------------------------------- I INFL="" G OF1 ; N LL S LL=+$P($G(@$$^%W1GLREP@(0,A)),";",2) S INFL=$$SPA^%L1FRM($E(INFL,$L(INFL)-LL+1,255)) ; I $P($G(@$$^%W1GLREP@(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(@$$^%W1GLREP@(0,A)),";",2),",",2) I DOT S OUTFL=$J(INFL,DOT,DOT) S OUTFL=INFL D SAVFL ; N FLDOU S FLDOU=$G(@$$^%W1GLREP@(0,A,"OUT")) I $L(FLDOU),$D(@$$^%W1GLREP@(0,A,"M2")) X ^("M2") S OUTFL=$TR($G(@FLDOU),"*""(),","X'[] ") D SAVFL Q ; I $L(FLDOU),$L($$FILE(A)),INFL'="" D Q .S OUTFL=$$OUFL($$FILE(A),INFL) .D SAVFL Q ; SAVFL ;;W "%STRING="_%STRING_" INFL="_$G(INFL)_" OUTFL="_OUTFL,! H 1 S %STRING=%STRING_OUTFL_"*" Q ; INIT ; S %L1PC("COD")="" N JJ F JJ=1:1 S A=$P(SEDM,"*",JJ) Q:A="" D .S %L1PC("COD")=%L1PC("COD")_A_"*" .I $D(@$$^%W1GLREP@(0,A,"OUT")) S %L1PC("COD")=%L1PC("COD")_@$$^%W1GLREP@(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 S @$$^%W1GLPRM@("COD")=SEDFL Q ; FILE2W4(FL) ; I FL["^["!(FL["^|") Q FL N FL1,FL2 S FL1=$P(FL,"(") S FL2=$P(FL,"(",2,20) I FL1["^" S FL1=$E(FL1,2,20) I FL2="" Q $$^W4GL(FL1) Q $$^W4GL(FL1)_"("_FL2 ; OUFL(FL0,FLD) N A,FL,FL00 I FL0="" Q "" S FL00=FL0 ; I $E(FL00)="^" S FL00=$E(FL00,2,100) I $E(FL00)="|" S FL00=$P(FL00,"|",3,20) I $E(FL00)="[" S FL00=$P(FL00,"]",2,20) ; I $G(FLD)="" Q "" S FL=$$FILE2W4(FL0) I FL="" Q "" I FL00'="NAME" S A=$G(@FL@(FLD)) I FL00="NAME" S A=$G(@FL@(FLD,1)) I FL00="PAR" S A=$P(A,"**") I FL00="B1CLUB" S A=$P($G(@FL@(FLD,1)),"\",3) S A=$TR(A,",*""()"," X'[]") Q A ; FILE(FLD) ; N FILE S FILE=$G(@$$^%W1GLREP@(0,FLD,"FILE")) I FILE["!" Q "" Q FILE ; CNVCMD(CMD) ; N CMD1,POS,POS0,POS1,IND,IND1 S CMD1="",POS0=1 CNVCMD1 ; S POS=$F(CMD,"(K,",POS0) I 'POS Q CMD1_$E(CMD,POS0,255) S POS1=$F(CMD,")",POS) S CMD1=CMD1_$E(CMD,POS0,POS-1) S IND=$E(CMD,POS,POS+4) S IND=$P(IND,")") S IND1=IND I IND,$D(M(IND)) S IND1=M(IND) S CMD1=CMD1_IND1_")" I 'POS1 Q CMD1 S POS0=POS1 G CNVCMD1 ; TIME(ME,AD) S ME=$$RPL^%L1FRM(ME,"%3A",":") S AD=$$RPL^%L1FRM(AD,"%3A",":") I $P(ME,":")>24!($P(ME,":",2)>60) Q 0 I $P(AD,":")>24!($P(AD,":",2)>60) Q 0 I ME?.N1N1":"2N Q 1 I AD?.N1N1":"2N Q 1 Q 0 ; VIBTIME(%MEINV,%ADINV,A) ; ;;S ^AA("MEINV","TIME")=%MEINV,^AA("ADINV","TIME")=%ADINV,^AA("A","TIME")=A N %MEIN1,%ADIN1 S %MEIN1=%MEINV*60+$P(%MEINV,":",2) S %ADIN1=%ADINV*60+$P(%ADINV,":",2) N %AT S %AT=A*60+$P(A,":",2) N %SHAAGV S %SHAAGV=$$SHAAZ^W4PRM I %SHAAGV'?1N.E S %SHAAGV=6 I %MEIN1?1N.E,%MEIN1<%SHAAGV S %MEIN1=%MEIN1+(24*60) I %ADIN1?1N.E,%ADIN1<%SHAAGV S %ADIN1=%ADIN1+(24*60) I %AT?1N.E,%AT<%SHAAGV S %AT=%AT+(24*60) I %AT<%MEIN1!(%AT>%ADIN1) Q 0 Q 1 ; MAM(GLO) ; ;;S ^AA("W1PCP-MAM","GLO")=GLO ;;S ^AA("W1PCP-MAM","MAXMIUN")=MAXMIUN ;;S ^AA("W1PCP-MAM","SEDM")=$G(SEDM) N A,MAM,IND S MAM=-1 I '$$GETP^%W1PRM("PCLMAM") Q MAM ; N JJ F JJ=1:1:MAXMIUN D Q:MAM'<0 .S A=$P($G(SEDM),"*",JJ) .I A["DAT"!(A["TRH") D ..S IND=$$^%L1IND(GLO,JJ+2) ..I IND'?5N,IND'?2N1"."2N1"."2N.E,IND'?2N1"/"2N1"/"2N.E,IND'?6N Q ..S IND=$$^%L1DC(IND,3) ..S MAM=$$MAMD^W4L(IND) ; I MAM<0,$G(@$$^%W1GLPRM@("VAL","METRH")) D .N DD S DD=^("METRH"),MAM=$$MAMD^W4L(DD) ; I MAM<0,$G(@$$^%W1GLPRM@("VAL","MEDAT")) D .N DD S DD=^("MEDAT"),MAM=$$MAMD^W4L(DD) Q MAM %W1PCREP %W1PCREP ; [ 08.11.21 08:29 ] [ 31.05.17 12:50 ] [ 05.01.13 09:45 ] N (JB,%ARG,%REM) D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) D PUT^%W1PRM("PCFIRST",1) D KILL^%W1PRM("CURSORT") ; -- 8.11.21 D PUT^%W1PRM("REPNAME",$$REPNAME^%W1PCS) ; N GLPRM S GLPRM=$$^%W1GLPRM K @GLPRM@("SIK") N N S N="" F S N=$O(%ARG(N)) Q:N="" D .I N?1"SIK"1N.N D ..S @GLPRM@("SIK",$E(N,4,10))=$S(%ARG(N)="on":1,1:0) ;;M ^AA("W1PCREP","SIK")=@GLPRM@("SIK") ; N MI,K S K=0 S N="" F S N=$O(@GLPRM@("MIUN",N)) Q:N="" D .S MI(K)=$G(^(N)) ; K @GLPRM@("CT") N N S N="" F S N=$O(%ARG(N)) Q:N="" D .I N?1"CT"1N.N D ..S @GLPRM@("CT",$E(N,3,5))=%ARG(N) Q %W1PCRKV %W1PCRKV(%REPN,COD) ; [ 12.09.22 17:39 ] [ 26.10.15 14:35 ] [ 03.04.12 09:30 ] N GLREP D GLREP I $G(COD)="" Q "" N TEUR S TEUR=$G(@GLREP@(0,COD)) Q TEUR ; NM(REPN,COD) ; N A S A=$$%W1PCRKV(REPN,COD) Q $P(A,";") ; DL(REPN,COD) ; N A S A=$$%W1PCRKV(REPN,COD) N DL S DL=$P(A,";",2) I DL["D" Q 8 Q +DL ; DR(REPN,COD) ; N A S A=$$%W1PCRKV(REPN,COD) Q $P($P(A,";",2),",",2) ; TYP(REPN,COD) ; N TYP N A S A=$$%W1PCRKV(REPN,COD) S TYP=$TR($P(A,";",2),"0123456789,","") S:TYP?.P TYP="E" Q TYP ; GL(%REPN,COD) ; N GLREP D GLREP N A S A=$G(@GLREP@(0,COD,"FILE")) Q A ; GLREP ; S GLREP=$$^%W1GLREP Q %W1PCS %W1PCS ; [ 13.03.25 12:14 ] [ 31.12.24 07:06 ] [ 30.12.24 14:39 ] ; INPUT : MAXMIUN SHEIL N %L1PCER ; D GLREP,GLPRM S %LNG=$G(^W1DICT,"H") N IJK,COD,%RNG,TH,DL,TYP I '$D(MAXMIUN),$D(@GLPRM@("MAXMIUN")) S MAXMIUN=^("MAXMIUN") D PUT^%W3DEB("%W1PCS","%L1PC=[%L1PC") F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" ; N COD,IJK,TYP,DL,%GETREST,TH I $D(%L1PC("SHEIL")) X %L1PC("SHEIL") Q S TH(1)=$$^%W1DICT("DATA_NAME") S TH(2)=$$^%W1DICT("FROM") S TH(3)=$$^%W1DICT("TO") S TH(4)=$$^%W1DICT("SORT") S TH(5)=$$^%W1DICT("TOT") S TH(6)=$$^%W1DICT("HEADER") W "

",! ; D GLREP,GLPRM N URL S URL="_self" ; ; W "
",! W "
",! Q .W "onReset=""self.location.replace('w5bo.jsp?JB="_$G(JB)_"')"" " W "" ; D DOPASK ; D OPTBL(1) W ">",! N I W "" F I=1:1 Q:'$D(TH(I)) S TH=$$H2U^%L1FRM(TH(I)) D .I I=1 W ""_TH_"" Q .I I>3 W ""_TH_"" Q .W ""_TH_"" W "",! ; N DL,TYP,NM,GL F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D ZSH .; .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .W " ",! .W " " .W "  "_$$H2U^%L1FRM($$NM^%W1PCRKV(%REPN,COD))_"",! .I TYP'="D" D ..D TD(COD) .I TYP="D" D TDAT(COD) .W " "_$S($G(MIUN(IJK)):$G(MIUN(IJK)),1:" ")_"",! .W " " . W "",! .W " " . ;;W $S($G(CT(IJK)):$G(CT(IJK)),1:" ") . W "" .W " ",! .W "",! W "",! ; W "

",! D HRTAG W "
",! D SHEIL3 W "

",! D HRTAG W "

",! D SHEIL2 W "

",! I $$DAT D SHOWDAYS W "

",! W "",! W $$NBSP^%L1FRM(5) W "",! W "
",! W "
",! Q ; OPTBL(BORD) ; W "",! W "",! W "
",! Q ; SELCT(J,NC) I J=NC Q " selected=""selected"" " Q "" ; TD(COD) ; Q:$G(COD)="" N GL S GL=$TR($$GL^%W1PCRKV(%REPN,COD),"!+","") ; I GL'="",$$SMALLG(GL) W "" D SEL(GL,"ME"_COD) W "" D SEL(GL,"AD"_COD) W "" Q ; W ""_$$VV("ME"_COD,COD,GL)_"" W ""_$$VV("AD"_COD,COD,GL)_"" Q ; TDD(COD,PRE) ; W "" N VL D .I $D(%L1PC("VAL",PRE_COD)) D Q ..S VL=%L1PC("VAL",PRE_COD) ..I VL?5N S VL=$ZD(VL,"DD.MM.YY") ..W VL,! .S VL=$$VL(PRE_COD) .S %W1DAT("NODAY")="" .D ^%W1DAT(PRE_COD,VL) W "" Q ; SHEIL2 ;---------------- HITUHIM NOSAFIM I $D(%L1PC("SHEIL")) Q N %W1PCS2 S %W1PCS2="" 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 D GLREP W "",! D OPTBL(1) W " rules=""rows"" >",! ; F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) I COD'?.P D .S IJK1=IJK-MAXMIUN+13 .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .D S0 .D SHTR(COD,TYP) W "
",! Q ; ; MULTY(NUM,DL) Q $TR($J("",DL)," ",NUM) ; SHEIL3 ; -- CODS WITH "-" -> ADDIT. TABLE N %L1PCER,A,DL3,TYP3,IJK,COD,Y1,Y2,CMIN,I ; --> %FLDMIN (-) S %FLDMIN="" N %I,COD D GLREP,GLPRM F %I=1:1:$L(@GLREP@("FLD"),"*") I $P($G(@GLREP@("FLD0")),"*",%I)="-" D .S COD=$P(@GLREP@("FLD"),"*",%I) .Q:$G(@GLREP@(0,COD,"SH"))=0 .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" ;;99999999 .S %FLDMIN=%FLDMIN_COD_"*" ; S %FLDMIN=$E(%FLDMIN,1,$L(%FLDMIN)-1) ; S @GLPRM@("FLDMIN")=%FLDMIN Q:%FLDMIN="" ; SHEIL31 I $D(%L1PC("SHEIL")) Q ; D GLREP D OPTBL(1) W " rules=""rows"" >",! N CMIN,IJK S CMIN=$L(%FLDMIN,"*") F IJK=1:1:$L(%FLDMIN,"*") D ZSH3 .S COD=$P(%FLDMIN,"*",IJK) Q:COD="" .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" .N DL,TYP .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .S DL3(IJK)=DL,TYP3(IJK)=TYP .D S0 .I $D(%L1PC("VAL",COD)),'$D(%L1GET) S %L1GET="V" .D SHTR(COD,TYP) W "",! Q ; SHTR(COD,TYP) ; W " "_$$H2U^%L1FRM($$NM^%W1PCRKV(%REPN,COD))_"" I TYP'="D" D TD(COD) I TYP="D" D TDAT(COD) W " " W " " W " " W "",! Q ; ; KOT(STAM) Q $G(@GLPRM@("QUERY")) Q ; S0 ; I ","_$P($P($G(GLOB2),"(",2),")")_","[(","_COD_",")!$D(%L1PC("S0",COD)) S %RNG("S0")=1 Q ; GLREP S GLREP=$$^%W1GLREP Q ; GLPRM S GLPRM=$$^%W1GLPRM Q ; TDAT(COD) ; D TDD(COD,"ME"),TDD(COD,"AD") ;;W " " Q ; ; CHECKPRM(STAM) ; N %REPN S %REPN=$G(@$$^%W1GLPRM@("REPN")) I %REPN="" Q "REPN" D PCPRM^%W1ARG(JB) ; ---> $$^%W1GLPRM("VAL","ME","AD" ; I $G(%ERRDATE)'="" Q "DT:"_%ERRDATE ; N QUERY S QUERY=$G(@$$^%W1GLPRM@("QUERY")) ; N N,MASPRM,OU S OU="" S N="" F S N=$O(@$$^%W1GLPRM@("VAL",N)) Q:N="" I $L(N)>2 D .I $E(N,1,2)="ME" S MASPRM($E(N,3,20),"ME")=$G(^(N)) .I $E(N,1,2)="AD" S MASPRM($E(N,3,20),"AD")=$G(^(N)) ; D US I $L(OU) Q OU ; S N="" F S N=$O(MASPRM(N)) Q:N="" D .N ME,AD,TYP .S ME=$G(MASPRM(N,"ME")) .S AD=$G(MASPRM(N,"AD")) .S TYP=$$TYP^%W1PCRKV(%REPN,N) .I ME!AD,ME>AD S OU="AD"_N .I ME,ME?2N1"."2N1"."2N,$$^%L1DC(ME,3)'>$$^%L1DC(AD,3) S OU="" .I ME?2N1"."2N1"."2N,$$^%L1DC(ME,3)>$$^%L1DC(AD,3) S OU="AD"_N .I TYP="D",OU'="" S OU=OU_"IDdd" ; Q OU ; ; VL(CD) ; N VL S VL=$G(@$$^%W1GLPRM@("VAL",CD)) Q $$H2U^%L1FRM(VL) ; REPNAME(STAM) ; N %REPN S %REPN=$G(@$$^%W1GLPRM@("REPN")) I %REPN="" Q "REPN" D GLREP N REPNAME S REPNAME=$G(@GLREP) N QUERY S QUERY=$$CLR^%W1PC($G(@$$^%W1GLPRM@("QUERY"))) I $L(QUERY) S REPNAME=QUERY_" - "_REPNAME Q REPNAME ; SEL(GLB,ID) ; N VV S VV="" W VV Q ; SMALLG(GLB) ; I $G(GLB)="" Q 0 N GLB1 S GLB1=GLB ;$S($E(GLB)="^":"",1:"^")_GLB ; N I,N S N="" F I=1:1:39 S N=$O(@GLB1@(N)) Q:N="" I N="" Q 1 Q 0 ; VV(ID,COD,GL) N VV N TYP,LEN S LEN=$$DL^%W1PCRKV(%REPN,COD) S TYP=$$TYP^%W1PCRKV(%REPN,COD) ; N VL S VL=$$VL(ID) I $D(%W1PCS2),$E(ID,1,2)="ME" S VL="-"_$$MULTY(9,LEN) I TYP="N",$E(ID,1,2)="ME" S VL="-"_$$MULTY(9,LEN) I $D(%W1PCS2),$E(ID,1,2)="AD" S VL=$$MULTY(9,LEN) ; S VV="" S VV=VV_"
" D .I $D(%L1PC("VAL",ID)) D Q ..S VL=%L1PC("VAL",ID) ..W VL,! . .S VV=VV_"" ; I $G(GL)'="" D .I GL="^PAR"!($P(GL,"|",3)="PAR")!($P(GL,"]",3)="PAR"),$D(@$$^W4GL("P1SET"))>9,$E(ID,1,2)="ME" D ..S VV=VV_"" ..S VV=VV_"    " . .S VV=VV_"" .S VV=VV_"    " ; S VV=VV_"
" ; Q VV ; ; US ; S OU="" I %REPN="W4DPMH",QUERY["zepnfd" D Q .I '$G(MASPRM("PARIT","ME")),'$G(MASPRM("SUGP","ME")) D ..N MEDT,ADDT ..S MEDT=$$GETP^%W1PRM("W4DPMHDT1") ..S ADDT=$$GETP^%W1PRM("W4DPMHDT2") ..I ADDT-MEDT>10 S OU="ITEMORGROUPMUST:MEPARIT" ; I %REPN="W4PRHZ" D Q .I $G(MASPRM("PAR","ME"))="" D ..N MEDT,ADDT ..S MEDT=$G(MASPRM("TRH","ME")) ..S ADDT=$G(MASPRM("TRH","AD")) ..I ADDT-MEDT>10 S OU="ITEMMUST:MEPAR" ; I %REPN="DLVLK" D .N KINDDAT .S KINDDAT=$G(%ARG("KINDDAT")) .I KINDDAT?1N D PUT^%W1PRM("KINDDAT",KINDDAT) Q ; ; DOPASK ; I %REPN="DLVLK" D .W "",! .W "

",! Q ; DOPASKSEL(VL) ; I VL=+$$GETP^%W1PRM("KINDDAT") Q " selected=""selected"" " Q "" ; DAT(STAM) ; N OK S OK=0 N FLD,COD S FLD=$G(@$$^%W1GLREP@("COD")) ;;S ^AA("W1PCS","FLD")=FLD I $G(%REPN)'="" D Q OK .N IJK F IJK=1:1:$L(FLD,"*") S COD=$P(FLD,"*",IJK) D Q:OK ..S TYP=$$TYP^%W1PCRKV(%REPN,COD) I TYP="D" S OK=1 ; N N S N="" F S N=$O(@$$^%W1GLPRM@("VAL",N)) Q:N="" D .I N["DAT"!(N["TRH") S OK=1 Q OK ; ; SHOWDAYS ; N DAYS S DAYS=$$GETP^%W1PRM("REPDAYS") N J F J=1:1:7 D .W $$^%W1DICT("DAY"_J) .W "" Q %W1PCS0 %W1PCS ; [ 02.09.15 15:34 ] [ 30.05.14 12:40 ] [ 19.04.13 20:51 ] ; INPUT : MAXMIUN SHEIL N %L1PCER ; D GLREP,GLPRM S %LNG=$G(^W1DICT,"H") N IJK,COD,%RNG,TH,DL,TYP I '$D(MAXMIUN),$D(@GLPRM@("MAXMIUN")) S MAXMIUN=^("MAXMIUN") D PUT^%W3DEB("%W1PCS","%L1PC=[%L1PC") F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" ; SHEIL1 N COD,IJK,TYP,DL,%GETREST,TH I $D(%L1PC("SHEIL")) X %L1PC("SHEIL") Q S TH(1)=$$^%W1DICT("DATA_NAME") S TH(2)=$$^%W1DICT("FROM") S TH(3)=$$^%W1DICT("TO") S TH(4)=$$^%W1DICT("SORT") S TH(5)=$$^%W1DICT("TOT") S TH(6)=$$^%W1DICT("HEADER") W "

",! W "

",! W "

",! ; D GLREP,GLPRM N URL S URL="_self" ; ;;D NOSELECT^%W1JS W "
",! W "
",! W "" ; W "",! N I W "" F I=1:1 Q:'$D(TH(I)) S TH=$$H2U^%L1FRM(TH(I)) D .I I=1 W "" Q .I I>3 W "" Q .W "" W "",! ; N DL,TYP,NM,GL F IJK=1:1:MAXMIUN S COD=$P(%L1PC("FLD"),"*",IJK) D .;;Q:$G(@GLREP@(0,COD,"SH"))=0 ZSH .; .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .W " ",! .W " ",! .I TYP'="D" D ..D TD(COD) .I TYP="D" D TDAT(COD) .W " ",! .;;W " ",! .W " ",! .W " ",! .W "",! W "
"_TH_""_TH_""_TH_"
" .W "  "_$$H2U^%L1FRM($$NM^%W1PCRKV(%REPN,COD))_""_$S($G(MIUN(IJK)):$G(MIUN(IJK)),1:" ")_""_$S($G(SIK(IJK)):$G(SIK(IJK)),1:" ")_"" . W "" . ;;W $S($G(CT(IJK)):$G(CT(IJK)),1:" ") . W "" .W "
",! W "

",! W "

",! D SHEIL3 W "

",! W "

",! W "",! W "",! W "
",! W "
",! Q ; ; SELCT(J,NC) I J=NC Q " selected=""selected"" " Q "" ; TD(COD) ; Q:$G(COD)="" N GL S GL=$TR($$GL^%W1PCRKV(%REPN,COD),"!+","") S ^LEVDEB(COD,"GL")=GL_"\"_%REPN_"\"_COD ; I GL'="",$$SMALLG(GL) W "" D SEL(GL,"ME"_COD) W "" D SEL(GL,"AD"_COD) W "" Q ; W ""_$$VV("ME"_COD,COD,GL)_"" W ""_$$VV("AD"_COD,COD,GL)_"" Q ; TDD(COD,PRE) ; W "" N VL D .I $D(%L1PC("VAL",PRE_COD)) D Q ..S VL=%L1PC("VAL",PRE_COD) ..I VL?5N S VL=$ZD(VL,"DD.MM.YY") ..W VL,! .S VL=$$VL(PRE_COD) .S %W1DAT("NODAY")="" .D ^%W1DAT(PRE_COD,VL) W "" 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 D GLREP F IJK=MAXMIUN+1:1:$L(%L1PC("FLD"),"*") S COD=$P(%L1PC("FLD"),"*",IJK) I COD'?.P D .S IJK1=IJK-MAXMIUN+13 .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .D S0 Q ; ; SHEIL3 ; -- CODS WITH "-" -> ADDIT. TABLE N %L1PCER,A,DL3,TYP3,IJK,COD,Y1,Y2,CMIN,I ; --> %FLDMIN (-) S %FLDMIN="" N %I,COD D GLREP,GLPRM F %I=1:1:$L(@GLREP@("FLD"),"*") I $P($G(@GLREP@("FLD0")),"*",%I)="-" D .S COD=$P(@GLREP@("FLD"),"*",%I) .Q:$G(@GLREP@(0,COD,"SH"))=0 .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" ;;99999999 .S %FLDMIN=%FLDMIN_COD_"*" ; S %FLDMIN=$E(%FLDMIN,1,$L(%FLDMIN)-1) ; S @GLPRM@("FLDMIN")=%FLDMIN Q:%FLDMIN="" ; SHEIL31 I $D(%L1PC("SHEIL")) Q ; D GLREP W "",! N CMIN,IJK S CMIN=$L(%FLDMIN,"*") F IJK=1:1:$L(%FLDMIN,"*") D ZSH3 .S COD=$P(%FLDMIN,"*",IJK) Q:COD="" .I '$D(%L1PC("VAL",COD)) S @("ME"_COD)="",@("AD"_COD)="" .N DL,TYP .S DL=$$DL^%W1PCRKV(%REPN,COD) .S TYP=$$TYP^%W1PCRKV(%REPN,COD) .S DL3(IJK)=DL,TYP3(IJK)=TYP .D S0 .I $D(%L1PC("VAL",COD)),'$D(%L1GET) S %L1GET="V" . .W "" .I TYP'="D" D TD(COD) .I TYP="D" D TDAT(COD) .W "" .W "" .W "" .W "",! W "
 "_$$H2U^%L1FRM($$NM^%W1PCRKV(%REPN,COD))_"   
",! Q ; ; KOT(STAM) Q $G(@GLPRM@("QUERY")) Q ; S0 ; I ","_$P($P($G(GLOB2),"(",2),")")_","[(","_COD_",")!$D(%L1PC("S0",COD)) S %RNG("S0")=1 Q ; GLREP D GLREP^%W1PC Q GLPRM S GLPRM=$$^%W1GLPRM Q ; TDAT(COD) ; D TDD(COD,"ME"),TDD(COD,"AD") ;;W " " Q ; ; CHECKPRM(STAM) ; N %REPN S %REPN=$G(@$$^%W1GLPRM@("REPN")) I %REPN="" Q "REPN" D PCPRM^%W1ARG(JB) ; I $G(%ERRDATE)'="" Q "DT:"_%ERRDATE ; N QUERY S QUERY=$G(@$$^%W1GLPRM@("QUERY")) ; N N,MASPRM,OU S OU="" S N="" F S N=$O(@$$^%W1GLPRM@("VAL",N)) Q:N="" I $L(N)>2 D .I $E(N,1,2)="ME" S MASPRM($E(N,3,20),"ME")=$G(^(N)) .I $E(N,1,2)="AD" S MASPRM($E(N,3,20),"AD")=$G(^(N)) ; D US I $L(OU) Q OU ; S N="" F S N=$O(MASPRM(N)) Q:N="" D .N ME,AD S ME=$G(MASPRM(N,"ME")) .S AD=$G(MASPRM(N,"AD")) .I AD,ME>AD S OU="AD"_N .I $$TYP^%W1PCRKV(%REPN,N)="D",$$^%L1DC(ME,3)'>$$^%L1DC(AD,3) S OU="" .I $$TYP^%W1PCRKV(%REPN,N)="D",OU'="" S OU=OU_"IDdd" ; Q OU ; ; VL(CD) ; N VL S VL=$G(@$$^%W1GLPRM@("VAL",CD)) Q $$H2U^%L1FRM(VL) ; REPNAME(STAM) ; N %REPN S %REPN=$G(@$$^%W1GLPRM@("REPN")) I %REPN="" Q "REPN" D GLREP N REPNAME S REPNAME=$G(@GLREP) N QUERY S QUERY=$G(@$$^%W1GLPRM@("QUERY")) I $L(QUERY) S REPNAME=QUERY_" - "_REPNAME Q REPNAME ; SEL(GLB,ID) ; N VV S VV="" W VV Q ; SMALLG(GLB) ; I $G(GLB)="" Q 0 N GLB1 S GLB1=GLB ;$S($E(GLB)="^":"",1:"^")_GLB ; N I,N S N="" F I=1:1:39 S N=$O(@GLB1@(N)) Q:N="" I N="" Q 1 Q 0 ; VV(ID,COD,GL) N VV N TYP,LEN S LEN=$$DL^%W1PCRKV(%REPN,COD) S TYP=$$TYP^%W1PCRKV(%REPN,COD) ; S VV="" I $G(GL)'="" D .S VV=VV_"
" S VV=VV_"" ; S VV=VV_"" .S VV=VV_"    " ; S VV=VV_"
" ; Q VV ; ; US ; S OU="" I %REPN="W4DPMH",QUERY["zepnfd" D Q .I '$G(MASPRM("PARIT","ME")),'$G(MASPRM("SUGP","ME")) D ..N MEDT,ADDT ..S MEDT=$$GETP^%W1PRM("W4DPMHDT1") ..S ADDT=$$GETP^%W1PRM("W4DPMHDT2") ..S ^LV("MEDT")=MEDT,^LV("ADDT")=ADDT ..I ADDT-MEDT>10 S OU="ITEMORGROUPMUST:MEPARIT" ; I %REPN="W4PRHZ" D Q .I '$G(MASPRM("PAR","ME")) D ..N MEDT,ADDT ..S MEDT=$G(MASPRM("TRH","ME")) ..S ADDT=$G(MASPRM("TRH","AD")) ..S ^LV("MEDT")=MEDT,^LV("ADDT")=ADDT ..I ADDT-MEDT>10 S OU="ITEMMUST:MEPAR" ; Q %W1PCSR %W1PCSR(PRINT,TXT,SM) ; [ 27.04.14 09:36 ] [ S1 ; Q:$G(PRINT)<3 S %MDP("B")=$G(%MDP("B")) S %MDP("N")=$G(%MDP("N")) I '$G(%MDP("GWPC")) S %MDP("GWPC")=40 S TXT=$$RPL^%L1FRM(TXT,"",%MDP("B")) S TXT=$$RPL^%L1FRM(TXT,"",%MDP("N")) ; S TXT=$$CLST^%L1FRM(TXT,%MDP("B"),%MDP("N")) ; I $$L^%L1FRM($$SPA^%L1FRM(TXT),%MDP("B"),%MDP("N"))>40,%MDP("GWPC")'>40 D .S TXT=$$RPL^%L1FRM($$SPA^%L1FRM(TXT),%MDP("B"),"") ; S11 Q:$G(PRINT)<3 S SM=+$G(SM) L +@$$^W4PC@(PRINT):1 N PCN,ST S PCN=$ZP(@$$^W4PC@(PRINT,999999))+1 I '$D(TS0)!'$D(TSS) D ^%L1TS S ST=%MDP("N")_$J("",SM)_$TR(TXT,TS0,TSS) S ST=$$RPL^%L1FRM(ST,$TR(%MDP("B"),TS0,TSS),%MDP("B")) S ST=$$RPL^%L1FRM(ST,$TR(%MDP("N"),TS0,TSS),%MDP("N")) S12 Q:$G(PRINT)<3 I PRINT=54,$$^%L1T2P(ST) G ES11 I '$D(PCN) S PCN=$ZP(@$$^W4PC@(PRINT,999999))+1 S @$$^W4PC@(PRINT,PCN)=ST ES11 K TXT L -@$$^W4PC@(PRINT) Q %W1PCVRM %W1PCVRM ; [ 13.06.09 20:37 ] [ S PRTN=$$^%W1JB S VRM=$$^W4GL("VRM")_"("""_PRTN_""")" Q %W1PCZ %W1PCZ ; [ 19.07.22 20:40 ] [ 06.10.21 13:20 ] [ 24.08.21 16:16 ] S ^%TYPCRT(%L3MYDVN)="VT510" S %HBRY="" N COD,COLPR,A,FLD,OUT I '$D(%POSIC) D ^%L1C X %chista BG S GLREP="^[$$^W3MAIN]W1REP(""H"")" S GLREPBG="^[$$^W3MAIN]W1REP(""H""," X %chista N %ECHO S %HBRY="" S %SAY=" zegec llegn " X %XMSGV ZD S %GET=" g""ec cew ++2,70,HH#"_$G(%REPN)_"++8,E,I++++++^rep" D ^%L1GET Q:%S=""!($G(%TO)="END") S %REPN=%S I $D(@GLREP@(%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#++8,E,I++++++^|$$^W3MAIN|W1REP" D ^%L1GET Q:%S=""!(%TO="END") .N %REPN1 S %REPN1=%S .S MAC1=GLREPBG_"%REPN1)",MAC2=GLREPBG_"%REPN)" D ^%S1GC1 ; ZN S %RNAME=$G(@GLREP@(%REPN)) S %GET=" g""ec xe`z ++2,50,HH#"_%RNAME_"++40,H,I" D ^%L1GET G:$G(%TO)="END" ZD S (%RNAME,@GLREP@(%REPN))=%S ; S %GLOB1=$$GL4($G(@GLREP@(%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 @GLREP@(%REPN,"GLOB1")=$$GL2(%GLOB1) ; S %GLOB2=$$GL4($G(@GLREP@(%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 @GLREP@(%REPN,"GLOB2")=$$GL2(%GLOB2) ; S (%S,COD)=$G(@GLREP@(%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,@GLREP@(%REPN,"COD")=COD I $D(@GLREP@(%REPN,0))<10 D 1,2,3,4 G BG D 1 S COD=@GLREP@(%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=" 5 - zezli`y, 4 - zexcbd , 3 - zxzek , 2 - miizenk mipezp , 1 - micew ++8,77,HH#++1,E,I" .D ^%L1GET Q Z5 S %Q("Z")=" CONDENSED ",%Q("U")=$S($G(@GLREP@(%REPN,"LPT"))="S":"Y",1:"N") D ^%S1ASK S @GLREP@(%REPN,"LPT")=$S(YES:"S",1:"B") G ZD ; ; 1 N COD,GLOB2,I,A S COD=@GLREP@(%REPN,"COD") K ^MBG($P) S GLOB2=@GLREP@(%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(@GLREP@(%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",$P(PRM,";",2)["N":"N",1:"E") .;FILE\OUT\DL\MUMPS\SHEIL\SET .I ","_$P($P(GLOB2,")"),"(",2)_","[(","_A_",") S @GLREP@(%REPN,0,A,"SET")=1 .S ^MBG($P,I)=^MBG($P,I)_"\"_$$GL4($G(@GLREP@(%REPN,0,A,"FILE")))_"\"_$G(@GLREP@(%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 @GLREP@(%REPN,0,A) .S @GLREP@(%REPN,0,A)=$P(ST,"\",2)_";"_$P(ST,"\",3)_$S($P(ST,"\",4)="H":"H",$P(ST,"\",4)="D":"D",$P(ST,"\",4)="N":"N",1:"") .I $P(ST,"\",5)'="" S @GLREP@(%REPN,0,A,"FILE")=$$GL2($S($P(ST,"\",5)'["^"&($E($P(ST,"\",5))'="+"):"^",1:"")_$P(ST,"\",5)) .I $P(ST,"\",6)'="" D S:$P(ST,"\",7)'="" @GLREP@(%REPN,0,A,"M2")=$P(ST,"\",7) S:$P(ST,"\",9)'="" @GLREP@(%REPN,0,A,"SET")=$P(ST,"\",9) Q ..S @GLREP@(%REPN,0,A,"OUT")=$P(ST,"\",6) ..S OUT($P(ST,"\",6))="" .I $P(ST,"\",7)'="" S @GLREP@(%REPN,0,A,"M2")=$P(ST,"\",7) .I $P(ST,"\",8)'="" S @GLREP@(%REPN,0,A,"SH")=$P(ST,"\",8) .I $P(ST,"\",9)'="" S @GLREP@(%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 @GLREP@(%REPN,"FLD")=$E(FLD,1,$L(FLD)-1) Q ; ; 2 S COD=@GLREP@(%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(@GLREP@(%REPN,0,A)) .S JJ=JJ+1 S ^MBG($P,JJ)=$P(PRM,";")_"\"_$P($P(PRM,";",2),",")_"\"_+$P($P(PRM,";",2),",",2)_"\"_$P($G(@GLREP@(%REPN,"SIK")),"*",JJ)_"\"_$P($G(@GLREP@(%REPN,"MAM")),"*",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 ; F I=1:1 Q:'$D(^MBG($P,I)) D .S ST=^(I) S A="x"_I K @GLREP@(%REPN,0,A) .S @GLREP@(%REPN,0,A)=$P(ST,"\")_";"_$P(ST,"\",2)_","_$P(ST,"\",3) .S $P(@GLREP@(%REPN,"SIK"),"*",I)=$P(ST,"\",4) .S $P(@GLREP@(%REPN,"MAM"),"*",I)=$P(ST,"\",5) D GET Q ; ; 3 ; S SHP=$G(@GLREP@(%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(@GLREP@(%REPN,"SHP")),%S="" Q I %S="" S %GET=" 99 - lehial " D N^%L1GET G:%S'=99 3 K @GLREP@(%REPN,"SHP") Q N SHP S SHP=%S K ^S000($P) S @GLREP@(%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(@GLREP@(%REPN,"SHP","PROG")) D ^%L1WE I %S'="" S @GLREP@(%REPN,"SHP","PROG")=%S E3 X %chista S %L1GET="" D ZD K %L1GET 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(@GLREP@(%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 @GLREP@(%REPN,"US",II) Q .I %S'?.P S @GLREP@(%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 ; ; 5 ;-- SHEILTOT D ^%W1PCZS X %chista 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 ; 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;26;1;E;#@S %MBG("NEW",%MBG("F","SIK"))=1## 0 - zxg` , 1 - mekiq lawl zexyt` MAM ;n"rn oniq;14;1;E; Q GL2(GL) ; I $G(GL)="" Q "" N GL2 I $E(GL)'="^",$E(GL)'="+" S GL="^"_GL S GL=$TR(GL,"[]","||") S GL2=GL I $E(GL,2)'="|" S GL2="^|$$^%W1UCI(JB)|"_$E(GL,2,80) Q GL2 I GL["^|M|" S GL2="^|$$^W3MAIN|"_$P(GL,"|",3,20) Q GL2 I '$D(JB) S JB=1 I GL["^|TM|",$L(GL)>5 S GL2=$$^W4MAIN($P(GL,"|",3,20)) Q GL2 Q GL ; GL4(GL) ; I $G(GL)="" Q "" N GL4 I $E(GL)'="^",$E(GL)'="+" S GL="^"_GL ;;I GL["^VRM"!(GL["^TMP")!(GL["^TEMP") S GL="^|M|"_$E(GL,2,80) S GL=$TR(GL,"[]","||") S GL4=GL I GL["^|$$^W3MAIN|" S GL4="^|M|"_$P(GL,"|",3) Q GL4 I GL["(""JB" D Q GL4 .I GL["|" S GL=$P(GL,"|",3) .I GL["]" S GL=$P(GL,"]",2) .I $E(GL)="^" S GL=$E(GL,2,30) .I GL["(" S GL=$P(GL,"(") .S GL4="^|TM|"_GL ; I GL["|" S GL4="^"_$P(GL,"|",3) Q GL4 Q GL %W1PCZS %W1PCZS ; [ 30.10.17 16:58 ] [ 08.08.17 13:54 ] [ 24.07.16 17:12 ] N (%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,%REPN) D ^%L1C S FLMODIF=0 S GLREP="^[$$^W3MAIN]W1REP(""H"")" S GLREPBG="^[$$^W3MAIN]W1REP(""H""," S JB=$$^%W1SsID("W1PCZ") QUERY ; X %chista I $D(@GLREP@(%REPN,"QUERY")) D I $G(FLAG)'="" S %BS=1 G ENDPC .N %LAB,%L1,INDEX,MAC .S MAC=GLREPBG_"%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" D ..S @GLREP@(%REPN,I)=$G(@GLREP@(%REPN,"QUERY",QUERY,I)) ; V0 D .N GLREP .D ^%W1PCIN V01 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 %GETIN="" 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 @GLREP@(%REPN,"QUERY",QUERY) S QUERY="" G QUERY 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 V01 ;--- BITUL SADOT MEJUTAROT .S %HBRY="" N I,J,A,A1,O,%MBS F I=1:1:$L(@GLREP@(%REPN,"FLD"),"*") D ..S A=$P(^("FLD"),"*",I),A1="" ..I $L(A) S A1=$P(@GLREP@(%REPN,0,A),";") ..S %MBS("Z",I)=A1,%MBS("O",I)=$P($G(@GLREP@(%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)_"*" .S FLD0=$E(O,1,$L(O)-1) .S @GLREP@(%REPN,"FLD0")=FLD0 ; S D SHEIL1 K %L1GET ; ---- VERXN. SHEILTA I %BS,$O(@GLREP@(%REPN,"QUERY",$O(@GLREP@(%REPN,"QUERY",""))))'="" X %chista S %LAB="ENDPC" G QUERY ENDPC I %BS K %L1PC,MAS 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 I %BS G S D IS3^%L1GET I %S=0 G END I %S=2 D SAVE G END I %S=1!($G(%TO)="END") G S3 END Q ; 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(@GLREP@(%REPN,0,COD,"SH"))=0 K %RNG ZSH .S %RNG=$G(@GLREP@(%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 K %L1GET" .S %RNG=%RNG_"++++"_$G(@GLREP@(%REPN,0,COD,"HELP")) .I $D(@GLREP@(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++"_@GLREP@(%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(@GLREP@(%REPN,0,COD,"SH"))'=0 S IJKOK=1 Q . .I $G(%TO)="END1" S %L1GET="END1" ;------- <.> --> %TO="END1" .; .I TYP="D" D ..I @("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) Q ..I @("ME"_COD)?2N1"."2N1"."2N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),3) Q .I TYP="D" D ..I @("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) Q ..I @("AD"_COD)?2N1"."2N1"."2N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),3) Q . .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=@GLREP@(%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 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($G(@GLREP@(%REPN,"FLD")),"*") I $P($G(@GLREP@(%REPN,"FLD0")),"*",%I)="-" D .K %RNG .S COD=$P(@GLREP@(%REPN,"FLD"),"*",%I) .Q:$G(@GLREP@(%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=@GLREP@(%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 K %L1GET" .I $D(@GLREP@(%REPN,0,COD,"FILE")) S %RNG=%RNG_"++++++"_@GLREP@(%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" D ..I @("ME"_COD)?6N S @("ME"_COD)=$$^%L1DC(@("ME"_COD),4) Q ..I @("ME"_COD)["." S @("ME"_COD)=$$^%L1DC(@("ME"_COD),3) Q .I TYP="D" D ..I @("AD"_COD)?6N S @("AD"_COD)=$$^%L1DC(@("AD"_COD),4) Q ..I @("AD"_COD)["." S @("AD"_COD)=$$^%L1DC(@("AD"_COD),3) Q .;;I $D(@GLREP@(%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 .I $G(@("ME"_A))?.P,TYP="N" S @("ME"_A_"=-99999999") .I $G(@("AD"_A))?.P S @("AD"_A)=$TR($J("",$P($G(@GLREP@(%REPN,0,A)),";",2))," ",9) Q KOT S %SAY=" "_$G(QUERY)_" : "_$G(@GLREP@(%REPN)) X %XMSGV Q S0 ; I ","_$P($P($G(GLOB2),"(",2),")")_","[(","_COD_",")!$D(%L1PC("S0",COD)) S %RNG("S0")=1 S %SAY="*"_%SAY Q ; SAVE ; S %GET=" `zli`yd my ++22,75,HH,,R#"_$G(QUERY)_"++60,H,I++++++"_GLREPBG_"%REPN,""QUERY"")\60\1\16" D ^%L1GET G:%S=""!(%TO="END") ESAVE S QUERY=$$SPA^%L1FRM(%S) D KOT ; I $D(@GLREP@(%REPN,"QUERY",QUERY)) S %GET=" 99 - xey`l . zniiw xak `zli`y " D N^%L1GET G:%S'=99&(%TO'="F9") ESAVE ; M SIK0=SIK S FLD0=$G(@GLREP@(%REPN,"FLD0")) ; I FLD0="" D .S FLD0=$G(@GLREP@(%REPN,"FLD")) .S FLD0=$P(FLD0,"*x1") .S ^("FLD0")=FLD0 S @GLREP@(%REPN,"QUERY",QUERY,"FLD0")=FLD0 ; N I F I="MIUN","SIK0","CT" D .N PRM,J S PRM="",J=0 .N SH F SH=1:1:$L(FLD0,"*") D ..I $P(FLD0,"*",SH)="-" S PRM=PRM_"*" Q ..S J=J+1,PRM=PRM_$G(@I@(J))_"*" .; .S @GLREP@(%REPN,"QUERY",QUERY,I)=$E(PRM,1,$L(PRM)-1) S %GET=" . dnlyed dxiny " D N^%L1GET ESAVE N %YY S %YY=21,%XX=0 X %POSIC X %chiste Q %W1PRM %W1PRM ; [ 10.09.23 14:37 ] [ 03.09.23 18:23 ] [ 14.12.22 16:38 ] PUT(NM,VL,JBB) ; I '$G(JBB) S JBB=JB N MAIN S MAIN=$$^W3MAIN S ^[MAIN]TMPPRM(+$G(JBB),NM)=VL S ^[MAIN]TMPPRM(+$G(JBB),NM,"TIME")=$H Q ; TIME(NM,JBB) ; I '$G(JBB) S JBB=JB N MAIN S MAIN=$$^W3MAIN Q $G(^[MAIN]TMPPRM(+$G(JBB),NM,"TIME")) ; GET(NM,DELAY,JBB) ; I '$G(JBB) S JBB=$G(JB) I '$G(JBB) Q "//" I $G(DELAY) H DELAY N MAIN S MAIN=$$^W3MAIN I JBB[".",'($D(^[MAIN]TMPPRM(JBB,NM))#2),$D(^[MAIN]TMPPRM($P(JBB,"."),NM))#2 D .S JBB=$P(JBB,".") N OU S OU=$G(^[MAIN]TMPPRM(JBB,NM),""_JBB_";"_NM_";"_$$ASC(NM)_"") I $E(NM,1,3)="PSW" D .N LASTJB S LASTJB=$$^%W1SsID .I LASTJB-JBB>1000000 S OU="" Q .I $$DIF^%L1TIME($H,$$TIME(NM,JBB))>$$TIMPSW S OU="" I NM="MSD",'OU S OU=1 Q OU ; GETP(NM) N VL S VL=$$GET(NM) I VL["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) ; [ 03.04.25 10:54 ] [ 01.04.25 10:56 ] [ 30.03.25 13:43 ] 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")) 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 ....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 ; 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) ; [ 23.04.25 15:37 ] [ 03.04.25 12:20 ] [ 01.04.25 11:31 ] 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 W " " Q .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) ; 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 "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 14 ; 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 "",! ; S MSDR="" F I=1:1 S MSDR=$O(@MSDRM@(MSDM,MSDR)) Q:MSDR="" D .D COORD(I) .W "",! W "
",! Q ; MSDRM ; S MSDRM="^[$$^W3MAIN]W3MSDRM" Q ; HG(COLX) ; I COLX=3 Q 1000 Q 480 ; WD(COLX) ; Q WD0\COLX-20 ; LEFT(I) ; N LEFT N I1 S I1=I#COLX I 'I1 S I1=COLX S LEFT=WD*(I1-1)+(5*(I1-1)) Q WD0-LEFT-WD-20 ; TOP(I) ; N I1 S I1=(I-1)\COLX Q TOP0*(I1+1)+(HG*I1) ; COORD(I) ; S LEFT=$$LEFT(I) S TOP=$$TOP(I) Q ; MSG(MSDM,MSDR) ; N MSD,H,H1,MSG,COLORMSG Q:$G(MSDM)="" Q:$G(MSDR)="" ; W "
",! D MSDRM,WEBMSG S COLORMSG(MSDR)=$G(@MSDRM@(MSDM,MSDR,"COLOR")) ;;W "",! S MSD="" F S MSD=$O(@WEBMSG@(MSD)) Q:MSD="" D . I '$D(^[$$^W3MAIN]W3MSDR(MSDR,MSD)) Q . S H=$O(@WEBMSG@(MSD,99999),-1) Q:H="" D .. I H=($H-1),$P($H,",",2)>20000 Q .. S H1=$O(@WEBMSG@(MSD,H,99999),-1) Q:H1="" D ... ;;I H1<($P($H,",",2)-3600) W " " Q ... S MSG=$G(^(H1)) Q:MSG="" ... W "" ... W $$^%W1DICT("FROM")_$$H2U^%L1FRM($G(@WEBMSG@(MSD,H,H1,"WHO"))) ... W " "_$ZD(H_","_H1,"24:60")_" : "_$$^%W1DICT(MSG) ... W "",! ;;W "",! W "
",! Q ; WEBMSG ; S WEBMSG="^[$$^W3MAIN]WEBMSG" Q W3RCVRM0 W3RCVRM(MSDM) ; [ 24.07.16 07:16 ] [ 23.07.16 16:19 ] [ 20.07.16 18:50 ] N (JB,%ARG,MSDM) S DZ=+$H N MSDR D MSDRM ; S HG=1000 S TOP=90 S WD=630 ; S WEBMSG="^[$$^W3MAIN]WEBMSG" ; W "
",! ; S MSDR="" F I=1:1 S MSDR=$O(@MSDRM@(MSDM,MSDR)) Q:MSDR="" D .S COLORMSG(MSDR)=$G(@MSDRM@(MSDM,MSDR,"COLOR")) .S LEFT=WD*(I-1)+(5*(I-1)) .W "" . S NM=$P($G(^[$$^W3MAIN]W3MSDR(MSDR)),"\") . W $$H2U^%L1FRM(NM),! .W "",! . .W "
" . W "",! . S MSD="" F S MSD=$O(@WEBMSG@(MSD)) Q:MSD="" D .. I '$D(^[$$^W3MAIN]W3MSDR(MSDR,MSD)) Q .. S H=$H-1 F S H=$O(@WEBMSG@(MSD,H)) Q:H="" D ... I H=($H-1),$P($H,",",2)>20000 Q ... S H1="" F S H1=$O(@WEBMSG@(MSD,H,H1)) Q:H1="" D .... I H1<($P($H,",",2)-3600) Q .... S MSG=$G(^(H1)) Q:MSG="" .... W "" .... W $$^%W1DICT("FROM")_"-"_$$H2U^%L1FRM($G(@WEBMSG@(MSD,H,H1,"WHO"))) .... W " "_$ZD(H_","_H1,"24:60")_" : "_$$^%W1DICT(MSG) .... W " *** " .... W "",! . W "",! .W "
",! ; S MSDR="" F I=1:1 S MSDR=$O(@MSDRM@(MSDM,MSDR)) Q:MSDR="" D .S LEFT=WD*(I-1)+(5*(I-1)) .W "",! W "
",! Q ; MSDRM ; S MSDRM="^[$$^W3MAIN]W3MSDRM" Q W3RCVRSD W3RCVRSD ; [ 24.12.20 13:01 ] [ 06.02.18 15:02 ] [ 24.10.17 08:49 ] N FLIN,MSD,UCI,OKP,OKL,OKF S $ZT="ZG "_$ZL_":ER^W3RCVRSD" ; CYC I $G(^[$$^W3MAIN]STLOOP("W3RCVRSD")) H ; G HW ; HW ; S OKF=0 D RCV("HZ2MSD","HZ2MSD") ; --- HAZMANOT LE MISSADOT AHEROT D RCV("HZ2WEB","HZ2WEB") ; --- HAZAOT MAHIR D RCV("HZ2MM","HZ2MM") ; --- MI MSD -> RAV MISSADOT D RCV("MRK2WEB","MRK2WEB") D RCV("HZLINKWI","HZLNK") D RCV("PARSEND","P") D RCV("LKHSEND","L") D RCV("P1IRSND","I") D RCV("p1sendw","S") ;;D RCV("P1TA2HRZ","T2H") D RCV("ZP","ZAPA") D RCV("ZPB","ZAPAB") D RCV("WEBMSG","WEBMSG") D RCV("W4MNYPR","W4MNYPR") ; END S ^[$$^W3MAIN]W3RCVRSD=$ZD($H,"DD.MM.YY 24:60")_"\"_$J H 2 G CYC ; ER D SVER^%L1X H ; PRIEM(FL,UCI,PRKILL) N OKP S OKP=0 N FLP,FLE,FLA S FLP=FL N NAME S NAME=$ZPARSE(FLP,"NAME") S FL=$P(NAME,"_") I FL="" S OKP=0 G EP N DIR S DIR=$ZPARSE(FLP,"DIR") ; S FLE=DIR_FL_"E"_"_"_$P(NAME,"_",2,22) S FLA=DIR_FL_"A"_"_"_$P(NAME,"_",2,22) ; ZSY "rm -f "_FLE ZSY "rm -f "_FLA ; I FLP'[".END",$$^%L1ZOS(10,FLP)>0,$$^%L1ZOS(10,FLP_".END")<0 D .N II F II=1:1:5 Q:$$^%L1ZOS(10,FLP_".END")>-1 H 1 D G EP .I $G(PRKILL),FL'["/",FL'["." K @("^["""_UCI_"""]"_FL) .F JJJ=1:1:5 X "I $$GR^W3G2F(FLP,UCI) S OKP=1" Q:OKP H 1 .; .I OKP ZSY "mv "_FLP_" "_FLA .I 'OKP ZSY "mv "_FLP_" "_FLE ; ;;I FLP[".END",$$^%L1ZOS(10,FLP)>0,$$^%L1ZOS(10,$P(FLP,".END"))<0 D .S OKP=0 ZSY "mv "_FLP_" "_FLE ; EP Q OKP ; ; ERR(CDER,IND,FL) S ^[$$^W3MAIN]W3RCVER(+$H,$P($H,",",2))=$G(CDER)_"\"_IND_"\"_FL Q CLRMSD(MSD) I MSD["-" S MSD=$P(MSD,"-") Q MSD ; ; RCV(NMFL,IND) ; N FLIN,MSD N DIRCV S DIRCV=$G(^[$$^W3MAIN]PL("SND","DIRCV")) I $E(DIRCV,$L(DIRCV))'="/" S DIRCV=DIRCV_"/" ; S FLIN=DIRCV_NMFL_"_*" S FLIN=$ZSEARCH(FLIN) I FLIN'[NMFL_"_" G RCVE S MSD=$P($P(FLIN,"_",2),".") S MSD=$$CLRMSD(MSD) I MSD="" D ERR(-1,IND,FLIN) G RCVE ; S UCI=$G(^[$$^W3MAIN]UCI(MSD)) I NMFL="HZLINKWI"!(NMFL="HZ2MSD")!(NMFL="HZ2WEB")!(NMFL="HZ2MM")!(NMFL["WEBMSG") S UCI=$$^W3MAIN ; I NMFL="p1sendw" D .I $P($H,",",2)>(5*3600),$P($H,",",2)<(6*3600),'$D(^[$$^W3MAIN]NEWDAY(+$H,MSD)) D ..N N S N="" F S N=$O(^[UCI]PRTNO(N)) Q:N="" D ...I $G(^(N))=0 K ^[UCI]PRTNO(N) ..S ^[$$^W3MAIN]NEWDAY(+$H,MSD)=$H S OKP=$$PRIEM(FLIN,UCI) ; I 'OKP D ERR(-2,IND,FLIN) G RCVE ; I NMFL="HZ2MSD" D .N HZM S HZM=$P($P($P(FLIN,"_",2),"."),"-",2) Q:'HZM .N MSDTO S MSDTO=$P($P($P(FLIN,"_",2),"."),"-",3) Q:'MSDTO .D ^W3TR2HZ(MSD,MSDTO,HZM) ; I NMFL="HZ2WEB" D .N HZM S HZM=$P($P($P(FLIN,"_",2),"."),"-",2) Q:'HZM .D ^W3TR2WEB(MSD,HZM) ; I NMFL="HZ2MM" D .N DT S DT=$P($P($P(FLIN,"_",2),"."),"-",2) Q:'DT .N TO S TO=$P($P($P(FLIN,"_",2),"."),"-",3) Q:'TO .N HZM S HZM=$P($P($P(FLIN,"_",2),"."),"-",4) Q:'HZM .D ^W3TR2MM(DT,MSD,TO,HZM) ; I NMFL="PARSEND" D ^W3TR2P(UCI) S OKF=1 ; I NMFL="LKHSEND" D ^W3TR2L(UCI) S OKF=OKF+2 ; I NMFL="P1IRSND" D S OKF=OKF+4 .K ^[UCI]P1IR .M ^[UCI]P1IR=^[UCI]P1IRSND(9000) .K ^[UCI]P1IRSND(9000) ; I NMFL="p1sendw" D ^W3TR2S(UCI) S OKF=OKF+8 ; I NMFL="p1sendw" D .I MSD=1,OKF S %ARG("TRG")=OKF D ^W3TRM(MSD) ; --- SF -> SITE .; I NMFL="ZAPAB" D .N DT S DT=$P($P($P(FLIN,"_",2),"."),"-",2) Q:'DT .D ^W3ZAPA(MSD,DT) ; RCVE Q W3REGFAX W3REGFAX(HZ) ; [ 22.03.11 10:21 ] [ S @$$^W3ORD(HZ)@(HZ,"F")=$H S @$$^W3ORD(HZ)@(HZ,"F",$H)="" Q W3REST W3REST ; [ 31.08.17 07:21 ] [ 05.11.15 11:33 ] [ 23.04.12 21:20 ] N (JB,MSDR,FIND,%ARG) ;;I $G(MSDR)="" Q S %W1LNG=$$GET^%W1PRM("LNG") S GL="^[$$^W3MAIN]W3MSD" K ^[$$^W3MAIN]TMPST(JB) ; S FIND=$$INVH^%L1FRM($$SPA^%L1FRM($$CLEAR^%L1FRM(FIND))) D PUT^%W3DEB("W3REST","MSDR=MSDR & FIND=FIND & %ARG=[%ARG") ; N RS,OK S OK=0,RS="" F S RS=$O(@GL@(RS)) Q:RS="" D .S ST=$G(^(RS)) Q:ST="" .I $L($G(MSDR)),'$G(^[$$^W3MAIN]W3MSDR(MSDR,RS)) Q .I $L(FIND),ST'[FIND Q .D ADDTBL(RS,ST) ; VIEW ; W "",! N RS S RS="" F S RS=$O(^[$$^W3MAIN]TMPST(JB,RS)) Q:RS="" D .W " ",! W "
"_$$H2U^%L1FRM(^[$$^W3MAIN]TMPST(JB,RS))_"
",! Q ; ADDTBL(RS,ST) ; S ^[$$^W3MAIN]TMPST(JB,RS)=$J(RS,5)_" "_@GL@(RS) Q W3RGOU W3RGOU(PRM,CODE) ; [ 13.10.13 13:49 ] [ 06.06.12 16:42 ] [ 03.06.12 14:21 ] ; N (JB,%ARG,CODE,PRM) N TDWIDTH,TDALIGN,TDDIR D KILL^%W3DEB("W3ORDRG") D PUT^%W3DEB("W3ORDRG","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("W3ORDRG","MSD=MSD") ; N GL D GL^W3L I '$D(CODE) S CODE="" N PRNEW S PRNEW=0 I $G(CODE)["NEW" S CODE="",PRNEW=1 I $$ONLINE^W4DLVCSR D .I $G(CODE)["!" S CODE=$P(CODE,"!"),PRNEW=2,GL=$$GLA^W3L .E I CODE'="",'$$D^W3L(CODE) S GL=$$GLA^W3L,PRNEW=2 ; W "
",! ; W "
",! ; W "",! I 'CODE W "",! I CODE W "",! W "
"_$$^%W1DICT("NEWREGISTRY")_"
"_$$^%W1DICT("UPDATEPROFILE")_"
",! ; W ""_$$^%W1DICT("FLDMUSTASTR")_"",! W "
",! ; W "",! W "" D CODE,NAME W "",! W "
",! ; W "",! W "",! D DEP W "",! ; W "",! D ROLE W "",! ; W "" D FLOOR W "",! ; W "",! D FLAT W "",! ; W "",! D EMAIL W "",! ; W "",! D COMMENT W "",! ; W "",! D ISCR,ISCH W "",! ; W "
",! W "
",! W "
",! W "
",! ; ;W "",! W "
",! D ROUNDBUT^%W1JS("rbtsubm",$$^%W1DICT("SUBMIT"),"SubmOut('"_PRNEW_"','"_MSD_"')","color:green","wh,22") W "",! D ROUNDBUT^%W1JS("rbtback",$$^%W1DICT("BACK"),"Back('"_PRNEW_"','"_MSD_"')","color:red","wh,22") W "
",! W "
",! ; W "
",! ; -- KLALI Q ; CODE N TDALIGN S TDALIGN=$S($$^%W1DIR="RTL":"right",1:"left") S TDWIDTH="15%" D TD W " "_$$ZW_$$^%W1DICT("MOBIL")_"" W "" D INPC("CODE",100,12,"LTR") Q ; NAME D TD W " "_$$ZW_$$^%W1DICT("NAME")_"" W "  " D INP("NAME",180,30,$$^%W1DIR) Q ; DEP D TD W " "_$$^%W1DICT("DEPARTMENT")_"  " D INP("DEP",180,30,$$^%W1DIR) Q ; ROLE D TD W " "_$$^%W1DICT("ROLE")_"  " D INP("ROLE",180,30,$$^%W1DIR) Q ; FLOOR D TD W " "_$$^%W1DICT("FLOOR")_"" W "  " D INP("FLOOR",30,3,$$^%W1DIR) Q ; FLAT D TD W " "_$$^%W1DICT("ROOM")_"" W "  " D INP("ROOM",40,5,"LTR") Q ; COMMENT D TD W " "_$$^%W1DICT("COMMENT")_"" W "  " D INP("COMMENT","95%",60,$$^%W1DIR) Q ; EMAIL D TD W " "_$$ZW_$$^%W1DICT("EMAIL")_"" W "  " D INP("EMAIL","95%",60,"LTR") Q ; ISCR ; D TD I '$$RKV("ISCR") W "  " Q W " "_$$^%W1DICT("ISCR")_"  " N MZV S MZV=$S($$RKV("ISCR"):$$^%W1DICT("YES"),1:$$^%W1DICT("NO")) ;;W " "_MZV_" ",! W " "_MZV_" ",! Q ; ISCH ; D TD I '$$RKV("ISCH") W "  " Q W " "_$$^%W1DICT("ISCH")_"  " N MZV S MZV=$S($$RKV("ISCH"):$$^%W1DICT("YES"),1:$$^%W1DICT("NO")) ;W " "_MZV_" ",! W " "_MZV_" ",! Q ; ZW(STAM) Q "*" ; TD ; W "",! K TDSPAN,TDWIDTH,TDALIGN,TDDIR Q ; INP(RKV,WD,SIZE,DIR) ; I $G(PRM)="IN",DIR'="D" D .W "",! ; I $G(PRM)="VW" W " : "_$$RKV(0)_"" W "",! Q ; ; INPC(RKV,WD,SIZE,DIR) ; I $G(PRM)="IN" D .N CD S CD=$$GET^%W1PRM("CODE") .I CD["!" S CODE=$P(CD,"!") .I $G(CODE)="",PRNEW=1 S CODE=$$RKV("NMB","LTR") .I PRNEW S CODE=$TR(CODE,"-","") .W "" I $G(PRM)="VW" W " : "_$$RKV(0) ; NOM W "",! Q ; RKV(FLD,DIR) N A I $$P(FLD)'="",$$D^W3L(CODE) Q $$P(FLD) ; I $$P(FLD)'="" Q $$P(FLD) ; Q " " ; ; P(FLD) N OK S OK=0 I $G(CODE)="" Q "" I $G(PRNEW)=1 Q "" I '$$D^W3L(CODE),$G(PRNEW)'=2 Q "" P1 I FLD="CODE" Q $G(CODE) I FLD="NAME" Q $$H2U^%L1FRM($$LKH^W3L(CODE,GL)) I FLD="PELE" Q $$PELE^W3L(CODE,GL) I FLD="DEP" Q $$H2U^%L1FRM($$DEP^W4L(CODE,GL)) I FLD="ROLE" Q $$H2U^%L1FRM($$ROLE^W4L(CODE,GL)) I FLD="FLAT"!(FLD="ROOM") Q $$DIRA^W3L(CODE,GL) I FLD="ENTRANCE" Q $$H2U^%L1FRM($$CNISA^W3L(CODE,GL)) I FLD="FLOOR" Q $$H2U^%L1FRM($$KOMA^W3L(CODE,GL)) I FLD="COMMENT" Q $$H2U^%L1FRM($$CMNT^W3L(CODE,GL)) I FLD="EMAIL" Q $$EMAIL^W3L(CODE,GL) I FLD="ISCR" Q $$ISCR^W3L(CODE,GL) I FLD="ISCH" Q $$ISCH^W3L(CODE,GL) Q "" ; NMB D TD W " "_$$^%W1DICT("MOBIL")_" " D INP("CODE",130,18,"LTR") Q ; VW ; N PRM S PRM="VW" W "
",! ; W "",! W "" D NMB D NAME W "",! D FLAT D FLOOR W "",! W "
",! ; W "",! W "",! D EMAIL D COMMENT W "",! W "
",! ; W "
",! Q W3RSTGAS W3RSTGAS ; [ 13.11.23 06:41 ] [ 12.11.23 17:31 ] [ 24.07.23 06:39 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ;;M ^AA("W3RSTGAS","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_"w4rstgnt"_MSDR_"-"_MSD ; ;;S ^AA("W3RSTGAS","FL")=FL ;;S ^AA("W3RSTGAS","FLEX")=$$EXIST^%L1ZOS(FL) ; I $$EXIST^%L1ZOS(FL) D .O FL:(REWIND:READONLY) .F U FL R A Q:$ZEOF D ..;;S ^AA("W3RSTGAS","A")=A ..U 0 W A,! .C FL .ZSY "rm "_FL Q ; ; ERR(PRM) ; D ERR^W3ANSIT($G(PRM)) Q W3SALE W3SALE(PRM) ; [ 19.11.24 13:27 ] [ 31.10.23 08:37 ] [ 26.10.23 10:43 ] N (PRM,JB,%ARG,%REM) D DEFNOMVC W "
",! ; D PUT^%W3DEB("W3SALE","PRM=PRM") ; I PRM["COUP" D COUP(PRM) Q D PUT^%W1PRM("MVC",2) ; N SIGNIT S SIGNIT="SIGNSALEITEM" I $$NOMVC S SIGNIT="W6SIGNITEMS" W ""_$$^%W1DICT(SIGNIT)_"",! W "

",! W " ",! W " " W " ",! I $$^W6 D .W " " ; W " ",! ; I '$$NOMVC D .W " ",! .W " ",! .W " ",! ; I $$NOMVC D .W " ",! ; W " ",! W " ",! ; I $G(%ARG("MTN")) D MTN G ETB ; S GL=$$^W4GL("W3MVC") S NMB=$$GETP^%W1PRM("NMB") ; I NMB D .S I=0 .S N="" F S N=$O(@GL@(2,N)) Q:N="" I N D VIB(N,2) ; D PUT^%W1PRM("WASMVC2",1) ; ETB W "
"_$$^%W1DICT("NAME")_""_$$^%W1DICT("PICTURE")_""_$$^%W1DICT("QUANT")_""_$$^%W1DICT("NORMALPRICE")_""_$$^%W1DICT("SALEPRICE")_""_$$^%W1DICT("DIFFERENCE")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("SIGN")_"
",! W "
",! D ^W4SBMBCK("AddMvc2()") W "
",! ; D CLEARNOMVC Q ; ; COUP(PRM) ; D PUT^%W3DEB("W3MVC-COUP","PRM=PRM") N MVC S MVC=PRM W "" W "",! W "" W "",! W "",! W "",! W "" W "",! W "",! W "
"_$$H2U^%L1FRM($$GETHD^W3MVC(MVC))_"
" W " " W "",! W "
  
" D ROUNDBUT^%W1JS("submit",$$^%W1DICT("SUBMIT"),"SubmCoup('"_MVC_"')","color:green","wh,22") W " " D ROUNDBUT^%W1JS("backid",$$^%W1DICT("SKIP"),"Back('"_MVC_"')","color:red","wh,22") W "
",! Q ; ; MTN ; N CD,NM,PRC,QN,TXT S CD=$P(PRM,"~") S NM=$$CNWEB^%L1FRM($P(PRM,"~",2)) S PRC=$J($P(PRM,"~",3),2,2) S QN=$P(PRM,"~",4) S TXT="0~"_CD_"~"_$P(PRM,"~",2)_"~"_PRC_"~"_QN D SETMVC^W3ST("TXT","MVC2") W " " W " "_$$H2U^%L1FRM(NM)_"" ; I $$^W6 D TDPIC(CD) ; W " "_QN_"" N SUMN S SUMN=$$MH^W3P(CD)*QN N SUMM S SUMM=PRC*QN I '$$NOMVC D .W " "_$J(SUMN,2,2)_"" .W " "_$J(SUMM,2,2)_"" .W " "_$J(SUMM-SUMN,2,2)_"" ; I $$NOMVC D .W " "_$J(SUMM,2,2)_"" ; W " " W " " W " ",! Q ; ; GET(RKVZ,STR,MVC) ; I $G(MVC)=2 Q $$GET2^W3MVC($G(RKVZ),$G(STR)) Q "" ; ; VIB(N,MVC,CHKMVC) I MVC=2 S A=$G(@GL@(2,N)) N DT1,DT2,DZ,THUM,TOT,CD,QN,MH,PRC,NM,CHK S DT1=$$^%L1DC($$GET("DAT1",A,MVC),3) S DT2=$$^%L1DC($$GET("DAT2",A,MVC),3) S DZ=$$^W4DZ I DZDT2) Q S THUM=$$GET("THUM",A,MVC) I $$^W4MSL(NMB),THUM=1!(THUM=3) Q I $$^W4MSD(NMB),THUM=2 Q I '$$^W6,THUM=3 Q ; S CHK=$$GET("ISHUR",A,MVC) ; S TOT=$$TOTORD^W4GETSUM(JB) I MVC=2 S SUMMVC=$$GET("SUMMVC",A,MVC) I TOT" W ""_$$H2U^%L1FRM(NM)_"" I $$^W6 D TDPIC(CD) W ""_QN_"" I '$$NOMVC W ""_MH_"" W ""_PRC_"" ; I '$$NOMVC D .W "" . W $J(PRC-MH,2,2) .W "" ; W "" D ^W4LBLCHK("lbl"_N,"sign"_N,$G(CHK)) W "" W "",! Q ; ; TDPIC(CD) ; N HG,WD S HG="55px",WD="60px" N PIC S PIC=$P($$GETPIC^W3ENTER(CD),"~",2) W "" W " " W "",! Q ; ; NOMVC() ; Q +$$GETP^%W1PRM("W3SALENOMVC") ; I $$^W6 Q 1 Q $G(%ARG("NOMVC")) ; ; CLEARNOMVC ; D KILL^%W1PRM("W3SALENOMVC") Q ; DEFNOMVC ; N N,NMB S NMB=$$GETP^%W1PRM("NMB") D PUT^%W1PRM("W3SALENOMVC",1) N GL S GL=$$^W4GL("W3MVC") S N="" F S N=$O(@GL@(2,N)) Q:N="" I N D VIB(N,2,1) Q W3SDMENU W3SDMENU(MSD) ; [ 10.08.21 12:02 ] [ 16.10.16 12:15 ] [ 30.10.10 08:09 ] N N D PUT^%W1PRM("MSD",MSD) W "
",! W "",! S N="" F S N=$O(@$$^W4GL("PARSUG")@(N)) Q:N="" D .N A S A=$G(^(N)) Q:A="" I '$$^W4VWGR(N) Q .W "" .W " ",! .I +$G(%ARG("GROUP"))=N D ..S ^[$$^W3MAIN]TMPFL(JB,N)=1-$G(^[$$^W3MAIN]TMPFL(JB,N)) ..Q:'^[$$^W3MAIN]TMPFL(JB,N) ..D SHOWGR(N) W "
" .W $$H2U^%L1FRM(A)_"
",! Q SHOWGR(N) N NP S NP="" F S NP=$O(@$$^W4GL("PAR")@(NP)) Q:NP="" D .N B S B=$G(^(NP)) Q:B="" N NM,MH,IHTML .I $$SUG^W4P(NP)'=N Q .I $$NOPAR^W4PRTVW(NP) Q .S NM=$P(B,"**"),MH=$P(B,"**",2) .S MH=$J(MH,2,2) .S IHTML="" .S IHTML=IHTML_"" .S IHTML=IHTML_"  "_$$H2U^%L1FRM(NM)_"
" .S IHTML=IHTML_"  " .N I,ST,LINE S ST="" F I=1:1 Q:'$D(@$$^W4GL("L1TIP")@("MTK",NP,I)) D ..S LINE=$G(^(I)) ..S ST=ST_$$SPA^%L1FRM(LINE)_" " .S IHTML=IHTML_$$H2U^%L1FRM(ST) .S IHTML=IHTML_"" .S IHTML=IHTML_""_MH_"" .N PIC S PIC=$$GETPIC^W3ENTER(NP) .S IHTML=IHTML_"" .W ""_IHTML_"",! .W "
",! Q W3SET W3SET ; [ 05.08.23 12:30 ] [ 04.09.18 08:15 ] [ 21.06.18 15:14 ] N (JB,%ARG) I '$D(JB) W " JB number is not defined ! " Q S SRCH="" I $D(%ARG("SRCH")) S SRCH=$$CNWEB^%L1FRM(%ARG("SRCH")) S SRCH=$$SPA^%L1FRM(SRCH) ;;W "%ARG(SRCH)="_$G(%ARG("SRCH"))_" SRCH="_SRCH D PUT^%W3DEB("W3SET","%ARG=[%ARG & SRCH=SRCH") D ^W3CRSET W "
",! W ""_$$^%W1DICT("SETSTABLE")_"",! W "",! W "" W "" W "" W "" W "" W "",! N N,I S N="",I=0 F S N=$O(@$$^W4GL("P1SETA")@(N)) Q:N="" D .I $G(%ARG("PARENT")),$D(^[$$^W3MAIN]TMPEZ($$^%W1JB,%ARG("PARENT"),"A"_N)) Q .I SRCH?1N.N,N'=SRCH Q .I SRCH'?1N.N,$L($G(SRCH)),'$$SRCH(SRCH,N) Q .W "" S I=I+1 . .W "" . .W "" . .W "" . .N ID,PROC S ID="chset"_N .S PROC="OnClickTbl('"_N_"','TblSet','trset','chset')" .D ^W4TDCHBX(ID,PROC) . .W "",! . .I $$CUR(N) D DET(N) W "
"_$$^%W1DICT("SETCODE")_""_$$^%W1DICT("SETNAME")_""_$$^%W1DICT("SHOWSET")_""_$$^%W1DICT("SIGN")_"
 "_N_"  "_$$H2U^%L1FRM($$NMSET(N))_" 
",! W "
",! Q ; NMSET(NN) ; I $E(NN)="A" S NN=$E(NN,2,10) Q $P($G(@$$^W4GL("P1SETA")@(NN)),"\") QNMAX(NN) ; I $E(NN)="A" S NN=$E(NN,2,10) I NN="" Q "" Q $P($G(@$$^W4GL("P1SETA")@(NN)),"\",2) ; QNMAXN(NN) ; N A S A=$$QNMAX(NN) Q $$QNMAXNA(A) ; QNMAXNA(A) ; Q $TR(A,"!=^<> ","") ; EQ(NN) N QNMAX S QNMAX=$$QNMAX(NN) Q $$EQA(QNMAX) ; EQA(QNMAX) Q $S(QNMAX["!"!(QNMAX["="):1,QNMAX["^"!(QNMAX[">"):2,1:"") ; SRCH(SRCH,SET) ; I '$L($G(SRCH)) Q 1 N SRCOK S SRCOK=0 I SRCH?1N.N,SET=SRCH S SRCOK=1 G ES I $$^%W1DIR="LTR" S SRCH=$$FUNC^%LCASE(SRCH) N NM I $$^%W1DIR="RTL" S NM=$$INVH^%L1FRM($$NMSET(SET)) I $$^%W1DIR="LTR" S NM=$$FUNC^%LCASE($$NMSET(SET)) D PUT^%W3DEB("W3SET-SRCH","NM=NM & SRCH=SRCH") 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 F J=1:1:$L(SRCH," ") D Q:'OK .N FND,FND1 S FND=$F(" "_NM," "_$P(SRCH," ",J)) I FND<1 S OK=0 Q .S FND1=FND-$L($P(SRCH," ",J)) .I $D(MF(FND1)) S FND=$F(" "_NM," "_$P(SRCH," ",J),MF(FND1)) I FND<1 S OK=0 Q .S MF(FND1)=FND I SRCH=SET S OK=1 S SRCOK=OK ES Q SRCOK ; GETCODES(SET) ; N N,CD S CD="" S N="" F S N=$O(@$$^W4GL("P1SETA")@(SET,N)) Q:N="" D .S CD=CD_N_";" S CD=$P(CD,";",1,$L(CD,";")-1) S:CD="" CD=" " Q CD ; GETST(CD) ; N ST I $G(CD)="" Q " " S ST=CD_";"_$$H2U^%L1FRM($$SHEM^W4P(CD))_";"_$G(@$$^W4GL("QNSET")@(CD))_";"_$G(@$$^W4GL("MHSET")@(CD)) S:ST="" ST=" " Q ST DET(SET) ; D DET^W3TREIDK(SET) Q N N W " ",! W "",! S CD="" F S CD=$O(@$$^W4GL("P1SETA")@(SET,CD)) Q:CD="" D .W "",! .W "",! .W "" .W "" .W "",! W "
"_CD_""_$$H2U^%L1FRM($$SHEM^W4P(CD))_""_$$QNSET(CD)_""_$$MHSET(CD)_"
",! W "",! Q CUR(SET) ; I '$G(%ARG("CUR")) Q 0 I $G(%ARG("CUR"))=SET Q 1 Q 0 QNSET(CD) ; S QN=$G(@$$^W4GL("QNSET")@(CD)) I QN="" Q " " Q QN MHSET(CD) ; S MH=$G(@$$^W4GL("MHSET")@(CD)) I MH="" Q " " Q $J(MH,2,2) W3SETA W3SETA ; [ 22.01.16 16:44 ] [ 01.01.16 04:42 ] [ 02.09.10 11:42 ] Q NM(SET) ; I $G(SET)="" Q "" I '$L(SET) Q "" I $$SETHD(SET)="" Q "" Q $$SPA^%L1FRM($P($$SETHD(SET),"\")) ; QN(SET) ; I $G(SET)="" Q "" I '$L(SET) Q "" I $$SETHD(SET)="" Q "" Q $$SPA^%L1FRM($P($$SETHD(SET),"\",2)) ; SET(SET) ; I $E(SET)="A" S SET=$E(SET,2,20) Q SET ; SETHD(SET) ; S SET=$$SET(SET) I SET="" Q "" Q $G(@$$^W4GL("P1SETA")@(SET)) ; D(SET) ; S SET=$$SET(SET) I SET="" Q 0 I $D(@$$^W4GL("P1SETA")@(SET))=11 Q 1 Q 0 W3SETHD W3SETHD(PRM) ; [ 29.12.24 12:19 ] [ 31.10.24 15:58 ] [ 19.09.24 12:03 ] N (JB,%ARG,%REM,PRM) I '$D(JB),$D(%ARG("JB")) S JB=%ARG("JB") N I,VIR,SVLK S SVLK=0 S ^AA("W3SETHD","PRM0")=PRM I PRM["<>" S SVLK=$P(PRM,"<>",2),PRM=$P(PRM,"<>") ; N T S T=$$T^W3HZHD ; F I=1:1:$L(PRM,"~") D .N VIRL,VIRR,TYPE S TYPE="" .S VIRL=$$SPA^%L1FRM($P(T,";",I)) Q:VIRL?.P .I VIRL[":" S TYPE=$P(VIRL,":",2),VIRL=$P(VIRL,":") .S VIRR=$P(PRM,"~",I) .I TYPE="T" S VIRR=$$TS^%L1TIME(VIRR) .I VIRR="" S @VIRL="" Q .S VIRR=$$RPL^%L1FRM(VIRR,"""","%22") .S VIRR=$$RPL^%L1FRM(VIRR,"''","%22") .S @(VIRL_"="""_VIRR_"""") .S @VIRL=$$CLEAR(@VIRL) .D DATTM(VIRL) ; I $G(EMAIL)'="" D .S EMAIL=$TR(EMAIL,"'","") .S EMAIL=$TR(EMAIL,"""","") ; I $G(CITY)'="" D .;;S ^AA("W3SETHD","CITY0")=CITY .S CITY=$$CITY(CITY) .I $G(HOME),'$G(@$$^W4PRM@("KTVNUM")) S CITY=$TR(CITY,"01234567890","") ;;S ^AA("W3SETHD","CITY")=CITY ; I $G(STREET)'="",$G(HOME) D .I $G(@$$^W4PRM@("KTVNUM")) Q .S STREET=$TR(STREET,"01234567890","") ; I $$GETP^%W1PRM("HZM")'>0,SHAA<5,$$^%L1DC(DAT,3)=$$^W4DZ,$P($H,",",2)>(9*3600) D .S DAT=$$^%L1DC($$^%L1DC(DAT,3)+1,1) ; S AHUZ=$$AHUZ^W4MENUBT ; D PUT^%W3DEB("W3SETHD","NMB=NMB&NAME=NAME&DAT=DAT&SHAA=SHAA&CITY=CITY&PELE=PELE&STREET=STREET&COMMENT=COMMENT&ENTRANCE=ENTRANCE&COMP=COMP&FLAT=FLAT&FLOOR=FLOOR&FAX=FAX&EMAIL=EMAIL&MIKUD=MIKUD&TELB=TELB") ; S MSD=$$GET^%W1PRM("MSD") ; S NMB1="",CODE=$G(CODE) S COMMENT=$$CLRDLM^%L1FRM(COMMENT,"{","}") ; I $$^W4DLVCSR,'$$TELEPHONE^W4PRM D ; -- KUPA ( LO ONLINE ) .Q:'$G(NMB) Q:NMB=$$LKKLALI^W4PRM .N NMB1 S NMB1=$$PROCNMB(NMB) .;;Q:$$DC^W4L(NMB1) ; *** 14/04/23 .I '$D(NAME) S NAME=$$INVH($$NAME^W3HZMST(JB)) .D CRLK(NMB,JB) ; I NMB1 S CODE=NMB1 D PUT^%W1PRM("NMB",CODE) ; *** 22/11/15 *** LEV ; N NOCHNDLV I $$^W4DLVCSR,$D(@$$^W4TMPORD)=11 S NOCHNDLV=1 ; N CITYI S CITYI=$$INVH^%L1FRM($G(CITY)) ; ;;S ^AA("W3SETHD","DMSH")=DMSH D .N CITY S CITY=$G(CITYI) .D HEAD^W3HZTFR ;!!! -----------------------> ^TMPORD, AHUZ ; K NOCHNDLV ; N HZM S HZM=$$GET^%W1PRM("HZM") ; I $$^W4DLVCSR,$$^W4ISORD(HZM) D .N A,RES S A=$$^W4NEWHZ(JB,HZM,1) .;;I HZM>0,$$TEAV^W4PRM D SETTV(HZM) ; -- 26.05.25 ; I $$^W4DLVCSR,'$$TELEPHONE^W4PRM D SAVE^W4TMPORD I $G(CODE)="",$$GETP^%W1PRM("CODE") S CODE=$$GETP^%W1PRM("CODE") ; I SVLK,$G(CODE),'$$^W4DLVCSR!$$TELEPHONE^W4PRM D ; -- ONLINE OR CALLCENTER .N STR S STR="" .; .I $$GETP^%W1PRM("W5ORDDT")="W5ORDDT1" D Q ..I $G(NAME)'?.P S STR=STR_"LKH="_$$HB($G(NAME)) ..I $G(NMB)'?.P S STR=STR_"<>TELB="_NMB ..I $G(PELE)'="" S STR=STR_"<>PELE="_$G(PELE) ..S STR=STR_"<>COMP="_$$HB($G(COMP)) ..S STR=STR_"<>EMAIL="_$$HB($G(EMAIL)) ..D PUT^%W3DEB("W3SETHD-SVLK","STR=STR") ..D PUT2^W3L(CODE,STR) . .I $$GETP^%W1PRM("W5ORDDT")="W5ORDDT2" D Q ..I $G(STREET)'?.P S STR=STR_"<>KTV="_$$HB($G(STREET)) ..S STR=STR_"<>DIRA="_$G(FLAT) ..S STR=STR_"<>KOMA="_$$HB($G(FLOOR)) ..S STR=STR_"<>BAIT="_$G(HOME) ..S STR=STR_"<>CNISA="_$G(ENTRANCE) ..S STR=STR_"<>IR="_CITY .S ^AA("W3SETHD","CITY")=CITY .S ^AA("W3SETHD","CITYHB")=$$HB(CITY) .I $G(NAME)'?.P S STR=STR_"LKH="_$$HB($G(NAME)) .I $G(STREET)'?.P S STR=STR_"<>KTV="_$$HB($G(STREET)) .I $G(NMB)'?.P S STR=STR_"<>TELB="_$S($G(TELB):TELB,1:NMB) .I $G(FLAT)'="-" S STR=STR_"<>DIRA="_$G(FLAT) .I $G(FLOOR)'="-" S STR=STR_"<>KOMA="_$$HB($G(FLOOR)) .I $G(HOME)'="-" S STR=STR_"<>BAIT="_$G(HOME) .I $G(ENTRANCE)'="-" S STR=STR_"<>CNISA="_$G(ENTRANCE) .I $G(COMMENT)'="-" S STR=STR_"<>CMNT="_$$HB($G(COMMENT)) .I $G(CITY)'?.P S STR=STR_"<>IR="_CITY ;; $$HB($G(CITY)) ; -- 07/07/2024 .I $G(PELE)'="-" S STR=STR_"<>PELE="_$G(PELE) .I $G(COMP)'="-" S STR=STR_"<>COMP="_$$HB($G(COMP)) .;;I $G(TZ)'="-" S STR=STR_"<>TZ="_$$INVH($G(TZ)) .D PUT^%W3DEB("W3SETHD-SVLK","STR=STR") .D PUT2^W3L(CODE,STR) Q ; ; DATTM(VIRL) ; N VIRL1 S VIRL1=VIRL I VIRL?1U.U1"IDdd"!(VIRL?1U.U1"IDmm")!(VIRL?1U.U1"IDyy")!(VIRL?1U.U1"mnid")!(VIRL?1U.U1"hrid") S VIRL1=$E(VIRL,1,$L(VIRL)-4) I VIRL?1U.U1"IDdd" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),1,2) .S $E(@VIRL1,1,2)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)="." I VIRL?1U.U1"IDmm" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),4,5) .S $E(@VIRL1,4,5)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,6)="." I VIRL?1U.U1"IDyy" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),7,8) .S $E(@VIRL1,7,8)=$TR($J(@VIRL,2)," ",0) I VIRL?1U.U1"mnid" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),4,5) .S $E(@VIRL1,4,5)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)=":" I VIRL?1U.U1"hrid" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),1,2) .S $E(@VIRL1,1,2)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)=":" ; I $G(@VIRL1)?1"0-.".E S @VIRL1="-" I $G(@VIRL1)?1"0-:".E S @VIRL1="-" Q ; CLEAR(V) ; N V0,J S V0="" S V=$$CLEAR^%L1FRM($$CNWEB^%L1FRM(V)) F J=1:1:$L(V) I $A(V,J)>31,$A(V,J)<127 S V0=V0_$E(V,J) S V0=$TR(V0,"?#$^*=~\","") S V0=$$SPA^%L1FRM(V0) ;;S V0=$E(V0,J,255) Q V0 ; PROCNMB(LK) ; S LK=$$SPA^%L1FRM(LK) I $L(LK)>3,$$D^W4L(LK) Q LK S LK=$TR(LK,"-\*!","") I $L(LK)>3,$$D^W4L(LK) Q LK I $L(LK)=7,$$D^W4L("03"_LK) Q "03"_LK I $L(LK)=7,$$D^W4L("03-"_LK) Q "03-"_LK I $L(LK)=7,$$D^W4L("04"_LK) Q "04"_LK I $L(LK)=7,$$D^W4L("04-"_LK) Q "04-"_LK I $L(LK)=7,$$D^W4L("08"_LK) Q "08"_LK I $L(LK)=7,$$D^W4L("08-"_LK) Q "08-"_LK I $L(LK)=7,$$D^W4L("09"_LK) Q "09"_LK I $L(LK)=7,$$D^W4L("09-"_LK) Q "09-"_LK I $L(LK)>7,$$D^W4L($E(LK,3,13)) Q $E(LK,3,13) I $L(LK)>7,$$D^W4L($E(LK,4,13)) Q $E(LK,4,13) Q "" ; INVH(RKV) ; Q $$INVH^%L1FRM(RKV) ; DLV(STAM) ; I $$^W4DLVCSR!$$TELEPHONE^W4PRM Q 1 Q 0 ; HB(TX) ; S TX=$$SPA^%L1FRM(TX) S TX=$$CNWEB^%L1FRM(TX) S TX=$$INVH(TX) Q TX ; CITY(CITY) ; N CITY1 S CITY1=$$HB($G(CITY)) Q $$CITY^W3SP(CITY1) ; ; CRLK(NMB,JB,GLORD) ; S GLORD=$G(GLORD) S NMB1=$$PROCNMB(NMB) I NMB1="" S NMB1=$TR(NMB,"-\*!","") ; I $G(TELB)="" S TELB=NMB N NM S NM=NAME N HNH S HNH=$$HNH^W3HZMST(JB,GLORD) N HNHAH S HNHAH=$$AHUZ^W3HZMST(JB,GLORD) N TOT S TOT=$$TOTORD^W3HZMST(JB,GLORD) I $$COMP^W3PRM,$G(COMP)'="" S NM=COMP I NM="",$L($G(MAZMIN)) S NM=MAZMIN ; -- 16/01/24 ; Q:'$L($G(NM)) ; N GL D GL^W3L N SV S SV=1 N SHEM0,CITY0,KTV0,BAIT0 S SHEM0=$$LKH^W4L(NMB1) S CITY0=$$CITY^W4L(NMB1) S KTV0=$$KTV^W4L(NMB1) S BAIT0=$$BAIT^W4L(NMB1) ; I $D(@GL@(NMB1)),'$G(SVLK) D Q:'SV .I $L(SHEM0)>1&($L(CITY0)>2)&$L(KTV0)&$L(BAIT0) S SV=0 ; I $D(@GL@(NMB1)),'$L($G(STREET)) D Q .I NMB1=$$NMBKSK^W4KIOSKO Q .I $L($G(PELE)) D PUT^W4L(NMB1,PELE,"PELE") .I $L($G(COMP)) D PUT^W4L(NMB1,$$HB(COMP),"COMP") N PRM S PRM="LKH="_$$HB(NM)_"<>" ; I CITY="" S CITY="TAKEAWAY" ; I CITY'="TAKEAWAY" S PRM=PRM_"KTV="_$$HB($G(STREET))_"<>" S PRM=PRM_"TELB="_TELB ; I CITY'="TAKEAWAY" D .S PRM=PRM_"<>DIRA="_$G(FLAT)_"<>KOMA="_$$HB($G(FLOOR))_"<>" .S PRM=PRM_"BAIT="_$G(HOME)_"<>CNISA="_$$HB($G(ENTRANCE))_"<>" .S PRM=PRM_"IR="_CITY_"<>" .S PRM=PRM_"<>MIKUD="_$G(MIKUD) S PRM=PRM_"<>CMNT="_$$HB($G(COMMENT))_"<>" S PRM=PRM_"PELE="_$G(PELE)_"<>COMP="_$$HB($G(COMP))_"<>" S PRM=PRM_"FAX="_$G(FAX) I $L($G(EMAIL)) S PRM=PRM_"<>EMAIL="_$G(EMAIL) S PRM=PRM_"<>TZ="_$G(TZ) S PRM=PRM_"<>PRIVATE="_$G(KINDORD) ;;S ^AA("W3SETHD","PRM")=PRM ; D PUT2^W4L(NMB1,PRM) Q ; SETTV(HZM) ; N TIME S TIME=$G(@$$^W4GL("W4TVH2O")@(HZM,"TIME")) I TIME'="" Q ; -- 19.02.24 ;;N SEC S SEC=$$DIF^%L1TIME($H,TIME,1) ; -- 19.02.24 ;;I TIME,SEC<10 Q ; -- 19.02.24 S ^AA("W3SETHD-SETTV",HZM,$H)=TIME S RES=$$^W4TVORD(HZM) Q ; SETDA(HZM) ; N TIME S TIME=$G(@$$^W4GL("W4DAH2O")@(HZM,"TIME")) I TIME'="" Q ; -- 19.02.24 ;;N SEC S SEC=$$DIF^%L1TIME($H,TIME,1) ; -- 19.02.24 ;;I TIME,SEC<10 Q ; -- 19.02.24 S ^AA("W3SETHD-SETDA",HZM,$H)=TIME S RES=$$^W4DAORD(HZM) Q W3SETHD0 W3SETHD(PRM) ; [ 05.04.23 13:58 ] [ 24.01.23 12:54 ] [ 11.07.22 13:01 ] N (JB,%ARG,%REM,PRM) I '$D(JB),$D(%ARG("JB")) S JB=%ARG("JB") N I,VIR,SVLK S SVLK=0 D PUT^%W3DEB("W3SETHD","PRM=PRM") I PRM["<>" S SVLK=$P(PRM,"<>",2),PRM=$P(PRM,"<>") ; N T S T=$$T^W3HZHD ; F I=1:1:$L(PRM,"~") D .N VIRL,VIRR,TYPE S TYPE="" .S VIRL=$$SPA^%L1FRM($P(T,";",I)) Q:VIRL?.P .I VIRL[":" S TYPE=$P(VIRL,":",2),VIRL=$P(VIRL,":") .S VIRR=$P(PRM,"~",I) .I TYPE="T" S VIRR=$$TS^%L1TIME(VIRR) .I VIRR="" S @VIRL="" Q .S VIRR=$$RPL^%L1FRM(VIRR,"""","%22") .S VIRR=$$RPL^%L1FRM(VIRR,"''","%22") .S @(VIRL_"="""_VIRR_"""") .S @VIRL=$$CLEAR(@VIRL) .D DATTM(VIRL) ; I $G(EMAIL)'="" D .S EMAIL=$TR(EMAIL,"'","") .S EMAIL=$TR(EMAIL,"""","") ; I $G(CITY)'="" D .;;S ^AA("W3SETHD","CITY0")=CITY .S CITY=$$CITY(CITY) ;;S ^AA("W3SETHD","CITY")=CITY ; I $$GETP^%W1PRM("HZM")'>0,SHAA<5,$$^%L1DC(DAT,3)=$$^W4DZ,$P($H,",",2)>(9*3600) D .S DAT=$$^%L1DC($$^%L1DC(DAT,3)+1,1) ; S AHUZ=$$AHUZ^W4MENUBT ; D PUT^%W3DEB("W3SETHD","NMB=NMB&NAME=NAME&DAT=DAT&SHAA=SHAA&CITY=CITY&PELE=PELE&STREET=STREET&COMMENT=COMMENT&ENTRANCE=ENTRANCE&COMP=COMP&FLAT=FLAT&FLOOR=FLOOR&FAX=FAX&EMAIL=EMAIL&MIKUD=MIKUD&TELB=TELB") ; S MSD=$$GET^%W1PRM("MSD") ; S NMB1="",CODE=$G(CODE) S COMMENT=$$CLRDLM^%L1FRM(COMMENT,"{","}") ; I $$^W4DLVCSR,'$$TELEPHONE^W4PRM D ; -- KUPA ( LO ONLINE ) .Q:'$G(NMB) Q:NMB=$$LKKLALI^W4PRM .D CRLK(NMB,JB) ; I NMB1 S CODE=NMB1 D PUT^%W1PRM("NMB",CODE) ; *** 22/11/15 *** LEV ; N NOCHNDLV I $$^W4DLVCSR,$D(@$$^W4TMPORD)=11 S NOCHNDLV=1 ; N CITYI S CITYI=$$INVH^%L1FRM($G(CITY)) ; D .N CITY S CITY=$G(CITYI) .D HEAD^W3HZTFR ;!!! -----------------------> ^TMPORD, AHUZ ; K NOCHNDLV ; N HZM S HZM=$$GET^%W1PRM("HZM") ; I $$^W4DLVCSR,$$^W4ISORD(HZM) D .N A S A=$$^W4NEWHZ(JB,HZM,1) ; I $$^W4DLVCSR,'$$TELEPHONE^W4PRM D SAVE^W4TMPORD I $G(CODE)="",$$GETP^%W1PRM("CODE") S CODE=$$GETP^%W1PRM("CODE") ; I SVLK,$G(CODE),'$$^W4DLVCSR!$$TELEPHONE^W4PRM D ; -- ONLINE OR CALLCENTER .N STR S STR="" .; .I $$GETP^%W1PRM("W5ORDDT")="W5ORDDT1" D Q ..I $G(NAME)'?.P S STR=STR_"LKH="_$$HB($G(NAME)) ..I $G(NMB)'?.P S STR=STR_"<>TELB="_NMB ..I $G(PELE)'="" S STR=STR_"<>PELE="_$G(PELE) ..S STR=STR_"<>COMP="_$$HB($G(COMP)) ..S STR=STR_"<>EMAIL="_$$HB($G(EMAIL)) ..D PUT^%W3DEB("W3SETHD-SVLK","STR=STR") ..D PUT2^W3L(CODE,STR) . .I $$GETP^%W1PRM("W5ORDDT")="W5ORDDT2" D Q ..I $G(STREET)'?.P S STR=STR_"<>KTV="_$$HB($G(STREET)) ..S STR=STR_"<>DIRA="_$G(FLAT) ..S STR=STR_"<>KOMA="_$$HB($G(FLOOR)) ..S STR=STR_"<>BAIT="_$G(HOME) ..S STR=STR_"<>CNISA="_$G(ENTRANCE) ..S STR=STR_"<>IR="_CITY . .I $G(NAME)'?.P S STR=STR_"LKH="_$$HB($G(NAME)) .I $G(STREET)'?.P S STR=STR_"<>KTV="_$$HB($G(STREET)) .I $G(NMB)'?.P S STR=STR_"<>TELB="_$S($G(TELB):TELB,1:NMB) .I $G(FLAT)'="-" S STR=STR_"<>DIRA="_$G(FLAT) .I $G(FLOOR)'="-" S STR=STR_"<>KOMA="_$$HB($G(FLOOR)) .I $G(HOME)'="-" S STR=STR_"<>BAIT="_$G(HOME) .I $G(ENTRANCE)'="-" S STR=STR_"<>CNISA="_$G(ENTRANCE) .I $G(COMMENT)'="-" S STR=STR_"<>CMNT="_$$HB($G(COMMENT)) .I $G(CITY)'?.P S STR=STR_"<>IR="_$G(CITY) .I $G(PELE)'="-" S STR=STR_"<>PELE="_$G(PELE) .I $G(COMP)'="-" S STR=STR_"<>COMP="_$$HB($G(COMP)) .;;I $G(TZ)'="-" S STR=STR_"<>TZ="_$$INVH($G(TZ)) .D PUT^%W3DEB("W3SETHD-SVLK","STR=STR") .D PUT2^W3L(CODE,STR) Q ; ; DATTM(VIRL) ; N VIRL1 S VIRL1=VIRL I VIRL?1U.U1"IDdd"!(VIRL?1U.U1"IDmm")!(VIRL?1U.U1"IDyy")!(VIRL?1U.U1"mnid")!(VIRL?1U.U1"hrid") S VIRL1=$E(VIRL,1,$L(VIRL)-4) I VIRL?1U.U1"IDdd" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),1,2) .S $E(@VIRL1,1,2)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)="." I VIRL?1U.U1"IDmm" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),4,5) .S $E(@VIRL1,4,5)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,6)="." I VIRL?1U.U1"IDyy" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),7,8) .S $E(@VIRL1,7,8)=$TR($J(@VIRL,2)," ",0) I VIRL?1U.U1"mnid" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),4,5) .S $E(@VIRL1,4,5)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)=":" I VIRL?1U.U1"hrid" D Q .I $G(@VIRL)="-" S @VIRL=$E($G(@VIRL1),1,2) .S $E(@VIRL1,1,2)=$TR($J(@VIRL,2)," ",0) .S $E(@VIRL1,3)=":" ; I $G(@VIRL1)?1"0-.".E S @VIRL1="-" I $G(@VIRL1)?1"0-:".E S @VIRL1="-" Q ; CLEAR(V) ; N V0,J S V0="" S V=$$CLEAR^%L1FRM($$CNWEB^%L1FRM(V)) F J=1:1:$L(V) I $A(V,J)>31,$A(V,J)<127 S V0=V0_$E(V,J) S V0=$TR(V0,"?#$^*=~\","") S V0=$$SPA^%L1FRM(V0) ;;S V0=$E(V0,J,255) Q V0 ; PROCNMB(LK) ; S LK=$$SPA^%L1FRM(LK) I $L(LK)>3,$$D^W4L(LK) Q LK S LK=$TR(LK,"-\*!","") I $L(LK)>3,$$D^W4L(LK) Q LK I $L(LK)=7,$$D^W4L("03"_LK) Q "03"_LK I $L(LK)=7,$$D^W4L("03-"_LK) Q "03-"_LK I $L(LK)=7,$$D^W4L("04"_LK) Q "04"_LK I $L(LK)=7,$$D^W4L("04-"_LK) Q "04-"_LK I $L(LK)=7,$$D^W4L("08"_LK) Q "08"_LK I $L(LK)=7,$$D^W4L("08-"_LK) Q "08-"_LK I $L(LK)=7,$$D^W4L("09"_LK) Q "09"_LK I $L(LK)=7,$$D^W4L("09-"_LK) Q "09-"_LK I $L(LK)>7,$$D^W4L($E(LK,3,13)) Q $E(LK,3,13) I $L(LK)>7,$$D^W4L($E(LK,4,13)) Q $E(LK,4,13) Q "" ; INVH(RKV) ; Q $$INVH^%L1FRM(RKV) ; DLV(STAM) ; I $$^W4DLVCSR!$$TELEPHONE^W4PRM Q 1 Q 0 ; HB(TX) ; S TX=$$SPA^%L1FRM(TX) S TX=$$CNWEB^%L1FRM(TX) S TX=$$INVH(TX) Q TX ; CITY(CITY) ; N CITY1 S CITY1=$$HB($G(CITY)) Q $$CITY^W3SP(CITY1) ; ; CRLK(NMB,JB,GLORD) ; S GLORD=$G(GLORD) S NMB1=$$PROCNMB(NMB) I NMB1="" S NMB1=$TR(NMB,"-\*!","") ; S NAME=$$NAME^W3HZMST(JB,GLORD) ; I $G(TELB)="" S TELB=NMB N NM S NM=NAME N HNH S HNH=$$HNH^W3HZMST(JB,GLORD) N HNHAH S HNHAH=$$AHUZ^W3HZMST(JB,GLORD) N TOT S TOT=$$TOTORD^W3HZMST(JB,GLORD) I $$COMP^W3PRM,$G(COMP)'="" S NM=COMP ; Q:'$L($G(NM)) ; N GL D GL^W3L N SV S SV=1 N SHEM0,CITY0,KTV0,BAIT0 S SHEM0=$$LKH^W4L(NMB1) S CITY0=$$CITY^W4L(NMB1) S KTV0=$$KTV^W4L(NMB1) S BAIT0=$$BAIT^W4L(NMB1) ; I $D(@GL@(NMB1)),'$G(SVLK) D Q:'SV .I $L(SHEM0)>1&($L(CITY0)>2)&$L(KTV0)&$L(BAIT0) S SV=0 ; I $D(@GL@(NMB1)),'$L($G(STREET)) D Q .I $L($G(PELE)) D PUT^W4L(NMB1,PELE,"PELE") .I $L($G(COMP)) D PUT^W4L(NMB1,$$HB(COMP),"COMP") N PRM S PRM="LKH="_$$HB(NM)_"<>" I CITY="" S CITY="TAKEAWAY" I CITY'="TAKEAWAY" S PRM=PRM_"KTV="_$$HB($G(STREET))_"<>" S PRM=PRM_"TELB="_TELB ; I CITY'="TAKEAWAY" D .S PRM=PRM_"<>DIRA="_$G(FLAT)_"<>KOMA="_$$HB($G(FLOOR))_"<>" .S PRM=PRM_"BAIT="_$G(HOME)_"<>CNISA="_$$HB($G(ENTRANCE))_"<>" .S PRM=PRM_"IR="_CITY_"<>" .S PRM=PRM_"<>MIKUD="_$G(MIKUD) S PRM=PRM_"<>CMNT="_$$HB($G(COMMENT))_"<>" S PRM=PRM_"CMNTIN="_$$HB($G(CMNTIN))_"<>" S PRM=PRM_"PELE="_$G(PELE)_"<>COMP="_$$HB($G(COMP))_"<>" S PRM=PRM_"FAX="_$G(FAX) I $L($G(EMAIL)) S PRM=PRM_"<>EMAIL="_$G(EMAIL) S PRM=PRM_"<>TZ="_$G(TZ) S PRM=PRM_"<>PRIVATE="_$G(KINDORD) ;;S ^AA("W3SETHD","PRM")=PRM ; D PUT2^W4L(NMB1,PRM) Q W3SETIDK W3SETIDK ; [ 05.08.23 06:05 ] [ 04.08.23 16:00 ] [ 03.08.23 16:20 ] ; --- %ARG("SETKIND")=1 - SET PRITIM TO B/L ; =2 - TO REPORT ; --- %ARG("SETKIND")=3 - SET PRITIM TO SALE N (JB,%ARG,SRCH) ;;W !,"W3SETIDK: SET="_$G(%ARG("SET"))_" MSD="_$G(%ARG("MSD")),! I '$G(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W3SETIDK","%ARG=[%ARG") I '$G(%ARG("SET")) Q I $G(%ARG("NEWSET")) Q ;;I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q ; ;;D NOSELECT^%W1JS ; D GL S SETKIND=$$SETKIND ; D PUT^%W1PRM("SET",%ARG("SET")) I $G(%ARG("SETKIND")) D PUT^%W1PRM("SETKIND",%ARG("SETKIND")) ; S SET=%ARG("SET") ; I $G(%ARG("FIRST")) D .D ..K @GL ..M @GL=@$$GLSET@(SET) ..I $G(%ARG("COPYSET")),$D(@GL)<10 D Q ...N HD S HD=$G(@GL) K @GL ...M @GL=@$$GLSET@(%ARG("COPYSET")) ...I HD'="" S $P(@GL,"\")=$P(HD,"\") . .I $$SETKIND=1 D ^W3CRSET ; W "
",! W "",! W " " W " " W "",! ; W " " W " ",! ; I SETKIND=1 D .W " " .W " ",! ; W " ",! ; I SETKIND=1 D .D GETTMPAI .I $D(@TMPAI)>9 D ..W " " ..W " " ..W "",! . .D CRGL1 .I $D(@$$^W4MAIN("TMPSET1"))<10 D ..W "" ..W " " .W " " ; W "
" I SETKIND=1 D .W $$^%W1DICT("SETITEMSTABLE") I SETKIND=2 D .W $$^%W1DICT("SETREPORTTABLE") I SETKIND=3 D .W $$^%W1DICT("SETITEMSTOSALE") W "
"_$$^%W1DICT("SETNAME")_" " W " " W " "_$$^%W1DICT("SETMAX")_"" .W " " .W "
" ..W $$^%W1DICT("SETINUSE")_" : " ..W " ",! ..W "
" .. W $$^%W1DICT("COPYFROM") W " " .. W "",! .. W " " .. W "" .. W "  " .. W "" ..W "
",! ; ; W $$^W4DVTBFX($S($$1024^W4WDSCR:80,1:90)_"%"),! W "",! W "",! W "" W "" W "" W "" I SETKIND=1 D .W "" .W "" I SETKIND=2!(SETKIND=3) D .W "" ; W "" ; I SETKIND=1 D .W "" W "",! W "",! ; N N,I D CRGL1 ; S NP="",I=0 F S NP=$O(@GL1@(NP)) Q:NP="" D .S N=$G(^(NP)) Q:N="" .S I=I+1 .W "" .W "" .W "",! . .W " ",! . .W "",! . .I SETKIND=1 D ..W "",! . .N ID S ID="chset"_N .N PROC S PROC="OnClickTbl('"_N_"','TblSet','trset','chset')" .D ^W4TDCHBX(ID,PROC) . .I SETKIND=1 D ..W "",! . .W "",! ; W "
#"_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("ADDPRICE")_""_$$^%W1DICT("QNDEF")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("DELETE")_" 
" . W " " .W " "_I_" "_N_"  " . W " "_$$H2U^%L1FRM($$SHEM^W4P(N))_"" .W "  " . I $$SETKIND=1 D ..N SZ S SZ=4 ;;I $$1024^W4WDSCR S SZ=3 .. W " " . I $$SETKIND=2!($$SETKIND=3) D .. W $J($$MH^W4P(N),2,2) .W "" ..W " " ..W "" ..N SZ S SZ=2 ;;I $$1024^W4WDSCR S SZ=1 .. W "" .. W " " .. W "" ..W "
",! W "
",! W "
",! Q ; ; GL S GL="^[$$^W3MAIN]TMPSET($$^%W1JB)" Q GL1 S GL1="^[$$^W3MAIN]TMPSET1($$^%W1JB)" Q GL2 S GL2="^[$$^W3MAIN]TMPSET2($$^%W1JB)" Q ; FIRSTGR(STAM) ; N N S N=$O(@$$GLSET@("")) Q N ; ; SAVE(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D GL N SET S SET=$$GET^%W1PRM("SET") I '$G(SET) Q 0 S SETKIND=$$SETKIND D PUT^%W3DEB("W3SETIDK-SAVE","PRM=PRM & SET=SET & SETKIND=SETKIND") ; I SETKIND=1 D .S ST=PRM .S CD=$$SPA^%L1FRM($P(ST,";")) .S MH=+$P(ST,";",3) .S QN=$$SPA^%L1FRM($P(ST,";",4)) .D SETMH(SET,CD,MH) .D SETQN(SET,CD,QN) ; Q 1 ; ; SAVEND(PRM) ; D PUT^%W3DEB("W3SETIDK-SAVEND","PRM=PRM") S PRM=$$CLEAR^%L1FRM(PRM) N SETNAME,MAX,SETKIND S SETNAME=$$CNWEB^%L1FRM($P(PRM,";")) S MAX=$P(PRM,";",2) N SET D GL,GL1 S SET=$$GET^%W1PRM("SET") I '$G(SET) Q 0 S SETKIND=$$SETKIND ; N GLSET S GLSET=$$GLSET I $D(@GL)<10 Q 0 K @GLSET@(SET) M @GLSET@(SET)=@GL N N S N="" F S N=$O(@GL@(N)) Q:N="" D .S @(GLSET_"I")@(N,SET)="" K @GL,@GL1 ; S @$$GLSET@(SET)=$$INVH^%L1FRM(SETNAME) ; I SETKIND=1 S $P(@$$GLSET@(SET),"\",2)=MAX I $D(@$$GLSET@(SET))<10 K @$$GLSET@(SET) ; I SETKIND=1 D UPDATE(SET) Q 1 ; ; SETMH(SET,CD,MH) S @$$^W4GL("MHSET")@(SET,CD)=$J(MH,2,2) Q ; SETQN(SET,CD,QN) S @$$^W4GL("QNSET")@(SET,CD)=QN Q ; UPDATE(SET) ; D UPD(SET,"P1EZA") D UPD(SET,"P1EZT") Q ; MVPR2KV(PRM) ; D PUT^%W3DEB("W3SETIDK-MVPR2KV","PRM=PRM") N SETKIND S SETKIND=$$SETKIND S PRM=$$CLEAR^%L1FRM(PRM) D GL D CRGL1 S PRM=$E(PRM,1,$L(PRM)-1) N SET S SET=$P(PRM,";") N QNMAX S QNMAX=$P(PRM,";",2) S PRM=$P(PRM,";",3,$L(PRM,";")) ;;W "SET="_SET_" PRM="_PRM,! N OK,NP S OK=0 I SET="" Q "0:NOSET" I PRM="" Q "0:NOPRM" ; S NP=$O(@GL1@(99999999),-1) I SETKIND=1 D .S $P(@GL,"\",2)=QNMAX ; N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .Q:'$D(@$$^W4GL("PAR")@(CD)) .S NP=NP+1,OK=1 CHKEX .I $$EXIST(NP,CD) S NP=NP+1 G CHKEX .S @GL@(CD)=NP .I SETKIND=1 S @GL1@(NP)=CD Q OK ; ; EXIST(NP,CD) N OK S OK=0 N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .I $G(^(N))=NP,N'=CD S OK=1 Q OK ; MVKV2PR(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D GL D CRGL1 S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q 0 N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .N NP S NP=+$G(@GL@(CD)) .K @GL@(CD) S OK=1 D CRGL1 Q OK ; GROUP ; W "",! Q ; ; SET ; N NEWSET S NEWSET=$$GETP^%W1PRM("NEWSET") W "",! Q ; ; NMSET(NN) Q $P($G(@$$GLSET@(NN)),"\") ; SETNMSET(VL) D GL S $P(@GL,"\")=$$INVH^%L1FRM(VL) Q 1 ; QNMAX(STAM) D GL Q $P($G(@GL),"\",2) ; SETQNMAX(VL) D GL S $P(@GL,"\",2)=VL Q 1 ; SETNAME(STAM) D GL Q $$H2U^%L1FRM($P($G(@GL),"\")) ; MHSET(SET,PAR) ; N A S A="" I $$SETKIND=1 D .S A=$G(@$$^W4GL("MHSET")@(SET,PAR)) .I 'A,$G(@$$^W4PRM@("MH2SET")) S A=$J($$MH^W4P(PAR),2,2) I $$SETKIND=2!($$SETKIND=3) S A=$J($$MH^W4P(PAR),2,2) I A="" Q " " Q A ; QNSET(SET,PAR) ; N A S A=$G(@$$^W4GL("QNSET")@(SET,PAR)) I A=0 Q " " Q A ; SWAP(CD,DRC) ; D CRGL1 S NST=$$GETPN(CD) S NST0=$O(@GL1@(NST),DRC) Q:'NST0 S CD0=$G(@GL1@(NST0)) S @GL1@(NST0)=CD S @GL1@(NST)=CD0 S @GL@(CD0)=NST S @GL@(CD0,"CUR")=1 S @GL@(CD)=NST0 S @GL1@(NST0,"CUR")=1 Q ; SWAPN(PRM) ; N (JB,%ARG,PRM) D CRGL1 S NST="" D CLEAR S NST=+PRM,NST0=$P(PRM,";",2) S PR=0 I NST0>NST S PR=1 G:'NST SWPNE G:'NST0 SWPNE S CD0=$G(@GL1@(NST0)) G:'CD0 SWPNE S OK=1 D ADD^%L1GSEQ(GL1,NST+'PR,CD0,OK) D DEL^%L1GSEQ(GL1,NST0+PR) S @GL1@(NST,"CUR")=1 S HD=$G(@GL) K @GL N CD S N="" F S N=$O(@GL1@(N)) Q:N="" D .S CD=$G(^(N)) Q:'CD .S @GL@(CD)=N ; S @GL@(CD0,"CUR")=1 S @GL=HD Q 1 ; SWPNE Q 0 ; GETPN(CD) ; D GL Q +$G(@GL@(CD)) ; CLEAR ; D GL1 N N S N="" F S N=$O(@GL1@(N)) Q:N="" K ^(N,"CUR") Q ; CRGL1 ; D GL,GL1,GL2 K @GL1,@GL2 N N,NP,I S I=1,NP=0 ; I $$SETKIND=2!($$SETKIND=3) D Q .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S NP=NP+1,@GL1@(NP)=N ; S N="" F S N=$O(@GL@(N)) Q:N="" D .S NP=+$G(^(N)) CC .I $D(@GL2@(NP)) S NP=NP+1 G CC .S @GL2@(NP)=N ; S I=0 S N="" F S N=$O(@GL2@(N)) Q:N="" D .N CD S CD=$G(^(N)) Q:CD="" .S I=I+1,@GL1@(I)=CD S @GL@(CD)=I ; K @GL2 Q ; ; UPD(SET,TREE) ; N N,N1,N2,NSET S N="" F S N=$O(@$$^W4GL(TREE)@(N)) Q:N="" D .S N1="" F S N1=$O(@$$^W4GL(TREE)@(N,N1)) Q:N1="" D ..I $E(N1)'="A" Q ..S NSET=$E(N1,2,7) Q:NSET="" Q:SET'=NSET ..S N2="" F S N2=$O(@$$^W4GL("P1SETA")@(SET,N2)) Q:N2="" D ...I $D(@$$^W4GL("MHSET")@(SET,N2)) S @$$^W4GL("MHT")@(N,N2)=@$$^W4GL("MHSET")@(SET,N2) ...I $D(@$$^W4GL("QNSET")@(SET,N2)) S @$$^W4GL("QNDEF")@(N,N2)=@$$^W4GL("QNSET")@(SET,N2) Q ; NEWSET(PRM) ; N CD,NM S CD=$P(PRM,";") S NM=$$INVH^%L1FRM($P(PRM,";",2)) I 'CD Q -1 I '$L(NM) Q -2 I $D(@$$GLSET@(CD)) Q -3 S @$$GLSET@(CD)=NM D PUT^%W1PRM("NEWSET",CD) Q 1 ; DELSET(PRM) ; N CD,NM S CD=$P(PRM,";") I 'CD Q -1 K @$$GLSET@(CD) Q 1 ; GETTMPAI ; S TMPAI=$$^W4MAIN("TMPAI") K @TMPAI N N S N="" F S N=$O(@$$^W4GL("P1EZA")@(N)) Q:N="" I $D(@$$^W4GL("P1EZA")@(N,"A"_SET)) S @TMPAI@(N)="" S N="" F S N=$O(@$$^W4GL("P1EZT")@(N)) Q:N="" I $D(@$$^W4GL("P1EZT")@(N,"A"_SET)) S @TMPAI@(N)="" Q ; GLSET(STAM) ; N SETKIND S SETKIND=$$SETKIND I SETKIND=1 Q $$^W4GL("P1SETA") I SETKIND=3 Q $$^W4GL("P1SETM") Q $$^W4GL("P1SET") ; SETKIND(STAM) ; I $G(%ARG("SETKIND")) Q %ARG("SETKIND") I $$GET^%W1PRM("SETKIND") Q $$GET^%W1PRM("SETKIND") Q 1 ; INIT ;-- IF FIRST K MSD D ^%W1ARG D CLR I $G(%ARG("MSD")) D PUT^%W1PRM("MSD",%ARG("MSD")) Q ; CLR ; D KILL^%W1PRM("SET") D GL,GL1,GL2 K @GL,@GL1,@GL2 D KILL^%W1PRM("NEWSET") Q ; CONFLICT(CD,SET) ; I $$SETKIND'=1 Q 0 N N,SETA,NSET,PRT,RES S N="",RES="" N P1EZA S P1EZA=$$^W4GL("P1EZA") N P1EZT S P1EZT=$$^W4GL("P1EZT") ; S RES=$$CONFL(P1EZA,CD,SET) S RES1=$$CONFL(P1EZT,CD,SET) S RES=RES_RES1 I $E(RES,$L(RES))="~" S RES=$E(RES,1,$L(RES)-1) Q RES ; CONFL(P1EZA,CD,SET) ; N N,SETA,NSET,RES S N="",RES=CD_"|" F S N=$O(@P1EZA@(N)) Q:N="" I $D(@P1EZA@(N,"A"_SET)) D .S SETA="" F S SETA=$O(@P1EZA@(N,SETA)) Q:SETA="" D ..S NSET=$E(SETA,2,20) Q:NSET="" ..I $D(@$$^W4GL("P1SETA")@(NSET,CD)),NSET'=SET S RES=RES_N_";"_NSET_"~" I RES'[";" S RES="" I $L(RES)>1 S RES=$E(RES,1,$L(RES)-1) Q RES ; WD1() ; I $$^W4TABLET=2 Q "51%" Q "53%" ; WD2() I $$^W4TABLET=2 Q "9%" Q "7%" ; WD3() Q "40%" W3SETVW W3SETVW(SET) ; [ 08.10.14 14:53 ] [ ; --- %ARG("SETKIND")=1 - SET PRITIM TO B/L ; =2 - TO REPORT ; --- %ARG("SETKIND")=3 - SET PRITIM TO SALE N (JB,%ARG,SET) I '$G(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W3SETIDK","%ARG=[%ARG") ; D GL S SETKIND=$$SETKIND ; D PUT^%W1PRM("SET",SET) I $G(%ARG("SETKIND")) D PUT^%W1PRM("SETKIND",%ARG("SETKIND")) ; K @GL M @GL=@$$GLSET@(SET) ; W "
",! W "",! W " " W " ",! W "",! ; W " " W " " ; I SETKIND=1 D .W " " .W " ",! ; W " ",! ; W "
" I SETKIND=1 D .W $$^%W1DICT("SETITEMSTABLE") I SETKIND=2 D .W $$^%W1DICT("SETREPORTTABLE") I SETKIND=3 D .W $$^%W1DICT("SETITEMSTOSALE") ; W "   " W "" W "
"_$$^%W1DICT("SETNAME")_" :" W " "_$$SETNAME_"" W " "_$$^%W1DICT("SETMAX")_"" .W $$QNMAX .W "
",! ; ; W "",! W "" W "" W "" I SETKIND=1 D .W "" .W "" I SETKIND=2!(SETKIND=3) D .W "" ; W "",! ; N N,I D CRGL1 ; S NP="",I=0 F S NP=$O(@GL1@(NP)) Q:NP="" D .S N=$G(^(NP)) Q:N="" .S I=I+1 .W "" . .W "",! . .W " ",! . .W "",! . .I SETKIND=1 D ..W "",! . .W "",! ; W "
"_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("ADDPRICE")_""_$$^%W1DICT("QNDEF")_""_$$^%W1DICT("PRICE")_"
 "_N_"  " . W " "_$$H2U^%L1FRM($$SHEM^W4P(N))_"" .W "  " . I $$SETKIND=1 D .. W $J($$MHSET(SET,N),2,2) . I $$SETKIND=2!($$SETKIND=3) D .. W $J($$MH^W4P(N),2,2) .W "" ..W $$QNSET(SET,N) ..W "
",! W "
",! Q ; ; GL S GL="^[$$^W3MAIN]TMPVW($$^%W1JB)" Q GL1 S GL1="^[$$^W3MAIN]TMPVW1($$^%W1JB)" Q GL2 S GL2="^[$$^W3MAIN]TMPVW2($$^%W1JB)" Q ; NMSET(NN) Q $P($G(@$$GLSET@(NN)),"\") ; QNMAX(STAM) D GL Q $P($G(@GL),"\",2) ; SETNAME(STAM) D GL Q $$H2U^%L1FRM($P($G(@GL),"\")) ; MHSET(SET,PAR) ; N A S A="" I $$SETKIND=1 S A=$G(@$$^W4GL("MHSET")@(SET,PAR)) I $$SETKIND=2!($$SETKIND=3) S A=$J($$MH^W4P(PAR),2,2) I A="" Q " " Q A ; QNSET(SET,PAR) ; N A S A=$G(@$$^W4GL("QNSET")@(SET,PAR)) I 'A Q " " Q A ; ; CRGL1 ; D GL,GL1,GL2 K @GL1,@GL2 N N,NP,I S I=1,NP=0 ; I $$SETKIND=2!($$SETKIND=3) D Q .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S NP=NP+1,@GL1@(NP)=N ; S N="" F S N=$O(@GL@(N)) Q:N="" D .S NP=+$G(^(N)) CC .I $D(@GL2@(NP)) S NP=NP+1 G CC .S @GL2@(NP)=N ; S I=0 S N="" F S N=$O(@GL2@(N)) Q:N="" D .N CD S CD=$G(^(N)) Q:N="" .S I=I+1,@GL1@(I)=CD S @GL@(CD)=I ; K @GL2 Q ; ; GETTMPAI ; S TMPAI=$$^W4MAIN("TMPAI") K @TMPAI N N S N="" F S N=$O(@$$^W4GL("P1EZA")@(N)) Q:N="" I $D(@$$^W4GL("P1EZA")@(N,"A"_SET)) S @TMPAI@(N)="" S N="" F S N=$O(@$$^W4GL("P1EZT")@(N)) Q:N="" I $D(@$$^W4GL("P1EZT")@(N,"A"_SET)) S @TMPAI@(N)="" Q ; GLSET(STAM) ; N SETKIND S SETKIND=$$SETKIND I SETKIND=1 Q $$^W4GL("P1SETA") I SETKIND=3 Q $$^W4GL("P1SETM") Q $$^W4GL("P1SET") ; SETKIND(STAM) ; I $G(%ARG("SETKIND")) Q %ARG("SETKIND") I $$GET^%W1PRM("SETKIND") Q $$GET^%W1PRM("SETKIND") Q 1 ; INIT ;-- IF FIRST K MSD D ^%W1ARG D CLR I $G(%ARG("MSD")) D PUT^%W1PRM("MSD",%ARG("MSD")) Q ; CLR ; D KILL^%W1PRM("SET") D GL,GL1,GL2 K @GL,@GL1,@GL2 D KILL^%W1PRM("NEWSET") Q ; W3SFHD W3SFHD ; [ 02.12.14 12:14 ] [ 07.12.10 20:44 ] [ 19.11.10 11:11 ] W "
",! W "",! W "",! N WEB S WEB=$$WEB^W3MAIN I WEB[".2order.org" S WEB="https://"_$P(WEB,"//",2,20) W " ",! W " ",! W " ",! W "",! W "
",! W "
",! Q W3SFLOGO W3SFLOGO ; [ 12.09.09 18:10 ] [ W "",! W " " W " " W " " W " " W " ",! W "
" W " " W " " W " " W " " W " " W "
",! W3SHM W3SHM(NMB) ; [ 11.02.12 04:33 ] [ 10.02.12 21:13 ] [ 04.02.12 18:10 ] S NMB=$G(NMB) N IND S IND="W3SHM"_NMB W "",! W "",! W "
",! N I F I=1:1 Q:'$D(^[$$^W3MAIN]SHP(IND,I)) D .N A S A=$$H2U^%L1FRM(^[$$^W3MAIN]SHP(IND,I)) .S A=$$RPL^%L1FRM(A,""," ") .S A=$$RPL^%L1FRM(A,"<>","•") .S A=$$RPL^%L1FRM(A,"","") .S A=$$RPL^%L1FRM(A,"","") .I A["LEV1957@GMAIL.COM" S A=$$FUNC^%LCASE(A) .W A,"
",! W "
",! Q W3SHOWFR W3SHOWDR(PAR) ; [ 23.01.14 18:32 ] [ N (JB,%ARG,%REM,PAR) W "
",! W "
",! W "" W PAR_" "_$$H2U^%L1FRM($$SHEM^W4P(PAR)) W "",! W "

",! ; W "",! S N="" F S N=$O(@$$^W4GL("P1EZI")@(PAR,N)) Q:N="" D .W "" . W "" . W "" . W "" .W "",! W "
"_N_""_$$H2U^%L1FRM($$SHEM^W4P(N))_""_$J($$MH^W4P(PAR),2,2)_"
",! ; W "
",! W "",! W "
",! Q W3SHOWHN W3SHOWHN ; [ 12.02.17 13:21 ] [ N (JB,%ARG) S TSHL=$$TSHL^W3HZMST(JB) S HNH=$$HNH^W3HZMST(JB) S HNHAH=$$AHUZ^W3HZMST(JB) S WD=60 ; W "
",! S STYLE="font-size:"_$$^W3FSZ(16)_";"_$$FONTFM^W3CSS S TX=$$^%W1DICT("SHNH",$J(HNH,2,2)) D ^W4SPAN($$^%W1DIR,STYLE,TX) ; I $$HNH2^W3HZMST(JB) D .N HNH2 S HNH2=$$HNH2^W3HZMST(JB) .W "

" .S STYLE="font-size:"_$$^W3FSZ_";"_$$FONTFM^W3CSS .S TX=$$^%W1DICT("HNH2",$J(HNH2,2,2)) .D ^W4SPAN($$^%W1DIR,STYLE,TX) ; I HNHAH D .W "

" .W "",! .W "" . .W "",! . W "" . W "" . W "" . .I $G(@$$^W4TMPORD@("HNH"))'?.P D . W "" . W "" .W "",! . .W "",! . N TOTHN S TOTHN=$$TOTHN . W "",! . W "",! . W "",! . S WHO1="",SIBA1="" . . I $G(@$$^W4TMPORD@("HNH"))'?.P D . .N A,WHO,SIBA1 S A=$G(^("HNH")) . .S WHO=$P(A,"*",2) . .S SIBA1=$P(A,"*",4) . .S WHO1=$$H2U^%L1FRM($$^W4NAME(WHO)) .W "" .W "" .W "",! .W "
" . W $$^%W1DICT("INCLUDEPERCENTDISC") .W "
"_$$^%W1DICT("BEFOREDISC")_""_$$^%W1DICT("DISCPERCENT")_""_$$^%W1DICT("HOWMUCHDISC")_""_$$^%W1DICT("WHOSUBMNM")_""_$$^%W1DICT("CAUSEDISC")_"
"_$J(TOTHN,2,2)_""_HNHAH_""_$J(TOTHN*HNHAH*.01,2,2)_""_$$H2U^%L1FRM(WHO1)_""_$$H2U^%L1FRM(SIBA1)_"
",! ; S SLKHNH=$J($$SLKHNH,2,2) ; I SLKHNH D .W "
",! .W "" . W $$^%W1DICT("SLKHNH",$J(SLKHNH,2,2)) .W "",! . .W "
",! .W "" . W $$^%W1DICT("SLKHNHDETAILS") .W "",! ; W "

",! S SHNH1=$J($$SHNH1,2,2) W "" W $$^%W1DICT("SHNH1",SHNH1)_"",! W "",! W "
",! Q ; TOTHN(STAM) ; Q $$TOTORD^W4GETSUM(JB,"D") ; SLKHNH(STAM) ; N SHNH,LKHNH S SHNH=0 N N S N="" F S N=$O(@$$^W4TMPORD@("CB","ASR",N)) Q:N="" D .S A=$G(^(N)) .S LKHNH=$P(A,"*",3) .S SHNH=SHNH+LKHNH Q SHNH ; SHNH1(STAM) ; N SHNH1,HNH1 S SHNH1=0 N N S N="" F S N=$O(@$$^W4TMPORD@("CB","HNH1",N)) Q:N="" D .S HNH1=+$G(^(N)) .S SHNH1=SHNH1+HNH1 Q SHNH1 W3SHOWKV W3SHOWKV(NN) ; [ 07.11.22 07:25 ] [ 10.08.21 12:03 ] [ 26.06.18 14:26 ] N (JB,%ARG,NN,W4ABC) N NMGL S NMGL=$G(W4ABC("GL")) I NMGL="" S NMGL="PARSUG" I NMGL="" Q "" I NMGL'="PARSUG" Q $$H2U^%L1FRM($G(@$$^W4GL(NMGL)@(NN))) ; N SKOB1,SKOB2 S (SKOB1,SKOB2)=" " I '$$^W4VWGR(NN) S SKOB1="[ ",SKOB2=" ]" Q SKOB1_$$H2U^%L1FRM($G(@$$^W4GL("PARSUG")@(NN)))_SKOB2 W3SHOWTS W3SHOWTS(CODTS,PRTS) ; [ 11.10.20 19:07 ] [ 16.01.20 14:12 ] [ 04.04.18 19:51 ] I CODTS=1 Q $$^%W1DICT("CASH") I CODTS=2 Q $$^%W1DICT("CHECK") I CODTS=3,$D(W3SHOWTS("CA")) Q $$^%W1DICT("CA") I CODTS=3 Q $$^%W1DICT("CRCARD") I CODTS=4,$G(PRTS) Q $$^%W1DICT("BANKMOVING") I CODTS=4 Q $$^%W1DICT("CREDIT") I CODTS=5 Q $$^%W1DICT("CIBUS") I CODTS=6 Q $$^%W1DICT("COUPONPHONE") I CODTS=7 Q $$^%W1DICT("TENBIS") I CODTS=9 Q $$^%W1DICT("PICUL") I CODTS=13 Q $$^%W1DICT("MSHCA") I CODTS="-" Q $$^%W1DICT("HZMH") Q "" ; ; V(VD) ; I VD=1 Q "hxw`xyi" I VD=2 Q "dfie" I VD=3 Q "qxpiic" I VD=4 Q "qxtqw` .n`" I VD=6 Q "cxw ine`l" Q "" W3SIDKV0 W3SIDKVZ ; [ 17.03.12 07:09 ] [ 03.08.10 20:51 ] [ 17.06.10 09:58 ] ; INPUT: ; KVZ ; LCOD ; ---------------------- SIDUR LEFI KVUZOT --------- N N,N1,I S I=0 K @$$^W4MAIN("TMPTF") ; I $D(@$$^W4GL("P1KVZSID"))>9 D G END .N NP,KV,MMM S NP="",I=0 F S NP=$O(@$$^W4GL("P1KVZSID")@(NP)) Q:NP="" D ..S KV=$G(^(NP)) Q:KV="" ..N N S N=KV ..D SETTMPF(KV) ..S MMM(KV)="" . .S N="" F S N=$O(@KVZ) Q:N="" I '$D(MMM(N)) D ..D SETTMPF(N) ; I $G(@$$^W4PRM@("HFNUM")) D G END ; SEDER NUMERI .S N="" F S N=$O(@KVZ) Q:N="" D SETTMPF(N) ; I KVZ["^[$$^W3MAIN]PARCAT" D G ES ; -- MIUN A-B .D INV("^[$$^W3MAIN]PARCAT($$^%W1JB)",$$^W4GL("PARSUG")) ; D INV($P(KVZ,"("),$$^W4GL("PARSUG")) G ES ; ES S N="" F S N=$O(@$$^W4MAIN("TMPTF1")@(N)) Q:N="" S N1=$G(^(N)) I N1 D .D SETTMPF(N1) ; K @$$^W4MAIN("TMPTF1") END Q ; ; INV(KVZ,GL) ; --- SIDUR A-B K @$$^W4MAIN("TMPTF1") N N1,N2,IND S N1="" F S N1=$O(@KVZ@(N1)) Q:N1="" D .S N2=N1 .I KVZ["P1TFR",GL=$$^W4GL("PAR") S N2=$P($G(^(N1)),"\") .N OK S OK=0 .I $L(N2),'$G(@$$^W4GL("P1PRM")@("TSF")),GL=$$^W4GL("PAR") D Q:OK ..I $D(@$$^W4GL("P1EZTI")@(N2))!$D(@$$^W4GL("P1EZAI")@(N2))!$D(@$$^W4GL("P1EZ")@(N2))!$D(@$$^W4GL("P1EZK")@(N2))!$D(@$$^W4GL("P1EZRI")@(N2))!$D(@$$^W4GL("P1SETAI")@(N2)),'$$MH^W4P(N2) S OK=1 Q .I $L(N2),GL=$$^W4GL("PAR"),$D(@$$^W4GL("PRTNO")@(N2)) Q .N NM S NM=$P($G(@GL@(N2)),"**"),NM=$E(NM,$L(NM)-9,255) .S IND=$$INV^%L1FRM($TR(NM," ","")) .S IND=IND_$J("",10-$L(IND))_N2 .S @$$^W4MAIN("TMPTF1")@(IND)=N2 Q ; SUGNAME(KV) ; Q $$HBR^%L1FRM($$SUGN(KV),20) ; SUGN(KV) ; N SUGN S SUGN=$G(@$$^W4GL("PARSUG")@(KV)) I SUGN["()" S SUGN=$$RPL^%L1FRM(SUGN,"()","") ; -- PIZZA Q SUGN ; SETTMPF(KV) ; I $D(@KVZ)<10,'$$PODZAG^W3HZTFR($$SUGNAME(KV)) Q I $$NOSUG^W3HZTFR(KV) Q I $$SUGNAME(KV)?." " Q S I=I+1,@$$^W4MAIN("TMPTF")@(1,I)=$$SUGNAME(KV)_" "_$J(KV,LCOD) S @$$^W4MAIN("TMPTF")@(1,I,"KV")=KV Q W3SIDKVZ W3SIDKVZ ; [ 26.07.23 17:18 ] [ 19.01.21 14:47 ] [ 13.10.19 15:25 ] ; INPUT: ; KVZ ; LCOD ; ---------------------- SIDUR LEFI KVUZOT --------- N N,N1,I S I=0 K @$$^W4MAIN("TMPTF") ; D G END .N NP,KV,MMM S NP="",I=0 F S NP=$O(@$$^W4GL("P1KVZSID")@(NP)) Q:NP="" D ..S KV=$G(^(NP)) Q:KV="" ..I '$D(@KVZ@(KV)) Q ..I '$D(W3PRTPC),'$$GETP^%W1PRM("W4BO"),$$FASTGR^W4HD,'$$FULLHD^W4HD,$D(@$$^W4GL("W4FASTGR")@(KV)) Q ..N N S N=KV ..D SETTMPF(KV) ..S MMM(KV)="" .; .S N="" F S N=$O(@KVZ@(N)) Q:N="" I '$D(MMM(N)) D ..D SETTMPF(N) END Q ; ; SUGNAME(KV) ; Q $$HBR^%L1FRM($$SUGN(KV),20) ; SUGN(KV) ; N SUGN S SUGN=$G(@$$^W4GL("PARSUG")@(KV)) I SUGN["()" S SUGN=$$RPL^%L1FRM(SUGN,"()","") ; -- PIZZA Q SUGN ; SETTMPF(KV) ; I $E(KV,1,2)="<>" D Q .I $D(W3PRTPC) Q .I $$GETP^%W1PRM("W4BO") Q .S I=I+1 .N CD S CD=$$FINDFAST($E(KV,3,10)) Q:'CD .S @$$^W4MAIN("TMPTF")@(1,I)=$$SHEM^W4P(CD)_" "_$J(CD,6) .S @$$^W4MAIN("TMPTF")@(1,I,"KV")=KV ; I $$CATOLD^W4PRM,$D(@KVZ@(KV))<10,'$$PODZAG^W3HZTFR($$SUGNAME(KV)) Q I $$NOSUG^W3HZTFR(KV) Q I $$SUGNAME(KV)?." " Q S I=I+1,@$$^W4MAIN("TMPTF")@(1,I)=$$SUGNAME(KV)_" "_$J(KV,LCOD) S @$$^W4MAIN("TMPTF")@(1,I,"KV")=KV Q ; ; INV(KVZ,GL,KV) ; --- SIDUR A-B K @$$^W4MAIN("TMPTF1") N N1,N2,IND S N1="" F S N1=$O(@KVZ@(KV,N1)) Q:N1="" D .S N2=N1 .I KVZ["P1TFR",GL=$$^W4GL("PAR") S N2=$P($G(^(N1)),"\") .N OK S OK=0 .I $L(N2),'$G(@$$^W4GL("P1PRM")@("TSF")),GL=$$^W4GL("PAR") D Q:OK ..I $D(@$$^W4GL("P1EZTI")@(N2))!$D(@$$^W4GL("P1EZAI")@(N2))!$D(@$$^W4GL("P1EZ")@(N2))!$D(@$$^W4GL("P1EZK")@(N2))!$D(@$$^W4GL("P1EZRI")@(N2))!$D(@$$^W4GL("P1SETAI")@(N2)),'$$MH^W4P(N2) S OK=1 Q .I $L(N2),GL=$$^W4GL("PAR"),$$NL^W4PRTVW(N2) Q .N NM S NM=$P($G(@GL@(N2)),"**"),NM=$E(NM,$L(NM)-9,255) .S IND=$$INV^%L1FRM($TR(NM," ","")) .S IND=IND_$J("",10-$L(IND))_N2 .S @$$^W4MAIN("TMPTF1")@(IND)=N2 Q ; FINDFAST(NIT) ; I $G(NIT)>10000 S NIT=NIT-10000 N OK S OK=0 N N S N="" F S N=$O(@$$^W4GL("W4ITFAST")@(N)) Q:N="" D Q:OK .I $G(^(N))=NIT S OK=N Q OK W3SITE W3SITE ; [ 03.02.12 14:26 ] [ 29.01.12 07:17 ] [ 11.04.09 18:36 ] N BGH,NMB S BGH="CC0000" S PR800=$$GET^%W1PRM("PR800") ;;S $ZGBLDIR=$$^W3MAIN D KILL^%W3DEB("W3SITE") W "
",! S LNG=$G(%W1LNG) I LNG="H" S LNG="" D CHAPTER("1"_LNG,"ABOUTUS","w3sint.jpg") W "

",! D CHAPTER("2"_LNG,"ABOUTPRODUCT","w3sdisk.jpg") W "

",! D CHAPTER("3"_LNG,"DEMO","w3skb.jpg") W "

",! I $G(%W1LNG)'="E" D .D CHAPTER("4"_LNG,"FAQ","w3slsn.jpg") .W "

",! D CHAPTER("5"_LNG,"CONTACTUS","w3scnt.jpg") W "

",! W "
",! Q CHAPTER(NMB,HEADER,PIC) ; N BGCV S BGCV=$P($$BGBODY^W3CSS($$COLOR^W3CSS),":",2) W "",! W "",! W "",! W "",! W "",! W ! W "",! W "",! W "
",$$^%W1DICT(HEADER),"
",! D PUT^%W3DEB("W3SITE","NMB=NMB") N I F I=1:1 Q:'$D(^[$$^W3MAIN]SHP("SITE"_NMB,I)) D .N A S A=$$H2U^%L1FRM(^[$$^W3MAIN]SHP("SITE"_NMB,I)) .S A=$$RPL^%L1FRM(A,""," ") .S A=$$RPL^%L1FRM(A,"","") .S A=$$RPL^%L1FRM(A,"","") .I A["LEV1957@GMAIL.COM" S A=$$FUNC^%LCASE(A) .W A,"
",! I HEADER="DEMO" D .W "

",! .W "" ; W "		" I HEADER="DEMO" W "" S WD=400,HG=600 I PR800 S WD=300,HG=450 W "",! I HEADER="DEMO" W "" W "
",! Q W3SNDHM0 W3SNDHMH ; [ 13.11.16 10:11 ] [ 13.03.15 13:09 ] [ 24.02.15 09:59 ] N (JB,%ARG,%REM) W "
",! ; W ""_$$^%W1DICT("CHOICEKINDOFSENDING")_"",! W "

",! ; W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " " W " ",! W " " W " ",! W " ",! W " ",! ; W "
"_$$^%W1DICT("FAX")_"
"_$$^%W1DICT("EMAIL")_"
 "_$$^%W1DICT("WITHADDS")_"
 "_$$^%W1DICT("SENDMENU")_"
 "_$$^%W1DICT("SENDKASHRUT")_"
" W $$^%W1DICT("COMMENTS"),"
",! W "" W "
 
"_$$^%W1DICT("NOSEND")_"
",! W "
",! W " ",! W "",! W "",! W "
" D ROUNDBUT^%W1JS("submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") W "
",! W "
",! Q ; SNDFAX(FAX) ; N MSD,HZ,DET S DET=0 I FAX[";" S DET=$P(FAX,";",3),FAX=$P(FAX,";") S FAX=$TR(FAX,"- ","") S HZ=$$GET^%W1PRM("ORD") I 'HZ Q "NOTORDERNUMBER" I $L(FAX)<7!(FAX'?1N.N) Q "FAXNUMBERISWRONG" ; D PUT^W3HZMST(HZ,"FAX",FAX,$$^W3ORD) S MSD=$$MSD^W3HZMST(HZ) I 'MSD Q "RESTNOTEXIST" S @$$^W3ORD(HZ)@(HZ,"DBF")="2\"_$H D ^W3FAXHTM(HZ,MSD,"2-"_DET) D ^W3REGFAX(HZ) S ^[$$^W3MAIN]W3TSTORD(HZ)=MSD_"\"_$H_"\F" Q 1 ; SNDMAIL(PRM) ; N HZ,MSD,ZSY,ISHUR S HZ=$$GET^%W1PRM("ORD") I 'HZ Q "NOTORDERNUMBER" S MSD=$$MSD^W3HZMST(HZ) I 'MSD Q "RESTNOTEXIST" S ISHUR=$P(PRM,";",6) N TOT S TOT=$$TOTORD^W3HZMST(HZ,"",$$^W3ORD) ; I '$$^W3PRCOFR(HZ),TOT>0 S ISHUR=1 I $$^W3PRCOFR(HZ),TOT'>0 S ISHUR=0 ; S ZSY=$$SNDM(MSD,HZ,PRM,ISHUR) I 'ZSY S:ISHUR'?1N @$$^W3ORD(HZ)@(HZ,"EMAIL")=$H Q 1 Q "ERROR : "_ZSY ; ; SNDM(MSD,HZ,PRM,ISHUR) ; D PUT^%W3DEB("W3SNDHMH-SNDM","MSD=MSD&HZ=HZ&PRM=PRM") N SNIF,HZRSD,MKBL,MKBN S SNIF="" I $G(HZ) S SNIF=$G(@$$^W3ORD(HZ)@(HZ,"SNIF")) I MSD=1 S SNIF=$S(SNIF=1:1000,1:1001) S (HZRSD,MKBL,MKBN)="" I $G(HZ) D .S HZRSD=$G(@$$^W3ORD(HZ)@(HZ,"HZRSD")) .S MKBL=$P($G(@$$^W3ORD(HZ)@(HZ)),"~",18) .S MKBN=$G(@$$^W3ORD(HZ)@(HZ,"MKBN")) .S MKBN=$P(MKBN,";",2) ; N MSG,EMAIL,LINK,FROM,SMTP,USER,PSW,FILE,LOGO,DET N SNDMENU,KASHRUT,TXT,HDMAIL ; S EMAIL=$P(PRM,";") S EMAIL=$$CNWEB^%L1FRM(EMAIL) S LINK=$P(PRM,";",2) S LINK=$$CNWEB^%L1FRM(LINK) S DET=$P(PRM,";",3) S SNDMENU=$P(PRM,";",4) S KASHRUT=$P(PRM,";",5) S TXT=$$CNWEB^%L1FRM($P(PRM,";",7)) S LINK=LINK_"&COMPRVIEW="_'DET S ^AL(JB,"PRM")=EMAIL_"\"_LINK_"\"_HZ_"\"_MSD_"\"_DET_"\"_ISHUR_"\"_SNDMENU_"\"_KASHRUT I $G(ISHUR)'?1N D .D PUT^W3HZMST(HZ,"EMAIL",EMAIL,$$^W3ORD) S FROM=$P($$EMAIL^W3R(MSD),",") S SMTP=$$SMTP^W3R(MSD) ;"out.bezeqint.net" S USER=$$USER^W3R(MSD) ;"sfactory@5666666.co.il" S PSW=$$PSWMAIL^W3R(MSD) ;"s5858585" ;;S LOGO=$$LOGO^W3R(MSD) ;"w3sflogo.jpg" S LOGO="w3sfsite.jpg" S HDMAIL=$$HDMAIL^W3R(MSD) ;"w3sflogo.jpg" I HDMAIL="" S HDMAIL="Bid" I MSD=1 S HDMAIL="Hazaat mahir online" D ^%L1TS ;;S HDMAIL=HDMAIL_"-"_HZ_" ( "_HZRSD_" ) "_MKBN S HDMAIL=HDMAIL_" "_HZRSD_" "_MKBN S KASHRUTFILE="http://www.sandwich-factory.co.il/images/kosher.pdf" ; S FILE="/tmp/sndmail"_$G(JB) O FILE:(NEWVERSION:REWIND:WRITE) U FILE I MSD=1 D SFHEAD I MSD'=1 D HEAD C FILE ; I SNDMENU D MENUFILE ; S MSG="/pos/sbin/smail.py -m """_SMTP_""" -u """_USER_""" -p """_PSW_""" -j """_HDMAIL_""" -s """_FROM_""" -y """_FROM_""" -r """_EMAIL_""" -b """_FILE_"""" ; I SNDMENU D .S MSG=MSG_" -a """_MENUFILE_"""" ; S ^AL(JB,"MSG")=$E(MSG,1,800) zsy MSG S ^AL(JB,"ZSY")=$ZSY Q $ZSY ; ; ORDCONTENT(ORD) ; N (%ARG,%REM,ORD,TSTORD,DET,JB) S W3FAXHTM=1,W3FAXHTM("SNDMAIL")="" S W3ORDLS=ORD S VW=1 I $P($G(TSTORD),"-",2)=0!'$G(DET) S VW=1.5,COMPRVIEW=1,W3FAXHTM("COMPRESS")="" D ^W3ORDVW(VW) Q ; ; MENUFILE ; S MENUFILE="/tmp/sndmenu"_$G(JB)_".html" I $G(ISHUR)?1N Q O MENUFILE:(NEWVERSION:REWIND:WRITE) U MENUFILE W "" N %ARG S %ARG("MSD")=MSD S %ARG("CDKV")="ALL" S %ARG("SNDMAIL")=1 D ^W3PRTPC W "",! C MENUFILE Q ; CMNT(TXT) ; N ST S ST="
" S ST=ST_$$H2U^%L1FRM(TXT)_"" Q ST ; SFSITE(IMG) ; N WEB S WEB=$$WEB^W3MAIN W " " W " " W " ",! Q ; SFTBL ; W "",! Q ; SFHEAD ; W "" W "
" N CLICK S CLICK=$$^%W1DICT("CLICKTHEBID") I ISHUR S CLICK=$$^%W1DICT("CLICKCONFIRM") ; N IMGSIZE S IMGSIZE=" width=""150px"" height=""50px"" " ; N WEB S WEB=$$WEB^W3MAIN ; D SFTBL W "
" ; W "",! ; D SFHDHMH W "",! ; W "" D SFHDMENU ; D SFHDKASHRUT ; D SFHDCATERING W "",! ; W "",! D SFHDORD ; D SFHDSITE ; D SFHDMAIL W "",! ; W "" W "" w "",! ; W "
",! ; 3 W "" W "
" ; 6 W "" w "
",! ; S TXT=$$INVH^%L1FRM(TXT) S TXT=$TR(TXT,"_",$C(10)) S TXT=$TR(TXT,$C(9),$C(10)) ; I ISHUR=1 D .I $$^%W1LNG="H" D ..W $$CMNT("! dxye` mkly dpnfd ") ..W $$CMNT("! ixehwt 'uieecpqn dax dcez") ; I ISHUR=0 D .I $$^%W1LNG="H" D ..W $$CMNT("! dlhea dpnfd ") ..;;W $$CMNT(TXT_" : daiqn") ; I ISHUR'?1N D .W $$CMNT(TXT) ; D ORDCONTENT(HZ) ; W "",! W "",! Q ; SFHDHMH ; W "",! W "" W "" W "",! W "",! Q ; SFHDMENU ; W "",! W "" W "" W "",! W "",! Q ; ; SFHDKASHRUT ; W "",! W " " W "" W " ",! W "",! Q ; ; SFHDCATERING ; W "",! W "" W "" W "",! W "",! Q ; ; SFHDORD ; W "",! W "" W "" W "",! W "",! Q ; SFHDSITE ; W "",! I WEB[".2order.org" S WEB="https://"_$P(WEB,"//",2,20) D SFSITE("w3sfsite.jpg") W "",! Q ; SFHDMAIL ; W "",! W "" W "" W "",! W "",! Q ; HEAD ; W "" W "
" N CLICK S CLICK=$$^%W1DICT("CLICKTHEBID") I ISHUR S CLICK=$$^%W1DICT("CLICKCONFIRM") W ""_CLICK_"",! W "
" W ""_$$^%W1DICT("CLICKTOORDERONLINE")_"",! ;I KASHRUT D W "
" W ""_$$^%W1DICT("SHOWKASHRUTFILE")_"" W "
",! W ""_$$^%W1DICT("SHOWWEBMENU")_"" W "
",! W ""_$$^%W1DICT("SHOWWEBSITE")_"" W "
",! I $$^W3PRCOFR(HZ) D .W ""_$$H2U^%L1FRM("o`k ugl bpixhiiw zwlgn zbvnl")_"" W "
",! ; I $L(LOGO) D .N WEB S WEB=$$WEB^W3MAIN .I WEB[".2order.org" S WEB="https://"_$P(WEB,"//",2,20) .W "
",! ; ; S TXT=$$INVH^%L1FRM(TXT) S TXT=$TR(TXT,"_",$C(10)) S TXT=$TR(TXT,$C(9),$C(10)) ; I ISHUR=1 D .I $$^%W1LNG="H" D ..W $$CMNT("! dxye` mkly dpnfd ") ..W $$CMNT("! ixehwt 'uieecpqn dax dcez") ; I ISHUR=0 D .I $$^%W1LNG="H" D ..W $$CMNT("! dlhea dpnfd ") ..;;W $$CMNT(TXT_" : daiqn") ; I ISHUR'?1N D .W $$CMNT(TXT) ; D ORDCONTENT(HZ) W "
",! W "",! Q W3SNDHMH W3SNDHMH ; [ 20.03.25 13:57 ] [ 13.08.19 09:33 ] [ 08.09.17 13:30 ] N (JB,%ARG,%REM) W "
",! ; W ""_$$^%W1DICT("CHOICEKINDOFSENDING")_"",! W "

",! ; W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " ",! W " ",! W " " W " " W " ",! W " " W " ",! W " ",! W " ",! ; W "
"_$$^%W1DICT("FAX")_"
"_$$^%W1DICT("EMAIL")_"
 "_$$^%W1DICT("WITHADDS")_"
 "_$$^%W1DICT("SENDMENU")_"
 "_$$^%W1DICT("SENDKASHRUT")_"
" W $$^%W1DICT("COMMENTS"),"
",! W "" W "
 
"_$$^%W1DICT("NOSEND")_"
",! W "
",! W " ",! W "",! W "",! W "
" D ROUNDBUT^%W1JS("submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") W "
",! W "
",! Q ; SNDFAX(FAX) ; N MSD,HZ,DET S DET=0 I FAX[";" S DET=$P(FAX,";",3),FAX=$P(FAX,";") S FAX=$TR(FAX,"- ","") S HZ=$$GET^%W1PRM("ORD") I 'HZ Q "NOTORDERNUMBER" I $L(FAX)<7!(FAX'?1N.N) Q "FAXNUMBERISWRONG" ; D PUT^W3HZMST(HZ,"FAX",FAX,$$^W3ORD) S MSD=$$MSD^W3HZMST(HZ) I 'MSD Q "RESTNOTEXIST" S @$$^W3ORD(HZ)@(HZ,"DBF")="2\"_$H D ^W3FAXHTM(HZ,MSD,"2-"_DET) D ^W3REGFAX(HZ) S ^[$$^W3MAIN]W3TSTORD(HZ)=MSD_"\"_$H_"\F" Q 1 ; SNDMAIL(PRM) ; N HZ,MSD,ZSY,ISHUR S HZ=$$GET^%W1PRM("ORD") I 'HZ Q "NOTORDERNUMBER" S MSD=$$MSD^W3HZMST(HZ) I 'MSD Q "RESTNOTEXIST" S ISHUR=$P(PRM,";",6) N TOT S TOT=$$TOTORD^W3HZMST(HZ,"",$$^W3ORD) ; I '$$^W3PRCOFR(HZ),TOT>0 S ISHUR=1 I $$^W3PRCOFR(HZ),TOT'>0 S ISHUR=0 ; S ZSY=$$SNDM(MSD,HZ,PRM,ISHUR) I 'ZSY S:ISHUR'?1N @$$^W3ORD(HZ)@(HZ,"EMAIL")=$H Q 1 Q "ERROR : "_ZSY ; ; SNDM(MSD,HZ,PRM,ISHUR) ; D PUT^%W3DEB("W3SNDHMH-SNDM","MSD=MSD&HZ=HZ&PRM=PRM") N SNIF,HZRSD,MKBL,MKBN S SNIF="" I $G(HZ) S SNIF=$G(@$$^W3ORD(HZ)@(HZ,"SNIF")) I MSD=1 S SNIF=$S(SNIF=1:1000,1:1001) S (HZRSD,MKBL,MKBN)="" I $G(HZ) D .S HZRSD=$G(@$$^W3ORD(HZ)@(HZ,"HZRSD")) .S MKBL=$P($G(@$$^W3ORD(HZ)@(HZ)),"~",18) .S MKBN=$G(@$$^W3ORD(HZ)@(HZ,"MKBN")) .S MKBN=$P(MKBN,";",2) ; N MSG,EMAIL,LINK,FROM,SMTP,USER,PSW,FILE,LOGO,DET N SNDMENU,KASHRUT,TXT,HDMAIL ; S EMAIL=$P(PRM,";") S EMAIL=$$CNWEB^%L1FRM(EMAIL) S LINK=$P(PRM,";",2) S LINK=$$CNWEB^%L1FRM(LINK) S DET=$P(PRM,";",3) S SNDMENU=$P(PRM,";",4) S KASHRUT=$P(PRM,";",5) S TXT=$$CNWEB^%L1FRM($P(PRM,";",7)) S LINK=LINK_"&COMPRVIEW="_'DET S ^AL(JB,"PRM")=EMAIL_"\"_LINK_"\"_HZ_"\"_MSD_"\"_DET_"\"_ISHUR_"\"_SNDMENU_"\"_KASHRUT I $G(ISHUR)'?1N D .D PUT^W3HZMST(HZ,"EMAIL",EMAIL,$$^W3ORD) S FROM=$P($$EMAIL^W3R(MSD),",") S SMTP=$$SMTP^W3R(MSD) ;"out.bezeqint.net" S USER=$$USER^W3R(MSD) ;"sfactory@5666666.co.il" S PSW=$$PSWMAIL^W3R(MSD) ;"s5858585" ;;S LOGO=$$LOGO^W3R(MSD) ;"w3sflogo.jpg" S LOGO="w3sfsite.jpg" S HDMAIL=$$HDMAIL^W3R(MSD) ;"w3sflogo.jpg" I HDMAIL="" S HDMAIL="Bid" I MSD=1 S HDMAIL="Hazaat mahir online" I $$SF^W4PRM S HDMAIL="Order" D ^%L1TS ;;S HDMAIL=HDMAIL_"-"_HZ_" ( "_HZRSD_" ) "_MKBN S HDMAIL=HDMAIL_" "_HZRSD_" "_MKBN S KASHRUTFILE="http://www.sandwich-factory.co.il/images/kosher.pdf" ; S FILE="/tmp/sndmail"_$G(JB) O FILE:(NEWVERSION:REWIND:WRITE) U FILE D HEAD ;;I MSD=1 D SFHEAD ;;I MSD'=1 D HEAD C FILE ; I SNDMENU D MENUFILE ; S MSG="/pos/sbin/smail.py -m """_SMTP_""" -u """_USER_""" -p """_PSW_""" -j """_HDMAIL_""" -s """_FROM_""" -y """_FROM_""" -r """_EMAIL_""" -b """_FILE_"""" ; I SNDMENU D .S MSG=MSG_" -a """_MENUFILE_"""" ; S ^AL(JB,"MSG")=$E(MSG,1,800) zsy MSG S ^AL(JB,"ZSY")=$ZSY Q $ZSY ; ; ORDCONTENT(ORD) ; N (%ARG,%REM,ORD,TSTORD,DET,JB) S W3FAXHTM=1,W3FAXHTM("SNDMAIL")="" S W3ORDLS=ORD S VW=1 I $P($G(TSTORD),"-",2)=0!'$G(DET) S VW=1.5,COMPRVIEW=1,W3FAXHTM("COMPRESS")="" D ^W3ORDVW(VW) Q ; ; MENUFILE ; S MENUFILE="/tmp/sndmenu"_$G(JB)_".html" I $G(ISHUR)?1N Q O MENUFILE:(NEWVERSION:REWIND:WRITE) U MENUFILE W "" N %ARG S %ARG("MSD")=MSD S %ARG("CDKV")="ALL" S %ARG("SNDMAIL")=1 D ^W3PRTPC W "",! C MENUFILE Q ; CMNT(TXT) ; N ST S ST="
" S ST=ST_$$H2U^%L1FRM(TXT)_"" Q ST ; SFSITE(IMG) ; N WEB S WEB=$$WEB^W3MAIN W " " W " " W " ",! Q ; SFTBL ; W "",! Q ; SFHEAD ; W "" W "
" N CLICK S CLICK=$$^%W1DICT("CLICKTHEBID") I ISHUR S CLICK=$$^%W1DICT("CLICKCONFIRM") ; N IMGSIZE S IMGSIZE=" width=""240px"" height=""60px"" " ; N WEB S WEB=$$WEB^W3MAIN ; D SFTBL W "
" ; W "",! ; D SFHDHMH ; ;;D SFHDSITE ; ;;D SFHDMAIL W "",! ; W "" W "" w "",! ; W "
",! ; 3 W "" W "
" ; 6 W "" w "
",! ; S TXT=$$INVH^%L1FRM(TXT) S TXT=$TR(TXT,"_",$C(10)) S TXT=$TR(TXT,$C(9),$C(10)) ; I ISHUR=1 D .I $$^%W1LNG="H" D ..W $$CMNT("! dxye` mkly dpnfd ") ..W $$CMNT("! ixehwt 'uieecpqn dax dcez") ; I ISHUR=0 D .I $$^%W1LNG="H" D ..W $$CMNT("! dlhea dpnfd ") ; I ISHUR'?1N D .W $$CMNT(TXT) ; D ORDCONTENT(HZ) ; W "",! W "",! Q ; ; SFHDHMH ; W "",! W "" W "" W "",! W "",! Q ; SFHDMENU ; W "",! W "" W "" W "",! W "",! Q ; ; SFHDKASHRUT ; W "",! W " " W "" W " ",! W "",! Q ; ; SFHDCATERING ; W "",! W "" W "" W "",! W "",! Q ; ; SFHDORD ; W "",! W "" W "" W "",! W "",! Q ; SFHDSITE ; W "",! I WEB[".2order.org" S WEB="https://"_$P(WEB,"//",2,20) D SFSITE("w3sfsite.jpg") W "",! Q ; SFHDMAIL ; W "",! W "" W "" W "",! W "",! Q ; ; HEAD ; W "" W "
" N CLICK S CLICK=$$^%W1DICT("CLICKTHEBID") I ISHUR S CLICK=$$^%W1DICT("CLICKCONFIRM") W ""_CLICK_"",! W "
" W ""_$$^%W1DICT("CLICKTOORDERONLINE")_"",! ;I KASHRUT D W "
" W ""_$$^%W1DICT("SHOWKASHRUTFILE")_"" W "
",! W ""_$$^%W1DICT("SHOWWEBMENU")_"" W "
",! W ""_$$^%W1DICT("SHOWWEBSITE")_"" W "
",! I $$^W3PRCOFR(HZ) D .W ""_$$H2U^%L1FRM("o`k ugl bpixhiiw zwlgn zbvnl")_"" W "
",! ; I $L(LOGO) D .N WEB S WEB=$$WEB^W3MAIN .I WEB[".2order.org" S WEB="https://"_$P(WEB,"//",2,20) .W "
",! ; S TXT=$$INVH^%L1FRM(TXT) S TXT=$TR(TXT,"_",$C(10)) S TXT=$TR(TXT,$C(9),$C(10)) ; I ISHUR=1 D .I $$^%W1LNG="H" D ..W $$CMNT("! dxye` mkly dpnfd ") ..W $$CMNT("! ixehwt 'uieecpqn dax dcez") ; I ISHUR=0 D .I $$^%W1LNG="H" D ..W $$CMNT("! dlhea dpnfd ") ..;;W $$CMNT(TXT_" : daiqn") ; I ISHUR'?1N D .W $$CMNT(TXT) ; D ORDCONTENT(HZ) W "
",! W "",! Q W3SNDMSG W3SNDMSG(EMAIL,FROM,MSGBODY,HD) ; [ 20.03.25 13:57 ] [ 09.04.24 17:20 ] [ 04.06.23 17:14 ] ;;S MSG="echo """_FROM_"
"_$$RPL^%L1FRM($$H2U^%L1FRM(MSGBODY),"_","
")_""" | mail -n -a ""content-type: text/html"" -s ""You have new customer message from Back office"" "_$$FUNC^%LCASE(EMAIL) ;;zsy MSG ;;Q $ZSY ; I $G(HD)="" S HD="Customer-Message" ; N MSD,MSG,LINK,SMTP,USER,FILE ; S MSD=$$GET^%W1PRM("MSD") I 'MSD Q "RESTNOTEXIST" I $G(FROM)="" S FROM=$$EMAIL^W3R(MSD) S SMTP=$$SMTP^W3R(MSD) S USER=$$USER^W3R(MSD) S PSW=$$PSWMAIL^W3R(MSD) ; Q $$MSG(MSGBODY,HD,EMAIL,FROM,SMTP,USER,PSW) ; ; ; MSG(MSGBODY,HD,EMAIL,FROM,SMTP,USER,PSW) ; N FILE D FILE(MSGBODY) S HD=$$RPL^%L1FRM(HD,"'","\'") S MSG="/pos/sbin/smail.py -m """_SMTP_""" -u """_USER_""" -p """_PSW_""" -j """_HD_""" -s """_FROM_""" -y """_FROM_""" -r """_EMAIL_""" -b """_FILE_"""" ;;S MSG=MSG_"-S smtp-use-starttls -S smtp=smtp://smtp.example.com:587 -S smtp-auth=login" S ^AL(JB,"MSG")=$E(MSG,1,800) zsy MSG S ^AL(JB,"MSG","ZSY")=$ZSY Q $ZSY ; FILE(MSGBODY) ; S FILE="/tmp/sndmail"_$G(JB) ;;I $E(MSGBODY)="<" S FILE=$E(MSGBODY,2,200) ; C FILE:(DELETE) O FILE:(NEWVERSION:REWIND:WRITE) U FILE W "",! W MSGBODY W "",! C FILE ; Q W3SNDORD W3SNDORD ; [ 31.08.08 09:17 ] [ 12.05.08 21:27 ] [ 28.03.08 20:47 ] ;------------------------------------------------------- N (JB,MEDAT,ADDAT,MSD,%ARG,OKPSW) D KILL^%W3DEB("W3SNDORD") S MSDR=$G(%ARG("MSDR")) S MSD=$G(%ARG("MSD")) D PUT^%W3DEB("W3SNDORD","MEDAT=MEDAT & ADDAT=ADDAT & MSD=MSD & OKPSW=OKPSW & ARG=[%ARG") I '$G(OKPSW) Q S W3ORDLS("JB")=JB ;;W "MSD="_MSD_" MSDR="_MSDR D GL S (SHZ,SHZNOK)=0 W "
",! W "
",! W "",! W "",! W "" W "" W "" W "" W "" W "" W "" W "" W "" ; S DRC=1 I $G(%ARG("ORDER")) D G TOT .I '$D(@$$^W4GL("W3ORDSND")@(%ARG("ORDER"))) Q .N JB S W3ORDLS=%ARG("ORDER"),JB=W3ORDLS D SHOWORD(%ARG("ORDER")) ; S N="" F S N=$O(@GL@(N)) Q:N="" D .N JB S W3ORDLS=N,JB=N .I $G(MEDAT),$$DT(N)ADDAT Q .I $$RS,$G(MSD),$$RS'=MSD Q .I $$RS,$G(MSDR),'$D(^[$$^W3MAIN]W3MSDR(MSDR,$$RS)) Q .D SHOWORD(N) ; TOT W "",! W "",! W "" W "",! ; EN W "
"_$$^%W1DICT("ORDERNUMBER")_""_$$^%W1DICT("DATE")_""_$$^%W1DICT("TIME")_""_$$^%W1DICT("RESULT")_""_$$^%W1DICT("FILENAME")_""_$$^%W1DICT("RESTAURANT")_""_$$^%W1DICT("SENDTO")_""_$$^%W1DICT("CREATEDORDER")_""_$$^%W1DICT("KINDOFERROR")_" " W $$^%W1DICT("TOTAL") W "  " W "",! W $$^%W1DICT("ORDERQN")_""_SHZ W ""_$$^%W1DICT("ORDERNOK")_"",! W " "_SHZNOK_" " W "
",! W "
",! ; W "",! W "
",! W "


",! Q ; SHOWORD(N) ; S SHZ=SHZ+1 W "",! W " "_N_"" W ""_$$DAT(N)_"" W ""_$$TIM(N)_"" W ""_$$RES(N)_"" W " "_$$FN(N)_"" W " "_$$REST(N)_"" W " "_$$SENDTO(N)_"" W " "_$$REMORD(N)_"" W " "_$$ERROR(N)_"" W "",! Q MIN(SHAA) ; Q $P(SHAA,":")*60+$P(SHAA,":",2) ; DT(N) S GLN=$$GLN(N) I GLN="" Q "" Q $P($P($G(@GL@(N)),";"),",") ; TIM(N) S GLN=$$GLN(N) I GLN="" Q " " Q $$T^%L1TIME($P($P($G(@GL@(N)),";"),",",2)) ; DAT(N) N DT S DT=$$DT(N) I DT="" Q " " Q $$^%L1DC($$DT(N),1) ; RESCD(N) N GLN,RES S GLN=$$GLN(N) I GLN="" Q "" Q $P(GLN,";",2) RES(N) ; S RES=$$RESCD(N) I RES="" Q " " I RES="OK" Q "+" I RES="NOK" Q "-" I RES="NOK1" Q "-" Q " " ; FN(N) S GLN=$$GLN(N) I GLN="" Q " " N FN S FN=$P(GLN,";",3) I FN="" Q " " Q FN ; SENDTO(N) S GLN=$$GLN(N) I GLN="" Q " " N SND S SND=$P(GLN,";",4) I SND="" Q " " Q SND ; REST(N) N RS,RS1 S RS=$$RS(N) S RS1="" I RS S RS1=$G(^[$$^W3MAIN]W3MSD(RS)) I RS1="" Q " " Q $$H2U^%L1FRM(RS1) ; RS(N) Q $P($P($P(GLN,";",3),"_",2),".") ; REMORD(N) S GLN=$$GLN(N) I GLN="" Q " " I $$RESCD(N)="OK" Q $P(GLN,";",5) Q " " ; ERROR(N) N GLN,ER S GLN=$$GLN(N) I GLN="" Q " " S ER="" I $$RESCD(N)="OK" Q " " S ER=$P(GLN,";",5) I ER="" Q " " IF ER<0 S ER=$G(^[$$^W3MAIN]W3SNDERR(ER)) Q ER ; GL ; S GL="^[$$^W3MAIN]W3ORDSND" Q GLN(N) D GL N GLN S GLN=$G(@GL@(N)) Q GLN ; SELREST ; N I,N,GLMSD S GLMSD="^[$$^W3MAIN]W3MSD" ; W "",! Q SELRESTR ; N I,N,GLMSDR S GLMSDR="^[$$^W3MAIN]W3MSDRI" ; W "",! Q W3SNDPSW W3SNDPSW(USER) ; [ 01.10.07 14:04 ] [ N (USER) S JB=$P($G(USER),"~",2) I 'JB Q "-3" D PUT^%W3DEB("W3SNDPSW","USER=USER") S USER=$P(USER,"~") S MSD=$$GET^%W1PRM("MSD") I 'MSD Q "-1" I '$$D^W3L(USER) Q "-2" S MSGBODY="""Your password is:"_$C(10)_$$PSW^W3L(USER)_"""" S MSG="echo "_MSGBODY_" | mail -n -s ""Your password"" "_$$FUNC^%LCASE($$EMAIL^W3L(USER)) zsy MSG Q 1 W3SNIF W3SNIF ; [ 09.04.12 20:43 ] [ 01.07.08 08:50 ] [ SNIF(NSNIF) Q $G(@$$^W4GL("W3SNIF")@(NSNIF)) ADDR(NSNIF) Q $G(@$$^W4GL("W3SNIF")@(NSNIF,"ADDR")) SNIFA(NSNIF) I $$^%W1DIR="LTR" Q $$SNIF(NSNIF)_", "_$$ADDR(NSNIF) Q $$ADDR(NSNIF)_" ,"_$$SNIF(NSNIF) ; GETSNIF(STAM) ; N SNIF S SNIF="" N N S N="" F S N=$O(@$$^W4GL("W3SNIF")@(N)) Q:N="" D .S SNIF=SNIF_N_"^"_$$H2U^%L1FRM($$SNIFA(N))_"~" Q $E(SNIF,1,$L(SNIF)-1) W3SO W3SO ; [ 29.04.15 09:35 ] [ 02.08.13 13:14 ] [ 25.06.13 03:40 ] ;;-------------------------------------------------------------- ;; ^W3SO("fresh-kitchen")=spice|fresh-kitchen@rsd.co.il|GSsfHqN ;; ^W3SOR2M("fresh-kitchen")=10040 ;;-------------------------------------------------------------- N (%ARG,%REM) N $ZT S $ZT="G SVER^%L1X" S RESTID="" BG S RESTID=$O(^[$$^W3MAIN]W3SO(RESTID)) I RESTID="" H ;10 G BG ;S RESTID="""_RESTID_""" D ^W3SORD(RESTID) I $D(^[$$^W3MAIN]SOGP($H-7)) K ^[$$^W3MAIN]SOGP($H-7) H .1 G BG Q W3SO1 W3SO ; [ 04.07.13 04:42 ] [ 11.05.13 19:26 ] [ 18.02.13 13:15 ] ;;-------------------------------------------------------------- ;; ^W3SO("fresh-kitchen")=spice|fresh-kitchen@rsd.co.il|GSsfHqN ;; ^W3SOR2M("fresh-kitchen")=10040 ;;-------------------------------------------------------------- N (%ARG,%REM) N $ZT S $ZT="G SVER^%L1X" S RESTID="" BG S RESTID=$O(^[$$^W3MAIN]W3SO(RESTID)) I RESTID="" H ;10 G BG ;S RESTID="""_RESTID_""" D ^W3SORD(RESTID) H 10 K ^[$$^W3MAIN]SOGP($H-5) G BG Q W3SOCON W3SOCON(FUNC,POST); [ 16.08.10 11:23 ] [ ; [ 29.04.15 09:45 ] [ 25.02.14 15:35 ] [ 06.01.13 12:24 ] N (JB,%ARG,%REM,FUNC,POST,SOER,SOER1) S COUNTER=$O(^[$$^W3MAIN]SOGP(+$H,"CON",""),-1)+1 S PROT="^[$$^W3MAIN]SOGP(+$H,""CON"",COUNTER)" S SOER=0,SOER1="" S HEADER="""Content-Type:application/json""" S URL="https://api.openrest.com/v1.1" ; ; S FLOUT=$$FLOUT^W3SOPRM C FLOUT:(DELETE) ; *** LEV 26/12 S CMD="/usr/bin/curl -k -m 10 -s -X POST -H "_HEADER_" -d@"_POST_" "_URL_" -o "_FLOUT ; D GL S H=+$H ; D PROT("CMD",CMD) D PROT("FLOUT",FLOUT) ; ZSY CMD ;;SUCCESS OF THIS COMMAND SHOUL BE CHECKED BEFORE CMD1 D PROT("ZSY",$ZSY) I $ZSY S SOER=-$ZSY,SOER1="zxeywza d`iby" G END ; F JJ=1:1:20 Q:$$^%L1ZOS(10,FLOUT)'<0 H 1 ; I $$^%L1ZOS(10,FLOUT)<0 S SOER=-.2,SOER1="dlawzd `l daeyz" D G END .D PROT("SOER",SOER) ; K @GL ; C FLOUT I '$$^%L1JSON(FLOUT,GL) S SOER=-.9,SOER1="mipezp zlawa d`iby" ; D PROTGT ; END Q ; ; PROT(NM,VL) ; Q:'$G(SODEB) S @PROT@(FUNC,POST,NM)=VL Q ; PROTGT ; ;;M @PROT@("SOGT")=@GL Q ; GL ; S GL="^[$$^W3MAIN]TMPSO($J)" Q W3SOER W3SOER(PROG,SOER,SOER1,REST) ; [ 21.11.12 18:59 ] [ S ^[$$^W3MAIN]W3SOER($H,PROG,SOER)=SOER1_"\"_$J_"\"_$G(REST)_"\"_$ZD($H,"DD.MM.YY 24:60") Q W3SOFUNC W3SOFUNC ; [ 26.02.14 14:01 ] [ 19.07.13 09:43 ] [ 20.06.13 15:48 ] ; GETMENU(RESTID) ; D HEADER S STRIN="{""type"":""get_organization_full"", ""organizationId"":"""_RESTID_""",""fields"":[""menu""]}" D FOOTER(STRIN,FLIN) D ^W3SOCON("GETMENU",FLIN) Q ; GETORDS(RESTID) D HEADER I RESTID=0 S RESTID=$$GRSTL^W3SOFUNC,AUTH="spice|general@rsd.co.il|H9zb4f3" E S AUTH=$$AUTH(RESTID) S STRIN="{""type"":""query_orders"",""accessToken"":"""_AUTH_""", ""restaurantIds"":["""_RESTID_"""], ""status"":""new"", ""restaurantView"":true}" D FOOTER(STRIN,FLIN) D ^W3SOCON("GETORDS",FLIN) Q ; CHORDSTA(RESTID,ORD,STAT,ERDESC) ; N AUTH,STRIN D HEADER S AUTH=$$AUTH(RESTID) ;;S STRIN="{""type"":""set_order_status"", ""accessToken"":"""_AUTH_""", ""orderId"":"""_ORD_""", ""status"":"""_STAT_"""}" S STRIN="{""type"":""set_order_status"", ""accessToken"":"""_AUTH_""", ""orderId"":"""_ORD_""", ""status"":"""_STAT_""",""comment"":"""_ERDESC_"""}" D FOOTER(STRIN,FLIN) D ^W3SOCON("CHORDSTA",FLIN) Q ; HEADER ; --> FLIN,BID,FS : O FLIN U FLIN ; S BID=$$RESTID^W3SOPRM ; ; S FS="&" ;- FIELD SEPARATOR ; S FLIN=$$FLIN^W3SOPRM C FLIN:DELETE O FLIN:(WRITE:NEWVERSION:REWIND) U FLIN Q ; ; GRSTL(STAM) ; S REST="",RESTL="" F S REST=$O(^W3SO(REST)) Q:REST="" D .S RESTL=RESTL_""""_REST_""""_"," Q $E(RESTL,2,$L(RESTL)-2) ; FOOTER(STRIN,FLIN) ; W STRIN,! C FLIN ;;U 0 W STRIN,! H 4 Q ; ; AUTH(RESTID) ; Q $G(^[$$^W3MAIN]W3SO(RESTID)) W3SOMEN0 W3SOMENU(RESTID) ; [ 27.10.14 13:37 ] [ 23.01.14 19:51 ] [ 11.02.13 13:41 ] N (JB,%ARG,%REM,M,RESTID,SOER) D ^%L1TS D GETMENU^W3SOFUNC(RESTID) D GL^W3SOCON I $G(SOER) W $G(SOER1),! D ^W3SOER(RESTID,"W3SOMENU",SOER,SOER1) G END S GL0=GL S GLTMP="^[$$^W3MAIN]TMPMENU($J)" K @GLTMP S (IT4,IT5,IT6,IT7)=0 F S GL0=$Q(@GL0) Q:GL0="" D .;W GL0,"=",$G(@GL0),! .S UR=$L(GL0,",") .S GL00=$P(GL0,",",1,$L(GL0,",")-1)_")" .S PTR=$P($G(@GL00),",") S:PTR="" PTR=" " .S A=$G(@GL0) . .I UR=4 S IT4=0,IDIT="" I A["items" S IT4=1 .I UR=5 S IT5=0,IDIT="" I A["items" S IT5=1 .I UR=6,A["id" S IT6=0 I IT4,IT5 D ..S:A["=" A=$P(A,"=",2,20) ..S ITID=$$GET(A,"id") Q:ITID="" ..S IT6=1 .I UR=7,A["title",A["he_IL" S IT7=0 I IT4,IT5,IT6,ITID D ..; ..S ITNM=$$GET(A,"he_IL") Q:ITNM="" ..S @GLTMP@(ITID)=ITNM .I UR=7,A["externalIds" I A["il.co.rsd",IT4,IT5,IT6,ITID D ..S ITEXT=$$GET(A,"externalIds=il.co.rsd") ..I ITEXT?.P S ITEXT=$$GET(A,"il.co.rsd") ..S @GLTMP@(ITID,"EXT")=ITEXT ; END K @GL Q ; ; GETRKV(PTR,A) ; N T S T="" I A["=" S T=$$CLRQ($P(A,"=")),A=$P(A,"=",2,40) N J F J=1:1:$L(A,",") D .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S IND=$$CLRQ(IND) .S PTR=$$CLRQ(PTR) .S:PTR="" PTR=" " Q:IND="" .S CONT=$P(COUPLE,":",2) .S CONT=$$FUNC^%UCASE(CONT) .S CONT=$$CLRQ(CONT) .I T'="" S IND=T_"="_IND .I $D(HD(PTR,IND)) D ..N J1 F J1=1:1 Q:'$D(HD(PTR,$P(IND,"-")_"-"_J1)) ..S IND=$P(IND,"-")_"-"_J1 .S HD(PTR,IND)=CONT Q ; GET(A,RKV) ; Q $$GET^W3SORD(A,RKV) ; CLRQ(TXT) ; Q $$CLRQ^W3SORD(TXT) ; W2L(TXT) ; Q $$W2L^W3SORD(TXT) ; ; ZAP ; ; D SENDOK Q ; SENDOK ; Q W3SOMENU W3SOMENU(RESTID) ; [ 29.04.15 09:40 ] [ 27.10.14 13:39 ] [ 23.01.14 19:51 ] N (JB,%ARG,%REM,M,RESTID,SOER) D ^%L1TS D GETMENU^W3SOFUNC(RESTID) D GL^W3SOCON I $G(SOER) W $G(SOER1),! D ^W3SOER(RESTID,"W3SOMENU",SOER,SOER1) G END S GL0=GL S GLTMP="^[$$^W3MAIN]TMPMENU($J)" K @GLTMP S (IT4,IT5,IT6,IT7)=0 ; F S GL0=$Q(@GL0) Q:GL0="" D .;W GL0,"=",$G(@GL0),! .S UR=$L(GL0,",") .S GL00=$P(GL0,",",1,$L(GL0,",")-1)_")" .S PTR=$P($G(@GL00),",") S:PTR="" PTR=" " .S A=$G(@GL0) . .I UR=4 S IT4=0,IDIT="" I A["items" S IT4=1 .I UR=5 S IT5=0,IDIT="" I A["items" S IT5=1 .I UR=6,A["id" S IT6=0 I IT4,IT5 D ..S:A["=" A=$P(A,"=",2,20) ..S ITID=$$GET(A,"id") Q:ITID="" ..S IT6=1 .I UR=7,A["title",A["he_IL" S IT7=0 I IT4,IT5,IT6,ITID D ..; ..S ITNM=$$GET(A,"he_IL") Q:ITNM="" ..S @GLTMP@(ITID)=ITNM .I UR=7,A["externalIds" I A["il.co.rsd",IT4,IT5,IT6,ITID D ..S ITEXT=$$GET(A,"externalIds=il.co.rsd") ..I ITEXT?.P S ITEXT=$$GET(A,"il.co.rsd") ..S @GLTMP@(ITID,"EXT")=ITEXT ; END K @GL Q ; ; GETRKV(PTR,A) ; N T S T="" I A["=" S T=$$CLRQ($P(A,"=")),A=$P(A,"=",2,40) N J F J=1:1:$L(A,",") D .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S IND=$$CLRQ(IND) .S PTR=$$CLRQ(PTR) .S:PTR="" PTR=" " Q:IND="" .S CONT=$P(COUPLE,":",2) .S CONT=$$FUNC^%UCASE(CONT) .S CONT=$$CLRQ(CONT) .I T'="" S IND=T_"="_IND .I $D(HD(PTR,IND)) D ..N J1 F J1=1:1 Q:'$D(HD(PTR,$P(IND,"-")_"-"_J1)) ..S IND=$P(IND,"-")_"-"_J1 .S HD(PTR,IND)=CONT Q ; GET(A,RKV) ; Q $$GET^W3SORD(A,RKV) ; CLRQ(TXT) ; Q $$CLRQ^W3SORD(TXT) ; W2L(TXT) ; Q $$W2L^W3SORD(TXT) ; ; ZAP ; ; D SENDOK Q ; SENDOK ; Q ; UPD(RESTID) ; N GLTMP,COUNT S GLTMP="^[$$^W3MAIN]TMPMENU($J)" K @GLTMP D ^W3SOMENU(RESTID) S COUNT=$O(^[$$^W3MAIN]W3SOM(RESTID,+$H,999999),-1)+1 M ^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT)=@GLTMP Q W3SOPRM SOPRM ; [ 11.10.12 13:19 ] [ 10.10.12 14:47 ] [ FLIN() Q "/tmp/soin"_$$^%L3MYDVN ; FLOUT() Q "/tmp/soout"_$$^%L3MYDVN ; RESTID() Q "demo20" ; VENDID() Q 25 W3SORD W3SORD(RESTID) ; [ 10.11.15 14:48 ] [ 29.04.15 09:49 ] [ 10.02.15 18:46 ] N (%ARG,%REM,M,RESTID) D ^%L1TS ; S GLMENU="^[$$^W3MAIN]TMPMENU($J)" D GETMENU(RESTID) I $D(@GLMENU)<10 Q ; D GL^W3SOCON K @GL D GETORDS^W3SOFUNC(RESTID) ; S GLTMP="^[$$^W3MAIN]TMPSORD($J)" S GLHD="^[$$^W3MAIN]TMPSOHD($J)" I $G(SOER) G END ; D SENDOK(RESTID,9999999,"","ERROR "_SOER) G END ; S GL0=GL,PTR=" ",IDORD="",I=0 ; K @GLTMP,@GLHD,PTRID ; S URORD="",ENDORD=0 F S GL0=$Q(@GL0) Q:GL0="" Q:$P($P(GL0,","),"(",2)'=$J D Q:ENDORD .S UR=$L(GL0,",") .I URORD,UR'>URORD S IDORD="" .F U=UR+1:1:11 K PTRID(U) .S GL00=$P(GL0,",",1,$L(GL0,",")-1)_")" .S PTR=$P($G(@GL00),",") S:PTR="" PTR=" " .S A=$G(@GL0) .I A["=" S PTRID(UR)=$P(A,"=") . .I UR=3 S IDORD="" D GETHDORD(A) I IDORD S URORD=3 D KILL .I 'IDORD,UR=5 D GETHDORD(A) S URORD=5 D KILL .I UR>5,'IDORD D KILL Q . .I IDORD,UR=(URORD+1)!(UR=(URORD+2))!(UR=(URORD+3)),'$$ITEM(A) D GETRKV(IDORD,A,UR) S PTR=$P(A,",") . .I UR=(URORD+2)!(UR=(URORD+5))!(UR=(URORD+8)),$$ITEM(A) D Q ..N MAIN S MAIN=0 I UR=(URORD+2) S MAIN=1 K MAINQN ..I A["=" S A=$P(A,"=",2,200) ..S CD=$$GET(A,"itemId") Q:CD="" ..S CDR=$S($G(@GLMENU@(CD,"EXT")):^("EXT"),1:"0-"_CD) ..S NAME=$TR($G(@GLMENU@(CD)),"()","") ..S NAME=$TR(NAME,"\~*","/-X") ..S PRC=$$GET(A,"price") ..S CMNT=$$GET(A,"comment") ..S QN=$$GET(A,"count") I 'QN S QN=$S(MAIN:1,$G(MAINQN):MAINQN,1:1) ..I MAIN S MAINQN=QN ..S ST=$S(MAIN:"0",1:1)_"~"_CDR_"~"_NAME_"~"_$J(PRC*.01,2,2)_"~"_QN ..S $P(ST,"~",7)=CMNT ..;;W "GL0:",GL0_" = "_$G(@GL0),! ..;;W "I="_I_" ST="_ST,!! ..I IDORD S I=I+1,@GLTMP@(IDORD,I)=ST . D ZAP ; I $D(@GL@(1,1,1))>9 D .N GLA S GLA="^[$$^W3MAIN]W3SOA(+$H," .N COUNT S COUNT=$O(^[$$^W3MAIN]W3SOA(+$H,99999),-1)+1 .S GLA=GLA_COUNT_")" .M @GLA=@GL .S @GLA=$H .M ^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT)=@GLMENU ; END K @GL,@GLTMP,@GLMENU,@GLHD ; *** 11/09 Q ; ; GETRKV(PTR,A,UR) ; N T S T="" I A["=" S T=$$CLRQ($P(A,"=")),A=$P(A,"=",2,40) I T="",$G(PTRID(UR))'="" S T=$$CLRQ(PTRID(UR)) S A=$$CLRZPT(A) N J F J=1:1:$L(A,",") D .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S IND=$$CLRQ(IND) .S PTR=$$CLRQ(PTR) .S:PTR="" PTR=" " Q:IND="" .S CONT=$P(COUPLE,":",2) .S CONT=$$FUNC^%UCASE(CONT) .S CONT=$$CLRQ(CONT) .I T'="" S IND=T_"="_IND .I $D(@GLHD@(PTR,IND)) D ..N J1 F J1=1:1 Q:'$D(@GLHD@(PTR,$P(IND,"-")_"-"_J1)) ..S IND=$P(IND,"-")_"-"_J1 .S @GLHD@(PTR,IND)=CONT Q ; GET(A,RKV) ; N COUPLE,IND,CONT,OK,BG S OK=0 S A=$$CLRZPT(A) N J,J1 F J=1:1:$L(A,",") D Q:OK .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S BG=$F(A,IND) .S IND=$$CLRQ(IND) .Q:IND="" .I IND=RKV S OK=1 S CONT=$P(COUPLE,":",2) .E I $P(IND,"=",2)=RKV S OK=1 S CONT=$P(COUPLE,":",2) I OK Q $$CLRQ($$FUNC^%UCASE(CONT)) Q "" ; ITEM(A) ; I $TR($P($P(A,","),":"),"""","")["itemId" Q 1 Q 0 ; CLRQ(TXT) ; S:$E(TXT)="""" TXT=$TR(TXT,"""","") I TXT[$C(215) S TXT=$$W2L(TXT) S TXT=$TR(TXT,"\~*","/-X") Q TXT ; W2L(TXT) ; N OU S OU="" N J S J=0 W2LC ; S J=J+1 I J>$L(TXT) G W2LCE I $A(TXT,J)=215 D G W2LC .N SMB S SMB=$A(TXT,J+1) .D ..I SMB>186 S SMB=SMB-155 Q ..I SMB=153 S SMB=105 Q ;39 Q ..I SMB>79 S SMB=SMB-48 .S OU=OU_$C(SMB) S J=J+1 ; S OU=OU_$E(TXT,J) G W2LC W2LCE S OU=$$RPL^%L1FRM(OU,$C(194,128,153),"i") Q $$^%W1H2U(OU) ; ; ZAP ; N ORD,I,JB S ORD="" F S ORD=$O(@GLHD@(ORD)) Q:ORD="" D .S JB=$$^%W1SsID("TMPSO") .K ^[$$^W3MAIN]TMPORD(JB) S I=0 .N N S N="" F S N=$O(@GLTMP@(ORD,N)) Q:N="" D ..S I=I+1 M ^[$$^W3MAIN]TMPORD(JB,I)=@GLTMP@(ORD,N) .K @GLTMP@(ORD) .D ZAPHD(ORD) K @GLHD@(ORD) .;;W "ORD:"_ORD_" OK="_OK,! Q ; ZAPHD(ORD) ; N (JB,%ARG,ORD,GLHD,OK,RESTID) S OK=0 S REST=$G(@GLHD@(ORD,"id-rest")) Q:REST="" S REST=$$FUNC^%LCASE(REST) ; Q:REST'=RESTID S MSD=$G(^[$$^W3MAIN]W3SOR2M(REST)) Q:MSD="" S ^[$$^W3MAIN]TMPORD(JB,"MSD")=MSD S CITY=$G(@GLHD@(ORD,"address=city")) S DLVMETHOD=$G(@GLHD@(ORD,"delivery=type")) S NAME=$G(@GLHD@(ORD,"contact=lastName"))_" "_$G(@GLHD@(ORD,"contact=firstName")) S PHONE01=$G(@GLHD@(ORD,"contact=phone")) S PHONE01=$$RPL^%L1FRM(PHONE01,"+972",0) S PHONE02="" S CODE=$S(PHONE01:PHONE01,1:1111111) D PUT^%W1PRM("CODE",CODE) S ZMANK=$ZD($H,"DD.MM.YY 24:60") S ASM=ORD ; S DMSH=$G(@GLHD@(ORD,"delivery=charge"))*.01 S HNH=-$G(@GLHD@(ORD,"charges=amount"))*.01 S AHUZ="" ;;-$G(@GLHD@(ORD,"charges=amountRule"))*.01 S TOTIME=$G(@GLHD@(ORD,"delivery=time")) I TOTIME?10N.N S TOTIME=$$SPA^%L1FRM($$EPOH2T^%L1DC(TOTIME)) S TIMERCV=$G(@GLHD@(ORD,"log=timestamp")) I TIMERCV?10N.N S TIMERCV=$$SPA^%L1FRM($$EPOH2T^%L1DC(TIMERCV)) ; D .S DAT=$ZD($H,"DD.MM.YY"),SHAA="" .I TOTIME?.E2N1"/"2N1"/"4N1" "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":"2N.E D ..S DAT=$ZD($H,"DD.MM.YY") ..S SHAA=$P(TOTIME,":",1,2) ..I TIMERCV?.E1N1":"2N.E S SHAA=SHAA_":-"_TIMERCV ; I DAT=$ZD($H,"DD.MM.YY"),SHAA*3600+($P(SHAA,":",2)*60)-$P($H,",",2)<1800,DLVMETHOD'="TAKEOUT" D .S SHAA=$$TM^W3TIME($H,CITY)_":!"_SHAA ; N SHAA0 S SHAA0=$S(SHAA["-":$P(SHAA,"-",2),1:SHAA) I DAT=$ZD($H,"DD.MM.YY"),$H>82000,SHAA0<3 S DAT=$ZD($H+1,"DD.MM.YY") ; S TOPAY=0 S TOPAY=$G(@GLHD@(ORD,"id-price")) ; I TOPAY D .D PUT^W3HZMST(JB,"TSHL",$G(TOPAY)) ; D PUT^W3HZMST(JB,"NAME",NAME) D PUT^W3HZMST(JB,"NMB",CODE) D PUT^W3HZMST(JB,"CODE",CODE) D PUT^W3HZMST(JB,"PELE",PHONE01) 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","15") ; SOI D PUT^W3HZMST(JB,"DMSH",$G(DMSH)) D PUT^W3HZMST(JB,"HNH",$G(HNH)) D PUT^W3HZMST(JB,"AHUZ",$G(AHUZ)) ; S HOME=$G(@GLHD@(ORD,"address=number")) S STREET=$G(@GLHD@(ORD,"address=street")) I DLVMETHOD="TAKEOUT" S STREET="TAKEAWAY" S COMMENT=$G(@GLHD@(ORD,"address=comment")) S CMHD=$G(@GLHD@(ORD,"id-comment")) S FLAT=$G(@GLHD@(ORD,"address=apt")) S COMP="" S ENTRANCE=$G(@GLHD@(ORD,"address=entrance")) S FLOOR=$G(@GLHD@(ORD,"address=floor")) ; 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_":SO "_CMHD) ; S CASH=0 S PYTYPE(0)=$G(@GLHD@(ORD,"payments=type")) S AMOUNT(0)=$G(@GLHD@(ORD,"payments=amount"))*.01 I PYTYPE(0)="CASH",AMOUNT(0) S CASH=1 S CARD(CASH)=$G(@GLHD@(ORD,"card=number")) I CASH,CARD(CASH) S PYTYPE(CASH)="CREDIT" S CVV(CASH)=$G(@GLHD@(ORD,"card=csc")) S MM(CASH)=$G(@GLHD@(ORD,"card=expireMonth")) S YY(CASH)=$G(@GLHD@(ORD,"card=expireYear")) S TZ(CASH)=$G(@GLHD@(ORD,"card=holderId")) ; S EJ=0,CLRX=0 ; I PYTYPE(0)["CELLARIX",AMOUNT(0) S CLRX=1 ; F J=1:1:10 D Q:EJ .S PYTYPE(J+CASH)=$G(@GLHD@(ORD,"payments=type-"_J)) .I PYTYPE(J+CASH)="CASH" S CASH=1 .I $G(PYTYPE(J+CASH))="" D S EJ=1 K PYTYPE(J+CASH) Q ..S AMOUNT(J)=$G(@GLHD@(ORD,"payments=amount-"_J))*.01 .S CARD(J+CASH)=$G(@GLHD@(ORD,"card=number-"_J)) .S CVV(J+CASH)=$G(@GLHD@(ORD,"card=csc-"_J)) .S AMOUNT(J)=$G(@GLHD@(ORD,"payments=amount-"_J))*.01 .S MM(J+CASH)=$G(@GLHD@(ORD,"card=expireMonth-"_J)) .S YY(J+CASH)=$G(@GLHD@(ORD,"card=expireYear-"_J)) .S TZ(J+CASH)=$G(@GLHD@(ORD,"card=holderId-"_J)) ; S CI=0,CREDCARD="",CREDSUM="",CREDMMYY="",CREDTZ="",CREDCVV="" F J=0:1 Q:'$D(PYTYPE(J)) D .I PYTYPE(J)="CREDIT"!(PYTYPE(J)["IL.CO.BITSOFGOLD") D ..S CI=CI+1 ..S CREDCARD=CREDCARD_$$^W3ENCR(JB_";"_$G(CARD(J)))_"^" ..S CREDSUM=CREDSUM_$G(AMOUNT(J))_";" ..S CREDMMYY=CREDMMYY_$TR($J($G(MM(J)),2)," ",0)_$E($G(YY(J)),3,4)_";" ..S CREDTZ=CREDTZ_$$^W3ENCR(JB_";"_$G(TZ(J)))_"^" ..S CREDCVV=CREDCVV_$G(CVV(J))_";" ; I CREDSUM D .D PUT^W3HZMST(JB,"CREDCARD",$E(CREDCARD,1,$L(CREDCARD)-1)) .D PUT^W3HZMST(JB,"CREDSUM",$E(CREDSUM,1,$L(CREDSUM)-1)) .D PUT^W3HZMST(JB,"CREDMMYY",$E(CREDMMYY,1,$L(CREDMMYY)-1)) .D PUT^W3HZMST(JB,"CREDTZ",$E(CREDTZ,1,$L(CREDTZ)-1)) .D PUT^W3HZMST(JB,"CREDCVV2",$E(CREDCVV,1,$L(CREDCVV)-1)) ; N CODTS S CODTS=$S(CASH:1,CLRX:11,1:3) D PUT^W3HZMST(JB,"CODTS",CODTS) ; ; I $D(^[$$^W3MAIN]W3SO(RESTID,ORD)) K ^[$$^W3MAIN]TMPORD(JB) D G EZ .D SENDOK(RESTID,ORD,"","DOUBLE ORDER") ; D NEWHZ S ^[$$^W3MAIN]W3SO(RESTID,ORD)=$H I $G(OK)=1 D SENDOK(RESTID,ORD,"accepted","") I $G(OK)'=1 D SENDOK(RESTID,ORD,"",OK) EZ Q ; SENDOK(RESTID,ORD,STAT,CMNT) ; D CHORDSTA^W3SOFUNC(RESTID,ORD,"accepted",$G(CMNT)) Q ; NEWHZ ; D TERM^W3ORDVW ; -- OK=1 K ^[$$^W3MAIN]TMPORD(JB) Q ; CLRZPT(A) ; N J,QU S A=$$CLRKV(A) S J=0,QU=0 CLRZPTC S J=J+1 I J>$L(A) G CLRZPTE I $E(A,J)="""" S QU='QU G CLRZPTC I $E(A,J)=",",QU S $E(A,J)=" " G CLRZPTC I $E(A,J)=":",QU S $E(A,J)="-" G CLRZPTC G CLRZPTC CLRZPTE Q A ; CLRKV(A) ; N J F J=1:1:$L(A) D .I $E(A,J)="""",$E(A,J-1)="\" S $E(A,J-1)="'" S $E(A,J)="'" Q A ; TOMENU ; N LASTIND S (LASTD,LASTIND)="" LAST S LASTD=$O(^[$$^W3MAIN]W3SOM(RESTID,LASTD),-1) Q:LASTD="" S LASTIND=$O(^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND),-1) Q:LASTIND="" I $D(^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND))<10 G LAST M @GLMENU=^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND) I $D(@GLMENU)>9,LASTD<$H D .M ^[$$^W3MAIN]W3SOM(RESTID,+$H,1)=@GLMENU Q ; GETHDORD(A) ; I A["=" S A=$P(A,"=",2,200) S IDORD=$$GET(A,"id") Q:IDORD="" S @GLHD@(IDORD,"id-comment")=$$GET(A,"comment") S @GLHD@(IDORD,"id-status")=$$GET(A,"status") S @GLHD@(IDORD,"id-price")=$$GET(A,"price") S @GLHD@(IDORD,"id-rest")=$$GET(A,"restaurantId") Q ; KILL ; Q K @GLTMP,@GLHD Q ; GETMENU(RESTID) ; S GLMENU="^[$$^W3MAIN]TMPMENU($J)" K @GLMENU ; S ^W3SOMSH(RESTID)=$G(^W3SOMSH(RESTID))+1 ;;I ^W3SOMSH(RESTID)#100 D TOMENU ; I $D(^[$$^W3MAIN]W3SOM(RESTID,+$H))>9,^W3SOMSH(RESTID)#10 D .N COUNT .S COUNT=$O(^[$$^W3MAIN]W3SOM(RESTID,+$H,999999),-1) Q:'COUNT .K @GLMENU .M @GLMENU=^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT) ; N OK,I S I=0 N N S N="" F S N=$O(@GLMENU@(N)) Q:N="" D .I $G(^(N))?.P S I=I+1 I I>3 K @GLMENU ; I '(^W3SOMSH(RESTID)#40)!($D(@GLMENU)<10)!'$D(^[$$^W3MAIN]W3SOM(RESTID,+$H)) D .D ^W3SOMENU(RESTID) ; I $D(@GLMENU)<10 D TOMENU Q W3SORD0 W3SORD(RESTID) ; [ 17.12.14 20:04 ] [ 20.06.14 12:08 ] [ 27.02.14 13:31 ] N (%ARG,%REM,M,RESTID) D ^%L1TS ; S GLMENU="^[$$^W3MAIN]TMPMENU($J)" D GETMENU(RESTID) I $D(@GLMENU)<10 Q ; D GL^W3SOCON K @GL D GETORDS^W3SOFUNC(RESTID) ; S GLTMP="^[$$^W3MAIN]TMPSORD($J)" S GLHD="^[$$^W3MAIN]TMPSOHD($J)" I $G(SOER) G END ; D SENDOK(RESTID,9999999,"","ERROR "_SOER) G END ; S GL0=GL,PTR=" ",IDORD="",I=0 ; K @GLTMP,@GLHD,PTRID ; S URORD="",ENDORD=0 F S GL0=$Q(@GL0) Q:GL0="" Q:$P($P(GL0,","),"(",2)'=$J D Q:ENDORD .S UR=$L(GL0,",") .I URORD,UR'>URORD S IDORD="" .F U=UR+1:1:11 K PTRID(U) .S GL00=$P(GL0,",",1,$L(GL0,",")-1)_")" .S PTR=$P($G(@GL00),",") S:PTR="" PTR=" " .S A=$G(@GL0) .I A["=" S PTRID(UR)=$P(A,"=") . .I UR=3 S IDORD="" D GETHDORD(A) I IDORD S URORD=3 D KILL .I 'IDORD,UR=5 D GETHDORD(A) S URORD=5 D KILL .I UR>5,'IDORD D KILL Q . .I IDORD,UR=(URORD+1)!(UR=(URORD+2))!(UR=(URORD+3)),'$$ITEM(A) D GETRKV(IDORD,A,UR) S PTR=$P(A,",") . .I UR=(URORD+2)!(UR=(URORD+5))!(UR=(URORD+8)),$$ITEM(A) D Q ..N MAIN S MAIN=0 I UR=(URORD+2) S MAIN=1 K MAINQN ..I A["=" S A=$P(A,"=",2,200) ..S CD=$$GET(A,"itemId") Q:CD="" ..S CDR=$S($G(@GLMENU@(CD,"EXT")):^("EXT"),1:"0-"_CD) ..S NAME=$TR($G(@GLMENU@(CD)),"()","") ..S NAME=$TR(NAME,"\~*","/-X") ..S PRC=$$GET(A,"price") ..S CMNT=$$GET(A,"comment") ..S QN=$$GET(A,"count") I 'QN S QN=$S(MAIN:1,$G(MAINQN):MAINQN,1:1) ..I MAIN S MAINQN=QN ..S ST=$S(MAIN:"0",1:1)_"~"_CDR_"~"_NAME_"~"_$J(PRC*.01,2,2)_"~"_QN ..S $P(ST,"~",7)=CMNT ..;;W "GL0:",GL0_" = "_$G(@GL0),! ..;;W "I="_I_" ST="_ST,!! ..I IDORD S I=I+1,@GLTMP@(IDORD,I)=ST . D ZAP ; I $D(@GL@(1,1,1))>9 D .N GLA S GLA="^[$$^W3MAIN]W3SOA(+$H," .N COUNT S COUNT=$O(^[$$^W3MAIN]W3SOA(+$H,99999),-1)+1 .S GLA=GLA_COUNT_")" .M @GLA=@GL .S @GLA=$H .M ^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT)=@GLMENU ; END K @GL,@GLTMP,@GLMENU,@GLHD ; *** 11/09 Q ; ; GETRKV(PTR,A,UR) ; N T S T="" I A["=" S T=$$CLRQ($P(A,"=")),A=$P(A,"=",2,40) I T="",$G(PTRID(UR))'="" S T=$$CLRQ(PTRID(UR)) S A=$$CLRZPT(A) N J F J=1:1:$L(A,",") D .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S IND=$$CLRQ(IND) .S PTR=$$CLRQ(PTR) .S:PTR="" PTR=" " Q:IND="" .S CONT=$P(COUPLE,":",2) .S CONT=$$FUNC^%UCASE(CONT) .S CONT=$$CLRQ(CONT) .I T'="" S IND=T_"="_IND .I $D(@GLHD@(PTR,IND)) D ..N J1 F J1=1:1 Q:'$D(@GLHD@(PTR,$P(IND,"-")_"-"_J1)) ..S IND=$P(IND,"-")_"-"_J1 .S @GLHD@(PTR,IND)=CONT Q ; GET(A,RKV) ; N COUPLE,IND,CONT,OK,BG S OK=0 S A=$$CLRZPT(A) N J,J1 F J=1:1:$L(A,",") D Q:OK .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S BG=$F(A,IND) .S IND=$$CLRQ(IND) .Q:IND="" .I IND=RKV S OK=1 S CONT=$P(COUPLE,":",2) .E I $P(IND,"=",2)=RKV S OK=1 S CONT=$P(COUPLE,":",2) I OK Q $$CLRQ($$FUNC^%UCASE(CONT)) Q "" ; ITEM(A) ; I $TR($P($P(A,","),":"),"""","")["itemId" Q 1 Q 0 ; CLRQ(TXT) ; S:$E(TXT)="""" TXT=$TR(TXT,"""","") I TXT[$C(215) S TXT=$$W2L(TXT) S TXT=$TR(TXT,"\~*","/-X") Q TXT ; W2L(TXT) ; N OU S OU="" N J S J=0 W2LC ; S J=J+1 I J>$L(TXT) G W2LCE I $A(TXT,J)=215 S OU=OU_$C($A(TXT,J+1)-48),J=J+1 G W2LC S OU=OU_$E(TXT,J) G W2LC W2LCE Q $$^%W1H2U(OU) ; ; ZAP ; N ORD,I,JB S ORD="" F S ORD=$O(@GLHD@(ORD)) Q:ORD="" D .S JB=$$^%W1SsID("TMPSO") .K ^[$$^W3MAIN]TMPORD(JB) S I=0 .N N S N="" F S N=$O(@GLTMP@(ORD,N)) Q:N="" D ..S I=I+1 M ^[$$^W3MAIN]TMPORD(JB,I)=@GLTMP@(ORD,N) .K @GLTMP@(ORD) .D ZAPHD(ORD) K @GLHD@(ORD) .;;W "ORD:"_ORD_" OK="_OK,! Q ; ZAPHD(ORD) ; N (JB,%ARG,ORD,GLHD,OK,RESTID) S OK=0 S REST=$G(@GLHD@(ORD,"id-rest")) Q:REST="" S REST=$$FUNC^%LCASE(REST) ; Q:REST'=RESTID S MSD=^[$$^W3MAIN]W3SOR2M(REST) Q:MSD="" S ^[$$^W3MAIN]TMPORD(JB,"MSD")=MSD S CITY=$G(@GLHD@(ORD,"address=city")) S DLVMETHOD=$G(@GLHD@(ORD,"delivery=type")) S NAME=$G(@GLHD@(ORD,"contact=lastName"))_" "_$G(@GLHD@(ORD,"contact=firstName")) S PHONE01=$G(@GLHD@(ORD,"contact=phone")) S PHONE01=$$RPL^%L1FRM(PHONE01,"+972",0) S PHONE02="" S CODE=$S(PHONE01:PHONE01,1:1111111) D PUT^%W1PRM("CODE",CODE) S ZMANK=$ZD($H,"DD.MM.YY 24:60") S ASM=ORD ; S DMSH=$G(@GLHD@(ORD,"delivery=charge"))*.01 S HNH=-$G(@GLHD@(ORD,"charges=amount"))*.01 S AHUZ="" ;;-$G(@GLHD@(ORD,"charges=amountRule"))*.01 S TOTIME=$G(@GLHD@(ORD,"delivery=time")) I TOTIME?10N.N S TOTIME=$$SPA^%L1FRM($$EPOH2T^%L1DC(TOTIME)) S TIMERCV=$G(@GLHD@(ORD,"log=timestamp")) I TIMERCV?10N.N S TIMERCV=$$SPA^%L1FRM($$EPOH2T^%L1DC(TIMERCV)) ; D .S DAT=$ZD($H,"DD.MM.YY"),SHAA="" .I TOTIME?.E2N1"/"2N1"/"4N1" "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":"2N.E D ..S DAT=$ZD($H,"DD.MM.YY") ..S SHAA=$P(TOTIME,":",1,2) ..I TIMERCV?.E1N1":"2N.E S SHAA=SHAA_":-"_TIMERCV ; I DAT=$ZD($H,"DD.MM.YY"),SHAA*3600+($P(SHAA,":",2)*60)-$P($H,",",2)<1800,DLVMETHOD'="TAKEOUT" D .S SHAA=$$TM^W3TIME($H,CITY)_":!"_SHAA ; N SHAA0 S SHAA0=$S(SHAA["-":$P(SHAA,"-",2),1:SHAA) I DAT=$ZD($H,"DD.MM.YY"),$H>82000,SHAA0<3 S DAT=$ZD($H+1,"DD.MM.YY") ; S TOPAY=0 S TOPAY=$G(@GLHD@(ORD,"id-price")) ; I TOPAY D .D PUT^W3HZMST(JB,"TSHL",$G(TOPAY)) ; D PUT^W3HZMST(JB,"NAME",NAME) D PUT^W3HZMST(JB,"NMB",CODE) D PUT^W3HZMST(JB,"CODE",CODE) D PUT^W3HZMST(JB,"PELE",PHONE01) 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","15") ; SOI D PUT^W3HZMST(JB,"DMSH",$G(DMSH)) D PUT^W3HZMST(JB,"HNH",$G(HNH)) D PUT^W3HZMST(JB,"AHUZ",$G(AHUZ)) ; S HOME=$G(@GLHD@(ORD,"address=number")) S STREET=$G(@GLHD@(ORD,"address=street")) I DLVMETHOD="TAKEOUT" S STREET="TAKEAWAY" S COMMENT=$G(@GLHD@(ORD,"address=comment")) S CMHD=$G(@GLHD@(ORD,"id-comment")) S FLAT=$G(@GLHD@(ORD,"address=apt")) S COMP="" S ENTRANCE=$G(@GLHD@(ORD,"address=entrance")) S FLOOR=$G(@GLHD@(ORD,"address=floor")) ; 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_":SO "_CMHD) ; S CASH=0 S PYTYPE(0)=$G(@GLHD@(ORD,"payments=type")) S AMOUNT(0)=$G(@GLHD@(ORD,"payments=amount"))*.01 I PYTYPE(0)="CASH",AMOUNT(0) S CASH=1 S CARD(CASH)=$G(@GLHD@(ORD,"card=number")) I CASH,CARD(CASH) S PYTYPE(CASH)="CREDIT" S CVV(CASH)=$G(@GLHD@(ORD,"card=csc")) S MM(CASH)=$G(@GLHD@(ORD,"card=expireMonth")) S YY(CASH)=$G(@GLHD@(ORD,"card=expireYear")) S TZ(CASH)=$G(@GLHD@(ORD,"card=holderId")) ; S EJ=0,CLRX=0 ; I PYTYPE(0)["CELLARIX",AMOUNT(0) S CLRX=1 ; F J=1:1:10 D Q:EJ .S PYTYPE(J+CASH)=$G(@GLHD@(ORD,"payments=type-"_J)) .I PYTYPE(J+CASH)="CASH" S CASH=1 .I $G(PYTYPE(J+CASH))="" D S EJ=1 K PYTYPE(J+CASH) Q ..S AMOUNT(J)=$G(@GLHD@(ORD,"payments=amount-"_J))*.01 .S CARD(J+CASH)=$G(@GLHD@(ORD,"card=number-"_J)) .S CVV(J+CASH)=$G(@GLHD@(ORD,"card=csc-"_J)) .S AMOUNT(J)=$G(@GLHD@(ORD,"payments=amount-"_J))*.01 .S MM(J+CASH)=$G(@GLHD@(ORD,"card=expireMonth-"_J)) .S YY(J+CASH)=$G(@GLHD@(ORD,"card=expireYear-"_J)) .S TZ(J+CASH)=$G(@GLHD@(ORD,"card=holderId-"_J)) ; S CI=0,CREDCARD="",CREDSUM="",CREDMMYY="",CREDTZ="",CREDCVV="" F J=0:1 Q:'$D(PYTYPE(J)) D .I PYTYPE(J)="CREDIT"!(PYTYPE(J)["IL.CO.BITSOFGOLD") D ..S CI=CI+1 ..S CREDCARD=CREDCARD_$$^W3ENCR(JB_";"_$G(CARD(J)))_"^" ..S CREDSUM=CREDSUM_$G(AMOUNT(J))_";" ..S CREDMMYY=CREDMMYY_$TR($J($G(MM(J)),2)," ",0)_$E($G(YY(J)),3,4)_";" ..S CREDTZ=CREDTZ_$$^W3ENCR(JB_";"_$G(TZ(J)))_"^" ..S CREDCVV=CREDCVV_$G(CVV(J))_";" ; I CREDSUM D .D PUT^W3HZMST(JB,"CREDCARD",$E(CREDCARD,1,$L(CREDCARD)-1)) .D PUT^W3HZMST(JB,"CREDSUM",$E(CREDSUM,1,$L(CREDSUM)-1)) .D PUT^W3HZMST(JB,"CREDMMYY",$E(CREDMMYY,1,$L(CREDMMYY)-1)) .D PUT^W3HZMST(JB,"CREDTZ",$E(CREDTZ,1,$L(CREDTZ)-1)) .D PUT^W3HZMST(JB,"CREDCVV2",$E(CREDCVV,1,$L(CREDCVV)-1)) ; N CODTS S CODTS=$S(CASH:1,CLRX:11,1:3) D PUT^W3HZMST(JB,"CODTS",CODTS) ; ; I $D(^[$$^W3MAIN]W3SO(RESTID,ORD)) K ^[$$^W3MAIN]TMPORD(JB) D G EZ .D SENDOK(RESTID,ORD,"","DOUBLE ORDER") ; D NEWHZ S ^[$$^W3MAIN]W3SO(RESTID,ORD)=$H I $G(OK)=1 D SENDOK(RESTID,ORD,"accepted","") I $G(OK)'=1 D SENDOK(RESTID,ORD,"",OK) EZ Q ; SENDOK(RESTID,ORD,STAT,CMNT) ; D CHORDSTA^W3SOFUNC(RESTID,ORD,"accepted",$G(CMNT)) Q ; NEWHZ ; D TERM^W3ORDVW ; -- OK=1 K ^[$$^W3MAIN]TMPORD(JB) Q ; CLRZPT(A) ; N J,QU S A=$$CLRKV(A) S J=0,QU=0 CLRZPTC S J=J+1 I J>$L(A) G CLRZPTE I $E(A,J)="""" S QU='QU G CLRZPTC I $E(A,J)=",",QU S $E(A,J)=" " G CLRZPTC I $E(A,J)=":",QU S $E(A,J)="-" G CLRZPTC G CLRZPTC CLRZPTE Q A ; CLRKV(A) ; N J F J=1:1:$L(A) D .I $E(A,J)="""",$E(A,J-1)="\" S $E(A,J-1)="'" S $E(A,J)="'" Q A ; TOMENU ; N LASTIND S (LASTD,LASTIND)="" LAST S LASTD=$O(^[$$^W3MAIN]W3SOM(RESTID,LASTD),-1) Q:LASTD="" S LASTIND=$O(^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND),-1) Q:LASTIND="" I $D(^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND))<10 G LAST M @GLMENU=^[$$^W3MAIN]W3SOM(RESTID,LASTD,LASTIND) I $D(@GLMENU)>9,LASTD<$H D .M ^[$$^W3MAIN]W3SOM(RESTID,+$H,1)=@GLMENU Q ; GETHDORD(A) ; I A["=" S A=$P(A,"=",2,200) S IDORD=$$GET(A,"id") Q:IDORD="" S @GLHD@(IDORD,"id-comment")=$$GET(A,"comment") S @GLHD@(IDORD,"id-status")=$$GET(A,"status") S @GLHD@(IDORD,"id-price")=$$GET(A,"price") S @GLHD@(IDORD,"id-rest")=$$GET(A,"restaurantId") Q ; KILL ; Q K @GLTMP,@GLHD Q ; GETMENU(RESTID) ; S GLMENU="^[$$^W3MAIN]TMPMENU($J)" K @GLMENU ; S ^W3SOMSH(RESTID)=$G(^W3SOMSH(RESTID))+1 ;;I ^W3SOMSH(RESTID)#100 D TOMENU ; I $D(^[$$^W3MAIN]W3SOM(RESTID,+$H))>9,^W3SOMSH(RESTID)#10 D .N COUNT .S COUNT=$O(^[$$^W3MAIN]W3SOM(RESTID,+$H,999999),-1) Q:'COUNT .K @GLMENU .M @GLMENU=^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT) ; N OK,I S I=0 N N S N="" F S N=$O(@GLMENU@(N)) Q:N="" D .I $G(^(N))?.P S I=I+1 I I>3 K @GLMENU ; I '(^W3SOMSH(RESTID)#10)!($D(@GLMENU)<10)!'$D(^[$$^W3MAIN]W3SOM(RESTID,+$H)) D .D ^W3SOMENU(RESTID) ; I $D(@GLMENU)<10 D TOMENU Q W3SORD1 W3SORD(RESTID) ; [ 04.07.13 04:43 ] [ 18.06.13 17:56 ] [ 22.04.13 22:38 ] N (%ARG,%REM,M,RESTID) D ^%L1TS ; I RESTID'=0 D GETMENU(RESTID) ; D GETORDS^W3SOFUNC(RESTID) ; D GL^W3SOCON D GLMENU S GLTMP="^[$$^W3MAIN]TMPSORD($J)" S GLHD="^[$$^W3MAIN]TMPSOHD($J)" I $G(SOER) W $G(SOER1),! G END ; S GL0=GL,PTR=" ",IDORD="",I=0 ; K @GLTMP,@GLHD,PTRID F S GL0=$Q(@GL0) Q:GL0="" D .;W GL0,"=",$G(@GL0),! .S UR=$L(GL0,",") .F U=UR+1:1:11 K PTRID(U) .S GL00=$P(GL0,",",1,$L(GL0,",")-1)_")" .S PTR=$P($G(@GL00),",") S:PTR="" PTR=" " .S A=$G(@GL0) .I A["=" S PTRID(UR)=$P(A,"=") . .I UR=5 D ..I A["=" S A=$P(A,"=",2,200) ..S IDORD=$$GET(A,"id") Q:IDORD="" ..S @GLHD@(IDORD,"id-comment")=$$GET(A,"comment") ..S @GLHD@(IDORD,"id-status")=$$GET(A,"status") ..S @GLHD@(IDORD,"id-price")=$$GET(A,"price") ..S @GLHD@(IDORD,"id-rest")=$$GET(A,"restaurantId") . .I UR=6!(UR=7)!(UR=8),'$$ITEM(A) D GETRKV(IDORD,A,UR) S PTR=$P(A,",") . .I UR=7!(UR=10),$$ITEM(A) D Q ..N MAIN S MAIN=0 I UR=7 S MAIN=1 K MAINQN ..I A["=" S A=$P(A,"=",2,200) ..S CD=$$GET(A,"itemId") Q:CD="" ..S CDR=$S($G(@GLMENU@(CD,"EXT")):^("EXT"),1:"0-"_CD) ..S NAME=$TR($G(@GLMENU@(CD)),"()","") ..S NAME=$TR(NAME,"\~*","/-X") ..S PRC=$$GET(A,"price") ..S CMNT=$$GET(A,"comment") ..S QN=$$GET(A,"count") I 'QN S QN=$S(MAIN:1,$G(MAINQN):MAINQN,1:1) ..I MAIN S MAINQN=QN ..S ST=$S(MAIN:"0",1:1)_"~"_CDR_"~"_NAME_"~"_$J(PRC*.01,2,2)_"~"_QN ..S $P(ST,"~",7)=CMNT ..I IDORD S I=I+1,@GLTMP@(IDORD,I)=ST . D ZAP ; I $D(@GL@(1,1,1))>9 D .N GLA S GLA="^[$$^W3MAIN]W3SOA(+$H," .N COUNT S COUNT=$O(^[$$^W3MAIN]W3SOA(+$H,99999),-1)+1 .S GLA=GLA_COUNT_")" .M @GLA=@GL .M ^[$$^W3MAIN]W3SOM(RESTID,+$H,COUNT)=@GLMENU ; END K @GL,@GLTMP,@GLMENU,@GLHD Q ; ; GETRKV(PTR,A,UR) ; N T S T="" I A["=" S T=$$CLRQ($P(A,"=")),A=$P(A,"=",2,40) I T="",$G(PTRID(UR))'="" S T=$$CLRQ(PTRID(UR)) S A=$$CLRZPT(A) N J F J=1:1:$L(A,",") D .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S IND=$$CLRQ(IND) .S PTR=$$CLRQ(PTR) .S:PTR="" PTR=" " Q:IND="" .S CONT=$P(COUPLE,":",2) .S CONT=$$FUNC^%UCASE(CONT) .S CONT=$$CLRQ(CONT) .I T'="" S IND=T_"="_IND .I $D(@GLHD@(PTR,IND)) D ..N J1 F J1=1:1 Q:'$D(@GLHD@(PTR,$P(IND,"-")_"-"_J1)) ..S IND=$P(IND,"-")_"-"_J1 .S @GLHD@(PTR,IND)=CONT Q ; GET(A,RKV) ; N COUPLE,IND,CONT,OK,BG S OK=0 S A=$$CLRZPT(A) N J,J1 F J=1:1:$L(A,",") D Q:OK .S COUPLE=$P(A,",",J) Q:COUPLE="" Q:COUPLE'[":" .S IND=$P(COUPLE,":") Q:IND="" .S BG=$F(A,IND) .S IND=$$CLRQ(IND) .Q:IND="" .I IND=RKV S OK=1 S CONT=$P(COUPLE,":",2) I OK Q $$CLRQ($$FUNC^%UCASE(CONT)) Q "" ; ITEM(A) ; I $TR($P($P(A,","),":"),"""","")["itemId" Q 1 Q 0 ; CLRQ(TXT) ; S:$E(TXT)="""" TXT=$TR(TXT,"""","") I TXT[$C(215) S TXT=$$W2L(TXT) S TXT=$TR(TXT,"\~*","/-X") Q TXT ; W2L(TXT) ; N OU S OU="" N J S J=0 W2LC ; S J=J+1 I J>$L(TXT) G W2LCE I $A(TXT,J)=215 S OU=OU_$C($A(TXT,J+1)-48),J=J+1 G W2LC S OU=OU_$E(TXT,J) G W2LC W2LCE Q $$^%W1H2U(OU) ; ; ZAP ; N ORD,I,JB S ORD="" F S ORD=$O(@GLHD@(ORD)) Q:ORD="" D .S JB=$$^%W1SsID("TMPSO") .K ^[$$^W3MAIN]TMPORD(JB) S I=0 .N N S N="" F S N=$O(@GLTMP@(ORD,N)) Q:N="" D ..S I=I+1 M ^[$$^W3MAIN]TMPORD(JB,I)=@GLTMP@(ORD,N) .K @GLTMP@(ORD) .D ZAPHD(ORD) K @GLHD@(ORD) .W "ORD:"_ORD_" OK="_OK,! Q ; ZAPHD(ORD) ; N (JB,%ARG,ORD,GLHD,OK,RESTID) S OK=0 S REST=$G(@GLHD@(ORD,"id-rest")) Q:REST="" S REST=$$FUNC^%LCASE(REST) ; I RESTID'=0 Q:REST'=RESTID I RESTID=0 D GETMENU(REST) ; S MSD=^[$$^W3MAIN]W3SOR2M(REST) Q:MSD="" S ^[$$^W3MAIN]TMPORD(JB,"MSD")=MSD S CITY=$G(@GLHD@(ORD,"address=city")) S DLVMETHOD=$G(@GLHD@(ORD,"delivery=type")) S NAME=$G(@GLHD@(ORD,"contact=lastName"))_" "_$G(@GLHD@(ORD,"contact=firstName")) S PHONE01=$G(@GLHD@(ORD,"contact=phone")) S PHONE01=$$RPL^%L1FRM(PHONE01,"+972",0) S PHONE02="" S CODE=$S(PHONE01:PHONE01,1:1111111) D PUT^%W1PRM("CODE",CODE) S ZMANK=$ZD($H,"DD.MM.YY 24:60") S ASM=ORD ; S DMSH=$G(@GLHD@(ORD,"delivery=charge"))*.01 S HNH=-$G(@GLHD@(ORD,"charges=amount"))*.01 S AHUZ="" ;;-$G(@GLHD@(ORD,"charges=amountRule"))*.01 S TOTIME="" 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,DLVMETHOD'="TAKEOUT" D .S SHAA=$$TM^W3TIME($H,CITY) ; S TOPAY=0 S TOPAY=$G(@GLHD@(ORD,"id-price")) ; I TOPAY D .D PUT^W3HZMST(JB,"TSHL",$G(TOPAY)) ; D PUT^W3HZMST(JB,"NAME",NAME) D PUT^W3HZMST(JB,"NMB",CODE) D PUT^W3HZMST(JB,"CODE",CODE) D PUT^W3HZMST(JB,"PELE",PHONE01) 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","15") ; SOI D PUT^W3HZMST(JB,"DMSH",$G(DMSH)) D PUT^W3HZMST(JB,"HNH",$G(HNH)) D PUT^W3HZMST(JB,"AHUZ",$G(AHUZ)) ; S HOME=$G(@GLHD@(ORD,"address=number")) S STREET=$G(@GLHD@(ORD,"address=street")) I DLVMETHOD="TAKEOUT" S STREET="TAKEAWAY" S COMMENT=$G(@GLHD@(ORD,"address=comment")) S CMHD=$G(@GLHD@(ORD,"id-comment")) S FLAT=$G(@GLHD@(ORD,"address=apt")) S COMP="" S ENTRANCE=$G(@GLHD@(ORD,"address=entrance")) S FLOOR=$G(@GLHD@(ORD,"address=floor")) ; 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_":SO "_CMHD) ; S PYTYPE(0)=$G(@GLHD@(ORD,"payments=type")) S AMOUNT(0)=$G(@GLHD@(ORD,"payments=amount"))*.01 S CARD(0)=$G(@GLHD@(ORD,"card=number")) S CVV(0)=$G(@GLHD@(ORD,"card=csc")) S MM(0)=$G(@GLHD@(ORD,"card=expireMonth")) S YY(0)=$G(@GLHD@(ORD,"card=expireYear")) S TZ(0)=$G(@GLHD@(ORD,"card=holderId")) ; S EJ=0,CASH=0 I PYTYPE(0)="CASH",AMOUNT(0) S CASH=1 F J=1:1:10 D Q:EJ .S PYTYPE(J)=$G(@GLHD@(ORD,"payments=type-"_J)) .I PYTYPE(J)="CASH" S CASH=1 .I PYTYPE(J)="" S EJ=1 K PYTYPE(J) Q .S CARD(J)=$G(@GLHD@(ORD,"card=number-"_J)) .S CVV(J)=$G(@GLHD@(ORD,"card=csc-"_J)) .S AMOUNT(J)=$G(@GLHD@(ORD,"payments=amount-"_J))*.01 .S MM(J)=$G(@GLHD@(ORD,"card=expireMonth-"_J)) .S YY(J)=$G(@GLHD@(ORD,"card=expireYear-"_J)) .S TZ(J)=$G(@GLHD@(ORD,"card=holderId-"_J)) ; S CI=0,CREDCARD="",CREDSUM="",CREDMMYY="",CREDTZ="",CREDCVV="" F J=0:1 Q:'$D(PYTYPE(J)) D .I PYTYPE(J)="CREDIT" D ..S CI=CI+1 ..S CREDCARD=CREDCARD_$$^W3ENCR(JB_";"_$G(CARD(J)))_"^" ..S CREDSUM=CREDSUM_$G(AMOUNT(J))_";" ..S CREDMMYY=CREDMMYY_$TR($J($G(MM(J)),2)," ",0)_$E($G(YY(J)),3,4)_";" ..S CREDTZ=CREDTZ_$$^W3ENCR(JB_";"_$G(TZ(J)))_"^" ..S CREDCVV=CREDCVV_$G(CVV(J))_";" ; I CREDSUM D .D PUT^W3HZMST(JB,"CREDCARD",$E(CREDCARD,1,$L(CREDCARD)-1)) .D PUT^W3HZMST(JB,"CREDSUM",$E(CREDSUM,1,$L(CREDSUM)-1)) .D PUT^W3HZMST(JB,"CREDMMYY",$E(CREDMMYY,1,$L(CREDMMYY)-1)) .D PUT^W3HZMST(JB,"CREDTZ",$E(CREDTZ,1,$L(CREDTZ)-1)) .D PUT^W3HZMST(JB,"CREDCVV2",$E(CREDCVV,1,$L(CREDCVV)-1)) ; N CODTS S CODTS=$S(CASH:1,1:3) D PUT^W3HZMST(JB,"CODTS",CODTS) ; ; I $D(^[$$^W3MAIN]W3SO(REST,ORD)) K ^[$$^W3MAIN]TMPORD(JB) G EZ ; D NEWHZ S ^[$$^W3MAIN]W3SO(REST,ORD)=$H I $G(OK)=1 D SENDOK(REST,ORD) EZ Q ; SENDOK(REST,ORD) ; D CHORDSTA^W3SOFUNC(REST,ORD,"accepted") Q ; NEWHZ ; D TERM^W3ORDVW ; -- OK=1 K ^[$$^W3MAIN]TMPORD(JB) Q ; CLRZPT(A) ; N J,QU S A=$$CLRKV(A) S J=0,QU=0 CLRZPTC S J=J+1 I J>$L(A) G CLRZPTE I $E(A,J)="""" S QU='QU G CLRZPTC I $E(A,J)=",",QU S $E(A,J)=" " G CLRZPTC I $E(A,J)=":",QU S $E(A,J)="-" G CLRZPTC G CLRZPTC CLRZPTE Q A ; CLRKV(A) ; N J F J=1:1:$L(A) D .I $E(A,J)="""",$E(A,J-1)="\" S $E(A,J-1)="'" S $E(A,J)="'" Q A ; GETMENU(REST) ; D ^W3SOMENU(REST) D GLMENU ; I $D(@GLMENU)<10 D .N LASTD,LASTIND S (LASTD,LASTIND)="" LAST .S LASTD=$O(^[$$^W3MAIN]W3SOM(REST,LASTD),-1) Q:LASTD="" .S LASTIND=$O(^[$$^W3MAIN]W3SOM(REST,LASTD,LASTIND),-1) Q:LASTIND="" .I $D(^[$$^W3MAIN]W3SOM(REST,LASTD,LASTIND))<10 G LAST .M @GLMENU=^[$$^W3MAIN]W3SOM(REST,LASTD,LASTIND) ; Q ; GLMENU ; S GLMENU="^[$$^W3MAIN]TMPMENU($J)" Q W3SP W3SP ; [ 24.04.22 16:43 ] [ 12.04.22 17:52 ] [ 29.10.18 15:50 ] Q ; DMS(IRI) ; I $$GET^%W1PRM("TAW") Q 0 I $G(IRI)=""!'$D(@$$^W4GL("P1IR")) Q $J($$DSHL^W4PRM,2,2) Q $J($$FIND(IRI,1),2,2) ; ZMSHD(IRI) ; I $G(IRI)="" Q "" Q +$$FIND(IRI,2) ; MHMIN(IRI) ; S IRI=$G(IRI) I $TR(IRI," .","")="TAKEAWAY"!($TR(IRI," .","")="TAW")!(IRI["zgwl") Q $$MHMIN1 ; N MHMIN S MHMIN="" I $$POLYGON^W4PRM,$$GETP^%W1PRM("AZRPLGN") D I MHMIN'="" Q MHMIN .N PRM S PRM=$$GETP^%W1PRM("AZRPLGN") .N MAP,AZ S MAP=$P(PRM,";"),AZ=$P(PRM,";",2) .I MAP=""!(AZ="") Q .S MHMIN=$$MHMIN^W3AZRIDK(MAP,AZ) ; I $G(IRI)=""!'$D(@$$^W4GL("P1IR")) Q $$MHMIN1 N NR ;;S NR=4 I $$DLVWEB^W4DLVCSR S NR=6 S NR=6 N MHMIN S MHMIN=$J($$FIND(IRI,NR),2,2) I 'MHMIN Q $$MHMIN1 I MHMIN>1000 S MHMIN="" Q MHMIN ; ; MHMIN1(STAM) ; ;;N MSD S MSD=$$GET^%W1PRM("MSD") I 'MSD Q 0 ;;N CODE S CODE=$$GET^%W1PRM("CODE") Q $J($G(@$$^W4PRM@("MSLMHMIN")),2,2) ; ; MHCNC(IRI) ; N MHCNC S MHCNC="" I $$POLYGON^W4PRM,$$GETP^%W1PRM("AZRPLGN") D I MHCNC Q MHCNC .N PRM S PRM=$$GETP^%W1PRM("AZRPLGN") .N MAP,AZ S MAP=$P(PRM,";"),AZ=$P(PRM,";",2) .I MAP=""!(AZ="") Q .S MHCNC=$$DLVCNC^W3AZRIDK(MAP,AZ) ; I $G(IRI)=""!'$D(@$$^W4GL("P1IR")) Q $J($G(@$$^W4PRM@("TSHLDM")),2,2) N MHCNC S MHCNC=$J($$FIND(IRI,3),2,2) I 'MHCNC S MHCNC=$J($G(@$$^W4PRM@("TSHLDM")),2,2) I MHCNC>1000 S MHCNC="" Q MHCNC ; ; TMARV(IRI) ; N TMARV I $$POLYGON^W4PRM,$$GETP^%W1PRM("AZRPLGN") S TMARV=$$TMARVPLGN I TMARV Q TMARV Q $$THZ^W3TIME($G(IRI)) ; TMARVPLGN(STAM) ; N PRM S PRM=$$GETP^%W1PRM("AZRPLGN") N MAP,AZ S MAP=$P(PRM,";"),AZ=$P(PRM,";",2) I MAP=""!(AZ="") Q N TMARV S TMARV=$$DLVTM^W3AZRIDK(MAP,AZ) Q TMARV ; FIND(IRI,IND) N (JB,%ARG,IRI,IND) S OK=0 S IRI=$$CLEAR^%L1FRM($$CNWEB^%L1FRM(IRI)) N STREETI S STREETI=$$SPA^%L1FRM($P(IRI,":",2)) N HOME S HOME=$P(IRI,":",3) S IRI=$$SPA^%L1FRM($P(IRI,":")) N IR S IR=$$INV(IRI) N STREET S STREET=$$INV(STREETI) ; S N="" F S N=$O(@$$^W4GL("P1IR")@(N)) Q:N="" D Q:OK .N IR1 S IR1=$TR($G(^(N)),"-"," ") .I IR1=$TR(IR,"-"," ")!(IR1=$TR($$INV(IR),"-"," ")) S OK=1 Q I 'OK Q "" ; N FND S FND="" N CNTRY S CNTRY=$$COUNTRY ; I $L(STREETI),$L(IRI),$D(@$$^W4GL("W3AZR")@(CNTRY,IRI))>9 D I $L(FND) Q FND .N STR .N INDEX S INDEX="" .F S INDEX=$O(@$$^W4GL("W3AZS")@(CNTRY,IRI,INDEX)) Q:INDEX="" D Q:$L(FND) ..N AZ S AZ=$G(^(INDEX)) Q:'AZ ..S STR=$$SPA^%L1FRM($P(INDEX,":")) ..S MEHOME=$P(INDEX,":",2) ..S ADHOME=$P(INDEX,":",3) ..I STREETI=STR,HOME'ADHOME D ...Q:'$D(@$$^W4GL("W3AZR")@(CNTRY,IRI,AZ)) ...N A S A=$G(@$$^W4GL("W3AZR")@(CNTRY,IRI,AZ,1)) ...S FND=$P(A,"\",IND) ; S FND=$G(@$$^W4GL("P1IR")@(N,1)) ; Q $P(FND,"\",IND) ; ; INV(TXT) ; I $$^%W1DIR="LTR" Q TXT Q $$INV^%L1FRM(TXT) ; COUNTRY(STAM) ; N MSD S MSD=$$GET^%W1PRM("MSD") I 'MSD Q "IS" Q $$COUNTRY^W3R(MSD) ; EXSTREET(PRM) ; N CITY,STREET S CITY=$P(PRM,";") S STREET=$P(PRM,";",2) I CITY="" Q 0 I STREET="" Q 0 S CITY=$$CNWEB^%L1FRM(CITY) S STREET=$$CNWEB^%L1FRM(STREET) I CITY="" Q 0 I STREET="" Q 0 S CNTRY=$$COUNTRY I CNTRY="" Q 0 Q $D(^[$$^W3MAIN]P1STREET(CNTRY,CITY,STREET)) ; CITY(CITY) S CITY=$$SPA^%L1FRM(CITY) I $$^%W1LNG="H" S CITY=$TR(CITY,"-"," ") I CITY="eti aia` lz" S CITY="aia` lz" I CITY="aia`lz" S CITY="aia` lz" I CITY="`""z" S CITY="aia` lz" I CITY="b""x" S CITY="ob znx" I CITY="z""t" S CITY="deewz gzt" I CITY="v""ly`x" S CITY="oeivl oey`x" Q CITY W3ST W3ST ; [ 07.08.18 16:59 ] [ Q MVC(ST) ; Q $P(ST,"~",17) ; SETMVC(%ST,VL) ; S $P(@%ST,"~",17)=VL Q W3STREE0 W3STREET ; [ 13.09.17 19:01 ] [ 08.08.17 10:17 ] [ 16.03.12 14:23 ] N (JB,CITY,FIND,%ARG,%W1LNG) I $G(CITY)=""!($G(FIND)="") Q ;;S %W1LNG=$$GET^%W1PRM("LNG") S COUNTRY=$$COUNTRY^W3AZRIDK S MUSTAZR=0 S GL="^[$$^W3MAIN]P1STREET(COUNTRY)" I $G(@$$^W4GL("W3AZR")@(COUNTRY,CITY)) D .S MUSTAZR=1 .S GL=$$^W4GL("W3AZS")_"(COUNTRY)" ; K ^[$$^W3MAIN]TMPST(JB) ;;D KILL^%W3DEB("W3HZORD") ; S CITY=$$SPA^%L1FRM($$CLEAR^%L1FRM(CITY)) S FIND=$$SPA^%L1FRM($$CLEAR^%L1FRM(FIND)) ; S ENG=0 I $$ENG^W4FIND(FIND)!($$^%W1DIR="LTR") S FIND=$$FUNC^%UCASE(FIND),ENG=1 ; D PUT^%W3DEB("W3STREET","CITY=CITY & FIND=FIND & %ARG=[%ARG") ; N CT,OK,CTE,CITYE S OK=0,CT="" F S CT=$O(@GL@(CT)) Q:CT="" D Q:OK .S CTE=CT I ENG S CTE=$$FUNC^%UCASE(CT) .S CITYE=CITY I ENG S CITYE=$$FUNC^%UCASE(CITY) .I $TR(CITYE,"-"," ")=$TR(CTE,"-"," ") S OK=1 Q ; I 'OK Q ; N CITY S CITY=CT I $G(CITY)=""!($G(FIND)="") Q D PUT^%W3DEB("W3STREET","CT=CT") ; I $D(@GL@(CITY))<10 Q ; I MUSTAZR D G VIEW ; -- HIPUS LEFI AZORIM .S ST=FIND_$J("",25-$L(FIND)) .I ENG S ST="" .F S ST=$O(@GL@(CITY,ST)) Q:ST="" S STE=ST S:ENG STE=$$FUNC^%UCASE(ST) Q:(STE'[FIND)&'ENG D ..I STE'[FIND Q ..D ADDTBL(A) ; K ^[$$^W3MAIN]TMPS(JB) N FND F J=1:1:$L(FIND," ") S FND=$P(FIND," ",J) D .S ST=FND .I $D(@GL@(CITY,ST)) D ..S A=$G(^(ST)) ..S INVA=$$INVH^%L1FRM(A) ..S ^[$$^W3MAIN]TMPS(JB,INVA)="" . .I ENG S ST="" . .F S ST=$O(@GL@(CITY,ST)) Q:ST="" S STE=ST S:ENG STE=$$FUNC^%UCASE(ST) Q:(STE'[FND)&'ENG D ..I STE'[FND Q ..S A=$G(^(ST)) ..S INVA=$$INVH^%L1FRM(A) ..S ^[$$^W3MAIN]TMPS(JB,INVA)="" ; D .S IND=0 .N N S N="" F S N=$O(^[$$^W3MAIN]TMPS(JB,N)) Q:N="" D ..N A,INVA ..S INVA=N,A=$$INVH^%L1FRM(INVA) ..S OK=1 ..I ENG S INVA=$$FUNC^%UCASE(INVA) ..F I=1:1:$L(FIND," ") D Q:'OK ...S FND=$P(FIND," ",I) ...I (" "_INVA)'[(" "_FND) S OK=0 ..Q:'OK ..S IND=IND+1,^[$$^W3MAIN]TMPST(JB,IND)=A VIEW ; W "",! ; F I=1:1 Q:'$D(^[$$^W3MAIN]TMPST(JB,I)) D .W " " .W " " .W " ",! W "
" .W " " . W $$H2U^%L1FRM($G(^[$$^W3MAIN]TMPST(JB,I))) .W " ",! .I $$^W4SMALL W "
",! .W "
",! Q ADDTBL(ST) ; N IND,STREET I ST[":" S ST=$P(ST,":") S ST=$$SPA^%L1FRM(ST) I MUSTAZR S STREET=$$INVH^%L1FRM(ST) I 'MUSTAZR S STREET=ST S IND=$O(^[$$^W3MAIN]TMPST(JB,99999),-1)+1 S ^[$$^W3MAIN]TMPST(JB,IND)=STREET Q W3STREET W3STREET ; [ 16.08.21 11:15 ] [ 27.06.21 11:27 ] [ 13.09.17 19:36 ] N (JB,CITY,FIND,%ARG,%W1LNG) I $G(CITY)=""!($G(FIND)="") Q I $G(COUNTRY)="" S COUNTRY=$$COUNTRY^W3PRM I COUNTRY="" S COUNTRY="IS" S FIND=$$CNWEB^%L1FRM(FIND) ;;S %W1LNG=$$GET^%W1PRM("LNG") S MUSTAZR=0 I $G(CITY)?1N.N S CITY=$$INV^%L1FRM($G(@$$^W4GL("P1IR")@(CITY))) I $G(CITY)="" Q D GL I $G(@$$^W4GL("W3AZR")@(COUNTRY,CITY)) D .S MUSTAZR=1 .S GL=$$^W4GL("W3AZS")_"(COUNTRY)" ; K ^[$$^W3MAIN]TMPST(JB) ; S CITY=$$SPA^%L1FRM($$CLEAR^%L1FRM(CITY)) S FIND=$$SPA^%L1FRM($$CLEAR^%L1FRM(FIND)) ; S ENG=0 I $$ENG^W4FIND(FIND)!($$^%W1DIR="LTR") S FIND=$$FUNC^%UCASE(FIND),ENG=1 ; D PUT^%W3DEB("W3STREET","CITY=CITY & FIND=FIND & %ARG=[%ARG") ; N CT,OK,CTE,CITYE S OK=0,CT="" F S CT=$O(@GL@(CT)) Q:CT="" D Q:OK .S CTE=CT I ENG S CTE=$$FUNC^%UCASE(CT) .S CITYE=CITY I ENG S CITYE=$$FUNC^%UCASE(CITY) .I $TR(CITYE,"-"," ")=$TR(CTE,"-"," ") S OK=1 Q ; I 'OK Q ; N CITY S CITY=CT I $G(CITY)=""!($G(FIND)="") Q D PUT^%W3DEB("W3STREET","CT=CT") ; I $D(@GL@(CITY))<10 Q ; I MUSTAZR D G VIEW ; -- HIPUS LEFI AZORIM .S ST=FIND_$J("",25-$L(FIND)) .I ENG S ST="" .F S ST=$O(@GL@(CITY,ST)) Q:ST="" S STE=ST S:ENG STE=$$FUNC^%UCASE(ST) Q:(STE'[FIND)&'ENG D ..I STE'[FIND Q ..D ADDTBL(A) ; D FIND(CITY,FIND) ; VIEW ; W "",! ; F I=1:1 Q:'$D(^[$$^W3MAIN]TMPST(JB,I)) D .W " " .W " " .W " ",! W "
" .W " " . W $$H2U^%L1FRM($G(^[$$^W3MAIN]TMPST(JB,I))) .W " ",! .I $$^W4SMALL W "
",! .W "
",! Q ; ADDTBL(ST) ; N IND,STREET I ST[":" S ST=$P(ST,":") S ST=$$SPA^%L1FRM(ST) I MUSTAZR S STREET=$$INVH^%L1FRM(ST) I 'MUSTAZR S STREET=ST S IND=$O(^[$$^W3MAIN]TMPST(JB,99999),-1)+1 S ^[$$^W3MAIN]TMPST(JB,IND)=STREET Q ; ; FIND(CITY,FIND) ; N ST,STE,IND,A,J,ER D GL S ST="",IND=0 F S ST=$O(@GL@(CITY,ST)) Q:ST="" S STE=ST S:ENG STE=$$FUNC^%UCASE(ST) D .S A=$G(^(ST)) .S ER=0 .F J=1:1:$L(FIND," ") S FND=$P(FIND," ",J) D Q:ER ..I (" "_STE)'[(" "_FND) S ER=1 Q .Q:ER .S IND=IND+1 .S ^[$$^W3MAIN]TMPST(JB,IND)=A Q ; GL ; S COUNTRY=$$COUNTRY^W3AZRIDK S GL="^[$$^W3MAIN]P1STREET(COUNTRY)" Q W3SUBMIT W3SUBMIT ; [ 02.12.07 20:35 ] [ 13.11.07 07:15 ] [ 11.11.07 08:26 ] N (JB,%ARG) S MSD=$$GET^%W1PRM("MSD") I MSD="" D BACK2PSW("NORESTN") Q I '$D(%ARG("PRM")) D BACK2PSW("NOARG") Q S PRM=%ARG("PRM") S USER=$P(PRM,"~") S PSW=$P(PRM,"~",2) S PSW=$$DESCR(PSW) S PRM=USER_"~"_PSW I '$$TEST^W3ORDLK(PRM) D BACK2PSW("USERPSWINVALID") Q D PUT^%W1PRM("CODE",USER) D PUT^%W1PRM("PRM",%ARG("PRM")) D VIEW Q ; BACK2PSW(MSG) ; W "",! Q DESCR(PSW) ; N A,J S A="" F J=1:1:$L(PSW) D .;;S A=A_$C($A(PSW,J)-J-16) .S A=A_$C(170-$A(PSW,J)) Q A ; VIEW ; W "
",! D HDMSD^W3ORDVW(MSD) N WD S WD=$S($$^%W1LNG="H":"57%",1:"70%") W "",! W "",! W "
"_$$^%W1DICT("HI")_", "_$$H2U^%L1FRM($$LKH^W3L(USER))_"
",! W ! W "


",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "
",! W "",! W "",! W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W ! W " ",! W " ",! W " ",! W ! W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W "
"_$$^%W1DICT("WHATTODO")_"
",! W "
",! W "" W "
",! W "" W "
",! W "" W "
",! W "" W "
",! W "		 
 
 
"_$$^%W1DICT("LEVMAIN")_"
WWW.2ORDER.ORG
",! W "
",! Q W3SVZ W3SVZ ; [ 17.09.18 06:15 ] [ 26.05.16 12:15 ] [ 27.11.12 13:29 ] H 1 Q BG I $$^%L1FLAG("^flag(""SVZ"")") G END I '$G(^flag("SVZ")) S ^flag("SVZ")=$J S FILE="w3svz" ZSY "rm -f "_FILE ZSY "ps -fC mumps > "_FILE N $ZT S $ZT="G CLOSE" O FILE:(REWIND:READONLY) F U FILE R A Q:$ZEOF D .I A["W3AS" D ..S A=$$SP1^%L1FRM(A) ..S NOM=$P(A," ",2) ..S TIME=$P(A," ",5) ..S MNT=TIME*60+$P(TIME,":",2) ..I $P($H,",",2)\60-MNT>4!($P($H,",",2)\60-MNT<-4) D ...ZSY "kill -9 "_NOM S ^W3SVZ("KILL",$ZD($H,"DD.MM.YY 24.60"))="" CLOSE C FILE H 120 G BG END Q W3TB W3TB ; [ 06.01.22 07:49 ] [ 04.01.22 15:39 ] [ 01.01.18 12:54 ] N D INIT S $ZT="ZG "_$ZL_":ER^W3TB" I $$^%L1FLAG("^flag(""TB"")") Q D SETFLAG("TB") ; K ^[$$^W3MAIN]W3TBM S REST="",SHR=0 F S REST=$O(^[$$^W3MAIN]W3TBR2M(REST)) Q:REST="" D .S MSD=$G(^(REST)) Q:MSD="" .I $D(^[$$^W3MAIN]W3TBM(MSD)) Q .S SHR=SHR+1 .S ^[$$^W3MAIN]W3TBM(MSD)="" ; S MYMSD="" ASK S $ZT="ZG "_$ZL_":ER^W3TB" S MYMSD=$O(^[$$^W3MAIN]W3TBM(MYMSD)) D ^W3TBGET(1,"GetPendingOrders",VEND,MYMSD) ; S LISTORD="GetPendingOrdersResponseMsg" S NUMPORD="NumOfPendingOrders" S ORDER="OrderLineElement" S POOLID="PoolID" S ORDID="OrderID" S RESID="ResID" S ORDSTAT="OrderStatus" S ORDTYPE="OrderType" S SUCCESS="Success" ; S GL="^[$$^W3MAIN]TMPBIS(MYDVN,1)" ; S I=0 CYC S I=I+1 I '$D(@GL@(I)) G END S A=$G(^(I)) I A[("<"_LISTORD) D .S BGLO=I .S SUCCESS=$$GET(BGLO,"Success",LISTORD) .I $$FUNC^%UCASE(SUCCESS)'="TRUE" S I=$$FINDEND(BGLO,LISTORD,"") Q .S BGOI=BGLO CYCORD .S BGOI=$$FIND(BGOI,ORDER,LISTORD) .I 'BGOI S I=$$FINDEND(BGOI,ORDER,LISTORD) Q . .S STATUS=$$GET(BGOI,ORDSTAT,ORDER) .; .I $$FUNC^%UCASE(STATUS)'="PENDING" G ENDORD .;;I STATUS'="InProcess" G ENDORD . .S REST=$$GET(BGOI,RESID,ORDER) .S MSD=$G(^[$$^W3MAIN]W3TBR2M(REST)) .I MSD="" D PROT(NOMTB,"RESTWRONG:"_REST,BGOI) G ENDORD .I MSD'=MYMSD Q .S ORDTP=$$GET(BGOI,ORDTYPE,ORDER) .; .I $$FUNC^%UCASE(ORDTP)="STANDARD" D I 'ORDNMB G ENDORD ..S ORDNMB=$$GET(BGOI,ORDID,ORDER) Q:'ORDNMB ..N IND S IND=VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB ..I $D(^[$$^W3MAIN]W3TBORD(IND)) Q ..D ^W3TBGET(2,"GetSingleOrder",VEND_"/"_ORDNMB,MYMSD) ..D ^W3TBORD(2,MSD,IND) .. .I $$FUNC^%UCASE(ORDTP)="POOLED" D I 'ORDNMB G ENDORD ..S ORDNMB=$$GET(BGOI,POOLID,ORDER) Q:'ORDNMB ..N IND S IND=VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB ..I $D(^[$$^W3MAIN]W3TBORD(IND)) Q ..D ^W3TBGET(2,"GetPoolOrder",VEND_"/"_ORDNMB,MYMSD) ..D ^W3TBORD(2,MSD,IND) . ENDORD .S BGOI=$$FINDEND(BGOI,ORDER,LISTORD) .G CYCORD ; G CYC ; END D KILLTMP I $G(MYMSD) G ASK ; -- 04/01/22 ; I '$G(SHR) S SHR=2 ;;H 120/SHR H 10 K ^[$$^W3MAIN]TMPBISA($H-30) G ASK ; ; KILLTMP ; K ^[$$^W3MAIN]TMPBIS(MYDVN) Q ; MYDVN ; S MYDVN=$$^%L3MYDVN Q ; GET(I,EL,PARENT) Q $$GET^W3TBORD($G(I),$G(EL),$G(PARENT)) ; FIND(I,EL,PARENT,PR) ; Q $$FIND^W3TBORD($G(I),$G(EL),$G(PARENT),$G(PR)) ; FINDEND(I,EL,PARENT) ; Q $$FINDEND^W3TBORD($G(I),$G(EL),$G(PARENT)) ; PROT(NOMTB,CODER,NOMST) ; N GLPROT S GLPROT="^[$$^W3MAIN]W3TBPROT" S @GLPROT@(NOMTB,$O(@GLPROT@(NOMTB,9999),-1)+1)=$ZD($H,"DD.MM.YY 24:60")_"\"_CODER_"\"_NOMST S ERORD=1 Q ; SENDOK(PRM,MSD) ; D ^W3TBGET(2,"ChangeOrderStatus",PRM,MSD) N IND S IND=$P(PRM,"/",1,4) S ^[$$^W3MAIN]W3TBORD(IND)=$H_";"_$G(MSD) Q ; INIT ; D MYDVN S VEND="toorder" D KILLTMP Q ; ER ; D SVER^%L1X H ;G ASK ; SETFLAG(IND) ; Q:$G(IND)="" I '$G(^flag(IND)) S ^flag(IND)=$J,^flag(IND,"TIME")=$H Q W3TB0 W3TB ; [ 06.09.09 22:34 ] [ 17.08.09 11:53 ] [ 13.08.09 09:36 ] N D INIT ; ASK S $ZT="ZG "_$ZL_":ER^W3TB" D ^W3TBGET(1,"GetPendingOrders",VEND) ; S LISTORD="GetPendingOrdersResponseMsg" S NUMPORD="NumOfPendingOrders" S ORDER="OrderLineElement" S POOLID="PoolID" S ORDID="OrderID" S RESID="ResID" S ORDSTAT="OrderStatus" S ORDTYPE="OrderType" S SUCCESS="Success" ; S GL="^[$$^W3MAIN]TMPBIS(MYDVN,1)" ; S I=0 CYC S I=I+1 I '$D(@GL@(I)) G END S A=$G(^(I)) I A[("<"_LISTORD) D .S BGLO=I .S SUCCESS=$$GET(BGLO,"Success",LISTORD) .I $$FUNC^%UCASE(SUCCESS)'="TRUE" S I=$$FINDEND(BGLO,LISTORD,"") Q .S BGOI=BGLO CYCORD .S BGOI=$$FIND(BGOI,ORDER,LISTORD) .I 'BGOI S I=$$FINDEND(BGOI,ORDER,LISTORD) Q . .S STATUS=$$GET(BGOI,ORDSTAT,ORDER) .; .I $$FUNC^%UCASE(STATUS)'="PENDING" G ENDORD .;;I STATUS'="InProcess" G ENDORD . .S REST=$$GET(BGOI,RESID,ORDER) .S MSD=$G(^[$$^W3MAIN]W3TBR2M(REST)) .I MSD="" D PROT(NOMTB,"RESTWRONG:"_REST,BGOI) G ENDORD .S ORDTP=$$GET(BGOI,ORDTYPE,ORDER) .; .I $$FUNC^%UCASE(ORDTP)="STANDARD" D I 'ORDNMB G ENDORD ..S ORDNMB=$$GET(BGOI,ORDID,ORDER) Q:'ORDNMB ..N IND S IND=VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB ..I $D(^[$$^W3MAIN]W3TBORD(IND)) Q ..D ^W3TBGET(2,"GetSingleOrder",VEND_"/"_ORDNMB) ..D ^W3TBORD(2,MSD,IND) ..;;D SENDOK(VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB_"/InProcess") .. .I $$FUNC^%UCASE(ORDTP)="POOLED" D I 'ORDNMB G ENDORD ..S ORDNMB=$$GET(BGOI,POOLID,ORDER) Q:'ORDNMB ..N IND S IND=VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB ..I $D(^[$$^W3MAIN]W3TBORD(IND)) Q ..D ^W3TBGET(2,"GetPoolOrder",VEND_"/"_ORDNMB) ..D ^W3TBORD(2,MSD,IND) ..;;D SENDOK(VEND_"/"_REST_"/"_ORDTP_"/"_ORDNMB_"/InProcess") . ENDORD .S BGOI=$$FINDEND(BGOI,ORDER,LISTORD) .G CYCORD ; G CYC ; END D KILLTMP H 120 G ASK ; KILLTMP ; K ^[$$^W3MAIN]TMPBIS(MYDVN) Q ; MYDVN ; S MYDVN=$$^%L3MYDVN Q ; GET(I,EL,PARENT) Q $$GET^W3TBORD($G(I),$G(EL),$G(PARENT)) ; FIND(I,EL,PARENT,PR) ; Q $$FIND^W3TBORD($G(I),$G(EL),$G(PARENT),$G(PR)) ; FINDEND(I,EL,PARENT) ; Q $$FINDEND^W3TBORD($G(I),$G(EL),$G(PARENT)) ; PROT(NOMTB,CODER,NOMST) ; N GLPROT S GLPROT="^[$$^W3MAIN]W3TBPROT" S @GLPROT@(NOMTB,$O(@GLPROT@(NOMTB,9999),-1)+1)=$ZD($H,"DD.MM.YY 24:60")_"\"_CODER_"\"_NOMST S ERORD=1 Q ; SENDOK(PRM) ; D ^W3TBGET(2,"ChangeOrderStatus",PRM) N IND S IND=$P(PRM,"/",1,4) S ^[$$^W3MAIN]W3TBORD(IND)=$H_";"_$G(MSD) Q ; INIT ; D MYDVN S VEND="toorder" D KILLTMP Q ; ER ; D SVER^%L1X H ;G ASK W3TBGET W3TBGET(UR,FUNC,PARAMS,MYMSD) ; [ 18.12.18 06:37 ] [ 20.09.13 14:53 ] [ 14.08.13 15:50 ] N (UR,FUNC,PARAMS,NOMTB,MYMSD) ; S NOMTB=$O(^[$$^W3MAIN]TMPBISA(+$H,999999),-1)+1 ; S PARAMS=$G(PARAMS) S HEADER="""Content-Type:Application/xml""" ;;S POST="@/pos/10bis" S POST="@"_^[$$^W3MAIN]W3MAIN("WEBL")_MYMSD_"/10bis/10bis" D ^%L1TS ;;S URL="https://www.10bis.co.il/services/testservice.svc/testxml/" S URL="https://www.10bis.co.il/services/resservice.svc/xml/" ;;S CMD="curl -m 15 -N -s -H "_HEADER_" -d "_POST_" "_URL_FUNC_"/"_PARAMS ;;S CMD="curl -s -H "_HEADER_" -d "_POST_" "_URL_FUNC_"/"_PARAMS ;;S CMD=CMD_"|xml862.sh" S CMD="/pos/sbin/tbtst.sh "_MYMSD_" "_FUNC_"/"_PARAMS S CON="TBIS" D MYDVN^W3TB O CON:(COMMAND=CMD:READONLY)::"PIPE" K ^[$$^W3MAIN]TMPBISA($H-40) U CON S I=0 I FUNC'="ChangeOrderStatus" D .S GL="^[$$^W3MAIN]TMPBIS(MYDVN,UR)" .K @GL .;;F R A Q:$ZEOF S I=I+1,@GL@(I)=$TR(A,TSS,TS0) .F R A Q:$ZEOF S I=I+1,@GL@(I)=A .I $G(NOMTB) M ^[$$^W3MAIN]TMPBISA(+$H,NOMTB)=^[$$^W3MAIN]TMPBIS(MYDVN) D COMP(+$H,NOMTB,UR) C CON Q ; COMP(H,NOMTB,UR) ; Q:'$G(NOMTB) N GL,NOMPREV,I S GL="^[$$^W3MAIN]TMPBISA(H)" S NOMPREV=$O(@GL@(NOMTB),-1) I 'NOMPREV Q N OK S OK=1 F I=1:1 Q:'$D(@GL@(NOMTB,UR,I)) D Q:'OK .I $G(@GL@(NOMTB,UR,I))'=$G(@GL@(NOMPREV,UR,I)) D ..I $G(^(I))["") D Q:OK .I $L($G(SING)) D ..I A[("<"_SING) S PRSNG=1 ..I A[("") 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 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) ; I A'[("") D .N EZ,A1 S EZ=0 .N I1 F I1=I:1:I+10 D ..S A1=$$SPA^%L1FRM($G(@GL@(I1))) ..I $E(A1)["<" Q ..S ZN=ZN_A1 ; S ZN=$P(ZN,"") S ZN=$$REG(ZN) Q $$SPA^%L1FRM(ZN) ; NEWHZ ; D TERM^W3ORDVW ;;S ^[$$^W3MAIN]W3TBORD(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,".") 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) Q TXT ; REG(TXT) ; N ENG S ENG=0 I '$D(TSS) D ^%L1TS I $G(TXT)="" Q $G(TXT) S TXT=$TR(TXT,$C(13,10)," ") S TXT=$$RPL^%L1FRM(TXT,"&","&") S TXT=$$RPL^%L1FRM(TXT,"&qout;","'") S TXT=$$RPL^%L1FRM(TXT," "," ") ; S TXT=$$FUNC^%UCASE(TXT) S TXT=$TR(TXT,"`","'") S TXT=$TR(TXT,TSS,TS0) Q TXT ; CDTXT(STAM) ; Q 1 ;I MSD=1!(MSD=99999) Q 1 Q 0 ; POOLED(STAM) I $G(ORDTP)="POOLED" Q 1 Q 0 ; SINGLE(STAM) I $G(ORDTP)="STANDARD" Q 1 Q 0 ; OK(STAM) ; I OK&($D(@TMPORD)=11) Q 1 Q 0 ; FRMHDPS(BGOI,PARENT) ; N COUPONHNH,COUPONPAYER S TNBPAY=TNBPAY+$$GET(BGOI,"TenBisPayment",PARENT) S DMSH=$$GET(BGOI,"DeliveryPrice",PARENT) S HNH=HNH-$$GET(BGOI,"DeliveryDiscount",PARENT) S COUPONPAYER=$$GET(BGOI,"DiscountCouponBenefitPayer",PARENT) S COUPONHNH=-$$GET(BGOI,"DiscountCouponDiscount",PARENT) S COUPONHNHS=COUPONHNHS+COUPONHNH I COUPONHNH,$$RESTPAYER(COUPONPAYER) D .S COUPONHNHR=COUPONHNHR+COUPONHNH Q ; FRMHD(BGOI,PARENT) ; N ADDR,CITY,DLVMETHOD,PHONE01,PHONE02,ZMANK,ASM,DMSH N COUPONPAYER,TOTIME S ADDR=$$GET(BGOI,"AddressLine",PARENT) S CITY=$$SPA^%L1FRM($P($P(ADDR,",",2),".")) S DLVMETHOD=$$GET(BGOI,"DeliveryMethod",PARENT) S NAME=$$GET(BGOI,"Name",PARENT) S PHONE01=$$GET(BGOI,"Phone01",PARENT) S PHONE02=$$GET(BGOI,"Phone02",PARENT) S CODE=$S(PHONE01:PHONE01,1:PHONE02) I CODE="",MSD=1!(MSD=99999) S CODE="101010" D PUT^%W1PRM("CODE",CODE) S ZMANK=$ZD($H,"DD.MM.YY 24:60") S ASM=$$GET(BGOI,"OrderID",PARENT) ; I $$POOLED S ASM=$$GET(BGOI,"PooledOrderID",PARENT) ; I $$SINGLE D .S TNBPAY=$$GET(BGOI,"TenBisPayment",PARENT) .S DMSH=$$GET(BGOI,"DeliveryPrice",PARENT) .S HNH=-$$GET(BGOI,"DeliveryDiscount",PARENT) .S COUPONHD=$$GET(BGOI,"DiscountCouponCaptionForRes",PARENT) .S COUPONPAYER=$$GET(BGOI,"DiscountCouponBenefitPayer",PARENT) .S COUPONHNH=-$$GET(BGOI,"DiscountCouponDiscount",PARENT) .S COUPONHNHR=0 .I COUPONHNH,$$RESTPAYER(COUPONPAYER) D ..S HNH=HNH+COUPONHNH,COUPONHNHR=COUPONHNH,COUPONHNH=0 ..S TNBPAY=$J(TNBPAY,1,1)_":"_COUPONHNH_":"_COUPONHNHR ; S TOTIME=$$GET(BGSNG,"DesiredDeliveryTime",PARENT) ;;S TOFUTURE=$$GET(BGSNG,"DesiredDeliveryTime",PARENT) S TOFUTURE=$$GET(BGSNG,"FormatedTimeTitleStr",PARENT) I TOFUTURE?.E2N1"/".E S TOTIME=TOFUTURE ;;S ^AA("W3TBORD",+ASM)=TOTIME D .S DAT=$ZD($H,"DD.MM.YY"),SHAA="" .I TOTIME?.E2N1"/"2N1"/"4N1" "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!(SHAA>21),DLVMETHOD'="Pickup" D .N SHAA0 S SHAA0=SHAA .S SHAA=$$TM^W3TIME($H,CITY) .I SHAA") D Q:OK .I $L($G(SING)) D ..I A[("<"_SING) S PRSNG=1 ..I A[("") 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 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) ; I A'[("") D .N EZ,A1 S EZ=0 .N I1 F I1=I:1:I+10 D ..S A1=$$SPA^%L1FRM($G(@GL@(I1))) ..I $E(A1)["<" Q ..S ZN=ZN_A1 ; S ZN=$P(ZN,"") S ZN=$$REG(ZN) Q $$SPA^%L1FRM(ZN) ; NEWHZ ; D TERM^W3ORDVW ;;S ^[$$^W3MAIN]W3TBORD(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,".") 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) Q TXT ; REG(TXT) ; N ENG S ENG=0 I '$D(TSS) D ^%L1TS I $G(TXT)="" Q $G(TXT) S TXT=$TR(TXT,$C(13,10)," ") S TXT=$$RPL^%L1FRM(TXT,"&","&") S TXT=$$RPL^%L1FRM(TXT,"&qout;","'") S TXT=$$RPL^%L1FRM(TXT," "," ") ; S TXT=$$FUNC^%UCASE(TXT) S TXT=$TR(TXT,"`","'") S TXT=$TR(TXT,TSS,TS0) Q TXT ; CDTXT(STAM) ; Q 1 ;I MSD=1!(MSD=99999) Q 1 Q 0 ; POOLED(STAM) I $G(ORDTP)="POOLED" Q 1 Q 0 ; SINGLE(STAM) I $G(ORDTP)="STANDARD" Q 1 Q 0 ; OK(STAM) ; I OK&($D(@TMPORD)=11) Q 1 Q 0 ; FRMHDPS(BGOI,PARENT) ; N COUPONHNH,COUPONPAYER S TNBPAY=TNBPAY+$$GET(BGOI,"TenBisPayment",PARENT) S DMSH=$$GET(BGOI,"DeliveryPrice",PARENT) S HNH=HNH-$$GET(BGOI,"DeliveryDiscount",PARENT) S COUPONPAYER=$$GET(BGOI,"DiscountCouponBenefitPayer",PARENT) S COUPONHNH=-$$GET(BGOI,"DiscountCouponDiscount",PARENT) S COUPONHNHS=COUPONHNHS+COUPONHNH I COUPONHNH,$$RESTPAYER(COUPONPAYER) D .S COUPONHNHR=COUPONHNHR+COUPONHNH Q ; FRMHD(BGOI,PARENT) ; N ADDR,CITY,DLVMETHOD,PHONE01,PHONE02,ZMANK,ASM,DMSH N COUPONPAYER,TOTIME S ADDR=$$GET(BGOI,"AddressLine",PARENT) S CITY=$$SPA^%L1FRM($P($P(ADDR,",",2),".")) S DLVMETHOD=$$GET(BGOI,"DeliveryMethod",PARENT) S NAME=$$GET(BGOI,"Name",PARENT) S PHONE01=$$GET(BGOI,"Phone01",PARENT) S PHONE02=$$GET(BGOI,"Phone02",PARENT) S CODE=$S(PHONE01:PHONE01,1:PHONE02) I CODE="",MSD=1!(MSD=99999) S CODE="101010" D PUT^%W1PRM("CODE",CODE) S ZMANK=$ZD($H,"DD.MM.YY 24:60") S ASM=$$GET(BGOI,"OrderID",PARENT) ; I $$POOLED S ASM=$$GET(BGOI,"PooledOrderID",PARENT) ; I $$SINGLE D .S TNBPAY=$$GET(BGOI,"TenBisPayment",PARENT) .S DMSH=$$GET(BGOI,"DeliveryPrice",PARENT) .S HNH=-$$GET(BGOI,"DeliveryDiscount",PARENT) .S COUPONHD=$$GET(BGOI,"DiscountCouponCaptionForRes",PARENT) .S COUPONPAYER=$$GET(BGOI,"DiscountCouponBenefitPayer",PARENT) .S COUPONHNH=-$$GET(BGOI,"DiscountCouponDiscount",PARENT) .S COUPONHNHR=0 .I COUPONHNH,$$RESTPAYER(COUPONPAYER) D ..S HNH=HNH+COUPONHNH,COUPONHNHR=COUPONHNH,COUPONHNH=0 ..S TNBPAY=$J(TNBPAY,1,1)_":"_COUPONHNH_":"_COUPONHNHR ; S TOTIME=$$GET(BGSNG,"DesiredDeliveryTime",PARENT) ;;S TOFUTURE=$$GET(BGSNG,"DesiredDeliveryTime",PARENT) S TOFUTURE=$$GET(BGSNG,"FormatedTimeTitleStr",PARENT) I TOFUTURE?.E2N1"/".E S TOTIME=TOFUTURE ;;S ^AA("W3TBORD",+ASM)=TOTIME D .S DAT=$ZD($H,"DD.MM.YY"),SHAA="" .I TOTIME?.E2N1"/"2N1"/"4N1" "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!(SHAA>21),DLVMETHOD'="Pickup" D .N SHAA0 S SHAA0=SHAA .S SHAA=$$TM^W3TIME($H,CITY) .I SHAA9 D ...S TSF="" F S TSF=$O(^P1EZI(PAR,TSF)) Q:TSF="" D ....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZR(PAR))>9 D ...S TSF="" F S TSF=$O(^P1EZR(PAR,TSF)) Q:TSF="" D ....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZA(PAR))=11 D ...S SET="" F S SET=$O(^P1EZA(PAR,SET)) Q:SET="" D ....S NSET=$E(SET,2,10) Q:'NSET ....S TSF="" F S TSF=$O(^P1SETA(NSET,TSF)) Q:TSF="" D .....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZT(PAR))=11 D ...S SET="" F S SET=$O(^P1EZT(PAR,SET)) Q:SET="" D ....W !,"SET="_SET_" PAR="_PAR,! ....S NSET=$E(SET,2,10) Q:'NSET ....S TSF="" F S TSF=$O(^P1SETA(NSET,TSF)) Q:TSF="" D .....I $D(^PAR(TSF)) D SETPAR(TSF) ; K ^PAR M ^PAR=^PAR1 K ^PAR1 S N="" F S N=$O(^P1EZI(N)) Q:N="" D .I '$D(^PAR(N)) D ..S N1="" F S N1=$O(^P1EZ(N1)) Q:N1="" K ^P1EZ(N1,N) ..K ^P1EZI(N) ; S N="" F S N=$O(^P1EZA(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZA(N) S N="" F S N=$O(^P1EZT(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZT(N) S N="" F S N=$O(^P1EZR(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZR(N) S N="" F S N=$O(^P1EZH(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZH(N) ; I '$D(^P1PARSID) D .M ^P1PARSID=^P1TFRA(MSD) ; S N="" F S N=$O(^PAR(N)) Q:N="" D .S SUG=$$SUG^W4P(N) Q:'SUG .I '$D(^PARSUG(SUG)) Q .S NP=$O(^P1PARSID(SUG,999999),-1) .I '$$SRCPAR(SUG,N) S NP=NP+1,^P1PARSID(SUG,NP)=N ; M ^PARSUG=^PARSUG1 S I=$O(^P1KVZSID(99999),-1) S N="" F S N=$O(^PARSUG(N)) Q:N="" D .I '$$SRCSUG(N) S I=I+1,^P1KVZSID(I)=N ; M ^P1TFRA(MSD+4000)=^P1TFRA(MSD) D SETA Q SRCSUG(SUG) ; N OK S OK=0 N N S N="" F S N=$O(^P1KVZSID(N)) Q:N="" I $G(^(N))=SUG S OK=N Q Q OK SRCPAR(SUG,PAR) ; N OK S OK=0 N N S N="" F S N=$O(^P1PARSID(SUG,N)) Q:N="" I $G(^(N))=PAR S OK=N Q Q OK SETPAR(PAR) ; ;;B:PAR["35." N NM,CD S NM=$P(^PAR(PAR),"**") I NM?1N.N Q S CD=$$SPA^%L1FRM($P(NM,"-",$L(NM,"-"))) I CD?1N.N D .S NM=$P(NM,"-",1,$L(NM,"-")-1) .S NM=$TR(NM,"{}","()") .S ^PAR1(PAR)=NM_"**"_$P(^PAR(PAR),"**",2,30) .S ^PAR1(PAR,"CD")=CD N SUG S SUG=$$SUG^W4P(PAR) D SETPARSUG(SUG) I CD'?1N.N M ^PAR1(PAR)=^PAR(PAR) Q SETPARSUG(SUG) ; Q:'SUG Q:'$D(^PARSUG(SUG)) M ^PARSUG1(SUG)=^PARSUG(SUG) N A S A=^PARSUG1(SUG) S A=$$SPA^%L1FRM(A) S A=$$RPL^%L1FRM(A,^[$$^W3MAIN]W3MSD(4000+MSD),"") S A=$$SPA^%L1FRM(A) I $E(A,$L(A))="-" S A=$E(A,1,$L(A)-1) I $E(A)="-" S A=$E(A,2,$L(A)) S ^PARSUG1(SUG)=A Q SETA ; K MS N N,NS,SET S N="" F S N=$O(^P1EZA(N)) Q:N="" D .S NS="" F S NS=$O(^P1EZA(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" S N="" F S N=$O(^P1EZT(N)) Q:N="" D .S NS="" F S NS=$O(^P1EZT(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" ; S SET="" F S SET=$O(^P1SETA(SET)) Q:SET="" I '$D(MS(SET)) K ^P1SETA(SET) Q W3TFR2PA W3TF2PAR(MSD) ; [ 26.02.08 20:43 ] [ K ^PAR1,^PARSUG1 S SUG="" F S SUG=$O(^P1TFRM(MSD,SUG)) Q:SUG="" D .S PAR="" F S PAR=$O(^P1TFRM(MSD,SUG,PAR)) Q:PAR="" D ..Q:'$D(^PARSUG(SUG)) ..Q:'$D(^PAR(PAR)) ..M ^PAR1(PAR)=^PAR(PAR) ..M ^PARSUG1(SUG)=^PARSUG(SUG) W3TFTMP W3TF2PAR(MSD) ; [ 29.12.21 12:31 ] [ 24.05.15 14:23 ] [ 17.06.10 11:20 ] I $ZG["/maf" W "IT'S MAFINS",! Q BG N SUG,NP K ^PAR1,^PARSUG1 S SUG="" F S SUG=$O(^P1TFRA(MSD,SUG)) Q:SUG="" D .D SETPARSUG(SUG) K ^PARSUG M ^PARSUG=^PARSUG1 K ^PARSUG1 ; S SUG="" F S SUG=$O(^P1TFRA(MSD,SUG)) Q:SUG="" D .S NP="" F S NP=$O(^P1TFRA(MSD,SUG,NP)) Q:NP="" D ..S PAR=$G(^(NP)) Q:PAR="" ..Q:'$D(^PARSUG(SUG)) ..Q:'$D(^PAR(PAR)) ..D SETPAR(PAR) .. ..I $D(^P1EZI(PAR))>9 D ...S TSF="" F S TSF=$O(^P1EZI(PAR,TSF)) Q:TSF="" D ....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZR(PAR))>9 D ...S TSF="" F S TSF=$O(^P1EZR(PAR,TSF)) Q:TSF="" D ....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZA(PAR))=11 D ...S SET="" F S SET=$O(^P1EZA(PAR,SET)) Q:SET="" D ....S NSET=$E(SET,2,10) Q:'NSET ....S TSF="" F S TSF=$O(^P1SETA(NSET,TSF)) Q:TSF="" D .....I $D(^PAR(TSF)) D SETPAR(TSF) .. ..I $D(^P1EZT(PAR))=11 D ...S SET="" F S SET=$O(^P1EZT(PAR,SET)) Q:SET="" D ....W !,"SET="_SET_" PAR="_PAR,! ....S NSET=$E(SET,2,10) Q:'NSET ....S TSF="" F S TSF=$O(^P1SETA(NSET,TSF)) Q:TSF="" D .....I $D(^PAR(TSF)) D SETPAR(TSF) ; K ^PAR M ^PAR=^PAR1 K ^PAR1 S N="" F S N=$O(^P1EZI(N)) Q:N="" D .I '$D(^PAR(N)) D ..S N1="" F S N1=$O(^P1EZ(N1)) Q:N1="" K ^P1EZ(N1,N) ..K ^P1EZI(N) ; S N="" F S N=$O(^P1EZA(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZA(N) S N="" F S N=$O(^P1EZT(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZT(N) S N="" F S N=$O(^P1EZR(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZR(N) S N="" F S N=$O(^P1EZH(N)) Q:N="" D .I '$D(^PAR(N)) K ^P1EZH(N) ; I '$D(^P1PARSID) D .M ^P1PARSID=^P1TFRA(MSD) ; S N="" F S N=$O(^PAR(N)) Q:N="" D .S SUG=$$SUG^W4P(N) Q:'SUG .I '$D(^PARSUG(SUG)) Q .S NP=$O(^P1PARSID(SUG,999999),-1) .I '$$SRCPAR(SUG,N) S NP=NP+1,^P1PARSID(SUG,NP)=N ; M ^PARSUG=^PARSUG1 S I=$O(^P1KVZSID(99999),-1) S N="" F S N=$O(^PARSUG(N)) Q:N="" D .I '$$SRCSUG(N) S I=I+1,^P1KVZSID(I)=N ; M ^P1TFRA(MSD)=^P1TFRA(MSD) D SETA Q SRCSUG(SUG) ; N OK S OK=0 N N S N="" F S N=$O(^P1KVZSID(N)) Q:N="" I $G(^(N))=SUG S OK=N Q Q OK SRCPAR(SUG,PAR) ; N OK S OK=0 N N S N="" F S N=$O(^P1PARSID(SUG,N)) Q:N="" I $G(^(N))=PAR S OK=N Q Q OK ; SETPAR(PAR) ; N NM,CD S NM=$P(^PAR(PAR),"**") I NM?1N.N Q S CD=$$SPA^%L1FRM($P(NM,"-",$L(NM,"-"))) I CD?1N.N D .S NM=$P(NM,"-",1,$L(NM,"-")-1) .S NM=$TR(NM,"{}","()") .S ^PAR1(PAR)=NM_"**"_$P(^PAR(PAR),"**",2,30) .S ^PAR1(PAR,"CD")=CD N SUG S SUG=$$SUG^W4P(PAR) D SETPARSUG(SUG) I CD'?1N.N M ^PAR1(PAR)=^PAR(PAR) Q SETPARSUG(SUG) ; Q:'SUG Q:'$D(^PARSUG(SUG)) M ^PARSUG1(SUG)=^PARSUG(SUG) N A S A=^PARSUG1(SUG) S A=$$SPA^%L1FRM(A) S A=$$RPL^%L1FRM(A,^[$$^W3MAIN]W3MSD(MSD),"") S A=$$SPA^%L1FRM(A) I $E(A,$L(A))="-" S A=$E(A,1,$L(A)-1) I $E(A)="-" S A=$E(A,2,$L(A)) S ^PARSUG1(SUG)=A Q SETA ; K MS N N,NS,SET S N="" F S N=$O(^P1EZA(N)) Q:N="" D .S NS="" F S NS=$O(^P1EZA(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" S N="" F S N=$O(^P1EZT(N)) Q:N="" D .S NS="" F S NS=$O(^P1EZT(N,NS)) Q:NS="" D ..S SET=$E(NS,2,6) Q:SET="" S MS(SET)="" ; S SET="" F S SET=$O(^P1SETA(SET)) Q:SET="" I '$D(MS(SET)) K ^P1SETA(SET) Q W3TIME W3TIME(H,IR) ; [ 25.03.25 12:05 ] [ 26.09.24 16:19 ] [ 13.05.21 19:18 ] S IR=$$CNWEB^%L1FRM(IR) N TM,DT,HR,ND,THZ K W3TIME S ND=0 S DT=$P(H,",") S THZ=$$THZ(IR) ; I $$^%L1DC(+H,8)=7,$G(@$$^W4PRM@("SHBTIME")) S THZ=THZ+^("SHBTIME") S HR=$P(H,",",2)+(THZ*60) I HR>(60*60*24) S HR=HR-(60*60*24),W3TIME("ND")=1 I $D(W3TIME("ND")) S DT=DT+1 S TM=DT_","_HR Q TM ; THZ(IR) ; S IR=$G(IR) I $L($P(IR,",",2)) S IR=$P(IR,",",2) I $L($P(IR,":")) S IR=$P(IR,":") ;;S ^AA("W3TIME-THZ","IR")=IR I IR?.P!($TR(IR," ","")["TAKEAWAY")!($TR(IR,". ","")["TAW")!$$TAWDLV^W4PRM Q $$THZTAW ; N THZ S THZ=0 I $L($G(IR)) D .I $$POLYGON^W4PRM,$$GETP^%W1PRM("AZRPLGN") S THZ=$$TMARVPLGN^W3SP Q .S THZ=$$ZMSHD^W3SP(IR) ; I 'THZ S THZ=$G(@$$^W4PRM@("TIMEHZ")) I 'THZ S THZ=40 I $D(@$$^W4GL("W3TMZONE")) S THZ=THZ+@$$^W4GL("W3TMZONE") Q THZ ; ; TM(H,IR,PR) ; N TM S TM=$$W3TIME(H,IR) S TM=$$T^%L1TIME(TM) N DOP N HR,MN S HR=$P(TM,":") S MN=$P(TM,":",2) ; I $$ADSHAA^W4PRM D .N TMAD S TMAD=HR*60+MN+$$PLUSTIME^W4PRM .S TMAD=$$DOP^%L1FRM(TMAD\60)_":"_$$DOP^%L1FRM(TMAD#60) .S TM=TM_":"_TMAD Q TM ; THZTAW(STAM) ; N THZ S THZ=+$G(@$$^W4PRM@("TAWTIME")) I 'THZ S THZ=+$G(@$$^W4PRM@("DLYPRN")) I 'THZ S THZ=30 Q THZ W3TMPORD W3TMPORD(STAM) ; [ 07.01.08 21:02 ] [ Q "^[$$^W3MAIN]TMPORD" ; D(JB) Q $D(@$$W3TMPORD@(JB)) W3TMPTF W3TMPTF(STAM) ; [ 22.06.18 12:31 ] [ 03.05.17 13:03 ] [ 19.12.10 15:59 ] Q "^[$$^W3MAIN]TMPTF" ; CD(A) ; Q $P(A,"~") ; NM(A) ; Q $P(A,"~",2) ; MH(A) ; Q $P(A,"~",3) ; PR(A) ; Q $P(A,"~",4) ; EQ(A) ; N PR S PR=$$PR(A) I PR["="!(PR["!") Q 1 I PR[">"!(PR["^") Q 2 Q 0 ; BOX(A) ; N PR S PR=$$PR(A) I PR["-" Q 1 Q 0 ; KILL(UR) K @$$W3TMPTF@($$^%W1JB,+$G(UR)) Q W3TR2HZ W3TR2HZ(MSDFROM,MSDTO,HZM) ; [ 27.11.12 11:30 ] [ 09.05.12 19:56 ] [ 12.03.12 09:32 ] N (MSDFROM,MSDTO,HZM) S JB=$$^%W1SsID("W3TR2HZ") ; S %ARG("GLORD")="^[$$^W3MAIN]HZ2MSD(MSDFROM,MSDTO,HZM)" S %ARG("MSDFROM")=MSDFROM S %ARG("MSDTO")=MSDTO ; ;;I $D(^[$$^W3MAIN]HZ2MSDA(MSDFROM,MSDTO,HZM,"SENDED")) G END I $D(^[$$^W3MAIN]HZ2MSDA(MSDFROM,MSDTO,HZM)) G END ; S MKR=$$MKR^W3MSDR(+MSDFROM) I 'MKR G END ; I '$$^W4GETHZ(HZM) G ER ; S $P(^[$$^W3MAIN]TMPORD(JB),"~",51)=MKR D PUT^%W1PRM("MSD",MSDTO) ; S OK=0 D TERM^W3ORDVW ; I OK D .M ^[$$^W3MAIN]HZ2MSDA(MSDFROM,MSDTO,HZM)=^[$$^W3MAIN]HZ2MSD(MSDFROM,MSDTO,HZM) .K ^[$$^W3MAIN]HZ2MSD(MSDFROM,MSDTO,HZM) ; END Q ; ER ; M ^[$$^W3MAIN]HZ2MSDE(MSDFROM,MSDTO,HZM)=^[$$^W3MAIN]HZ2MSD(MSDFROM,MSDTO,HZM) K ^[$$^W3MAIN]HZ2MSD(MSDFROM,MSDTO) G END W3TR2L W3TR2L(UCI) ; [ 02.12.10 10:40 ] [ 12.08.10 16:01 ] [ 27.04.10 15:00 ] N MRK,LKH ; S MRK="" F S MRK=$O(^[UCI]LKHSEND(MRK)) Q:MRK="" D .S LKH="" F S LKH=$O(^[UCI]LKHSEND(MRK,LKH)) Q:LKH="" D ..N A S A=$G(^(LKH,2)) .. ..M ^[UCI]LKHA(LKH)=^[UCI]LKHSEND(MRK,LKH) .. ..I $D(^[$$^W3MAIN]LKH(LKH)) D Q ...N B S B=$G(^(LKH,2)) ...D SETMEMB(LKH,LKH,A,B) .. ..I $D(^[$$^W3MAIN]LKH("03"_LKH)) D Q ...N B S B=$G(^("03"_LKH,2)) ...D SETMEMB("03"_LKH,LKH,A,B) .. ..I $E(LKH,3,12),$D(^[$$^W3MAIN]LKH($E(LKH,3,12))) D Q ...N B S B=$G(^($E(LKH,3,12),2)) ...D SETMEMB($E(LKH,3,12),LKH,A,B) .. ..I UCI["/maf/",$D(^[UCI]P1EZLI(77000,LKH)) D ; --- BURSA ...D BURSA(LKH,UCI) . .K ^[UCI]LKHSENDA(+$H_$P($H,",",2),MRK) .M ^[UCI]LKHSENDA(+$H_$P($H,",",2),MRK)=^[UCI]LKHSEND(MRK) .K ^[UCI]LKHSEND(MRK) ; END Q ; BURSA(N,MAF) ; I $D(^[$$^W3MAIN]LKH(N)) Q I $D(^[MAF]LKHA(N)) D SET(N,N) Q I $D(^[MAF]LKHA($E(N,3,12))) D SET(N,$E(N,3,12)) Q I $D(^[MAF]LKHA("03"_N)) D SET(N,"03"_N) Q Q ; SET(N,N1) ; Q:'$D(^[MAF]LKHA(N1)) M ^[$$^W3MAIN]LKH(N)=^[MAF]LKHA(N1) K ^[$$^W3MAIN]LKH(N,"A") S $P(^[$$^W3MAIN]LKH(N,3),"*",3)=1234 S $P(^[$$^W3MAIN]LKH(N,2),"*",23)="dqxea" Q ; SETMEMB(LKH1,LKH2,A,B) ; S $P(^[$$^W3MAIN]LKH(LKH1,1),"*",5)=$P($G(^[UCI]LKHSEND(MRK,LKH2,1)),"*",5) S $P(^[$$^W3MAIN]LKH(LKH1,1),"*",13)=$P($G(^[UCI]LKHSEND(MRK,LKH2,1)),"*",13) S ^[$$^W3MAIN]LKH(LKH1,2)=$P(A,"*",1,18)_"*"_$P(B,"*",19)_"*"_$P(A,"*",20,21)_"*"_$P(B,"*",22,30) Q W3TR2MM W3TR2MM(DT,MSDFROM,TO,HZM) ; [ 22.08.12 12:50 ] [ 21.08.12 10:51 ] [ 20.08.12 17:25 ] N (DT,MSDFROM,TO,HZM) S JB=$$^%W1SsID("W3TR2MM") ; S %ARG("GLORD")="^[$$^W3MAIN]HZ2MM("""_DT_""","""_MSDFROM_""","""_TO_""","""_HZM_""")" S %ARG("MSDFROM")=MSDFROM S %ARG("TO")=TO ; I $D(^[$$^W3MAIN]HZ2MMA(DT,MSDFROM,TO,HZM,"SENDED")) G END ; I '$$^W4GETHZ(HZM) G ER ; S MKR="" S $P(^[$$^W3MAIN]TMPORD(JB),"~",51)=MKR D PUT^%W1PRM("MSD",TO) ; S ^[$$^W3MAIN]TMPORD(JB,"MSDTO")=$G(^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO,HZM,"MSDTO")) S ^[$$^W3MAIN]TMPORD(JB,"SHUL")=$G(^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO,HZM,"SHUL")) S OK=0 D TERM^W3ORDVW ; I OK D .M ^[$$^W3MAIN]HZ2MMA(DT,MSDFROM,TO,HZM)=^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO,HZM) .K ^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO,HZM) ; END Q ; ER ; M ^[$$^W3MAIN]HZ2MME(DT,MSDFROM,TO,HZM)=^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO,HZM) K ^[$$^W3MAIN]HZ2MM(DT,MSDFROM,TO) G END W3TR2P W3TR2P(UCI) ; [ 18.08.16 09:16 ] [ 22.01.16 15:02 ] [ 29.06.11 11:24 ] N MRK,MAINPRT,GLP,PRT,N ; S MRK="" F S MRK=$O(^[UCI]PARSEND(MRK)) Q:MRK="" D .I $G(^(MRK))="ALL" D ..S IND=+$H_$TR($J($P($H,",",2),5)," ",0) ..S FL="PAROLD"_IND ..I $$EXIST^%L1ZOS(FL) C FL:DELETE ..O FL:(WRITE:NEWVERSION) ..U FL ..N N S N="" F S N=$O(^[UCI]SHP("%GSPAR",N)) Q:N="" D ...S GL=$G(^(N)) S:$E(GL)'="^" GL="^"_GL ...D WR^%L1G2F(GL) ;ZWR @GL ..C FL ..K ^[UCI]PAROLD(MRK,IND) ..M ^[UCI]PAROLD(MRK,IND)=^[UCI]PAR ..K ^[UCI]PAR ..N N S N="" F S N=$O(^[UCI]PRTNO(N)) Q:N="" D ...S ^[UCI]W3PAR(N)=1 ..K ^[UCI]PRTNO,^[UCI]PRTNNO ..S N="" F S N=$O(^[UCI]SHP("%GSPAR",N)) Q:N="" D ...S A=$G(^(N)) I A["P1EZ"!(A["P1SET")!($E(A,1,3)="MHT") K @("^"_A) . .S MAINPRT="" F S MAINPRT=$O(^[UCI]PARSEND(MRK,MAINPRT)) Q:MAINPRT="" D ..N OKK S OKK=0 ..S GLP="" F S GLP=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP)) Q:GLP="" D ...I GLP'="PRTNO",GLP'="PRTNNO" S OKK=1 ..I OKK D ...K ^[UCI]P1EZA(MAINPRT),^[UCI]P1EZT(MAINPRT) ...K ^[UCI]P1EZR(MAINPRT),^[UCI]P1EZI(MAINPRT) .. ..S GLP="" F S GLP=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP)) Q:GLP="" D ...N GLO S GLO="^["""_UCI_"""]"_GLP ... ...I $D(^[UCI]P1PRM("PARSEND",GLP)) D ....K @GLO S @GLO=^[UCI]PARSEND(MRK,MAINPRT,GLP) ... ...S PRT="" F S PRT=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT)) Q:PRT="" D ....K @GLO@(PRT) ....;;I GLP="P1EZA" K ^[UCI]P1EZT(PRT),^[UCI]P1EZR(PRT),^[UCI]P1EZI(PRT) ....;;I GLP="P1EZT" K ^[UCI]P1EZA(PRT),^[UCI]P1EZR(PRT),^[UCI]P1EZI(PRT) ....I GLP="L1TIP" M ^[UCI]L1TIP("MTK",PRT)=^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT) Q .... ....M @GLO@(PRT)=^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT) .. .I $G(^[UCI]PARSEND(MRK))="ALL" D ..S N="" F S N=$O(^[UCI]PRTNO(N)) Q:N="" D ...;K ^[UCI]PAR(N) ...S ^[UCI]W3PAR(N)=0 . .M ^[UCI]PARSENDA(+$H_$P($H,",",2),MRK)=^[UCI]PARSEND(MRK) .K ^[UCI]PARSEND(MRK) ; S N="" F S N=$O(^[UCI]PRTNNO(N)) Q:N="" K ^[UCI]PRTNO(N) S ^[UCI]W3PAR(N)=1 M ^[UCI]PRTNNOO(+$H)=^[UCI]PRTNNO K ^[UCI]PRTNNO ; END Q W3TR2P0 W3TR2P(UCI) ; [ 18.08.16 09:01 ] [ 22.01.16 15:02 ] [ 29.06.11 11:24 ] N MRK,MAINPRT,GLP,PRT,N ; S MRK="" F S MRK=$O(^[UCI]PARSEND(MRK)) Q:MRK="" D .I $G(^(MRK))="ALL" D ..S IND=+$H_$TR($J($P($H,",",2),5)," ",0) ..K ^[UCI]PAROLD(MRK,IND) ..M ^[UCI]PAROLD(MRK,IND)=^[UCI]PAR ..K ^[UCI]PAR . .S MAINPRT="" F S MAINPRT=$O(^[UCI]PARSEND(MRK,MAINPRT)) Q:MAINPRT="" D ..N OKK S OKK=0 ..S GLP="" F S GLP=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP)) Q:GLP="" D ...I GLP'="PRTNO",GLP'="PRTNNO" S OKK=1 ..I OKK D ...K ^[UCI]P1EZA(MAINPRT),^[UCI]P1EZT(MAINPRT) ...K ^[UCI]P1EZR(MAINPRT),^[UCI]P1EZI(MAINPRT) .. ..S GLP="" F S GLP=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP)) Q:GLP="" D ...N GLO S GLO="^["""_UCI_"""]"_GLP ... ...I $D(^[UCI]P1PRM("PARSEND",GLP)) D ....K @GLO S @GLO=^[UCI]PARSEND(MRK,MAINPRT,GLP) ... ...S PRT="" F S PRT=$O(^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT)) Q:PRT="" D ....K @GLO@(PRT) ....;;I GLP="P1EZA" K ^[UCI]P1EZT(PRT),^[UCI]P1EZR(PRT),^[UCI]P1EZI(PRT) ....;;I GLP="P1EZT" K ^[UCI]P1EZA(PRT),^[UCI]P1EZR(PRT),^[UCI]P1EZI(PRT) ....I GLP="L1TIP" M ^[UCI]L1TIP("MTK",PRT)=^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT) Q .... ....M @GLO@(PRT)=^[UCI]PARSEND(MRK,MAINPRT,GLP,PRT) .. .I $G(^[UCI]PARSEND(MRK))="ALL" D ..S N="" F S N=$O(^[UCI]PRTNO(N)) Q:N="" K ^[UCI]PAR(N) . .M ^[UCI]PARSENDA(+$H_$P($H,",",2),MRK)=^[UCI]PARSEND(MRK) .K ^[UCI]PARSEND(MRK) ; S N="" F S N=$O(^[UCI]PRTNNO(N)) Q:N="" K ^[UCI]PRTNO(N) S ^[UCI]W3PAR(N)=1 M ^[UCI]PRTNNOO(+$H)=^[UCI]PRTNNO K ^[UCI]PRTNNO ; END Q W3TR2S W3TR2S(UCI) ; [ 25.03.11 19:34 ] [ 20.03.11 20:44 ] [ 30.01.11 19:20 ] N MRK,GL,GLO ; S MRK="" F S MRK=$O(^[UCI]p1sendw(MRK)) Q:MRK="" D .S GL="" F S GL=$O(^[UCI]p1sendw(MRK,GL)) Q:GL="" D ..S GLO="^["""_UCI_"""]"_GL ..D ...I GL="P1AZR" D AZR(MRK) Q ...I GL="P1AZS" D AZS(MRK) Q ...K @GLO ...M @GLO=^[UCI]p1sendw(MRK,GL) .. ..K ^[UCI]p1sendwa(+$H_$P($H,",",2),MRK,GL) ..M ^[UCI]p1sendwa(+$H_$P($H,",",2),MRK,GL)=^[UCI]p1sendw(MRK,GL) ..K ^[UCI]p1sendw(MRK,GL) ; END Q ; AZR(MRK) ; K ^[UCI]W3AZR("IS") M ^[UCI]W3AZR("IS")=^[UCI]p1sendw(MRK,"P1AZR") Q ; AZS(MRK) ; K ^[UCI]W3AZS("IS") M ^[UCI]W3AZS("IS")=^[UCI]p1sendw(MRK,"P1AZS") Q ; W3TR2WEB W3TR2WEB(MSD,HZM) ; [ 29.12.21 07:13 ] [ 29.10.17 09:02 ] [ 24.10.17 09:57 ] N (MRK,MSD,HZM) S JB=$$^%W1SsID("W3TR2WEB") ; S %ARG("GLORD")="^[$$^W3MAIN]HZ2WEB("""_MSD_""","""_HZM_""")" ; S SNIF=+$G(^[$$^W3MAIN]HZ2WEB(MSD,HZM,"SNIF")) ; K ^[$$^W3MAIN]HZ2WEB0(MSD,HZM) M ^[$$^W3MAIN]HZ2WEB0(MSD,HZM)=^[$$^W3MAIN]HZ2WEB(MSD,HZM) ; S %ARG("MSD")=MSD ; S OLDDLV=$G(^[$$^W3MAIN]HZ2WEBA(MSD,SNIF_"-"_HZM,"WEB")) S OLDORD=$P(OLDDLV,";") ; S %ARG("DLVCSR")="WEB" ; I '$$^W4GETHZ(HZM) G ER ; ^HZ2WEB(MSD,HZM) --> ^TMPORD(JB) ; I $D(@%ARG("GLORD")@("MKBN"))#2 D .S @$$^W3TMPORD@(JB,"MKBN")=@%ARG("GLORD")@("MKBN") ; I $D(@%ARG("GLORD")@("PSLN"))#2 D .S @$$^W3TMPORD@(JB,"PSLN")=@%ARG("GLORD")@("PSLN") ; K DLV S ST=$G(@%ARG("GLORD")) S DLV=$G(@%ARG("GLORD")@("WEB")) ; S HZW=+$P(DLV,";") ; I HZW,$D(@$$^W3ORD@(HZW)) D .N HD,HD0 S HD=$G(@$$^W3TMPORD@(JB)) .S HD0=$G(@$$^W3ORD@(HZW)) .N J F J=1:1:$L(HD0,"~") D ..I $P(HD,"~",J)="",$P(HD0,"~",J)'="" S $P(HD,"~",J)=$P(HD0,"~",J) .S @$$^W3TMPORD@(JB)=HD . .I $D(@%ARG("GLORD")@("MSDTO")) Q . .N N S N="" F S N=$O(@$$^W3ORD@(HZW,N)) Q:N="" I N'?1N.E D ..I '$D(@$$^W3TMPORD@(JB,N)) M @$$^W3TMPORD@(JB,N)=@$$^W3ORD@(HZW,N) ; D PUT^%W3DEB("W3TR2WEB","DLV0=DLV") ; I $D(@%ARG("GLORD")@("DBF"))#2 D .S @$$^W3TMPORD@(JB,"DBF")=@%ARG("GLORD")@("DBF") ; M @$$^W3TMPORD@(JB,"F")=@%ARG("GLORD")@("F") ; S $P(DLV,";",4)=HZM S $P(DLV,";",5)=$G(@%ARG("GLORD")@("SNIF")) ; I $D(@%ARG("GLORD")@("MSDTO")) D ; -- PERENOS IZ SNIFA V SNIF .S MSD=$G(^("MSDTO")) .S @$$^W3TMPORD@(JB,"MSDFROM")=$G(@$$^W3TMPORD@(JB,"MSD")) .K @$$^W3TMPORD@(JB,"MSD") .K @$$^W3TMPORD@(JB,"WEB") .K @$$^W3TMPORD@(JB,"S") .K @$$^W3TMPORD@(JB,"D") .S OLDORD="" .S $P(DLV,";",1)="" .S $P(DLV,";",4)="" ; D PUT^%W1PRM("MSD",MSD) I 'DLV S $P(DLV,";")=$S(OLDORD:OLDORD,1:JB) ; S $P(@$$^W3TMPORD@(JB),"~",34)="" ; -- HEARA S $P(@$$^W3TMPORD@(JB),"~",27)=$P(@$$^W3TMPORD@(JB),"~",1) ; S $P(DLV,";",10,200)=$$INVH^%L1FRM($P(DLV,";",10,200)) D PUT^%W3DEB("W3TR2WEB","DLV=DLV") ; S ^[$$^W3MAIN]HZ2WEB(MSD,HZM,"WEB")=DLV ; D TERM^W3ORDVW ; ;;I '$$ISHUR(DLV) D TERM^W3ORDVW ;;I $$ISHUR(DLV) D:OLDORD SNDISHUR(MSD,DLV) G END ; M ^[$$^W3MAIN]HZ2WEBA(MSD,SNIF_"-"_HZM)=^[$$^W3MAIN]HZ2WEB(MSD,HZM) K ^[$$^W3MAIN]HZ2WEB(MSD,HZM) ; END Q ; ; ER ; S SNIF=+$G(^[$$^W3MAIN]HZ2WEB(MSD,HZM,"SNIF")) M ^[$$^W3MAIN]HZ2WEBE(MSD,SNIF_"-"_HZM)=^[$$^W3MAIN]HZ2WEB(MSD,HZM) K ^[$$^W3MAIN]HZ2WEB(MSD) G END ; PRCOFR(GL) N I,A,CD N UCI S UCI=^[$$^W3MAIN]UCI(MSD) S OK=0 F I=1:1 Q:'$D(@GL@(I)) D Q:OK .S A=$G(^(I)) Q:A="" .S CD=$P(A,"\") Q:CD="" .I CD=$G(^[UCI]W3PRM("HZMH2")) S OK=2 Q .I CD=$G(^[UCI]W3PRM("HZMH")) S OK=1 Q Q OK ; ISHUR(DLV) ; I $P(DLV,";",9)?1N Q 1 Q 0 ; SNDISHUR(MSD,DLV) ; D PUT^%W3DEB("W3TR2WEB-SNDISHUR","MSD=MSD&DLV=DLV") N SND,FAX,EMAIL,LINK,DET,ORD,HZRSD,ISHUR S ORD=$P(DLV,";") Q:'ORD S SND=$P($P(DLV,";",2),"-") S DET=$P($P(DLV,";",2),"-",2) S EMAIL=$P(DLV,";",3) Q:'$L(EMAIL) S HZRSD=$P(DLV,";",4) S ISHUR=$P(DLV,";",9) S LINK=$P($$WEB^W3MAIN,"//",2,20)_"w3ordvw.jsp?MSD="_MSD_"&W3ORDLS="_ORD_"&RCV=1" I $$SNDM^W3SNDHMH(MSD,ORD,EMAIL_";"_LINK_";"_DET,ISHUR) Q W3TREE W3TREE ; [ 21.06.13 14:07 ] [ 01.11.08 14:25 ] [ 28.06.08 12:59 ] N SUGA S SUGA=$$SUGA K ^[$$^W3MAIN]TMPEZ($$^%W1JB) ; I SUGA="A" D .N N S N="" F S N=$O(@$$^W4GL("P1EZA")@(N)) Q:N="" I $D(^(N))>9 D ..M ^[$$^W3MAIN]TMPEZ($$^%W1JB,N)=@$$^W4GL("P1EZA")@(N) ..S $P(^[$$^W3MAIN]TMPEZ($$^%W1JB,N),"\",2)="A" ; I SUGA="T" D .S N="" F S N=$O(@$$^W4GL("P1EZT")@(N)) Q:N="" I $D(^(N))>9 D ..I $D(@$$^W4GL("P1EZA")@(N))>9 Q ..M ^[$$^W3MAIN]TMPEZ($$^%W1JB,N)=@$$^W4GL("P1EZT")@(N) ..S $P(^[$$^W3MAIN]TMPEZ($$^%W1JB,N),"\",2)="T" Q ; SUGA(STAM) ; Q $$GETP^%W1PRM("SUGA") ; TABLENAME(STAM) I $$SUGA^W3TREE="A" Q $$^%W1DICT("TREETABLE") Q $$^%W1DICT("ITEMADDGROUPTABLE") W3TREIDK W3TREIDK ; [ 12.11.24 18:35 ] [ 05.08.23 12:36 ] [ 29.05.22 13:54 ] N (JB,%ARG,SRCH) ;;W !,"W3TREIDK: PARENT="_$G(%ARG("PARENT"))_" MSD="_$G(%ARG("MSD")),! D PUT^%W1PRM("SAVED",0) D TMPEZ I '$G(JB) W " JB number is not defined ! " Q N MSG S MSG="" N SRC S SRC=$$SPA^%L1FRM(%ARG("SEARCHTREE")) ; I '$G(%ARG("PARENT")),$$ISNUM^%L1FRM(SRC) D Q:$L(MSG) .I $$SHEM^W4P(SRC)="" S MSG="LUNCHNUMBERISWRONG!" .I $$^W4TSF(SRC),'$$^W4EZAT(SRC) S MSG="ITSITEMADDONS!" .I $G(%ARG("EZT")),$$DD^W4EZA(SRC) S MSG="ITSLUNCH!" .I '$G(%ARG("EZT")),$$DD^W4EZT(SRC) S MSG="ITSITEMGROUPADDONS!" . .I MSG'="" D Q ..W "",! . .S %ARG("PARENT")=SRC ; D PUT^%W3DEB("W3TREIDK","%ARG=[%ARG") I '$G(%ARG("PARENT")) Q ; S MSD=%ARG("MSD") I 'MSD S MSD=$$GETP^%W1PRM("MSD") I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q ; D PUT^%W1PRM("PARENT",%ARG("PARENT")) S PARENT=%ARG("PARENT") ; I $G(%ARG("FIRST")) K @$$^W4MAIN("TMPMHQ"),@$$^W4MAIN("TMPEZ") D ^W3TREE ; W "
",! ;;W ""_$$TABLENAME^W3TREE_"" W ""_$$PARENT_" "_$$H2U^%L1FRM($$SHEM^W4P($$PARENT))_"" W "",! W "" W "" W "" W "" W "" W "",! ; N N,I D CRGL1(PARENT) ; S NP="",I=0 F S NP=$O(@GL1@(NP)) Q:NP="" D .S N=$G(^(NP)) ; -- N - "A"+SET NUMBER . .W "" S I=I+1 . .W "",! .N CS,COLSET,EXCT S COLSET="",EXCT=0 .S CS=$$COLSET(N) I CS["!" S EXCT=1,CS=+CS .I +CS=1 S COLSET=$$^%W1DICT("ONEITEMONLY") .I CS>1 S COLSET=$$^%W1DICT($S(EXCT:"ITEMSEXACTLY",1:"UNTILITEMS"),CS) .W "",! . .N ID,PROC .S ID="chtre"_N .S PROC="OnClickTbl('"_N_"','TblTree','trtre','chtre')" .D ^W4TDCHBX(ID,PROC) . .D ^W4VRXNIZ(N) .W "",! .I $G(%ARG("CONTENT")) D DET(N) ; W "
"_$$^%W1DICT("SETCODE")_""_$$^%W1DICT("SETNAME")_""_$$^%W1DICT("DELETE")_" 
 "_N_"  " . W $$H2U^%L1FRM($$NMSET(N))_" " . W ""_COLSET_"" .W "
",! W "
",! ; I $D(GL1),$D(@GL1) K @GL1 I $D(GL2),$D(@GL2) K @GL2 I $D(GLS),$D(@GLS) K @GLS Q ; GL S GL="^[$$^W3MAIN]TMPTREE($$^%W1JB)" Q GL1 S GL1="^[$$^W3MAIN]TMPTREE1($$^%W1JB)" Q GL2 S GL2="^[$$^W3MAIN]TMPTREE2($$^%W1JB)" Q ; ; DET(NSET) ; Q:$G(NSET)="" S PRTREE=0 I $E(NSET)="A" S PRTREE=1,NSET=$$NOMSET(NSET) W " " W "" W "",! W "" W " " W " " W " " W " " W "",! ; D CRGLS(NSET) N PAR,II,NP S NP="",II=0 F S NP=$O(@GLS@(NP)) Q:NP="" D .S II=II+1,PAR=$G(^(NP)) Q:PAR="" .W "" .W "" .W "" . .I PRTREE D ..I $G(%ARG("FIRST"))!'$D(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",PAR))!'$D(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",PAR)) D ...D SETMHQ(PARENT,PAR,"QN",$$QNDEF(PARENT,NSET,PAR)) ...D SETMHQ(PARENT,PAR,"MH",$$MHT(PARENT,NSET,PAR)) .. ..W "",! ..W "",! ..W "",! . .I 'PRTREE D ..W "" ..W "" .W "",! ; W "
"_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("QNDEF")_""_$$^%W1DICT("ADDPRICE")_""_$$^%W1DICT("COMPSUBADD")_"
"_PAR_""_$$ITEMNAME(PAR)_"" .. W "" ..W "" .. W "" ..W "" .. W "" ..W ""_$$QNSET(NSET,PAR)_""_$$MHSET(NSET,PAR)_"
",! W " ",! Q ; ITEMNAME(PAR) ; N NM S NM=$$SHEM^W4P(PAR) ;;I NM="" Q " " Q $$H2U^%L1FRM(NM) ; MHT(PARENT,NSET,PAR) N MHT S MHT=$G(@$$^W4GL("MHT")@(PARENT,PAR)) I MHT="",$D(@$$^W4GL("P1EZT")@(PARENT,"A"_NSET))<10,$D(@$$^W4GL("P1EZA")@(PARENT,"A"_NSET))<10 S MHT=$$MHSET(NSET,PAR) ;;I MHT="" Q " " Q MHT ; QNDEF(PARENT,NSET,PAR) N QNDEF ;;S QNDEF=$G(@$$^W4GL("QNDEF")@(PARENT,PAR)) ;;I QNDEF="" S QNDEF=$$QNSET(NSET,PAR) S QNDEF=$$QNSET(NSET,PAR) I $$PRINT^W4P(PAR)[">>",QNDEF'[">" S QNDEF=QNDEF_">" ;;I QNDEF="" Q " " Q QNDEF ; QNSET(SET,CD) ; S QN=$G(@$$^W4GL("QNSET")@(SET,CD)) ;;I QN="" Q " " Q QN ; MHSET(SET,CD) ; S SET=$$NOMSET(SET) S MH=$G(@$$^W4GL("MHSET")@(SET,CD)) ;;I MH="" Q " " Q $J(MH,2,2) ; FIRSTREE(STAM) ; D TMPEZ N N S N=$O(@TMPEZ@("")) Q N ; ; SAVE(PRM) ; D GETPARENT,TMPEZ D PUT^%W3DEB("W3TREIDK-SAVE","PARENT=PARENT") I '$G(PARENT) Q 0 ;;I $D(@TMPEZ@(PARENT))<10 Q 0 ; K @$$^W4GL("QNDEF")@(PARENT) K @$$^W4GL("MHT")@(PARENT) ; I $D(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT))>9 D .N I,CD,QN,MH .N N S N="" F S N=$O(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",N)) Q:N="" D ..N QN S QN=$G(^(N)) ;;I 'QN,QN'[">" Q ..S @$$^W4GL("QNDEF")@(PARENT,N)=QN ..N SET S SET=$$^W4SET(PARENT,N) I $E(SET)="A" S SET=$E(SET,2,20) ..I SET S @$$^W4GL("QNSET")@(SET,N)=QN .S N="" F S N=$O(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",N)) Q:N="" D ..N MH S MH=$G(^(N)) Q:MH="" ..S @$$^W4GL("MHT")@(PARENT,N)=MH . N HD S HD=$G(@TMPEZ@(PARENT)) ; I $$SUGA^W3TREE="T" D Q 1 .K @$$^W4GL("P1EZT")@(PARENT) .M @$$^W4GL("P1EZT")@(PARENT)=@TMPEZ@(PARENT) .S @$$^W4GL("P1EZT")@(PARENT)=+$G(@$$^W4GL("P1EZT")@(PARENT)) .I $D(@$$^W4GL("P1EZT")@(PARENT))<10 K @$$^W4GL("P1EZT")@(PARENT) ; D .K @$$^W4GL("P1EZA")@(PARENT) .M @$$^W4GL("P1EZA")@(PARENT)=@TMPEZ@(PARENT) .S $P(@TMPEZ@(PARENT),"\",2)="A" .I '$P($G(@TMPEZ@(PARENT)),"\") S $P(@TMPEZ@(PARENT),"\",1)=1 .I '$P($G(@$$^W4GL("P1EZA")@(PARENT)),"\") S $P(@$$^W4GL("P1EZA")@(PARENT),"\")=1 .I $D(@$$^W4GL("P1EZA")@(PARENT))<10 K @$$^W4GL("P1EZA")@(PARENT) ; K @TMPEZ@(PARENT) K ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT) D PUT^%W1PRM("SAVED",1) Q 1 ; ; DEL(STAM) ; D GETPARENT,TMPEZ D PUT^%W3DEB("W3TREIDK-DEL","PARENT=PARENT") I '$G(PARENT) Q 0 ; K @$$^W4GL("QNDEF")@(PARENT) K @$$^W4GL("MHT")@(PARENT) K @TMPEZ@(PARENT) K ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT) ; K @$$^W4GL("P1EZT")@(PARENT) K @$$^W4GL("P1EZA")@(PARENT) Q 1 ; MV2TREE(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) N PARENT D GETPARENT I '$G(PARENT) Q 0 D TMPEZ D CRGL1(PARENT) S PRM=$E(PRM,1,$L(PRM)-1) N OK,NP S OK=0 I PRM="" Q 0 S NP=$O(@GL1@(99999999),-1) ; K ^[$$^W3MAIN]TMPRT($$^%W1JB) N SET,NSET S SET="" F S SET=$O(@TMPEZ@(PARENT,SET)) Q:SET="" D .S NSET=$$NOMSET(SET) .N PRT S PRT="" F S PRT=$O(@$$^W4GL("P1SETA")@(NSET,PRT)) Q:PRT="" D ..S ^[$$^W3MAIN]TMPRT($$^%W1JB,PRT)=NSET ; N I,ER S ER=0 F I=1:1:$L(PRM,";") D Q:ER .S SET=$P(PRM,";",I) Q:SET="" .S NSET=$$NOMSET(SET) .N PRT S PRT="" F S PRT=$O(@$$^W4GL("P1SETA")@(NSET,PRT)) Q:PRT="" D Q:ER ..I $D(^[$$^W3MAIN]TMPRT($$^%W1JB,PRT)),$G(^(PRT))'=NSET D ...S ER=PRT_";"_$G(^(PRT)) I ER Q ER ; N I,SET F I=1:1:$L(PRM,";") D .S SET=$P(PRM,";",I) Q:SET="" .S NP=NP+1,OK=1 .S:$E(SET)'="A" SET="A"_SET .S $P(@TMPEZ@(PARENT,SET),">")=NP .S @GL1@(NP)=SET .D CLEARMHQ(PARENT,SET) Q OK ; MV2SET(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D TMPEZ,GETPARENT Q:'PARENT 0 D CRGL1(PARENT) S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q 0 N I,SET F I=1:1:$L(PRM,";") D .S SET=$P(PRM,";",I) Q:SET="" .N NP S NP=+$G(@TMPEZ@(PARENT,SET)) .K @TMPEZ@(PARENT,SET) S OK=1 .D CLEARMHQ(PARENT,SET) ; D CRGL1(PARENT) Q OK ; CLEARMHQ(PARENT,SET) ; S SET=$$NOMSET(SET) N PRT S PRT="" F S PRT=$O(@$$^W4GL("P1SETA")@(SET,PRT)) Q:PRT="" D .D KILLMHQ(PARENT,PRT) Q KILLMHQ(PARENT,CD) ; K ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",CD) K ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",CD) K @$$^W4GL("QNDEF")@(PARENT,CD) K @$$^W4GL("MHT")@(PARENT,CD) Q TREE ; N GLOB,TREEONLY S GLOB="^[$$^W3MAIN]TMPEZ($$^%W1JB)" S TREEONLY=1 I '$G(%ARG("TREEONLY")) S TREEONLY=0,GLOB=$$^W4GL("PAR") ;;W !,"GLOB="_GLOB,! W $$^%W1DICT("MEAL")_" : " W !,"",! Q ; NMTREE(NN) ; Q $P($G(@$$^W4GL("PAR")@(NN)),"**") ; NMSET(CD) D TMPEZ N CDN S CDN=$E(CD,2,5) Q $P($G(@$$^W4GL("P1SETA")@(CDN)),"\") ; COLSET(CD) D TMPEZ N CDN S CDN=$E(CD,2,5) Q $P($G(@$$^W4GL("P1SETA")@(CDN)),"\",2) ; ; SWAP(CD,DRC) ; D GETPARENT,TMPEZ D CRGL1(PARENT) S NST=$$GETPN(CD) S NST0=$O(@GL1@(NST),DRC) Q:'NST0 S CD0=$G(@GL1@(NST0)) S @GL1@(NST0)=CD S @GL1@(NST)=CD0 S $P(@TMPEZ@(PARENT,CD0),">")=NST S @TMPEZ@(PARENT,CD0,"CUR")=1 S $P(@TMPEZ@(PARENT,CD),">")=NST0 N MH,QN ; S QN=$G(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",CD)) S MH=$G(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",CD)) S ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",CD)=$G(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",CD0)) S ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",CD)=$G(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",CD0)) S ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"QN",CD0)=QN S ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,"MH",CD0)=MH S @GL1@(NST0,"CUR")=1 Q ; GETPN(CD) ; D TMPEZ,GETPARENT Q +$G(@TMPEZ@(PARENT,CD)) ; CLEAR ; D GL1 N N S N="" F S N=$O(@GL1@(N)) Q:N="" K ^(N,"CUR") Q ; CRGL1(PARENT) ; --- SIDUR SETIM BETOH TREE D GETPARENT,TMPEZ,GL1,GL2 K @GL1,@GL2 N SET,NP,I S I=1 ; S SET="" F S SET=$O(@TMPEZ@(PARENT,SET)) Q:SET="" D .S NP=+$G(^(SET)) ; -- MISP SIDURI .I $D(@GL2@(NP)) S NP=1000+I,I=I+1 .S @GL2@(NP)=SET ; S I=0 S NP="" F S NP=$O(@GL2@(NP)) Q:NP="" D .N SET S SET=$G(^(NP)) Q:SET="" .S I=I+1,@GL1@(I)=SET S $P(@TMPEZ@(PARENT,SET),">")=I ; K @GL2 Q ; ; TMPEZ S TMPEZ="^[$$^W3MAIN]TMPEZ($$^%W1JB)" ; -- COPY ^P1EZT OR ^P1EZA Q ; GETPARENT S PARENT=$$GETP^%W1PRM("PARENT") ; --- MAIN ITEM Q ; CRGLS(SET) ; -- > P1SETA - > GLS ; --- SIDUR PRITIM BETOH SET N GL,GL2 S GL=$$^W4GL("P1SETA") S GLS="^[$$^W3MAIN]TMPSET($$^%W1JB)" S GL2="^[$$^W3MAIN]TMPSET2($$^%W1JB)" K @GLS,@GL2 N N,NP,I,PRT S I=1 S PRT="" F S PRT=$O(@GL@(SET,PRT)) Q:PRT="" D .S NP=+$G(^(PRT)) .I $D(@GL2@(NP)) S NP=1000+I,I=I+1 .S @GL2@(NP)=PRT S I=0 S NP="" F S NP=$O(@GL2@(NP)) Q:NP="" D .N PRT S PRT=$G(^(NP)) Q:PRT="" .S I=I+1,@GLS@(I)=PRT .S @GL@(SET,PRT)=I K @GL2 Q ; SETMHQ(PARENT,PAR,IND,VL) ; I $G(NRZ)="" S NRZ=1 S VL=$$SPA^%L1FRM(VL) S VL=$$RPL^%L1FRM(VL," ","") S VL=$TR(VL,"~","") S ^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,IND,PAR)=VL Q ; TMPMHQ(PARENT,PAR,IND) ; I $G(PARENT)="" Q "" I $G(PAR)="" Q "" I $G(IND)="" Q "" Q $G(^[$$^W3MAIN]TMPMHQ($$^%W1JB,PARENT,IND,PAR)) ; GETQN(PRM) ; N PARENT,PAR,VL S PARENT=$P(PRM,";") S PAR=$P(PRM,";",2) Q $$TMPMHQ(PARENT,PAR,"QN") ; ; SETQN(PRM) ; N PARENT,PAR,VL S PARENT=$P(PRM,";") S PAR=$P(PRM,";",2) S VL=$P(PRM,";",3) D SETMHQ(PARENT,PAR,"QN",VL) Q ; SETMH(PRM) ; N PARENT,PAR,VL,COMP S PARENT=$P(PRM,";") S PAR=$P(PRM,";",2) S VL=$P(PRM,";",3) S COMP=$P(PRM,";",4) S COMP=$S(COMP:"",1:"NO") S VL=VL_";"_COMP D SETMHQ(PARENT,PAR,"MH",VL) Q ; NOMSET(SET) ; I $E(SET)="A" S SET=$E(SET,2,10) Q SET ; PARENT(STAM) ; I $G(%ARG("PARENT")) Q %ARG("PARENT") Q $$GETP^%W1PRM("PARENT") W3TRG W3TRG(MSD) ; [ 12.02.18 09:24 ] [ 04.12.17 23:01 ] [ 21.06.17 17:19 ] N (JB,%ARG,MSD) S TRG=$G(%ARG("TRG")) S VRM=$$VRM^W3TRM K @VRM@("TRL") K @VRM@("TRG") D ^%L1TS ; S UCI=$$UCI(MSD) ; S N=999 F S N=$O(@$$GLMSD("LKH")@(N)) Q:N="" D WST(N) ; N GLSUGL S GLSUGL=$$GLMSD("SUGL") S N="" F S N=$O(@GLSUGL@(N)) Q:N="" D .S ST="GRP_CUST,"_N_","_$$HB($G(@GLSUGL@(N)))_","_$G(@GLSUGL@(N,1)) .S ST=ST_"***" D W("TRL",2) ; ;;Q:$G(TRG)<4 ; S GLIR=$$GLMSD("P1IR") ; S N="" F S N=$O(@GLIR@(N)) Q:N="" D .N A S A=$G(@GLIR@(N,1)) .D PRS^%L1FRM(A,"DMSH\DLVTIME\SUMCNCDM","\") .S ST="CITY_PRM,"_N_","_$$HB($G(@GLIR@(N)))_","_DMSH_","_DLVTIME_","_SUMCNCDM .S ST=ST_"***" D W("TRG",1) . N W3AZR S W3AZR=$$GLMSD("W3AZR")_"(""IS"")" S IRI="" F S IRI=$O(@W3AZR@(IRI)) Q:IRI="" D .S AZ="" F S AZ=$O(@W3AZR@(IRI,AZ)) Q:AZ="" D ..S CDIR=$$CDIR(IRI) Q:'CDIR ..S AZ1=$G(^(AZ)) ..S A=$G(^(AZ,1)) ..S DM=$P(A,"\") ..S TIME=$P(A,"\",2) ..S CNC=$P(A,"\",3) ..S OPEN=$P(A,"\",4) ..S ST="NBR_CT_PRM,"_CDIR_","_AZ_","_$$HB(AZ1)_","_DM_","_TIME_","_CNC ..S ST=ST_"***" D W("TRG",2) ; N W3AZS S W3AZS=$$GLMSD("W3AZS")_"(""IS"")" S CDIR="" F S CDIR=$O(@GLIR@(CDIR)) Q:CDIR="" D .S IR=$G(^(CDIR)) .S IRI=$$INVH^%L1FRM(IR) Q:IRI="" .S N="" F S N=$O(@W3AZS@(IRI,N)) Q:N="" D ..S STREETI=$$SPA^%L1FRM($P(N,":")) ..S STREET=$$INVH^%L1FRM(STREETI) ..S MEBAIT=$$SPA^%L1FRM($P(N,":",2)) ..S ADBAIT=$$SPA^%L1FRM($P(N,":",3)) ..S ST="NBR_STREET,"_CDIR_","_$$HB(STREET)_","_MEBAIT_","_ADBAIT ..S ST=ST_"***" D W("TRG",3) Q ; ; W(IND0,IND) ; S SH=$O(@VRM@(IND0,IND,9999999),-1)+1 S SH=SH+1,@VRM@(IND0,IND,SH)=ST Q ; HB(TXT) Q $TR($$INVHBW^%L1FRM($TR(TXT,",","")),TS0,TS1) ; CDIR(IRI) ; N IR,CD S IR=$$INVH^%L1FRM(IRI),CD="" S N="" F S N=$O(@GLIR@(N)) Q:N="" D Q:CD .I IR=$G(^(N)) S CD=N Q CD ; W4MAIN(GLB) ; Q "^[$$^W3MAIN]"_GLB_"($J)" ; GLMSD(GLREF) Q "^["""_$$UCI(MSD)_"""]"_GLREF ; UCI(MSD) ; Q $G(^[$$^W3MAIN]UCI(MSD)) ; WST(N) ; N ST I '$$MAZAV^W4L(N) Q S ST="CUST_DETS,"_N_","_$$HB($$LKH^W4L(N))_","_$$HB($$LKH^W4L(N))_","_$$TELB^W4L(N) S ST=ST_","_$$PELE^W4L(N)_","_$$HB($$IR^W4L(N))_","_$$HB($$KTV^W4L(N))_","_$$HB($$BAIT^W4L(N)) S ST=ST_","_$$HB($$CNISA^W4L(N))_","_$$HB($$KOMA^W4L(N))_","_$$DIRA^W4L(N) N LKDM S LKDM=$S($D(@$$GLMSD("P1LKDM")@(N)):1,1:0) N LKHR S LKHR=$G(@$$GLMSD("P1EZL")@(N)) I LKHR S LKDM=$S($D(@$$GLMSD("P1LKDM")@(LKHR)):1,1:0) S ST=ST_","_$$SUGL^W4L(N)_","_+$$ISCR^W4L(N)_","_LKDM S ST=ST_","_$$EMAIL^W4L(N) S ST=ST_"***" D W("TRL",1) Q W3TRG0 W3TRG(MSD) ; [ 12.02.18 09:47 ] [ 04.12.17 23:01 ] [ 21.06.17 17:19 ] N (JB,%ARG,MSD) S TRG=$G(%ARG("TRG")) K @$$W4MAIN("VRM")@("TRL") K @$$W4MAIN("VRM")@("TRG") D ^%L1TS ; S UCI=$$UCI(MSD) ; S N=999 F S N=$O(@$$GLMSD("LKH")@(N)) Q:N="" D WST(N) ; N GLSUGL S GLSUGL=$$GLMSD("SUGL") S N="" F S N=$O(@GLSUGL@(N)) Q:N="" D .S ST="GRP_CUST,"_N_","_$$HB($G(@GLSUGL@(N)))_","_$G(@GLSUGL@(N,1)) .S ST=ST_"***" D W("TRL",2) ; ;;Q:$G(TRG)<4 ; S GLIR=$$GLMSD("P1IR") ; S N="" F S N=$O(@GLIR@(N)) Q:N="" D .N A S A=$G(@GLIR@(N,1)) .D PRS^%L1FRM(A,"DMSH\DLVTIME\SUMCNCDM","\") .S ST="CITY_PRM,"_N_","_$$HB($G(@GLIR@(N)))_","_DMSH_","_DLVTIME_","_SUMCNCDM .S ST=ST_"***" D W("TRG",1) . N W3AZR S W3AZR=$$GLMSD("W3AZR")_"(""IS"")" S IRI="" F S IRI=$O(@W3AZR@(IRI)) Q:IRI="" D .S AZ="" F S AZ=$O(@W3AZR@(IRI,AZ)) Q:AZ="" D ..S CDIR=$$CDIR(IRI) Q:'CDIR ..S AZ1=$G(^(AZ)) ..S A=$G(^(AZ,1)) ..S DM=$P(A,"\") ..S TIME=$P(A,"\",2) ..S CNC=$P(A,"\",3) ..S OPEN=$P(A,"\",4) ..S ST="NBR_CT_PRM,"_CDIR_","_AZ_","_$$HB(AZ1)_","_DM_","_TIME_","_CNC ..S ST=ST_"***" D W("TRG",2) ; N W3AZS S W3AZS=$$GLMSD("W3AZS")_"(""IS"")" S CDIR="" F S CDIR=$O(@GLIR@(CDIR)) Q:CDIR="" D .S IR=$G(^(CDIR)) .S IRI=$$INVH^%L1FRM(IR) Q:IRI="" .S N="" F S N=$O(@W3AZS@(IRI,N)) Q:N="" D ..S STREETI=$$SPA^%L1FRM($P(N,":")) ..S STREET=$$INVH^%L1FRM(STREETI) ..S MEBAIT=$$SPA^%L1FRM($P(N,":",2)) ..S ADBAIT=$$SPA^%L1FRM($P(N,":",3)) ..S ST="NBR_STREET,"_CDIR_","_$$HB(STREET)_","_MEBAIT_","_ADBAIT ..S ST=ST_"***" D W("TRG",3) Q ; ; W(IND0,IND) ; S SH=$O(@$$W4MAIN("VRM")@(IND0,IND,9999999),-1)+1 S SH=SH+1,@$$W4MAIN("VRM")@(IND0,IND,SH)=ST Q ; HB(TXT) Q $TR($$INVHBW^%L1FRM($TR(TXT,",","")),TS0,TS1) ; CDIR(IRI) ; N IR,CD S IR=$$INVH^%L1FRM(IRI),CD="" S N="" F S N=$O(@GLIR@(N)) Q:N="" D Q:CD .I IR=$G(^(N)) S CD=N Q CD ; W4MAIN(GLB) ; Q "^[$$^W3MAIN]"_GLB_"($J)" ; GLMSD(GLREF) Q "^["""_$$UCI(MSD)_"""]"_GLREF ; UCI(MSD) ; Q $G(^[$$^W3MAIN]UCI(MSD)) ; WST(N) ; N ST I '$$MAZAV^W4L(N) Q S ST="CUST_DETS,"_N_","_$$HB($$LKH^W4L(N))_","_$$HB($$LKH^W4L(N))_","_$$TELB^W4L(N) S ST=ST_","_$$PELE^W4L(N)_","_$$HB($$IR^W4L(N))_","_$$HB($$KTV^W4L(N))_","_$$HB($$BAIT^W4L(N)) S ST=ST_","_$$HB($$CNISA^W4L(N))_","_$$HB($$KOMA^W4L(N))_","_$$DIRA^W4L(N) N LKDM S LKDM=$S($D(@$$GLMSD("P1LKDM")@(N)):1,1:0) N LKHR S LKHR=$G(@$$GLMSD("P1EZL")@(N)) I LKHR S LKDM=$S($D(@$$GLMSD("P1LKDM")@(LKHR)):1,1:0) S ST=ST_","_$$SUGL^W4L(N)_","_+$$ISCR^W4L(N)_","_LKDM S ST=ST_","_$$EMAIL^W4L(N) S ST=ST_"***" D W("TRL",1) Q W3TRITDK W3TRITDK ; [ 30.10.10 08:11 ] [ 20.10.10 13:13 ] [ 27.09.10 10:48 ] N (JB,%ARG) D KILL^%W3DEB("W3TRITDK") D PUT^%W3DEB("W3TRITDK","%ARG=[%ARG") I $G(JB)="" W " JB number is not defined ! " Q I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q I '$D(%ARG("CDKV")) W " Group number is not defined ! " Q I '$G(%ARG("CDKV")) Q ; D PUT^%W1PRM("CDKV",%ARG("CDKV")) ; W "
",! W "",! W "" W "" W "" W "" W "",! ; N N,NN,I D GL ; N I S I=0 K @GL S N="" F S N=$O(@$$^W4GL("PAR")@(N)) Q:N="" D .I $$SUG^W3P(N)=%ARG("CDKV") D ..S @GL@(N)=N ; S NN="",I=0 F S NN=$O(@GL@(NN)) Q:NN="" D .S N=$G(^(NN)) Q:N="" .W "" S I=I+1 . . W "" . . W "" . . W "",! . .W "",! ; W "
"_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("CUSTOMITEMCODE")_"
 "_N_"  "_$$H2U^%L1FRM($$SHEM^W3P(N))_" ",! . W "",! .W "
",! W "
",! Q ; SAVE(PRM) N CD D PUT^%W3DEB("W3TRIDK-SAVE","PRM=PRM") S CD=$P(PRM,";") S CDC=$P(PRM,";",2) I CDC="" K @$$^W4GL("W3TRIT")@(CD) Q S @$$^W4GL("W3TRIT")@(CD)=CDC Q ; SAVEND(PRM) ; N CD D GL K @GL Q ; GL S GL=$$^W4MAIN("TMP") Q ; VL(PAR) ; Q $G(@$$^W4GL("W3TRIT")@(PAR)) W3TRM W3TRM(TOMRK,MSD,MEDAT,ADDAT,MEPAR,ADPAR) ; [ 12.11.24 18:37 ] [ 12.05.23 06:45 ] [ 29.12.21 07:14 ] N (MSD,MEDAT,ADDAT,MEPAR,ADPAR,%SCKPORT,JB,%ARG,%REM,TOMRK) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $$^%L1FLAG($$^W4flag_"(""TRM"")") Q I '$G(^[$$^W3MAIN]flag("TRM")) S ^[$$^W3MAIN]flag("TRM")=$J,^[$$^W3MAIN]flag("TRM","TIME")=$H S SF2=0 S TOMRK=+$G(TOMRK) ;;I $$SF^W4PRM S %ARG("TRG")=1 S %ARG("TRG")=1 I TOMRK=2,$$SF^W4PRM S SF2=1 I '$G(MSD) S MSD=1 ; D ^%L1TS S DATA="" S TRG=$G(%ARG("TRG")) I '$G(JB) S JB=$$^%W1SsID("W3TRM") ;;N $ZT S $ZT="G SVER^%L1X" ; S MAXL=4000 ; S MEDAT=$G(MEDAT),ADDAT=$G(ADDAT) S MEPAR=$G(MEPAR),ADPAR=$G(ADPAR) S D1=$$^%L1DC(MEDAT,3) S D2=$$^%L1DC(ADDAT,3) ; I MEDAT="",ADDAT="",MEPAR="",ADPAR="" S GL=$$GLMSD("PAR") G EXP ; S GL=$$MAIN("TEMP") K @GL ; S I=0 S N=D1-1 F S N=$O(@$$GLMSD("PARPROT")@(N)) Q:N="" Q:N>D2 D .S N1="" F S N1=$O(@$$GLMSD("PARPROT")@(N,N1)) Q:N1="" D ..S A=^(N1) ..S PAR=$P(A,"\") I MEPAR,PARADPAR Q ..I $$NOSHOW1(PAR) Q ..I $P(A,"\",2)="=" Q ..I $P(A,"\",2)="-" S B=$P(A,"\",4) ..S I=I+1 I $P(A,"\",2)=">" S @$$MAIN("TEMP")@(PAR)="" ; ; EXP ; N PATHP,FN,N,N1,PAR,PATHP,SET,ST,VP S KOLMAX=$G(@$$^W4PRM@("KOLMAX")) ; K @$$MAIN("MMM") K @$$VRM,@$$MAIN("KVUZA") ; S SH=0 N UR0 S N="" F S N=$O(@GL@(N)) Q:N="" D .S UR0=1 .I $$NOSHOW1(N) Q .S SHOW='$$NOSHOW(N) .S ST="ITEM_DETS,"_N_","_$$HB($$SHEM(N))_","_SHOW_","_$J($$MH(N),2,2) . .S VP=$$VP(N) . .S VP1=$P(@$$GLMSD("PAR")@(N),"**",5) ; SUG .S ST=ST_","_VP_","_KOLMAX_","_$$SHEML(N)_"***" D W . .I VP1>0,$D(@$$GLMSD("PARSUG")@(VP1)) D ..I $$NOSHOWGR(VP1) Q ..S SHK=$ZP(@$$MAIN("KVUZA")@(VP1,""))+1 ..S @$$MAIN("KVUZA")@(VP1,SHK,N)="" . .S UR0=0 .I VP=1 S ST0="ITEM_ADDONS,"_N,ST="" D ; -- PARIT - TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZI")@(N,N1)) Q:N1="" D ...I $$NOSHOW1(N1) Q ...D BDKL ...S ST=ST_","_N1 ..D WST . .I 'VP,VP1,$D(@$$GLMSD("P1EZKI")@(VP1)) D ..S ST0="ITEM_ADDONS,"_N,ST="" D ; -- PARIT - TOSAFOT ...S N1="" F S N1=$O(@$$GLMSD("P1EZKI")@(VP1,N1)) Q:N1="" D ....I $$NOSHOW1(N1) Q ....D BDKL ....S ST=ST_","_N1 ...D WST . .K @$$MAIN("VRMEZT") . .I VP=2 S ST0="ITEM_AI,"_N,ST="" D ; -- PARIT - KVUZAT TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZT")@(N,N1)) Q:N1="" D ...S NP=+$G(^(N1)) ...S @$$MAIN("VRMEZT")@(N,NP)=N1 ..S NP="" F S NP=$O(@$$MAIN("VRMEZT")@(N,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:N1="" ...D BDKL ...S ST=ST_","_N1 ..D WST .K @$$MAIN("VRMEZT") . .K @$$MAIN("VRMEZA") .I VP=3 S ST0="ITEM_AI,"_N,ST="" D ; -- ARUHA ISKIT ..S N1="" F S N1=$O(@$$GLMSD("P1EZA")@(N,N1)) Q:N1="" D ...S NP=+$G(^(N1)) ...S @$$MAIN("VRMEZA")@(N,NP)=N1 ..S NP="" F S NP=$O(@$$MAIN("VRMEZA")@(N,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:N1="" ...D BDKL ...S ST=ST_","_N1 ..D WST .K @$$MAIN("VRMEZA") . .I VP=4 S ST0="ITEM_ADDONS,"_N,ST="" D ; -- RAV BRERA ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...I $$NOSHOW1(N1) Q ...D BDKL ...S ST=ST_","_N1 ..D WST ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...S N2="" F S N2=$O(@$$GLMSD("P1SBR")@(N2)) Q:N2="" I $$ISNUM^%L1FRM(N2) D ....Q:$G(@$$GLMSD("P1SBR")@(N2))?.P Q:$D(@$$MAIN("MMM")@(N1,N2)) ....S ST="ITEM_REMARKS,"_N1_","_N2_","_$$HB(@$$GLMSD("P1SBR")@(N2)) ....S ST=ST_"***" D W ....S @$$MAIN("MMM")@(N1,N2)=N . .I $D(@$$GLMSD("P1EZH")@(N)),'$D(@$$GLMSD("P1EZRI")@(N)) D ..S N1="" F S N1=$O(@$$GLMSD("P1EZH")@(N,N1)) Q:N1="" D ...Q:'$D(@$$GLMSD("P1CODH")@(N1)) ...S ST="ITEM_REMARKS,"_N ...S ST=ST_","_N1_","_$$HB($G(@$$GLMSD("P1CODH")@(N1))) ...S ST=$E(ST,1,509)_"***" D W . .I $D(@$$GLMSD("QNDEF")@(N))>9 D ..S ST0="ITEM_QNDEF,"_N,ST="" D ; -- ADD QN DFLT ...S N1="" F S N1=$O(@$$GLMSD("QNDEF")@(N,N1)) Q:N1="" D ....S QN=+$G(^(N1)) Q:'QN ;Q:QN'?1N.N ....I $$NOSHOW1(N1) Q ....D BDKL ....S ST=ST_","_N1_"-"_QN ...D WST . ; S UR0=1 S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW1(N) Q .S ST="ITEM_DESC,"_N .N DESC,DESC0 S (DESC,DESC0)="" .N N1 S N1="" F S N1=$O(@$$GLMSD("L1TIP")@("MTK",N,N1)) Q:N1="" D ..S DESC0=$$DESC(N,N1)_" "_DESC0 .I DESC0[" == " S DESC0=$P(DESC0," == ",2) Q:DESC0="" .S DESC0=$$SPA^%L1FRM(DESC0) .S DESC=$$CLRDLM^%L1FRM(DESC0,"[[","]]") .N PRM S PRM=$P($P(DESC0,"[[",2),"]]") .S ST=ST_",1,"_$$HB(DESC)_"***" .D W ; S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW1(N) Q .S ST="ITEM_DESC_ENG,"_N .N DESC,DESC0 S (DESC,DESC0)="" .N N1 S N1="" F S N1=$O(@$$GLMSD("L1TIP")@("MTK",N,N1)) Q:N1="" D ..S DESC0=$$DESC(N,N1)_" "_DESC0 .S DESC0=$$SPA^%L1FRM(DESC0) Q:DESC0'[" == " .I DESC0[" == " S DESC0=$P(DESC0," == ",1) Q:DESC0="" .S DESC=$$CLRDLM^%L1FRM(DESC0,"[[","]]") .N PRM S PRM=$P($P(DESC0,"[[",2),"]]") .S ST=ST_",1,"_$$HL^W3PRTPC(DESC)_"***" .D W ;----------------- ADDONS PRICES ------- N ST0 S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW1(N) Q .S ST0="ITEM_ADDONS_PRC,"_N . .S VP=$$VP(N) . .S UR0=0 . .I VP=1 D Q ; -- PARIT - TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZI")@(N,N1)) Q:N1="" D ...I $$NOSHOW1(N1) Q ...S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W . .K @$$MAIN("VRMSETA") .I VP=2 D Q ; -- PARIT - KVUZAT TOSAFOT ; N1 - SETIM ..S N1="" F S N1=$O(@$$GLMSD("P1EZT")@(N,N1)) Q:N1="" D ...I $$ISNUM^%L1FRM(N1) S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W Q ...S NSET=$E(N1,2,9) Q:NSET="" ...K @$$MAIN("VRMSETA") ...S N2="" F S N2=$O(@$$GLMSD("P1SETA")@(NSET,N2)) Q:N2="" D ....S NP=$G(^(N2)) Q:'NP ....S @$$MAIN("VRMSETA")@(NSET,NP)=N2 ...S NP="" F S NP=$O(@$$MAIN("VRMSETA")@(NSET,NP)) Q:NP="" D ....S N2=$G(^(NP)) Q:'N2 ....I $$NOSHOW1(N2) Q ....S ST=ST0_","_N2_","_$J($G(@$$GLMSD("MHT")@(N,N2)),2,2)_"***" D W . .K @$$MAIN("VRMSETA") .S UR0=0 .I VP=3 D Q ; -- ARUHA ISKIT ..S N1="" F S N1=$O(@$$GLMSD("P1EZA")@(N,N1)) Q:N1="" D ...I $$ISNUM^%L1FRM(N1) S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W Q ...S NSET=$E(N1,2,9) Q:NSET="" ...K @$$MAIN("VRMSETA") ...S N2="" F S N2=$O(@$$GLMSD("P1SETA")@(NSET,N2)) Q:N2="" D ....S NP=$G(^(N2)) Q:'NP ....S @$$MAIN("VRMSETA")@(NSET,NP)=N2 ...S NP="" F S NP=$O(@$$MAIN("VRMSETA")@(NSET,NP)) Q:NP="" D ....S N2=$G(^(NP)) Q:'N2 ....I $$NOSHOW1(N2) Q ....S ST=ST0_","_N2_","_$J($G(@$$GLMSD("MHT")@(N,N2)),2,2)_"***" D W . .K @$$MAIN("VRMSETA") .I VP=4 D Q ; -- RAV BRERA ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...I $$NOSHOW1(N1) Q ...S ST=ST0_","_N1_",0.00,***" D W ; ; I $D(@$$GLMSD("P1CODH")) S N=99999999 D .S N1="" F S N1=$O(@$$GLMSD("P1CODH")@(N1)) Q:N1="" D ..S ST="ITEM_REMARKS,"_N ..S ST=ST_","_N1_","_$$HB($G(@$$GLMSD("P1CODH")@(N1))) ..S ST=$E(ST,1,509)_"***" D W ; S UR0=0 I $D(@$$GLMSD("P1SETA")) D .S SET="" F S SET=$O(@$$GLMSD("P1SETA")@(SET)) Q:SET="" I $$ISNUM^%L1FRM(SET) D ..S SHEM=$P($G(@$$GLMSD("P1SETA")@(SET)),"\") I SHEM?.P S SHEM=SET_" hq" ..S KAM=+$P($G(@$$GLMSD("P1SETA")@(SET)),"\",2) I KAM<1 S KAM=1 ..S ST="ITEM_SETS,A"_SET_","_KAM ..K @$$MAIN("VRMSETA") ..S N1="" F S N1=$O(@$$GLMSD("P1SETA")@(SET,N1)) Q:N1="" D ...N NP S NP=$G(^(N1)) Q:'NP ...S @$$MAIN("VRMSETA")@(SET,NP)=N1 ..S NP="" F S NP=$O(@$$MAIN("VRMSETA")@(SET,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:'N1 ...I $$NOSHOW1(N1) Q ...D BDKL ...S ST=ST_","_N1 ..S ST=ST_"***" D W .. ..S ST="ITEM_DETS,A"_SET_","_$$HB(SHEM)_",1, , ,"_$P($G(@$$GLMSD("P1SETA")@(SET)),"\",2) ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1SETM")) D ;-- SET PRITIM LE MIVCA .S SET="" F S SET=$O(@$$GLMSD("P1SETM")@(SET)) Q:SET="" I $$ISNUM^%L1FRM(SET) D ..S ST="ITEM_SETS,S"_SET_","_KOLMAX ..S N1="" F S N1=$O(@$$GLMSD("P1SETM")@(SET,N1)) Q:N1="" D ...I $$NOSHOW1(N1) Q ...D BDKL ...S ST=ST_","_N1 ..S ST=ST_"***" D W ..S SHEM=$P($G(@$$GLMSD("P1SETM")@(SET)),"\") I SHEM?.P S SHEM=SET_" rvan hq" ..S ST="ITEM_DETS,S"_SET_","_$$HB(SHEM)_",1, , , " ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1MVC")@(1))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(1,N)) Q:N="" D ..S ST="SALE_DETS_1" ..N A S A=$G(^(N)) Q:$P(A,"\",14)=1 ..S MEJOM=$P(A,"\",8),ADJOM=$P(A,"\",9) ..S MESHAA=$P(A,"\",9),ADSHAA=$P(A,"\",11) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",7)_","_MEJOM_","_ADJOM ..S ST=ST_","_MESHAA_","_ADSHAA_","_$P(A,"\",1)_","_$P(A,"\",3)_","_$P(A,"\",4)_","_$P(A,"\",17)_","_$P(A,"\",6) ..S ST=ST_","_$TR($P(@$$GLMSD("P1MVC")@(1),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(1),"\",2),"/.","") ..S ST=ST_",1_"_N_","_$P(@$$GLMSD("P1MVC")@(1),"\",12)_"***" D W ; I $D(@$$GLMSD("P1MVC")@(2))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(2,N)) Q:N="" D ..S ST="SALE_DETS_2" ..N A S A=$G(^(N)) Q:$P(A,"\",12)=1 ..S MEJOM=$P(A,"\",6),ADJOM=$P(A,"\",7) ..S MESHAA=$P(A,"\",8),ADSHAA=$P(A,"\",9) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",5)_","_MEJOM_","_ADJOM_","_MESHAA_","_ADSHAA ..S ST=ST_","_$P(A,"\")_","_$P(A,"\",2)_","_$P(A,"\",15)_","_$P(A,"\",4) ..S ST=ST_",KOLMAX,"_$TR($P(@$$GLMSD("P1MVC")@(2),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(2),"\",2),"/.","") ..S ST=ST_",2_"_N_","_$P(@$$GLMSD("P1MVC")@(2),"\",10)_"***" D W ; I $D(@$$GLMSD("P1MVC")@(3))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(3,N)) Q:N="" D ..S ST="SALE_DETS_3" ..N A S A=$G(^(N)) Q:$P(A,"\",14)=1 ..S MEJOM=$P(A,"\",8),ADJOM=$P(A,"\",9) ..S MESHAA=$P(A,"\",10),ADSHAA=$P(A,"\",11) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",7)_","_MEJOM_","_ADJOM ..S ST=ST_","_MESHAA_","_ADSHAA_","_$P(A,"\",1)_","_$P(A,"\",3)_","_$P(A,"\",4)_","_$P(A,"\",17)_","_$P(A,"\",6) ..S ST=ST_","_$TR($P(@$$GLMSD("P1MVC")@(3),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(3),"\",2),"/.","") ..S ST=ST_",3_"_N_","_$P(@$$GLMSD("P1MVC")@(3),"\",12)_"***" D W ; ; I $D(@$$GLMSD("W3PARM")@(1))>9 D .N N S N="" F S N=$O(@$$GLMSD("W3PARM")@(1,N)) Q:N="" I $D(^(N,"SHAA")) D ..N A,ST,MEJOM,ADJOM,MESHAA,ADSHAA ..S A=$G(^("SHAA")) ..S ST="ITEM_HOURS" ..S MEJOM=1,ADJOM=7 ..S MESHAA=$P(A,"-",1) ..S ADSHAA=$P(A,"-",2) ..S ST=ST_",1,"_MEJOM_","_ADJOM_","_N ..S ST=ST_","_MESHAA_","_ADSHAA ..S ST=ST_"***" D W ; K @$$MAIN("MMMK") K @$$MAIN("MMMP") ; I $D(@$$GLMSD("P1KVZSID")) D .N NKV,PAR .S NKV="" F S NKV=$O(@$$GLMSD("P1KVZSID")@(NKV)) Q:NKV="" D ..S KV=$G(^(NKV)) Q:KV="" ..I $$NOSHOWGR(KV) Q ..N KV1 S KV1=$G(@$$GLMSD("PARSUG")@(KV)) ..I KV1="" Q ..I $D(@$$MAIN("KVUZA")@(KV))<10 Q ..S ST="ITEM_KVUZA,"_KV_","_$$HB(KV1) ..S @$$MAIN("MMMK")@(KV)="" ..D SIDPRT(KV) ..S ST=ST_"***" D W ; ; ---------- IF NOT ^P1KVZSID -------------------------------- I $D(@$$MAIN("KVUZA")) S N1="" D .F S N1=$O(@$$MAIN("KVUZA")@(N1)) Q:N1="" D ..I $D(@$$MAIN("MMMK")@(N1)) Q ..I $$NOSHOWGR(N1) Q ..S ST="ITEM_KVUZA,"_N1_","_$$HB(@$$GLMSD("PARSUG")@(N1)) ..D SIDPRT(N1) ..S ST=ST_"***" D W ..Q .. ..S ST="ITEM_KVUZA,"_N1_","_$$HB(@$$GLMSD("PARSUG")@(N1)) D ...S N3="" F S N3=$O(@$$MAIN("KVUZA")@(N1,N3)) Q:N3="" D ....S N2="" F S N2=$O(@$$MAIN("KVUZA")@(N1,N3,N2)) Q:N2="" D BDKL S ST=ST_","_N2 ...S ST=ST_"***" D W ; NL ; I $D(@$$GLMSD("PARNL")) D .S N1="" F S N1=$O(@$$GLMSD("PARNL")@(N1)) Q:N1="" D ..S A=^(N1),MESHAA=$P(A,"\"),ADSHAA=$P(A,"\",2) ..S MEJOM=$P(A,"\",3),ADJOM=$P(A,"\",4) ..S ST="ITEM_HLOCK,"_N1_","_MESHAA_","_ADSHAA_","_MEJOM_","_ADJOM,STKOT=ST ..S N2="" F S N2=$O(@$$GLMSD("PARNL")@(N1,N2)) Q:N2="" D ...D BDKL ...S ST=ST_","_N2 ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1KVZSID")) S STKOT="POZ_KVUZA," D .S N1="",N2="" .F S N1=$O(@$$GLMSD("P1KVZSID")@(N1)) Q:N1="" S N2=$G(@$$GLMSD("P1KVZSID")@(N1)) I $G(N2) D ..I $$NOSHOWGR(N2) Q ..S ST=STKOT_N1_","_N2_","_"***" D W ; D .N A,N,GL,ST S GL=$$GLMSD("W4MSGSIT") Q:$D(@GL)<10 .S N="" F S N=$O(@GL@(N)) Q:N="" D ..S A=$G(^(N)) Q:'$P(A,"\",6) ..N TX S TX=$P(A,"\") ..S TX=$$RPL^%L1FRM(TX,"%60","`") ..S A=$$HB(TX)_"\"_$P(A,"\",2,255) ..S A=$TR(A,"\",",") ..I $E(A,$L(A))="," S A=$E(A,1,$L(A)-1) ..S ST="MSG_SITE,"_N_","_A_"***" D W ; I TRG D ^W3TRG(MSD) ; D TRN ; END K @$$MAIN("VRM") K @$$MAIN("MMM"),@$$MAIN("MMMP"),@$$MAIN("MMMK") K @$$MAIN("KVUZA") Q ; ; SIDPRT(KV) ; N UR0 S UR0=1 N NP S NP="" F S NP=$O(@$$GLMSD("P1PARSID")@(KV,NP)) Q:NP="" D .N PAR S PAR=$G(^(NP)) .N SUG S SUG=$P($G(@$$GLMSD("PAR")@(PAR)),"**",5) .Q:SUG'=KV Q:$$NOSHOW1(PAR) .D BDKL .S ST=ST_","_PAR .I $D(@$$MAIN("MMMP")@(PAR)) Q .S @$$MAIN("MMMP")@(PAR)="" Q:$D(@$$GLMSD("P1PARSID")@(KV)) ; S N3="" F S N3=$O(@$$MAIN("KVUZA")@(KV,N3)) Q:N3="" D .S PAR="" F S PAR=$O(@$$MAIN("KVUZA")@(KV,N3,PAR)) Q:PAR="" D ..I $D(@$$MAIN("MMMP")@(PAR)) Q ..Q:$$NOSHOW1(PAR) ..D BDKL S ST=ST_","_PAR ; Q ; TRN ; -------------- SHIDUR LE MISHLOHIM --------- N ITEM,WVW,RZD,N,N1,ST,DIR,I,J K @$$TRM@("ER") S TID="" ; S DIR=$$DIR(MSD) ; S MREST=$$GETREST(MSD) I MREST?.P S MREST=MSD ; S IND1=$G(%ARG("IND1")) I 'IND1 S IND1=+$H S IND2=$G(%ARG("IND2")) I 'IND2 S IND2=$P($H,",",2) ; I $G(@$$TRM@("DEB")) D .M @$$TRM@(IND1,IND2,"VRM",TOMRK)=@$$VRM ; I 'TRG D .N J F J=1:1:$L(MREST,",") S REST=$P(MREST,",",J) I REST D ..D TRN2R(REST,"IT","TR",0,TOMRK) ; I TRG D .D TRN2R(MSD,"IT","TR",1,TOMRK) .D TRN2R(MSD,"LKH","TRL",1,TOMRK) .D TRN2R(MSD,"GEO","TRG",1,TOMRK) Q ; ; TRN2R(REST,PRFX,IND,TRG,TOMRK) N A,J,FN,SH,WVW,N,N1,ST,CMD,CON S FN=$$FN(PRFX_"_"_REST) ; C FN:DELETE O FN:(WRITE:NEWVERSION) S SH=0 ; I $G(TRG) U FN W "data=" ; S WVW="W1" D ^%L1TS ; S N="" F S N=$O(@$$VRM@(IND,N)) Q:N="" D .S ST="" ; .S N1="" F S N1=$O(@$$VRM@(IND,N,N1)) Q:N1="" D ..N A S A=$G(^(N1)) ..I A[">>>" D ...; ...I $E(A,$L(A)-2,$L(A))=">>>" S A=$E(A,1,$L(A)-3) ...I A[">>>" S A=$P(A,">>>",2) ..S ST=ST_A ..I $E(ST,$L(ST)-2,$L(ST))'="***" Q ..D @WVW S ST="" ; S ST="END_FILE***" D @WVW C FN ; ;;K @$$VRM ; I 'TOMRK S HTTP="http://www.mishlohim.co.il/rashad/UpdateMenu.aspx" I TOMRK S HTTP=$G(@$$MRK("W4MRK")@(TOMRK,"MAIN")) ; I $G(TRG) D G CMDMENU .N DOP .I $L($G(PRFX)) S DOP=$G(@$$MRK@(TOMRK,PRFX)) .I $E(HTTP,$L(HTTP))'="/" S HTTP=HTTP_"/" .S HTTP=HTTP_DOP .S CMD="curl -s -k """_HTTP_""" --data-urlencode data@"_FN ; S CMD="curl -s """_HTTP_""" -F "_PRFX_"_"_REST_".DAT=@"_FN S CMD=CMD_" | xmllint --format --encode cp862 - " ; CMDMENU S:$G(PRFX)="" PRFX=" " S IND1=$G(%ARG("IND1"),+$H) S IND2=$G(%ARG("IND2"),$P($H,",",2)) ; S @$$TRM@(IND1,IND2,"CMDMENU",TOMRK,PRFX)=$G(CMD) ; S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="IN PROGRESS" S CON="MSL" O CON:(COMMAND=CMD:READONLY)::"PIPE" ; I $ZSY D G ETRN2R .S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="ER\"_$ZSY_"\"_$H ; S OK=$$READ(CON) S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="OK\"_OK_"\"_$H ; ETRN2R C CON ; Q ; ; GLMSD(GLREF) Q "^["""_$$UCI(MSD)_"""]"_GLREF ; FN(FN) Q $$DIR(MSD)_FN_".dat" ; SHEM(CD) Q $P($G(@$$GLMSD("PAR")@(CD)),"**") ; SHEML(CD) Q $P($G(@$$GLMSD("PAR")@(CD)),"**",14) ; MH(CD) Q $P($G(@$$GLMSD("PAR")@(CD)),"**",2) ; DESC(CD,NOM) ; Q $TR($G(@$$GLMSD("L1TIP")@("MTK",CD,NOM)),",",";") ; DESCHB(CD,NOM) N ST S ST=$$DESC(CD,NOM) S ST=$P(ST," == ",2) Q ST ; DESCENG(CD,NOM) N ST S ST=$$DESC(CD,NOM) S ST=$P(ST," == ",1) Q ST ; VP(N) ; N VP S VP=0 I $D(@$$GLMSD("P1EZA")@(N)) S VP=3 E I $D(@$$GLMSD("P1EZT")@(N)) S VP=2 E I $D(@$$GLMSD("P1EZI")@(N)) S VP=1 E I $D(@$$GLMSD("P1EZR")@(N)) S VP=4 Q VP ; W1 U FN W ST,! Q W N FLD,IND S FLD=$P(ST,",") S IND=$S(FLD="ITEM_DETS":1,FLD="ITEM_BRANCH":2,FLD="ITEM_ADDONS":3,FLD="ITEM_AI":4,FLD="ITEM_SETS":5,FLD="ITEM_REMARKS":6,FLD["SALE":7,FLD="ITEM_KVUZA":8,FLD="ITEM_HLOCK":9,FLD="POZ_KVUZA":10,1:11) S SH=SH+1,@$$VRM@("TR",IND,SH)=ST Q W2 ; X %SCKPORT("USE") W ST,! Q W3 ; X %SCKPORT("USE") W ST Q WST I $G(ST)="" Q S ST=ST0_ST_"***" D W Q ; MEAD ; I 'MEJOM,'ADJOM S MEJOM=1,ADJOM=7 I MEJOM,'ADJOM S ADJOM=MEJOM S:'MEJOM MEJOM=1 S:'ADJOM ADJOM=7 S:'MESHAA MESHAA="0000" S:'ADSHAA ADSHAA=2359 S MESHAA=$TR(MESHAA,":",""),ADSHAA=$TR(ADSHAA,":","") S MESHAA=$TR($J(MESHAA,2)," ",0) S ADSHAA=$TR($J(ADSHAA,2)," ",0) I $L(MESHAA)=2 S MESHAA=MESHAA_"00" I $L(ADSHAA)=2 S ADSHAA=ADSHAA_"00" I ADSHAA=2400 S ADSHAA=2359 Q ; HB(TXT) ;;Q $TR($$INVHBW^%L1FRM($TR(TXT,",","")),TS0,TS1) Q $TR($$^%W1H2U($TR(TXT,","," ")),TS0,TS1) ; NOSHOW(PAR) ; N SUG,ST S ST=$G(@$$GLMSD("PAR")@(PAR)) S SUG=$P(ST,"**",5) I SUG,$$NOSHOWGR(SUG) Q 1 I $G(TOMRK),$G(@$$GLMSD("W4PRTSND")@(PAR,TOMRK))=0 Q 1 Q $$NOSHOW1(PAR) ; NOSHOW1(PAR) ; I $P($G(@$$GLMSD("W3PAR")@(PAR)),"\")=0 Q 1 I $$NOMSL^W4THUM(PAR) Q 1 Q 0 ; NOSHOWGR(GR) ; I '$G(GR) Q 1 I $G(@$$GLMSD("W3SUG")@(GR))=0 Q 1 I $G(@$$GLMSD("W3SUG")@(GR))=2 Q 1 I $G(TOMRK),$G(@$$GLMSD("W4KVZSND")@(GR,TOMRK))=0 Q 1 Q 0 ; UCI(MSD) ; Q $G(^[$$^W3MAIN]UCI(MSD)) ; DIR(MSD) ; Q $ZPARSE($$UCI(MSD),"DIR") ; GETREST(MSD) ; N MREST,N S MREST="" S N="" F S N=$O(^[$$^W3MAIN]W3MSL2M(N)) Q:N="" D .I $G(^(N))=MSD S MREST=MREST_N_"," Q $E(MREST,1,$L(MREST)-1) ; GETVL(A,EL) ; S ZN=$P(A,"<"_EL_">",2) S ZN=$P(ZN,"") Q $$SPA^%L1FRM(ZN) ; READ(CON) D ^%L1TS N I,OK S OK=0 U CON S I=0 D .N TMP,A .S TMP=$$MAIN("TMPMSL") .N NOM S NOM=$O(@TMP@(999999),-1)+1 .N C R *C:20 Q:C<0 .S C=$C(C) .F R A Q:$ZEOF D Q:OK ..I $L(C) S A=C_A S C="" ..S I=I+1,@TMP@(NOM,I)=$TR($E(A,1,1400),TSS,TS0) ..I A["
" D ...R A I $$SPA^%L1FRM(A)="OK" S OK=1 ..I A["upload_ok" S OK=1 Q OK ; TRNPIC ; N N,GL,UR0 S UR0=1 S GL=$$GLMSD("PAR") S N="" F S N=$O(@GL@(N)) Q:N="" I $$TRNPICP(MSD,N) Q ; TRNPICP(MSD,N) N FLPIC,LPIC,CMD,CON,OK,J,OK I $$NOSHOW1(N) Q 1 S MREST=$$GETREST(MSD) I MREST="" Q 0 S FLPIC=$$PICL^W4P(N) I FLPIC="" Q 1 S LPIC=$P(FLPIC,"/",$L(FLPIC,"/")) I LPIC="" Q 1 I LPIC'["pic" Q 1 ; S OK=1 F J=1:1:$L(MREST,",") S REST=$P(MREST,",",J) I REST S OK=$$TRNPIC2R(REST) Q OK ; TRNPIC2R(REST) N CMD,CON,J S CMD="curl -s -T """_FLPIC_""" " S CMD=CMD_"""http://www.mishlohim.co.il/Rashad/PutImage.ashx?" S CMD=CMD_"businessID="_REST S CMD=CMD_"&fileName="_LPIC_"""" ; S @$$TRM@("CMDPIC",LPIC)=CMD ; S CON="MSLPIC" ; O CON:(COMMAND=CMD:READONLY)::"PIPE" ; I $ZSY D C CON Q 0 .S @$$TRM@("ER","PIC",LPIC)=$ZSY_"\"_$H ; S OK=$$READ(CON) C CON ; S @$$TRM@("CMDPIC",LPIC,"OK")=OK ; I $D(W3MSLPIC) D .N SH .D TMP^W3MSLPIC .S SH=$O(@TMP@(999999),-1)+1 .S @TMP@(SH)=LPIC_" - "_$S(OK:"OK",1:"NOK") Q 1 ; VRM(STAM) ; Q "^[$$^W3MAIN]VRM($J)" ; MAIN(GLB) ; Q "^[$$^W3MAIN]"_GLB_"($J)" ; W4MAIN(GLB) ; Q "^[$$^W3MAIN]"_GLB_"($J)" ; BDKL ; I $L(ST)>MAXL D S ST=">>>" .S ST=ST0_ST_">>>" D W Q ; NOFILTER(STAM) ; I $G(TRG) Q 1 Q 0 ; SEND(JB) ; N MSD S MSD=$$GETP^%W1PRM("MSD") Q:MSD="" ; I $D(@$$MRK)<10 D Q .D ^W3TRM("",MSD) .K ^[$$^W3MAIN]flag("TRM") ; S %ARG("IND1")=+$H S %ARG("IND2")=$P($H,",",2) ; N MRK S MRK="" F S MRK=$O(@$$MRK@(MRK)) Q:MRK="" D .D ^W3TRM(MRK,MSD) ; K ^[$$^W3MAIN]flag("TRM") Q ; TRM(STAM) ; Q $$^W4GL("W3TRM") ; MRK(STAM) ; Q $$GLMSD("W4MRK") W3TRM0 W3TRM(TOMRK,MSD,MEDAT,ADDAT,MEPAR,ADPAR) ; [ 12.02.18 09:47 ] [ 11.02.18 18:04 ] [ 10.02.18 17:45 ] N (MSD,MEDAT,ADDAT,MEPAR,ADPAR,%SCKPORT,JB,%ARG,%REM,TOMRK) I $$^%L1FLAG($$^W4flag_"(""TRM"")") Q I '$G(^[$$^W3MAIN]flag("TRM")) S ^[$$^W3MAIN]flag("TRM")=$J,^[$$^W3MAIN]flag("TRM","TIME")=$H S SF2=0 S TOMRK=+$G(TOMRK) I $$SF^W4PRM S %ARG("TRG")=1 I TOMRK=2,$$SF^W4PRM S SF2=1 I '$G(MSD) S MSD=1 ; D ^%L1TS S DATA="" S TRG=$G(%ARG("TRG")) I '$G(JB) S JB=$$^%W1SsID("W3TRM") ;;N $ZT S $ZT="G SVER^%L1X" ; S MAXL=4000 ; S MEDAT=$G(MEDAT),ADDAT=$G(ADDAT) S MEPAR=$G(MEPAR),ADPAR=$G(ADPAR) S D1=$$^%L1DC(MEDAT,3) S D2=$$^%L1DC(ADDAT,3) ; I MEDAT="",ADDAT="",MEPAR="",ADPAR="" S GL=$$GLMSD("PAR") G EXP ; S GL=$$W4MAIN("TEMP") K @GL ; S I=0 S N=D1-1 F S N=$O(@$$GLMSD("PARPROT")@(N)) Q:N="" Q:N>D2 D .S N1="" F S N1=$O(@$$GLMSD("PARPROT")@(N,N1)) Q:N1="" D ..S A=^(N1) ..S PAR=$P(A,"\") I MEPAR,PARADPAR Q ..I $$NOSHOW(PAR) Q ..I $P(A,"\",2)="=" Q ..I $P(A,"\",2)="-" S B=$P(A,"\",4) ..S I=I+1 I $P(A,"\",2)=">" S @$$W4MAIN("TEMP")@(PAR)="" ; ; EXP ; N PATHP,FN,N,N1,PAR,PATHP,SET,ST,VP S KOLMAX=$G(@$$^W4PRM@("KOLMAX")) ; K @$$W4MAIN("MMM") K @$$W4MAIN("VRM"),@$$W4MAIN("KVUZA") ; S SH=0 ; S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW(N) Q .S SHOW=1 I $$NOFILTER S SHOW='$$NOSHOW1(N) .S ST="ITEM_DETS,"_N_","_$$HB($$SHEM(N))_","_SHOW_","_$J($$MH(N),2,2) . .S VP=$$VP(N) . .S VP1=$P(@$$GLMSD("PAR")@(N),"**",5) ; SUG .S ST=ST_","_VP_","_KOLMAX_"***" D W . .I VP1>0,$D(@$$GLMSD("PARSUG")@(VP1)) D ..I $$NOSHOWGR(VP1) Q ..S SHK=$ZP(@$$W4MAIN("KVUZA")@(VP1,""))+1 ..S @$$W4MAIN("KVUZA")@(VP1,SHK,N)="" . .I VP=1 S ST0="ITEM_ADDONS,"_N,ST="" D ; -- PARIT - TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZI")@(N,N1)) Q:N1="" D ...I $$NOSHOW(N1) Q ...D BDKL ...S ST=ST_","_N1 ..D WST . .I 'VP,VP1,$D(@$$GLMSD("P1EZKI")@(VP1)) D ..S ST0="ITEM_ADDONS,"_N,ST="" D ; -- PARIT - TOSAFOT ...S N1="" F S N1=$O(@$$GLMSD("P1EZKI")@(VP1,N1)) Q:N1="" D ....I $$NOSHOW(N1) Q ....D BDKL ....S ST=ST_","_N1 ...D WST . .K @$$^W4MAIN("VRMEZT") . .I VP=2 S ST0="ITEM_AI,"_N,ST="" D ; -- PARIT - KVUZAT TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZT")@(N,N1)) Q:N1="" D ...S NP=+$G(^(N1)) ...S @$$^W4MAIN("VRMEZT")@(N,NP)=N1 ..S NP="" F S NP=$O(@$$^W4MAIN("VRMEZT")@(N,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:N1="" ...D BDKL ...S ST=ST_","_N1 ..D WST .K @$$^W4MAIN("VRMEZT") . .K @$$^W4MAIN("VRMEZA") .I VP=3 S ST0="ITEM_AI,"_N,ST="" D ; -- ARUHA ISKIT ..S N1="" F S N1=$O(@$$GLMSD("P1EZA")@(N,N1)) Q:N1="" D ...S NP=+$G(^(N1)) ...S @$$^W4MAIN("VRMEZA")@(N,NP)=N1 ..S NP="" F S NP=$O(@$$^W4MAIN("VRMEZA")@(N,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:N1="" ...D BDKL ...S ST=ST_","_N1 ..D WST .K @$$^W4MAIN("VRMEZA") . .I VP=4 S ST0="ITEM_ADDONS,"_N,ST="" D ; -- RAV BRERA ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...I $$NOSHOW(N1) Q ...D BDKL ...S ST=ST_","_N1 ..D WST ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...S N2="" F S N2=$O(@$$GLMSD("P1SBR")@(N2)) Q:N2="" I N2?1N.N.".".N D ....Q:$G(@$$GLMSD("P1SBR")@(N2))?.P Q:$D(@$$W4MAIN("MMM")@(N1,N2)) ....S ST="ITEM_REMARKS,"_N1_","_N2_","_$$HB(@$$GLMSD("P1SBR")@(N2)) ....S ST=ST_"***" D W ....S @$$W4MAIN("MMM")@(N1,N2)=N . .I $D(@$$GLMSD("P1EZH")@(N)),'$D(@$$GLMSD("P1EZRI")@(N)) D ..S N1="" F S N1=$O(@$$GLMSD("P1EZH")@(N,N1)) Q:N1="" D ...Q:'$D(@$$GLMSD("P1CODH")@(N1)) ...S ST="ITEM_REMARKS,"_N ...S ST=ST_","_N1_","_$$HB($G(@$$GLMSD("P1CODH")@(N1))) ...S ST=$E(ST,1,509)_"***" D W . .I $D(@$$GLMSD("QNDEF")@(N))>9 D ..S ST0="ITEM_QNDEF,"_N,ST="" D ; -- ADD QN DFLT ...S N1="" F S N1=$O(@$$GLMSD("QNDEF")@(N,N1)) Q:N1="" D ....S QN=+$G(^(N1)) Q:'QN ;Q:QN'?1N.N ....I $$NOSHOW(N1) Q ....D BDKL ....S ST=ST_","_N1_"-"_QN ...D WST . ; S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW(N) Q .N N1 S N1="" F S N1=$O(@$$GLMSD("L1TIP")@("MTK",N,N1)) Q:N1="" D ..S ST="ITEM_DESC,"_N ..N A S A=$G(^(N1)) Q:A?.P ..S ST=ST_","_N1_","_$$HB($$DESC(N,N1))_"***" ..D W ; ;----------------- ADDONS PRICES ------- N ST0 S N="" F S N=$O(@GL@(N)) Q:N="" D .I $$NOSHOW(N) Q .S ST0="ITEM_ADDONS_PRC,"_N . .S VP=$$VP(N) . .I VP=1 D Q ; -- PARIT - TOSAFOT ..S N1="" F S N1=$O(@$$GLMSD("P1EZI")@(N,N1)) Q:N1="" D ...I $$NOSHOW(N1) Q ...S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W . .K @$$^W4MAIN("VRMSETA") .I VP=2 D Q ; -- PARIT - KVUZAT TOSAFOT ; N1 - SETIM ..S N1="" F S N1=$O(@$$GLMSD("P1EZT")@(N,N1)) Q:N1="" D ...I N1?1N.N.".".N S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W Q ...S NSET=$E(N1,2,9) Q:NSET="" ...K @$$^W4MAIN("VRMSETA") ...S N2="" F S N2=$O(@$$GLMSD("P1SETA")@(NSET,N2)) Q:N2="" D ....S NP=$G(^(N2)) Q:'NP ....S @$$^W4MAIN("VRMSETA")@(NSET,NP)=N2 ...S NP="" F S NP=$O(@$$^W4MAIN("VRMSETA")@(NSET,NP)) Q:NP="" D ....S N2=$G(^(NP)) Q:'N2 ....I $$NOSHOW(N2) Q ....S ST=ST0_","_N2_","_$J($G(@$$GLMSD("MHT")@(N,N2)),2,2)_"***" D W . .K @$$^W4MAIN("VRMSETA") .I VP=3 D Q ; -- ARUHA ISKIT ..S N1="" F S N1=$O(@$$GLMSD("P1EZA")@(N,N1)) Q:N1="" D ...I N1?1N.N.".".N S ST=ST0_","_N1_","_$J($$MH(N1),2,2)_"***" D W Q ...S NSET=$E(N1,2,9) Q:NSET="" ...K @$$^W4MAIN("VRMSETA") ...S N2="" F S N2=$O(@$$GLMSD("P1SETA")@(NSET,N2)) Q:N2="" D ....S NP=$G(^(N2)) Q:'NP ....S @$$^W4MAIN("VRMSETA")@(NSET,NP)=N2 ...S NP="" F S NP=$O(@$$^W4MAIN("VRMSETA")@(NSET,NP)) Q:NP="" D ....S N2=$G(^(NP)) Q:'N2 ....I $$NOSHOW(N2) Q ....S ST=ST0_","_N2_","_$J($G(@$$GLMSD("MHT")@(N,N2)),2,2)_"***" D W . .K @$$^W4MAIN("VRMSETA") .I VP=4 D Q ; -- RAV BRERA ..S N1="" F S N1=$O(@$$GLMSD("P1EZR")@(N,N1)) Q:N1="" D ...I $$NOSHOW(N1) Q ...S ST=ST0_","_N1_",0.00,***" D W ; ; I $D(@$$GLMSD("P1CODH")) S N=99999999 D .S N1="" F S N1=$O(@$$GLMSD("P1CODH")@(N1)) Q:N1="" D ..S ST="ITEM_REMARKS,"_N ..S ST=ST_","_N1_","_$$HB($G(@$$GLMSD("P1CODH")@(N1))) ..S ST=$E(ST,1,509)_"***" D W ; I $D(@$$GLMSD("P1SETA")) D .S SET="" F S SET=$O(@$$GLMSD("P1SETA")@(SET)) Q:SET="" I SET?1N.N.".".N D ..S SHEM=$P($G(@$$GLMSD("P1SETA")@(SET)),"\") I SHEM?.P S SHEM=SET_" hq" ..S KAM=+$P($G(@$$GLMSD("P1SETA")@(SET)),"\",2) I KAM<1 S KAM=1 ..S ST="ITEM_SETS,A"_SET_","_KAM ..K @$$^W4MAIN("VRMSETA") ..S N1="" F S N1=$O(@$$GLMSD("P1SETA")@(SET,N1)) Q:N1="" D ...N NP S NP=$G(^(N1)) Q:'NP ...S @$$^W4MAIN("VRMSETA")@(SET,NP)=N1 ..S NP="" F S NP=$O(@$$^W4MAIN("VRMSETA")@(SET,NP)) Q:NP="" D ...S N1=$G(^(NP)) Q:'N1 ...I $$NOSHOW(N1) Q ...D BDKL ...S ST=ST_","_N1 ..S ST=ST_"***" D W .. ..S ST="ITEM_DETS,A"_SET_","_$$HB(SHEM)_",1, , ,"_$P($G(@$$GLMSD("P1SETA")@(SET)),"\",2) ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1SETM")) D ;-- SET PRITIM LE MIVCA .S SET="" F S SET=$O(@$$GLMSD("P1SETM")@(SET)) Q:SET="" I SET?1N.N.".".N D ..S ST="ITEM_SETS,S"_SET_","_KOLMAX ..S N1="" F S N1=$O(@$$GLMSD("P1SETM")@(SET,N1)) Q:N1="" D ...I $$NOSHOW(N1) Q ...D BDKL ...S ST=ST_","_N1 ..S ST=ST_"***" D W ..S SHEM=$P($G(@$$GLMSD("P1SETM")@(SET)),"\") I SHEM?.P S SHEM=SET_" rvan hq" ..S ST="ITEM_DETS,S"_SET_","_$$HB(SHEM)_",1, , , " ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1MVC")@(1))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(1,N)) Q:N="" D ..S ST="SALE_DETS_1" ..N A S A=$G(^(N)) Q:$P(A,"\",14)=1 ..S MEJOM=$P(A,"\",8),ADJOM=$P(A,"\",9) ..S MESHAA=$P(A,"\",9),ADSHAA=$P(A,"\",11) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",7)_","_MEJOM_","_ADJOM ..S ST=ST_","_MESHAA_","_ADSHAA_","_$P(A,"\",1)_","_$P(A,"\",3)_","_$P(A,"\",4)_","_$P(A,"\",17)_","_$P(A,"\",6) ..S ST=ST_","_$TR($P(@$$GLMSD("P1MVC")@(1),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(1),"\",2),"/.","") ..S ST=ST_",1_"_N_","_$P(@$$GLMSD("P1MVC")@(1),"\",12)_"***" D W ; I $D(@$$GLMSD("P1MVC")@(2))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(2,N)) Q:N="" D ..S ST="SALE_DETS_2" ..N A S A=$G(^(N)) Q:$P(A,"\",12)=1 ..S MEJOM=$P(A,"\",6),ADJOM=$P(A,"\",7) ..S MESHAA=$P(A,"\",8),ADSHAA=$P(A,"\",9) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",5)_","_MEJOM_","_ADJOM_","_MESHAA_","_ADSHAA ..S ST=ST_","_$P(A,"\")_","_$P(A,"\",2)_","_$P(A,"\",15)_","_$P(A,"\",4) ..S ST=ST_",KOLMAX,"_$TR($P(@$$GLMSD("P1MVC")@(2),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(2),"\",2),"/.","") ..S ST=ST_",2_"_N_","_$P(@$$GLMSD("P1MVC")@(2),"\",10)_"***" D W ; I $D(@$$GLMSD("P1MVC")@(3))=11 D .S N="" F S N=$O(@$$GLMSD("P1MVC")@(3,N)) Q:N="" D ..S ST="SALE_DETS_3" ..N A S A=$G(^(N)) Q:$P(A,"\",14)=1 ..S MEJOM=$P(A,"\",8),ADJOM=$P(A,"\",9) ..S MESHAA=$P(A,"\",10),ADSHAA=$P(A,"\",11) D MEAD ..S ST=ST_",1,"_$$^%L1MRK_","_$P(A,"\",7)_","_MEJOM_","_ADJOM ..S ST=ST_","_MESHAA_","_ADSHAA_","_$P(A,"\",1)_","_$P(A,"\",3)_","_$P(A,"\",4)_","_$P(A,"\",17)_","_$P(A,"\",6) ..S ST=ST_","_$TR($P(@$$GLMSD("P1MVC")@(3),"\"),"/.","")_","_$TR($P(@$$GLMSD("P1MVC")@(3),"\",2),"/.","") ..S ST=ST_",3_"_N_","_$P(@$$GLMSD("P1MVC")@(3),"\",12)_"***" D W ; ; K @$$W4MAIN("MMMK") K @$$W4MAIN("MMMP") I $D(@$$GLMSD("P1KVZSID")) D .N NKV,PAR .S NKV="" F S NKV=$O(@$$GLMSD("P1KVZSID")@(NKV)) Q:NKV="" D ..S KV=$G(^(NKV)) Q:KV="" ..I $$NOSHOWGR(KV) Q ..N KV1 S KV1=$G(@$$GLMSD("PARSUG")@(KV)) ..I KV1="" Q ..I $D(@$$W4MAIN("KVUZA")@(KV))<10 Q ..S ST="ITEM_KVUZA,"_KV_","_$$HB(KV1) ..S @$$^W4MAIN("MMMP")@(KV)="" ..D SIDPRT(KV) ..S ST=ST_"***" D W ; ; ---------- IF NOT ^P1KVZSID -------------------------------- I $D(@$$W4MAIN("KVUZA")) S N1="" D .F S N1=$O(@$$W4MAIN("KVUZA")@(N1)) Q:N1="" D ..I $D(@$$^W4MAIN("MMMP")@(N1)) Q ..I $$NOSHOWGR(N1) Q ..S ST="ITEM_KVUZA,"_N1_","_$$HB(@$$GLMSD("PARSUG")@(N1)) ..D SIDPRT(N1) ..S ST=ST_"***" D W ..Q .. ..S ST="ITEM_KVUZA,"_N1_","_$$HB(@$$GLMSD("PARSUG")@(N1)) D ...S N3="" F S N3=$O(@$$W4MAIN("KVUZA")@(N1,N3)) Q:N3="" D ....S N2="" F S N2=$O(@$$W4MAIN("KVUZA")@(N1,N3,N2)) Q:N2="" D BDKL S ST=ST_","_N2 ...S ST=ST_"***" D W ; NL ; I $D(@$$GLMSD("PARNL")) D .S N1="" F S N1=$O(@$$GLMSD("PARNL")@(N1)) Q:N1="" D ..S A=^(N1),MESHAA=$P(A,"\"),ADSHAA=$P(A,"\",2) ..S MEJOM=$P(A,"\",3),ADJOM=$P(A,"\",4) ..S ST="ITEM_HLOCK,"_N1_","_MESHAA_","_ADSHAA_","_MEJOM_","_ADJOM,STKOT=ST ..S N2="" F S N2=$O(@$$GLMSD("PARNL")@(N1,N2)) Q:N2="" D ...D BDKL ...S ST=ST_","_N2 ..S ST=ST_"***" D W ; I $D(@$$GLMSD("P1KVZSID")) S STKOT="POZ_KVUZA," D .S N1="",N2="" .F S N1=$O(@$$GLMSD("P1KVZSID")@(N1)) Q:N1="" S N2=@$$GLMSD("P1KVZSID")@(N1) I $G(N2) D ..I $$NOSHOWGR(N2) Q ..S ST=STKOT_N1_","_N2_","_"***" D W ; I TRG D ^W3TRG(MSD) ; D TRN ; END K @$$^W4MAIN("VRM") K @$$^W4MAIN("MMM"),@$$^W4MAIN("MMMP"),@$$^W4MAIN("MMMK") K @$$^W4MAIN("KVUZA") Q ; ; SIDPRT(KV) ; N NP S NP="" F S NP=$O(@$$GLMSD("P1PARSID")@(KV,NP)) Q:NP="" D .N PAR S PAR=$G(^(NP)) .N SUG S SUG=$P(@$$GLMSD("PAR")@(PAR),"**",5) .Q:SUG'=KV Q:$$NOSHOW(PAR) .D BDKL .S ST=ST_","_PAR .I $D(@$$W4MAIN("MMMP")@(PAR)) Q .S @$$W4MAIN("MMMP")@(PAR)="" Q:$D(@$$GLMSD("P1PARSID")@(KV)) ; S N3="" F S N3=$O(@$$W4MAIN("KVUZA")@(KV,N3)) Q:N3="" D .S PAR="" F S PAR=$O(@$$W4MAIN("KVUZA")@(KV,N3,PAR)) Q:PAR="" D ..I $D(@$$W4MAIN("MMMP")@(PAR)) Q ..Q:$$NOSHOW(PAR) ..D BDKL S ST=ST_","_PAR ; Q ; TRN ; -------------- SHIDUR LE MISHLOHIM --------- N ITEM,WVW,RZD,N,N1,ST,DIR,I,J K @$$TRM@("ER") S TID="" ; S DIR=$$DIR(MSD) ; S MREST=$$GETREST(MSD) I MREST?.P S MREST=MSD ; S IND1=$G(%ARG("IND1")) I 'IND1 S IND1=+$H S IND2=$G(%ARG("IND2")) I 'IND2 S IND2=$P($H,",",2) ; I $G(@$$TRM@("DEB")) D .M @$$TRM@(IND1,IND2,"VRM",TOMRK)=@$$^W4MAIN("VRM") ; I 'TRG D .N J F J=1:1:$L(MREST,",") S REST=$P(MREST,",",J) I REST D ..D TRN2R(REST,"IT","TR",0,TOMRK) ; I TRG D .D TRN2R(MSD,"IT","TR",1,TOMRK) .D TRN2R(MSD,"LKH","TRL",1,TOMRK) .D TRN2R(MSD,"GEO","TRG",1,TOMRK) Q ; ; TRN2R(REST,PRFX,IND,TRG,TOMRK) N A,J,FN,SH,WVW,N,N1,ST,CMD,CON S FN=$$FN(PRFX_"_"_REST) ; C FN:DELETE O FN:(WRITE:NEWVERSION) S SH=0 ; I $G(TRG) U FN W "data=" ; S WVW="W1" D ^%L1TS ; S N="" F S N=$O(@$$W4MAIN("VRM")@(IND,N)) Q:N="" D .S ST="" ; .S N1="" F S N1=$O(@$$W4MAIN("VRM")@(IND,N,N1)) Q:N1="" D ..N A S A=$G(^(N1)) ..I A[">>>" D ...; ...I $E(A,$L(A)-2,$L(A))=">>>" S A=$E(A,1,$L(A)-3) ...I A[">>>" S A=$P(A,">>>",2) ..S ST=ST_A ..I $E(ST,$L(ST)-2,$L(ST))'="***" Q ..D @WVW S ST="" ; S ST="END_FILE***" D @WVW C FN ; ;;K @$$W4MAIN("VRM") ; I 'TOMRK S HTTP="http://www.mishlohim.co.il/rashad/UpdateMenu.aspx" I TOMRK S HTTP=$G(@$$MRK("W4MRK")@(TOMRK,"MAIN")) ; I $G(TRG) D G CMDMENU .N DOP .I $L($G(PRFX)) S DOP=$G(@$$MRK@(TOMRK,PRFX)) .I $E(HTTP,$L(HTTP))'="/" S HTTP=HTTP_"/" .S HTTP=HTTP_DOP .S CMD="curl -k """_HTTP_""" --data-urlencode data@"_FN ; S CMD="curl """_HTTP_""" -F "_PRFX_"_"_REST_".DAT=@"_FN S CMD=CMD_" | xmllint --format --encode cp862 - " ; CMDMENU S:$G(PRFX)="" PRFX=" " S IND1=$G(%ARG("IND1"),+$H) S IND2=$G(%ARG("IND2"),$P($H,",",2)) ; S @$$TRM@(IND1,IND2,"CMDMENU",TOMRK,PRFX)=$G(CMD) ; S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="IN PROGRESS" S CON="MSL" O CON:(COMMAND=CMD:READONLY)::"PIPE" ; I $ZSY D G ETRN2R .S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="ER\"_$ZSY_"\"_$H ; S OK=$$READ(CON) S @$$TRM@(IND1,IND2,"RES","MENU",TOMRK,PRFX)="OK\"_OK_"\"_$H ; ETRN2R C CON ; Q ; ; GLMSD(GLREF) Q "^["""_$$UCI(MSD)_"""]"_GLREF ; FN(FN) Q $$DIR(MSD)_FN_".dat" ; SHEM(CD) Q $P($G(@$$GLMSD("PAR")@(CD)),"**") ; MH(CD) Q $P($G(@$$GLMSD("PAR")@(CD)),"**",2) ; DESC(CD,NOM) ; Q $TR($G(@$$GLMSD("L1TIP")@("MTK",CD,NOM)),","," ") ; VP(N) ; N VP S VP=0 I $D(@$$GLMSD("P1EZA")@(N)) S VP=3 E I $D(@$$GLMSD("P1EZT")@(N)) S VP=2 E I $D(@$$GLMSD("P1EZI")@(N)) S VP=1 E I $D(@$$GLMSD("P1EZR")@(N)) S VP=4 Q VP ; W1 U FN W ST,! Q W N FLD,IND S FLD=$P(ST,",") S IND=$S(FLD="ITEM_DETS":1,FLD="ITEM_BRANCH":2,FLD="ITEM_ADDONS":3,FLD="ITEM_AI":4,FLD="ITEM_SETS":5,FLD="ITEM_REMARKS":6,FLD["SALE":7,FLD="ITEM_KVUZA":8,FLD="ITEM_HLOCK":9,FLD="POZ_KVUZA":10,1:11) S SH=SH+1,@$$W4MAIN("VRM")@("TR",IND,SH)=ST Q W2 ; X %SCKPORT("USE") W ST,! Q W3 ; X %SCKPORT("USE") W ST Q WST I $G(ST)="" Q S ST=ST0_ST_"***" D W Q ; MEAD ; I 'MEJOM,'ADJOM S MEJOM=1,ADJOM=7 I MEJOM,'ADJOM S ADJOM=MEJOM S:'MEJOM MEJOM=1 S:'ADJOM ADJOM=7 S:'MESHAA MESHAA="0000" S:'ADSHAA ADSHAA=2359 S MESHAA=$TR(MESHAA,":",""),ADSHAA=$TR(ADSHAA,":","") S MESHAA=$TR($J(MESHAA,2)," ",0) S ADSHAA=$TR($J(ADSHAA,2)," ",0) I $L(MESHAA)=2 S MESHAA=MESHAA_"00" I $L(ADSHAA)=2 S ADSHAA=ADSHAA_"00" I ADSHAA=2400 S ADSHAA=2359 Q ; HB(TXT) ;;Q $TR($$INVHBW^%L1FRM($TR(TXT,",","")),TS0,TS1) Q $TR($$^%W1H2U($TR(TXT,","," ")),TS0,TS1) ; NOSHOW(PAR) ; N SUG,ST S ST=$G(@$$GLMSD("PAR")@(PAR)) S SUG=$P(ST,"**",5) I SUG,$$NOSHOWGR(SUG) Q 1 I $G(TOMRK),$G(@$$GLMSD("W4PRTSND")@(PAR,TOMRK))=0 Q 1 I $$NOFILTER Q 0 Q $$NOSHOW1(PAR) ; NOSHOW1(PAR) ; I $D(@$$GLMSD("PRTNO")@(PAR)) Q 1 I $P($G(@$$GLMSD("W3PAR")@(PAR)),"\")=0 Q 1 N DIAPSHA S DIAPSHA=$G(@$$GLMSD("W3PAR")@(PAR,"SHAA")) ; I DIAPSHA'="",DIAPSHA'["0-23" Q 1 ;;,$$NOSHAA1^W3HZTFR(^("SHAA")) Q 1 N DAYS S DAYS=$G(@$$GLMSD("W3PAR")@(PAR,"DAYS")) I DAYS'="",DAYS'["11111" Q 1 ;;,'$E(^("DAYS"),$$^%L1DC($H,8)) Q 1 Q 0 ; NOSHOWGR(GR) ; I $G(@$$GLMSD("W3SUG")@(GR))=0 Q 1 I $G(@$$GLMSD("W3SUG")@(GR))=2 Q 1 Q 0 ; UCI(MSD) ; Q $G(^[$$^W3MAIN]UCI(MSD)) ; DIR(MSD) ; Q $ZPARSE($$UCI(MSD),"DIR") ; GETREST(MSD) ; N MREST,N S MREST="" S N="" F S N=$O(^[$$^W3MAIN]W3MSL2M(N)) Q:N="" D .I $G(^(N))=MSD S MREST=MREST_N_"," Q $E(MREST,1,$L(MREST)-1) ; GETVL(A,EL) ; S ZN=$P(A,"<"_EL_">",2) S ZN=$P(ZN,"") Q $$SPA^%L1FRM(ZN) ; READ(CON) D ^%L1TS N I,OK S OK=0 U CON S I=0 D .N TMP,A .S TMP=$$W4MAIN("TMPMSL") .N NOM S NOM=$O(@TMP@(999999),-1)+1 .N C R *C:20 Q:C<0 .S C=$C(C) .F R A Q:$ZEOF D Q:OK ..I $L(C) S A=C_A S C="" ..S I=I+1,@TMP@(NOM,I)=$TR($E(A,1,1400),TSS,TS0) ..I A["
" D ...R A I $$SPA^%L1FRM(A)="OK" S OK=1 ..I A["upload_ok" S OK=1 Q OK ; TRNPIC ; N N,GL S GL=$$GLMSD("PAR") S N="" F S N=$O(@GL@(N)) Q:N="" I $$TRNPICP(MSD,N) Q ; TRNPICP(MSD,N) N FLPIC,LPIC,CMD,CON,OK,J,OK I $$NOSHOW(N) Q 1 S MREST=$$GETREST(MSD) I MREST="" Q 0 S FLPIC=$$PICL^W4P(N) I FLPIC="" Q 1 S LPIC=$P(FLPIC,"/",$L(FLPIC,"/")) I LPIC="" Q 1 I LPIC'["pic" Q 1 ; S OK=1 F J=1:1:$L(MREST,",") S REST=$P(MREST,",",J) I REST S OK=$$TRNPIC2R(REST) Q OK ; TRNPIC2R(REST) N CMD,CON,J S CMD="curl -T """_FLPIC_""" " S CMD=CMD_"""http://www.mishlohim.co.il/Rashad/PutImage.ashx?" S CMD=CMD_"businessID="_REST S CMD=CMD_"&fileName="_LPIC_"""" ; S @$$TRM@("CMDPIC",LPIC)=CMD ; S CON="MSLPIC" ; O CON:(COMMAND=CMD:READONLY)::"PIPE" ; I $ZSY D C CON Q 0 .S @$$TRM@("ER","PIC",LPIC)=$ZSY_"\"_$H ; S OK=$$READ(CON) C CON ; S @$$TRM@("CMDPIC",LPIC,"OK")=OK ; I $D(W3MSLPIC) D .N SH .D TMP^W3MSLPIC .S SH=$O(@TMP@(999999),-1)+1 .S @TMP@(SH)=LPIC_" - "_$S(OK:"OK",1:"NOK") Q 1 ; W4MAIN(GLB) ; Q "^[$$^W3MAIN]"_GLB_"($J)" ; BDKL ; I $L(ST)>MAXL D S ST=">>>" .S ST=ST0_ST_">>>" D W Q ; NOFILTER(STAM) ; I $G(TRG) Q 1 Q 0 ; SEND(JB) ; N MSD S MSD=$$GETP^%W1PRM("MSD") Q:MSD="" ; I $D(@$$MRK)<10 D Q .D ^W3TRM("",MSD) ; S %ARG("IND1")=+$H S %ARG("IND2")=$P($H,",",2) ; N MRK S MRK="" F S MRK=$O(@$$MRK@(MRK)) Q:MRK="" D .D ^W3TRM(MRK,MSD) ; K ^[$$^W3MAIN]flag("TRM") Q ; TRM(STAM) ; Q $$^W4GL("W3TRM") ; MRK(STAM) ; Q $$GLMSD("W4MRK") W3TRMPR W3TRMPR ; [ 11.02.18 17:15 ] [ N (JB,%ARG,%REM) S TMP=$$^W4MAIN("TMP") K @TMP S GLTRM=$$TRM^W3TRM S I=0 S H1="" F S H1=$O(@GLTRM@(H1),-1) Q:H1="" D .S H2="" F S H2=$O(@GLTRM@(H1,H2),-1) Q:H2="" D ..I I>1 S I=I+1,@TMP@(I)="-------------" ..S M="" F S M=$O(@GLTRM@(H1,H2,"RES","MENU",M)) Q:M="" D ...S I=I+1 ...S @TMP@(I)=$ZD(H1_","_H2,"DD.MM.YY 24:60")_"\"_$$MRK(M) ... ...S PRFX="" F S PRFX=$O(@GLTRM@(H1,H2,"RES","MENU",M,PRFX)) Q:PRFX="" D ....S IND=$$IND(PRFX) ....S A=$G(^(PRFX)) ....S $P(@TMP@(I),"\",IND)=$P(A,"\") ; W "
",! D ^W4BUTTON("close","CLOSE","Close()","height:"_$$^W4KF(35)_"px;width:"_$$^W4KF(90)_"px;color:red;font-size:"_$$^W3FSZ(12)) W "

" W "" W $$^%W1DICT("SENDINGDATALIST") W "",! W "" W " " W "" W "" W "" W "" W "" W " ",! ; S TOP=0,DATTOP="" F I=1:1 Q:'$D(@TMP@(I)) D .S A=$G(^(I)) .I I=1 S TOP=1,DATTOP=$P(A,"\") .I I>1,$P(A,"\")'=DATTOP S TOP=0 .W "" . W "" . . W "" . . W "" . . W "" . . W "" .W "",! W "
"_$$^%W1DICT("STARTSENDINGTIME")_""_$$^%W1DICT("SITE")_""_$$^%W1DICT("ITEMSFILESENDINGSTATUS")_""_$$^%W1DICT("CLIENTSFILESENDINGSTATUS")_""_$$^%W1DICT("CITIESFILESENDINGSTATUS")_"
" . W $P(A,"\") . W "" . W $$H2U^%L1FRM($P(A,"\",2)) . W "" . W $P(A,"\",3) . W "" . W $P(A,"\",4) . W "" . W $P(A,"\",5) . W "
",! W "
",! Q ; MRK(MRK) ; Q $G(@$$^W4GL("W4MRK")@(MRK)) ; NM(PRFX) ; I PRFX="IT" Q "mihixt uaew" I PRFX="GEO" Q "mixr uaew" I PRFX="LKH" Q "zegewl uaew" Q "" ; IND(PRFX) ; I PRFX="IT" Q 3 I PRFX="LKH" Q 4 I PRFX="GEO" Q 5 Q 2 W3TSTOR0 W3TSTORD ; [ 30.06.14 20:01 ] [ 27.02.14 19:48 ] [ 25.02.14 15:46 ] S $ZT="ZG "_$ZL_":ER^W3TSTORD" N N,A,MSD,T CYC ; I $G(^[$$^W3MAIN]STLOOP("W3TSTORD")) H ; N DT S DT=$H-5 F S DT=$O(^[$$^W3MAIN]W3LINKD(DT)) Q:DT="" D .S N="" F S N=$O(^[$$^W3MAIN]W3LINKD(DT,N)) Q:N="" D ..S A=$G(^[$$^W3MAIN]W3LINKO(N)) ..S MSD=$$MSD(A) Q:'MSD ..S UCI=$G(^[$$^W3MAIN]UCI(MSD)) Q:UCI="" ..Q:$D(@$$^W3ORD(N)@(N,"D")) ..Q:$D(@$$^W3ORD(N)@(N,"F")) ..Q:$G(@$$^W3ORD(N)@(N,"DBF"))>3 ..Q:$D(@$$^W3ORD(N)@(N,"EMAIL")) ..Q:$D(@$$^W3ORD(N)@(N,"PC"))&$$AUTOPR^W3PRM(MSD) ..I '$$PRCOFR(N) Q:$P($G(@$$^W3ORD(N)@(N,"S")),";",2)=2 ..I '$$AUTOSEND^W3PRM(N),'$$AUTOPR^W3PRM(MSD),$D(@$$^W3ORD(N)@(N,"S")) Q ..S DTTO=$$^%L1DC($P($G(@$$^W3ORD(N)@(N)),"~",5),3) ..I DTTO'=+$H,'$$PRCOFR(N) Q ..S T=$$SENDTIME(A) ..S DIF=$P($H,",",2)-T ..I DIF<0 S DIF=DIF+86400 ..;;I DIF>900!($H>$P(A,"~",3))!$$PRCOFR(N),$TR($$FAX^W3R(MSD),"!-","") D ..I DIF>900,$TR($$FAX^W3R(MSD),"!-","") D ...S @$$^W3ORD(N)@(N,"DBF")="1\"_$H ...S TSTORD=$S($$PRCOFR(N):2,1:"") ...D SNDFAX(MSD,N) S ^[$$^W3MAIN]W3TSTORD=$ZD($H,"DD.MM.YY 24:60")_"\"_$J H 300 G CYC ; ER D SVER^%L1X H ; MSD(A) ; Q $P(A,"~",1) ; SENDTIME(A) ; Q $P($P(A,"~",3),",",2) ; SNDFAX(MSD,HZ) ; N (MSD,HZ,TSTORD) S FAX=$$FAX^W3R(MSD) I '$$PRCOFR(HZ) D ^W3FAXHTM(HZ,MSD,1) I $$PRCOFR(HZ) D D ^W3FAXHTM(HZ,MSD,2) .S @$$^W3ORD(HZ)@(HZ,"DBF")="2\"_$H S ^[$$^W3MAIN]W3TSTORD(HZ)=MSD_"\"_$H_"\F\"_$ZSY I '$ZSY D ^W3REGFAX(HZ) Q ; PRCOFR(HZ) ; I $$^W3PRCOFR(HZ)&(MSD=1) Q 1 Q 0 ; END Q W3TSTORD W3TSTORD ; [ 24.07.17 17:14 ] [ 13.09.14 17:56 ] [ 30.06.14 17:02 ] S $ZT="ZG "_$ZL_":ER^W3TSTORD" N N,A,MSD,T CYC ; I $G(^[$$^W3MAIN]STLOOP("W3TSTORD")) H ; N DT S DT=$H-5 F S DT=$O(^[$$^W3MAIN]W3LINKD(DT)) Q:DT="" D .S N="" F S N=$O(^[$$^W3MAIN]W3LINKD(DT,N)) Q:N="" D ..S A=$G(^[$$^W3MAIN]W3LINKO(N)) ..S MSD=$$MSD(A) Q:'MSD ..S UCI=$G(^[$$^W3MAIN]UCI(MSD)) Q:UCI="" ..Q:$D(@$$^W3ORD(N)@(N,"D")) ..Q:$D(@$$^W3ORD(N)@(N,"F")) ..Q:$G(@$$^W3ORD(N)@(N,"DBF"))>3 ..Q:$D(@$$^W3ORD(N)@(N,"EMAIL")) ..Q:$D(@$$^W3ORD(N)@(N,"PC"))&$$AUTOPR^W3PRM(MSD) ..I '$$PRCOFR(N) Q:$P($G(@$$^W3ORD(N)@(N,"S")),";",2)=2 ..I '$$AUTOSEND^W3PRM(N),'$$AUTOPR^W3PRM(MSD),$D(@$$^W3ORD(N)@(N,"S")) Q ..S DTTO=$$^%L1DC($P($G(@$$^W3ORD(N)@(N)),"~",5),3) ..I DTTO'=+$H,'$$PRCOFR(N) Q ..S T=$$SENDTIME(A) ..S DIF=$P($H,",",2)-T ..I DIF<0 S DIF=DIF+86400 ..N FAXTIM S FAXTIM=900 ..I $G(^[$$^W3MAIN]W3FAXTIM(MSD)) S FAXTIM=$G(^(MSD)) ..I DIF>FAXTIM,$TR($$FAX^W3R(MSD),"!-","") D ...S @$$^W3ORD(N)@(N,"DBF")="1\"_$H ...S TSTORD=$S($$PRCOFR(N):2,1:1) ; -- WAS "" 24/07/17 ...D SNDFAX(MSD,N) S ^[$$^W3MAIN]W3TSTORD=$ZD($H,"DD.MM.YY 24:60")_"\"_$J H 300 G CYC ; ER D SVER^%L1X H ; MSD(A) ; Q $P(A,"~",1) ; SENDTIME(A) ; Q $P($P(A,"~",3),",",2) ; SNDFAX(MSD,HZ) ; N (MSD,HZ,TSTORD) S FAX=$$FAX^W3R(MSD) I '$$PRCOFR(HZ) D ^W3FAXHTM(HZ,MSD,1) I $$PRCOFR(HZ) D D ^W3FAXHTM(HZ,MSD,2) .S @$$^W3ORD(HZ)@(HZ,"DBF")="2\"_$H S ^[$$^W3MAIN]W3TSTORD(HZ)=MSD_"\"_$H_"\F\"_$ZSY I '$ZSY D ^W3REGFAX(HZ) Q ; PRCOFR(HZ) ; I $$^W3PRCOFR(HZ)&(MSD=1) Q 1 Q 0 ; END Q W3TZ TZ(TZ) ; CHECK NUMBER TZ ; SHEER ; 07/07/93 [ 05.09.08 13:56 ] [ 07/07/93 10:36 AM ] ; INPUT -- TZ, OUTPUT -- S=1 IF TZ ORIGINAL, S=0 IF TZ -- FALSE N S,I,S2 S S=0 F I=1:2:8 S S=S+$E(TZ,I) F I=2:2:8 S S2=$E(TZ,I)*2,S=S+$E(S2)+$E(S2,2) S S=S+$E(TZ,9)#10=0 Q S W3UCI W3UCI(MSD) ; [ 08.06.11 08:53 ] [ 19.08.07 12:26 ] [ 26.06.07 08:29 ] I $G(MSD)="" Q "" I $$WEB^W3MAIN["195." S MSD=1 N MAINDIR S MAINDIR=$$^W3MAIN Q $G(^[MAINDIR]UCI(MSD)) W3UPLPIC W3UPLPIC(PRM) ; [ 12.02.20 13:12 ] [ 01.10.17 12:56 ] [ 10.07.13 10:58 ] N OK,FL,CD,MSD,PRE,TO S ^BB=PRM_" JB="_$G(JB) S OK=$P(PRM,";",1) I OK'="true" Q "NOTOK" S FL=$P(PRM,";",2) ;;I FL'[".jpg"&(FL'[".jpeg")&(FL'[".gif")&(FL'[".png")&(FL'[".bmp") Q "FILETYPEISWRONG" S CD=$P(PRM,";",3) S MSD=$P(PRM,";",4) S PRE=$P(PRM,";",5) I PRE="" S PRE="pic" I CD="" S CD=$P(FL,".") I PRE="crul" S CD=$$FUNC^%LCASE(CD) S TO=PRE_CD_".jpg" N A S A="sudo -u gtmuser /bin/mv /home/gtmuser/img/"""_FL_""" "_$$PATH(MSD)_TO I $G(^W3MAIN("WEB"))[".2order.org" D .S A="/bin/mv /home/gtmuser/img/"""_FL_""" "_$$PATH(MSD)_TO D PUT^%W3DEB("W3UPLPIC","A=A") ZSY A I '$ZSY D .S ^[$$^W3MAIN]TMPIMG(JB,CD)=1 .D PUT^%W1PRM("UPLPICFILE",TO) ; D PUT^%W1PRM("CRULSHCN",1) ;;S ^BB(1)=A ;;S ^BB("ZSY")=$ZSY ; Q $ZSY ; PATH(MSD) ; I '$G(MSD) S MSD=1 Q $$WEBL^W3MAIN_MSD_"/itp/" PATHWEB(MSD) ; I '$G(MSD) S MSD=1 Q $$WEB^W3MAIN_MSD_"/itp/" W3UTERM W3UTERM ; [ 18.06.09 21:14 ] [ 17.06.09 21:15 ] [ 08.05.09 18:21 ] N (JB,CODE,%ARG,%REM) S ORD=JB I $D(@$$^W3ORD(JB)@(JB)) Q I '$G(CODE) S CODE=$$GET^%W1PRM("CODE") S MSD=$$GET^%W1PRM("MSD") I MSD="" Q I $$^W3UCI(MSD)="" Q ;;S $ZGBLDIR=$$^W3UCI(MSD) D SAVE D HDMSD^W3ORDVW(MSD) D ^%L1WEBHD($$^W3MSDG(MSD),"T") ; W "

",! W "",! W "
",! W "

",$$^%W1DICT("THANKS"),! W "

",! W "

",! W $$^%W1DICT("UTERM") W "
",! W $$^%W1DICT("UTERM1") W "  ",$$H2U^%L1FRM($$CHECKERNAME^W3MENUHD),"" W "

",! W "",! W "

",! W "
",! ; W "
" W "
",! D ROUNDBUT^%W1JS("msgclose",$$^%W1DICT("CLOSE"),"Finish('"_CODE_"')","color:red","wh,22") W "
",! W "
",! END K ^[$$^W3MAIN]TMPORD(JB),^[$$^W3MAIN]TMPTF($$^%W1JB) K @$$^W4PARCAT D KILL^%W1PRM("CHECKER") D KILL^%W1PRM("CODE") Q ; SAVE ; N CHECKER,CODE S CHECKER=$$GET^%W1PRM("CHECKER") Q:'CHECKER S CODE=$$GET^%W1PRM("CODE") Q:'CODE N IND S IND=$O(^[$$^W3MAIN]W3UNIT(CHECKER,+$H,CODE,9999),-1)+1 M ^[$$^W3MAIN]W3UNIT(CHECKER,+$H,CODE,IND)=^[$$^W3MAIN]TMPORD(JB) S ^[$$^W3MAIN]W3UNIT(CHECKER,+$H,CODE,IND)=JB_"\"_$H_"\"_$G(%REM) Q W3VHOD W3VHOD ; [ 21.06.12 10:07 ] [ 20.06.12 21:46 ] [ 12.06.12 10:29 ] INIT ; D ^%W1ARG,^W3CSS D PUT^%W1PRM("OUTCOMP",$$OUTCOMP^W3VHOD) D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",$G(%ARG("MSD"))) Q ; PSW(COMP) I $G(COMP)="" Q "" Q $$PSW^W4L(COMP,$$^W4GL("W3COMP")) ; CHKPSW(PRM) S USR=$TR($P(PRM,";"),"-$!","") S PSW=$P(PRM,";",2) S COMP=$P(PRM,";",3) ;;I $$D^W3L(USR)'=11 Q 0 I $$PSW(COMP)'=PSW Q 0 Q 1 ; PUT(PRM) ; N (JB,%ARG,%REM,PRM) S CODE=$P(PRM,";") S CODE=$TR(CODE,"-~!","") D PUT^%W1PRM("CODE",CODE) ;S COMP=$$OUTCOMP S NAME=$P(PRM,";",2) S TIME=$P(PRM,";",3) S COMP=$P(PRM,";",4) ; 1 2 3 5 6 7 9 13 14 15 16 27 31 32 38 39 40 41 42 43 47 56 57 58 59 60 ;NMB;NAME;STREET;;DAT;SHAA;COMMENT;;DMSH;;;;FLOOR;FLAT;HOME;ENTRANCE;;;;;;;;;;;CODE;;;;CITY;PELE;;;;;;AHUZ;DATIDdd;DATIDmm;DATIDyy;SHAAhrid;SHAAmnid;;;;COMP;;;;;;;;;EMAIL;MIKUD;FAX;TELB;HZMLAK S NAME=$$SPA^%L1FRM($$CNWEB^%L1FRM(NAME)) I $L(NAME) D .S NAME=$$INVH^%L1FRM(NAME) .D PUT^W3L(CODE,NAME,"LKH") .I $$D^W3L(CODE)<11 D ..N GL D GL^W3L ..S @GL@(CODE,1)="*" ..S @GL@(CODE,2)="*" ..S @GL@(CODE,3)="*" ..S @GL@(CODE,4)="*" ; N ST S ST=$G(@$$^W4TMPORD) S GLC=$$^W4GL("W3COMP") S $P(ST,"~")=CODE S $P(ST,"~",2)=$$LKH^W3L(CODE) S $P(ST,"~",3)=$$KTV^W4L(COMP,GLC) N DAT S DAT=$ZD($H,"DD.MM.YY") S $P(ST,"~",5)=DAT S $P(ST,"~",6)=TIME S $P(ST,"~",7)=$$CMNT^W3L(CODE) S $P(ST,"~",9)=$$DMSHNIS^W4L(COMP,GLC) S FLOOR=$$KOMA^W3L(CODE) ; -- DOP-T I FLOOR="" S FLOOR=$$KOMA^W4L(COMP,GLC) S $P(ST,"~",13)=FLOOR S $P(ST,"~",14)=$$DIRA^W3L(CODE) ; -- DOP-T S $P(ST,"~",15)=$$BAIT^W4L(COMP,GLC) S $P(ST,"~",16)=$$CNISA^W4L(COMP,GLC) S $P(ST,"~",27)=CODE S $P(ST,"~",31)=$$IR^W4L(COMP,GLC) S $P(ST,"~",32)=CODE S $P(ST,"~",38)=$$HNH^W4L(COMP,GLC) F J=39:1:41 S $P(ST,"~",J)=$P(DAT,".",J-38) S $P(ST,"~",42)=+TIME S $P(ST,"~",43)=$P(TIME,":",2) S $P(ST,"~",47)=$$LKH^W4L(COMP,GLC) S $P(ST,"~",56)=$$EMAIL^W3L(CODE) S $P(ST,"~",57)=$$MIKUD^W4L(COMP,GLC) N FAX S FAX=$$FAX^W3L(CODE) I FAX=""!($L(FAX)<7) S FAX=$$FAX^W4L(COMP,GLC) S $P(ST,"~",58)=FAX S $P(ST,"~",59)=$$TEL^W4L(COMP,GLC) ; S @$$^W4TMPORD=ST Q ; OUTCOMP(STAM) ; I $$OUTCOMP^W3PRM Q $$OUTCOMP^W3PRM I $G(%ARG("OUTCOMP")) Q %ARG("OUTCOMP") I $$GETP^%W1PRM("OUTCOMP") Q $$GETP^%W1PRM("OUTCOMP") Q 0 ; CODE(STAM) ; I $G(%ARG("CODE")) Q %ARG("CODE") I $$GETP^%W1PRM("CODE") Q $$GETP^%W1PRM("CODE") Q 0 ; SELSHAA ; W "",! Q W3VLDADD W3VLDADD(TXT) ; [ 06.01.22 15:29 ] [ 17.10.18 12:55 ] [ 07.01.08 17:02 ] N LI,BG,PRT,PRA,BGA,SUMA,ER,CD,TST,TST1 S LI=$$LI^W3HZMST(JB) I 'LI Q 1 S TST=1 I $$LVST^W3HZMST(JB,LI)=0 D .N CD S CD=$$CDST^W3HZMST(JB,LI) .I $$DD^W4EZA(CD)!$$DD^W4EZT(CD),$P(TXT,"~")=0 S TST=0 ; S TST1=1 I 'TST S TST1=0 I $$LVST^W3HZMST(JB,LI)=0,TST Q 1 ; S BG=$$LASTI0^W3HZMST(JB) N STPAR S STPAR=$$LAST0^W3HZMST(JB) Q:STPAR="" 1 S PRT=$P(STPAR,"~",2) ; D CRTMP^W3HZTSF(PRT,"^[$$^W3MAIN]VRMJB") ; S (PRA,BGA,SUMA,EQA)=0 ; N GL S GL="^[$$^W3MAIN]VRMJB($$^%W1JB,3)" F I=1:1 Q:'$D(@GL@(I)) D Q:'TST .N A S A=$G(@GL@(I)) .S CD=$$CD^W3TMPTF(A) .I $E(CD)="A" D Q ..I PRA,EQA,+SUMA'=+PRA S TST="0~"_BGA_"~"_SUMA_"~"_PRA_"~"_EQA ..S PRA=$$PR^W3TMPTF(A),BGA=I,SUMA=0,EQA=$$EQ^W3TMPTF(A) . .I PRA S SUMA=SUMA+$$VALADD^W3HZTSF(CD) ; D PUT^%W3DEB("W3VLDADD","TST=TST") I PRA,EQA,+SUMA'=+PRA S TST="0~"_BGA_"~"_SUMA_"~"_PRA_"~"_EQA I PRA,'EQA,SUMA>PRA S TST="0~"_BGA_"~"_SUMA_"~"_PRA_"~"_EQA I TST,'TST1 S TST=0 I TST="" S TST=0 D PUT^%W3DEB("W3VLDADD","TST=TST") Q TST W3VLDDT W3VLDDT(DAT) ; [ 18.03.13 12:17 ] [ 12.11.10 13:00 ] [ 28.09.08 06:59 ] N MSD S MSD=$$GET^%W1PRM("MSD") I '$G(MSD) Q 1 N DTN,DTNDP,DT1234,DT5,DT6,DT7,I TV S DTN=$$^%L1DC(DAT,8) S ER=0 F I=1:1:7 D .S @("DT"_I_"=$$DP"_I_"^W3R(MSD)") .I @("DT"_I)="",DTN=I S ER=-I .I @("DT"_I)="00:00:00-00:00:00",DTN=I S ER=-I .I @("DT"_I)="00:00-00:00",DTN=I S ER=-I I ER<0 Q ER I $$^%L1DC(DAT,3)<$H Q -8 S @("DTNDP=$$DP"_DTN_"^W3R(MSD)") N DP2 S DP2=$P(DTNDP,"-",2) I $$^%L1DC(DAT,3)=+$H,$P($H,",",2)>(DP2*3600+$P(DP2,":",2)*60) Q -8 N CNT S CNT=$$COUNTRY^W3R(MSD) I $L(CNT),$D(^[$$^W3MAIN]HAG(CNT,$$^%L1DC(DAT,3))) Q -9 I $D(@$$^W4GL("HAG")@($$^%L1DC(DAT,3))) Q -9 Q 1 W3VLDHD W3VLDHD ; [ 09.01.25 10:56 ] [ 18.05.24 14:39 ] [ 26.12.23 12:31 ] ; D ^%W1JS D TBLSEL^%W1JS ; W "",! W "",! W "",! ; N ZPR S ZPR=$G(@Z@(DT,IND)) I ZPR["B" D Q .S %SCRN="W4TOT" .I ZPR["L" S %SCRN="W4TOTLKH" .M @$$^W4MAIN("TMPREP")=@Z@(DT,IND) .D KOTZ^W4DMANY($ZD(DT,"DD.MM.YY"),IND) .D ^%W1FREP(%SCRN) ; S PRZ=0,PRZM=0,PRY=0 W "",! S NP="" F S NP=$O(@Z@(DT,IND,NP)) Q:NP="" D .S A=$G(^(NP)) .N ALG S ALG=$$^%W1ALIGN .I A["- Z -" S PRZ=1,PRZM=1,PRY=0 .I A[" g""ec",A'["zexikn",A'["mei zxibq",A'="zelaw",A'="dxibn" S PRZM=0 .I A["- Y -" S PRY=1 .I (A["- X -") S PRY=0 .I A["- Y -"!(A["- X -") S PRZ=0 .I A["- Z -"!(A["- Y -")!(A["- X -") S ALG=" align=""center"" " .I $G(%ARG("OPT"))="ZONLY",'PRZ Q .I $G(%ARG("OPT"))="ZMANY",'PRZ!'PRZM Q .I $G(%ARG("OPT"))="YONLY",'PRY Q .S STYLE=" style=""" .I A["- X -"!(A["- Y -")!(A["- Z -")!(A["g""ec") S STYLE=STYLE_"font-weight:bold" .S STYLE=STYLE_"""" .W "",! W "
"_$$H2U^%L1FRM(A)_"
",! ; Q ; SELOPT ; W "",! Q ; SELDAT ; N Z,DT,IND D Z W "",! Q ; Z ; S Z=$$^W4GL("Z") Q ; PRINT(PRM) ; D ^W4MDPPC N DAT,DT,IND,OPT,NP,A S DAT=$P(PRM,";") S IND=$P(PRM,";",2) S OPT=$P(PRM,";",3) S DT=$$^%L1DC(DAT,3) N Z D Z I DT=""!(IND="") Q ; S TXT=$G(%MDP("B"))_"!!! wzrd "_$G(%MDP("N")) D S1^W4PCST S TXT=$ZD($H,"DD/MM/YY 24:60")_" : dqtcd onf" D S1^W4PCST S TXT="" D S1^W4PCST ; D PRINTZ(DT,IND,OPT) PRINTE Q ; PRINTZ(DT,IND,OPT) ;N NP,TXT ;S NP="" F S NP=$O(@Z@(DT,IND,NP)) Q:NP="" D ;.S TXT=$G(^(NP)) ;.D S1^W4PCST S PRZ=0,PRZM=0,PRY=0 S NP="" F S NP=$O(@Z@(DT,IND,NP)) Q:NP="" D .S A=$G(^(NP)) .I A["- Z -" S PRZ=1,PRZM=1 .I A[" g""ec",A'["zexikn",A'["mei zxibq",A'="zelaw",A'="dxibn" S PRZM=0 .I A["- Y -"!(A["- X -") S PRZ=0 .I A["- Z -"!(A["- X -") S PRY=0 .I OPT="ZONLY",'PRZ Q .I OPT="ZMANY",'PRZ!'PRZM Q .I OPT="YONLY",'PRY Q .S TXT=A D S1^W4PCST Q ; PRINTCSR(STAM) ; N DAT,DT,IND,Z,PRM S PRM=$G(%ARG("DAT")) S DAT=$P(PRM,";") S IND=$P(PRM,";",2) S DT=$$^%L1DC(DAT,3) I 'DT!'IND Q 0 D Z I $G(@Z@(DT,IND))["B" Q 0 I $$^W4LKH,'$$DOCCSR^W4LKHCSR Q 0 Q 1 W4ABC W4ABC(TXT) ; [ 25.03.25 21:58 ] [ 24.03.25 16:28 ] [ 19.03.25 10:28 ] N (JB,%ARG,%REM,TXT) D PUT^%W3DEB("W4ABC","%ARG=[%ARG & TXT=TXT") D DEF ; S VL=$$CNWEB^%L1FRM($G(%ARG("VL"))) I $$NOCAPS S %ARG("CAPS")=1 D PUT^%W1PRM("ABCCAPS",1) I $G(%ARG("CAPS")),$$GETP^%W1PRM("ABCCAPS") S VL=VL_" " I VL["[CL]" D .S VL=$$RPL^%L1FRM(VL,"[CL]","") .S VL=$$INVH^%L1FRM(VL) ; I VL="",$G(%ARG("SHID"))["LV0",$P(TXT,"~")=0 D .N STID,TXT1 S STID=%ARG("SHID") .S TXT1=$$TXTNEXT^W4HZORD(STID) .I $P(TXT1,"~",2)["-C" S VL=$P(TXT1,"~",3,3) ; I '$G(%ARG("CAPS")),$G(%ARG("TXT"))?1N1"~"1N.E,$G(%ARG("SHID"))["LV",VL'="" D .I $E(VL)'=";" D ..I $$HB S VL=" ; "_VL Q ..S VL=VL_" ; " ; S VL=$$H2U^%L1FRM(VL) ; S TXT=$$CNWEB^%L1FRM(TXT) S HD=$P(TXT,"~",3) I $E(HD)="<" S HD=$$^%W1DICT($E(HD,2,50)) ; I HD="",$P(TXT,"~",2) D .N PAR S PAR=$P(TXT,"~",2) .S HD=$$SHEM^W4P(PAR) ; I HD="" S HD=$$^%W1DICT("COMMENT") ; D KB(MAXL,VL) Q ; ; KB(MAXL,VL) ; D PUT^%W3DEB("W4ABC","MAXL=MAXL & VL = VL") D NOSELECT^%W1JS N SZ S SZ="36" I $G(%ARG("SZ")) S SZ=$G(%ARG("SZ")) N FSZ S FSZ=12+($$1700^W4WDSCR*6) I $G(%ARG("FSZ")) S FSZ=$G(%ARG("FSZ")) W "
",! ; I $G(%ARG("TAW")) D TAWBUT ; W "",! W "" W "" W "" W "",! ; W "",! ; N SZ S SZ=50 I $$^W4TABLET=2 S SZ=60 W "" W "" W "",! ; ;;W "",! ; D KBABC ; W "
"_$$H2U^%L1FRM($G(HD))_"
" W "" W "
 
" ; W "" D .W "" ; W "" ; I '$G(%ARG("NOBACK")) D .W "",! .W "" ; W "
" . W "" .W "" W "" W " " . W "" .W "
" W "
 
",! W "
",! Q ; ; KBABC ; N CELLSPC S CELLSPC=$S($$1024^W4WDSCR:3,1:7) I $G(%ARG("CELLSPC")) S CELLSPC=$G(%ARG("CELLSPC")) I $$^W4SMALL!($$^W4TABLET=1&'$G(@$$^W4PRM@("TABLETABC"))!($$^W4TABLET=2)) Q W "" W "" W "",! S K=0,W4ABC="" ; F I=1:1:4 D .W "",! .F J=1:1:10 D ..S K=K+1 .. ..I I=4 D S J=10 Q ...I '$$HB D ....I $$NOCAPS D .....S SPAN=8 D DIGIT^W4KB(" ") .....S SPAN=1 D DIGIT^W4KB("C","","red","ClearDisplay()") ....I '$$NOCAPS D .....S SPAN=3 D DIGIT^W4KB("CapsLock",1,"darkblue","CapsLock()") .....K SPAN S J=J+2 .....S SPAN=6 D DIGIT^W4KB(" ") ....K SPAN S J=10 D DEL ... ...I $$HB D ....I LNG="E" D Q .....D DEL .....I '$$NOCAPS D ......S SPAN=2 D DIGIT^W4KB("Hebrew",1,"green","ToHebrew()") ......S SPAN=5 D DIGIT(" ") K SPAN .....I $$NOCAPS D ......S SPAN=7 D DIGIT(" ") K SPAN .....D DIGIT("!") .....D DIGIT("'") S J=10 ....; --- LNG="H" ....D DEL ....S SPAN=1 D DIGIT^W4KB("C","","red","ClearDisplay()") ....I '$$NOCAPS D .....S SPAN=2 D DIGIT^W4KB("English",1,"green","ToEnglish()") .....S SPAN=4 D DIGIT(" ") K SPAN ....I $$NOCAPS D .....S SPAN=6 D DIGIT(" ") K SPAN ....D DIGIT("!") ....D DIGIT("'") S J=10 .. ..D LETTER(K,MAXL) .W "",! ; K SPAN I '$G(%ARG("NODIGIT")) D .W "" .I $$HB F J=9:-1:0 D ..D DIGIT(J) .I '$$HB F J=0:1:9 D ..D DIGIT(J) .W "",! .; .W "" .;;D DEL .; .D DIGIT("."),DIGIT(","),DIGIT("-"),DIGIT("/") .D DIGIT("("),DIGIT(")"),DIGIT("*"),DIGIT("%") .D DIGIT(":"),DIGIT(";") W "",! W "
",! W "" W "",! Q ; ; LETTER(K,MAXL) ; W " " Q I $G(SPAN) W " colspan="""_SPAN_"""" W " onMouseOver=""this.style.cursor='pointer';this.style.backgroundColor='gray'""" W " onMouseDown=""this.style.backgroundColor='gray'""" W " "_$$^W4TOUCH_"=""this.style.backgroundColor='#eaeaea';ClickLetter('"_ABC(K)_"',"_+$G(MAXL)_")""" W " onMouseOut=""this.style.backgroundColor='#eaeaea'""" W ">" W "  &#"_ABC(K)_";  " W "" Q ; DIGIT(K) ; N W4ABC S W4ABC="" D DIGIT^W4KB(K) Q ; STYLE(COLOR) ; S COLOR=$G(COLOR) W "style=""" D .N FSZ S FSZ=$S($$^W4SMALL:+$$^W3FSZ,$$^W4TABLET:22,1:20) .I $$1024^W4WDSCR S FSZ=FSZ-2 .I $$GETP^%W1PRM("ABCLNG")="E" S FSZ=FSZ-2 .I COLOR'="" W "color:"_$G(COLOR)_";" .W "font-size:"_FSZ_"pt" W """" Q ; SBM(CMNT) ; -- CMNT = CMNT^SHID^LV^PRT D PUT^%W3DEB("W4ABC-SBM","CMNT=CMNT") N OK S OK=0 N SHID S SHID=$P(CMNT,"^",2) I SHID="SRCH" Q 9 ; N LV S LV=$P(CMNT,"^",3) N PRT S PRT=$P(CMNT,"^",4) S CMNT=$$INVH^%L1FRM($$CNWEB^%L1FRM($P(CMNT,"^"))) ; I SHID="CMHD" D Q "CMHD" .D PUT^W3HZMST(JB,"CMHD",CMNT) ; N TMPORD D TMPORD^W4HZORD N LI I SHID["LV",$$SPA^%L1FRM(CMNT)="" S CMNT="[]" ; I $$GET^%W1PRM("SMALLHD"),SHID["LV0" D Q "SMALLHD" .N LI S LI=+$P(SHID,"LV0",2) .N STLI S STLI=$G(@TMPORD@(LI)) Q:$P(STLI,"~")'=0 .Q:'$L(CMNT) .N PRT S PRT=$P(STLI,"~",2) .I $D(@TMPORD@(LI+1)) D ..D ADD^%L1GSEQ(TMPORD,LI+1,"",1) .S @TMPORD@(LI+1)="1~"_PRT_"-C0~"_CMNT ; Q $$SETCMNT^W4CMNT("CMNT",CMNT,0,SHID,LV,PRT) ; ; ; INIT D ^W4CSS I $G(%ARG("FIRST")) D KILL,CHKENG Q KILL ; D KILL^%W1PRM("ABC") D KILL^%W1PRM("W4ABC") D KILL^%W1PRM("ABCLNG") D KILL^%W1PRM("ABCCAPS") Q ; DEF ; K ABC S HGTR=40 I $G(%ARG("HGTR")) S HGTR=%ARG("HGTR") S LNG=$$GETP^%W1PRM("ABCLNG") I LNG="" S LNG=$$^%W1LNG S CAPS=0 I $$GET^%W1PRM("ABCCAPS") S CAPS=1 I $$^%W1LNG="H",LNG="E" S CAPS=1 ; I $G(@$$^W4PRM@("ABC")) D .I LNG="E",'CAPS D ..F I=97:1:122 S ABC(I-96)=I .I LNG="E",CAPS D ..F I=65:1:90 S ABC(I-64)=I .I LNG="H" D ..F I=1488:1:1514 S ABC(I-1487)=I .I LNG="R" D ..F I=1135:1:1166 S ABC(I-1134)=I ; I '$G(@$$^W4PRM@("ABC")) D .N I .I '$$HB D Q ..I 'CAPS D ...N ST S ST="qwertyuiop" ...S ST=ST_"asdfghjkl " ...S ST=ST_"zxcvbnm " ...F I=1:1:$L(ST) S ABC(I)=$A(ST,I) ..I CAPS D ...N ST S ST="QWERTYUIOP" ...S ST=ST_"ASDFGHJKL " ...S ST=ST_"ZXCVBNM " ...F I=1:1:$L(ST) S ABC(I)=$A(ST,I) .. .I LNG="E",'CAPS D ..N ST S ST="poiuytrewq" ..S ST=ST_" lkjhgfdsa" ..S ST=ST_" mnbvcxz" ..F I=1:1:$L(ST) S ABC(I)=$A(ST,I) .I LNG="E",CAPS D ..N ST S ST="POIUYTREWQ" ..S ST=ST_" LKJHGFDSA" ..S ST=ST_" MNBVCXZ" ..F I=1:1:$L(ST) S ABC(I)=$A(ST,I) .I LNG="H" D ..S ST="tmoeh`xw " ..S ST=ST_"sjlgirkbcy" ..S ST=ST_"uzvnpdaqf " ..F I=1:1:$L(ST) S ABC(I)=$S($E(ST,I)=" ":32,1:1392+$A(ST,I)) ; S MAXLETTERS=$O(ABC(999),-1) S MAXL=36 I $G(%ARG("MAXL")) S MAXL=%ARG("MAXL") Q ; ; TAWBUT ; I $$^W4AIN Q N NMB S NMB=$$GETP^%W1PRM("NMB") Q:NMB="" I $$TAW^W4DLPK(NMB) Q N UR S UR=$P(TXT,"~") I UR Q N CD S CD=$P(TXT,"~",2) Q:CD="" I '$G(@$$^W4GL("PARTA")@(CD)) Q N STID S STID=$G(%ARG("SHID")) N NST S NST=+$P(STID,"LV0",2) N TAWCMNT,FLAG S TAWCMNT=$$^%W1DICT("TAWCMNT"),FLAG=1 I $$CMST^W3HZMST(JB,NST)[$$TAWCMNT D .S TAWCMNT=$$^%W1DICT("NOTAWCMNT"),FLAG=0 W "",! Q ; TAWSET(PRM) ; N STID,ACT,NST D PUT^%W3DEB("W4ABC-TAWSET","PRM=PRM") S STID=$P(PRM,";") I STID'["LV0" Q S ACT=$P(PRM,";",2) S NST=+$P(STID,"LV0",2) Q:'NST N NMB S NMB=$$NMB^W3HZMST(JB) ; N LKHN,ZMANK S LKHN=$$LKHN^W3HZMST(JB) S ZMANK=$$DATCB^W3HZMST(JB) N PRMHNMB S PRMHNMB=NMB ; N CD S CD=$$CDST^W3HZMST(JB,NST) N LV S LV=$$LVST^W3HZMST(JB,NST) ; I ACT,$G(@$$^W4GL("PARTA")@(CD)) D Q .N TAWABC S TAWABC=1 .S $P(@$$^W4TMPORD@(NST),"~",4)=$$MH^W4P(CD) .S $P(@$$^W4TMPORD@(NST),"~",7)=$$TAWCMNT . .I '$$^W4EZAT(CD)!LV D ..N K F K=NST+1:1 Q:'$D(@$$^W4TMPORD(K)) Q:'$$LVST^W3HZMST(JB,K) D ...N CDT S CDT=$$CDST^W3HZMST(JB,K) Q:'$$ISNUM^%L1FRM(CDT) ...S $P(@$$^W4TMPORD@(K),"~",4)=$$MH^W4P(CDT) ; I 'ACT D Q .S $P(@$$^W4TMPORD@(NST),"~",4)=$$MH^W4P(CD) .S $P(@$$^W4TMPORD@(NST),"~",7)="" .I '$$^W4EZAT(CD)!LV D ..N K F K=NST+1:1 Q:'$D(@$$^W4TMPORD(K)) Q:'$$LVST^W3HZMST(JB,K) D ...N CDT S CDT=$$CDST^W3HZMST(JB,K) Q:'$$ISNUM^%L1FRM(CDT) ...S $P(@$$^W4TMPORD@(K),"~",4)=$$MH^W4P(CDT) Q ; ; TAWCMNT(STAM) ; I $G(@$$^W4PRM@("SHEML")) Q "[ TAKE AWAY ]" Q "["_$$TV^%W1DICT($$^%W1LNG,"TAWCMNT")_"]" ; CHKENG ; I $$ABCENG^W4PRM D ^W4SETENG Q CHECKER(TXT) ; N (JB,%ARG,TXT) S HZM=$$GETP^%W1PRM("HZM") Q:'HZM S LAST=$O(@$$^W4ORD@(HZM,99999),-1)+1 S CD=$$CHECKERCD^W4PRM Q:'CD S NM=$$SHEM^W4P(CD) S @$$^W4ORD@(HZM,LAST)=CD_"\\"_NM_"\\1\\\"_TXT D ^W4HZM(HZM,JB) Q ; HB(STAM) ; I $$^%W1LNG="H" Q 1 Q 0 ; DEL ; W "Del" Q ; STLBUT(STAM) ; Q "width:100%;height:100%;border:2px ridge lightgrey" ; HEIGHT(HGTR) ; I '$G(HGTR) S HGTR=40 Q "height="""_$$^W4KF(HGTR)_""" " ; NOCAPS() ; Q $G(%ARG("NOCAPS")) W4ABCHNH W4ABCHNH ; [ 01.04.25 15:22 ] [ 22.03.21 08:53 ] [ 10.08.17 17:54 ] N (JB,%ARG,%REM) D DEF^W4ABC ; S HD=$$^%W1DICT("COMMENT") S VL="" D KB(MAXL,VL) Q ; KB(MAXL,VL) ; D NOSELECT^%W1JS W "
",! W "",! W "" W "" W "" W "",! ; W "",! ; W "" W "" W "",! ; I $$^W4SMALL!($$^W4TABLET=2!($$^W4TABLET=1&'$G(@$$^W4PRM@("TABLETABC")))) G EKB W "" W "" W "",! ; ; EKB ; W "
"_$G(HD)_"
" W "" W "
 
" W "" W "" W "" W "" W "" W "" W "
" W "" W " " W "" W " " ;;W "" W "" W "
" W "
" W "",! S K=0 F I=1:1:4 D .W "",! .F J=1:1:10 D ..S K=K+1 ..I K<36 D LETTER(K) ..;;I K=36 D DIGIT("'") ..;;I K=37 D DIGIT("""") ..I K=36 S SPAN=5 D DIGIT(" ") K SPAN .W "",! ;;D DIGIT(".") D DIGIT(0) ; W "" S K=0 F J=1:1:10 D .D DIGIT(K) .S K=K+1 ; W "",! W "" W "" D DIGIT("."),DIGIT(","),DIGIT("-"),DIGIT("/") D DIGIT("("),DIGIT(")"),DIGIT("*"),DIGIT("%") D DIGIT(":") W "",! W "
Del
",! W "
",! W "
",! Q ; LETTER(K) ; W " " Q I $G(SPAN) W " colspan="""_SPAN_"""" W " onMouseOver=""this.style.cursor='pointer';this.style.backgroundColor='gray'""" W " onMouseDown=""this.style.backgroundColor='gray'""" W " onMouseUp=""this.style.backgroundColor='#eaeaea';ClickLetter('"_ABC(K)_"')""" W " onMouseOut=""this.style.backgroundColor='#eaeaea'""" W ">" W "  &#"_ABC(K)_";  " W "" Q ; DIGIT(K) ; D DIGIT^W4KB(K) Q ; SBM(CMNT) ; N HZM S HZM=$$GET^%W1PRM("HZM") N OK S OK=0 S CMNT=$$INVH^%L1FRM($$CLEAR^%L1FRM(CMNT)) D SETCMHN^W4CMNHNH(HZM,CMNT) Q 1 ; NOCMNT(CMNT) I CMNT="NO"!(CMNT="") Q 1 Q 0 ; HEIGHT(STAM) ; Q " height="""_$$^W4KF(40)_""" " W4ABCIND W4ABCIND(N,NM) ; [ 10.03.17 18:59 ] [ 28.02.17 07:25 ] [ S NM=$$SPA^%L1FRM(NM) S NM=$$HBR^%L1FRM(NM,10) S NM=$$INV^%L1FRM(NM) Q NM_$TR($J(N,12)," ",0) W4ABCKVZ W4ABCKVZ ; [ 02.12.21 08:53 ] [ 18.05.21 14:39 ] [ 22.10.20 14:41 ] N A,IND,N,J,TMPABC N GL S GL=$G(W4ABC("GL")) I GL="" S GL="PARSUG" S TMPABC=$$TMPABC N GLOB S GLOB=$$^W4GL(GL) I $E(GL,1,3)="TMP" S GLOB=$$^W4MAIN(GL) K @TMPABC S N="" F S N=$O(@GLOB@(N)) Q:N="" S A=$G(^(N)) D .I GL="PARSUG",'$$^W4VWGR(N),$D(W4ABC("NOHIDE"))!$G(%ARG("NOVWHIDE")) Q .D SETABC(A,N) Q ; TMPABC(STAM) ; Q $$^W4MAIN("TMPABC") ; SETABC(A,N) ; N J,IND S A=$P(A,"**") S A=$TR(A,"0123456789-/.*,""';$&!() ","") S A=$$SPA^%L1FRM(A) S A=$$HBR^%L1FRM(A,10) S IND=$$INV^%L1FRM(A) F J=1:1 Q:'$D(@TMPABC@(IND_J)) S IND=IND_J S @TMPABC@(IND)=N Q W4ABCN W4ABCN(TXT) ; [ 01.12.22 19:17 ] [ 01.11.22 08:53 ] [ 21.05.18 16:18 ] N (JB,%ARG,%REM,TXT) D PUT^%W3DEB("W4ABCN","%ARG=[%ARG & TXT=TXT") D ^%W1ARG S TYPKB=$G(TYPKB) I TYPKB="E" D ^W4SETENG D DEF ; S VL=$$CNWEB^%L1FRM($G(%ARG("VL"))) I VL["[CL]" D .S VL=$$RPL^%L1FRM(VL,"[CL]","") .S VL=$$INVH^%L1FRM(VL) ; S VL=$$H2U^%L1FRM(VL) ; S TXT=$$CNWEB^%L1FRM(TXT) ; D KB(MAXL,VL) Q ; ; KB(MAXL,VL) ; D PUT^%W3DEB("W4ABC","MAXL=MAXL & VL = VL") D NOSELECT^%W1JS N SZ S SZ="18" W "
",! ; W "",! ; I $G(TYPKB)'="N" D .D KBABC ; I $G(TYPKB)="N" D KBNUM ; W "
",! W "
",! Q ; ; KBABC ; Q:$$^W4SMALL W "" W "" W "",! S K=0,W4ABC="" F I=1:1:3 D .W "",! .F J=1:1:10 D ..S K=K+1 ..I I=1,J=9 D CLOSE(2) Q ..I I=1,J=10 Q ..D LETTER(K,MAXL,SZF) .W "",! ; D BOTLINE($G(TYPKB)) W "
",! W "" W "",! Q ; KBNUM ; Q:$$^W4SMALL W "" W "" W "",! W "",! F J=1:1:10 D .S K=J#10 .D DIGIT(K) W "",! ; W "" F K="?","@","$","%","/","&","*","(",")","-" D .D DIGIT(K) W "",! ; W "" F K=".",",",";",":","[","]","'","!","+","=" D .D DIGIT(K) W "",! ; W "" D DIGIT^W4KB($$H2U^%L1FRM("ba`"),1,"green","ToHebrew()",SZF) D .N SPAN S SPAN=2 .D DIGIT^W4KB("ABC",1,"green","ToEnglish('1')",SZF) I $$^%W1LNG'="H" D .D DIGIT^W4KB("abc",1,"green","ToEnglish('0')",SZF) .D SPACE(1) D CLOSE(3+($$^%W1LNG="H")) D DEL D UP D DOWN W "",! W "
",! W "" W "",! ; Q ; ; LETTER(K,MAXL,FSZ) ; I '$G(FSZ) S FSZ=22 W " " Q I $G(SPAN) W " colspan="""_SPAN_"""" W " onMouseOver=""this.style.cursor='pointer';this.style.backgroundColor='gray'""" W " onMouseDown=""this.style.backgroundColor='gray'""" W " onMouseUp=""this.style.backgroundColor='#eaeaea';ClickLetter('"_ABC(K)_"',"_+$G(MAXL)_")""" W " onMouseOut=""this.style.backgroundColor='#eaeaea'""" W ">" W "  &#"_ABC(K)_";  " W "" Q ; DIGIT(K) ; N W4ABC S W4ABC="" D DIGIT^W4KB(K,"","","",SZF) Q ; DEL ; W "Del" Q ; UP ; D DIGIT^W4KB("Up",1,"","ABCNUp('"_$G(%ARG("K"))_"','"_$G(%ARG("SCRN"))_"')") Q ; DOWN ; D DIGIT^W4KB("Down",1,"","ABCNDown('"_$G(%ARG("K"))_"','"_$G(%ARG("SCRN"))_"')") Q ; SPACE(SPAN) ; I '$G(SPAN) S SPAN=2 D DIGIT(" ") Q ; CLOSE(SPAN) ; D DIGIT^W4KB($$^%W1DICT("CLOSE"),1,"red","Close()",SZF) Q ; REG ; N SPAN I LNG'="E" D Q .;;D DIGIT^W4KB("abc",1,"green","ToEnglish('0')",SZF) ; *** 01.11.22 .;;N SPAN S SPAN=2; *** 01.11.22 .D DIGIT^W4KB("ABC",1,"green","ToEnglish('1')",SZF) ; I $$^%W1LNG="H" D .D DIGIT^W4KB($$H2U^%L1FRM("ba`"),1,"green","ToHebrew()",SZF) ; I $$^%W1LNG'="H" D .I '$$GETP^%W1PRM("ABCCAPS") D ..N SPAN S SPAN=2 ..D DIGIT^W4KB("ABC",1,"green","ToEnglish('1')",SZF) .I $$GETP^%W1PRM("ABCCAPS") D DIGIT^W4KB("abc",1,"green","ToEnglish('0')",SZF) Q ; INIT ; I $G(%ARG("FIRST")) D KILL D CHKENG^W4ABC Q KILL ; D KILL^%W1PRM("ABCN") D KILL^%W1PRM("ABCLNG") D KILL^%W1PRM("ABCCAPS") D KILL^%W1PRM("ABCSEL") D KILL^%W1PRM("TYPKB") Q ; DEF ; K ABC S SZF=26 S HG=52 S LNG=$$GETP^%W1PRM("ABCLNG") I LNG="" S LNG=$$^%W1LNG S CAPS=0 I $$GETP^%W1PRM("ABCCAPS") S CAPS=1 ;;I $$^%W1LNG="H",LNG="E" S CAPS=1 ; I $G(@$$^W4PRM@("ABC")) D .I LNG="E",'CAPS D ..F I=97:1:122 S ABC(I-96)=I .I LNG="E",CAPS D ..F I=65:1:90 S ABC(I-64)=I .I LNG="H" D ..F I=1488:1:1514 S ABC(I-1487)=I .I LNG="R" D ..F I=1135:1:1166 S ABC(I-1134)=I ; I '$G(@$$^W4PRM@("ABC")) D .N I .I LNG="E",'CAPS D ..N ST S ST="poiuytrewq" ..S ST=ST_" lkjhgfdsa" ..S ST=ST_" mnbvcxz" ..F I=1:1:$L(ST) S ABC(I)=$A(ST,I) . .I LNG="E",CAPS D ..N ST S ST="POIUYTREWQ" ..S ST=ST_" LKJHGFDSA" ..S ST=ST_" MNBVCXZ" ..F I=1:1:$L(ST) S ABC(I)=$A(ST,I) . .I LNG="H" D ..S ST="tmoeh`xw " ..S ST=ST_"sjlgirkbcy" ..S ST=ST_"uzvnpdaqf " ..F I=1:1:$L(ST) S ABC(I)=$S($E(ST,I)=" ":32,1:1392+$A(ST,I)) ; S MAXLETTERS=$O(ABC(999),-1) S MAXL=36 I $G(%ARG("MAXL")) S MAXL=%ARG("MAXL") Q ; BOTLINE(TYPKB) ; W "" D DOWN D UP D DEL N SPAN I $$^%W1LNG'="H" S SPAN=2+$$GETP^%W1PRM("ABCCAPS") I $$^%W1LNG="H" S SPAN=4 D DIGIT^W4KB(" ",1,"","ClickLetter('32')") D SWITCH D REG W "",! Q ; SWITCH ; N SPAN S SPAN=2 D DIGIT^W4KB("123;:!",1,"green","ToNumbers()",SZF) Q W4ACKCR W4ACKCR ; [ 31.03.17 18:01 ] [ S %ARG("HEAD")="GDCR",%ARG("MAXL")=5 D ^W4KB Q ; ; ACK(PRM) ; N ORD,TEMP,GDCR,GBNOW,LK,RES S ORD=$P(PRM,";") S TEMP=$P(PRM,";",2) S RES=1 ; I TEMP D Q RES .S HBNOW=2 .S LK=$$NMB^W4HZMST(ORD) I '$$^W4MSL(LK) S RES="CUSTOMERNUMBERISWRONG" .I $$D^W4L(LK)'=11 S RES="CUSTOMERNOTEXIST" .N ITRA S ITRA=$$ITRA^W4HZMST(ORD) .S GDCR=$$ITRA^W4L(LK)+ITRA+10 .I GDCR",! W "" W " "_$$^%W1DICT("BANK")_"" W " "_$$^%W1DICT("SNIF")_"" W " "_$$^%W1DICT("TZ")_"" W " "_$$^%W1DICT("ACCOUNT")_"" W "" F I=1:1 Q:'$D(@$$^W4MAIN("TMP")@(I)) D .N A S A=$G(^(I)) .W " ",! .F J=1:1:$L(A,";") D ..W ""_$P(A,";",J)_"" .W "",! W "",! Q CHOICE(NST) ; Q $G(@$$^W4MAIN("TMP")@(NST)) ; CRACNT(STRING) ; N N,I,BANK,SNIF,TZ,HESBON S N="" F S N=$O(@$$^W4GL("KLF")@(STRING,"CB",N)) Q:N="" D CRACNTN(STRING,N,"CB") S N="" F S N=$O(@$$^W4GL("KLF")@(STRING,"HMK",N)) Q:N="" D CRACNTN(STRING,N,"HMK") Q ; CRACNTN(STRING,NUMBER,CODDOC) ; D ACNT N I,BANK,SNIF,TZ,HESBON I CODDOC="CB" D .F I=1:1 Q:'$D(@$$^W4GL("KLF")@(STRING,"CB",NUMBER,I)) D CRACNTN1 I CODDOC="HMK" D .F I=1:1 Q:'$D(@$$^W4GL("KLF")@(STRING,"HMK",NUMBER,"CB",I)) D CRACNTN1 Q ; CRACNTN1 ; S A=$G(^(I)) Q:A="" D G^W4SCV("KLINC",A) I BANK=11,SNIF=111 Q I BANK,SNIF,HESBON S @ACNT@(+BANK,+SNIF,+TZ,+HESBON)="" Q ; ACNT ; S ACNT=$$^W4GL("KLCH")_"(STRING)" Q W4ADDCHN W4ADDCHN ; [ 31.12.17 08:13 ] [ 11.04.17 09:16 ] [ 10.03.14 08:10 ] N (JB,%ARG,%REM) D CLEAR^W4SCASK D PUT^%W1PRM("VP","ADDCHN") S %ARG("VZ")="ASK" S %ARG("FIRST")=1 D ^W4SCASK Q ; ; ADD(CDCMNT) ; D PUT^%W3DEB("W4ADDCHN-ADD","CDCMNT=CDCMNT") N OK S OK=0 N SHID S SHID=$P(CDCMNT,";",2) N LV S LV=$P(CDCMNT,";",3) N PRT S PRT=$P(CDCMNT,";",4) S CDCMNT=$P(CDCMNT,";") Q:CDCMNT="" ; S TXT=$G(@$$^W4GL("P1CODH")@(CDCMNT)) N TXTO S TXTO=$$TXTO(SHID,PRT) ; ; I $L(TXTO) D .S TXT=TXT_" ; "_TXTO ; N OKI S OKI="" D I OKI Q 3 ;-- ADD COMMENTS TO ADDONS ( NO EDIT MODE ) .N UR S UR=$$UR . .I SHID="",UR=3!(UR=5) D ..N TMPTFUR D TMPTFUR^W4HZTSF(UR) ..S OKI=$$FINDTMPPRT^W4CMNT(+UR,PRT) ..I OKI D ...N STO S STO=$G(@TMPTFUR@(OKI,"CMNT")) ...N CDO S CDO=$P(STO,"~") ...S @TMPTFUR@(OKI,"CMNT")=$P(CDO,"-")_"-C0~"_TXT . .D RESTUR^W4SCASK ; N RES S RES=$$SETCMNT^W4CMNT("CMNT",TXT,0,SHID,LV,PRT) D RESTUR^W4SCASK Q RES ; ; TXTO(SHID,PRT) ; N TXTO S TXTO="" N UR S UR=$$UR I UR=2!(UR=4)!($G(SHID)["LV") S TXTO=$P($$TXTNEXT^W4HZORD(SHID),"~",3) I UR=3!(UR=5),$G(SHID)'["LV" D .N TMPTFUR D TMPTFUR^W4HZTSF(UR) .N OKI S OKI=$$FINDTMPPRT^W4CMNT(+UR,PRT) .I OKI,$D(@TMPTFUR@(OKI,"CMNT")) S TXTO=$P($G(^("CMNT")),"~",2) Q TXTO ; UR(STAM) ; N UR S UR=+$$UR^W4MENU I 'UR D .N UROLD D TMPS^W4MENU .S UROLD=$G(@TMPS@("UROLD")) Q:'UROLD .S UR=+UROLD Q UR W4ADDHNH W4ADDHNH(HZM,VL,SIBA) ; [ 12.12.21 18:56 ] [ 09.12.20 08:12 ] [ 28.09.16 14:31 ] N NOM I $$CLOSE^W4HZMST(HZM)>1 Q N GLORD D GLORD^W4HZMST N HNHO S HNHO=$$HNH^W4HZMST(HZM) N TSHL S TSHL=$$TSHL^W4HZMST(HZM) S VL=$J(VL,2,2) S NOM=$O(@GLORD@("CB","HNH1",9999),-1)+1 N WHO S WHO=$$LASTMLZ^W4HZMST(HZM) ;;S ^AA("W4ADDHNH","MNL")=$$GETP^%W1PRM("MNL") I $$PSWDRG^W4PRM,$$GETP^%W1PRM("MNL") S WHO=$$GETP^%W1PRM("MNL") ; N MYDVN S MYDVN=$$^W4MYDVN N PORTDISP S PORTDISP=$$DISP^W4PLUK(MYDVN) I PORTDISP D .N TX1,TX2 .S TX1=$J(VL,2,2)_" : dgpd" .S TX2=$J($$ITRA^W4HZMST(HZM)-VL,2,2)_" : melyzl" .D ^W4TX2DSP(PORTDISP,TX1,TX2) ; S @GLORD@("CB","HNH1",NOM)=VL_"*"_$H_"*"_WHO_"*"_$$^W4MYDVN_"*"_$G(SIBA) ; D PUT^W4HZMST(HZM,"HNH",HNHO+VL) D PUT^W4HZMST(HZM,"TSHL",TSHL-VL) ; I $$D^W3TMPORD(JB)=11 D .D PUT^W3HZMST(JB,"HNH",HNHO+VL) .D PUT^W3HZMST(JB,"TSHL",TSHL-VL) .S @$$^W4TMPORD@("CB","HNH1",NOM)=VL_"*"_$H_"*"_WHO_"*"_$$^W4MYDVN_"*"_$G(SIBA) ; I $$MYCHECK^W4PRM D .D SYNCORD^WMCHFUNC(HZM,JB) Q W4ADDPAR W4ADDPAR(HZM,CD,QN,MH,TSF,CMNT) ; [ 29.09.15 15:37 ] [ 28.09.15 13:03 ] [ I $$CLOSE^W4HZMST(HZM) Q I $G(CD)="" S CD=0 N L S L=$O(@$$^W4ORD@(HZM,9999),-1)+1 N SUM S SUM=$J($G(QN)*$G(MH)+$G(TSF),2,2) S @$$^W4ORD@(HZM,L)=CD_"\\"_$$SHEM^W4P(CD)_"\"_$G(MH)_"\"_$G(QN)_"\"_$G(TSF)_"\"_SUM_"\"_$G(CMNT) S $P(^(L),"\",10)="@@!" D ^W4CALC(HZM) Q W4ADDPAY W4ADDPAY ; [ 07.03.15 12:34 ] [ 20.05.14 10:36 ] [ 05.12.13 08:43 ] N (JB,%ARG,%REM) W "
",! ; I $G(%ARG("DAT")) D PUT^%W1PRM("DAT",%ARG("DAT")) S DAT=$$GETP^%W1PRM("DAT") S DONAME=$$GETP^%W1PRM("DONAME") I 'DAT W " A DATE NOT DEFINED !" Q ; I $G(%ARG("FIRST")) D INIT ; W "" W $$^%W1DICT("ADDPAYMENTS",DAT) W "",! W "

",! ; W " ",! W " ",! W " ",! I '$$MKDM W " ",! I $$MKDM W " ",! W " ",! W " ",! W " ",! ; S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; F DT=DT1:1:DT2 D .W "",! . . W "" . . S AVAD=$$AVAD(OVED,DT) . W "" . . W "" . . W "" .W "",! ; W "
"_$$^%W1DICT("DATE")_""_$$^%W1DICT("ABSENCECAUSES")_""_$$^%W1DICT("ADDPAYMENTKINDS")_""_$$^%W1DICT("TOPAY")_""_$$^%W1DICT("COMMENT")_"
" . W $$^%L1DC(DT,1) . W "" . D . . N VL . . I AVAD'="" D Q . . . W $$RED($$^%W1DICT("WORKERWORKED",$$AVAD(OVED,DT))) . . . . S VL=$$CAUSE(OVED,$G(DT)) . . . . I ARGCS'="",VL=ARGCS!(VL="") D Q . . .W $$H2U^%L1FRM($G(@$$GLOB@(ARGCS))) . . .W "" . . . . D SELCAUSE(OVED,DT) . W "" . D . .I AVAD'="" W " " Q . .W "" . W "" . D . .I AVAD'="" W " " Q . .W "" . W "
",! W "

",! D DIVBUT W "
",! Q ; SELCAUSE(OVED,DT) ; I $G(DT)="" G SELC1 S VL=$$CAUSE(OVED,$G(DT)) S ARGCS=$G(%ARG("CAUSE")) I ARGCS'="",VL=ARGCS!(VL="") W $$H2U^%L1FRM($G(@$$GLOB@(ARGCS))) Q SELC1 ; N N,ID S ID="cause" I $G(DT) S ID=ID_DT W "",! Q ; ; CAUSE(OVED,DT) ; D FL N DAT S DAT=$ZD(DT,"YYMMDD") N N,OK S N="",OK="" F S N=$O(@$$GLOB@(N)) Q:N="" I $D(@FILE@(OVED,DAT,N)) S OK=N Q Q OK ; TSHL(OVED,DT) ; D FL N VL S VL=$$CAUSE(OVED,DT) I VL="" Q "" N DAT S DAT=$ZD(DT,"YYMMDD") Q $G(@FILE@(OVED,DAT,VL,"TSHL")) ; CMNT(OVED,DT) ; D FL N VL S VL=$$CAUSE(OVED,DT) I VL="" Q "" N DAT S DAT=$ZD(DT,"YYMMDD") Q $G(@FILE@(OVED,DAT,VL,"TXT")) ; AVAD(COD,DT) N AVAD S AVAD=$P($$^W4LEVTIM(COD,$ZD(DT,"YYMMDD")),"\") Q AVAD ; DIVBUT ; W "",! W "",! W " " W "" W " ",! W "",! W "
" D ROUNDBUT^%W1JS("repair",$$^%W1DICT("SUBMIT"),"Save()","color:green","wh,22") W "  " D ROUNDBUT^%W1JS("backid",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") W "
",! Q ; RED(RKV) ; Q ""_RKV_"" ; FL ; S FILE=$$^W4GL("FILE") Q ; INIT ; N DT,DT1,DT2,DAT D FL S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; K @$$^W4MAIN("TMPABS") F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .M @$$^W4MAIN("TMPABS")@(DAT)=@FILE@(OVED,DAT) Q ; ; SAVE(PRM) ; N (JB,%ARG,%REM,PRM) D FL S OVED=$$GETP^%W1PRM("OVED") Q:OVED="" S DONAME=$$DONAME ; F I=1:1:$L(PRM,";") D .S GR=$P(PRM,";",I) .S DT=$P(GR,"~") .S DAT=$ZD(DT,"YYMMDD") .S CAUSE=$P(GR,"~",2) Q:CAUSE="" .S TSHL=$P(GR,"~",3) .S CMNT=$$INVH^%L1FRM($$CNWEB^%L1FRM($P(GR,"~",4))) .S CAUSEOLD=$$CAUSE(OVED,DT) .S TSHLOLD=$$TSHL(OVED,DT) .S CMNTOLD=$$CMNT(OVED,DT) . .I $L(CAUSEOLD),CAUSE'=CAUSEOLD!(+TSHL'=+TSHLOLD)!(CMNTOLD'=CMNT) D ..D PROT(OVED,DAT,"DEL",CAUSEOLD) ..K @FILE@(OVED,DAT,CAUSEOLD) . .S @FILE@(OVED,DAT,CAUSE)=1 .S @FILE@(OVED,DAT,CAUSE,"MVC")=DONAME_"\"_$H .S @FILE@(OVED,DAT,CAUSE,"TSHL")=TSHL .S @FILE@(OVED,DAT,CAUSE,"TXT")=CMNT .D PROT(OVED,DAT,"SET",CAUSE) Q ; ; ; PROT(OVED,DAT,ACT,CAUSE) ; D FL S @$$^W4GL("FILEPROT")@(DAT,OVED,ACT,CAUSE)=$H_"\"_$$DONAME M @$$^W4GL("FILEPROT")@(DAT,OVED,ACT,CAUSE)=@FILE@(OVED,DAT,CAUSE) Q ; DONAME(STAM) ; Q $$GETP^%W1PRM("DONAME") ; GLOB(STAM) ; I $$MKDM Q $$^W4GL("W4MKDM") Q $$^W4GL("W4ABS") ; MKDM(STAM) ; Q $$MKDM^W4RPRABS W4ADDWND W4ADDWND(STAM) ; [ 23.11.17 19:57 ] [ I $$GRITVW^W4PRM,$$UR^W4MENU>2,'$$^W4AIN Q 1 I $$GRITVW^W4PRM,$$UR^W4MENU>4,$$^W4AIN Q 1 Q 0 W4ADM W4ADM(MLZ) ; [ 27.10.15 12:28 ] [ 11.10.15 05:44 ] [ 12.09.08 01:16 ] I @$$^W4PRM@("PSW")="",+MLZ=999!(+MLZ=99999) Q 1 I +MLZ=+@$$^W4PRM@("PSW")!(+MLZ=+(@$$^W4GL("PSW")+10)) Q 1 Q 0 W4ADRLST W4ADRLST ; [ 27.12.23 11:49 ] [ 10.06.20 12:03 ] [ 09.06.20 13:47 ] N (JB,%ARG,%REM) D ^%W1ARG ; D GL^W4L W "
",! D CLOSE I $G(LK)="" G END ; W "

",! W "",! ; S N="" F S N=$O(@GL@(LK,"A",N)) Q:N="" D .S IND=$TR(N,"\","~") .W "",! . W "" . W "" .W "",! W "
" . W $$KTVM(N) . W "" . W $$H2U^%L1FRM($$CITY(N)) . W "
",! W "

",! D CLOSE END ; W "
",! Q ; KTVM(A) ; N (JB,A) S DLM="\" S STREET=$P(A,DLM,2) S KTV=$$H2U^%L1FRM(STREET) S HOME=$P(A,DLM,3) S FLAT=$P(A,DLM,4) I $L(HOME) S KTV=KTV_" "_HOME I FLAT S KTV=KTV_"/"_FLAT S KOMA=$P(A,"\",5) I KOMA'="" S KTV=KTV_" "_$$H2U^%L1FRM(KOMA_" dnew") S CNISA=$P(A,"\",6) I CNISA'="" S KTV=KTV_" "_$$H2U^%L1FRM(CNISA_" dqipk") Q KTV ; CITY(A) ; Q $P(A,"\") ; CLOSE ; D ^W4BTN("CLOSE","Close()","red","",12) Q ; STYLETD(STAM) ; Q " style=""border-bottom-style:dotted;border-color:lightblue"" " W4ADVPAY W4ADVPAY ; [ 12.01.15 17:21 ] [ 24.10.11 13:26 ] [ 23.10.11 17:53 ] CUST ; N LKH K %SC("ER") S LKH=VL I LKH'?1N.N D Q .S %SC("ER")=1 .S %SC("ER","MSG")="FINDCUST" ; I '$$DC^W4L(LKH) D Q .S %SC("ER")=1 .S %SC("ER","MSG")="CUSTOMERNOTEXIST" ; I '$$ISCR^W4L(LKH) D Q .S %SC("ER")=1 .S %SC("ER","MSG")="CUSTNOTCREDIT" ; I '$$MAZAV^W4L(LKH) D Q .S %SC("ER")=1 .S %SC("ER","MSG")="CUSTCLOSED" Q ; INIT ; D CLEAR^W4SCASK D PUT^%W1PRM("VP","ADVPAY") D CREATE^W4ASK("ADVPAY","PAY") Q W4AHP W4AHP(ST) ; [ 10.11.08 18:16 ] [ 22.11.06 19:55 ] [ 10.03.05 13:40 ] [ N PAR S PAR=$P(ST,"\") I $E(PAR)="-",PAR["%" Q 1 Q 0 AH(ST) ; N PAR S PAR=$P(ST,"\") I $E(PAR)="-",PAR["%" Q +$E(PAR,2,25) Q 0 W4AIDF W4AIDF(PRM) ; [ 22.06.18 06:34 ] [ 11.01.17 05:20 ] [ 22.11.16 11:59 ] N (JB,%ARG,PRM) S QN0=$P(PRM,";") S:'QN0 QN0=1 S PAR0=$P(PRM,";",2) Q:PAR0="" N LAST,TMPORD,I S TMPORD=$$^W4TMPORD ; S SHEM=$$SHEM^W4P(PAR0) S NMB=$$NMB^W3HZMST(JB) S MH0=$$MH^W4P(PAR0) S STPAR0="0~"_PAR0_"~"_SHEM_"~"_MH0_"~"_QN0 ; N GLQNDF S GLQNDF=$$^W4GL("QNDEF") S P1SETA=$$^W4GL("P1SETA") S LAST=$O(@TMPORD@(999999),-1) S I=LAST+1 ; S @TMPORD@(I)=STPAR0 ; N REF S REF=$$REF^W4EZAT(PAR0) ; N MVRM,N,NP,NS N SET S SET="" F S SET=$O(@REF@(SET)) Q:SET="" D .S NS=$E(SET,2,10) Q:'NS .S N="" F S N=$O(@P1SETA@(NS,N)) Q:N="" D ..S NP=$G(^(N)) ..S QNDEF=$G(@GLQNDF@(PAR0,N)) Q:'QNDEF ..S MVRM(NS,NP)=N_";"_QNDEF . .S NP="" F S NP=$O(MVRM(NS,NP)) Q:NP="" D ..I '$D(MSET(NS)) D ...S I=I+1 ...S NMSET=$P($G(@P1SETA@(NS)),"\") ...S @TMPORD@(I)="1~"_SET_"~"_NMSET_"~" ...S MSET(NS)="" ..S I=I+1 ..S N=$P($G(MVRM(NS,NP)),";") Q:'N ..S QNDEF=$P($G(MVRM(NS,NP)),";",2) ..S MHT=$G(@$$^W4GL("MHT")@(PAR0,N)) ..S @TMPORD@(I)="1~"_N_"~"_$$SHEM^W4P(N)_"~"_$J(MHT,2,2) ..S @TMPORD@(I)=@TMPORD@(I)_"~"_(QN0_"*"_QNDEF) ; D KILL^%W1PRM("STPAR0") Q (LAST+1) W4AIMAX W4AIMAX(QN) ; [ 18.07.12 17:07 ] [ 25.06.12 10:26 ] [ 21.05.12 19:32 ] N (JB,%ARG,%REM,QN) W "
",! W "" W $$^%W1DICT("REDUCESETQN") W "",! W "

",! D AINMAIN^W4HZORD(QN) ; W " ",! ; W " " W " " W " " W " " W " ",! ; I $$MXOVR(QN) D .S NSET="" F S NSET=$O(M(NSET)) Q:NSET="" D ..I $G(MX(NSET)),M(NSET)>MX(NSET) D ...W "" ... W "" ... W "" ... W "" ...W "",! ; W "
"_$$^%W1DICT("SETNAME")_""_$$^%W1DICT("SETMX")_""_$$^%W1DICT("QNREAL")_"
"_$$H2U^%L1FRM($G(M(NSET,"NM")))_""_$G(MX(NSET))_""_$G(M(NSET))_"
",! ; W "
" W "",! W "
",! Q ; ; MXOVR(QNMAIN) ; N (JB,%ARG,%REM,QNMAIN,M,MX) ; S NSET="",NMSET="" I $G(QNMAIN)<0 Q 0 K M,MX S CDMAIN=$P($$GETP^%W1PRM("STPAR0"),"~",2) S N="" F S N=$O(@$$^W4GL("P1SETA")@(N)) Q:N="" D .S A=$G(^(N)) .S MAX=$P(A,"\",2) I 'MAX S MAX=999 .S MX(N)=MAX*QNMAIN ; F I=1:1 Q:'$D(@$$^W4TMPORD@(I)) D .S A=$G(^(I)) .I $$NSET(A) S NSET=$$NSET(A),NMSET=$P(A,"~",3) Q .Q:'NSET .I $$QNR^W3HZMST(JB,I)<0 Q .I $P(A,"~")=0 S M(NSET)=$G(M(NSET))+$$ITRAST^W3HZMST(JB,I) .S M(NSET,"NM")=NMSET ; S MXOVR=0 S NSET="" F S NSET=$O(M(NSET)) Q:NSET="" D Q:MXOVR .I $G(MX(NSET)),$G(M(NSET))>MX(NSET) S MXOVR=1 ; Q MXOVR ; ; NSET(A) ; N SET S SET=$P(A,"~",2) I SET'?1"A"1N.N Q "" Q $E(SET,2,6) ; QN(A) ; N QN S QN=$P(A,"~",5) I QN["*" S QN=QN*$P(QN,"*",2) Q QN W4AIN W4AIN(STAM) ; [ 02.05.14 15:06 ] [ 10.04.14 10:19 ] [ 09.04.14 16:35 ] N STPAR0 S STPAR0=$$GETP^%W1PRM("STPAR0") I STPAR0="" D .N FIRSTST S FIRSTST=$G(@$$^W4TMPORD@(1)) .I $E(FIRSTST,1,3)="0~A" S STPAR0=$$RESTSTPAR0 .I $$ISST0(STPAR0) D ..D PUT^%W1PRM("STPAR0",STPAR0) ..D PUT^%W1PRM("STPAR00",STPAR0) ; I STPAR0="" S STPAR0=$$GETP^%W1PRM("STPAR00") D .I $$ISST0(STPAR0) D PUT^%W1PRM("STPAR0",STPAR0) ; I $$ISST0(STPAR0) Q 1 Q 0 ; ISST0(STPAR0) ; I STPAR0?1"0~"1N.E Q 1 Q 0 ; RESTSTPAR0(STAM) ; N FIRSTST,N,A S FIRSTST="" S N="" F S N=$O(@$$^W4TMPORD@(N)) Q:N="" I N S A=$G(^(N)) I $P(A,"~")=0,$P(A,"~",15)["^" S FIRSTST=A Q S STPAR0=$TR($P(FIRSTST,"~",15),"^","~") Q STPAR0 W4ASHMGR W4ASHMGR ; [ 31.07.16 15:19 ] [ 31.01.14 14:14 ] [ 22.09.13 19:48 ] GET ; S MSD=$$GET^%W1PRM("MSD") D PUT^%W3DEB("W4ASHPRM-GET","JB=JB & MSD=MSD") ; S NAME=$$H2U^%L1FRM($G(@$$^W4PL@("ESEK",1))) S MURSH=$G(@$$^W4PL@("ESEK",4)) Q ; SAVE(PARAM) ; N (JB,%ARG,%REM,PARAM) S MSD=$$GET^%W1PRM("MSD") D PUT^%W3DEB("W4ASHMGR-SAVE","PARAM=PARAM & JB=JB & MSD=MSD") F II=1:1:$L(PARAM,";") D .N COUP S COUP=$P(PARAM,";",II) .N A,B S A=$P(COUP,"="),B=$P(COUP,"=",2) .Q:$E(A)'?1A S @A=$$CNWEB^%L1FRM(B) ; S @$$^W4PL@("ESEK",1)=$$INVH^%L1FRM($G(NAME)) S @$$^W4PL@("ESEK",4)=$G(MURSH) ; Q 1 ; FIRST(VD) ; N KLIN S KLIN=$$^W4KLIN N FIRST S FIRST=$O(@KLIN@(VD,"")) I FIRST="" Q "" I $G(@KLIN@(VD,FIRST))'="IN" Q "" Q (FIRST+1) ; EXIST(VD) ; N KLIN S KLIN=$$^W4KLIN I $D(@KLIN@(VD))<10 Q 0 N FIRST S FIRST=$O(@KLIN@(VD,"")) N SEC S SEC=$O(@KLIN@(VD,FIRST)) I SEC Q 1 I $G(@KLIN@(VD,FIRST))'="IN" Q 1 Q 0 ; NOMOD(STAM) ; Q "<>DISABLE" W4ASHRAM W4ASHRAM(STAM) ; [ 25.09.18 11:42 ] [ 11.08.16 05:59 ] [ 10.08.16 17:46 ] Q $$GETP^%W1PRM("ASHRAM") ; INIT ; D ^W3CSS D PUT^%W1PRM("ASHRAM",1) D ^W4BGBODY D ^W4CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) D KILL^%W1PRM("IFRURSH") D KILL^%W1PRM("ELPOS") S @$$^W4PRM@("SHVA1")=0 I +$G(MSD)=0 S MSD=+$$GETP^%W1PRM("MSD") D KILL^W4TMPPAY D PUT^%W1PRM("HZM",-JB) K @$$^W4ORD@(-JB) D ^W4JOB Q ; DOCCSR(STAM) ; Q $G(@$$^W4GL("W3PRM")@("DOCCSR")) W4ASK W4ASK(STAM) ; [ 22.01.25 11:25 ] [ 09.06.18 19:39 ] [ 20.08.16 15:32 ] N GL D GL Q GL ; KILL ; N GL D GL K @GL Q ; NM(VP,VZ,NP) ; N GL D GL Q $P($G(@GL@(VP,VZ,NP)),";",1) ; DL(VP,VZ,NP) ; N GL D GL N GLST S GLST=$G(@GL@(VP,VZ,NP)) N DL S DL=$P(GLST,";",2) I $E(DL)="$" S @("DL="_DL) Q DL ; DFLT(VP,VZ,NP) ; I '$G(NP) Q "" N GL,RES D GL N A S A=$P($G(@GL@(VP,VZ,NP)),";",3) I $E(A,1,2)="$$" X "S RES="_A Q RES I A?.P!(A?1N.N) Q A Q @A ; OU(VP,VZ,NP) ; N GL D GL N A S A=$G(@GL@(VP,VZ,NP)) I $P(A,";",4)="O" Q 1 I $P(A,";",6)="" Q 0 I $P(A,";",6)=0 Q 1 I $P(A,";",6)?1N.N Q '$P(A,";",6) N W4ASKOU X "S W4ASKOU="_$P(A,";",6) Q 'W4ASKOU ; GLOB(VP,VZ,NP) ; N GL D GL Q $P($G(@GL@(VP,VZ,NP)),";",7) ; US(VP,VZ,NP,IND) ; N GLB S @("GLB="_$$GLOB(VP,VZ,NP)) I GLB="" Q 1 N VL S VL=$G(@GLB@(IND)) D GL N OK S OK=1 N USIND S USIND=$P($G(@GL@(VP,VZ,NP)),";",8) I USIND'?.P S OK=0 I @USIND S OK=1 I 'OK Q 0 N USVL S USVL=$P($G(@GL@(VP,VZ,NP)),";",9) I USVL'?.P S OK=0 I @USVL S OK=1 Q OK ; MENU(VP,VZ,NP) ; N GL D GL N A S A=$G(@GL@(VP,VZ,NP)) I $E($P(A,";",4))="<" Q 1 Q 0 ; MENURL(VP,VZ,NP) ; N GL D GL N A S A=$G(@GL@(VP,VZ,NP)) I $E($P(A,";",4),2,5) Q $E($P(A,";",4),2,5) Q 100 ; PROG(VP,VZ,NP) ; N GL D GL Q $P($G(@GL@(VP,VZ,NP)),";",5) ; FIRST(VP,VZ) ; N GL D GL N N S N="" F S N=$O(@GL@(VP,VZ,N)) Q:N="" S A=$G(^(N)) I '$$OU(VP,VZ,N) Q Q N ; NEXT(VP,VZ,NP) ; N GL D GL N N S N=NP F S N=$O(@GL@(VP,VZ,N)) Q:N="" S A=$G(^(N)) I '$$OU(VP,VZ,N) Q Q N ; PREV(VP,VZ,NP) ; N GL D GL N N S N=NP F S N=$O(@GL@(VP,VZ,N),-1) Q:N="" S A=$G(^(N)) I '$$OU(VP,VZ,N) Q Q N ; CMD(VP,VZ,NP) ; N GL D GL Q $P($G(@GL@(VP,VZ,NP)),";",5) ; GETID(VP,VZ,NP,NS) ; Q $$NM(VP,VZ,NP)_NS ; GL S GL=$$^W4MAIN("TMPZ") Q ; CREATE(VP,VZ,N) ; N GL,A,N1 D GL K @$$^W4MAIN("TMPZ")@(VP,VZ) D PUT^%W1PRM("NP",1) ; I $G(N)'="" D Q .S N1="" F S N1=$O(^[$$^W3MAIN]W4ASK(VP,VZ,N,N1)) Q:N1="" D ..S A=$G(^(N1)) ..S @$$^W4MAIN("TMPZ")@(VP,VZ,N1)=A ; S N="" F S N=$O(^[$$^W3MAIN]W4ASK(VP,VZ,N)) Q:N="" D .S A=$G(^(N)) .S @$$^W4MAIN("TMPZ")@(VP,VZ,N)=A ; Q ; ; WHERE(VT,VZ,NP) ; N GL D GL Q $P($G(@GL@(VT,VZ,NP)),";",3) ; DELANS(STAM) ; N PRM S PRM=$$GETP^%W1PRM("DELITM") I PRM="" Q 1 N NS S NS=$P(PRM,";",2) I 'NS Q 1 N ST S ST=$G(@$$^W4TMPORD@(NS)) I ST="" Q 1 N CD S CD=$$CDST^W3HZMST(JB,NS) I CD="" Q 1 N UR S UR=$$LVST^W3HZMST(JB,NS) I UR Q 1 N UR1 S UR1=$$LVST^W3HZMST(JB,NS+1) I 'UR1 Q 1 I $D(@$$^W4GL("P1EZI")@(CD))<10 Q 1 Q "<->" W4ASKM W4ASKM(JB) ; [ 18.12.08 08:44 ] [ I $G(@$$^W4PL@("TRDDP"))=2 Q 1 Q 0 W4ASKPRC W4ASKPRC(STAM) ; [ 20.08.10 20:12 ] [ Q +$G(@$$^W4PRM@("ASKPRC")) W4ASKTLM W4ASKTLM(PRM) ; [ 03.12.20 12:44 ] [ 05.07.18 15:53 ] [ 18.10.16 16:58 ] N (JB,%ARG,%REM,PRM) S TOP="" S ODEF=$J($$SUM(PRM)-$$ITRA(PRM),2,2) S KOT=$$^%W1DICT("COUPONCHANGE",ODEF) N NG S NG=1 I '$$GCOUPIT^W4PRM D .S MGROUP(NG)=$$^%W1DICT("MOVECHANGE2TIP") .S MGROUP(NG,"TO")="MoveChange2Tip('"_PRM_"')" .S NG=NG+1 S MGROUP(NG)=$$^%W1DICT("MOVECHANGE2ADDPRICE") S MGROUP(NG,"TO")="MoveChange2AddPrice('"_PRM_"')" S NG=NG+1 S MGROUP(NG)=$$^%W1DICT("MOVECHANGE2TLODEF") S MGROUP(NG,"TO")="MoveChange2TlOdef('"_PRM_"')" S NG=NG+1 S MGROUP(NG)=$$^%W1DICT("BACK") S MGROUP(NG,"TO")="Back()" ; D ^W4SHEET(KOT,"","","","40%") Q ; ; MOVECHANGE2TIP(PRM) ; N HZM S HZM=$$GETP^%W1PRM("HZM") I 'HZM Q "NOTORDER" S TIPAS=$$SUM(PRM)-$$ITRA(PRM) I TIPAS'>0 Q "SUMNOTENOUGH2TIP" D PAIDTLMN^W4PAYKB($$LK(PRM),$$NOMCB(PRM),HZM,$$SUM(PRM),"",$$SUM(PRM)-$$ITRA(PRM)) Q 1 ; MOVECHANGE2ADDPRICE(PRM) ; N HZM S HZM=$$GETP^%W1PRM("HZM") I 'HZM Q "NOTORDER" D PAIDTLMN^W4PAYKB($$LK(PRM),$$NOMCB(PRM),HZM,$$SUM(PRM),$$ITRA(PRM)-$$SUM(PRM),"") Q 1 ; MOVECHANGE2TLODEF(PRM) ; N (JB,%ARG,%REM,PRM) S HZM=$$GETP^%W1PRM("HZM") I 'HZM Q "NOTORDER" ; I $$GCOUPIT^W4PRM Q $$MOVETLMIT2TLODEF(HZM,PRM) ; ; N LK,NOMCB S LK=$$LK(PRM) S NOMCB=$$NOMCB(PRM) ; D PAIDTLMN^W4PAYKB(LK,NOMCB,HZM,$$ITRA(PRM),"","") ; N LASTTLMN S LASTTLMN=$O(@$$GLCB^W4CBGET(LK,NOMCB)@("TLMN",9999),-1)+1 S MAS(1)="(scer) dpzn yelz" S MAS(3)=+NOMCB_"-"_LASTTLMN S MAS(5)=$ZD($H,"DD.MM.YY 24:60") S MAS(10)=$G(@$$GLCB^W4CBGET(LK,NOMCB)@("FOR")) S SUM=$J($$SUM(PRM)-$$ITRA(PRM),2,2) S MAS(15)=SUM S MAS("EHAD")=1 S MAS("HD")=1 S MAS("CUT")=1 S LAB="TLMTN" D ^W4CB S @$$GLCB^W4CBGET(LK,NOMCB)@("TLMN",LASTTLMN)=SUM_"\"_$$^W4DZ_"\"_$H Q 1 ; ; MOVETLMIT2TLODEF(HZM,PRM) ; N MAS D PUT^%W3DEB("MOVETLMIT2TLODEF","HZM=HZM&PRM=PRM") N LK S LK=$$LK(PRM) N NOMTL S NOMTL=$$NOMCB(PRM) I 'NOMTL Q 0 N HZMKR S HZMKR=$$HZM^W4TLMTN(NOMTL) ; D PAIDTLMIT^W4PAYKB(LK,NOMTL,HZM,$$ITRA(PRM),$$HZM^W4TLMTN(NOMTL)) ; N LASTTLMN S LASTTLMN=$$LAST^W4TLMTN+1 D SETTLMTN1^W4SNDCLS(HZM,LASTTLMN,$$SUM(PRM)-$$ITRA(PRM),$$PAYERNAME^W4TLMTN(NOMTL),$$PAYERTEL^W4TLMTN(NOMTL),$$RCP^W4TLMTN(NOMTL),NOMTL) ; S MAS(1)="(scer) dpzn yelz" S MAS(3)=LASTTLMN S MAS(5)=$ZD($H,"DD.MM.YY 24:60") S MAS(10)=$$RCP^W4TLMTN(NOMTL) S SUM=$J($$SUM(PRM)-$$ITRA(PRM),2,2) S MAS(15)=SUM S MAS("EHAD")=1 S MAS("HD")=1 S MAS("CUT")=1 S LAB="TLMTN" D ^W4CB ; Q 1 ; ITRA(PRM) ; Q $P(PRM,"*",2) ; SUM(PRM) ; Q $P(PRM,"*",3) ; LK(PRM) ; N LK S LK=$TR($P(PRM,"*",4),"-","") I LK="" S LK=0 Q LK ; NOMCB(PRM) ; Q $P(PRM,"*",5) W4ASR W4ASR ; TASHLUM BASHRAI [ 16.09.23 08:06 ] [ 15.09.23 06:00 ] [ 31.05.23 12:00 ] N (JB,%ARG,%REM,HZM,W4T1,SGIRATJOM,CUSN,LKAH,LKHN,LKHNH,BLIPR,ASR,TIP,TIPAS,HRA,HZMLK,P1TNOPR,TLUSH,KMTL,CIBVT,CIBCARD,CIBCID,CIBUID,CIBUIC,CIBORD,TSFMH,P3T,PRBIT,TBCARD,TBRECID) D ^W4INP Q:'$D(ASR) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D ^W4IN S DAT=$$^%L1DC(P1DZ,2) I $$HZM^W4MSL(HZM) S DAT=$$^%L1DC($$TRH^W4HZMST(HZM),2) S KUP=901 ; S %L1SCREF("N")=1,%SCRN=HZSCR,%L1SCREF("S")=$G(@$$^W4ORD@(HZM)) D ^W4SCREF ; I '$D(TIP) S TIP=$$TIP^W4HZMST(HZM) S TIP=TIP+$G(TIPAS) ; S SHULA=$$SAS^W4HZMST(HZM) I $$^W4CLOSE(HZM),'$G(SHULA),'$G(ASR) Q ; I '$D(PRBIT),$$CLOSECRED^W4HZMST(HZM) G PRINT ; I '$D(PRBIT),$$FULLPAYM,ASR'<0 G PRINT ; Q:ASR>-.01&(ASR<.01)&('LKHNH) ; ; ---- WRITE TO CLIENT REPORT S:$L(CUSN) LKHN=CUSN Q:LKHN="" ; ;;I $D(W4T1) S ^AA("W4ASR-W4T1")="" I $$HZM^W4MSL(HZM),$$TMMSL^W4PRM,$$NOTM^W4PRM,'$$^W4CLOSE(HZM),$D(W4T1) S P1TNOPR="" ; I '$$^W4REMOTE D .N HZM1 S HZM1=+$$HZM^W4ORD(HZM) .S @$$^W4GL("P1HL1")@(LKHN,HZM1)=$$^%L1DC(DAT,4) .S @$$^W4GL("P1HL2")@(LKHN,HZM1)=$$^%L1DC(DAT,4) .S @$$^W4GL("P1HL2I")@(HZM1,LKHN)="" .S @$$^W4GL("P1HL1I")@(HZM1,LKHN)="" ; I $$^W4REMOTE D .N TRH,SHAA,HZMLAK .S TRH=$$TRH^W4HZMST(HZM) .S SHAA=$$SHAA^W4HZMST(HZM) .I TRH="" D ..S TRH=$P($$ZMANK^W4HZMST(HZM)," ") ..S SHAA=$P($$ZMANK^W4HZMST(HZM)," ",2) .S HZMLAK=$$HZMLAK^W4HZMST(HZM) .N IND S IND=$O(@$$^W4ORD@(HZM,"CB","ASR",99999),-1)+1 .N HZM1 S HZM1=$$^%L1MRK_"-"_+$$HZM^W4ORD(HZM)_"-"_IND .I $G(HZMLK) S HZMLAK=HZMLK .N ST S ST=$$^%L1DC(DAT,4)_"*"_ASR_"*"_TRH_"*"_SHAA_"*"_HZMLAK_"*"_$$NAME^W4HZMST(HZM) .S @$$^W4GL("P1HL30")@(LKHN,HZM1)=ST .S @$$^W4GL("P1HL1")@(LKHN,HZM1)=@$$^W4GL("P1HL30")@(LKHN,HZM1) .S @$$^W4GL("P1HL1I")@(HZM1,LKHN)="" .D SHD(LKHN) ; S RZN=TSHL-SHUL-SHULA-ASR I TSHL>0,RZN>0,RZN<.5 D .S ASR=ASR+RZN ; S CUSN="" D Q:CUSN="" .N (JB,%ARG,%REM,HZSCR,CUSN,DAT,HZM,LKHN,NMB,ASR) D ^W4IN .S SUM=ASR N ASR .S CODDOC="HZ",DATE=DAT,COD="0H",CUSN="" N DAT .D ..I '$G(@$$^W4GL("P1EZL")@(LKHN)) S CUSN=LKHN Q ..S CUSN=$G(@$$^W4GL("P1EZL")@(LKHN)) . .Q:CUSN="" .S NUMBER=HZM D ^W4KLINIT S ER=0 D ^W4KLUP I ER S CUSN="" Q .I CUSN'=LKHN D ..N GL S GL=$$^W4GL("LKH") ..I '$D(@GL@(LKHN)) Q ..S $P(@GL@(LKHN,2),"*",4)=$P($G(@GL@(LKHN,2)),"*",4)+SUM .Q ; D .S:HNH["%" HNH=$P(HNH,"=",2) .S HNH=HNH+LKHNH .S TSHL=TSHL-LKHNH .D PUT^W4SCREF($$^W4ORD_"(HZM)",HZSCR,1,"HNH") .D PUT^W4SCREF($$^W4ORD_"(HZM)",HZSCR,1,"TSHL") .I $$D^W3TMPORD(JB)=11 D ..D PUT^W3HZMST(JB,"HNH",HNH) ..D PUT^W3HZMST(JB,"TSHL",TSHL) . .;;I $$MYCHECK^W4PRM D ..J SYNCORD^WMCHFUNC(HZM,JB) ; ; S SHULA=$G(SHULA)+ASR N SHUL,TSHL S SHUL=$$SHUL^W4HZMST(HZM) S TSHL=$$TSHL^W4HZMST(HZM) ;;I SHULA+SHUL-TSHL>0&(TSHL>0)!(SHULA+SHUL-TSHL<0&(TSHL<0)) D .S TIP=SHULA+SHUL-TSHL ; S IND=$$NEWIND^W4HZMST(HZM,"ASR") S (LKHR,LKHR1,LKHN1)="" ; I $$^W4ISCDLK(LKHN) D .S LKHN1=$$LKH^W4L(LKHN) .S LKHR=$G(@$$^W4GL("P1EZL")@(LKHN)) .I LKHR S LKHR1=$$LKH^W4L(LKHR) ; N ASRI ; 1 2 3 4 5 6 7 8 9 12 13 14 15 16 17 18 19 20 ; S ASRI=LKHN_"*"_LKAH_"*"_LKHNH_"*"_ASR_"*"_$G(HRA)_"*"_$G(LKHR)_"*"_$G(HZMLK)_"*"_$G(TLUSH)_"*"_$G(KMTL)_"***"_LKHN1_"*"_$G(LKHR1)_"*"_$G(CIBVT)_"*"_$G(CIBCARD)_"*"_$G(CIBCID)_"*"_$G(CIBUID)_"*"_$G(CIBUIC)_"*"_$G(TSFMH) S $P(ASRI,"*",21)=$G(TBCARD) S $P(ASRI,"*",22)=$G(TBRECID) S $P(ASRI,"*",27)=$G(CIBORD) ; D SETIND^W4HZMST(HZM,"ASR",IND,ASRI) D SETPOS^W4HZMST(HZM,"ASR",IND) ; I $$GDAY^W4L(CUSN) D .S @$$^W4GL("W4ITRAYOM")@(CUSN,$$^W4DZ)=$G(@$$^W4GL("W4ITRAYOM")@(CUSN,$$^W4DZ))+ASR ; I $G(TIPAS),'$$^W4CLOSE(HZM) D .S $P(@$$^W4ORD@(HZM,"CB","ASR",IND),"*",20)=TIPAS .S TIP=$$STIP^W4HZMST(HZM) .D PUT^W4HZMST(HZM,"TIP",TIP) ; D PUT^W4SCREF($$^W4ORD_"(HZM)",HZSCR,1,"SHULA") ; I $$FULLPAYM D CUSNAME(HZM) ; Q:$G(P1TNOPR)=3 ; ; PRINT I '$$FULLPAYM Q ; S TMASR=$$TMASR^W4PRM ; 06/02/17 -- WAS TMASR=0 I TMASR!($$NOTM^W4PRM&$$HZM^W4MSL(HZM)),'$$TMMSL^W4PRM K P1TNOPR,BLIPR ; S GLBV=$$^W4ORD_"(HZM)",SM=1 ; CLOSE ; N W4ASR S W4ASR="" D ^W4T(HZM,1) ; -- LEV 06/06/18 ; I $$SHUL^W4HZMST(HZM) D .N MAKOR S MAKOR=0 .I '$$CLOSECRED^W4HZMST(HZM) S MAKOR=1 .I MAKOR D ^W4PCHB(HZM,MAKOR) ; --- PECH HMK & H-A ; I '$$SHUL^W4HZMST(HZM) D ^W4PCHB2(HZM) ; D MVDT^W4T1(HZM) ; -- 04/05/22 ; ;;I '$$^W4CLOSE(HZM),'$$ITRA^W4HZMST(HZM) D ; -- 13/02/19 --> COMMENT .D ^W4SGHB(HZM) .I '$$^W4CLOSE(HZM),$$SGDLVASR^W4PRM D SETCLOSE^W4HZMST(HZM) ; END I HZM>0 M @$$^W4GL("P1HZ0")@(HZM)=@$$^W4ORD@(HZM) Q ; ; SHD(LKHN) ; N IND S IND=$O(@$$^W4GL("P1HL3A")@(9999999),-1)+1 S %L2MODEM("GLOB")=$$^W4GL("P1HL30")_"("""_LKHN_""")" S %L2MODEM("FL")="P1HL3_"_IND_"."_$$^%L1MRK S %L2MODEM("MRKTO")=1000 S %L2MODEM("ADDR")=$G(@$$^W4GL("MRKZ")@(%L2MODEM("MRKTO"),"ADDR")) D ^%L2MODEM I '$D(%L2MODEM("ER")) D .M @$$^W4GL("P1HL3A")@(IND,LKHN)=@$$^W4GL("P1HL30")@(LKHN) .K @$$^W4GL("P1HL30")@(LKHN) .D ^%S2GLSV($$^W4GL("P1HL30")_"("""_LKHN_""")",$$^W4FGIB,"K") Q ; FULLPAYM(STAM) ; I TSHL+TIP-SHUL-SHULA<.01&(TSHL>0)!(TSHL+TIP-SHUL-SHULA>-.01&(TSHL<0)) Q 1 Q 0 ; CUSNAME(HZM) I '$D(@$$^W4ORD@(HZM,"TOCUSNAME")),$O(@$$^W4ORD@(HZM,"CB","ASR",1))="" D .N LKHNM,NMB S LKHNM="" .S NMB=$$NMB^W4HZMST(HZM) .D ..I $$^W4MSL(NMB) S LKHNM=$$NAME^W4HZMST(HZM) Q ..N LKHN S LKHN=$P($G(@$$^W4ORD@(HZM,"CB","ASR",1)),"*") Q:'LKHN ..S LKHNM=$$LKH^W4L(LKHN) .I LKHNM'="" S @$$^W4ORD@(HZM,"TOCUSNAME")=LKHNM Q W4AUTHCD W4AUTHCD(COD) ; [ 15.05.19 16:00 ] [ I +COD=3!(COD=902) Q 1 Q 0 W4AUTOUT W4AUTOUT ; [ 25.02.25 06:09 ] [ 24.02.25 14:50 ] [ 23.02.25 01:44 ] S DT=+$H N (JB,%ARG,%REM,OV,DT) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S MAXD=$$MAXD S MAXW=$$MAXW ; S DT=$$^%L1DC(DT,3) S FILE=$$FILE ; S OV="" F S OV=$O(@FILE@(OV)) Q:OV="" D .I OV'?5N Q .I $G(@FILE@(OV,"CIO"))'="I" Q .S COMPUT="" .S DAT=$ZD($$^W4DZ,"YYMMDD") .N BGSHB S BGSHB=$$GET2^W4LEVKVZ(OV,"SHB1") .N ND S ND=$$^%L1DC(DT,8) .I '$$MNL(OV),$$PRM("RESTSTDY"),ND=6,BGSHB,$$T^%L1TIME($P($H,",",2))'(MAXD*60) D OUT(OV,"MAXHRDAY") Q .S MINWEEK=$$MINWEEK(OV,+$H) .I '$$MNL(OV),$$PRM("MAXHRWK"),MINWEEK+(DIF0+DIF)>(MAXW*60) D OUT(OV,"MAXHRWEEK") Q .S HR=$$T^%L1TIME($P($H,",",2)) .N GIL S GIL=$$GIL(OV) .I $$PRM("AGENIGHT"),GIL<$$BGR,HR>$$HR1!(HR<$$HR2),$$NOVAC D OUT(OV,"AGENIGHT") Q .I $$PRM("AGENIGHT"),GIL<$$BGR,HR'<$$HR3,HR<$$HR2,'$$NOVAC D OUT(OV,"AGENIGHT") Q .I $$PRM("AGESTDY"),GIL<$$BGR,ND=6,BGSHB,$$T^%L1TIME($H)'2) Q ISMNL ; MINWEEK(OV,DT) ; N (JB,%ARG,OV,DT) S OV=$$DOP^W4NAME(OV) N HR S HR=0 S DW=$$^%L1DC(DT,8) S D1=DT-DW+1 S DAT1=$ZD(D1,"YYMMDD") S DAT2=$ZD(DT-1,"YYMMDD") S COMPUT="" ; D TV^W4LEVTYP(OV,DAT1,DAT2) Q $G(SUM)\60 ; ; FILE() ; Q $$^W4GL("FILE") ; ; NOENTER(OV) ; N (JB,%ARG,%REM,OV) S OV=$$DOP^W4NAME(OV) ; S GIL=$$GIL(OV) I GIL<16 Q "1;AGE16" ; S DT=+$H I $D(@$$GLAU@(DT,OV))#2 Q "1;"_$P(@$$GLAU@(DT,OV),"\") ; S ND=$$^%L1DC(DT,8) I $$PRM("AGESTDY"),GIL<$$BGR,ND=7,$$GET2^W4LEVKVZ(OV,"SHB2") Q "1;AGESTDY" N BGSHB S BGSHB=$$GET2^W4LEVKVZ(OV,"SHB1") I $$PRM("AGESTDY"),GIL<$$BGR,ND=6,BGSHB,$$T^%L1TIME($P($H,",",2))'$$HR1!(HR<$$HR2),$$NOVAC Q "1;AGENIGHT" I $$PRM("AGENIGHT"),GIL<$$BGR,'$$NOVAC,HR,HR<$$HR2 Q "1;AGENIGHT" ; I $$MNL(OV) Q 0 ; S MINWEEK=$$MINWEEK(OV,DT) ; I '$$MNL(OV),$$PRM("MAXHRWK"),MINWEEK>($$MAXW*60) Q "1;MAXHRWEEK" ; S FILE=$$FILE ; I ND>5 D ;;I 'OK Q "1;REST36" .N D,D1,DT1,DT2,DIF,OK1,TIM,VL .S OK=0,OK1=0 .S D1=DT-ND+1 .S DT1=D1_",0" . .F D=D1:1:DT S N=$ZD(D,"YYMMDD") D:$D(@FILE@(OV,N)) Q:OK ; -- WAS DT-1 ..S OK1=1 ..S TIM="" F S TIM=$O(@FILE@(OV,N,TIM)) Q:TIM="" D:TIM Q:OK ...S VL=$G(@FILE@(OV,N,TIM)) I VL="O" S DT1=D_","_TIM Q ...I VL="I" D .... S DT2=D_","_TIM .... S DIF=$$DIF^%L1TIME(DT2,DT1) .... I DIF'<($$HRREST*60) S OK=1 .I 'OK1 S OK=1 ; N SS S SS=0 I $$^%L1DC(DT,8)=7 S SS=$$COLSHB(OV,DT) ; --> SS ; I '$$MNL(OV),$$PRM("RESTSTDY"),SS'<($$PRM("RESTSTDY")+1) Q "1;RESTSTDY" Q 0 ; ; COLSHB(OV,DT) ; N SS,MS S SS=0 N SHAASHB1 S SHAASHB1=$$GET2^W4LEVKVZ(OV,"SHB1") N SHAASHB3 S SHAASHB3=$$GET2^W4LEVKVZ(OV,"SHB3") I 'SHAASHB1 Q 0 ; F DDD=DT-28:7:DT-7 D .N DAT S DAT=$ZD(DDD,"YYMMDD") Q:'$D(@FILE@(OV,DAT)) .K MS(OV,DAT) .N N1 S N1="" F S N1=$O(@FILE@(OV,DAT,N1)) Q:N1="" I N1?1N.N D ..N VL S VL=$G(^(N1)) .. ..I VL="I",'$D(MS(OV,DAT)) D ...I 'SHAASHB3 S SS=SS+1 Q ...I $$MIN($$T^%L1TIME(N1))>$$MIN(SHAASHB3) Q ...S MS(OV,DAT)="" ...S SS=SS+1 .. ..I VL="O",'$D(MS(OV,DAT)) D ...I 'SHAASHB3,'$D(MS(OV,DAT)) S SS=SS+1 Q ...I $$MIN($$T^%L1TIME(N1))>$$MIN(SHAASHB3) Q ...S MS(OV,DAT)="" ...S SS=SS+1 .. ..I '$D(MS(OV,DAT)) S SS=0 Q SS ; ; GIL(OV) ; N JOMH S JOMH=$$GET1^W4LEVPR(OV,"JOMH") I 'JOMH S GIL=$$BGR N D S D=$$^%L1DC(JOMH,3) N DAYS S DAYS=$H-D S GIL=$P(DAYS/365.25,".") Q GIL ; NOVAC() ; N D,YY S D=$$^%L1DC($H,3) S YY=$ZD(D,"YY") I D'<$$^%L1DC("0107"_YY,3),D'>$$^%L1DC("3108"_YY,3) Q 0 Q 1 ; BGR() ; Q 18 ; HRREST() ; Q $G(@$$^W4PRM@("AUTOUT","HRREST"),36) ; HR1() ; Q 22 ; HR2() ; Q 6 ; HR3() ; Q 1 ; MAXD() ; Q $G(@$$^W4PRM@("AUTOUT","DAY"),10) ; MAXW() ; Q $G(@$$^W4PRM@("AUTOUT","WEEK"),42) ; GLAU() ; Q $$^W4GL("W4AUOU") ; MIN(TM) ; Q TM*60+$P(TM,":",2) ; PRM(PRM) ; I PRM="RESTSTDY" Q $S($G(@$$^W4PRM@("AUTOUT",PRM))<3:3,1:^(PRM)) I $G(@$$^W4PRM@("AUTOUT",PRM))=0 Q 0 Q 1 W4AVAR W4AVAR(HZM,N) ; [ 06.07.12 14:05 ] [ N SIBA S SIBA=$P($G(@$$^W4ORD@(HZM,"BIT",N)),"*",4) I SIBA["ogleyl xared" Q 1 Q 0 W4BACKN W4BACKN ; [ 06.06.10 13:03 ] [ 05.06.10 20:49 ] [ N (JB,%ARG,%REM) ; I $G(@$$^W4PRM@("NOGIB")) Q ; ;;S %MSG=" ... oznd `p` ... mipezp qiqa ly ieaib rvazn ",%MSG("DLY")=10 D ALL^P1PC ;;N %ZG S %ZG("^FILE")=1,%ZD="#FILE" ;;D TV^%L1GS ; D W("TABLESSAVINGINPROCESS") D SVSHP("#KLS","%GSKLS") D SVSHP("#KLZ","%GSKLZ") ; I $ZGBLDIR["/mumps.gld" D .D CP("mumps","DEFAULT") ; ML ; S ZGBLDIRO=$ZGBLDIR S ZDIRO=$ZDIR ; S PATH=$$PATHGB^W4FGIB ; ;;I $G(^PLUK)["MLY" D .S $ZGBLDIR=PATH_"/mly/mly.gld" .S $ZDIR=PATH_"/mly" .D CP(PATH_"/mly/mly","MLY") .S $ZGBLDIR=ZGBLDIRO .S $ZDIR=ZDIRO ; S @$$^W4GL("P1BACKUP")@(+$H)=$H D W("SAVINGFINISHED") ;;S %MSG=" zkxrn mr cearl ozip . miizqd ieaib",%MSG("DLY")=2 D ALL^P1PC Q ; CP(DB,REG) ; W "

",! D W("DBCOPY;"_DB_"") ; N DBB S DBB=$$PATHGB^W4FGIB D .I DBB="" S DBB=DB Q .I $E(DBB,$L(DBB))="/" S DBB=$E(DBB,1,$L(DBB)-1) .S DBB=DBB_"/"_$S(DB["/":$P(DB,"/",$L(DB,"/")),1:DB) ; ZSY "rm -f %l1cp."_$G(JB) ; N DIST S DIST=$ZTRNLNM("gtm_dist") ; -- SYSTEM DIRECTORY N TXT S TXT=DIST_"/mupip INTEG -fu -reg "_REG_" 2> %l1cp."_$G(JB) ; ZSY "export gtmgbldir="_$zgbldir_";"_TXT ; I $ZSY D Q .W "

",! .;;W "

DB_" - DATABASE ERRORS FOUND - BACKUP CANCELLED !!!

",! .D W("BACKUPCANCELLED","red") ; I $$^%L1ZOS(10,DBB_"b.dat")'<0 D .ZSY "rm "_DBB_"bo.dat" .ZSY "mv "_DBB_"b.dat "_DBB_"bo.dat" ; I $$^%L1ZOS(10,DBB_"b1.dat")'<0 D .ZSY "rm "_DBB_"bo1.dat" .ZSY "mv "_DBB_"b1.dat "_DBB_"bo1.dat" ; S TXT=DIST_"/mupip BACKUP "_REG_" "_DBB_"b.dat" ZSY "export gtmgbldir="_$zgbldir_";"_TXT Q ; SVSHP(%ZD,CD) ; N %GN K %ZG N N S N="" F S N=$O(@$$^W4SHP@(CD,N)) Q:N="" D .S %GN=$G(^(N)) Q:%GN="" .S:$E(%GN)="^" %GN=$E(%GN,2,20) .S %GN=$$^W4GL(%GN) .S %ZG(%GN)="" ; D TV^%W1GS Q ; W(TXT,COLOR) ; W "",! Q W4BACKUP W4BACKUP(JB) ; [ 26.03.24 12:05 ] [ 03.01.24 06:22 ] [ 02.01.24 12:45 ] ;;!!!!!!!!!!!! --------- OLD VERSION - NOT IN USE ----------- !!!!!!!!!!!! N (JB,%ARG,%REM) ; I $G(@$$^W4PRM@("NOGIB")) Q ; ;;S %MSG=" ... oznd `p` ... mipezp qiqa ly ieaib rvazn ",%MSG("DLY")=10 D ALL^P1PC ;;N %ZG S %ZG("^FILE")=1,%ZD="#FILE" ;;D TV^%L1GS ; D TMP K @TMP S SH=0,SHSY=0 K ^ZSY ; D W("TABLESSAVINGINPROCESS") S PATH=$$PATHGB^W4FGIB ; ZSY "rm "_PATH_"KLS"_$ZD($H-20,"YYMMDD") ZSY "mv "_PATH_"\#KLS "_PATH_"KLS"_$ZD($H-1,"YYMMDD") ZSY "rm "_PATH_"KLZ"_$ZD($H-20,"YYMMDD") ZSY "mv "_PATH_"\#KLZ "_PATH_"KLZ"_$ZD($H-1,"YYMMDD") ; D SVSHP(PATH_"#KLS","%GSKLS") D SVSHP(PATH_"#KLZ","%GSKLZ") ; I $ZGBLDIR["/mumps.gld" D .D CP("mumps","DEFAULT") ; ML ; S ZGBLDIRO=$ZGBLDIR S ZDIRO=$ZDIR ; S PATH=$$PATHGB^W4FGIB ; ;;I $G(^PLUK)["MLY" D .S $ZGBLDIR=PATH_"/mly/mly.gld" .S $ZDIR=PATH_"/mly" .D CP(PATH_"/mly/mly","MLY") .S $ZGBLDIR=ZGBLDIRO .S $ZDIR=ZDIRO ; S @$$^W4GL("P1BACKUP")@(+$H)=$H D W("SAVINGFINISHED") D PUT^%W1PRM("ENDBACKUP",1) ; ZSY "zip /home/gtmuser/\#GIB "_PATH_"\#KLS "_PATH_"\#KLZ" Q ; CP(DB,REG) ; D SPACE(2) D W("DBCOPY;"_DB_"") ; N PATH2GIB S PATH2GIB=$$PATHGB^W4FGIB S DBB=$ZDIR ;D .I DBB="" S DBB=DB Q .I $E(DBB,$L(DBB))="/" S DBB=$E(DBB,1,$L(DBB)-1) .S DBB=DBB_"/"_$S(DB["/":$P(DB,"/",$L(DB,"/")),1:DB) ; D ZSY("rm -f %l1cp."_$G(JB)) ; N DIST S DIST="/opt/gtm53004A/" ;$ZDIR ; $ZTRNLNM("gtm_dist")_"/" ; -- SYSTEM DIRECTORY N TXT S TXT=DIST_"mupip INTEG -fu -reg "_REG_" 2> %l1cp."_$G(JB) ; D ZSY("export gtmgbldir="_$zgbldir_";"_TXT) ; I $ZSY D Q .D SPACE(2) .;;W "

DB_" - DATABASE ERRORS FOUND - BACKUP CANCELLED !!!

",! .D W("BACKUPCANCELLED","red") ; I $$^%L1ZOS(10,PATH2GIB_DB_"b.dat")'<0 D .D ZSY("rm "_PATH2GIB_DB_"bo.dat") .D ZSY("mv "_PATH2GIB_DB_"b.dat "_PATH2GIB_DB_"bo.dat") ; I $$^%L1ZOS(10,PATH2GIB_DB_"b1.dat")'<0 D .D ZSY("rm "_PATH2GIB_DB_"bo1.dat") .D ZSY("mv "_PATH2GIB_DB_"b1.dat "_PATH2GIB_DB_"bo1.dat") ; S TXT=DIST_"mupip BACKUP "_REG_" "_PATH2GIB_DB_"b.dat" D ZSY("export gtmgbldir="_$zgbldir_";"_TXT) Q ; SVSHP(%ZD,CD) ; N %GN K %ZG N N S N="" F S N=$O(@$$^W4SHP@(CD,N)) Q:N="" D .S %GN=$G(^(N)) Q:%GN="" .S:$E(%GN)="^" %GN=$E(%GN,2,20) .S %GN=$$^W4GL(%GN) .S %ZG(%GN)="" ; D TV^%W1GS Q ; W(TXT,COLOR) ; N A S A="
" S A=A_"" I TXT[";" S PRM=$P(TXT,";",2,20) S A=A_$$^%W1DICT($P(TXT,";"),PRM) S A=A_"" S A=A_"
" D TMP S SH=SH+1,@TMP@(SH)=A Q ; TMP ; S TMP=$$^W4MAIN("TMP") Q SPACE(COUNT) ; D TMP N I F I=1:1:COUNT S SH=SH+1,@TMP@(SH)="
" Q ZSY(CMD) ; ZSY CMD D W(""_CMD_" $ZSY="_$ZSY_"","black") S SHSY=SHSY+1 S ^ZSY(SHSY)=CMD_" $ZSY="_$ZSY ;W CMD,! ;H 1 Q W4BC W4BC(CD,PRINT) ; [ 01.12.24 21:27 ] [ D ^%L1TS I '$G(PRINT),$G(@$$^W4PRM@("BCPRINT")) S PRINT=^("BCPRINT") ; ;;D CLSNBC^W4MDBPC(PRINT) D OPSNBC^W4MDBPC(PRINT) S TXT=$$SHEM^W4P(CD) S TXT=$$HBR^%L1FRM(TXT,24) S TXT=$$SPA^%L1FRM(TXT) S TXT=$TR(TXT,TS0,TS1) S TXT=$J("",(30-$L(TXT)\2))_TXT ; S CD=$TR($J(CD,12)," ",0) ; S ST=$C(27,51,30) S ST=ST_$C(27,36,120,0) S ST=ST_$C(29,72,3,29,102,0,29,119,3,29,104,180) ; S ST=ST_$C(29,107,2)_CD_$C(0,10) S ST=ST_$C(10,10,10,10,10) S ST=ST_$C(27,33,57)_TXT_$C(10) D SETPC^W4MDBPC(PRINT,ST) D CLSNBC^W4MDBPC(PRINT) Q W4BCK W4BCK ; [ 24.04.24 12:31 ] [ 06.12.20 17:16 ] [ 10.08.20 21:35 ] N SZ S SZ="" I $D(W4BCK("SZ")) S SZ=W4BCK("SZ") N PDN S PDN="" I $D(W4BCK("PDN")) S PDN=W4BCK("PDN") N NM S NM="BACK" I $D(W4BCK("NM")) S NM=W4BCK("NM") D ^W4BTN(NM,"Back()","red",,SZ,PDN) K W4BCK Q ; BUT ;;D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red") D ROUNDBUT^%W1JS("backid",$$^%W1DICT("BACK"),"Back()","color:red",",,,60") Q W4BCKUP W4BCKUP(JB) ; [ 27.03.24 06:58 ] [ 26.03.24 12:01 ] [ 22.02.23 18:59 ] N (JB,%ARG,%REM) ; I $G(@$$^W4PRM@("NOGIB")) Q N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; D TMP K @TMP S SH=0,SHSY=0 K ^ZSY ; S PATH=$$PATHGB^W4FGIB ; ZSY "rm "_PATH_"KLS"_$ZD($H-12,"YYMMDD") ZSY "mv "_PATH_"\#KLS "_PATH_"KLS"_$ZD($H-1,"YYMMDD") ZSY "rm "_PATH_"KLZ"_$ZD($H-12,"YYMMDD") ZSY "mv "_PATH_"\#KLZ "_PATH_"KLZ"_$ZD($H-1,"YYMMDD") ; D W("TABLESSAVINGINPROCESS") ; D SVSHP(PATH_"#KLS","%GSKLS") D SVSHP(PATH_"#KLZ","%GSKLZ") ; S BACKDB="BACKDB" S BACKUTL="sudo -u gtmuser /pos/sbin/backdb.sh" ; O BACKDB:(COMMAND=BACKUTL)::"PIPE" U BACKDB F R ST Q:$ZEOF D W^%W1GS(ST,"font-weight:bold") C BACKDB ; ZSY "zip /home/gtmuser/\#GIB "_PATH_"\#KLS "_PATH_"\#KLZ" ; S @$$^W4GL("P1BACKUP")@(+$H)=$H D W("SAVINGFINISHED") D PUT^%W1PRM("ENDBACKUP",1) Q ; ; SVSHP(%ZD,CD) ; N %GN K %ZG N N S N="" F S N=$O(@$$^W4SHP@(CD,N)) Q:N="" D .S %GN=$G(^(N)) Q:%GN="" .S:$E(%GN)="^" %GN=$E(%GN,2,20) .S %GN=$$SPA^%L1FRM(%GN) Q:%GN="" .S %GN=$$^W4GL(%GN) .S %ZG(%GN)="" ; D TV^%W1GS Q ; ; W(TXT,COLOR,DIR) ; I '$D(DIR) S DIR=$$^%W1DIR N A S A="
" S A=A_"" I $E(TXT,1,2)="<>" S A=A_$E(TXT,3,$L(TXT)) E D .I TXT[";" S PRM=$P(TXT,";",2,20) .S A=A_$$^%W1DICT($P(TXT,";"),PRM) S A=A_"" S A=A_"
" D TMP S SH=SH+1,@TMP@(SH)=A Q ; TMP ; S TMP=$$^W4MAIN("TMP") Q SPACE(COUNT) ; D TMP N I F I=1:1:COUNT S SH=SH+1,@TMP@(SH)="
" Q ; ; ZSY(CMD) ; ZSY CMD D W(""_CMD_" $ZSY="_$ZSY_"","black") S SHSY=SHSY+1 S ^ZSY(SHSY)=CMD_" $ZSY="_$ZSY ;W CMD,! ;H 1 Q W4BCODE W4BCODE(PRM) ; [ 02.12.24 08:30 ] [ N (JB,%ARG,PRM) S CD=$P(PRM,";") S COL=$P(PRM,";",2) F I=1:1:COL D ^W4BC(CD) Q 1 W4BDAI W4BDAI(CD,COL,NN) ; [ 06.01.22 15:29 ] [ 01.09.14 17:14 ] [ 30.08.14 08:35 ] ; -- CD - ITEM CODE TO BE MOVED TO LUNCH ; COL - ITEM QN ; NN - ORDER'S LINE NUMBER TO BE TESTED FOR LUNCH ;--------------------------------------------------------- N MNS,CDNS,CDSH,MAX,KF,MAX,N,A,NS,GLSET,N S GLSET=$$^W4GL("P1SETA") I '$G(CD) Q "NOCD" S CDNN=$$CDST^W3HZMST(JB,NN) I 'CDNN Q "NOCDNN" S NSCD=$$NS(CDNN,CD) I 'NSCD Q "NONSCD" ; NSCD - SET NUMBER ; S MAX=$$QNMAXN^W3SET(NSCD) I 'MAX S MAX=99 ; S KF=$$QNST^W3HZMST(JB,NN) S MAX=MAX*KF ; ; ------- CHECK IF POSSIBLE ADD ITEM TO LUNCH ; S N=NN F S N=$O(@$$^W4TMPORD@(N)) Q:N="" I N,$$LVST^W3HZMST(JB,N)=1 D .S CDN=$$CDST^W3HZMST(JB,N) Q:'CDN .S NS=$$NS(CDNN,CDN) Q:'NS .S MNS(NS)=$G(MNS(NS))+$$QNST^W3HZMST(JB,N) ; I $G(MNS(NSCD))+COL>MAX Q "MAX" Q NN ; ; NS(MAIN,CD) ; N NS,OK S OK="" N GLEZ I '$$^W4EZAT(MAIN) Q 0 S GLEZ=$S($$DD^W4EZA(MAIN):$$^W4GL("P1EZA"),1:$$^W4GL("P1EZT")) ; N N S N="" F S N=$O(@GLEZ@(MAIN,N)) Q:N="" D Q:OK .S NS=$E(N,2,10) .I $D(@$$^W4GL("P1SETA")@(NS,CD)) S OK=NS ; Q OK W4BDAIA W4BDAIA(CD,COL) ; [ 29.06.22 21:18 ] [ 06.01.22 15:16 ] [ 16.11.16 18:49 ] ; -- CD - ITEM CODE TO BE MOVED TO LUNCH ; COL - ITEM QN ;--------------------------------------------------------- N (JB,%ARG,%REM,CD,COL) S GLSET=$$^W4GL("P1SETA") I '$G(CD) Q "NOCD" S STPAR=$$GETP^%W1PRM("STPAR") ; S CDNN=$$CD^W3HZMST(STPAR) I 'CDNN Q "NOCDNN" S NSCD=$$NS(CDNN,CD) I 'NSCD Q "NONSCD" ; NSCD - SET NUMBER ; S MAX=$$QNMAXN^W3SET(NSCD) I 'MAX S MAX=99 ; S KF=$$QN^W3HZMST(STPAR) I 'KF S KF=$$GETP^%W1PRM("QNAT") S MAX=MAX*KF ; ; ------- CHECK IF POSSIBLE ADD ITEM TO LUNCH ; S N="" F S N=$O(@$$^W4TMPORD@(N)) Q:N="" I $E(N)?1N D .I $$LVST^W3HZMST(JB,N) Q .S CDN=$$CDST^W3HZMST(JB,N) Q:'CDN .S NS=$$NS(CDNN,CDN) Q:'NS .S MNS(NS)=$G(MNS(NS))+$$QNST^W3HZMST(JB,N) ; I $G(MNS(NSCD))+COL>MAX Q "MAX"_(MAX-$G(MNS(NSCD))) Q 1 ; ; NS(MAIN,CD) ; Q $$NS^W4BDAI(MAIN,CD) W4BDCAJ W4BDCAJ(HZM) ; [ 17.12.18 15:40 ] [ N (JB,%ARG,HZM) S N="V",N1="",OK=0 F S N1=$O(@$$^W4ORD@(HZM,"CB",N,N1)) Q:N1="" D Q:OK .I '$$GET^W4GTVCH(HZM,N1,"V","NCA") S OK=1 I OK,$$SHUL^W4HZMST(HZM) Q 0 Q 1 W4BDKCB W4BDKCB ; [ 18.05.18 09:15 ] [ 17.05.18 21:37 ] [ N (JB,%ARG,%REM) S KLCB=$$^W4GL("KLIN")_"(""CB"")" S BG=0 S DTS=$$^%L1DC("310118",3) S NOM="" F S NOM=$O(^TRANL(NOM)) Q:NOM="" D Q:BG .S N="" F S N=$O(^TRANL(NOM,901,N)) Q:N="" D Q:BG ..S A=$G(^(N)) ..I $P(A,"~",3)'(DTS+3)) Q ..I +$E(A,4,6)=+NP,+$E(A,13,19)=(SUM*100),A[CARD S OK=1 Q OK ; SEND ; S N1="" F S N1=$O(^NOSND(N1)) Q:N1="" D .S N2="" F S N2=$O(^NOSND(N1,N2)) Q:N2="" D ..W "CB="_N1_" N2="_N2_" "_^(N2) ..S STRING=$G(^KLIN("CB",N1)) Q:STRING="" ..S S21=$G(^KLF(STRING,"CBV",N1,N2)) Q:S21="" ..S STRIN=$$^W4S212IN(S21) ..S %ARG("AUTHNO")=1 ..S A=$$INOUT^W4PAYCA(STRIN) ..S ER=$P(A,"~"),STA=$P(A,"~",2),S21="" ..S SOUT=$P(A,"~",4),TRAN=$P(A,"~",5) ..W " -- STA="_STA,! ..S $P(^NOSND(N1,N2),"^",3)=STA Q:STA ..S ST=$$^W4TRAN(SOUT,TRAN) Q W4BDKDBL W4BDKDBL ; [ 20.10.16 10:52 ] [ 31.01.13 18:21 ] [ 18.01.13 13:12 ] BDKDBLHZ(DAT1,DAT2) ; N DT,DT1,DT2 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) K ^BDKDBLHZ1 F DT=DT1:1:DT2 D .S HZ="" F S HZ=$O(^P1H(DT,HZ)) Q:HZ="" D ..K ^BDKDBLHZ ..I $D(^P1HZ(HZ,"CB","V")) D ...S N="" F S N=$O(^P1HZ(HZ,"CBOLD","V",N)) Q:N="" I N D ....S ST=$G(^(N)) ....S IN=$G(^P1HZ(HZ,"CBOLD","V",N,"STRIN")) Q:IN="" ....S IN1=$E(IN,1,65) ....S OU=$G(^P1HZ(HZ,"CBOLD","V",N,"STROU")) ....I $E(OU,1,3)="000" D .....I $D(^BDKDBLHZ(IN1)) D Q ......I N>1 S ^BDKDBLHZ1(IN)=HZ_"\"_N .....S ^BDKDBLHZ(IN1)=HZ_"\"_N Q ; BDKDBLTR ; S NT1=256 S NT2=302 K ^BDKDBL1 F NT=NT1:1:NT2 D BDKDBL(NT) Q ; BDKDBL(NT) ; K ^BDKDBL S N="" F S N=$O(^TRANL(NT,901,N)) Q:N="" D .S A=$E($G(^(N)),7,77) Q:A="" .I $D(^BDKDBL(A)) W "NT="_NT_" N="_N,! S ^BDKDBL1(NT,N)="" Q .S ^BDKDBL(A)="" Q ; ZICGR ; N IN S IN="" F S IN=$O(^BDKDBLHZ1(IN)) Q:IN="" D .S A=$G(^(IN)) .W $$ZIC(IN)_" "_A,! K ^BDKDBLHZ1 Q ; ZIC(STRIN) ; N STRINBIT,S21 S STRINBIT=$$STRINBIT^W4PAYCA(STRIN) S A=$$INOUT^W4PAYCA(STRINBIT) ; S ER=$P(A,"~"),STA=$P(A,"~",2),S21="" S SOUT=$P(A,"~",4),TRAN=$P(A,"~",5) ; I STA'="000" Q ER_";"_STA_";"_TRAN ; S S21="" S TRAN("IN")=STRINBIT ; S S21=$$^W4TRAN(SOUT,TRAN) Q "OK" ; BIT(NT,N) ; K ^TRANL(NT,901,N) K ^W4TRANL(NT,901,N) Q ; DELGR ; N IN S IN="" F S IN=$O(^BDKDBLHZ1(IN)) Q:IN="" D .S A=$G(^(IN)) .S HZ=$P(A,"\"),N=$P(A,"\",2) .I 'HZ!'N Q .D DEL(HZ,N) .W HZ," ",N,! H 1 Q ; ; DEL(HZ,N) ; Q:N<2 N ST,SUM,TIP S ST=$G(^P1HZ(HZ,"CB","V",N)) Q:ST="" ; S SUM=$P(ST,"*",7) S SHUL=$P(^P1HZ(HZ),"\",12) S TSHL=$P(^P1HZ(HZ),"\",11) S TIP=$P(^P1HZ(HZ,"CB"),"\",10) I TIP,TIP'0 D PRTNO(PAR) D RESTKOT Q N SUG S SUG=$$SUG^W4P(PAR) I $D(@$$^W4GL("P1PARPOS")@(PAR)),MYDVN,"\"_@$$^W4GL("P1PARPOS")@(PAR)_"\"'[("\"_MYDVN_"\") S %MSG=" zxg` dcnrl crein "_PAR_" hixt " G EBDKP I $$NOMSL^W4THUM(PAR),$$^W4MSL($G(NMB)) S %MSG=" dcrqnl crein "_PAR_" hixt " G EBDKP I $$NOMSD^W4THUM(PAR),'$$^W4MSL($G(NMB)) S %MSG=" migelynl crein "_PAR_" hixt " G EBDKP I $D(@$$GLTHUM@^W4THUM@(PAR)) G BDTAW I $D(@$$^W4GL("P1PARMSL"))>9,$G(NMB),$$^W4MSL(NMB),SUG,'$D(@$$^W4GL("P1PARMSL")@(SUG)) S %MSG=" dcrqnl crein "_PAR_" hixt " G EBDKP I $D(@$$^W4GL("P1PARMSL"))>9,$G(NMB),'$$^W4MSL(NMB),SUG,$D(@$$^W4GL("P1PARMSL")@(SUG)) S %MSG=" migelynl crein "_PAR_" hixt " G EBDKP BDTAW I $D(@$$^W4GL("P1PARTAW"))>9,$G(NMB),'$$^W4MSL(NMB),SUG,'$G(@$$^W4PRM@("TAWKVZ")),$$^W4DLPK(NMB),'$D(@$$^W4GL("P1PARTAW")@(SUG)),$G(@$$^W4PRM@("ONLY")) D G EBDKP .S %MSG=$S($D(@$$^W4GL("P1PARMSL")@(SUG)):" migelynl ",1:" libx ogleyl ")_" wx crein "_PAR_" hixt " I $D(@$$^W4GL("P1PARTAW"))>9,$G(NMB),'$$^W4MSL(NMB),SUG,'$G(@$$^W4PRM@("TAWKVZ")),'$$^W4DLPK(NMB),$D(@$$^W4GL("P1PARTAW")@(SUG)) S %MSG=" xidn ogleyl wx crein "_PAR_" hixt " G EBDKP I $D(@$$^W4GL("P1PARTAW"))>9,$G(NMB),'$$^W4MSL(NMB),SUG,$G(@$$^W4PRM@("TAWKVZ")),$$TAW^W4DLPK(NMB),'$D(@$$^W4GL("P1PARTAW")@(SUG)),$G(@$$^W4PRM@("ONLY")) D G EBDKP .S %MSG=$S($D(@$$^W4GL("P1PARMSL")@(SUG)):" migelynl ",1:" libx ogleyl ")_" wx crein "_PAR_" hixt " I $D(@$$^W4GL("P1PARTAW"))>9,$G(NMB),'$$^W4MSL(NMB),SUG,$G(@$$^W4PRM@("TAWKVZ")),'$$TAW^W4DLPK(NMB),$D(@$$^W4GL("P1PARTAW")@(SUG)) S %MSG=" xidn ogleyl wx crein "_PAR_" hixt " G EBDKP N OKNL S OKNL=$$BDKNL(PAR) I OKNL,KAM>0 S %MSG=" ( "_OKNL_" dlah ) dry itl lerp "_PAR_" hixt " G EBDKP K PRSIS I $D(@$$^W4GL("P1EZRI")@(PAR))!$D(@$$^W4GL("P1EZ")@(PAR))!$D(@$$^W4GL("P1EZK")@(PAR))!$D(@$$^W4GL("P1SETAI")@(PAR))!$D(@$$^W4GL("P1EZAI")@(PAR))!$D(@$$^W4GL("P1EZTI")@(PAR)),'$$MH^W4P(PAR),'$G(@$$^W4PRM@("MH0")),'$$SUGOTH^W4L(NMB) .S PRSIS="" S %MSG="SIS2" Q I $D(@$$^W4GL("P1SETPI")@(PAR)),$G(@$$^W4PRM@("NOSETP")) D G EBDKP .S %MSG=$O(@$$^W4GL("P1SETPI")@(PAR,""))_" 'qn dxiknl mihixt hq jxc wx xeknl ozip df hixt " I $D(@$$^W4GL("P1TFR"))=11,$G(@$$^W4GL("P1TFR")),'$D(@$$^W4GL("P1TFRI")@(PAR)),('$D(@$$^W4GL("P1EZ")@(PAR))&'$D(@$$^W4GL("P1EZK")@(PAR)))!$G(@$$^W4PRM@("TSFTFR")) D Q .S %MSG=". hixtza `vnp `l hixt " S %SC("ER")=1 I $G(@$$^W4GL("PL")@("NAME"))'="ZADA",$D(@$$^W4GL("P1TFRM")@(MYDVN))=11,$G(@$$^W4GL("P1TFRM")@(MYDVN)),'$D(@$$^W4GL("P1TFRIM")@(MYDVN,PAR)),'$D(@$$^W4GL("P1EZ")@(PAR)),'$D(@$$^W4GL("P1EZK")@(PAR)) D Q .S %MSG=". hixtza `vnp `l hixt " S %SC("ER")=1 I $D(@$$^W4GL("P1EZA")@(PAR)),$$MANA^W4PRM S $P(%MBG("OU"),"\",8)=1 D PRTEND(PAR,KAM) I $G(%SC("ST"))=1!$D(%SC("ER")) Q TSTP N KUP S KUP=$$PRINTIG^W3PRMDP(PAR) Q:KUP["L" I KUP'?1N.N.E,$E(KUP)'="L",$E(KUP)'="C",HZSCR'="P1HZTA",HZSCR'="P1HZT1" D ERMDP^W4HZMPC(PAR) S %SC("ST")=1.1 Q I KUP?1"0".E,PAR,PAR'=$G(@$$^W4PRM@("SHEMZ")) D Q .Q:KUP'=0 .S HRP="" I '$$NOLELO^W4PRM S HRP=" ! dqtcd `ll" .I $L($G(HZM)),$D(@$$^W4THZ@("SHEMZ")) S HRP=HRP_^("SHEMZ") I PAR,PAR=$G(@$$^W4PRM@("SHEMZ")) Q I KUP D ^W4MDP(KUP) I '$D(%MDP)!'$G(PRINT),$E(KUP)'="L",$E(KUP)'="C",HZSCR'="P1HZTA",HZSCR'="P1T1" D ERMDP^W4HZMPC(PAR) S %SC("ST")=1.1 Q I $G(HRP)="" D .I $$SHEM^W4P(PAR)["FIRE" S HRP=$$T^%L1TIME($P($H,",",2)) Q .I $$SHEM^W4P(PAR)["UP!" S HRP=$$T^%L1TIME($P($H,",",2)) Q .I $$SHEM^W4P(PAR)["CLOSED!" S HRP=$$T^%L1TIME($P($H,",",2)) Q .I $$SHEM^W4P(PAR)["DOWN!" S HRP=$$T^%L1TIME($P($H,",",2)) Q .I $$TAW^W4DLPK(NMB),'$G(@$$^W4PRM@("TAWHZ")),'$$NOLELO^W4PRM S HRP="! dqtcd `ll" Q .Q:$$D^W4EZH(PAR) .I $$TAW^W4DLPK(NMB),'$G(@$$^W4PRM@("TAWHRKOT")) S HRP=$G(@$$^W4PRM@("TAWHR"),"TAKE AWAY") Q ;"TAKE AWAY" .S HRP=$$HRA^W4P(PAR) Q I $G(@$$^W4GL("PL")@("USER"))="MAFINS",$$MANA^W4PRM D .N M1,M2,I S M1="1,2,3,4,5,6,7,8,9,10" .S M2="-I-,-II-,-III-,-IV-,-V-,-VI-,-VII-,-VIII-,-IX-,-X-" .F I=1:1:$L(M1,",") I $$DEP^W4P(PAR)=$P(M1,",",I),$G(HRP)'[$P(M2,",",I) S HRP=$G(HRP)_$P(M2,",",I) Q Q EBDKP ; D V^%L1GET S %SC("ER")=1 D RESTKOT Q BDKNL(PAR) N OKNL S OKNL=0 ;; I $D(@$$^W4GL("PARNL")) D .N N,MES,ADS,MH,ZM,TM,DAY,MEJ,ADJ,MET,ADT,A,D .S ZM=$P($H,",",2)\60 D ^W4IN .S DAY=$$^%L1DC(P1DZ,8),OKNL=0 .S N="" F S N=$O(@$$^W4GL("PARNL")@(N)) Q:N="" S A=$G(^(N)) I $D(@$$^W4GL("PARNL")@(N,PAR)) D Q:OKNL ..D PRS^%L1FRM(A,"MET\ADT\MEJ\ADJ","\") ..I DAYADJ) Q ..S MES=MET*60+$P(MET,":",2),ADS=ADT*60+$P(ADT,":",2) ..I ADSADS S OKNL=N Q Q OKNL PRTNO(PAR) ; Q PRTEND(PAR,KAM) ; S %MSG="" Q:'KAM I '$D(P1DZ) D ^W4IN I KAM<-$G(@$$^W4PRM@("KOLMAX"),99)!(KAM>$G(@$$^W4PRM@("KOLMAX"),99)),PAR'=0 S %MSG=" ! icn dlecb zenk " S %SC("ER")=1 Q N A0,A,A1,A2,%TO,%ZMSL,%OLDTO,TSHL,SOAD S A2=0 S A0="" I $L($G(HZM)),$D(@$$^W4THZ) S A0=^(HZM) S TSHL=$$TSHL^W3HZMSTP(JB),SOAD=$$SOAD^W3HZMST(JB) S:'SOAD SOAD=1 I $G(@$$^W4GL("ENDSET")@(PAR)) S A2=$$SUMP2(PAR,0) D PRTEND2 Q:$D(%SC("ST")) I $G(@$$^W4GL("PRTEND")@(P1DZ,PAR))'?1N.N,'$D(@$$^W4GL("PRTMBS")@(PAR)),'$D(@$$^W4GL("PRTMBH")@(PAR)) Q S A1=$$SUMP(PAR,1) PRTEND1 I (A1+KAM)>1&(TSHL>0)!(A1+KAM<-1&(TSHL<0)),$D(@$$^W4GL("PRTMBH")@(PAR)) S %MSG=" `nqiq yiwdl yi xey`l ! dpnfda mrt wx oinfdl xzen df hixt " S %SC("ER")=1 D RESTKOT Q I (A1+KAM)>SOAD&(SOAD>0)!(A1+KAMA D D RESTKOT S %SC("ST")=1 Q .I A-A1>0 S %MSG=" zepn wx "_(A-A1)_" wx ex`yp : "_$$SHEM^W4P(PAR)_" "_PAR Q .S %MSG=" ! zepn ex`yp `l - "_$$SHEM^W4P(PAR)_" "_PAR Q Q PRTEND2 Q:KAM<0 S A=$G(@$$^W4GL("PRTEND")@(P1DZ,"S"_^ENDSET(PAR))) Q:A'?1N.N I KAM+A2>A D S %SC("ST")=1 Q .I A-A2>0 S %MSG=" zepn wx "_(A-A2)_" wx ex`yp " Q .S %MSG=" ! zepn ex`yp `l " Q Q RESTKOT ; Q SUMP(PAR,PR) ; ;--- HISHUV LELO SHURA NOHAHIT ;-- PR=1 - KOL HA PRITIM B HAZMANA ;-- PR=0 - RAK PRITIM HADASHIM N I S SUMP=0 F I=1:1 Q:'$D(@$$^W4THZ1@(I)) S:I'=SH&($P(^(I),"\")=PAR)&(PR!(^(I)'["\@@")) SUMP=SUMP+$P(@$$^W4THZ1@(I),"\",5) D .N N S N="" F S N=$O(@$$^W4THZ1@(I,N)) Q:N="" D ..I 'PR,^(N)["\@@" Q ..I N=PAR S SUMP=SUMP+$P(^(N),"\",3) Q ..I $P(N,"-",3)=PAR S SUMP=SUMP+$P(^(N),"\",2) Q SUMP SUMP2(PAR,PR) ; ;--- HISHUV LELO SHURA NOHAHIT ;-- PR=1 - KOL HA PRITIM B HAZMANA ;-- PR=0 - RAK PRITIM HADASHIM N I,SUMP,PARI S SUMP=0 F I=1:1 Q:'$D(@$$^W4THZ1@(I)) D .S PARI=$P($G(^(I)),"\") Q:PARI="" S PARS=$G(^ENDSET(PARI)) .I I'=SH,PARS,PARS=$G(^ENDSET(PAR)),PR!(@$$^W4THZ1@(I)'["\@@") S SUMP=SUMP+$P(@$$^W4THZ1@(I),"\",5) .N N S N="" F S N=$O(@$$^W4THZ1@(I,N)) Q:N="" D ..I 'PR,^(N)["\@@" Q ..I $G(^ENDSET(N))=$G(^ENDSET(PAR)) S SUMP=SUMP+$P(@$$^W4THZ1@(I,N),"\",3) Q ..I $P(N,"-",3),$G(^ENDSET($P(N,"-",3)))=$G(^ENDSET(PAR)) S SUMP=SUMP+$P(@$$^W4THZ1@(I,N),"\",2) Q SUMP W4BDKTMP W4BDKTMP ; [ 25.07.22 06:27 ] [ 21.07.22 21:15 ] [ 01.07.22 19:56 ] N (JB,%ARG,%REM) S TMPORD=$$^W4TMPORD S TMPORD2=$$^W4MAIN("TMPORD2") K @TMPORD2 ; S FIRST=$O(@TMPORD@("")) S LAST=$O(@TMPORD@(99999),-1) ; I FIRST'=1 D SEDER Q ; S OK=1 F I=1:1:LAST D Q:'OK .I '($D(@TMPORD@(I))#2) S OK=0 ; I 'OK D SEDER Q ; ; SEDER ; S K=0 M @$$^W4MAIN("TMPBDKER")=@TMPORD ; S N="" F S N=$O(@TMPORD@(N)) Q:N="" I N?."-"1N.E D .N A S A=$G(^(N)) Q:A="" Q:$E(A,1,3)="~~~" .S K=K+1 .M @TMPORD2@(K)=@TMPORD@(N) .D ^W4SRVTO(TMPORD,N,TMPORD2,K) ; S N="" F S N=$O(@TMPORD@(N)) Q:N="" I N?1U.E D .I '$D(@TMPORD2@(N)) M @TMPORD2@(N)=@TMPORD@(N) ; S @TMPORD2=$G(@TMPORD) K @TMPORD M @TMPORD=@TMPORD2 K @TMPORD2 Q W4BDKTS W4BDKTS ; [ 02.11.21 13:15 ] [ Z1 R !,"DAT1 :",DAT1 Q:'DAT1 S ZAPR="DAT2 [ "_DAT1_" ] :" W !,ZAPR R DAT2 S:DAT2="" DAT2=DAT1 I DAT2="^" G Z1 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) F DT=DT1:1:DT2 D .S N="" F S N=$O(^P1H(DT,N)) Q:N="" D ..S TS=$$TSHL^W4HZMST(N)+$$TIP^W4HZMST(N) ..S SHUL=$$SSHUL^W4HZMST(N) ..S SHULA=$$SHULA^W4HZMST(N) ..I (SHUL+SHULA>(TS*1.1))&(TS>0)!(SHUL+SHULA<(TS*1.1)&(TS<0)) D ...W !,$ZD(DT,"DD.MM.YY")_" ORD:"_$J(N,7)_" TO PAY :"_$J(TS,7,2)_" PAIDED :"_$J(SHUL+SHULA,2,2) Q W4BGBODY W4BGBODY ; [ 17.03.22 05:28 ] [ 08.06.21 18:20 ] [ 27.09.18 14:37 ] I $$^W6 D PUT^%W1PRM("BODYURL",$$W6) Q I '$$GRAD^W4PRM D PUT^%W1PRM("BODYURL","w4bgbody.jpg") Q D PUT^%W1PRM("BODYURL","E0CFB5-FFFFFF") Q ; BG(STAM) ; I $$^W6 Q $$GRD^W3CSS($$W6) I '$$GRAD^W4PRM Q "background-image:url('w4bgbody.jpg')" Q $$GRD^W3CSS("E0CFB5-FFFFFF") ; BG5(STAM) Q $$GRD^W3CSS("DARKGREY^LIGHTGREY") BG51(STAM) Q $$GRD^W3CSS("EFEFEF^FFFFFF") W6(STAM) Q "#C0C0C0-#EFEFEF" W4BGVW W4BGVW(JB) ; [ 22.02.23 08:36 ] [ 06.06.10 18:30 ] [ N N,TMP D TMP S PREV=+$G(@TMP@("PREV")) S LAST=+$O(@TMP@(9999999),-1) S @TMP@("PREV")=LAST Q PREV_";"_LAST ; TMP ; S TMP=$$^W4MAIN("TMP") Q TXT(SH) ; N A,TMP D TMP S A=$G(@TMP@(SH)) I A="" S A=" " Q A W4BIDMSG W4BIDMSG(HZM,PELE,DEL) ; [ 15.12.24 12:26 ] [ N (JB,%ARG,HZM,PELE,DEL) I '$G(HZM) Q S PELE=$$SPA^%L1FRM(PELE) S PELE=$TR(PELE,"-","") I '$G(PELE) Q I $L(PELE)<10 Q I +$E(PELE)="0" S PELE="+972"_$E(PELE,2,255) ; D ^%L1TS S DT=$$^W4DZ S TXT=$S($G(DEL):"dlhea",1:"dxye`")_" "_$G(HZM)_" dpnfd" ; S TXT=$$H2U^%L1FRM(TXT) S HD="Quotation "_HZM_" has been "_$S($G(DEL):"canceled",1:"approved") ; S FL="whappbid"_DT_"_"_JB_"_"_$P($H,",",2)_"_"_HZM_"_"_$S($G(DEL):"0",1:"1") O FL:(NEWVERSION:WRITE) U FL W "",! W "




",! W "

",! W TXT W "

",! W "",! C FL ; D PROCFILE^W4EMAIL(FL,"",3) ; D SNDWHATSAPP^W4PCHBP(HD,FILE1,PELE) Q W4BIGTM W4BIGTM ; [ 03.10.21 09:00 ] [ 19.09.21 13:52 ] [ 26.08.21 19:22 ] N (JB,%ARG,%REM) S HZ=$O(@$$^W4MAIN("TMPBIGTM")@("")) Q:HZ="" I $G(^(HZ))<($H-1) Q Q:'HZ S %ARG("MKRYD")=1 D PC(HZ,%ARG("MKRYD")) H 1 S %ARG("MKRYD")=0 D PC(HZ,0) K @$$^W4MAIN("TMPBIGTM")@(HZ) ; W "",! H 2 Q ; ; PC(HZ,MKR) ; N W4BIGTM S W4BIGTM="" S %ARG("TM")=1 S %ARG("PRINT")=1 D ^W4PCHBP(HZ,MKR) ;;I $O(@$$^W4MAIN("TMPBIGTM")@(HZ))!MKR D I MKR D .W "

",! Q W4BIO W4BIO ; [ 21.07.24 14:28 ] [ 06.07.23 11:47 ] [ 13.06.23 16:51 ] N (JB,%ARG) ; -- WAS


W "",! W ""_$$TDC_$$^%W1DICT("PUTYOURFINGER2DEV"),"",! W ""_$$TDC W "" W "",! W "" W "",! W "",! W ""_$$TDC I $G(%ARG("LVL"))="" D .D ^W4BTN("IMREADY",$S($G(%ARG("MGRBIO")):"MgrReady()",1:"Ready()"),"GREEN","",22,10) .W $$NBSP^%L1FRM(5) D ^W4BTN("BACK","Back()","RED","",22,10) W "",! W "
",! Q ; ; TRSP ; W " ",! Q ; TDC(STAM) ; Q "" ; ; GET(STAM) ; N (JB) S A=$$CMD("verify") I A?1U.E Q A ; GET1 ; S RES=$$GETVL(A,"result") S OV=$$GETVL(A,"empID") ; I 'RES,OV Q $$DOP^W4NAME(OV) I OV="null" Q $$^%W1DICT("WORKERNOTINBIOTABLE") ; N MSG S MSG=$$GETVL(A,"message") I MSG="" S MSG="ERROR" E S MSG=""_MSG Q MSG ; ; USBIO(STAM) ; I $$USBIO^W4PRM&($G(%ARG("VZ"))="WORKERNUMBER") Q 1 Q 0 ; ADDWORK(OV,DEL) ; N (JB,OV,DEL) S OV=$$DOP^W4NAME(OV) S MYDVN=$$^W4MYDVN ;;S MYDVN=1 ; *** N BIO S BIO=$G(@$$^W4GL("W4POSBIO")@(MYDVN)) I 'BIO Q "BIONOTDEFINED4POS" S FL="BIO"_MYDVN C FL:(DELETE) S MSG="" S N=MYDVN D .S EMDA="POS "_N .S ADR=$G(@$$^W4DEV@(N)) .S CMD=$$WEBL^W3MAIN_"w4bioadd.sh "_ADR_" "_$E(OV,2,5) .I $G(DEL) S CMD=$$WEBL^W3MAIN_"w4biodel.sh "_ADR_" "_$E(OV,2,5) .D PROTCMD(CMD) .ZSY CMD_" > "_FL .I $ZSY S MSG=MSG_EMDA_" : ERROR "_$ZSY Q .; .O FL:(REWIND:READONLY) .U FL .R A .D PROTCMD(A,"A") .C FL:(DELETE) .; .S MSG=MSG_EMDA_" : "_$$GETVL(A,"message") ;;_"
" ; Q MSG ; ; CMD(CMD) ; I $G(^DBIO) G CMD1 ; *** ; N MYDVN S MYDVN=$$^W4MYDVN N BIO S BIO=$G(@$$^W4GL("W4POSBIO")@(MYDVN)) I 'BIO Q "BIONOTDEFINED4POS" N ADR S ADR=$G(@$$^W4DEV@(MYDVN)) I 'ADR Q "NOTBIOADDRESS" G CMD1 ; N FL,A S FL="BIO"_MYDVN C FL:(DELETE) S CMD1=$$WEBL^W3MAIN I $E(CMD1,$L(CMD1))'="/" S CMD1=CMD1_"/" I CMD="verify" S CMD1=CMD1_"w4biovrf.sh "_ADR_" > "_FL I CMD="list" S CMD1=CMD1_"w4biolst.sh "_ADR_" > "_FL ZSY CMD1_" > "_FL D PROTCMD(CMD1) I $ZSY Q "ERROR "_$ZSY ; O FL:(REWIND:READONLY) U FL R A D PROTCMD(A,"A") C FL:(DELETE) Q A ; ; CMD1 ; I $G(^DBIO) D Q A ; *** .S A="{ ""result"":0 , ""message"":"""" , ""empID"":"""_$$DOP^W4NAME(^DBIO)_""" }" ; *** ; N A,B,PORT,PORTN,ERCON,MSK,MSKDEV S PORT=8888 S PORTN="SCK$"_$J C PORTN ; S ERCON=$$^%L2NALAN("127.0.0.1",PORT) ;;S ^AA("W4BIO-CMD1","ERRCON")=ERCON ; I $G(ERCON) C PORTN Q "-3;CONNECTERROR;"_ERCON N CMD1 S CMD1="{""cmd"":"""_CMD_""", ""ipAddr"":"""_ADR_""" }" W CMD1,! D PROTCMD(CMD1) S A="" R *B:8 I B=-1 G CMD1C S A=$C(B) F R *B:.4 Q:B=-1 Q:B=4 S A=A_$C(B) Q:$L(A)>3000 CMD1C ; C PORTN ; D PROTCMD(A,"A") I A="" Q "-4;NOANSWER" Q A ; ; GETVL(A,ZAPR,I) ; N ZAPR1,ZAPR2,VL S VL=$$EXTR(A,ZAPR,$G(I)) Q VL ; EXTR(A,DLM,I) ; N VL F Q:A'[" : " S A=$$RPL^%L1FRM(A," : ",":") F Q:A'[" :" S A=$$RPL^%L1FRM(A," :",":") F Q:A'[": " S A=$$RPL^%L1FRM(A,": ",":") ; I '$G(I) S I=1 I $E(DLM)'="""" S DLM=""""_DLM_"""" I DLM'[":" S DLM=DLM_":" S VL=$P($P(A,DLM,I+1),"}") S VL=$P(VL,"]") S VL=$P(VL,",") S VL=$$SPA^%L1FRM(VL) I $E(VL)="""" S VL=$E(VL,2,$L(VL)) I $E(VL,$L(VL))="""" S VL=$E(VL,1,$L(VL)-1) S VL=$$SPA^%L1FRM(VL) S VL=$$FUNC^%UCASE(VL) Q VL ; DEV(STAM) ; Q "SCK"_$J ; PROTCMD(A,IND) ; N LAST I $G(IND)="" D Q .N N S N=$O(^CMD1(99999),-1)+1 .S ^CMD1(N)=A ; N N S N=$O(^CMD1(99999),-1) I 'N S N=1 S ^CMD1(N,IND)=A Q W4BIO0 W4BIO ; [ 26.03.20 14:51 ] [ 23.03.20 21:32 ] [ 22.03.20 12:27 ] N (JB,%ARG) W "


",! W "",! W ""_$$TDC_$$^%W1DICT("PUTYOURFINGER2DEV"),"",! W ""_$$TDC W "" W "",! W "" W "",! W "",! W ""_$$TDC D ^W4BTN("IMREADY","Ready()","GREEN","",22,10) W $$NBSP^%L1FRM(5) D ^W4BTN("BACK","Back()","RED","",22,10) W "",! W "
",! Q ; ; TRSP ; W " ",! Q ; TDC(STAM) ; Q "" ; GET(STAM) ; N (JB) S A=$$CMD("verify") I A["ERROR" Q A ; GET1 ; S OV="" I A["emp :" D Q OV .S OV=$$EXTR(A,"emp :") .I OV="null" S OV=$$^%W1DICT("WORKERNOTINBIOTABLE") Q .S OV=$$DOP^W4NAME(OV) ; I A["message:" D Q OV .S OV=$$EXTR("message:") Q OV ; USBIO(STAM) ; I $$BIO^W4PRM&($G(%ARG("VZ"))="WORKERNUMBER") Q 1 Q 0 ; ADDWORK(OV) ; N (JB,OV) S FL="FINGER"_$$^W4MYDVN C FL:(DELETE) S CMD="finger.sh ""-enroll "_$E(OV,2,5)_""" " ZSY CMD_" > "_FL I $ZSY Q "ERROR "_$ZSY ; O FL:(REWIND:READONLY) U FL R A C FL:(DELETE) ; I A["message:" D Q MSG .S MSG=$P($P(A,"message:",2),"}") .S MSG=$$SPA^%L1FRM(MSG) .I $E(MSG)="""" S MSG=$E(MSG,2,$L(MSG)-1) .S MSG=$$FUNC^%UCASE(MSG) ; Q "ERROR" ; ; CMD(CMD) ; N FL,A S FL="FINGER"_$$^W4MYDVN C FL:(DELETE) S CMD="finger.sh ""-"_CMD_"""" ZSY CMD_" > "_FL I $ZSY Q "ERROR "_$ZSY ; O FL:(REWIND:READONLY) U FL R A C FL:(DELETE) Q A ; ; EXTR(A,DLM) ; N OV S OV=$P($P(A,DLM,2),"}") S OV=$$SPA^%L1FRM(OV) I $E(OV)="""" S OV=$E(OV,2,$L(OV)-1) S OV=$$FUNC^%UCASE(OV) Q OV W4BIOLST W4BIOLST ; [ 27.03.20 20:18 ] [ 24.03.20 16:20 ] [ 23.03.20 21:24 ] N (JB) W "

",! W "",! D KOT ; S A=$$CMD^W4BIO("list") ; I A'["empID" D G BUT .W "",! ; F I=1:1:$L(A,"empID")-1 D .S OV=$$EXTR^W4BIO(A,"empID",I) .I OV S M(+OV)="" ; S N="" F S N=$O(M(N)) Q:N="" D .S OV=$$DOP^W4NAME(N) .W "" . W "" .W "",! ; BUT ; W "",! W "",! W "",! W "
"_OV_""_$$H2U^%L1FRM($$^W4NAME(OV))_"
 
 
" D ^W4BUTTON("prn","PRINT","Print()","FONT-SIZE:"_$$^W3FSZ(18)_";COLOR:BLUE") W $$NBSP^%L1FRM(5) D ^W4BUTTON("prn","BACK","Back()","FONT-SIZE:"_$$^W3FSZ(18)_";COLOR:RED") W "
",! Q ; KOT ; W "" W "" W "" W $$^%W1DICT("TODELWORKERPRESSONLINE") W "",! W "" W "",! W "" W ""_$$^%W1DICT("WORKERNUMBER")_"",! W ""_$$^%W1DICT("WORKERNAME")_"",! W "",! Q ; ; DEV ; N DEV S DEV=$$^W4DEV W "
",! W "",! ; N A,N S N="" F S N=$O(@DEV@(N)) Q:N="" D .W "" .S A=$G(^(N)) .W " " .W "" .W "",! W "
"_N_""_A_"
",! Q ; GETVL(A,RKV) ; Q $$GETVL^W4BIO(A,RKV) W4BIT W4BIT(SH,TMPORD) ; [ 27.12.23 09:05 ] [ I $G(TMPORD)="" S TMPORD=$$^W4TMPORD N A S A=$G(@TMPORD@("BIT",SH)) I $P(A,"*",8) Q 1 Q 0 W4BITHLK W4BITHLK(HZMBIT) ; [ 29.06.22 21:19 ] [ 30.06.21 08:02 ] [ 16.06.21 12:39 ] N (JB,%ARG,%REM,HZMBIT) S TMPD=$$^W4MAIN("TMPD") S TMPN=$$^W4MAIN("TMPN") K @TMPN S TMPORD=$$^W4TMPORD ; S RES=$$^W4GETHZ(HZMBIT) ; S HD=$G(@TMPORD) F J=4,8,9,11,12,17,19,20,21,24,26,29,33,34,37,44,45,46,54,55,60,62,67:1:99 D .S $P(HD,"~",J)="" ; S K=0,SH0=0 S N="" F S N=$O(@TMPORD@(N)) Q:N="" I $E(N)?1N D .S A=$G(^(N)) .I $P(A,"~")=0 S SH0=SH0+1 .Q:'$D(@TMPD@(N)) .S QN=-$G(^(N)) Q:'QN .S K=K+1 .S $P(A,"~",5)=QN .S $P(A,"~",7)=HZMBIT_" dpnfdn lehia" .S @TMPN@(K)=A ; K @TMPORD S @TMPORD=HD M @TMPORD=@TMPN S HZM=$$^W4NEWHZ(JB) ; S @$$^W4GL("P1MLZ")@(HZM)=$G(@$$^W4GL("P1MLZ")@(HZMBIT)) S SIBA=$$GET^W4TMPANS("DEL","CAUSEDEL") S SIBA=$$RPL^%L1FRM(SIBA,"%20"," ") S SIBA1=$P(SIBA,"::",2) S SIBA=$P(SIBA,"::") N SIBA11 S SIBA11="[ "_HZMBIT_" dpnfdn lehia ] "_SIBA1 D PUT^W4TMPANS("DEL","CAUSEDEL",SIBA_"::"_SIBA11) D SIBA^W4HZBIT ; D SETHR2HZBIT(HZMBIT,HZM) S @$$^W4ORD@(HZM,"BITHLK")=$H ; K @TMPORD K @TMPD Q HZM ; ; SETHR2HZBIT(HZMBIT,HZM) ; N A,N,RES,QN,P1HZOP S RES=$$^W4GETHZ(HZMBIT) S N="" F S N=$O(@$$^W4TMPORD@(N)) Q:N="" I $E(N)?1N D .S A=$G(^(N)) .S QN=$G(@TMPD@(N)) Q:'QN .D ..I QN'=1 S $P(A,"~",7)=HZM_" dpnfd - elhea mihixt "_QN Q ..I QN=1 S $P(A,"~",7)="! "_HZM_" dpnfd - lhea hixt " Q .S @$$^W4TMPORD@(N)=A ; S P1HZOP="UPDCLOSE" N R S R=$$^W4NEWHZ(JB,HZMBIT,1) Q W4BLACK W4BLACK ; GET FILES FROM DOS [ 27.10.09 18:17 ] [ 19.10.09 09:56 ] [ 16.04.09 15:20 ] TRAN ; L ^A2BLACK:2 ;;E S %SAY=" ... xg` seqnn miyer LINUX-n mivaw zxard " X %XMSGV(1) G ENDPE S H1=+$H S REZ=0 I $D(^TRAN)>9 S %SAY=" zkxrna `vnp xak (^TRAN) `ay zeivwfpxh uaew " X %XMSGV(1) G ENDPE I $G(^A2BLACK)="OK" S %SAY=" zkxrna mi`vnp xak `ay ivaw " X %XMSGV(1) G ENDPE U $P W # S %SAY="... oznd `p` , LINUX-n mivaw zxard" X %XMSGV K ^TRANTOT,^HOSER(H1) S I=0 S PATH=^PATH D D READ^A2HZG .I '$D(^dump1) K ^DUMP1 S ^dump1="" D .N (JB,%ARG,%REM,%UPRCOD,%XMSG,%XMSGV,%XMSGN,%CV,%POSIC,%HBRY,PATH,AMAX) .N GIB,TEUDA,DOR,DATS,TIMS .S (GIB,TEUDA,DOR,DATS,TIMS)="" .D READ1("TOTAL") I OK D ..S GIB=$TR($E(^TOTAL,31,42)," ","") ..S TEUDA=$E(^TOTAL,15,22) ..S DOR=$E(^TOTAL,23,24) ..S DATS=$$^%L1DC($E(^TOTAL,3,8),1) ..S TIMS=$E(^TOTAL,9,10)_":"_$E(^TOTAL,11,12) .S LI=$ZP(^TRANL(999999)) Q:'LI S:$G(^TRANL)

  • ^TRAN S FILE=PATH_"TRAN" S S=$$^%L1ZOS(10,FILE) I S<0 S:$G(^TRANL)'>$ZP(^TRANL(999999)) ^TRANL=$ZP(^TRANL(99999))+1 G NOTFF O FILE:(REWIND:READONLY) K NTRAN U FILE K ^TRAN F R STR Q:$ZEOF Q:STR="" D .I $E(STR,1,3)'="",$E(STR,4,6)'="" S KUP=+$E(STR,1,3),NUM=+$E(STR,4,6) S ^TRAN(KUP,NUM)=STR,NTRAN(KUP)=NUM S KUP=-1 F S KUP=$N(^TRAN(KUP)) Q:KUP=-1 S ^TRAN(KUP)=$G(NTRAN(KUP)) C 54 S %ER=$$^%L1ZOS(2,FILE) NOTFF ; I '$$ASHOK("") G ENDPE D READA("ALPHA32") I 'OK G ENDPE D .S N="" D READ1("PARMNEW") I 'OK G ENDPE D READ1("PARMA") I 'OK G ENDPE D READ1("START") I 'OK G ENDPE D READ1("DATA") I 'OK G ENDPE S ^VERSOLD=$G(^VERSION) K ^VERSION D READ1("VERSION.EXE") I 'OK G ENDPE I ^VERSION>570,^VERSOLD<570 S ^A2PRM("DAT70")=+$H ;;D READS ;--- 570 I $E(^DATA,27) S ^A2BLACK="DATA27" G ENDPE S ^A2BLACK="OK" ; ENDPE L Q ; - REV S DI="" F I=1:2:6 S DI=$E(D,I,I+1)_DI Q READ1(NAME) ; R01 S OK=1 N NAME1,FILE,STR,DLM S DLM=$C(26) S FILE=$$FUNC^%LCASE(PATH_NAME) I NAME="VERSION.EXE" S DLM=$C(26,10) ;;S FILE=PATH_NAME S NAME1=$P(NAME,".") K @("^"_NAME1) S S=$$^%L1ZOS(10,FILE) I S<0 S FILE=PATH_NAME S S=$$^%L1ZOS(10,FILE) I S<0 G ERRFILE C FILE O FILE:(REWIND:READONLY) U FILE:(TERM=DLM) R STR S @("^"_NAME1)=$TR($E(STR,1,255),$C(13),$C(233)) C FILE Q READA(NAME) S OK=1 N NAME1,FILE,STR,DLM,I,J,IND S DLM=$C(26,13,233) S NAME1="^"_$P(NAME,".") S FILE=$$FUNC^%LCASE(PATH_NAME) K @NAME1 S S=$$^%L1ZOS(10,FILE) I S<0 G ERRFILE C FILE O FILE:(REWIND:READONLY) U FILE:(TERM=DLM) K @NAME1 F I=1:1 R STR Q:$ZEOF D .F J=1:23 Q:J>$L(STR) S IND=$E(STR,J,J+5) I IND S @NAME1@(IND)=$E(STR,J+8,J+22) C FILE Q READS ;---- 570 N S,IND,ASM,STR S FILE=$$FUNC^%LCASE(PATH_"STATIS") S S=$$^%L1ZOS(10,FILE) S DLM=$C(13,10) I S<0 G ERRFILE C FILE O FILE:(REWIND:READONLY) U FILE:(TERM=DLM) F R STR Q:$ZEOF D .S ASM=$E(STR,15,22) Q:ASM="" .F IND=1:1 Q:'$D(^STATIS(ASM,IND)) .S ^STATIS(ASM,IND,"KOT")=$E(STR,1,118) .S ^STATIS(ASM,IND,"TOH")=$E(STR,119,298) C FILE Q ; ERRFILE S %GET=$$FUNC^%UCASE(FILE)_" uaew xqeg " D N^%L1GET S ^A2BLACK=FILE S OK=0 Q ERRBUSY S %GET=" 99 - aey zeqpl . qetz 54 hxet " D N^%L1GET I %S=99 G R01 S OK=0,^A2BLACK=54 Q ASHOK(DUMP) N FNM,PRM S FNM=$$FUNC^%LCASE($G(@$$^W4GL("PATH"))_"NEG") S PRM=$$^%L1FLP(FNM) I PRM'<0,$P(PRM,"^",2)>0,($H-$P(PRM,"^",3)'>5)!'$P(PRM,"^",3) Q 1 S @$$^W4GL("A2BLACK")="NEG" Q 0 W4BLNMVC W4BLNMVC(CD,QN) ; [ 16.06.21 19:38 ] [ 31.08.18 13:05 ] [ 22.07.15 13:59 ] N (JB,%ARG,%REM,CD,QN) I $G(CD)="" Q "" I $L($$BELONG11^W4TSF(CD,$G(QN))) Q 11 ; S OK=0 N N S N="" F S N=$O(@$$^W4GL("W4MVCAH")@(N)) Q:N="" D Q:$G(OK) .S A=$G(^(N,1)) .S SET=$P(A,"\") Q:'SET .I $D(@$$^W4GL("P1SETM")@(SET,CD)) S OK="1A" ; I OK Q OK ; N N S N="" F S N=$O(@$$^W4GL("W4MVC1")@(N)) Q:N="" D Q:$G(OK) .S A=$G(^(N,1)) .S SET=$P(A,"\") Q:'SET .I $D(@$$^W4GL("P1SETM")@(SET,CD)) S OK="1" ; Q OK ; ; SMB(PAR) ; I $G(PAR)="" Q "" N SMB S SMB="" I $L(PAR),$D(@$$^W4GL("PRTBH")@(PAR)) S SMB="*" I $L(PAR),$$NOKFLMVC^W4PRM,$$W4BLNMVC(PAR) S SMB="*" Q SMB W4BLNORD W4BLNORD(ORD,VDOC,NOM) ; [ 19.12.16 16:44 ] [ 18.12.16 20:33 ] [ I '$G(ORD) Q "" S VDOC=$G(VDOC) S NOM=$G(NOM) I VDOC="HZMH",ORD?1N.N S ORD=+ORD_VDOC ; N BELONG S BELONG="" ; I $G(ORD),$E(VDOC)'="I" D .N NOMDOC .S NOMDOC=$$NOMDOC(ORD) .I ORD'["HZMH" D ..I +NOMDOC=+NOM S BELONG="" ..I NOMDOC,$G(@$$^W4GL("W4DOC")@(NOMDOC,"TM")) S BELONG=^("TM")_" .n.z " Q ..I NOMDOC,$G(@$$^W4GL("W4DOC")@(NOMDOC,"H")) S BELONG=^("H")_" 'yg " Q . .I ORD["HZMH" D ..I +NOMDOC=+NOM S BELONG="" ..I NOMDOC,$G(@$$^W4GL("W4DOC")@(NOMDOC,"TM")) S BELONG=^("TM")_" .n.z " Q ..I NOMDOC,$G(@$$^W4GL("W4DOC")@(NOMDOC,"H")) S BELONG=^("H")_" 'yg " Q ; Q BELONG ; ; NOMDOC(ORD) S ORD=$G(ORD) I ORD'["HZMH" Q $P($G(@$$^W4GL("W4ORD")@(+ORD)),"\",20) N NOMORD S NOMORD=$G(@$$^W4GL("W4DIR")@("HZMH",+ORD)) Q:'NOMORD "" Q $P($G(@$$^W4GL("W4DOC")@(NOMORD)),"\",20) ; ; ORDV(LKH,ORD,DOC) ; I $G(LKH)="" Q "" I $G(ORD)="" Q "" ; I $G(DOC)["HZMH" D .I ORD'["HZMH" S ORD=+ORD_"HZMH" ; I ORD["HZMH" Q $$W4BLNORD(ORD,"HZMH") ; Q $$W4BLNORD($$^W4ORDD(LKH,ORD),"HZ") W4BO W4BO ; [ 13.03.25 10:35 ] [ 04.01.25 11:29 ] [ 28.03.24 14:20 ] Q ; INIT ; N MYDVN S MYDVN=$$^W4MYDVN S ^DV(MYDVN,+$H)=$G(^DV(MYDVN,+$H))+1 ; D KILL^%W1PRM("ABCTOPDN"),KILL^%W1PRM("ABCTOPDNVIS") I $G(%ARG("PRSNLSET")) D .D PUT^%W1PRM("PRSNLSET",%ARG("PRSNLSET")) .I $$GETP^%W1PRM("MNL") D PUT^%W1PRM("CURMENU",$$GETP^%W1PRM("MNL")) ; K @$$^W4MAIN("TMP") K @$$^W4MAIN("TMPREP") K @$$^W4MAIN("TMPCSV") K @$$^W4MAIN("TMPG") K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMG") K @$$^W4MAIN("VRMDEP") K @$$^W4MAIN("VRMKVZ") D KILL^%W1PRM("NMB") N A S A=$$GETP^%W1PRM("SISALL") D ^W4CLEAR I A D PUT^%W1PRM("SISALL",A) D ^W3CSS D PUT^%W1PRM("W4BO",1) I $G(%ARG("TABLET")) D PUT^%W1PRM("TABLET",%ARG("TABLET")) D PUT^%W1PRM("MLZR",$G(@$$^W4PRM@("PSW"))) D KILL^%W1PRM("IFRURSH") D KILL^%W1PRM("SUPPL") D PUT^%W1PRM("PRKUP",1) ; N MSD S MSD=$G(%ARG("MSD")) I MSD D PUT^%W1PRM("MSD",MSD) I 'MSD S MSD=$$GETP^%W1PRM("MSD") I 'MSD S MSD=1 D PUT^%W1PRM("MSD",MSD) ; I $G(%ARG("TABLET")) D PUT^%W1PRM("TABLET",%ARG("TABLET")) I $G(%ARG("BO1"))?1N.N D PUT^%W1PRM("BO1",$G(%ARG("BO1"))) I $G(%ARG("LNG"))'="" D PUT^%W1PRM("LNG",%ARG("LNG")) Q ; ; USPRSNL() ; N MNL S MNL=$$GETP^%W1PRM("MNL") I 'MNL Q 0 I $D(@$$^W4GL("W4PRSMNU")@(MNL))<9 Q 0 N DRG S DRG=$$DARGA(MNL) I DRG>2 Q 0 Q 1 ; DARGA(MNL) ; S MNL=$$DOP^W4NAME(MNL) N DRG S DRG=$P($G(@$$^W4GL("W4PSWDRG")@(MNL)),"\") Q DRG ; ; CLEARMENU(UR) ; I UR=1 D .D KILL^%W1PRM("BOTO2") .D KILL^%W1PRM("BOTO3") .D KILL^%W1PRM("BOTO4") ; I UR=2 D .D KILL^%W1PRM("BOTO3") .D KILL^%W1PRM("BOTO4") ; I UR=3 D .D KILL^%W1PRM("BOTO4") Q 1 W4BON W4BON(PRM) ; [ 01.04.20 13:54 ] [ 30.03.20 17:07 ] [ I '$G(PRM) Q $$^W4GL("W4BON") I $G(PRM)=1 Q $$^W4GL("W4BONA") I $G(PRM)=2 Q $$^W4MAIN("TMPBON") Q "" W4BONBT W4BONBT ; [ 07.03.23 07:10 ] [ 20.12.22 20:31 ] [ 14.12.22 13:38 ] N (JB,%ARG,%REM) S TMPRKZ=$$^W4MAIN("TMPRKZ") W "",! W "",! W "",! ; W "" ; W "",! W "",! W "
    " I $$GETP^%W1PRM("ARRBCK") D .D ARROWBACK W "",! W "",! S I=0,COLS=6 W "" S N="" D TR(N) F S N=$O(@TMPRKZ@(N)) Q:N="" D TR(N) W "
    ",! W "    		" W $$ARROWFWD W "
    ",! Q ; ; TR(N) ; N WDTB S WDTB=100 I $G(N) D .N I1 .N QN S QN=$G(@TMPRKZ@(N)) .W ""_$$H2U^%L1FRM($$SHEM(N))_"" .W ""_QN_"" .S I=I+1 .N N1 S N1=$O(@TMPRKZ@(N)) .I '(I#COLS)!'N1 D ..I (I#COLS) F I1=I:1:COLS D ...W " " ..W "",! I N1 W "" ; Q ; ; SHEM(CD) ; I $$KVZRKZ^W4BONNEW Q $G(@$$^W4GL("W4GRC")@(CD)) Q $$SHEM^W4P(CD) ; TOPARROW() Q 0 ;10 ; ARROWBACK ; N LEFT,TOP S LEFT=$$^W4WDSCR-60 ;;I $$1024^W4WDSCR S LEFT=950 W "" N K S K=$$GETP^%W1PRM("ARRBCK") Q:'K W "",! W K W "",! Q ; ARROWFWD() ; N FRW S FRW=$$GETP^%W1PRM("ARRFRW") I 'FRW Q "" N ST S ST="" S ST=ST_"" S ST=ST_FRW_" " Q ST W4BONCS0 W4BONCSS ; [ 06.10.22 10:11 ] [ 21.09.22 17:02 ] [ 10.08.22 12:46 ] Q NORMFONT() ; ;;I '$$1024^W4WDSCR Q "font-family : otzar" Q "font-family : OpenSansHebrew-Regular" I $$1024^W4WDSCR Q "font-family : Arial;" I $$1024^W4WDSCR,$$^W4MYDVN'=1 Q "font-family : Tahoma;" Q "font-family : otzar" ; BOLDFONT() ; ;;I '$$1024^W4WDSCR Q "font-family : otzar" Q "font-family : OpenSansHebrew-Bold" I $$1024^W4WDSCR Q "font-family : Arial;" I $$1024^W4WDSCR,$$^W4MYDVN'=1 Q "font-family : Tahoma;" Q "font-family : otzar" ; HDFONTSIZE() I $$TAHOMA Q "font-size:14px" I $$OPENHEBREW Q "font-size:14px" Q "font-size:"_$S($$1024^W4WDSCR:18,1:20)_"px" ; TBLFONTSIZE() I $$TAHOMA Q "font-size:12px" I $$ARIAL Q "font-size:13px" I $$OPENHEBREW Q "font-size:14px" Q "font-size:"_$S($$1024^W4WDSCR:14,1:17)_"px" ; KBFONTSIZE() I $$TAHOMA Q "font-size:16px" I $$ARIAL Q "font-size:18px" I $$OPENHEBREW Q "font-size:"_$S($$1024^W4WDSCR:"22px",1:"26px") Q "font-size:"_$S($$1024^W4WDSCR:20,1:26)_"px" ; DOPFONTSIZE() Q "font-size:"_$S($$1024^W4WDSCR:"20px",1:"23px") ; ORDFONTSIZE() I $$TAHOMA Q "font-size:12px" I $$ARIAL Q "font-size:13px" I $$OPENHEBREW Q "font-size:14px" Q "font-size:"_$S($$1024^W4WDSCR:15,1:17)_"px" ; TAHOMA() ; I $$NORMFONT["Tahoma" Q 1 Q 0 ; ARIAL() ; I $$NORMFONT["Arial" Q 1 Q 0 ; OPENHEBREW() ; I $$NORMFONT["OpenSansHebrew" Q 1 Q 0 ; OTZAR() ; I $$NORMFONT["otzar" Q 1 Q 0 ; OTZAR24() ; I $$OTZAR&$$1024^W4WDSCR Q 1 Q 0 ; ORDARRTOP() N A S A=$$GETP^%W1PRM("WDSCR") N HG S HG=$P(A,";",2) ;;I 'HG Q 550 Q (HG-80) ; ORDARRBACK() N A S A=+$$^W4WDSCR Q (A-68) ; WDDOPKAV() ; I $$OPENHEBREW Q 24 Q 28 W4BONCSS W4BONCSS ; [ 20.12.22 20:13 ] [ 21.11.22 17:16 ] [ 06.10.22 10:40 ] Q NORMFONT() ; I '$$1024^W4WDSCR Q "font-family : otzar" Q "font-family : OpenSansHebrew-Regular" I $$1024^W4WDSCR Q "font-family : Arial;" I $$1024^W4WDSCR,$$^W4MYDVN'=1 Q "font-family : Tahoma;" Q "font-family : otzar" ; BOLDFONT() ; I '$$1024^W4WDSCR Q "font-family : otzar" Q "font-family : OpenSansHebrew-Bold" I $$1024^W4WDSCR Q "font-family : Arial;" I $$1024^W4WDSCR,$$^W4MYDVN'=1 Q "font-family : Tahoma;" Q "font-family : otzar" ; HDFONTSIZE() I $$TAHOMA Q "font-size:14px" I $$OPENHEBREW Q "font-size:"_$$OPNSZ_"px" Q "font-size:"_$S($$1024^W4WDSCR:18,1:20)_"px" ; TBLFONTSIZE() I $$TAHOMA Q "font-size:12px" I $$ARIAL Q "font-size:13px" I $$OPENHEBREW Q "font-size:"_$$OPNSZ_"px" Q "font-size:"_$S($$1024^W4WDSCR:14,1:17)_"px" ; KBFONTSIZE() I $$TAHOMA Q "font-size:"_$$OPNSZ_"px" I $$ARIAL Q "font-size:18px" I $$OPENHEBREW Q "font-size:"_$S($$1024^W4WDSCR:"22px",1:"26px") Q "font-size:"_$S($$1024^W4WDSCR:20,1:26)_"px" ; DOPFONTSIZE() Q "font-size:"_$S($$1024^W4WDSCR:"20px",1:"23px") ; ORDFONTSIZE() I $$TAHOMA Q "font-size:12px" I $$ARIAL Q "font-size:13px" I $$OPENHEBREW Q "font-size:"_$$OPNSZ_"px" Q "font-size:"_$S($$1024^W4WDSCR:15,1:17)_"px" ; TAHOMA() ; I $$NORMFONT["Tahoma" Q 1 Q 0 ; ARIAL() ; I $$NORMFONT["Arial" Q 1 Q 0 ; OPENHEBREW() ; I $$NORMFONT["OpenSansHebrew" Q 1 Q 0 ; OTZAR() ; I $$NORMFONT["otzar" Q 1 Q 0 ; OTZAR24() ; I $$OTZAR&$$1024^W4WDSCR Q 1 Q 0 ; ORDARRTOP() N A S A=$$GETP^%W1PRM("WDSCR") N HG S HG=$P(A,";",2) ;;I 'HG Q 550 Q (HG-80) ; ORDARRBACK() N A S A=+$$^W4WDSCR Q (A-68) ; WDDOPKAV() ; I $$OPENHEBREW Q 24 Q 28 ; OPNSZ() ; Q 14 ; -- WAS 14 ; COLORV() ; Q "#534e93" W4BONCVG W4BONCVG ; [ 18.04.23 19:15 ] [ 17.04.23 18:51 ] [ 10.08.21 12:15 ] N (JB,%ARG) W "
    ",! ; K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMT") ; W "
    ",! ; W "",! W "" W "" W "" W "" W "",! W "
    " D SORTSUG^W4SPIDK("") W " " D ^W4SBMBCK W "
    ",! ; W "

    ",! ; W "" W "" W "" W "" W "",! ; S GL=$$^W4GL("PARSUG") N GLOBT S GLOBT=GL S GLOBT=$$CRGLOBT^W4SPIDK(GL) ; ;;W "GLOBT="_GLOBT ; S N0="" F S N0=$O(@GLOBT@(N0)) Q:N0="" D .S N=N0 .I $G(%ARG("SORT"))=2!($G(%ARG("SORT"))=3) S N=$G(@GLOBT@(N0)) .Q:N="" .S A=$G(@GL@(N)) .I '$$^W4VWGR(N) Q .I $$^W4ELPOS,$$NODLVORD^W4PRM,$G(@$$^W4GL("W3SUG")@(N))=3 Q .I '$$^W4ELPOS,$G(@$$^W4GL("W3SUG")@(N))=2 Q . .W "" . W "" . . W "" .W "",! ; W "
    " W $$^%W1DICT("GROUP") W "" W $$^%W1DICT("FRAMECOLOR4GROUPS") W "
    " . W N_$$NBSP^%L1FRM(3) . W $$H2U^%L1FRM(A) . W " " . N ID S ID="color"_N . W "" . W "
    ",! W "
    ",! ; K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMT") Q ; PIC(N) ; Q $$^W4PIC("grp","w4grp",N) ; CLICK(PRM) ; S GR=$P(PRM,";") S CD=$P(PRM,";",2) I $G(GR)="" Q "WRONGGROUPCODE" S @$$^W4MAIN("VRM")@(GR)=CD Q 1 ; ; SELSORT(VL) Q $$SELSORT^W4SPIDK(VL) ; SET(PRM) ; N SUG,VL S SUG=$P(PRM,";") S SUG=$P(SUG,"color",2) S VL=$P(PRM,";",2) I SUG="" Q "NOSUG" I VL="FFFFFF" S VL="" S @$$^W4GL("W4BONCVG")@(SUG)=VL Q 1 W4BONDOP W4BONDOP ; [ 12.12.22 17:32 ] [ 29.11.22 18:07 ] [ 27.11.22 10:33 ] W "
    ",! W "",! W "

    ",! ; I $G(%ARG("HIST")) G HIST ; W "",! W "" W "" W "",! ; W "" W "" W "",! ; W "" W "" W "",! ; I '$$KVZRKZ^W4BONNEW D .W "" . W "" .W "",! ; W "" W "" W "",! W "
    " D HISTORY W "
    " D CHOICEWAITER W "
    " D CHOICEGROUP W "
    " D TBCONC W "
    " D TBRESET W "
    ",! W "
    ",! ; D CMB("waiter","PROC=Show4Waiter") D CMB("group","PROC=Show4Group") Q ; ; HISTORY ; W "",! Q ; ; CHOICEWAITER ; N NM S NM="waiter" D TMP S @TMP@(NM,0)=$$TV^%W1DICT($$^%W1LNG,"CHOICEWRKR") ; N N S N="" F S N=$O(@$$^W4GL("FILE")@(N)) Q:N="" D .I $G(@$$^W4GL("FILE")@(N,"CIO"))'="I" Q .I '$$GET1^W4LEVPR(N,"PAIL") Q .I '$$GET1^W4LEVPR(N,"MTIP") Q .S @TMP@(NM,N)=$$^W4NAME(N) ; W "

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

    ",! W "",! W "" W "" ; D TDARROW("td"_NM) W "",! W "
    " N CUR S CUR=$$CUR(NM) I 'CUR W $$^%W1DICT("ALLWORKERS") I CUR D .W $$H2U^%L1FRM($$^W4NAME(CUR)) W "
    ",! Q ; ; CHOICEGROUP ; N NM S NM="group" D TMP S @TMP@(NM,0)=$$TV^%W1DICT($$^%W1LNG,"CHOICEGRIT") ; N N S N="" F S N=$O(@$$^W4GL("PARSUG")@(N)) Q:N="" D .I '$$^W4VWGR(N) Q .S @TMP@(NM,N)=$G(@$$^W4GL("PARSUG")@(N)) ; W "

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

    ",! W "",! W "" W "" ; D TDARROW("td"_NM) W "",! W "
    " N CUR S CUR=$$CUR(NM) I 'CUR W $$^%W1DICT("ALLGROUPS") I CUR D .W $$H2U^%L1FRM($G(@$$^W4GL("PARSUG")@(CUR))) W "
    ",! Q ; ; TDARROW(PRM) ; W "",! W "" W "",! Q ; CMB(TO,PRM) ; D ^W4CMBBOX(TO,$G(PRM)) ; Q ; TMP ; D TMP^W4CMBBOX Q ; CUR(NM) ; I $G(NM)="" Q "" N TMP D TMP Q $G(@TMP@(NM)) ; INIT(NM) ; S @TMP@(NM,1)="``` `````" S @TMP@(NM,2)="aaaaa aaa" S @TMP@(NM,3)="bbbb bbb" S @TMP@(NM,4)="ccccc ccc" S @TMP@(NM,5)="ddddd ddd" S @TMP@(NM,6)="eeeee eee" S @TMP@(NM,7)="hhhhhh hhh" S @TMP@(NM,8)="ggggg ggg" Q ; TBCONC ; W "",! W "" W "" W "" W "",! W "
    " D KINDSHOW("conc") W ""_$$^%W1DICT("ITCNC")_"
    ",! Q ; ; TBRESET ; W "",! W "" W "" W "" W "",! W "
    " D KINDSHOW("reset") W ""_$$^%W1DICT("RESETPARAMETERS")_"
    ",! Q ; ; ; KINDSHOW(PRM) ; W "",! ; I PRM="conc" D .I $$CONC W " checked=""checked"" " .W " onClick=""ClickConc()"" />",! ; W "",! Q ; ; RESET(STAM) ; D TMP N OK S OK=1 N NM F NM="waiter","group" D .I $G(@TMP@(NM)) S OK=0 Q OK ; SETRESET ; D TMP N OK S OK=1 N NM F NM="waiter","group" S @TMP@(NM)=0 Q ; CONC() ; Q $G(%ARG("CONC")) ; IMGRNDFULL ; D IMGRNDFULL^W4BONHD Q ; IMGRND ; D IMGRND^W4BONHD Q ; WDCMB() ; I $$1024^W4WDSCR Q 200 Q 250 ; ; HIST ; N (JB,%ARG,%REM) ; D DEVLIST^W4BONVW($$^W4MYDVN) ; --> MPRN() ; S DT=$$^W4DZ D TMPHST K @TMPHST D HISTM(DT,1) D HISTM(DT,0) ; W "
    ",! W "",! S TIM="" F S TIM=$O(@TMPHST@(TIM)) Q:TIM="" D .S ORD="" F S ORD=$O(@TMPHST@(TIM,ORD)) Q:ORD="" D ..S PRN="" F S PRN=$O(@TMPHST@(TIM,ORD,PRN)) Q:PRN="" D ...S RD=$G(^(PRN)) ...S IND=$$^W4DZ_"~"_PRN_"~"_TIM_"~"_ORD ...W "" ... S IMG="w4bonrnd.png" ... I RD S IMG="w4bonrndfull.png" ... W "" ... W "" ... W "" ... W "" ... S A=$G(@$$^W4ORD@(ORD)) ... S NMB=$P(A,"\") ... S LK1=$$H2U^%L1FRM($P(A,"\",2)) ... I $$^W4MSD(NMB) D .... S LK1=$$MZMNM^W4HZMST(ORD) I LK1'="" S LK1=$$H2U^%L1FRM(LK1) Q .... S LK1=$$H2U^%L1FRM("ogley")_" "_NMB ... W "" ...W "",! ...W "",! W "
    "_$S($$TAW^W4BONKOT(ORD)!$$MSD^W4BONKOT(ORD):" ",1:"")_""_$$T^%L1TIME($E(TIM,6,10))_""_ORD_""_LK1_"
    ",! W "
    ",! Q ; HISTM(DT,PR) N (JB,%ARG,DT,PR,MPRN) D TMPHST S GL=$$^W4BON(PR) S PRN="" F S PRN=$O(@GL@(DT,PRN)) Q:PRN="" D .S TIM="" F S TIM=$O(@GL@(DT,PRN,TIM)) Q:TIM="" D ..S ORD="" F S ORD=$O(@GL@(DT,PRN,TIM,ORD)) Q:ORD="" D ...I PRN,'$D(MPRN(PRN)) Q ...S @TMPHST@(TIM,ORD,PRN)=PR Q ; TMPHST ; S TMPHST=$$^W4MAIN("TMPHST") Q ; SHOWORD(IND,READY) ; N READY D SHOWORD1^W4BONNEW W4BONHD W4BONHD ; [ 19.04.23 13:15 ] [ 07.02.23 07:52 ] [ 12.01.23 14:38 ] I $G(%ARG("READY")) S %ARG("NORDYIT")=0,%ARG("FIRE")=0 ;;W " ",! ;;W " ",! ; W "
    ",! I $G(%ARG("SHORT")) D Q .W "",! .W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "",! . W "" . W "",! .W "
    ",! . W "",! . W " " D KINDSHOW("notready") W ""_$$^%W1DICT("INWAITING")_"" D KINDSHOW("ready") W ""_$$NMREADY_" " D KINDSHOW("nordyit") W ""_$$^%W1DICT("HIDEREADYITEMS")_"" D KINDSHOW("fire") W "Fire  "_$$^%W1DICT("ORDHISTORY")_"  
    ",!,"
    ",! ; W "",! W "" W "" W "" I '$$1024^W4WDSCR D .W "" .W "" ; W "" ; D .W "" ; W "" ; I '$$1024^W4WDSCR W "" ; W "" ; W "" ; W "" ; W "" W "" W "",! W "
    " . D LOGO .W " ",! D SHOWOPTIONS W "" .W "",! W "",! W "",! D KEYBOARD W "",! W "
    ",! W "    		",! W "",! W "" W "" W "",! W "",! W "
    " I $G(%ARG("ORD"))'="" D .I $E(%ARG("ORD"))="T" D Q ..D PUT^%W1PRM("OBJ",0) ..W $E(%ARG("ORD"),2,20) .W %ARG("ORD") W "",! D SELOBJ W "
    ",! W "    		" W "
    ",! D .N MRG S MRG=4 I $$OPENHEBREW S MRG=6 .W "" W "
    ",! W "    		" D DOP W "
    ",! W "
    • ",! ; W "
    ",! W $$SHOWOBJLIST W "
    ",! Q ; ; IMGRND ; W "",! Q ; IMGRNDFULL ; W "",! Q ; IMGNOTREADY ; W "",! Q ; IMGREADY ; W "",! Q ; IMGITHIDE ; ;;W "
    ",! W "",! Q ; IMGFIRE ; W "",! Q ; LOGO ; W "" Q ; ; SELOBJ ; W "",! W "" W "" W "" W "",! W "
    " W $$OBJNAME W "" W $$IMGV,! W "
    ",! Q ; SHOWOBJLIST() ; N ST S ST="" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"" S ST=ST_"
    "_$$^%W1DICT("ORDER")_"" S ST=ST_$S($$OBJ=0:$$IMGV,1:" ")_"
    "_$$^%W1DICT("TABLE")_""_$S($$OBJ=1:$$IMGV,1:" ")_"
    " Q ST ; IMGV() ; Q "" ; CLICKOBJ(OBJ) ; N ST S ST=" onClick=""ClickObjStr('"_OBJ_"')"" " Q ST ; KEYBOARD ; N I F I=1:1:9 D .W "" W I W "" .D TDKBSP ; W "" W "0" W "" D TDKBSP W "" D KBDEL W "" D TDKBSP W "" W "C" W "" W "" Q ; TDKBSP ; W "" Q ; WD1(STAM) ; I $$1024^W4WDSCR Q "1%" Q "2%" ; WD2(STAM) ; I $$1024^W4WDSCR Q "15%" Q "12%" ; WD3(STAM) ; I $$1024^W4WDSCR Q "2%" Q "1%" ; WD4(STAM) ; I $$1024^W4WDSCR Q "23%" Q "17%" ; WD5(STAM) ; I $$1024^W4WDSCR Q "2px" Q "2%" ; WD6(STAM) ; I $$1024^W4WDSCR Q "160px" Q "192px" ; WD7(STAM) ; I $$1024^W4WDSCR Q "48%" Q "42%" ; WD8(STAM) ; I $$1024^W4WDSCR Q "50px" Q "54px" ; WD9(STAM) ; I $$1024^W4WDSCR Q "30px" Q "40px" ; WD10(STAM) ; I $$1024^W4WDSCR Q "8%" Q "8%" ; WD11(STAM) ; I $$1024^W4WDSCR Q "25%" Q "30%" ; WD12(STAM) ; I $$1024^W4WDSCR Q "1px" Q "2px" ; WD13(STAM) ; I $$1024^W4WDSCR Q "20%" Q "25%" ; WD14(STAM) ; Q "1%" ; WDOBJ() ; I $$1024^W4WDSCR Q "170px" Q "180px" ; KBDEL ; W "" Q ; DOP ; W "
    ",! W "
    ",! W "
    ",! W "
    ",! W "
    ",! Q ; ; KINDSHOW(PRM) ; W "" ; W "
    ",! END Q ; ; ; VW(TX,PR) ; N ST S ST="" D .I $G(PR)="H" S TX=$$H2U^%L1FRM(TX) Q .I $G(PR)="N" S TX=$J(TX,2,2) Q S ST=ST_TX_"" Q ST ; ; SPACE(ZN) I '$G(ZN) S ZN=5 Q $$NBSP^%L1FRM(ZN) ; SAVE(PRM) ; N (JB,%ARG,PRM) S ORD=$$SPA^%L1FRM($P(PRM,"~")) I $L(ORD)<1 Q 0 S DETNOTES=$P(PRM,"~",2) S IND=$O(@$$GL(ORD)@(99999),-1)+1 S ST=DETNOTES S @$$GL(ORD)@(IND)=ST Q 1 ; ; DETNOT(HZM) ; N N,A,B,C,I,J,K,TAG,LTX,LN,MC S A="",B="",C="",I=0,J=0,K=0,TAG=0 ; S N="" F S N=$O(@$$GL(HZM)@(N)) Q:N="" I N D .S LN=$G(^(N)) .S A=A_LN DETNOT1 S J=J+1 I J>$L(A) G DETNOT2 I $E(A,J)="<" S TAG=TAG+1 D CONVC S B=B_$E(A,J) G DETNOT1 I $E(A,J)=">" S TAG=TAG-1 S B=B_$E(A,J) G DETNOT1 I TAG S B=B_$E(A,J) G DETNOT1 S C=C_$E(A,J) G DETNOT1 ; DETNOT2 D CONVC I $$CORR(HZM)!$$CORHB(HZM)!$$CORHM(HZM)!$$CORWR(HZM) D .N KAV S KAV=$TR($J("",30)," ","-") .S B=B_"

    "_KAV_$$NBSP^%L1FRM(5)_$ZD($H,"DD.MM.YY 24:60")_$$NBSP^%L1FRM(5)_KAV_"

    " Q B ; ; CONVC ; S LTX=0 I '$L(C) Q D .D TSS^%L1TS .S TS=$C(95,127)_TSS_TS1 S C=$TR(C,TS,"") I $L(C) S LTX=1 S C=$$RPL^%L1FRM(C," ",$C(9)) S C=$$H2U^%L1FRM($$INVH^%L1FRM(C)) S C=$$RPL^%L1FRM(C,$C(9)," ") S B=B_C S I=I+1 S MC(I)=C S C="" Q ; ; KOT(HZM) ; N NMB,ST S ST="" I $$CORHM(HZM) S HZM=$E(HZM,2,20) ; I '$$CORR(HZM),'$$CORHB(HZM),'$$CORWR(HZM) D .S NMB=$$NMB^W4HZMST(HZM) .; .N SP S SP=10 .S ST=$$OPNDIV .S ST=ST_$$^%W1DICT("ORDER")_" "_$$VW(HZM) .S ST=ST_$$SPACE(SP) .N DAT S DAT=$$TRH^W4HZMST(HZM) .S DAT=DAT_" "_$$H2U^%L1FRM($$^%L1DC(DAT,9))_"`" .S ST=ST_$$^%W1DICT("TODATE")_" "_$$VW(DAT) .S ST=ST_$$SPACE(SP) .S ST=ST_$$VW($$SHAA^W4HZMST(HZM))_$$SPACE(SP) .; .S ST=ST_$$^%W1DICT("CUSTOMER")_" "_$$VW(NMB) .S ST=ST_$$SPACE(2)_$$VW($$LKH^W4L(NMB),"H") .S ST=ST_$$SPACE(SP) .; .S ST=ST_$$^%W1DICT("MAZMIN")_" "_$$VW($$MAZMIN^W4HZMST(HZM),"H") .S ST=ST_$$SPACE(SP) .S ST=ST_$$^%W1DICT("PELE")_" "_$$VW($$PELE^W4HZMST(HZM)) .S ST=ST_"" ; I $$CORR(HZM) D .N LK S LK=$$LKH(HZM) .S ST=$$^%W1DICT("CUSTOMER")_" "_LK .S ST=ST_$$SPACE(2)_$$VW($$LKH^W4L(LK),"H") ; I $$CORWR(HZM) D .N OV S OV=$$LKH(HZM) .S ST=OV .S ST=ST_$$SPACE(2)_$$VW($$^W4NAME(OV),"H") ; I $$CORHB(HZM) D .N LK S LK=$$LKHB(HZM) .S ST=$$^%W1DICT("CUSTOMER")_" "_LK .S ST=ST_$$SPACE(2)_$$VW($$LKH^W4L(LK),"H") .S ST=ST_$$SPACE(5)_$$^%W1DICT("INVOICE")_" "_$$HB(HZM) Q ST ; ; DIVBUT(ORD) ; D ^W4BTN("SUBMIT","Submit('"_ORD_"')","green") W $$NBSP^%L1FRM(10) D ^W4BTN("DELDOC","Delete('"_ORD_"')","brown") W $$NBSP^%L1FRM(10) D ^W4BTN("BACK","Back()","red") Q ; SHOW(ORD) ; W "
    " D SHOWBUT(ORD) W $$DETNOT(ORD) W "
    ",! ; D SHOWBUT(ORD) W "
    ",! Q ; OPNDIV(ID) ; N ST S ST="
    " Q ST ; SHOWBUT(ORD) ; W $$OPNDIV("divbut") D ^W4BTN("PRINT","Print()","blue") W $$NBSP^%L1FRM(10) D ^W4BTN("CLOSE","Close()","brown") W "
    ",! Q ; CORR(STAM) ; Q $E(HZM)="L" ; FIRSTNOT(HZM) ; Q $G(@$$GL(HZM)@(1)) ; GL(HZM) ; I $$CORR(HZM) Q $$^W4GL("LKH")_"("""_$$LKH(HZM)_""",""WR"")" I $$CORHB(HZM) Q $$^W4GL("W4CORHB")_"("""_$$LKHB(HZM)_""","""_$$HB(HZM)_""")" I $$CORHM(HZM) Q $$^W4GL("W4CORHM")_"("""_+$E(HZM,2,20)_""")" I $$CORWR(HZM) Q $$^W4GL("W4CORWR")_"("""_$$LKH(HZM)_""")" Q $$^W4ORD_"("""_HZM_""",""DETNOTES"")" ; LKH(HZM) ; Q $E(HZM,2,20) ; LKHB(NOM) ; N KLIN S KLIN=$$^W4GL("KLIN") I '$$CORHB(NOM) Q NOM N LK0,LK,N S N=$E(NOM,2,10) I $E(N)="[" S N=$TR(N,"[] ","") ; -- H-I S LK0=$G(@KLIN@("H",+N)) Q:LK0="IN" S LK=$$LK^W4LHB(LK0) Q LK ; HB(NOM) ; I '$$CORHB(NOM) Q NOM Q $E(NOM,2,10) ; CORHB(NOM) ; Q $E(NOM)="H" ; CORHM(NOM) ; Q $E(NOM)="M" ; CORWR(NOM) ; Q $E(NOM)="W" W4DEV W4DEV(STAM) ; [ 25.01.23 20:43 ] [ 10.08.22 11:42 ] [ 19.05.20 15:46 ] Q "^[$$^W3MAIN]dev" ; GET ; N GLOB,GLOB0 D GLOB^W4SPIDK K @GLOB N A,A1 N N S N="" F S N=$O(@$$W4DEV@(N)) Q:N="" D .S A=$G(^(N)) .S @GLOB@(N)=A .S A1=$G(@$$W4DEV@(N,"H")) .N N1,OK S OK=0,N1="" F S N1=$O(@$$^W4PRM@("MDP",N1)) Q:N1="" D Q:OK ..N B S B=$G(^(N1)) ..I +$P(B,"\",3)=N S $P(A1,"\",2)=$P(B,"\") S OK=1 .S @GLOB@(N,1)=A1 Q ; PUT ; N GLTMP,W4DEV0,W4DEVI0 S GLTMP=$$^W4MAIN("TMPDEV") S W4DEV0="^[$$^W3MAIN]dev0" S W4DEVI0="^[$$^W3MAIN]devi0" K @W4DEV0,@W4DEVI0 M @W4DEV0=@$$W4DEV M @W4DEVI0=@$$^W4DEVI K @$$W4DEV,@$$^W4DEVI ; N N,NM S N="" F S N=$O(@GLTMP@(N)) Q:N="" D .S NM=$G(@GLTMP@(N)) Q:NM="" .S @$$W4DEV@(N)=NM .N DOP S DOP=$$U2H^%L1FRM($G(@GLTMP@(N,1))) .S @$$W4DEV@(N,"H")=DOP .D ..N N1 S N1="" F S N1=$O(@$$^W4PRM@("MDP",N1)) Q:N1="" D ...N B S B=$G(^(N1)) ...I $P(B,"\",3)=N S $P(B,"\")=$P(DOP,"\",2) S ^(N1)=B . .S @$$^W4DEVI@(NM)=N ; K @$$^W4MAIN("TMPDEV") Q W4DEVI W4DEVI(STAM) ; [ 24.11.08 17:33 ] [ 23.11.08 14:46 ] [ Q "^[$$^W3MAIN]devi" W4DHB W4DHB ; DOCH HESBONIOT [ 16.12.18 19:48 ] [ 09.10.18 12:19 ] [ 23.10.14 09:59 ] N (JB,%ARG,%REM) ; ------------------- %REPN = DHBN !!!!!!!!!!!!!!!! Q:$G(%ARG("SHOW"))=0 D ^W4IN D ^%W1ARG ; D GET ; S %SCRN=$$SCRN S VD1="" I VD=1 S VD1=$$TV^%W1DICT($$^%W1LNG,"AUTOINVOICES") I VD=2 S VD1=$$TV^%W1DICT($$^%W1LNG,"ARMINVOICES") I $$VDZ(VD) S VD1=$$TV^%W1DICT($$^%W1LNG,"DEBETINVOICES") I VD=0 S VD1=$$TV^%W1DICT($$^%W1LNG,"ALLINVOICES") S HEARA="" I $$VDZ(VD)!(VD=0) S HEARA=$$TV^%W1DICT($$^%W1LNG,"DEBETINVOICESTHISREPORTSHOWEDASNEGATIV") ; D SORT ; D PCPRM^W4DMANY(%SCRN) Q ; GET ; I '$G(VD) S VD=0 I '$G(MESUGL) S MESUGL="" I '$G(ADSUGL) S ADSUGL=99999999999 S MESUGL1="" I MESUGL S MESUGL1=$G(@$$^W4GL("SUGL")@(MESUGL)) S ADSUGL1="" I ADSUGL S ADSUGL1=$G(@$$^W4GL("SUGL")@(ADSUGL)) I '$G(MELKH) S MELKH="" I '$G(ADLKH) S ADLKH=99999999999999 ; N KLIN S KLIN=$$^W4GL("KLIN") N GLHB S GLHB=$$^W4GL("P1LHB") N TMPREP D TMPREP K @TMPREP K @$$^W4MAIN("TMPREPB") ; N I,N S DT1=$$^%L1DC(DAT1,3),DT2=$$^%L1DC(DAT2,3) S I=0 S (SUMH,SLMAM,MAM,SAH,SDOP)=0 I '$$VDZ(VD) D .S N="" F S N=$O(@KLIN@("H",N)) Q:N="" D VIBHB("H") I $G(VD)=0!$$VDZ(VD) D .S N="" F S N=$O(@KLIN@("TZ",N)) Q:N="" D VIBHB("TZ") Q ; VIBHB(CODDOC) ; N LK,LK0 S LK0=$G(^(N)) I CODDOC="H",VD=1,$$ARM(LK0) Q I CODDOC="H",VD=2,'$$ARM(LK0) Q S LK=$$LK(LK0) N SUGL S SUGL=$$SUGL^W4L(LK) I SUGL<$G(MESUGL) Q I $G(ADSUGL),SUGL>ADSUGL Q I $TR(LK,"-","")<$TR(MELKH,"-","") Q I $TR(LK,"-","")>$TR(ADLKH,"-","") Q D LINEINVC(N,LK,LK0,CODDOC) Q ; LINEINVC(N,LK,LK0,CODDOC) ; D ^W4HSBGET(N,CODDOC) Q:$D(W4HSB)<10 ; Q:'$G(W4HSB("TODATE")) ; I W4HSB("DT")DT2 Q ; I $G(%ARG("MESUM")),W4HSB("TOT")<%ARG("MESUM") Q I $G(%ARG("ADSUM")),W4HSB("TOT")>%ARG("ADSUM") Q ; I $G(%ARG("MENOM")),N<%ARG("MENOM") Q I $G(%ARG("ADNOM")),N>%ARG("ADNOM") Q ; S I=I+1 ; ;;I $$HBZ(CODDOC),'$D(W4HIPUS) D .S W4HSB("LMAM")=$G(W4HSB("LMAM"))*-1 .S W4HSB("TOT")=$G(W4HSB("TOT"))*-1 ; S DOP=0 I CODDOC="H",$D(@GLHB@(LK,N)) D .N J F J=2:1 Q:'$D(@GLHB@(LK,N,"HB",J)) D ..S DOP=DOP+$P(^(J),"\",3) S @TMPREP@("G",I)=N_$S($$HBZ(CODDOC):" [-]",1:"")_"\"_W4HSB("TODATE") S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_LK S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_$$LKH^W4L(LK) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_W4HSB("LMAM") S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_(W4HSB("TOT")-W4HSB("LMAM")) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_W4HSB("TOT") S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_DOP ; S SUMH=SUMH+1 S SLMAM=SLMAM+W4HSB("LMAM") S MAM=MAM+(W4HSB("TOT")-W4HSB("LMAM")) S SAH=SAH+W4HSB("TOT") S SDOP=SDOP+DOP S @TMPREP@("TOT")=$J(SUMH,1,1)_"\"_$J(SLMAM,1,1)_"\"_$J(MAM,1,1)_"\"_$J(SAH,1,1)_"\"_$J(SDOP,1,1) Q ; LK(LK0) N LK S LK=LK0 I LK0["+" S LK=$P(LK0,"+") I LK0["^" S LK=$P(LK0,"^") I LK0["W" S LK=$P(LK0,"W") Q LK ; ARM(LK0) ; I LK0'["+",LK0'["^",LK0'["W" Q 1 I LK0["W" Q 2 Q 0 ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DHB-CHKPRM","MESUGL=MESUGL&ADSUGL=ADSUGL&MELKH=MELKH &ADLKH=ADLKH & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MELKH>ADLKH Q "0;RANGENOTVALID;;MELKH" I MESUGL>ADSUGL Q "0;RANGENOTVALID;;MESUGL" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4DHB" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N HB S HB=$$HBG(A) D TRG(HB) Q ; TRG(HB) ; N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(+HB,CODDOCG) N LK S LK=$$LK(LK0) W " style=""cursor:pointer;color:black" ;;;font-size:"_$$^W3FSZ(11) W """" I $$HBZG(HB),LK0'["+" D .W " onClick=""ShowArmInvoice('"_+HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q I $$HBZG(HB),LK0["+" D .W " onClick=""ShowInvoice('"_-HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q ; I LK0,'$$ARM(LK0) W " onClick=""ShowInvoice('"_HB_"','"_LK_"','ifr')""" ; I $$ARM(LK0) D .I $$ARM(LK0)=1 W " onClick=""ShowArmInvoice('"_HB_"','"_LK_"','ifr')""" Q .I $$ARM(LK0)=2 W " onClick=""ShowItemsInvoice('"_HB_"','"_LK_"','ifr')""" Q Q ; TD ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N LK S LK=$$LKG(A) Q:LK="" N HB S HB=$$HBG(A) N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(HB,CODDOCG) W " style=""" ;;I (HB_";"_LK)=$$GET^%W1PRM("LHBCUR") W "border:solid 2px brown;" D .I $$HBZG(HB)=1 W "background-color:pink" Q .I $$HBZG(HB)=2 W "background-color:pink" Q .I $$ARM(LK0)=1 W "background-color:lightblue" Q .I $$ARM(LK0)=2 W "background-color:lightyellow" Q W """" Q ; LKG(A) ; Q $P(A,"\",3) ; HBG(A) ; Q $P(A,"\") ; LK0(HB,CODDOC) ; Q $G(@$$^W4GL("KLIN")@(CODDOC,HB)) ; CODDOC(STAM) ; I $$HBZ Q "TZ" Q "H" ; CODDOCG(HB) ; I $$HBZG(HB) Q "TZ" Q "H" ; HBZ(CODDOC) ; I CODDOC="TZ" Q 1 Q 0 ; HBZG(HB) ; I $G(HB)["[-]" Q $S($G(@$$^W4KLIN@("TZ",+HB))["W":2,1:1) Q 0 ; TMPREP S TMPREP=$$^W4MAIN("TMPREP") Q ; SORT ; D TMPREP N VRM S VRM=$$^W4MAIN("VRM") K @VRM N A,I,DT,HB F I=1:1 Q:'$D(@TMPREP@("G",I)) D .S A=$G(^(I)) .S DT=$$^%L1DC($P(A,"\",2),3) .S HB=$P(A,"\") .S @VRM@(DT,HB)=A ; K @TMPREP@("G") ; S I=0 S DT="" F S DT=$O(@VRM@(DT)) Q:DT="" D .S HB="" F S HB=$O(@VRM@(DT,HB)) Q:HB="" D ..S I=I+1,@TMPREP@("G",I)=$G(@VRM@(DT,HB)) ; K @VRM Q ; VDZ(VD) ; I $G(VD)=3 Q 1 Q 0 W4DHB1 W4DHB ; DOCH HESBONIOT [ 09.10.18 12:19 ] [ 23.10.14 10:00 ] [ 17.05.14 19:50 ] N (JB,%ARG,%REM) Q:$G(%ARG("SHOW"))=0 D ^W4IN D ^%W1ARG ; D GET ; S %SCRN=$$SCRN S VD1="" I VD=1 S VD1=$$TV^%W1DICT($$^%W1LNG,"AUTOINVOICES") I VD=2 S VD1=$$TV^%W1DICT($$^%W1LNG,"ARMINVOICES") I $$VDZ(VD) S VD1=$$TV^%W1DICT($$^%W1LNG,"DEBETINVOICES") I VD=0 S VD1=$$TV^%W1DICT($$^%W1LNG,"ALLINVOICES") S HEARA="" I $$VDZ(VD)!(VD=0) S HEARA=$$TV^%W1DICT($$^%W1LNG,"DEBETINVOICESTHISREPORTSHOWEDASNEGATIV") ; D SORT ; D PCPRM^W4DMANY(%SCRN) Q ; GET ; I '$G(VD) S VD=0 I '$G(MESUGL) S MESUGL="" I '$G(ADSUGL) S ADSUGL=99999999999 S MESUGL1="" I MESUGL S MESUGL1=$G(@$$^W4GL("SUGL")@(MESUGL)) S ADSUGL1="" I ADSUGL S ADSUGL1=$G(@$$^W4GL("SUGL")@(ADSUGL)) I '$G(MELKH) S MELKH="" I '$G(ADLKH) S ADLKH=99999999999 ; N KLIN S KLIN=$$^W4GL("KLIN") N GLHB S GLHB=$$^W4GL("P1LHB") N TMPREP D TMPREP K @TMPREP K @$$^W4MAIN("TMPREPB") ; N I,N S DT1=$$^%L1DC(DAT1,3),DT2=$$^%L1DC(DAT2,3) S I=0 S (SUMH,SLMAM,MAM,SAH,SDOP)=0 I '$$VDZ(VD) D .S N="" F S N=$O(@KLIN@("H",N)) Q:N="" D VIBHB("H") I $G(VD)=0!$$VDZ(VD) D .S N="" F S N=$O(@KLIN@("TZ",N)) Q:N="" D VIBHB("TZ") Q ; VIBHB(CODDOC) ; N LK,LK0 S LK0=$G(^(N)) I CODDOC="H",VD=1,$$ARM(LK0) Q I CODDOC="H",VD=2,'$$ARM(LK0) Q S LK=$$LK(LK0) N SUGL S SUGL=$$SUGL^W4L(LK) I SUGL<$G(MESUGL) Q I $G(ADSUGL),SUGL>ADSUGL Q I $TR(LK,"-","")<$TR(MELKH,"-","") Q I $TR(LK,"-","")>$TR(ADLKH,"-","") Q D LINEINVC(N,LK,LK0,CODDOC) Q ; LINEINVC(N,LK,LK0,CODDOC) ; D ^W4HSBGET(N,CODDOC) Q:$D(W4HSB)<10 ; Q:'$G(W4HSB("TODATE")) ; I W4HSB("DT")DT2 Q ; I $G(%ARG("MESUM")),W4HSB("TOT")<%ARG("MESUM") Q I $G(%ARG("ADSUM")),W4HSB("TOT")>%ARG("ADSUM") Q ; I $G(%ARG("MENOM")),N<%ARG("MENOM") Q I $G(%ARG("ADNOM")),N>%ARG("ADNOM") Q ; S I=I+1 ; ;;I $$HBZ(CODDOC),'$D(W4HIPUS) D .S W4HSB("LMAM")=$G(W4HSB("LMAM"))*-1 .S W4HSB("TOT")=$G(W4HSB("TOT"))*-1 ; S DOP=0 I CODDOC="H",$D(@GLHB@(LK,N)) D .N J F J=2:1 Q:'$D(@GLHB@(LK,N,"HB",J)) D ..S DOP=DOP+$P(^(J),"\",3) S @TMPREP@("G",I)=N_$S($$HBZ(CODDOC):" [-]",1:"")_"\"_W4HSB("TODATE")_"\"_LK_"\"_$$LKH^W4L(LK) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_W4HSB("LMAM") S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_(W4HSB("TOT")-W4HSB("LMAM")) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_W4HSB("TOT") S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_DOP S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_$$TZ^W4L(LK) ; S SUMH=SUMH+1 S SLMAM=SLMAM+W4HSB("LMAM") S MAM=MAM+(W4HSB("TOT")-W4HSB("LMAM")) S SAH=SAH+W4HSB("TOT") S SDOP=SDOP+DOP S @TMPREP@("TOT")=$J(SUMH,1,1)_"\"_$J(SLMAM,1,1)_"\"_$J(MAM,1,1)_"\"_$J(SAH,1,1)_"\"_$J(SDOP,1,1)_"\" Q ; LK(LK0) N LK S LK=LK0 I LK0["+" S LK=$P(LK0,"+") I LK0["^" S LK=$P(LK0,"^") I LK0["W" S LK=$P(LK0,"W") Q LK ; ARM(LK0) ; I LK0'["+",LK0'["^",LK0'["W" Q 1 I LK0["W" Q 2 Q 0 ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DHB-CHKPRM","MESUGL=MESUGL&ADSUGL=ADSUGL&MELKH=MELKH &ADLKH=ADLKH & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MELKH>ADLKH Q "0;RANGENOTVALID;;MELKH" I MESUGL>ADSUGL Q "0;RANGENOTVALID;;MESUGL" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4DHB" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N LK S LK=$$LKG(A) N HB S HB=$$HBG(A) N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(+HB,CODDOCG) W " style=""cursor:pointer;color:black" ;;;font-size:"_$$^W3FSZ(11) W """" I $$HBZG(HB),LK0'["+" D .W " onClick=""ShowArmInvoice('"_+HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q I $$HBZG(HB),LK0["+" D .W " onClick=""ShowInvoice('"_-HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q ; I LK0,'$$ARM(LK0) W " onClick=""ShowInvoice('"_HB_"','"_LK_"','ifr')""" ; I $$ARM(LK0) D .I $$ARM(LK0)=1 W " onClick=""ShowArmInvoice('"_HB_"','"_LK_"','ifr')""" Q .I $$ARM(LK0)=2 W " onClick=""ShowItemsInvoice('"_HB_"','"_LK_"','ifr')""" Q Q ; TD ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N LK S LK=$$LKG(A) Q:LK="" N HB S HB=$$HBG(A) N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(HB,CODDOCG) W " style=""" ;;I (HB_";"_LK)=$$GET^%W1PRM("LHBCUR") W "border:solid 2px brown;" D .I $$HBZG(HB)=1 W "background-color:pink" Q .I $$HBZG(HB)=2 W "background-color:pink" Q .I $$ARM(LK0)=1 W "background-color:lightblue" Q .I $$ARM(LK0)=2 W "background-color:lightyellow" Q W """" Q ; LKG(A) ; Q $P(A,"\",3) ; HBG(A) ; Q $P(A,"\") ; LK0(HB,CODDOC) ; Q $G(@$$^W4GL("KLIN")@(CODDOC,HB)) ; CODDOC(STAM) ; I $$HBZ Q "TZ" Q "H" ; CODDOCG(HB) ; I $$HBZG(HB) Q "TZ" Q "H" ; HBZ(CODDOC) ; I CODDOC="TZ" Q 1 Q 0 ; HBZG(HB) ; I $G(HB)["[-]" Q $S($G(@$$^W4KLIN@("TZ",+HB))["W":2,1:1) Q 0 ; TMPREP S TMPREP=$$^W4MAIN("TMPREP") Q ; SORT ; D TMPREP N VRM S VRM=$$^W4MAIN("VRM") K @VRM N A,I,DT,HB F I=1:1 Q:'$D(@TMPREP@("G",I)) D .S A=$G(^(I)) .S DT=$$^%L1DC($P(A,"\",2),3) .S HB=$P(A,"\") .S @VRM@(DT,HB)=A ; K @TMPREP@("G") ; S I=0 S DT="" F S DT=$O(@VRM@(DT)) Q:DT="" D .S HB="" F S HB=$O(@VRM@(DT,HB)) Q:HB="" D ..S I=I+1,@TMPREP@("G",I)=$G(@VRM@(DT,HB)) ; K @VRM Q ; VDZ(VD) ; I $G(VD)=3 Q 1 Q 0 W4DHBN W4DHBN ; DOCH HESBONIOT [ 19.03.25 07:30 ] [ 09.10.18 12:36 ] [ 03.12.15 12:27 ] VD ; I VDKL'="H",VDKL'="TZ" S OK=0 Q I MEVD=3,ADVD=3,VDKL="H" S OK=0 Q I VDKL="TZ",ADVD'=0,ADVD<3 S OK=0 Q Q ; ; HB ; N LK0,LK S LK0=$G(@GLOB) I VDKL="H",MEVD=1,ADVD=1,$$ARM(LK0) S OK=0 Q I VDKL="H",MEVD=2,ADVD=2,'$$ARM(LK0) S OK=0 Q ; S LK=$$LK(LK0) I $TR(LK,"-","")<$TR(MELKH,"-","") S OK=0 Q I $TR(LK,"-","")>$TR(ADLKH,"-","") S OK=0 Q ; I $G(MEHB1),HBADHB1 S OK=0 Q ; D ^W4HSBGET(HB,VDKL) I '$G(W4HSB("TODATE")) S OK=0 Q ; I $G(W4HSB("DT"))ADTRH S OK=0 Q ; D .I VDKL="TZ" S VD=3 Q .I $$ARM(LK0) S VD=2 Q .I '$$ARM(LK0) S VD=1 ; I VDADVD) S OK=0 Q ; S VD1=$G(@$$^W4GL("W4VDHB")@(VD)) ; S SUGL=$$SUGL^W4L(LK) I SUGL<$G(MESUGL) S OK=0 Q I $G(ADSUGL),SUGL>ADSUGL S OK=0 Q ; S SUGL1="" I SUGL S SUGL1=$G(@$$^W4GL("SUGL")@(SUGL)) ; N GLHB S GLHB=$$^W4GL("P1LHB") S I=I+1 ; S DOP=0,OUT=0 I VDKL="H",$D(@GLHB@(LK,HB)) D .N J F J=2:1 Q:'$D(@GLHB@(LK,HB,"HB",J)) D ..S DOP=DOP+$P(^(J),"\",3) ; I VDKL="H",$D(@GLHB@(LK,HB)) D .N J F J=1:1 Q:'$D(@GLHB@(LK,HB,"HZ",J)) D ..N A S A=$G(^(J)) ..N DAT,DT,SHAA,MM ..S DAT=$P(A,"\",4),SHAA=$P(A,"\",5) ..S DAT=$TR(DAT,"/",".") ..S DT=$$^%L1DC(DAT,3) ..I SHAA<$$SHAAZ^W4PRM S DT=DT-1 ..S MM=$ZD(DT,"MM") ..I +MM'=+$P(W4HSB("TODATE"),".",2) D ...S OUT=OUT+$P(A,"\",6) ; S HB1=HB_$S($$HBZ(VDKL):" [-]",1:"") S TRH=$G(W4HSB("TODATE")) S LKH=LK S LKH1=$$LKH^W4L(LKH) S TZ=$$TZ^W4L(LK) S x1=$G(W4HSB("LMAM")) S x2=($G(W4HSB("TOT"))-$G(W4HSB("LMAM"))) S x3=$G(W4HSB("TOT")) S x4=DOP S x5=OUT ; Q ; ; LK(LK0) N LK S LK=LK0 I LK0["+" S LK=$P(LK0,"+") I LK0["^" S LK=$P(LK0,"^") I LK0["W" S LK=$P(LK0,"W") Q LK ; ARM(LK0) ; I LK0'["+",LK0'["^",LK0'["W" Q 1 I LK0["W" Q 2 Q 0 ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N LK S LK=$$LKG(A) N HB S HB=$$HBG(A) N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(+HB,CODDOCG) W " style=""cursor:pointer;color:black" ;;;font-size:"_$$^W3FSZ(11) W """" I $$HBZG(HB),LK0'["+" D .W " onClick=""ShowArmInvoice('"_+HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q I $$HBZG(HB),LK0["+" D .W " onClick=""ShowInvoice('"_-HB_"','"_LK_"','ifr','"_$$HBZG(HB)_"')""" Q ; I LK0,'$$ARM(LK0) W " onClick=""ShowInvoice('"_HB_"','"_LK_"','ifr')""" ; I $$ARM(LK0) D .I $$ARM(LK0)=1 W " onClick=""ShowArmInvoice('"_HB_"','"_LK_"','ifr')""" Q .I $$ARM(LK0)=2 W " onClick=""ShowItemsInvoice('"_HB_"','"_LK_"','ifr')""" Q Q ; ; TD ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N LK S LK=$$LKG(A) Q:LK="" N HB S HB=$$HBG(A) N CODDOCG S CODDOCG=$$CODDOCG(HB) N LK0 S LK0=$$LK0(HB,CODDOCG) W " style=""" ;;I (HB_";"_LK)=$$GET^%W1PRM("LHBCUR") W "border:solid 2px brown;" D .I $$HBZG(HB)=1 W "background-color:pink" Q .I $$HBZG(HB)=2 W "background-color:pink" Q .I $$ARM(LK0)=1 W "background-color:lightblue" Q .I $$ARM(LK0)=2 W "background-color:lightyellow" Q W """" Q ; ; LKG(A) ; Q $P(A,"*",3) ; HBG(A) ; Q $P(A,"*") ; LK0(HB,CODDOC) ; Q $G(@$$^W4GL("KLIN")@(CODDOC,HB)) ; CODDOC(STAM) ; I $$HBZ Q "TZ" Q "H" ; CODDOCG(HB) ; I $$HBZG(HB) Q "TZ" Q "H" ; HBZ(CODDOC) ; I CODDOC="TZ" Q 1 Q 0 ; HBZG(HB) ; I $G(HB)["[-]" Q $S($G(@$$^W4KLIN@("TZ",+HB))["W":2,1:1) Q 0 ; VDZ(VD) ; I $G(VD)=3 Q 1 Q 0 W4DHMK W4DHMK ; DOCH HESBONIOT [ 23.10.14 10:00 ] [ 12.09.13 07:15 ] [ 27.01.11 14:19 ] N (JB,%ARG,%REM) Q:$G(%ARG("SHOW"))=0 ;;D PUT^%W1PRM("VD","HMK") D ^W4IN D ^%W1ARG I '$G(MELKH) S MELKH="" I '$G(ADLKH) S ADLKH=99999999999 ; D GET ; S %SCRN=$$SCRN D PCPRM^W4DMANY(%SCRN) Q ; GET ; N KLIN S KLIN=$$^W4GL("KLIN") N CODDOC S CODDOC=$$CODDOC N TMPREP S TMPREP=$$^W4MAIN("TMPREP") K @TMPREP K @$$^W4MAIN("TMPREPB") ; S I=0 S (SUMHMK,SAH,SLMAM,SMAM)=0 ; S N="" F S N=$O(@KLIN@(CODDOC,N)) Q:N="" D .S LK=$$LK^W4STRING(CODDOC,N) .I $TR(LK,"-","")<$TR(MELKH,"-","") Q .I $TR(LK,"-","")>$TR(ADLKH,"-","") Q .D LINEHMK(N,LK) Q ; LINEHMK(N,LK) ; D ^W4HSBGET(N,"HMK") Q:$D(W4HSB)<10 ; Q:'$G(W4HSB("TODATE")) ; I $$^%L1DC(W4HSB("TODATE"),3)<$$^%L1DC(DAT1,3) Q I $$^%L1DC(W4HSB("TODATE"),3)>$$^%L1DC(DAT2,3) Q ; I $G(%ARG("MESUM")),W4HSB("TOT")<%ARG("MESUM") Q I $G(%ARG("ADSUM")),W4HSB("TOT")>%ARG("ADSUM") Q ; I $G(%ARG("MENOM")),N<%ARG("MENOM") Q I $G(%ARG("ADNOM")),N>%ARG("ADNOM") Q ; S I=I+1 S @TMPREP@("G",I)=N_"\"_W4HSB("TODATE")_"\"_LK_"\"_$$LKH^W4L(LK) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_$J(W4HSB("LMAM"),2,2)_"\"_$J(W4HSB("MAM"),2,2)_"\"_$J(W4HSB("TOT"),2,2) S SUMHMK=SUMHMK+1 S SLMAM=SLMAM+W4HSB("LMAM") S SMAM=SMAM+W4HSB("MAM") S SAH=SAH+W4HSB("TOT") Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DHMK-CHKPRM","MELKH=MELKH & ADLKH=ADLKH & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MELKH>ADLKH Q "0;RANGENOTVALID;;MELKH" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4DHMK" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N HMK S HMK=$$HMKG(A) W " style=""cursor:pointer;color:black;font-size:"_$$^W3FSZ(11) W """" N CODDOC S CODDOC=$$CODDOC N LK S LK=$$LK^W4STRING(CODDOC,HMK) W " onClick=""ShowArmInvoice('"_HMK_"HMK','"_LK_"','ifr')""" Q ; TD ; Q LKG(A) ; Q $P(A,"\",3) ; HMKG(A) ; Q $P(A,"\") ; CODDOC(STAM) Q "HMK" W4DHNH W4DHNH(DOCH) ; DOCH BITULIM & HANAHOT [ 12.01.25 08:35 ] [ 29.07.24 13:32 ] [ 01.01.24 17:18 ] ; METRH,ADTRH ; MLZRP ; MIUN ; CODP ; VHNHP 0 - KULAM, 1 - LELO HNH KV, 2 - RAK KV , 3 - 100% ;--------------------------------------------------------------------------- N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S %CLI=$C(27,91,55,109) S %LIGHT1=$C(27)_"[1m" S CLS=$C(27,91,48,109) ; S DOCH=$G(DOCH) S SIK=$G(%ARG("SIK")) I SIK="" S SIK=1 ; ;;ZWR %ARG S MESHAA=$G(%ARG("MESHAA")) S ADSHAA=$G(%ARG("ADSHAA")) S MESEC=MESHAA*3600+($P(MESHAA,":",2)*60) S ADSEC=ADSHAA*3600+($P(ADSHAA,":",2)*60) I MESEC!(ADSEC<(3600*$$SHAAZ^W4PRM)&ADSEC),MESEC<(3600*$$SHAAZ^W4PRM) S MESEC=MESEC+(24*3600) I ADSEC",! W " ",! W " ",! ; D .W " " .W " " ; W " " W " " W " " ; D ;I 'SIK D .W " " ; W " " ; W " ",! W " ",! W "
    " . W $$^%W1DICT("DETAILED") . W "" .W " "_$$^%W1DICT("CONCENTRATED") .W " " .W "  " D ROUNDBUT^%W1JS("print",$$^%W1DICT("PRINT"),"Print()","color:green","wh,22") W "  " . D ROUNDBUT^%W1JS("printCSR",$$^%W1DICT("PRINTCSR"),"PrintCSR()","color:green","wh,22") .W "  " D ROUNDBUT^%W1JS("backid",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") W "
    ",! W "",! W "
    " ; S METRH=$G(%ARG("MEDAT")) S ADTRH=$G(%ARG("ADDAT")) S MLZRP=$$DOP^W4NAME($G(%ARG("MLZR"))) S MIUN=$G(%ARG("MIUN")) S CODP=$G(%ARG("CODP")) ; S VHNHP=$G(%ARG("VHNHP")) ; S D1=$$^%L1DC(METRH,3) S D2=$$^%L1DC(ADTRH,3) ; S MLZRP=$G(MLZRP) I $G(CODP)="" S CODP=0 ; ZD ; ; ZM ; K @$$^W4MAIN("S111") S SH=0,MNLP="",MNL0="",HZM="" S (SSUMBIT,SSUMBITDM,SKAMBIT,SSUMHNH,SSUMHNHP,SKAMHNH,SKAMHNHP,SKAM0,SSUM0,SKAMRND,SHNHRND)=0 S (SUMBIT,SUMBITDM,KAMBIT,SUMHNH,SUMHNHP,KAMHNH,KAMHNHP,KAM0,SUM0)=0 ; W "
    ",! W "
    ",! W " ",! ; I '$$NOCSR S ST="" D S1 I '$$NOCSR S ST=ADTRH_" jix`z cr "_METRH_" jix`zn " D S1 S STW=$$H2U(" jix`zn ")_$$BOLD_METRH_$$EBOLD_$$H2U(" jix`z cr ")_$$BOLD_ADTRH_$$EBOLD D S1W ; S NMIUN=$S(MIUN=1:"zepnfd",MIUN=2:"micaer",1:"") I '$$NOCSR S ST=NMIUN_" itl oein" D S1 S STW=$$BOLD_$$H2U^%L1FRM(ST)_$$EBOLD D S1W ; I DOCH="H" D .I '$$NOCSR S ST=$$VHNHPNM(VHNHP) D S1 .S STW=$$BOLD_$$H2U^%L1FRM($$VHNHPNM(VHNHP))_$$EBOLD D S1W ; I '$$NOCSR S ST="" D S1 S STW="" D S1W ; K @$$^W4MAIN("VRM") N HZM1 S HZM1="" ;--------------------- VIBORKA -------------------------------- N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") S D=D1-1 F S D=$O(@$$^W4REF@(D)) Q:D="" Q:D>D2 D .I REPDAYS,'$E(REPDAYS,$$^%L1DC(D,8)) Q .S HZM="" F S HZM1=HZM,HZM=$O(@$$^W4REF@(D,HZM)) Q:HZM="" D ..Q:$$^W4HZMH(HZM) ..Q:$$I^W4PIZUL(HZM) ..I DOCH="H",$D(@$$^W4ORD@(HZM,"HNHP"))<10 D ...D ^W4HZHNHP(HZM) ..I DOCH="H" D ...N HNH2 S HNH2=$$HNH2^W4HZMST(HZM) Q:'HNH2 ...S SHNHRND=SHNHRND+HNH2 ...S SKAMRND=SKAMRND+1 ...D SUMHN(HNH2) ..; ..N HNH,HNHP,BIT,PRHNH ..D GETBITHN(HZM) ..I DOCH="B",'BIT Q ..I DOCH="B",$G(%ARG("ADSUM"))?."-"1N.E,$$TSHL^W4HZMST(HZM)>%ARG("ADSUM") Q ..I DOCH="B",$G(%ARG("MESUM"))?."-"1N.E,$$TSHL^W4HZMST(HZM)<%ARG("MESUM") Q ..I DOCH="H",'PRHNH,'HNHP Q .. ..I MIUN=1 D ; -- HAZMANOT ...I '$G(SORT) D ....S @$$^W4MAIN("VRM")@(HZM)="" ...I $G(SORT) D ....S HR=$$HRHN(HZM) S:HR="" HR=" " ....S @$$^W4MAIN("VRM")@(HR,HZM)="" .. .. ..I MIUN=2 D ; -- MELZARIM ...S MZ=$$^W4MLZR(HZM) ...S MKBL=MZ ... ...I BIT&(DOCH="B") D ....N N S N="" F S N=$O(@$$^W4ORD@(HZM,"BIT",N)) Q:N="" D .....S @$$^W4MAIN("VRM")@(MZ,HZM)="" ... ...I DOCH="H" D ....I MZ,MLZRP=""!(MLZRP=MZ) D .....I 'SORT S @$$^W4MAIN("VRM")@(MZ,HZM)="" .....I SORT D ......S HR=$$HRHN(HZM) S:HR="" HR=" " ......S @$$^W4MAIN("VRM")@(MZ,HR,HZM)="" ... ...I DOCH="0",MZ,MLZRP=""!(MLZRP=MZ) S @$$^W4MAIN("VRM")@(MZ,HZM)="" ; ;----------------------- HAZAGA ------------------------------ ; I MIUN=1 D ;----------- HAZMANOT ---------------- .S (SUMBIT,SUMBITDM,KAMBIT,SUMHNH,SUMHNHP,KAMHNH,KAMHNHP,KAM0,SUM0,QNHN,SUMHN,QNHNP,SUMHNP)=0 K NOPC S:SIK NOPC=1 .; .I SIK W "",! .; .I '$$NOCSR S ST=" "_$TR($J("",37)," ","-") D S1 .S STW="
    " D S1W . .K NOPC D PCSUM ; ; I MIUN=2 S MLZ="" D ;-------------- MELZARIM .F S MLZ=$O(@$$^W4MAIN("VRM")@(MLZ)) Q:MLZ="" D ..K NOPC ..I '$$NOCSR S ST="" D S1 S ST=%CLI_$$NAME(MLZ)_CLS_" : caer" D S1 ..S STW="" D S1W ..S STW=$$H2U(" : caer")_" "_$$H2U($$NAME(MLZ))_$$EBOLD D S1W S STW=" " D S1W ..I SIK S NOPC=1 W "",! ..I '$$NOCSR S ST=" "_$TR($J("",37)," ","=") D S1 ..S STW="
    " D S1W ..K NOPC I SIK S STW="" D S1W ..I '$$NOCSR S ST=$J("",14)_%CLI_$J($$NAME(MLZ),12)_CLS_" caerl k""dq" D S1 ..S STW=$$H2U(" caerl k""dq")_" "_$$BOLD_$$H2U($$NAME(MLZ))_$$EBOLD D S1W ..D PCSUM ..I '$$NOCSR S ST="" D S1 ..S STW=" " D S1W S STW="
    " D S1W ; D SHOW ; W "
    ",! . .I '$G(SORT) D ..N HZM S HZM="" F S HZM=$O(@$$^W4MAIN("VRM")@(HZM)) Q:HZM="" D PCBHZ(HZM) . .I $G(SORT) D ..N HR,HZ ..S HR="" F S HR=$O(@$$^W4MAIN("VRM")@(HR)) Q:HR="" D D SUM ...S QNHN=0,SUMHN=0 ...S QNHNP=0,SUMHNP=0 ...S HZ="" F S HZ=$O(@$$^W4MAIN("VRM")@(HR,HZ)) Q:HZ="" D PCBHZ(HZ) . .I SIK W "
    ",! ..S (SUMBIT,SUMBITDM,KAMBIT,SUMHNH,SUMHNHP,KAMHNH,KAMHNHP,KAM0,SUM0,QNHN,SUMHN,QNHNP,SUMHNP)=0 ..I '$G(SORT) S HZM="" F S HZM=$O(@$$^W4MAIN("VRM")@(MLZ,HZM)) Q:HZM="" D PCBHZ(HZM) ..I $G(SORT) D ...N HR S HR="" F S HR=$O(@$$^W4MAIN("VRM")@(MLZ,HR)) Q:HR="" D D SUM ....S QNHN=0,SUMHN=0 ....S QNHNP=0,SUMHNP=0 ....S HZM="" F S HZM=$O(@$$^W4MAIN("VRM")@(MLZ,HR,HZM)) Q:HZM="" D PCBHZ(HZM) ..I SIK W "
    ",! W "
    ",! ; K @$$^W4MAIN("VRM") Q ; ; HDORD ; S HDORD=$$H2U(" : dpnfd")_" "_$$BOLD("green")_HZM_$$EBOLD Q ; USL(HZM,MLZRP,N) N MZ S MZ=$$WHODEL^W4HZMST(HZM,N) I MZ,MLZRP=""!(MLZRP=MZ) Q 1 Q 0 ; ; SUMST(ST) ; Q $P(ST,"\",7) ; HR(ST) ; Q $P(ST,"\",8) ; ; PCBHZ(HZM) ; N $ZT S $ZT="ZG "_$ZL_":SVER^%L1X" N (JB,%ARG,%REM,DOCH,HZM,SH,CLS,MIUN,SIK,MLZ,SUMHNH,SUMHNHP,SSUMHNHP,SKAMHNHP,KAMHNH,KAMHNHP,SKAM0,SSUM0,SUMBIT,SUMBITDM,KAMBIT,KAM0,SUM0,NOPC,MNLP,MLZRP,OK,PRNT,%MDP,PRINT,P1B,CODP,VHNHP,QNHN,SUMHN,QNHNP,SUMHNP,MESEC,ADSEC,SHNHRND,SKAMRND,MAIL) S OK=0,FIRSTLINE=1 S %CLI=$C(27,91,55,109) S %LIGHT1=$C(27)_"[1m" ; N HZMDEL S HZMDEL=$$^W4DEL(HZM) I DOCH="B",$$SHIHZUR(HZM)!(HZMDEL'=HZM&HZMDEL) Q I DOCH="B",$$^W4HZMH(HZM) Q I DOCH="B",$$I^W4PIZUL(HZM) Q ; D GETBITHN(HZM) ; ; ---- VYBORKA ( VHNHP=1 - LELO HNH KV, 2 - RAK KV , 3 - 100% ) S OK=0 I DOCH="H",VHNHP D Q:'OK .S HNHP1=0,HNHP2=0,HNH=$$HNH^W4HZMST(HZM) . .N I F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D ..S ST=$G(^(I)) Q:ST="" ..S HR=$$HR(ST) ..Q:$P(ST,"\")'["%" Q:$E(ST)'="-" ..I VHNHP=3,$P(ST,"\")'="-100%" Q ..I $$HNHSHAA(ST) S HNHP2=HNHP2+$$SUMST(ST) ..S HNHP1=HNHP1+$$SUMST(ST) ; -- LO KAVUA . .I VHNHP=1!(VHNHP=3),HNHP1!(HNH'<1) S OK=1 Q .I VHNHP=2,HNHP2 S OK=1 Q ; I DOCH="0" D Q:'OK .S OK=0 F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) I $P($G(^(I)),"\")=CODP S OK=1 Q ; ; ---------------------- KOTERET ---------------------------- ;;D KOTHZ(HZM) ; ;----------- HAZAGAT BITULIM -------------- ; S BITHZ=0 I DOCH="B",$D(@$$^W4ORD@(HZM,"BIT")) D PCBIT(HZM) ; ;----------- HAZAGAT HANAHOT ------------------- ; I DOCH="H" D PCHNH(HZM) ; I DOCH="0" D .N J S J=0,KAMHZ0=0,SUMHZ0=0 .F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) I $P($G(^(I)),"\")=CODP D ..S J=J+1 D PCBHZ1(HZM,J=1,I,"") .S STW=STW_$$EMPTYTBLINE .S STW=STW_""_$$TDLINE_$$H2U(" : dpnfda ""0"" hixt zexikn")_" "_$$BOLDRED_$J(SUMHZ0,7,2)_$$EBOLD_"" .S STW=STW_"" D S1W ; ; I SIK D ; --------------------------- DOH MERUKAZ .N NOPC .N SUMHZ S SUMHZ="" . .D HDORD . .I DOCH="H" D Q ..I '$$NOCSR S ST=$J(HNH,6,2)_":zeillk zegpd "_$J(HNHP,6,2)_":hixtl zegpd" D S1 ..S STW="" ..S STW=STW_""_HDORD_"" ..S STW=STW_"  "_$$H2U(" : mihixtl zegpd")_"" ..S STW=STW_" "_$$BOLDRED_$J(HNHP,2,2)_$$EBOLD_"" ..S STW=STW_"  "_$$H2U(" : zeillk zegpd")_"" ..S STW=STW_" "_$$BOLDRED_$J(HNH,2,2)_$$EBOLD_"" ..S HRHN=$$HRHN(HZM) ..I HRHN="" S HRHN=" " ..S STW=STW_"  "_$$H2U(" : zexrd")_"" ..S STW=STW_" "_$$BOLDRED_HRHN_$$EBOLD_"" ..S STW=STW_"" W STW,! . .I DOCH="B" S SUMHZ=HDORD_$$SPACE_$$BOLDRED_$J(-BITHZ,2,2)_$$EBOLD D ..I '$$NOCSR S ST=%CLI_$J(-BITHZ,7,2)_CLS_" : "_HZM_" : dpnfd" D S1 . .I DOCH="0" D ..N DOP S DOP=" dir=""LTR"" " I SUMHZ0<0 S DOP=DOP_"color=""red"" " ..S SUMHZ=HDORD_$$SPACE_$$BOLD_$J(SUMHZ0,2,2)_$$EBOLD ..I '$$NOCSR S ST=%CLI_$J(SUMHZ0,7,2)_CLS_" : "_HZM_" : dpnfd" D S1 . .S STW="" .S STW=STW_""_SUMHZ_"" .W STW,! Q ; ; S1 Q:$D(NOPC) S SH=SH+1 S @$$^W4MAIN("S111")@(SH)=ST Q ; S1W ; Q:$D(NOPC) W "" W "" W STW_"" W "",! Q ; SHIHZUR(HZM) ; N B S B=$P($G(@$$^W4ORD@(HZM,"HR2")),"\\",2) S B=$$U2H^%L1FRM(B) I $E(B,$L(B))=">" Q 1 Q 0 ; ; PCSUM ;--- SAH HANAHOT BE AZMANA W "
    ",! I DOCH="B" D .I '$$NOCSR S ST=" "_%LIGHT1_$J(-SUMBIT,7,2)_" : mekq "_$J(KAMBIT,3)_" : milehia zenk"_CLS D S1 .S STW=$$H2U(" : milehia zenk")_" "_$$BOLDRED_KAMBIT_$$EBOLD_$$SPACE_$$H2U(" : mekq ")_" "_$$BOLDRED_$J(-SUMBIT,7,2)_$$EBOLD .S STW=STW_$$NBSP^%L1FRM(5)_$$H2U("gelyn inc ilehia")_" "_$$BOLDRED_$J(-SUMBITDM,2,2)_$$EBOLD .S STW=STW_$$NBSP^%L1FRM(5)_$$H2U("llek milehia")_" "_$$BOLDRED_$J(-SUMBIT-SUMBITDM,2,2)_$$EBOLD .D S1W ; I DOCH="H" D .I '$$NOCSR S ST=" "_%LIGHT1_$J(SUMHNHP,7,2)_" mekqa "_KAMHNHP_" : mihixtl zegpd "_CLS D S1 .S STW=$$BOLD_"     "_$$H2U(" : mihixtl zegpd")_$$EBOLD .S STW=STW_" "_$$BOLDRED_KAMHNHP_$$EBOLD_" "_$$SPACE_$$H2U(" : mekqa ")_" "_$$BOLDRED .S STW=STW_$J(SUMHNHP,7,2)_$$EBOLD D S1W . .I $G(VHNHP)'=3 D ..I '$$NOCSR S ST=" "_%LIGHT1_$J(SUMHNH,7,2)_" : mekqa "_$J(KAMHNH,3)_" : zeillk zegpd zenk"_CLS D S1 ..S STW=$$BOLD_$$H2U(" : zeillk zegpd zenk")_$$EBOLD_" "_$$BOLDRED_KAMHNH_$$EBOLD_$$SPACE_$$BOLD_$$H2U(" : mekqa ")_$$EBOLD_$$BOLDRED_$J(SUMHNH,7,2)_$$EBOLD D S1W ; I DOCH="0" D .I '$$NOCSR S ST=" "_%LIGHT1_$J(SUM0,7,2)_" : mekq "_$J(KAM0,3)_" : zexikn zenk"_CLS D S1 .S STW=$$H2U(" : zexikn zenk")_" "_$$BOLDRED_KAM0_$$EBOLD_$$SPACE_$$H2U(" : mekqa ")_" "_$$BOLDRED_$J(SUM0,7,2)_$$EBOLD D S1W ; S SSUMBIT=SSUMBIT+SUMBIT,SKAMBIT=SKAMBIT+KAMBIT S SSUMBITDM=SSUMBITDM+SUMBITDM S SSUM0=SSUM0+SUM0,SKAM0=SKAM0+KAM0 S SSUMHNH=SSUMHNH+SUMHNH,SKAMHNH=SKAMHNH+KAMHNH S SSUMHNHP=SSUMHNHP+SUMHNHP,SKAMHNHP=SKAMHNHP+KAMHNHP Q ; ; KOTHZ(HZM) ; D ^W4HZGT(HZM) S MKBL=$$^W4MLZR(HZM) S MLZR1="" I MKBL S MLZR1=$$NAME(MKBL) ; I '$$NOCSR S ST=$TR($J("",37)," ","-") D S1 S STW="
    " D S1W ; I '$$NOCSR S ST=$S('$G(@$$^W4PRM@("MLZ")):$$HBR^%L1FRM(MLZR1,10)_" :caer ",1:$J("",20))_%CLI_$J(HZM,5)_CLS_" :dpnfd" D S1 S STW=$$H2U(" : caer")_" "_$$BOLD_$$H2U(MLZR1)_$$EBOLD D S1W ; S STW="" D HDORD ; I 'SIK D .S STW=STW_""_HDORD_"" .W STW,! ; I $$^W4MSD(NMB) D .I '$$NOCSR S ST=$J(NMB,3)_" : ogley" D S1 .S STW=$$H2U(" : ogley")_" "_$$BOLD_$J(NMB,3)_$$EBOLD D S1W .I '$$NOCSR S ST=$J("",20)_$J(TSHL,7,2)_":oeayg k''dq" D S1 .S STW=$$H2U(":oeayg k''dq")_" "_$$BOLD_$J(TSHL,7,2)_$$EBOLD D S1W ; I $$^W4MSL(NMB) D .I '$$NOCSR S ST=$J("",32)_"gelyn" D S1 .S STW=$$BOLD_$$H2U("gelyn")_$$EBOLD D S1W .I '$$NOCSR S ST=$J("",2)_$J(TSHL,7,2)_":oeayg k''dq " D S1 .S STW=$$H2U(":oeayg k''dq")_" "_$$BOLD_$J(TSHL,7,2)_$$EBOLD D S1W . .I '$$NOCSR S ST=$$HBR^%L1FRM($$LKH^W4L(NMB),21)_" "_%CLI_$J(NMB,7)_CLS D S1 .S STW=$$H2U(" : gewl")_" "_$$BOLD_NMB_" "_$$H2U($$LKH^W4L(NMB)) D S1W ; I '$$NOCSR S ST=$J("",5)_$J(ZMANK,15)_" : dpnfd zlaw onf" D S1 S STW=$$H2U(" : dpnfd zlaw onf")_" "_$J(ZMANK,15) D S1W ; I $$^W4MSL($G(LKHN)),$$^W4MSD(NMB) D .I '$$NOCSR S ST=$$HBR^%L1FRM($$LKH^W4L(LKHN),21)_" "_%CLI_LKHN_CLS_" : gewl" D S1 .S STW=$$H2U(" : gewl")_" "_$$BOLD_LKHN_" "_$$H2U($$LKH^W4L(LKHN))_$$EBOLD D S1W ; S HRA2=$P($G(@$$^W4ORD@(HZM,"HR2")),"\\") S HRA2=$$U2H^%L1FRM(HRA2) I HRA2'="" D .I '$$NOCSR S ST=%CLI_HRA2_CLS D S1 Q ; ; PCBIT(HZM) ; N N,I,PRHD S N="",STW="",PRHD=1,BITHZ=0 ; I $$^W4HZMH(HZM) Q I $$I^W4PIZUL(HZM) Q ; F I=1:1 S N=$O(@$$^W4ORD@(HZM,"BIT",N)) Q:N="" D .N OKV S OKV=1 .I MESEC!ADSEC D ..I MESEC=0,ADSEC=(24*3600) Q ..S SEC=$P($P($G(^(N)),"*",5),",",2) ..S:SEC<(3600*$$SHAAZ^W4PRM) SEC=SEC+(24*3600) ..I SECADSEC) S OKV=0 .Q:'OKV .I $$AVAR(HZM,+N) Q .S WHODEL=$$WHODEL^W4HZMST(HZM,N) .I WHODEL="" S WHODEL=MKBL .I MIUN=2 D PCBHZ1(HZM,PRHD,N,WHODEL) S PRHD=0 Q .;;W "MESEC="_MESEC_" ADSEC="_ADSEC,! .D PCBHZ1(HZM,PRHD,N,WHODEL) S PRHD=0 Q ; I '$$NOCSR,BITHZ D .S ST=" "_%CLI_$J(-BITHZ,7,2)_CLS_" : dpnfda milehia" D S1 I 'PRHD,$L(STW) S STW=STW_"" D S1W ;;S STW=" " D S1W ; I BITHZ D .S STW=$$H2U(" : dpnfda mihixt ilehia")_" "_$$BOLDRED_$J(-BITHZ,7,2)_$$EBOLD .N TS S TS=$$TSHL^W4HZMST(HZM) .I TS<0 D ..N DM S DM=$$DMSH^W4HZMST(HZM) Q:DM'<0 ..S STW=STW_$$NBSP^%L1FRM(5)_$$H2U("gelyn inc ilehia")_" "_$$BOLDRED_$J(-DM,2,2)_$$EBOLD ..S STW=STW_$$NBSP^%L1FRM(5)_$$H2U("llek milehia")_" "_$$BOLDRED_$J(-BITHZ-DM,2,2)_$$EBOLD ..S SUMBITDM=SUMBITDM+DM .D S1W Q ; ; PCHNH(HZM) ; I FIRSTLINE D KOTHZ(HZM) S FIRSTLINE=0 I '$$NOCSR S ST="" D S1 S STW="" D S1W S HNHHZ=0 N MLZL S MLZL=$$^W4MLZR(HZM) I '$$NOCSR S ST="" D S1 S STW="" D S1W I MLZL D .I '$$NOCSR S ST=%CLI_$J($$^W4NAME(MLZL),8)_" "_MLZL_CLS_" : caer" D S1 .S STW=$$H2U(" : caer")_" "_$$BOLD_MLZL_" "_$$H2U($$^W4NAME(MLZL))_$$EBOLD D S1W ; ;;I HNHP D PCHNHP(HZM) ;------------------- HANAHOT PRITIM I $D(@$$^W4ORD@(HZM,"HNHP"))>9 D PCHNHP(HZM) ; I '$$NOCSR D .S ST="" D S1 .S ST=%LIGHT1_$J("",10)_$J(HNHP,6,2)_" : dpnfda mihixtl zegpd "_CLS D S1 .S ST="" D S1 ; S STW="" S STW=STW_"" S STW=STW_"" ; I VHNHP'=3,$$HNHA^W4HZMST(HZM) D .N GLH,ISHER S GLH=$$^W4ORD_"(HZM,""HNH"")" .N SIBA1 S SIBA1=$P($G(@GLH),"*",4) .S ISHER="" . .N WHO S WHO=$P($G(@GLH),"*",2) .I WHO D ..S ISHER=$J($$^W4NAME(WHO)_" : xyi`",38) . .N HNHA S HNHA=$$HNHA^W4HZMST(HZM) .I HNHA D PCHNHA(HZM) ; D PCHNHASR(HZM) ; D PCHNH1(HZM) ; S HNHHZ=HNHP+HNH S STW=STW_"
    "_$$BOLD_$$H2U(" : dpnfda mihixtl zegpd")_$$EBOLD_""_$$BOLDRED_$J(HNHP,6,2)_$$EBOLD_"
    " D S1W Q ; ; PCHNHP(HZM) ; N N,I,ST,ST0,ST00,ST1,ST2,J,JJ,PRHD N GL S GL=$$^W4ORD_"(HZM,""HNHP"")" ; S HNHP=0 S N="",PRHD=1 ; D M2 ; F I=1:1 S N=$O(@GL@(N)) Q:N="" I N D .S ST00=$G(^(N)) .S ST0=$G(@$$^W4ORD@(HZM,N)) .S ST1=$G(@$$^W4ORD@(HZM,N+1)) .I VHNHP=1,$$HNHSHAA(ST0) Q .I VHNHP=2,'$$HNHSHAA(ST0) Q .I VHNHP=3,+$$SPA^%L1FRM($P(ST0,"\",6))'=100 Q . .I PRHD D S PRHD=0 ..I '$$NOCSR S ST="" D S1 S ST=$P($T(M2),";",2) D S1 ..S STW="" D S1W ..S STW="" ..S JJ="" F S JJ=$O(M21(JJ),-1) Q:JJ="" D ...S STW=STW_"" ..S STW=STW_"" . .S J=0,ST="",STW=STW_"",A="" .S ST2=N_"\"_$P(ST0,"\",3)_"\"_$P(ST1,"\",5)_"\"_$P(ST0,"\",7)_"\"_-$P(ST1,"\")_"\"_-$P(ST1,"\",7) .F I1=1:1:6 D ..S RKV=$$CNWEB^%L1FRM($P(ST2,"\",I1)) ..S J=J+1 S ST=ST_$J(RKV,M2(J))_" " ..D STYLE(RKV,M2T(J)) ..S A=A_"" .S STW=STW_A . .S HNHP=HNHP+$$SUMST(ST0) .I '$$NOCSR S ST=$E(ST,1,$L(ST)-1) D S1 .S STW=STW_"" .S KAMHNHP=KAMHNHP+1 .S QNHNP=$G(QNHNP)+1 .S SUMHNHP=SUMHNHP+$$SUMST(ST0) .S SUMHNP=$G(SUMHNP)+$$SUMST(ST0) . .;;DHRP . .N GLH S GLH=$$^W4ORD_"(HZM,""HNH"")" .N WHO S WHO=$P($G(@GLH@(N)),"*",2) .N SIBA1 S SIBA1=$P($G(@GLH@(N)),"*",4) . .I WHO D ..N ISHER S ISHER=$$^W4NAME(WHO)_" : xyi`" ..I '$$NOCSR S ST=$J(ISHER,38) D S1 ; -- HEARA ..I '$$NOCSR S ST=$J(SIBA1_" : daiq",38) D S1 ; -- HEARA .. ..S STW=STW_"" ..S STW=STW_"" ..S STW=STW_"" . I 'PRHD S STW=STW_$$EMPTYTBLINE_"
    "_$$H2U(M21(JJ))_"
    "_$$H2U(RKV)_"
     " ..S STW=STW_$$BOLD("green")_$$H2U(SIBA1)_$$EBOLD_""_$$BOLD_$$H2U(ISHER)_$$EBOLD_"
    " D S1W Q ; ; PCHNHA(HZM) ; N ST I '$$NOCSR D .S ST=$J("",$S(HNHAH:6,1:15))_%LIGHT1_$J(HNHA,7,2)_$S(HNHAH:" = "_$J(HNHAH,5,2)_"%",1:"")_" : %-a dgpd "_CLS D S1 .S ST="" D S1 .I ISHER'="" S ST=ISHER D S1 .I SIBA1'="" S ST=SIBA1 D S1 ; S STW=STW_""_$$BOLD_$$H2U(" dgpd")_$$EBOLD S STW=STW_" = % "_$J(HNHAH,5,2)_$$EBOLD_"" S STW=STW_""_$$BOLDRED_$J(HNHA,7,2)_$$EBOLD_"" ; N GLH S GLH=$$^W4ORD_"(HZM,""HNH"")" ; I ISHER'=""!(SIBA1'="") D .S STW=STW_""_$$BOLD("green")_$$H2U(SIBA1)_$$EBOLD_"" .S STW=STW_$$TDLINE_$$BOLD_$$H2U(ISHER)_$$EBOLD_"" ; I ISHER="",SIBA1="" D .S STW=STW_"  " ; S STW=STW_"" ; D SUMHN(HNHA) Q ; ; PCHNHASR(HZM) ; N LK,LK1 N J,HN,HR F J=1:1 Q:'$D(@$$^W4ORD@(HZM,"CB","ASR",J)) D .N A S A=$G(^(J)) .S HN=$J($P(A,"*",3),2,2) Q:'HN .D SUMHN(HN) . .S LK=$$H2U($P(A,"*",12))_" "_$P(A,"*") .S LK1=$P(A,"*",12)_" "_$P(A,"*") . .S STW=STW_""_$$BOLD_$$H2U(" : "_LK_" gewll dgpd")_$$EBOLD_" " .S STW=STW_""_$$BOLDRED_HN_$$EBOLD_" " . .I '$$NOCSR S ST=": "_LK1_" gewll dgpd" D S1 .S ST=$J(HN,7,2) D S1 Q ; ; PCHNH1(HZM) ; N J,HN,HR,HR1 F J="" F S J=$O(@$$^W4ORD@(HZM,"CB","HNH1",J)) Q:J="" I J D .N A S A=$G(^(J)) .S HN=$J($P(A,"*"),2,2) .D SUMHN(HN) .Q:HN<.5&(HN>-.5) .S HR=$$H2U($P(A,"*",5)) .S HR1=$P(A,"*",5) . .S STW=STW_""_$$BOLD_$$H2U(" : g""ya dgpd")_$$EBOLD_"" .S STW=STW_""_$$BOLDRED_HN_$$EBOLD_"" .S STW=STW_""_$$BOLD("green")_HR_$$EBOLD_"" . .S ISHER="" .N WHO S WHO=$P(A,"*",3) .I WHO D ..S ISHER=$J($$^W4NAME(WHO)_" : xyi`",38) .I ISHER'="" D ..S STW=STW_$$TDLINE_$$BOLD_$$H2U(ISHER)_$$EBOLD_"" .I ISHER="" D ..S STW=STW_" " .S STW=STW_"" .I '$$NOCSR D ..S ST=$J(HR1,22)_$J(HN,7,2)_" g""ya dgpd" D S1 ..I ISHER'="" S ST=ISHER D S1 Q ; ; SHOW ; I DOCH="B",+SSUMBIT'=SUMBIT D .I '$$NOCSR S ST=%CLI_$J(-SSUMBIT,7,2)_CLS_" mekqa milehia "_%CLI_SKAMBIT_CLS_" k""dq" D S1 .S STW=$$BOLD_$$H2U(" k""dq")_$$EBOLD_" "_$$BOLDRED_SKAMBIT_$$EBOLD_" "_$$BOLD_$$H2U(" mekqa mihixt ilehia ")_$$EBOLD_$$BOLDRED_$J(-SSUMBIT,7,2)_$$EBOLD .I $G(SSUMBITDM) S STW=STW_$$NBSP^%L1FRM(5)_$$BOLD_$$H2U(" gelyn inc ilehia k""dq ")_$$EBOLD_$$BOLDRED_$J(-SSUMBITDM,2,2)_$$EBOLD_$$NBSP^%L1FRM(5)_$$BOLD_$$H2U(" llek milehia ")_$$EBOLD_" "_$$BOLDRED_$J(-SSUMBIT-SSUMBITDM,7,2)_$$EBOLD .D S1W ; I DOCH="H",+SSUMHNH'=+SUMHNH,VHNHP'=3 D .I '$$NOCSR S ST=%CLI_$J(SSUMHNH,7,2)_CLS_" : mekqa zeillk zegpd "_%CLI_SKAMHNH_CLS_" k""dq" D S1 .S STW=$$BOLD_$$H2U(" k""dq")_$$EBOLD_" "_$$BOLDRED_SKAMHNH_$$EBOLD_" "_$$BOLD_$$H2U(" mekqa zeillk zegpd ")_$$EBOLD_" "_$$BOLDRED_$J(SSUMHNH,7,2)_$$EBOLD D S1W ; I DOCH="H" D .I '$$NOCSR S ST=%CLI_$J(SHNHRND,7,2)_CLS_" mekqa milebir zegpd "_%CLI_SKAMRND_CLS_" k""dq" D S1 .S STW=$$BOLD_$$H2U(" k""dq")_$$EBOLD_" "_$$BOLDRED_SKAMRND_$$EBOLD_" "_$$BOLD_$$NBSP^%L1FRM(4)_$$H2U(" mekqa milebir zegpd ")_$$EBOLD_" "_$$BOLDRED_$J(SHNHRND,7,2)_$$EBOLD D S1W .I '$$NOCSR S ST=%CLI_$J(SSUMHNH+SHNHRND,7,2)_CLS_" mekqa milebir llek zegpd "_CLS_" k""dq" D S1 .S STW=$$BOLD_$$H2U(" : mekqa milebir llek zeillk zegpd ")_$$EBOLD_" "_$$BOLDRED_$J(SSUMHNH+SHNHRND,7,2)_$$EBOLD D S1W ; I DOCH="H",+SSUMHNHP'=+SUMHNHP D .I '$$NOCSR S ST=%CLI_$J(SSUMHNHP,7,2)_CLS_" mekqa mihixtl zegpd "_%CLI_SKAMHNHP_CLS_" k""dq" D S1 .S STW=$$BOLD_$$H2U(" k""dq")_$$EBOLD_" "_$$BOLDRED_SKAMHNHP_$$EBOLD_" "_$$BOLD_$$H2U(" mekqa mihixtl zegpd ")_$$EBOLD_" "_$$BOLDRED_$J(SSUMHNHP,7,2)_$$EBOLD D S1W ; I DOCH="0",SSUM0'=SUM0 D .I '$$NOCSR S ST=%CLI_$J(SSUM0,7,2)_CLS_" mekqa mihixt "_%CLI_SKAM0_CLS_" xknp k""dq" D S1 .S STW=$$BOLD_$$H2U(" xknp k""dq")_$$EBOLD_" "_$$BOLDRED_SKAM0_$$EBOLD_" "_$$BOLD_$$H2U(" mekqa mihixt ")_$$EBOLD_" "_$$BOLDRED_$J(SSUM0,7,2)_$$EBOLD D S1W ; ES ;;K @$$^W4MAIN("S111") Q ; ; PC S TXT=$$CLST^%L1FRM(TXT,%MDP("B"),%MDP("N")) S:$D(TXT("R")) TXT=%MDP("R")_TXT_%MDP("RL") N PCN S PCN=$ZP(@$$^W4PC@(PRINT,999999))+1 I '$D(TS0)!'$D(TSS) D ^%L1TS S @$$^W4PC@(PRINT,PCN)=$TR(TXT,TS0,TSS) K TXT Q ; M1 ; dry : mekq :zenk: hixt xe`z : cew ; ; E : N : N : H : E ; S T=$P($T(M1),";",2) S T1=$P($T(M1+1),";",2) K M N J F J=1:1:$L(T,":") S M(J)=$L($P(T,":",J)) K M1 F J=1:1:$L(T,":") S M1(J)=$P(T,":",J) K M1T F J=1:1:$L(T1,":") S M1T(J)=$TR($P(T1,":",J)," ","") Q ; M2 ; dgpd : %: mekq :zenk: hixt xe`z :'ey; ; N : N: N : N : H : E ; S T=$P($T(M2),";",2) S T1=$P($T(M2+1),";",2) K M2 N J F J=1:1:$L(T,":") S M2(J)=$L($P(T,":",J)) F J=1:1:$L(T,":") S M21(J)=$P(T,":",J) K M2T F J=1:1:$L(T1,":") S M2T(J)=$TR($P(T1,":",J)," ","") Q ; NAME(CODOV) ; S NAME=$$^W4NAME(CODOV) Q NAME ; ; PCBHZ1(HZM,FIRST,N,WHODEL) ; ;--------------------------- ; dpnfda milehia zexey zbvd ;--------------------------- Q:DOCH'="B"&(DOCH'="0") I $G(HZM)<1 Q N ST,ST0,J,I1,M S ST0="" I $G(FIRSTLINE) D KOTHZ(HZM) S FIRSTLINE=0 D M1 S ST="" ; I FIRST D .I '$$NOCSR D S1 S ST=$P($T(M1),";",2) D S1 .S STW="" .S STW=STW_"" D ..N JJ S JJ="" F S JJ=$O(M1(JJ),-1) Q:JJ="" D ...S STW=STW_"" .S STW=STW_"" ; ; I N'["-" D .S ST0=$G(@$$^W4ORD@(HZM,N)) .N TSF S TSF=$P(ST0,"\",6) .N SUM S SUM=$P(ST0,"\",7) .;;S $P(ST0,"\",6)="" .;;S $P(ST0,"\",7)=$P(ST0,"\",7)-TSF ; --> COMMENT 04/05/21 ; I N["-" D .N A .I $L(N,"-")=2 D Q ..S A=$G(@$$^W4ORD@(HZM,+$P(N,"-"),+$P(N,"-",2))) Q ..S ST0=+$P(N,"-",2)_"\\"_$P(A,"\")_"\"_$P(A,"\",2)_"\"_$P(A,"\",3)_"\\"_($P(A,"\",2)*$P(A,"\",3))_"\"_$P(A,"\",4) Q . .S A=$G(@$$^W4ORD@(HZM,+$P(N,"-"),+$P(N,"-",2),+$P(N,"-",3))) .I $P(A,"\") D Q ..S ST0=$P(A,"\")_"\\"_$P(A,"\",2)_"\"_$P(A,"\",7)_"\"_$P(A,"\",3)_"\\"_($P(A,"\",7)*$P(A,"\",3))_"\"_$P(A,"\",6) . .S ST0=$P(A,"\",4)_"\\"_$P(A,"\",5)_"\"_$P(A,"\",7)_"\"_$P(A,"\",3)_"\\"_($P(A,"\",7)*$P(A,"\",3))_"\"_$P(A,"\",6) ; S J=0,ST="",A="" F I1=7,5,3,1 D ; --- SHURAT HAZMANA .S J=J+1 .N RKV S RKV=$$CNWEB^%L1FRM($P(ST0,"\",I1)) .S ST=ST_$S(I1=7:$J(RKV,M(J),2),1:$J(RKV,M(J)))_" " .D STYLE(RKV,M1T(J)) .S A=""_A ; N TIM S TIM=" " I N'["-" D .N BIT S BIT=$G(@$$^W4ORD@(HZM,"BIT",N)) .S TIM=$$T^%L1TIME($P($P(BIT,"*",5),",",2)) S A=A_"" S ST=TIM_" "_ST I '$$NOCSR S ST=%LIGHT1_$E(ST,1,$L(ST)-1)_CLS D S1 S STW=STW_""_A_"" ; N STBIT S STBIT=$G(@$$^W4ORD@(HZM,"BIT",N)) ; N HRP S HRP=$P(STBIT,"*",4) ; I $L(HRP) D .I '$$NOCSR S ST=$J(HRP,20) D S1 .;;S STW=STW_""_$$TDLINE_$$BOLD_$$H2U(HRP)_$$EBOLD_"" ; I $$EX2KITCH^W4HZMST(HZM,N) D .I '$$NOCSR S ST=%CLI_"gahndn `vi hixt"_CLS D S1 .;;S STW=STW_""_$$TDLINE_$$BOLDRED_$$H2U("gahndn `vi hixt")_$$EBOLD_"" .;;S STW=STW_""_$$EMPTYTBLINE_"" .I '$$NOCSR S ST="" D S1 ; S SUMBIT=SUMBIT+$P(ST0,"\",7),KAMBIT=KAMBIT+1 ; I DOCH="B" S BITHZ=BITHZ+$P(ST0,"\",7) ; I DOCH="0" D .N QN,SUM S QN=$P(ST0,"\",5),SUM=$P(ST0,"\",7) .S KAM0=KAM0+QN .S KAMHZ0=KAMHZ0+QN .S SKAM0=SKAM0+QN .S SUM0=SUM0+SUM .S SUMHZ0=SUMHZ0+SUM ; I DOCH'="B",$E($G(@$$^W4ORD@(HZM,N+1)))="-" D ; --- HANAHA LE PARIT .N ST,ST0,I,J .S ST0=^(N+1) .S J=0,ST="",A="" S STW=STW_"" .F I1=7,5,3,1 D ..S J=J+1 ..N RKV S RKV=$$CNWEB^%L1FRM($P(ST0,"\",I1)) ..I I1=7 S RKV=$J(RKV,2,2) ..S ST=ST_$J(RKV,M(J))_" " ..D STYLE(RKV,M1T(J)) ..S A=""_A .I '$$NOCSR S ST=$E(ST,1,$L(ST)-1) D S1 .S STW=STW_A_"" . .S HRP=$P(ST0,"\",8) .I $L(HRP) D ..I '$$NOCSR S ST=$J(HRP,30) D S1 ..S STW=STW_""_$$TDLINE_$$BOLD_$$H2U(HRP)_$$EBOLD_"" ..I '$$NOCSR S ST="" D S1 . .N SUM S SUM=$P(ST0,"\",7) . .I DOCH="B" D ..S BITHZ=BITHZ+SUM ..S SUMBIT=SUMBIT+SUM . .I DOCH="0" D ..S SUM0=SUM0+SUM ..S SUMHZ0=SUMHZ0+SUM ; I WHODEL D .I '$$NOCSR S ST=$J("",15)_$$HBR^%L1FRM($$NAME(WHODEL),15)_" : lhia in" D S1 .S STW=STW_"" .S STW=STW_"" .N EX S EX=$$EX2KITCH^W4HZMST(HZM,N) .S STW=STW_"" .S STW=STW_"" .S STW=STW_$$EMPTYTBLINE .I '$$NOCSR S ST="" D S1 ; Q ; ; HNHSHAA(ST) ; I $P(ST,"\",8)["ry itl" Q 1 I $P(ST,"\")["-",$P(ST,"\")["%",$P(ST,"\",8)["*<" Q 1 I $P(ST,"\")["-",$P(ST,"\")["%",$P(ST,"\",5)<0 Q 1 Q 0 ; GETBITHN(HZM) ; S HNH=$$HNH^W4HZMST(HZM) S HNHP=$S($D(@$$^W4ORD@(HZM,"HNHP"))<10:0,1:1) S PRHNH=$S(HNH>.9!(HNH<-.9):1,1:0) S BIT=$$BIT(HZM) I $G(VHNHP)=3 D .N I,OK S OK=0 .F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) I $$SPA^%L1FRM($P(^(I),"\"))="-100%" S OK=1 Q .I 'OK S PRHNH=0,HNHP=0 Q ; BOLD(COLOR) ; N SPN S SPN="" Q SPN ; BOLDRED(STAM) ; Q "" EBOLD(STAM) ; Q "" ; H2U(RKV) ; Q $$H2U^%L1FRM(RKV) ; H2UG(RKV) ; Q ""_$$H2U^%L1FRM(RKV)_"" ; TDLINE(STAM) ; Q "" ; EMPTYTBLINE(STAM) ; Q "" ; STYLE(RKV,TYPE) ; S STYLE=" style=""text-align:right;" ;;I TYPE="N",RKV<0 S STYLE=STYLE_"color:red" S STYLE=STYLE_"""" I TYPE="N" S STYLE=STYLE_" dir=""LTR"" " Q ; SPACE(STAM) ; Q "   " ; REPNAME(REP) ; I REP="B" Q "DELETINGREPORT" I REP="H" Q "DISCOUNTSHOW" I REP="0" Q "ITEM0REPORT" Q "" ; INIT ; D:$G(MSD) PUT^%W1PRM("MSD",MSD) D ^W3CSS,^W4CSS D PUT^%W1PRM("REPNAME",$$REPNAME($G(%ARG("REP")))) Q ; VHNHPNM(VHNHP) ; I VHNHP=0 Q "mihixtl zegpd lk bivdl" I VHNHP=1 Q "zereaw zegpd `ll mihixtl zegpd bivdl" I VHNHP=2 Q "mihixtl zeraw zegpd wx bivdl" I VHNHP=3 Q "( O.T.H. ) 100% mihixt zegpd wx bivdl" Q "" ; AVAR(HZM,N) ; Q $$AVAR^W4HZMST(HZM,N) ; HRHN(HZM) ; N HRHN S HRHN="" N J S J="" F S J=$O(@$$^W4ORD@(HZM,"CB","HNH1",J)) Q:J="" I J D .N A S A=$P($G(^(J)),"*",5) Q:A="" .S HRHN=HRHN_$$H2U(A)_";" S HRHN=$E(HRHN,1,$L(HRHN)-1) Q HRHN ; SUMHN(HN) ; S SUMHNH=SUMHNH+HN S SUMHN=$G(SUMHN)+HN I HN'<.5 D .S QNHN=$G(QNHN)+1 .S KAMHNH=KAMHNH+1 Q ; SUM ; N NOPC,COLSPAN I '$$NOCSR S ST=%CLI_$J(SUMHN,7,2)_CLS_" mekqa zeillk zegpd "_%CLI_QNHN_CLS_" k""dq" D S1 ; S STW="
    "_$$BOLD_$$H2U(" k""dq")_$$EBOLD_" "_$$BOLDRED_QNHN_$$EBOLD S STW=STW_" "_$$BOLD_$$H2U(" mekqa zeillk zegpd ")_$$EBOLD S STW=STW_" "_$$BOLDRED_$J(SUMHN,7,2)_$$EBOLD ; S COLSPAN=7 D S1W ; I $G(QNHNP) D .I '$$NOCSR S ST=" "_%LIGHT1_$J(SUMHNP,7,2)_" mekqa "_QNHNP_" : mihixtl zegpd "_CLS D S1 .; .S STW=$$BOLD_$$H2U(" : mihixtl zegpd")_$$EBOLD .S STW=STW_" "_$$BOLDRED_QNHNP_$$EBOLD_" "_$$SPACE_$$H2U(" : mekqa ")_" "_$$BOLDRED .S STW=STW_$J(SUMHNP,7,2)_$$EBOLD .D S1W ; S STW=" :" D S1W Q ; BIT(HZM) ; N OK S OK=0 N N S N="" F S N=$O(@$$^W4ORD@(HZM,"BIT",N)) Q:N="" D Q:OK .I N'["-",$P($G(^(N)),"*",4)'["xar" D ..I $G(MLZRP),'$$USL(HZM,MLZRP,N) Q ..S OK=1 I OK!$G(MLZRP) Q OK ; N I F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D Q:OK .I $$QN^W4HZMST(HZM,I)<0,'$$AVAR^W4HZMST(HZM,I) S OK=1 Q OK ; PRINTCSR ; D ^W4MDPPC N SM S SM=0 N N,A S N="" F S N=$O(@$$^W4MAIN("S111")@(N)) Q:N="" D .S A=$G(^(N)) .D ^%W1PCSR($G(PRINT),A,SM) ; N ST S ST=$C(10,10,10,10,10)_$G(%MDP("CUT")) D S12^%W1PCSR Q ; NOCSR(STAM) ; I $D(MAIL) Q 1 Q 0 ; HRP ; N HRP S HRP=$P(ST00,"*",4) ;;$$HR(ST0) I '$$NOCSR S ST=$J(HRP,30) D S1 ; -- HEARA S STW=STW_""_$$TDLINE_$$BOLD("green")_$$H2U(HRP)_$$EBOLD_"" I '$$NOCSR I HRP'?.P S ST="" D S1 I HRP'="" D .S STW=STW_$$EMPTYTBLINE Q W4DHNHA W4DHNHA ; [ 12.11.15 12:27 ] [ 15.05.15 11:55 ] [ 14.05.15 14:09 ] N (JB,%ARG,%REM) ; ---- LIFNEY QUERY !! S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" ; D SETGL^W4SPIDK ; K %L1PC S %REPN="W4DHNA" S %REPN("HZSCR")=HZSCR S %REPN("TRH","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN S @$$^%W1GLREP@("MIUN","PROG")="TRH^W4DHNHA" D PUT^%W1PRM("HRFREP","w4reports.jsp?JB="_JB_"&FIRST=1") ; Q ; ; TRH ; D TRH^W4DPHNH ; N VRM1,VH1 S VRM1=$$^W4MAIN("VRM1") K @VRM1 ; N DT,WHO,HZM,VH,NST,SIBA,SIBA1,VH1,ST,SUM,IND ; S DT="" F S DT=$O(@VRM@(DT)) Q:DT="" D .S WHO="" F S WHO=$O(@VRM@(DT,WHO)) Q:WHO="" D ..S HZM="" F S HZM=$O(@VRM@(DT,WHO,HZM)) Q:HZM="" D ...S VH="" F S VH=$O(@VRM@(DT,WHO,HZM,VH)) Q:VH="" D ....S NST="" F S NST=$O(@VRM@(DT,WHO,HZM,VH,NST)) Q:NST="" D .....S SIBA="" F S SIBA=$O(@VRM@(DT,WHO,HZM,VH,NST,SIBA)) Q:SIBA="" D ......S SIBA1="" F S SIBA1=$O(@VRM@(DT,WHO,HZM,VH,NST,SIBA,SIBA1)) Q:SIBA1="" D .......S SUM=$P($G(^(SIBA1)),"*",3) .......S ST=$G(@VRM1@(DT,SIBA,SIBA1,HZM)) .......S IND=$S(VH>4:1,1:2) .......S $P(ST,"*",IND)=$P(ST,"*",IND)+SUM .......I '$P(ST,"*"),'$P(ST,"*",2) K @VRM1@(DT,SIBA,SIBA1,HZM),ST Q .......S @VRM1@(DT,SIBA,SIBA1,HZM)=ST ; K @VRM Q ; ; PRI N I F I="DT","SIBA","SIBA1","HZM" D .I $G(@I)="" S @I=" - " .I $G(@I)["*" S @I=$TR(@I,"*","X") Q ; SUGH ; Q ; HZM ; S x1=$P($G(@GLOB),"*") S x2=$P($G(@GLOB),"*",2) S x3=x1+x2 Q ; FNDSIB(SIBA1) ; N OK S OK=0 N N S N="" F S N=$O(@$$^W4GL("P1SHNH")@(N)) Q:N="" D Q:OK .I $$SPA^%L1FRM($G(^(N)))=$$SPA^%L1FRM(SIBA1) S OK=N Q OK ; HNHSHAA(A) ; I $P(A,"\",8)["dry itl dgpd" Q 1 Q 0 W4DHV W4DHV ; [ 18.03.25 16:45 ] [ 19.01.25 14:24 ] [ 07.01.25 12:44 ] N (JB,%ARG,%REM) I '$G(%ARG("DAT")) D ASK Q ; D ^%W1ARG D MEADSUGL^W4DLKM ; MEKVZ --> MESUGL,MESUGL1, ADKVZ --> ADSUGL,ADSUGL1 I '$G(MELKH) S MELKH=1000 I '$G(ADLKH) S ADLKH=99999999999 D CRTMP(DAT) D CREX D DIVBUT W "

    ",! D SHOW S DIVDOWN="" D DIVBUT W "

    ",! D TMP K @TMP K @TMPEX@("GLOUT") Q ; ASK ; W "
    " W "
    ",! W "
    "_$$H2U(M1(JJ))_"
    "_$S(I1=7:$J(RKV,2,2),1:$$H2U(RKV))_""_TIM_"
    "_$$H2U(RKV)_"
    "_$$H2UG(" : lhia in")_" "_$$BOLD_$$H2U($$NAME(WHODEL))_$$EBOLD_""_$$H2UG(" : lehia zaiq")_" "_$$BOLD_$$H2U($$SIBA1^W4HZMST(HZM,N))_$$EBOLD_""_$$H2UG(" : gahnn `vi m`d")_" "_$$BOLD_$$H2U($S(EX:"ok",1:"`l"))_$$EBOLD_"
    " ; EMPTYLINE(STAM) ; Q "
     
     
    ",! W "" W " " W "",! W " " W "" W "" W "",! W "
    " D .N D,MM .S MM=$$MM^%L1DC($H) .F D=+$H:-1:1 Q:MM'=$$MM^%L1DC(D) .S DAY=$$^%L1DC(D,1) S %W1DAT("NODAY")="" D ^%W1DAT("DAT",DAY," "_$$^%W1DICT("SHOWREPORTTODATE")_" ") 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 ; CRTMP(DAT) ; D ^%W1ARG N LKH,TMP,STRING,ITRA,LK,W4HSB D LKH,TMP S DT=$$^%L1DC(DAT,3) K @TMP ; S STRING="" F S STRING=$O(@LKH@(STRING)) Q:STRING="" D .I MELKH,$TR(STRING,"-","")<$TR(MELKH,"-","") Q .I ADLKH,$TR(STRING,"-","")>$TR(ADLKH,"-","") Q .I MESUGL,$$SUGL^W4L(STRING)ADSUGL Q .S ITRA=$$CBH^W4KLOST(STRING,DT,2) Q:ITRA<1 ; -- 2 - KOLEL TZ . .S IND=$$IND(STRING) . .S @TMP@(IND)=STRING .S @TMP@(IND,"ITRA")=ITRA ; S KLIN=$$^W4GL("KLIN") ; N N S N="" F S N=$O(@KLIN@("H",N)) Q:N="" D .S LK=$G(^(N)) .S LK=$$^W4CLRLK(LK) .I LK["-" S LK=$TR(LK,"-","") .Q:LK="" .S IND=$$IND(LK) .I '$D(@TMP@(IND)) Q .I $P(@TMP@(IND,"ITRA"),";",3) Q .D ^W4HSBGET(N,"H",LK) .I $$^%L1DC(W4HSB("TODATE"),3)>$$^%L1DC(%ARG("DAT"),3) Q .I $G(W4HSB("TOT"))-$G(W4HSB("PAID"))<1 Q .S $P(@TMP@(IND,"ITRA"),";",2)=$G(W4HSB("TODATE")) .S $P(@TMP@(IND,"ITRA"),";",3)=N Q ; ; CREX ; N I,HD,N,LNG,STRING,ITRA,OPENINVDATE,OPENINV,ST D TMP S TMPEX=$$^%W1GLPRM K @TMPEX@("GLOUT") S I=1,LNG=$$^%W1LNG S HD=$$TV^%W1DICT(LNG,"CUSTOMNUMBER") S HD=HD_"*"_$$TV^%W1DICT(LNG,"CUSTOMNAME") S HD=HD_"*"_$$TV^%W1DICT(LNG,"CITY") S HD=HD_"*"_$$TV^%W1DICT(LNG,"ADDRESS") S HD=HD_"*"_$$TV^%W1DICT(LNG,"TEL") S HD=HD_"*"_$$TV^%W1DICT(LNG,"FIRSTOPENINVCNMB") S HD=HD_"*"_$$TV^%W1DICT(LNG,"FIRSTOPENINVCDATE") S HD=HD_"*"_$$TV^%W1DICT(LNG,"ITRA") ;;S HD=$$INVD^%L1FRM(HD,"*","*") ; S @TMPEX@("GLOUT",1)=HD ; S N="" F S N=$O(@TMP@(N)) Q:N="" D .S STRING=$$IND2STRING(N) .S ITRA=$G(^(N,"ITRA")) .S OPENINVDATE=$P(ITRA,";",2) .S OPENINV=$P(ITRA,";",3) .S ITRA=$J(+ITRA,2,2) .S ST=STRING .S ST=ST_"*"_$$LKH^W4L(STRING) .S ST=ST_"*"_$$CITY^W4L(STRING) .S ST=ST_"*"_$$KTV2^W4L(STRING) .S ST=ST_"*"_$$TEL^W4L(STRING) .S ST=ST_"*"_OPENINV .S ST=ST_"*"_$G(OPENINVDATE) .S ST=ST_"*"_ITRA .S I=I+1 .S @TMPEX@("GLOUT",I)=ST Q ; ; SHOW ; W "
    ",! S %W1PCEX("NOHD")="" S %W1PCEX("NOHD1")="" D DIVEXC^%W1PC1("W4DHV","%W1PCEX") D HEAD D HEADTBL N N D TMP S SITRA=0 S IL=0,PG=1,RSIZE=22,SHLN=3,SSHLN=0 ; S N="" F S N=$O(@TMP@(N)) Q:N="" D .S ITRA=$G(^(N,"ITRA")) .S SHLN=SHLN+1,SSHLN=SSHLN+1 .I SHLN>RSIZE D PAGEBREAK .N LK S LK=$G(@TMP@(N)) S:LK="" LK=N .D SHOWLINE(LK,ITRA) .S SITRA=SITRA+ITRA ; D FOOT ; W "
    ",! ; I 'SSHLN D .W "",! Q ; ; HEAD ; W "
    ",! W $$^%W1DICT("DEBTREPORTTODATE",DAT) W "
    ",! W "
    ",! W "" D MEADL^W4DLKP W "
    ",! W "
    ",! W "
    ",! Q ; HEADTBL ; W "",! W "" W " ",! W " ",! W " ",! W " ",! W " ",! ;;W " ",! W " ",! W " ",! W " ",! I $$CORR^W4PRM D .W " ",! W "",! Q ; SHOWLINE(STRING,ITRA) ; S STRING=$$IND2STRING(STRING) W "" S OPENINVDATE=$P(ITRA,";",2) S OPENINV=$P(ITRA,";",3) S ITRA=+ITRA D TD W "> "_STRING_"",! D TD W " > "_$$RKVH($$LKH^W4L(STRING))_" ",! D TD W " > "_$$RKVH($$CITY^W4L(STRING))_" ",! D TD W " > "_$$RKVH($$KTV2^W4L(STRING))_" ",! D TD W " > "_$$RKVH($$TEL^W4L(STRING))_" ",! ; ; D TD W " dir=""LTR"" align=""center"" >" W " "_OPENINV_" " W "",! ; D TD W " align=""center"" id=""fd"_STRING_"""> "_$G(OPENINVDATE)_" ",! D RKV(ITRA) ; I $$CORR^W4PRM D .W "" W "",! Q ; ; TD ; W "" W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! D RKV(SITRA,"balack",1) W "",! Q ; LKH N GL D GL^W4L S LKH=GL Q ; TMP ; S TMP=$$^W4MAIN("TMP") Q ; IND2STRING(STRING) I $L(STRING)>20 S STRING=$E(STRING,$L(STRING)-11,$L(STRING)) Q STRING ; RKV(VL,COLOR,IT) ; D RKV^W4DLKM($G(VL),$G(COLOR),$G(IT)) Q ; RKVH(VL) ; I $G(VL)="" Q " " Q $$H2U^%L1FRM(VL) ; PAGEBREAK ; W "
    "_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("CITY")_""_$$^%W1DICT("ADDRESS")_""_$$^%W1DICT("TEL")_""_$$^%W1DICT("LASTPAYMSUM")_""_$$^%W1DICT("FIRSTOPENINVCNMB")_""_$$^%W1DICT("FIRSTOPENINVCDATE")_""_$$^%W1DICT("BALANCE")_""_$$^%W1DICT("CORRESPONDENCE")_"
    " .N CLRBUT S CLRBUT="green" .I $D(@$$^W4GL("W4CORHB")@(STRING,+OPENINV))>9 S CLRBUT="red" .D ^W4BUTTON("corr",$$^%W1DICT("CORRESPONDENCE"),"ShowCorr('"_+OPENINV_"')","color:"_CLRBUT) .W "
    ",! Q ; STSUM ; W "
    "_$$^%W1DICT("TOTAL")_"      
    ",! W "

    ",! S PG=PG+1 D HEADTBL S SHLN=0,RSIZE=24 Q ; DIVBUT ; D DIVBUT^W4DLKM(1) Q ; MEDAT(DAT) ; N DD,MM,YY I $G(DAT)="" Q "" S DAT=$TR(DAT,"./","") S DD=$E(DAT,1,2) S MM=$E(DAT,3,4) S YY=$E(DAT,5,6) I DD<28 Q "01."_$S(MM>1:$TR($J(MM-1,2)," ",0),1:12)_"."_$S(MM>1:YY,1:$TR($J(YY-1,2)," ",0)) ;;Q "01."_MM_"."_YY Q "01.01."_$S(MM>3:YY,1:$TR($J(YY-1,2)," ",0)) ; DAT0 ; N D,MM S MM=$$MM^%L1DC($H) F D=+$H:-1:1 Q:MM'=$$MM^%L1DC(D) S DAT=$$^%L1DC(D,1) Q ; IND(STRING) N IND S IND=STRING I $G(%ARG("SORT")) S IND=$$^W4ABCIND(STRING,$$LKH^W4L(STRING)) Q IND W4DHZMSL W4DHZMSL ; DOCH HAZMANOT LE POWERLINK [ 26.12.23 03:42 ] [ 21.12.23 19:33 ] [ 19.12.23 03:58 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) ; S @$$^W4GL("W4PWRSTA")@(1)="xign zrvd" S @$$^W4GL("W4PWRSTA")@(2)="dxye` dpnfd" S @$$^W4GL("W4PWRSTA")@(3)="dnley dpnfd" S @$$^W4GL("W4PWRSTA")@(4)="xeyi` ixg` lhea" S @$$^W4GL("W4PWRSTA")@(5)="xeyi` iptl lhea" ; K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")="W4DHZMSL" ; S TMPIR=$$^W4MAIN("TMPIR") K @TMPIR N IRS S IRS="" F S IRS=$O(@$$^W4GL("P1IR")@(IRS)) Q:IRS="" D .N IR1 S IR1=$G(^(IRS)) .I $L(IR1) D ..S @TMPIR@(IR1)=IRS ..I IR1="dewz gzt" S IR1="deewz gzt" S @TMPIR@(IR1)=IRS Q ; ; TRH ; I DATHADTRH) S OK=0 Q I DATH>64000,DATH<80000 D .S TRH=$ZD(DATH,"DD.MM.YY") Q ; HZM ; S PRMSD=0,PRMSL=0 ; ;;I $$^W4HZMH(HZM) S OK=0 Q I $$I^W4PIZUL(HZM) S OK=0 Q ;;I $$DEL^W4DEL(HZM) S OK=0 Q ; S PRMSL=1 ; S TMPIR=$$^W4MAIN("TMPIR") S %SCRN="P1HZ" ; D GA^W4SCREF(%SCRN,$$^W4ORD_"(HZM)") S MKR=$$MKRDLV^W4HZMST(HZM) ; S IR=$$IR^W4HZMST(HZM) S IR=$$RPL^%L1FRM(IR,"HD_","") ; S OK=1 ;;D Q:OK'=1 ; -- MISHLOHIM .S SHAA=$P($P(SHAA,":",1,2)," ") .I $$GET^%W1PRM("NOSHOWDELZIC"),$$DEL^W4DEL(HZM)!($$TSHL^W4HZMST(HZM)<0) S OK=0 ; S DATCB=$P(ZMANK," ") N DTCB S DTCB=$$^%L1DC(DATCB,3) I DTCB(ADDATCB+1) S OK=0 Q I DTCB=(ADDATCB+1),SHAA'<$$SHAAZ^W4PRM!'$$^W4SHAAZ S OK=0 Q I DTCB=MEDATCB,SHAA<$$SHAAZ^W4PRM S OK=0 Q ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") ;;I REPDAYS,'$E(REPDAYS,$$^%L1DC(DTCB,8)) S OK=0 Q ; I $$^W4ISCDLK(LKHN) S NMB=LKHN N NMB1 S NMB1=$TR(NMB,"-","") D D(.5) I NMB1<$TR(MENMB,"-","")!(NMB1>$TR(ADNMB,"-","")) S OK=0 Q ; S IR=$$SPA^%L1FRM($G(IR)) I $$^W4MSL(NMB),IR="" S IR="TAKEAWAY" I IR="eti aia` lz" S IR="aia` lz" I IR["milyexi" S IR="milyexi" ; I $$^W4MSL(NMB),$G(MEIR)=0,ADIR=0,'$$TAKEAWAY(IR) S OK=0 Q I $G(MEIR)=1,$G(ADIR),ADIR=$O(@$$^W4GL("P1IR")@(999999),-1),'$$TAKEAWAY(IR) G VIBMKBL I '$G(MEIR),$G(ADIR),ADIR=$O(@$$^W4GL("P1IR")@(999999),-1)!(ADIR>99999) G VIBMKBL I $G(MEIR)?1N.N,$G(ADIR)?1N.N,$L(IR),$G(@TMPIR@(IR))ADIR) S OK=0 Q ; VIBMKBL ; D D(2) I $G(MEMKBL),$G(ADMKBL),MKBLADMKBL) S OK=0 Q I $G(MEMKR),$G(ADMKR),MKRADMKR) S OK=0 Q ; I ADSHAA>24,ADSHAA<40,$$^W4SHAAZ,SHAA<$$SHAAZ^W4PRM,$$^%L1DC($P(ZMANK," "),3)=METRH S OK=0 Q I MESHAA[":"!(ADSHAA[":"),MESHAA<40,ADSHAA<40 S OK=$$VIBTIME^%W1PCP(MESHAA,ADSHAA,SHAA) Q:'OK I MESHAA'[":",ADSHAA'[":" D .S SHAA1=$S($$^W4SHAAZ&(SHAA<$$SHAAZ^W4PRM)&(ADSHAA>24):SHAA+24,1:SHAA) .I SHAA1TIMEMAX S TIMEMAX=TIME ; I 'TIMEMAX Q " " N DT,SEC S DT=$E(TIMEMAX,1,5) S SEC=$E(TIMEMAX,6,10) Q $ZD(DT,"DD.MM.YY")_" "_$$T^%L1TIME(SEC) ; ; STAT(HZM) ; S STAT=0,STAT1="" D .I $$TSHL^W4HZMST(HZM)<0 S STAT=4,STAT1="xeyi` ixg` lhea" Q .I '$$TSHL^W4HZMST(HZM),$$^W4DEL(HZM)=HZM S STAT=5,STAT1="xeyi` iptl lhea" Q .I $$^W4HZMH(HZM) S STAT=1,STAT1="xign zrvd" Q .I $$ITRA^W4HZMST(HZM) S STAT=2,STAT1="dxye` dpnfd" Q .S STAT=3,STAT1="dnley dpnfd" Q Q W4DICTBL W4DICTBL(STAM) ; [ 25.02.10 20:33 ] [ I $$POS^W4MTAW Q $$^%W1DICT("CSR") Q $$^%W1DICT("SHULHAN") PC(STAM) ; I $$POS^W4MTAW Q " dtew" Q " ogley" W4DICTHS W4DICTHS(SHULH) ; [ 15.01.16 16:17 ] [ 10.03.10 18:04 ] [ 26.02.10 17:37 ] [ I $$^W4DLVCSR!$$^W4MSL(SHULH) Q $$^%W1DICT("CUSTOMHISTORY",SHULH) I '$$POS^W4MTAW Q $$^%W1DICT("TABLEHISTORY",SHULH) Q $$^%W1DICT("CSRHISTORY",SHULH) W4DITEMS W4DITEMS ; [ 28.08.22 10:11 ] [ 02.02.17 23:20 ] [ 31.10.16 19:07 ] N (JB,%ARG,%REM) Q:$G(%ARG("SHOW"))=0 S %ARG("MEDAT")=$G(%ARG("DAT1")) S %ARG("ADDAT")=$G(%ARG("DAT2")) D TV^W4DP1 K @$$^W4MAIN("TMPREP") M @$$^W4MAIN("TMPREP")@("G")=@$$^W4MAIN("TEMP") K @$$^W4MAIN("TEMP") S %SCRN=$$SCRN^W4DP1 ; D PCPRM^W4DMANY(%SCRN) Q W4DIVBUT W4DIVBUT(PRM,CLASS) ; [ 30.03.17 09:56 ] [ 29.03.17 11:14 ] [ 15.03.15 10:58 ] I $G(PRM)="" S PRM="SPB" ; W "

    ",! W "",! W "",! ; I PRM["S" D .W " " .W "" ; I $G(PRM)["P" D .W " ",! .W "" ; I PRM["B" D .W " ",! ; W "",! W "
    " . D BUT("submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green",$G(CLASS)) .W "  " . D BUT("print",$$^%W1DICT("PRINT"),"Print()","color:blue",$G(CLASS)) .W "  " . D BUT("backid",$$^%W1DICT("BACK"),"Back()","color:red",$G(CLASS)) .W "
    ",! W "
    ",! Q ; ; BTN(CLASS) ; W " ",! W " " W " " W " ",! W " " W " ",! W "
    " D SBM($G(CLASS)) W "  " D BACK($G(CLASS)) W "
    ",! Q ; ; SBM(CLASS) ; W "",! Q ; BACK(CLASS) ; W "",! Q ; BUT(ID,VL,PROC,STYLE,CLASS,DOP) I $G(DOP)="" S DOP="wh,22" D ROUNDBUT^%W1JS(ID,VL,PROC,$G(STYLE),DOP) Q W4DKC W4DKC(MEDAT,ADDAT) ; DOCH HAZMANOT; [ 23.04.25 14:13 ] [ 21.02.22 07:36 ] [ 03.09.20 07:40 ] N (JB,%ARG,%REM,MEDAT,ADDAT,%REPN) D ^W4IN,^%W1PCVRM K @VRM S D1=$$^%L1DC(MEDAT,3),D2=$$^%L1DC(ADDAT,3) ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") ; F DT=D1:1:D2 D .I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) Q .S HZ="" F S HZ=$O(@$$^W4GL("P1H")@(DT,HZ)) Q:HZ="" I $D(@$$^W4ORD@(HZ,"CB","CH")) D ..S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","CH",N)) Q:N="" D ...N A S A=$G(^(N)) ...I '$$KC^W4KC(A) Q ...D ^W4GTVCH(A,"CH") ...S SH=$O(@VRM@(DT,HZ,999),-1)+1 ...S @VRM@(DT,HZ,SH)=$ZD(TIME,"DD.MM.YY 24:60")_"*"_$J(CHS,2,2) ; S %REPN="W4DKC" S %REPN("PRTN")=$$^%W1JB S %REPN("METRH")=D1,%REPN("ADTRH")=D2 S %REPN("METRH","VIEW")=1,%REPN("ADTRH","VIEW")=1 S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN ; D PUT^%W1PRM("HRFREP","w4dkc.jsp?JB="_JB) END Q ; HZ ; S x1=$P($G(@GLOB),"*") S x2=$J($P($G(@GLOB),"*",2),2,2) Q W4DLK W4DLK(DT1,DT2,DISP) ;-- DOCH LAKOHOT [ 18.06.20 10:46 ] [ 16.06.20 10:03 ] [ N (JB,%REM,%ARG,DT1,DT2,DISP,NOBACKBUT) I $G(DISP)="" S DISP=1 K @$$^W4MAIN("S111") D ^W4IN,^W4MDPPC,^%L1TS ; I $TR(DT1,"./","")?6N S DAT1=DT1,DT1=$$^%L1DC(DT1,3) I $TR(DT2,"./","")?6N S DAT2=DT2,DT2=$$^%L1DC(DT2,3) I $P(DT1,",")?5N S DAT1=$ZD(DT1,"DD.MM.YY") I $P(DT2,",")?5N S DAT2=$ZD(DT2,"DD.MM.YY") ; S SM=1 S TXT="" D S1 S TXT="" D S1 I DAT1=DAT2 S P1TOT=DAT1_" jix`zl zegewl g""ec" I DAT1'=DAT2 S P1TOT=DAT1_" - "_DAT2_" dtewza zegewl g""ec" S TXTL=$L(P1TOT) S TXT=$J("",3)_P1TOT D S1 S TXT=$J("",3)_$TR($J("",TXTL)," ","-") D S1 D ASR(DT1,DT2) ; I $G(DISP) D VIEW^W4TELREP Q ; ; ASR(DT1,DT2) ; N (JB,%REM,%ARG,DT1,DT2,DISP) S TMPL=$$^W4MAIN("TMPL") K @TMPL F DT=DT1:1:DT2 D .S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" I $D(@$$^W4ORD@(HZ,"CB","ASR")) D ..S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","ASR",N)) Q:N="" I N D ...S A=$G(^(N)) ...S LK=$P(A,"*"),SUM=$P(A,"*",4) ...S LKR=LK ...I $G(@$$^W4GL("P1EZL")@(LK)) S LKR=^(LK) ...S @TMPL@(LKR)=$G(@TMPL@(LKR))+SUM ; N LKH,SUMC,TXT S LKH="" N SSUM S SSUM=0 F S LKH=$O(@TMPL@(LKH)) Q:LKH="" S SUMC=$G(^(LKH)) D .N LKH1 .I $$HB S LKH1=$$HBR^%L1FRM($G(@$$^W4GL("LKH")@(LKH)),16) .I '$$HB S LKH1=$$ENG^%L1FRM($G(@$$^W4GL("LKH")@(LKH)),16) .S SSUM=SSUM+SUMC .I $$HB S TXT=$J(SUMC,8,2)_" : "_LKH1_$J(LKH,11) D S1 .I '$$HB S TXT=$J(LKH,11)_LKH1_" : "_$J(SUMC,8,2) D S1 . ; S TXT=$TR($J("",35)," ","-") D S1 ; I $$HB S TXT=$J(SSUM,8,2)_$J("k""dq",27) D S1 I '$$HB S TXT="TOTAL :"_$J($J(SSUM,8,2),27) D S1 ; K @TMPL Q ; ; S1 D ^W4PCST(TXT,DISP) Q ; HB(STAM) ; Q $$^%W1HB W4DLKHZ W4DLKHZ ; [ 18.01.18 09:06 ] [ N (JB,%ARG,%REM) S DT1=$$^%L1DC("MEDAT",3) S DT2=$$^%L1DC("ADDAT",3) S BYDAT=$G(%ARG("BYDAT")) S VRM=$$^W4MAIN("VRM") K @VRM ; I BYDAT="ORD" D .S N="" F S N=$O(@$$^W4GL("W4LINK")@(N)) Q:N="" D ..S A=$G(^(N)) ..S DTHZ=$P(A,"~",6) ..I DTHZDT2) Q ..D SETVRM(N) ; I BYDAT="SEND" D .S DT="" F S DT=$O(@$$^W4GL("W4LINKD")@(DT)) Q:DT="" D ..S N="" F S N=$O(@$$^W4GL("W4LINKD")@(DT,N)) Q:N="" D ...S DTHZ=DT ...I DTHZDT2) Q ...D SETVRM(N) ; Q ; SETVRM(N) ; N NMB,SUM,B S NMB=$$NMB^W4HZMST(N) Q:'$$HZM^W4MSL(N) S SUM=$$TSHL^W4HZMST(N) S B=$G(@VRM@(NMB)) S B=B+1_"\"_($P(B,"\",2)+SUM) S @VRM@(NMB)=B S @VRM@(NMB,N)=SUM Q W4DLKM W4DLKM ; [ 17.09.18 07:12 ] [ 24.04.18 13:36 ] [ 20.02.18 06:48 ] ;--- INPUT - DAT1,DAT2 ; ; ASONLY = 1 (KOLEL HAZMANOT , 2 -HESB & LAK BILVAD ) ; PRATI - ONE CUSTOMER ONLY N (JB,%ARG,%REM) ; D ^%W1ARG D MEADSUGL ; I $G(ADLKH)="" S ADLKH=9999999999 ; S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) ; ;;S ASONLY=3-$G(%ARG("ASONLY")) S ASONLY=$G(%ARG("ASONLY")) ; D DIVBUT(1) ; D FRM^W4DLKP(JB,MEDAT,ADDAT,$G(MELKH),$G(ADLKH),$G(MESUGL),$G(ADSUGL),ASONLY) ;;S ASONLY=3-$G(%ARG("ASONLY")) D RIKUZ D PC S DIVDOWN="" D DIVBUT(2) W "

    ",! K @VRM Q ; RIKUZ ; D ^%W1PCVRM D VRM1 K @VRM1 ; N LKH,DAT,SUGTD,NOMTD,NP,SUG,SUMTD S LKH="" F IL=1:1 S LKH=$O(@VRM@(LKH)) Q:LKH="" D .S DAT="" F S DAT=$O(@VRM@(LKH,DAT)) Q:DAT="" D ..S SUGTD="" F S SUGTD=$O(@VRM@(LKH,DAT,SUGTD)) Q:SUGTD="" D ...S NOMTD="" F S NOMTD=$O(@VRM@(LKH,DAT,SUGTD,NOMTD)) Q:NOMTD="" D ....S NP="" F S NP=$O(@VRM@(LKH,DAT,SUGTD,NOMTD,NP)) Q:NP="" D .....N A S A=$G(^(NP)) .....S SUG="?" .....S SUMTD=$P(A,"\") .....S SUMHV=$P(A,"\",2) .....I SUGTD=0 S SUG=0 .....I SUGTD=1,$$CBHB Q .....I SUGTD=1,$$GAMHZ S SUMTD=SUMHV,SUG=1 .....I SUGTD=2 S SUG=1 .....I SUGTD=3 S SUG=4 .....I SUGTD=4 S SUG=2 .....I SUGTD=5 S SUG=2 .....I SUGTD=6 S SUG=3 .....I SUGTD=7 S SUG=3 .....S IND=LKH .....I $$SORT S IND=$$^W4ABCIND(LKH,$$LKH^W4L(LKH)) .....S @VRM1@(IND)=LKH .....S @VRM1@(IND,SUG)=$G(@VRM1@(IND,SUG))+SUMTD ; D FRMTMPREP Q ; ; ; PC ; W "
    ",! D PCPRM^W4DMANY("W4DLKMR") ; D DIVEXC^%W1PC1("W4DLKMR","%W1FREPX") ; S IL=0,PG=1,RSIZE=23,SHLN=3,SSHLN=0 S (SITRA0,SSKUP,SSHSBY,SSCB,SSTZ)=0 D KOT ; S IND="" F S IND=$O(@VRM1@(IND)) Q:IND="" D .S LKH=$G(^(IND)) .N ITRA0,SKUP,SHSBY,SCB,ITRA .S ITRA0=$G(@VRM1@(IND,0)) .S SITRA0=SITRA0+ITRA0 .S SKUP=$G(@VRM1@(IND,1)) .S SSKUP=SSKUP+SKUP .S SHSBY=$G(@VRM1@(IND,2)) .S SSHSBY=SSHSBY+SHSBY .S STZ=$G(@VRM1@(IND,3)) .S SSTZ=SSTZ+STZ .S SCB=$G(@VRM1@(IND,4)) .S SSCB=SSCB+SCB .S ITRA=ITRA0+SKUP+SHSBY-STZ-SCB .I $G(%ARG("LKITRA")),'ITRA Q . .S SHLN=SHLN+1,SSHLN=SSHLN+1 .I SHLN>RSIZE D PAGEBREAK .W "" .W "  "_LKH_" " .W "  "_$$H2U^%L1FRM($$LKH^W4L(LKH))_" " . . D RKV(ITRA0) . D RKV(SKUP,"darkblue") . D RKV(SHSBY,"darkblue") . D RKV(STZ,"red") . D RKV(SCB,"darkgreen") . D RKV(ITRA) . .W "",! ; W "",! W " "_$$^%W1DICT("TOTAL")_"",! W "  ",! D RKV(SITRA0,"darkblue",1) D RKV(SSKUP,"darkblue",1) D RKV(SSHSBY,"darkblue",1) D RKV(SSTZ,"red",1) D RKV(SSCB,"green",1) S SITRA=SITRA0+SSKUP+SSHSBY-SSTZ-SSCB D RKV(SITRA,"darkblue",1) W "",! W "",! ; I 'SSHLN D .W "",! ; W "
    ",! ; Q ; GAMHZ(STAM) I $G(ASONLY)=1 Q 1 Q 0 ; CBHB(STAM) I $G(ASONLY)=2 Q 1 Q 0 ; PAGEBREAK ; W "",! W "

    ",! S PG=PG+1 D KOT S SHLN=0 Q ; KOT ; ;;W ""_$$^%W1DICT("CUSTOMSCONCREPORT")_"
    ",! ; W "" ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W "
    "_$$^%W1DICT("MESUGL")_""_MESUGL_" "_MESUGL1_""_$$^%W1DICT("ADSUGL")_""_ADSUGL_" "_ADSUGL1_""_$$^%W1DICT("PAGE")_" : "_PG_"
    "_$$^%W1DICT("MELKH")_""_$G(MELKH)_""_$$^%W1DICT("ADLKH")_""_$G(ADLKH)_" 
    "_$$^%W1DICT("MEDATE")_""_$G(MEDAT)_""_$$^%W1DICT("ADDATE")_""_$G(ADDAT)_" 
    ",! ; I $$GAMHZ W ""_$$^%W1DICT("ALLDOCUMENTS")_"",! I $$CBHB W ""_$$^%W1DICT("INVOICESANDRECEIPTS")_"",! ; W "
    ",! ; W "",! W " " W " " W " " W " " I '$$^W4LKH D .W " " .W " " I $$^W4LKH D .W " " .W " " W " " W " " W " " W " ",! Q RKV(RKV,COLOR,IT) ; I $G(COLOR)="" S COLOR="black" I 'RKV S RKV="" S STYLE=" style=""color:"_COLOR I RKV<0 S STYLE=" style=""color:red" I $G(IT) S STYLE=STYLE_";font-weight:bold" S STYLE=STYLE_"""" I RKV S RKV=$$ZPTN^%L1FRM(RKV) W "" Q VRM1 ; S VRM1=$$^W4MAIN("VRM1") Q ; HDSTYLE(STAM) ; Q " style=""color:brown;font-weight:bold""" ; DIVBUT(I) ; I '$G(I) S I=1 W "
    " W "
    ",! W "
    "_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("ITRA0")_""_$$^%W1DICT($S(ASONLY=1:"INVCORDSUM",1:"INVOICES"))_""_$$^%W1DICT("ARMINVOICESUM")_""_$$^%W1DICT("AUTOINVOICES")_""_$$^%W1DICT("OTHERINVOICES")_""_$$^%W1DICT("DEBINVOICES")_""_$$^%W1DICT("PAYMENTS")_""_$$^%W1DICT("ITRA")_"
     "_RKV_" 
    ",! W "" W "",! ; W " " ; W "" ; I $$LPTMDB^W3HZGLK D .W "" .W "" ; W "" W "",! W "
    " I '$D(DIVDOWN) D .W $$^%W1DICT("ABCSORT")_" " .W " " ; I $D(DIVDOWN) W " " W "" D ROUNDBUT^%W1JS("Print",$$^%W1DICT("PRINT"),"Print()","color:green",",,,100") W " " . D ROUNDBUT^%W1JS("Mdb",$$^%W1DICT("MDBPC"),"Mdb()","color:blue",",,,100") .W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "",! Q ; ; MEADSUGL ; S MESUGL=$G(%ARG("MEKVZ")) S MESUGL1="" I MESUGL D .S MESUGL1=$G(@$$^W4GL("SUGL")@(MESUGL)) .S MESUGL1=$$H2U^%L1FRM(MESUGL1) ; S ADSUGL1="" S ADSUGL=$G(%ARG("ADKVZ")) I ADSUGL D .S ADSUGL1=$G(@$$^W4GL("SUGL")@(ADSUGL)) .S ADSUGL1=$$H2U^%L1FRM(ADSUGL1) ; I 'ADSUGL S ADSUGL=99999 Q ; FRMTMPREP ; D TMPREP K @TMPREP ; N IND,LKH,I,ST,ITRA0,SKUP,SHSBY,STZ,SCB,ITRA S I=0 ; S IND="" F S IND=$O(@VRM1@(IND)) Q:IND="" D .S LKH=$G(^(IND)) I LKH="" S LKH=IND .Q:'LKH .S ST=LKH_"\"_$$LKH^W4L(LKH) .S ITRA0=$G(@VRM1@(IND,0)) .S SKUP=$G(@VRM1@(IND,1)) .S SHSBY=$G(@VRM1@(IND,2)) .S STZ=$G(@VRM1@(IND,3)) .S SCB=$G(@VRM1@(IND,4)) .I 'SKUP,'SHSBY,'STZ,'SCB Q .S ST=ST_"\"_ITRA0 .S ST=ST_"\"_SKUP .S ST=ST_"\"_SHSBY .S ST=ST_"\"_STZ .S ST=ST_"\"_SCB .S ITRA=ITRA0+SKUP+SHSBY-STZ-SCB .I $G(%ARG("LKITRA")),'ITRA Q .S ST=ST_"\"_ITRA .S I=I+1 .S @TMPREP@("G",I)=ST Q ; TMPREP ; S TMPREP=$$^W4MAIN("TMPREP") Q ; SORT(STAM) ; Q $G(%ARG("SORT")) W4DLKP W4DLKP ; [ 30.01.25 16:13 ] [ 14.11.19 11:58 ] [ 14.02.19 05:39 ] ;--- INPUT - DAT1,DAT2 ; ; ASONLY = 1 (KOLEL HAZMANOT , 2 -HESB & LAK BILVAD ) ; PRATI - ONE CUSTOMER ONLY N (JB,%ARG,%REM) ; S SH=0,S111=$$^W4MAIN("S111") K @S111 S DL=8 D DR ; D ^%W1ARG W "

    " W "
    ",! W "",! W "" W " " W "" W " " W "" W "" W "",! W "
    " D ROUNDBUT^%W1JS("Print",$$^%W1DICT("PRINT"),"Print()","color:green",",,,100") W " " D ROUNDBUT^%W1JS("CSRPrint",$$^%W1DICT("CSRPRINT"),"CSRPrint()","color:green",",,,180") W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "
    ",! ; D ^%W1PCVRM ; I '$D(@VRM) D .D FRM(JB,MEDAT,ADDAT,MELKH,ADLKH,$G(MEKVZ),$G(ADKVZ),ASONLY,$G(DEBT)) ; ; D PC Q ; ; FRM(JB,MEDAT,ADDAT,MELKH,ADLKH,MEKVZ,ADKVZ,ASONLY,DEBT) ; N (JB,%ARG,%REM,MEDAT,ADDAT,MELKH,ADLKH,MEKVZ,ADKVZ,ASONLY,DEBT) D DR D PRM K @VRM ; D KLFKP ; S SHS=0,FIN=0 S SSUMH=0,SSUMZ=0,SUMH=0,SUMZ=0 K STRINGP ; K @TEMPL S N="" F S N=$O(@$$^W4GL("KLF")@(N)) Q:N="" D .N N1 S N1=$TR(N,"-","") .N MESTRING1 S MESTRING1=$TR(MESTRING,"-","") .N ADSTRING1 S ADSTRING1=$TR(ADSTRING,"-","") .I MESTRING?1U.E,$E(N1,1,$L(MESTRING1))'=MESTRING1 Q .I MESTRING1'?1U.E,N1ADSTRING1 Q .S SUGL=$$SUGL^W4L(N) I 'SUGL S SUGL=1 .I SUGL<$G(MESUGL) Q .I $G(ADSUGL),SUGL>ADSUGL Q .;;I $$SLAVE(N),'$D(@$$^W4GL("KLF")@(N,"H")),'$D(@$$^W4GL("KLF")@(N,"TZ")),'$D(@$$^W4GL("KLF")@(N,"CB")),'$D(@$$^W4GL("P1LHB")@(N)) Q .S @TEMPL@(N)=N ; S NNN="" F S NNN=$O(@TEMPL@(NNN)) Q:NNN="" I NNN'="PC" S STRING=NNN D .S SUMH=0,SUMZ=0,SHZ=0 K M .S FIRST=1 . .D ; -- HISHUV ITRA KODEMET ..N KLOST,ITRA0,ITRA1 ..S DAT0=$$^%L1DC(DAT1,"2-1") ..; ..;;D BDKRKZ(STRING) ; --> 14/02/18 .. ..I $$GAMHZ D ^W4KLOST S ITRA=ITRA0 Q ;-- KOLEL HAZMANOT ..I $$CBHB S ITRA=$$CBH^W4KLOST(STRING,$$^%L1DC($$^%L1DC(DAT0,1),3)) ; HESB & KAB . .S DAT=$$CR^W4DTL(DAT0) .F S DAT=$O(@KLFKP@(DAT)) Q:DAT="" S DT=$$DT^W4DTL(DAT) I DT'DT2 Q ...I $$CBHB,DOC'="H",DOC'="CB",DOC'="TZ" Q ...I $$GAMHZ,DOC'="H",DOC'="CB",DOC'="TZ",DOC'="HZ",DOC'="HMK",DOC'="TM",DOC'="TMZ" Q ...I $$GAMHZ,DOC="HMK",'$$^W4LKH Q ...; ...S NUMBER="" F S NUMBER=$O(@KLFKP@(DAT,DOC,NUMBER)) Q:NUMBER="" D I $D(M) S DATV=$$DATV(DAT) D SETST ....K M ....S STR=$G(^(NUMBER)) ....I FIRST D .....S FIRST=0 .....S M("SUGTD")=0 .....S M("ZHUT")="",M("HOVA")="",M("NOMTD")="" .....N DATV S DATV=$$CR^W4DTL(DAT1)_"0000" .....S M("ITRA")=$J(ITRA,DR,DR),M("SUMH")=ITRA .....D SETST .... ....S M("ZHUT")=$P(STR,"\",1) ....S M("HOVA")=$P(STR,"\",2) ....I +M("HOVA")=+M("ZHUT"),DOC'="H",DOC'="TZ",DOC'="HMK" K M Q ....S M("TRH")=$$^%L1DC(DAT,1) ....S M("SUGTD")=$S(DOC="HZ":1,DOC="H":$$SUGHB(NUMBER),DOC="CB":3,DOC="TZ":$$SUGHBZ(NUMBER),DOC["HMK":$$SUGHMK(NUMBER),DOC="TM":10,DOC="TMZ":12,1:"") ....;;I $$ZIC(M("SUGTD")),M("HOVA"),'M("ZHUT") S M("ZHUT")=-M("HOVA"),M("HOVA")="" ....S M("SUMH")=$S(M("HOVA"):M("HOVA"),M("ZHUT"):M("ZHUT"),1:$P(STR,"\",3)) ....S M("NOMTD")=$S(NUMBER<0:-NUMBER,1:$P(NUMBER,"-",1,2)) .... ....I DOC="HZ"!(DOC="TM")!(DOC="TMZ"),$$HB(STRING,DOC,NUMBER) D Q .....S M("ZHUT")="",M("HOVA")="" .... ....D ; I $G(ASONLY)=2 D ; *** LEV 26/02/15 .....I DOC="H"&NUMBER>0,M("SUMH") S M("HOVA")=$J(M("SUMH"),DR,DR) .....I DOC="TZ"!(NUMBER<0),M("SUMH") S M("HOVA")=$J(-M("SUMH"),DR,DR),M("ZHUT")="" .... ....I +M("HOVA")=+M("ZHUT"),DOC="H"!(DOC="TZ") S M("ZHUT")="" ....S M("ITRA")=ITRA+M("HOVA")-M("ZHUT"),ITRA=M("ITRA") .... ....D SUMHZ ...Q ..Q .Q ; D PUT^%W1PRM("W4DLKP",1) Q ; ; DATV(DAT) ; I $L(DAT)=12 Q DAT N DATV S DATV=$$CR^W4DTL(DAT) I $L(DATV)<12 S DATV=$E(DATV_"00000000000",1,12) Q DATV ; PC ; D PRM ; W "
    ",! S IL=0,PG=1,RSIZE=33,SHLN=0,SSHLN=0 S (SSHOV,SSZHUT,SLITRA,LITRA)=0 ; S LKH="" F IL=1:1 S LKH=$O(@VRM@(LKH)) Q:LKH="" D .S (SHOV,SZHUT)=0 .I IL=1 D KOT(LKH) S SHLN=SHLN+3 .I IL>1 D PAGEBREAK .S DAT="" F S DAT=$O(@VRM@(LKH,DAT)) Q:DAT="" D ..S SUGTD="" F S SUGTD=$O(@VRM@(LKH,DAT,SUGTD)) Q:SUGTD="" D ...S NOMTD="" F S NOMTD=$O(@VRM@(LKH,DAT,SUGTD,NOMTD)) Q:NOMTD="" D ....S NP="" F S NP=$O(@VRM@(LKH,DAT,SUGTD,NOMTD,NP)) Q:NP="" D .....N A S A=$G(^(NP)) Q:A="" .....S SHLN=SHLN+1,SSHLN=SSHLN+1 .....I SHLN>RSIZE D PAGEBREAK .....N DOP S DOP="" I SUGTD=4 S DOP="HY" .....S PRM=LKH_"n"_SUGTD_"n"_NOMTD_DOP_"n"_NP .....W "" .....W " "_$$^%L1DC(DAT,1)_"" .....S STC=$$^%L1DC(DAT,1) .....W "  " .....I SUGTD=0 W "" .....W $$H2U^%L1FRM($$NAMEDOC(SUGTD)) .....S STC=$$HBR^%L1FRM($$NAMEDOC(SUGTD),18)_" "_STC .....N HBN S HBN=$$HBN(LKH,"HZ",NOMTD) .....I SUGTD=1,HBN D ......W " [ "_$$H2U^%L1FRM("'yg")_" "_HBN_" ]" ......S STC="[ "_$J(HBN,6)_" 'yg ] "_STC .....I SUGTD=0 W "" .....W "" .....W " "_NOMTD_"" .....S STC=$J(NOMTD,DL)_" "_STC D S1 .....D RKV($P(A,"\"),$S(SUGTD=6!(SUGTD=7):"red",1:""),$S(SUGTD=0:1,1:"")) ;- SHUM BE TEUDA .....S STC=$J($P(A,"\"),DL,2) .....D RKV($P(A,"\",2),"darkblue") S SHOV=SHOV+$P(A,"\",2) .....S STC=$J($P(A,"\",2),DL,2)_" "_STC .....D RKV($P(A,"\",3),"green") S SZHUT=SZHUT+$P(A,"\",3) .....S STC=$J($P(A,"\",3),DL,2)_" "_STC .....D RKV($P(A,"\",4),"black") S LITRA=$P(A,"\",4) .....S STC=$J($P(A,"\",4),DL,2)_" "_STC D S1 S STC="" D S1 .....W "",! .;---------------------- ITOGO ------- .D KAV .W "" .W " "_$$^%W1DICT("TOTAL")_"" .W "  " .W "  " .W "  " .S STC=$$TV^%W1DICT($$^%W1LNG,"TOTAL") D S1 .S SSHOV=SSHOV+SHOV .S SSZHUT=SSZHUT+SZHUT .S SLITRA=SLITRA+LITRA . .D RKV(SHOV,"darkblue",1) .S STC=$J("",DL) .S STC=$J(SHOV,DL,2)_" "_STC .D RKV(SZHUT,"green",1) .S STC=$J(SZHUT,DL,2)_" "_STC .D RKV(LITRA,"black",1) .S STC=$J(LITRA,DL,2)_" "_STC D S1 .D KAV .W "",! . ; I 'SSHLN D .W "",! ; W "" W " "_$$^%W1DICT("TOTALALLCUSTOMERS")_"" S STC=$$TV^%W1DICT("H","TOTALALLCUSTOMERS") D S1 W "  " W "  " W "  " D RKV(SSHOV,"darkblue",1) S STC=$J("",DL) S STC=$J(SSHOV,DL,2)_" "_STC D RKV(SSZHUT,"green",1) S STC=$J(SSZHUT,DL,2)_" "_STC D RKV(SLITRA,"black",1) S STC=$J(SLITRA,DL,2)_" "_STC D S1 W "",! W "",! W "
    ",! K @TEMPL K @VRM Q ; TEMPL S TEMPL=$$^W4MAIN("TEMPL") Q KLFKP S KLFKP=$$^W4GL("KLF")_"(STRING,""KP"")" Q SUMHZ ; S SUMH=SUMH+M("HOVA"),SUMZ=SUMZ+M("ZHUT") S SSUMH=SSUMH+M("HOVA"),SSUMZ=SSUMZ+M("ZHUT") Q ; HB(STRING,DOC,NOMTD) ; N OK S OK=0 S NOMTD=$$^W4NOMTD(NOMTD,DOC) I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,"HSB")) Q 1 N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,I,"HSB")) S OK=1 Q I OK Q OK N LK S LK="" F S LK=$O(@$$^W4GL("P1EZLI")@(STRING,LK)) Q:LK="" D .I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,"HSB")) S OK=1 Q .N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,I,"HSB")) S OK=1 Q Q OK ; HBN(STRING,DOC,NOMTD) ; N OK S OK=0 S NOMTD=$$^W4NOMTD(NOMTD,DOC) N ST S ST="" N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,I,"HSB")) D .S ST=ST_$G(^("HSB"))_"," I $L(ST) Q $E(ST,1,$L(ST)-1) ; N LK S LK="" F S LK=$O(@$$^W4GL("P1EZLI")@(STRING,LK)) Q:LK="" D .I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,"HSB")) S OK=1 Q .N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,I,"HSB")) D ..S ST=ST_$G(^("HSB"))_"," I $L(ST) S ST=$E(ST,1,$L(ST)-1) Q ST ; ; SETST ; ; N NP,IND1,IND2,IND3 S IND2=$G(M("SUGTD")) I IND2="" S IND2="-" S IND3=$G(M("NOMTD")) I IND3="" S IND3="-" S NP=$O(@VRM@(STRING,DATV,IND2,IND3,9999),-1)+1 S @VRM@(STRING,DATV,IND2,IND3,NP)=$G(M("SUMH"))_"\"_$G(M("HOVA"))_"\"_$G(M("ZHUT"))_"\"_$G(M("ITRA")) Q ; SLAVE(LKH) ; I $G(@$$^W4GL("P1EZL")@(LKH)) Q 1 Q 0 GAMHZ(STAM) Q $$GAMHZ^W4DLKM ; CBHB(STAM) Q $$CBHB^W4DLKM ; ZIC(SUGTD) ; I SUGTD=6!(SUGTD=7)!(SUGTD=11)!(SUGTD=12) Q 1 Q 0 ; NAMEDOC(SUGTD) ; N SUGTD1 S SUGTD1="" I SUGTD=0 Q "zncew dxzi" I SUGTD=1 Q "dpnfd" I SUGTD=2 Q "fekix zipeayg" I SUGTD=3 Q "dlaw" I SUGTD=4 Q "'ci zipeayg" I SUGTD=5 Q "'tn zipeayg" I SUGTD=6 Q "iekif zipeayg" I SUGTD=7 Q "'tn iekif zipeayg" I SUGTD=8 Q "dlaw/qn zipeayg" I SUGTD=9 Q "'tn dlaw/qn zipeayg" I SUGTD=10 Q "gelyn zcerz" I SUGTD=11 Q "iekif fekix zipeayg" I SUGTD=12 Q "xfgd zcerz" Q SUGTD1 ; PAGEBREAK ; W "",! W "

    ",! S PG=PG+1 S STC=$C(10,10,10,10) D S1 D KOT(LKH) S SHLN=0 Q ; KOT(LKH) ; I $G(%ARG("MELKH")),$G(%ARG("MELKH"))=$G(%ARG("ADLKH")) D DIVEX(LKH) W ""_LKH_" "_$$H2U^%L1FRM($$LKH^W4L(LKH))_"
    ",! S STC=$$LKH^W4L(LKH)_" "_LKH D S1C ; W "" D MEADL ; W " " W " ",! S STC=$$TV^%W1DICT("H","MEDATE") W " ",! S STC=$G(%ARG("MEDAT"))_" "_STC W " ",! S STC=$$TV^%W1DICT("H","ADDATE")_" "_STC W " ",! S STC=$G(%ARG("ADDAT"))_" "_STC D S1C W " ",! W "
    "_$$^%W1DICT("MEDATE")_""_$G(%ARG("MEDAT"))_""_$$^%W1DICT("ADDATE")_""_$G(%ARG("ADDAT"))_"
    ",! ; W "" W " " W " ",! S STC=$$KTVM^W4L(LKH) D S1C W " ",! S STC=$$TELB^W4L(LKH)_" : "_$$TV^%W1DICT("H","TEL") D S1C W " ",! W " ",! ; W "
    "_$$H2U^%L1FRM($$KTVM^W4L(LKH))_""_$$^%W1DICT("TEL")_" : "_$$TELB^W4L(LKH)_""_$$^%W1DICT("PAGE")_" : "_PG_"
    ",! W "
    ",! ; W "",! W " " D KAV W " " W " " W " " W " " S STC=$$HBR^%L1FRM($$TV^%W1DICT("H","SUMOFDOC"),DL-1) W " " S STC=$$HBR^%L1FRM($$TV^%W1DICT("H","HOVA"),DL-2)_" : "_STC W " " S STC=$$HBR^%L1FRM($$TV^%W1DICT("H","ZHUT"),DL-2)_" : "_STC W " " S STC=$$HBR^%L1FRM($$TV^%W1DICT("H","ITRA"),DL-2)_" : "_STC D S1 W " ",! D KAV Q ; RKV(RKV,COLOR,IT) ; I $G(COLOR)="" S COLOR="black" I 'RKV S RKV="" I RKV S RKV=$J(RKV,DR,DR) S STYLE=" style=""color:"_COLOR I RKV<0 S STYLE=" style=""color:red" I $G(IT) S STYLE=STYLE_";font-weight:bold" S STYLE=STYLE_"""" W "" Q SUGHB(NOM) ; N LK I NOM<0 Q 11 S LK=$G(@$$^W4GL("KLIN")@("H",NOM)) I LK["+" Q 2 I LK["W" Q 5 Q 4 ; SUGHBZ(NOM) ; N LK S LK=$G(@$$^W4GL("KLIN")@("TZ",NOM)) I LK["W" Q 7 I LK["+" Q 11 Q 6 ; SUGHMK(NOM) ; N LK S LK=$G(@$$^W4GL("KLIN")@("HMK",NOM)) I LK["W" Q 9 Q 8 ; HDSTYLE(STAM) ; Q " style=""color:brown;font-weight:bold""" ; DEBT(STAM) ; Q +$G(DEBT) ; ZHUT(DOC) ; I $G(DOC)="CB" Q 1 Q 0 ; MEADL ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! Q ; PRM ; D ^%W1PCVRM D TEMPL S %ARG("MEKVZ")=$G(MEKVZ) S %ARG("ADKVZ")=$G(ADKVZ) S PRTN=$$^%W1JB S DAT1=$$^%L1DC(MEDAT,2) S DAT2=$$^%L1DC(ADDAT,2) S MESTRING=$TR(MELKH,"-","") I MESTRING,MESTRING<1000,'$$^W4LKH S MESTRING=1000 S ADSTRING=$TR(ADLKH,"-","") D MEADSUGL^W4DLKM S:'ADSTRING (ADSTRING,ADLKH)=99999999999 S:'ADSUGL ADSUGL=99999 ;;S ASONLY=3-ASONLY S DT1=$$^%L1DC(DAT1,4) S DT2=$$^%L1DC(DAT2,4) Q ; BDKRKZ(STRING) ; N DAT,OK N GLRKZ S GLRKZ=$$^W4GL("P1LHB") N GLKL S GLKL=$$^W4GL("KLF") N NUM S NUM="" F S NUM=$O(@GLRKZ@(STRING,NUM)) Q:NUM="" D .N DT0 S DT0=$G(@GLRKZ@(STRING,NUM,"HB","DF")) Q:'DT0 .N DAT0 S DAT0=$ZD(DT0,"YYYYMMDD")_"0000" .N SUM S SUM=$G(@GLRKZ@(STRING,NUM,"HB","SHUM")) Q:'SUM .S OK=0 .N LKHR S LKHR=$G(@$$^W4GL("P1EZL")@(STRING)) .I $L(LKHR)>3 S STRING=LKHR .S DAT=DAT0 F S DAT=$O(@GLKL@(STRING,"KP",DAT)) Q:DAT="" D Q:OK ..I $D(@GLKL@(STRING,"KP",DAT,"H",NUM)) S OK=1 .Q:OK Q:NUM<1 .S DAT=$E(DAT0,1,8)_"0099" .S @GLKL@(STRING,"KP",DAT,"H",NUM)="\\"_SUM Q ; S1 ; Q:'$$CSR S SH=SH+1 S @S111@(SH)=$J(STC,$$WD) Q ; S1C ; Q:'$$CSR S STC=$$CENTR^%L1FRM(STC,$$WD) D S1 Q ; CSR(STAM) ; Q 1 Q +$G(%ARG("CSR")) ; KAV ; Q:'$$CSR N STC S STC=$TR($J("",$$WD)," ","-") D S1 Q ; WD(STAM) ; Q 38 ; PCCSR ; N (JB,%ARG,%REM) D ^W4MDPPC Q:'$L($G(PRINT)) S W4DELAY="" D ST^W4HZTH ;;K @$$^W4MAIN("S111") D ^W4CUT(PRINT,$G(%MDP("CUT"))) Q ; DR S DR=1 Q ; ; DIVEX(LKH) ; N I,HD,DAT,SUGTD,NOMTD,NP,ST,STC,%W1PCEX N TMP S TMP=$$^%W1GLPRM K @TMP ; S HD="dxzi*zekf*daeg*dcerz mekq*dcerz 'qn*jnqn beq*jix`z" S HD=$$INVD^%L1FRM(HD,"*","*") S @TMP@("GLOUT",1)=HD S I=1 ; S DAT="" F S DAT=$O(@VRM@(LKH,DAT)) Q:DAT="" D .S SUGTD="" F S SUGTD=$O(@VRM@(LKH,DAT,SUGTD)) Q:SUGTD="" D ..S NOMTD="" F S NOMTD=$O(@VRM@(LKH,DAT,SUGTD,NOMTD)) Q:NOMTD="" D ...S NP="" F S NP=$O(@VRM@(LKH,DAT,SUGTD,NOMTD,NP)) Q:NP="" D ....N A S A=$G(^(NP)) Q:A="" ....S ST="" ....S STC=$$^%L1DC(DAT,1) S ST=STC_"*" ....S STC=$$HBR^%L1FRM($$NAMEDOC(SUGTD),18) S ST=ST_STC_"*" .....S STC="[ "_$J(HBN,6)_" 'yg ]" S ST=ST_STC_"*" ....S STC=$J(NOMTD,DL) S ST=ST_STC_"*" ....S STC=$J($P(A,"\"),DL,2) S ST=ST_STC_"*" ....S STC=$J($P(A,"\",2),DL,2) S ST=ST_STC_"*" ....S STC=$J($P(A,"\",3),DL,2) S ST=ST_STC_"*" ....S STC=$J($P(A,"\",4),DL,2) S ST=ST_STC ....S I=I+1,@TMP@("GLOUT",I)=ST ; S %W1PCEX("NOHD")="" S %W1PCEX("NOHD1")="" ; D DIVEXC^%W1PC1("W4DLKP","%W1PCEX") Q W4DLMSTL W4DLMSTL(STAM) ; [ 30.12.20 06:32 ] [ 19.03.17 16:25 ] [ Q " style=""background-color:orange;color:black"" " ; DLM(STAM) ; Q " style=""background-color:yellow;color:black"" " W4DLPK W4DLPK(NMB) ; [ 15.02.24 13:16 ] [ 31.05.23 10:48 ] [ 09.12.20 08:17 ] I $G(NMB)="" Q 0 I $$^W4MSL(NMB) Q 0 I $$TAW(NMB) Q 1 Q 0 ; TAW(NMB) ; I $$^W4MSL(NMB) Q 0 N SUGL1 D SUGL1 I (SUGL1["TAW")!(SUGL1["TAKEAWAY")!(SUGL1["cx`il")!(SUGL1["wtlc") Q 1 I (SUGL1["T/A")!(SUGL1["xidn xa")!(SUGL1["xidnxa") Q 1 N MYDVN S MYDVN=$$^W4MYDVN I $$KUPA^W4PLUK(MYDVN) Q 1 I $$TAWM(NMB) Q 1 I $$TAW^W4PRM Q 1 Q 0 ; TAWM(NMB) ; I $$^W4MSL(NMB) Q 0 N SUGL1 D SUGL1 N MSL S MSL="migelyn" I SUGL1["TA"&(SUGL1[MSL)!(SUGL1["TAKEAWAY"&(SUGL1[MSL))!(SUGL1["zgwl") Q 1 Q 0 ; BAR(NMB) ; I '$G(NMB) Q 0 I $$^W4MSL(NMB) Q 0 N SUGL1 D SUGL1 I NMB=SUGL1["BAR"!(SUGL1["xa") Q 1 Q 0 ; SUGL1 ; S SUGL1=$TR($$SUGL1^W4L(NMB)," ./","") Q ; TAWHZM(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) I 'NMB Q 0 Q $$TAW(NMB) W4DLV W4MSD(NMB) ; [ 16.01.09 12:39 ] [ I $L($G(NMB))<4 Q 1 Q 0 W4DLVCSR W4DLVCSR(STAM) ; [ 16.03.22 15:08 ] [ 25.01.22 13:05 ] [ 18.09.18 17:05 ] ; -------------- DLVCSR = 1 - MISHLOHIM MI KUPA (DLV) ; -------------- DLVCSR = 2 - CALL CENTER (DLVWEB) ; -------------- DLVCSR = 0 OR "WEB" - MISHLOHIM ON LINE N DLVCSR I $G(%ARG("DLVCSR"))'="" Q %ARG("DLVCSR") I $$TELEPHONE^W4PRM D PUT^%W1PRM("DLVCSR",2) Q 2 I $$CCWEBR^W4PRM D KILL^%W1PRM("DLVCSR") Q 0 S DLVCSR=$$GETP^%W1PRM("DLVCSR") I DLVCSR>1 Q DLVCSR N NMB S NMB=$$GETP^%W1PRM("NMB") ; I NMB,DLVCSR?1N Q $$^W4MSL(NMB) ; I DLVCSR'["UNDEF",DLVCSR'="" Q DLVCSR ; I $$POS Q 1 I $$SYS&'$G(@$$^W4PRM@("MSD"))&'$G(@$$^W4PRM@("MTAW")) Q 1 I $$SYS&($G(@$$^W4PRM@("MSD"))!$G(@$$^W4PRM@("MTAW"))) Q "AND" Q 0 ; POS(STAM) ;---- IM BE EMDAT KUPA ESH MISHLOHIM I $G(%REM)="" Q 0 Q +$G(@$$^W4PRM@("MSL",%REM)) ; SYS(STAM) ; --- IM BE MAAREHET KUPA ESH MISHLOHIM I $$DLVWEB Q 0 Q +$G(@$$^W4PRM@("MSL")) ; MSD(STAM) ; --- IM BE MAAREHET KUPA ESH MISSADA I $G(@$$^W4PRM@("MSD"))!$G(@$$^W4PRM@("MTAW")) Q 1 Q 0 ; CSR(STAM) ; N CSR S CSR=$$GETP^%W1PRM("DLVCSR") I CSR="" Q +CSR Q CSR ; DLVWEB(STAM) ; --------- CALL CENTER I $$TELEPHONE^W4PRM Q 1 I $G(%ARG("DLVCSR"))=2 Q 1 I $$CSR=2 Q 1 Q 0 ; DLVWEBN(STAM) ; --------- CALL CENTER I $G(%ARG("DLVCSR"))=3 Q 1 I $$CSR=3 Q 1 Q 0 ; MOUSE(STAM) I $G(%ARG("DLVCSR"))=3 Q 1 I $$CSR=3 Q 1 Q 0 ; ONLINE(STAM) ; -------- MISHLOHIM ON LINE I $G(%ARG("DLVCSR"))="WEB"!($$CSR="WEB") Q 1 Q 0 ; DLV(STAM) ;------------- MISHLOHIM KUPA I $G(%ARG("DLVCSR"))=1 Q 1 I $$CSR=1 Q 1 Q 0 ; INIT ; D PUT^%W1PRM("NMB","") ; I $G(%ARG("FIRST")) D Q .D ^W4KORD(JB) Q ; PADDING(STAM) ; I $$^W4ELPOS Q $$^W4KF(5) I $$CALLCENTER^W4PRM Q 6 Q 6 W4DLVLK W4DLVLK ; [ 07.07.24 08:24 ] [ 18.08.23 11:16 ] [ 16.08.23 17:52 ] N (JB,%ARG,%REM) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" D ^%W1ARG ; S %REPN="DLVLK" ; K %L1PC S %REPN("TRH","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN S @$$^%W1GLREP@("MIUN","PROG")="TRH^W4DLVLK" D PUT^%W1PRM("HRFREP","w4dlvlk.jsp?JB="_JB_"&REPN="_%REPN) Q ; ; TRH N (JB,%ARG,%REM,METRH,ADTRH,%L1PC,%REPN) D VRM K @VRM S MEDATH=$$^%L1DC(METRH,3) S ADDATH=$$^%L1DC(ADTRH,3) ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I '$$KINDDAT D .S GL=$$^W4GL("W4LINKD") .F DT=MEDATH:1:ADDATH D ..I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) Q ..S HZM="" F S HZM=$O(@GL@(DT,HZM)) Q:HZM="" I $D(@$$^W4ORD@(HZM)) D ...S OK=1 D SETVRM(HZM,DT) Q:OK'=1 ; I $$KINDDAT=1 D .S GL=$$^W4GL("W4LINK") .S HZM="" F S HZM=$O(@GL@(HZM)) Q:HZM="" D ..S A=$G(^(HZM)) ..S DTHZ=$P(A,"~",6) ..I 'DTHZ D ...N TM S DTHZ=$P(A,"~",3),TM=$P(DTHZ,",",2)\3600 ...S DTHZ=$S(TM<$$SHAAZ^W4PRM&$$^W4SHAAZ:DTHZ-1,1:+DTHZ) ..I DTHZADDATH) Q ..I REPDAYS,'$E(REPDAYS,$$^%L1DC(DTHZ,8)) Q ..I '$D(@$$^W4ORD@(HZM)) Q ..S OK=1 D SETVRM(HZM,DTHZ) Q:OK'=1 ; I $$KINDDAT=2 D .S GL=$$^W4GL("P1H") .F DT=MEDATH:1:ADDATH D ..I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) Q ..S HZM="" F S HZM=$O(@GL@(DT,HZM)) Q:HZM="" I $D(@$$^W4ORD@(HZM)) D ...I $$SHUL^W4HZMST(HZM)+$$SHULA^W4HZMST(HZM)<$$TSHL^W4HZMST(HZM) Q ...S OK=1 D SETVRM(HZM,DT) Q:OK'=1 ; S %L1PC("CONTINUE")="" Q ; ; PRI N I F I="SUGL","LKHN","DT","HZM" D .I $G(@I)="" S @I=" - " .I $G(@I)["*" S @I=$TR(@I,"*","X") Q ; ; SETVRM(N,DT) ; I $$HZM^W4MSD(N) Q I $$^W4HZMH(N) Q I $$I^W4PIZUL(N) Q ; N NMB,SUM,B D VRM S NMB=$$NMB^W4HZMST(N) S SUM=$$TSHL^W4HZMST(N) S B=$G(@VRM@(NMB)) S B=B+$$^W4QNORD(N)_"\"_($P(B,"\",2)+SUM) S SUGL=$$SUGL^W4L(NMB) I SUGL="" S SUGL=" - " S @VRM@(NMB)=B S @VRM@(NMB,DT,N)=SUM Q ; ; VRM ; D ^%W1PCVRM Q ; LKHN ; I MELKHN,LKHNADLKHN S OK=0 Q S LKHN1=$$LKH^W4L(LKHN) ; S KTV=$$KTVM^W4L(LKHN) S SUGL=$$SUGL^W4L(LKHN) I MESUGL,SUGLADSUGL S OK=0 Q I 'SUGL S SUGL1=" - " I SUGL S SUGL1=$G(@$$^W4GL("SUGL")@(SUGL)) S TEL1=$$TELB^W4L(LKHN) S TEL2=$$PELE^W4L(LKHN) I METEL2,TEL2ADTEL2 S OK=0 Q Q ; HZM ; I MEHZM,HZMADHZM S OK=0 Q S x1=1 I $G(HZM),$$^W4PIZUL(HZM) S x1=2 S x2=$J($G(@GLOB),2,2) Q ; KINDDAT(STAM) ; Q +$$GETP^%W1PRM("KINDDAT") ; HEAD1(STAM) ; Q $$^%W1DICT($$HEAD) ; HEAD(STAM) ; I '$$NODLVORD^W4PRM Q "DLVCUSTREPORT" I $$KINDDAT=0 Q "DLVCUSTREPORTSNDDAT" I $$KINDDAT=1 Q "DLVCUSTREPORTORDDAT" I $$KINDDAT=2 Q "DLVCUSTREPORTPAYDAT" Q "" ; HEADDAT(STAM) ; I '$$NODLVORD^W4PRM Q "" I $$KINDDAT=0 Q "PERSNDDAT" I $$KINDDAT=1 Q "PERORDDAT" I $$KINDDAT=2 Q "PERPAYDAT" Q "" ; QUERYMN ; N GLREP D GLREP K MN N N,I S I=0 S I=I+1,MN(I)=$$^%W1DICT("BACK") S MA(I)=$$GET^W4STACK("REPBACK",1) ;;$$GETP^%W1PRM("REPBACK") S N="" F S N=$O(@GLREP@("QUERY",N)) Q:N="" D .S I=I+1,MN(I)=$$SPA^%L1FRM(N) .I MN(I)?1N.N." "."-".E D ..S MN(I)=$$CLR^%W1PC(MN(I)) .S MA(I)="w4dlvlkask.jsp?JB="_JB_"&QUERY="_$$CLWEB^%L1FRM(N)_"&FIRST=1" ; N ZERO S ZERO=1 D WMN^%W1WEBMN(.MN,.MA,"",1) Q ; GLREP ; S GLREP=$$^%W1GLREP Q W4DLVLK1 W4DLVLK1(LKH,DAT1,DAT2) ; [ 19.01.18 18:50 ] [ 18.01.18 21:14 ] [ N (JB,%ARG,%REM,LKH,DAT1,DAT2) S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; W "
    ",! ; W "
    ",! D ^W4BTN("PRINT","Print()","blue") W $$NBSP^%L1FRM(5) D ^W4BTN("CLOSE","Close()","red") W "
    ",! ; W "
    ",! ; W "",! W LKH_" "_$$H2U^%L1FRM($$LKH^W4L(LKH)) W "",! W "
    " W "",! W $$H2U^%L1FRM($$KTVM^W4L(LKH)) W "
    " W $$^%W1DICT("TEL")_" : "_$$TEL^W4L(LKH) I $$PELE^W4L(LKH) W " , "_$$PELE^W4L(LKH) I $L($$EMAIL^W4L(LKH)) D .W "
    " .W $$^%W1DICT("EMAIL")_" : "_$$EMAIL^W4L(LKH) W "    ",! W "

    " ; W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("KINDOFDOCUMENT")_""_$$^%W1DICT("NUMBEROFDOC")_""_$$^%W1DICT("SUMOFDOC")_""_$$^%W1DICT("HOVA")_""_$$^%W1DICT("ZHUT")_""_$$^%W1DICT("ITRA")_"
     "_RKV_" 
    "_$$^%W1DICT("MESUGL")_""_MESUGL_" "_MESUGL1_""_$$^%W1DICT("ADSUGL")_""_ADSUGL_" "_ADSUGL1_"
    "_$$^%W1DICT("MELKH")_""_MELKH_""_$$^%W1DICT("ADLKH")_""_ADLKH_"
    " W "" W "" W "" W "" W "",! ; S VRM=$$^W4MAIN("VRM") N SQN,SSUM S (SQN,SSUM)=0 S DT=DT1-1 F S DT=$O(@VRM@(LKH,DT)) Q:DT="" D .S HZ="" F S HZ=$O(@VRM@(LKH,DT,HZ)) Q:HZ="" D ..W "" ..W " " ..W " " ..S TS=$$TSHL^W4HZMST(HZ) ..W " " ..W "",! ..S SQN=SQN+1,SSUM=SSUM+TS ; W "",! W "" W "" W "" W "",! W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("ORDER")_""_$$^%W1DICT("SUM")_"
    "_$ZD(DT,"DD.MM.YY")_" "_HZ_" "_$J(TS,2,2)_"
      "_$$^%W1DICT("TOTALORDERS")_" : "_SQN_" "_$J(SSUM,2,2)_"
    ",! W "",! Q W4DLVNNX W4DLVNNX ; [ 12.11.24 18:39 ] [ 18.09.24 15:35 ] [ 16.09.24 13:22 ] N (JB,%ARG,%REM,%REPN,FMT,%W1LNG) S:'$D(FMT) FMT=0 D ^%L1TS N DIR S DIR=$$DIRL N FL S FL=DIR_"W4DLVNON"_$$^W4MYDVN S FLCSV=FL_".csv" N A,B,I,J,RZD S RZD="," C FLCSV:(DELETE) ZSY "rm -f "_FLCSV ;;W "FLCSV="_FLCSV,! O FLCSV:(REWIND:NEWVERSION:WRITE) ; U FLCSV ;;W $$RKV("gewl 'qn")_$$RKV("gewl my")_$$RKV("zaezk")_$$RKV("mipetlh")_$$RKV("qwt")_$$RKV("l""`ec"),! W $$RKV("gewl 'qn")_$$RKV("gewl my")_$$RKV("zaezk")_$$RKV("mipetlh")_$$RKV("l""`ec")_$$RKV("qpis")_$$RKV("dfnpez"),! ; S VRM=$$^W4MAIN("VRM") S N="" F S N=$O(@VRM@(N)) Q:N="" D .S A=$G(^(N)) .D PRS^%L1FRM(A,"LKH1~KTV~TEL~MAIL~SNIF","~") .S ORDS=$G(@VRM@(N,"QN")) .S SNIF1="" I SNIF S SNIF1=$$MSD^W3R(SNIF) .W $$RKV(N)_$$RKV(LKH1)_$$RKV(KTV)_$$RKV(TEL)_$$RKV(MAIL)_$$RKV(SNIF1)_$$RKV(ORDS),! C FLCSV ; Q ; ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; DIRWEB(STAM) ; N DIR S DIR=$$WEB^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; RKV(VL) S VL=$$SPA^%L1FRM(VL) I VL="" G RKVE I $$ISNUM^%L1FRM(VL) G RKVE S VL=$TR(VL,","," ") S VL=$TR($$INVH^%L1FRM(VL),TS0,TS1) S VL=$TR(VL,","," ") RKVE ; I $G(FMT)=1 Q VL_$C(9) Q VL_"," ; FMT(FMT) ; I $G(FMT) Q "txt" Q "csv" ; W4DLVNO W4DLVNO(MEDAT,ADDAT) ; [ 21.08.19 07:23 ] [ 28.05.18 16:13 ] [ 20.01.18 15:30 ] N (JB,%ARG,%REM,MEDAT,ADDAT) I $G(%ARG("SHOW"))=0 Q D ^%W1ARG D PUT^%W1PRM("KINDDAT",$G(%ARG("KINDDAT"))) ; D CRVRM(MEDAT,ADDAT,JB) ; D ^W4DLVNOX ; W "

    ",! W " " W $$^%W1DICT("CUSTOMLISTDLVNOT<>"_MEDAT_"<>"_ADDAT) W "
    " W $$^%W1DICT($$HEADDAT^W4DLVLK) W " ",! W "     ",! W "

    ",! W "",! W "" W "",! W "" W "" W "
    ",! S FL="W4DLVNO"_$$^W4MYDVN S FLCSV=$$DIRWEB^%W1PCEX_FL_".csv" W " "_FL_".csv",! W "" W " " W "
    ",! ; W "",! W "" W "" W "" W "" ;;W "" W "" W "" W "" W "" ; S GLLK=$$^W4GL("KLF") ; -- WAS LKH S VRM=$$^W4MAIN("VRM") ; S N=999 F S N=$O(@GLLK@(N)) Q:N="" D .I $D(@VRM@(N)) Q .W "" . W "" . W "" . W "" . ;;W "" . S PHONES=$$TELB^W4L(N) . S PELE=$$PELE^W4L(N) . I $L(PELE)>6,PELE'=PHONES D .. I $L(PHONES)<7 S PHONES=PELE Q .. S PHONES=PHONES_","_PELE . W "" . W "" . W "" .W "",! W "
    "_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("ADDRESS")_""_$$^%W1DICT("CITY")_""_$$^%W1DICT("PHONES")_""_$$^%W1DICT("FAX")_""_$$^%W1DICT("EMAIL")_"
    "_N_""_$$H2U^%L1FRM($$LKH^W4L(N))_""_$$H2U^%L1FRM($$KTVM^W4L(N))_""_$$H2U^%L1FRM($$CITY^W4L(N))_""_PHONES_""_$$FAX^W4L(N)_""_$$EMAIL^W4L(N)_"
    ",! W "
    ",! Q ; ; CRVRM(METRH,ADTRH,JB) ; D TRH^W4DLVLK Q ; SELKDAT ; W "",! Q ; DOPASKSEL(VL) Q $$DOPASKSEL^%W1PCS($G(VL)) W4DLVNON W4DLVNON(MEDAT,ADDAT) ; [ 18.09.24 12:54 ] [ 17.09.24 14:47 ] [ 16.09.24 14:06 ] N (JB,%ARG,%REM,MEDAT,ADDAT) I $G(%ARG("SHOW"))=0 Q D ^%W1ARG ;;D PUT^%W1PRM("KINDDAT",$G(%ARG("KINDDAT"))) D PUT^%W1PRM("KINDDAT",1) ; S TKFO=30.5*$G(%ARG("TKFO"))\1 S ^BB("TKFO")=TKFO ; D CRVRM(MEDAT,ADDAT,JB) ; D ^W4DLVNNX ; W "
    ",! ; D OPTBL W "" W "",! S FL="W4DLVNON"_$$^W4MYDVN S FLCSV=$$DIRWEB^%W1PCEX_FL_".csv" W " "_FL_".csv",! W "",! W "" W " " W "" W "" W "",! ; D OPTBL2,OPTBL1 ; S GLORD=$$^W4GL("W3ORD") S VRM=$$^W4MAIN("VRM") ; S RZ=40,II=0,K=0 ; S N="" F S N=$O(@VRM@(N)) Q:N="" D .N A S A=$G(^(N)) .I MINORDS,$G(@VRM@(N,"QN"))RZ D ..W "",! ..I $G(%ARG("PRINT")) D PGBREAK ..I '$G(%ARG("PRINT")) W "

     

    ",! ..D OPTBL,OPTBL1 ..S II=1 .N LKH1,KTV,PHONES,EMAIL,MSD .S LKH1=$P(A,"~") .S KTV=$P(A,"~",2) .S PHONES=$P(A,"~",3) .S EMAIL=$P(A,"~",4) .S MSD=$P(A,"~",5) . .W "" . W ""_K_"" . W ""_N_"" . W ""_$$H2U^%L1FRM(LKH1)_"" . W ""_$$H2U^%L1FRM(KTV)_"" . W ""_PHONES_"" . W ""_EMAIL_"" . W ""_$$H2U^%L1FRM($$MSD^W3R(MSD))_"" . W ""_$G(@VRM@(N,"QN"))_"" .W "",! ; W "",! W "
    ",! Q ; ; CRVRM(METRH,ADTRH,JB) ; N (JB,%ARG,METRH,ADTRH,MSDR,TKFO) S GLORD="^|"""_$$^W3MAIN_"""|W3ORD" S MEDT=$$^%L1DC(METRH,3) S ADDT=$$^%L1DC(ADTRH,3) S MEDTO=MEDT-TKFO S ADDTO=MEDT+1 N GL S GL="^|"""_$$^W3MAIN_"""|W3LINKDR" N VRM S VRM=$$^W4MAIN("VRM") K @VRM ; S KIOSK="0500000000" F DT=MEDTO:1:ADDTO D .D SCRIPT($ZD(DT,"DD.MM.YY")) .S ORD="" F S ORD=$O(@GL@(DT,ORD)) Q:ORD="" D ..S MSD=$P($G(^(ORD)),"~") I MSD="" Q ..I '$D(^|$$^W3MAIN|W3MSDR(MSDR,MSD)) Q ..S ^BB1(MSD)="" ..S LK=$$LK(ORD,GLORD) ..I LK="" S ^BB(ORD)=1 Q ..S LK1=$$LKHN1^W3HZMST(ORD,GLORD) ..S LK1=$$SPA^%L1FRM(LK1) ..I LK1?.P S LK1=$$NAME^W3HZMST(ORD) ..S LK2=$TR(LK1,". ","") ..I LK1?.P!(LK2="TAW")!(LK2="TAKEAWAY") S ^BB(ORD)=2 Q ..S ADR=$$KTV^W3HZMST(ORD,GLORD) ..S ADR=$$SPA^%L1FRM(ADR) ..S TEL=$$SPA^%L1FRM($$TELB^W3HZMST(ORD,GLORD)) ..I TEL="" S TEL=$$NMB^W3HZMST(ORD,GLORD) ..S TEL=$$TEL(TEL) ..I TEL=KIOSK S TEL="" ..S PELE=$$SPA^%L1FRM($$PELE^W3HZMST(ORD,GLORD)) ..S PELE=$$TEL(PELE) ..I PELE,$TR(PELE,"-","")'=$TR(TEL,"-","") S TEL=TEL_$S($L(TEL):",",1:"")_PELE ..I TEL?.P!(TEL=KIOSK) S ^BB(ORD)=3 Q ..S MAIL=$$SPA^%L1FRM($$EMAIL^W3HZMST(ORD,GLORD)) ..S @VRM@(LK)=LK1_"~"_ADR_"~"_TEL_"~"_MAIL_"~"_MSD ..S @VRM@(LK,"QN")=$G(@VRM@(LK,"QN"))+1 ; F DT=MEDT:1:ADDT D .D SCRIPT($ZD(DT,"DD.MM.YY")) .S ORD="" F S ORD=$O(@GL@(DT,ORD)) Q:ORD="" D ..S MSD=$P($G(^(ORD)),"~") Q:MSD="" ..I '$D(^|$$^W3MAIN|W3MSDR(MSDR,MSD)) Q ..S LK=$$LK(ORD,GLORD) Q:'LK ..;;W "LKKILL="_LK,! ..K @VRM@(LK) Q ; ; ASKSEL(VL) W "",! Q ; MINORDS(VL) W $$^%W1DICT("QNPREVORDS") W "",! Q ; LK(ORD,GLORD) ; N LK S LK=$$LKHN^W3HZMST(ORD,GLORD) S LK=$$SPA^%L1FRM(LK) I LK="" S LK=$$NMB^W3HZMST(ORD,GLORD) Q $TR(LK,"- ","") ; TEL(TEL) ; S TEL=$TR(TEL,"- ","") I $E(TEL,1,3)=972 S TEL="0"_$E(TEL,4,20) I $E(TEL,1,4)="+972" S TEL="0"_$E(TEL,5,20) I $E(TEL,1,2)="05" S TEL=$E(TEL,1,3)_"-"_$E(TEL,4,20) E S TEL=$E(TEL,1,2)_"-"_$E(TEL,3,20) Q TEL ; OPTBL ; W " ",! W $$^%W1DICT("CUSTOMLISTDLVNOT<>"_MEDAT_"<>"_ADDAT) W "
    " W $$^%W1DICT($$HEADDAT^W4DLVLK) W " ",! W "     ",! W "

    ",! ; D OPTBL2 Q ; ; OPTBL1 ; W "" W ""_$$^%W1DICT("NPP")_"" W ""_$$^%W1DICT("CUSTOMNUMBER")_"" W ""_$$^%W1DICT("CUSTOMNAME")_"" W ""_$$^%W1DICT("ADDRESS")_"" ;;W ""_$$^%W1DICT("CITY")_"" W ""_$$^%W1DICT("PHONES")_"" ;;W ""_$$^%W1DICT("FAX")_"" W ""_$$^%W1DICT("EMAIL")_"" W ""_$$^%W1DICT("SNIF")_"" W ""_$$^%W1DICT("QNPREVORDS")_"" W "" ; Q ; ; OPTBL2 ; W "",! Q ; PGBREAK ; W "

    ",! Q ; SCRIPT(DAT) ; Q W "",! Q W4DLVNOX W4DLVNOX ; [ 12.11.24 18:39 ] [ 22.08.19 07:40 ] [ 21.08.19 07:55 ] N (JB,%ARG,%REM,%REPN,FMT,TOT,%W1LNG,MSD) S:'$D(FMT) FMT=0 D ^%L1TS N DIR S DIR=$$DIRL N FL S FL=DIR_"W4DLVNO"_$$^W4MYDVN S FLCSV=FL_".csv" N A,B,I,J,RZD S RZD="," C FLCSV:(DELETE) ZSY "rm -f "_FLCSV ;;W "FLCSV="_FLCSV,! O FLCSV:(REWIND:NEWVERSION:WRITE) ; U FLCSV W $$RKV("gewl 'qn")_$$RKV("gewl my")_$$RKV("zaezk")_$$RKV("mipetlh")_$$RKV("qwt")_$$RKV("l""`ec"),! ; S VRM=$$^W4MAIN("VRM") S N=999 F S N=$O(@$$^W4GL("KLF")@(N)) Q:N="" D .I $D(@VRM@(N)) Q .W $$RKV(N)_$$RKV($$LKH^W4L(N))_$$RKV($$KTV1^W4L(N))_$$RKV($$TEL^W4L(N))_$$RKV($$FAX^W4L(N))_$$RKV($$EMAIL^W4L(N)),! ; C FLCSV ; Q ; ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; DIRWEB(STAM) ; N DIR S DIR=$$WEB^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q DIR ; RKV(VL) S VL=$$SPA^%L1FRM(VL) I VL="" G RKVE I $$ISNUM^%L1FRM(VL) G RKVE S VL=$TR(VL,","," ") S VL=$TR($$INVH^%L1FRM(VL),TS0,TS1) S VL=$TR(VL,","," ") RKVE ; I $G(FMT)=1 Q VL_$C(9) Q VL_"," ; FMT(FMT) ; I $G(FMT) Q "txt" Q "csv" ; W4DLVNPR W4DLVNPR(JB) ; [ 30.12.20 20:08 ] [ 09.12.20 08:18 ] [ 03.12.20 08:13 ] N (JB,%ARG,%REM) S NMB=$$GETP^%W1PRM("NMB") I 'NMB S NMB=$$NMB^W3HZMST(JB) ; I 'NMB Q 0 ; ;;I 'NMB,$$NMB^W4TMPHD D .S @$$^W4TMPORD=$$GET^W4TMPHD .S NMB=$$NMB^W4TMPHD ; I $$^W4MSD(NMB) Q 0 ; I '$$MOUSEORD Q 0 Q 1 ; MOUSEORD(STAM) ; N MYDVN S MYDVN=$$^W4MYDVN I $$TELEPHONE^W4PRM!$$NODLVORD^W4PRM!$$DLVMOUSE^W4PRM!$G(@$$^W4PRM@("DLVMOUSE",MYDVN)) Q 1 Q 0 W4DLVOR0 W4DLVORD(OPT) ; [ 29.05.19 08:43 ] [ 16.05.19 18:48 ] [ 08.05.19 07:00 ] ; === OPT=PC === ; --- OPT=0 -- ; COPY PREV ORDER ; ; --- OPT=1 -- NO SUBMIT ORDER LIST FOR RESTAURANT ; w3rcvhd -> SbmRadio -> w3rcvord PC=1 ; --- OPT=2 -- SUBMIT ORDER LIST FOR RESTAURANT ;w3rcvhd -> SbmRadio -> w3rcvord PC=2 ; --- OPT=3 -- DELETE ORDER LIST FOR RESTAURANT ;w3rcvhd -> SbmRadio -> w3rcvord PC=3 ; --- OPT=4 -- ALL ORDERS ( ELPOS ) ; WITH PHONE - UNREGISTER CUSTOMER REPORT ; w3guest -> ShowStat -> w3rcvord (PC=4, PHONE,HOME) ; WITH CODE - REGISTER CUSTOMER REPORT ; - w3member ; WITHOUT CODE,PHONE - RESTAURANT REPORT ; -- w3rcvhd -> SbmRadio -> w3rcvord PC=4 ;------------------------------------------------------- N (JB,CODE,OPT,HOME,PHONE,%ARG,LKH,LKHR,SUGT,%REM) I '$G(JB) Q ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; I $D(@$$^W4GL("W4LINKDR"))<10 D CRLINKDR ; D CLRCOPY^W4MENU ; I $$SNDKTC D .K %ARG("DISPATH") .D KILL^%W1PRM("DISPATH") ; I $$TOMORROW D .N DT0 S DT0=$H+1 .S %ARG("MEDAT")=$ZD(DT0,"DD.MM.YY") .N DT S DT=DT0 .I $$^%L1DC(DT0,8)>5,$$SF^W4PRM D ..N DT1 F DT1=DT0:1:DT0+100 Q:$$^%L1DC(DT1,8)=1 ..S DT=DT1 .S %ARG("ADDAT")=$ZD(DT,"DD.MM.YY") .S %ARG("FUTUREORDS")=1 ; D INIT ; W "

    ",! ; I $$CUSTLASTORDS D G TOTLAB .D INITVIB .N N,I,LK S LK=$$CUSTLASTORDS .S TXTMRQ="" .S FIRSTLINE=1 .W "
    " . N STYLE S STYLE="font-size:"_$$^W3FSZ(16) . I $$CUSTALL D . .D ^W4BUTTON("lastords","SHOWLASTORDS","CustLastOrders1('"_LK_"','0')",STYLE) . I '$$CUSTALL D . .D ^W4BUTTON("allords","SHOWALLORDS","CustLastOrders1('"_LK_"','1')",STYLE) .W "

    " .D TBORD .D PUT^%W1PRM("CUSTLASTORDS",LK) .S N="",I=0 F S N=$O(@$$^W4GL("W4LINKI")@(LK,MSD,N),-1) Q:N="" I N D ..S I=I+1 I '$$CUSTALL,I>9 Q ..S W4DLVORD=N ..D SHOWORD(MSD,N,0) ; I $$MIKUM D .S %ARG("TIMESORT")=1 .S %ARG("SHORTSHOW")=1 .S %ARG("NOSENDEDORDS")=0 .S %ARG("SENDEDORDS")=1 .S %ARG("BIDS")=0 .S %ARG("DELETEDORDS")=0 .S %ARG("NOPAIDORDS")=1 .S %ARG("PAIDORDS")=1 .S %ARG("SHOWTAW")=0 .S %ARG("ASCENDING")=0 .S %ARG("FUTUREORDS")=0 .S %ARG("SIK")=0 ; I $$DISPATH D .S %ARG("NOSENDEDORDS")=1 .I $G(%ARG("TIMESORT"))'=0 S %ARG("TIMESORT")=1 .I $G(%ARG("ASCENDING"))'=0 S %ARG("ASCENDING")=1 .I $G(%ARG("SHORTSHOW"))'=0 S %ARG("SHORTSHOW")=1 .I $G(%ARG("DELETEDORDS"))="" S %ARG("DELETEDORDS")=0 .I $G(%ARG("NOSENDEDORDS"))="" S %ARG("NOSENDEDORDS")=1 .I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 .I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 .S %ARG("BIDS")=1 .I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")=1 ; I '$$DISPATH D SETARG ; I $G(%ARG("NOSENDEDORDS"))=0 D .S %ARG("FUTUREORDS")=0 .S %ARG("BIDS")=0 ; I $$VIEWRCV G DIR ; I $$SHOW4COPY D ; -- SHOW FOR COPY .W "

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

    ",! ; I '$$SHOW4COPY,'$$MY,'$$REPTRH D .;;W "

    "_$$T^%L1TIME($P($H,",",2))_"

    ",! .N MEDAT,ADDAT,KOT,GLLINK .S MEDAT=$G(%ARG("MEDAT")),ADDAT=$G(%ARG("ADDAT")) .S GLLINK=$G(%ARG("GLLINK")) .I GLLINK="" D ..I MEDAT=ADDAT S KOT=$$^%W1DICT("ORDERSLIST2DAY",MEDAT) ..I MEDAT'=ADDAT S KOT=$$^%W1DICT("ORDERSLIST2PERIOD",MEDAT_"<>"_ADDAT) .I GLLINK="W4LINKDR" D ..I MEDAT=ADDAT S KOT=$$^%W1DICT("ORDERSRCV2DAY",MEDAT) ..I MEDAT'=ADDAT S KOT=$$^%W1DICT("ORDERSRCV2PERIOD",MEDAT_"<>"_ADDAT) .W "

    "_KOT_"

    ",! .I $$TOMORROW D ..D BUTTON("printords1",$$^%W1DICT("PRINTALLORDSMDB"),"PrintAllOrds('1')","color:blue;font-size:"_$$^W3FSZ(16)) ..W $$NBSP^%L1FRM(5) ..D BUTTON("printords2",$$^%W1DICT("PRINTALLORDSNOMDB"),"PrintAllOrds('0')","color:blue;font-size:"_$$^W3FSZ(16)) ..I $$SF^W4PRM D ...W $$NBSP^%L1FRM(5) ...D BUTTON("printords3",$$^%W1DICT("PRINTALLKOTMDB"),"PrintAllKotMdb()","color:blue;font-size:"_$$^W3FSZ(16)) ; DIR ; S DRC=$S($G(%ARG("ASCENDING")):1,1:-1) ; S TXTMRQ="" S FIRSTLINE=1 ; K @$$^W4MAIN("VIB") K @$$^W4MAIN("TMP") ; ;;I $G(%ARG("KNDO"))="BID" D .D ^W4BTN("SENDALLBID2MAIL","SendAllBid2Mail()") ; D CRVIB(1) ; -- PROYTI VES CYCL NE POKAZYVAYA ; I $$MY D .W "
    " .W " " . W " " .W " ",! .W "
    " . W $$SHOW^W4KOTMLZ($$MY,"12B") . W "
    ",! .W "
    ",! ; I $$REPTRH D KOTREPTRH ; I '$$VIEWRCV,'$$SNDKTC,'$$REPTRH D KOT ; I '$$REPTRH,'$$MIKUM D DIVPSL ; K @$$^W4MAIN("TMPIRTM") ; D TBORD ; I $E($G(%ARG("ORDER")))="W"!($E($G(%ARG("ORDER")))="w") D .N ORD S ORD=+$E(%ARG("ORDER"),2,20) .I $G(@$$^W4GL("HZLINKI")@(ORD)) S %ARG("ORDER")=$P(^(ORD),"\") Q .S HZMLAK=$E($G(%ARG("ORDER")),2,12) .K %ARG("ORDER") ; I $G(%ARG("ORDER")) D G TOTLAB ; -- SHOW ONE ORDER .N MSDHZ S MSDHZ=$P($G(@$$^W4GL("W4LINK")@(%ARG("ORDER"))),"~") Q:'MSDHZ .I $G(MSD),MSDHZ'=MSD Q .I $G(%ARG("MSDR")),'$D(^[$$^W3MAIN]W3MSDR(%ARG("MSDR"),MSDHZ)) Q .N JB S W4DLVORD=%ARG("ORDER"),JB=W4DLVORD .D SHOWORD(MSDHZ,%ARG("ORDER"),0) ; ; I '$G(%ARG("SIK")) D CRVIB(0) ; -- PROYTI VES CYCL & POKAZAT ; TOTLAB ; I '$$DISPATH,'$$VIEWRCV,'$$SNDKTC D TOT W "",! ; W "
    ",! ; I '$$VIEWRCV,'$$REPTRH D BUTTONS ; W "",! ; W "


    ",! ; ;K ^[$$^W3MAIN]TMPORD(JB) ;I $D(^[$$^W3MAIN]TMPORDB(JB)) D ;.M ^[$$^W3MAIN]TMPORD(JB)=^[$$^W3MAIN]TMPORDB(JB) ; END Q ; ; GLLINK(STAM) ; N GLLINK S GLLINK=$$^W4GL("W4LINKD") I $L($G(%ARG("GLLINK"))) S GLLINK=$$^W4GL(%ARG("GLLINK")) Q GLLINK ; ; TBORD ; W "",! D KOTTB Q ; INITVIB ; K SPAY,SHZ,SDMS,SNEW,SMKR,SHNH S (SPAY,SHZ,SDMS,SHNH,SNEW,SNEWDM,SNEWHN,SNEWPAY,SDEL,SSBM,SNOSHUD,SNOSBM,SNOSHUL,SNODLV)=0 S (SPAYM,SHZM,SDMSM)=0 K SMSD,SCODTS Q ; CRVIB(NOPC) ; N HZMH D INITVIB ;;S ^LV("W4DLVORD-CRVIB","NOPC")=$G(NOPC) I '$G(NOPC) G CRVIB1 N SHAAGV S SHAAGV=$$SHAAGV ; ;;W " MEDT="_$G(MEDT)_" ADDT="_ADDT,! ; *** N DT I $G(MEDT),$G(ADDT) F DT=MEDT:1:ADDT+1 D .N DTTO,SHAA,SL,N .S N="" F S N=$O(@$$GLLINK@(DT,N)) Q:N="" D ..I '$$MSL^W4MSL(N) Q ..S DTTO=$$^%L1DC($$TRH^W4HZMST(N),3) ..S SHAA=$$SHAA^W4HZMST(N) .. ..I $G(%ARG("GLLINK"))="W4LINKDR" D ...S DTTO=$$^%L1DC($P($$DATCB^W4HZMST(N)," "),3) ...S SHAA=$P($$DATCB^W4HZMST(N)," ",2) .. ..I DTTO>ADDT,$$SHAA^W4HZMST(N)'<$$SHAAGV Q ..I 'DTTO S DTTO=$$^%L1DC($P($$DATCB^W4HZMST(N)," "),3) ..I $$DISPATH!$$SNDKTC,DTTO($H+1)) Q ..I $$DISPATH!$$SNDKTC,DTTOADSUM Q D D(14) ; N HZMLAKHZ S HZMLAKHZ=$$HZMLAK^W4HZMST(N) S:$E(HZMLAKHZ)="W" HZMLAKHZ=$E(HZMLAKHZ,2,10) I $G(HZMLAK)'="",HZMLAK'=HZMLAKHZ,HZMLAK'=+$$HRAED^W4HZMST(N),HZMLAK'=$$INVH^%L1FRM(HZMLAKHZ) Q D D(15) ; I $TR(CUSTOM,"-","")?1N.N,CUSTOM'=$$NMB^W4HZMST(N) Q I $L(CUSTOM),$TR(CUSTOM,"-","")'?1N.N,'$$SRCH^W1SRCH($$NAME^W4HZMST(N),CUSTOM),'$$SRCH^W1SRCH($$MAZMIN^W4HZMST(N),CUSTOM) Q ; I $G(NCA),'$$CMPR(N,NCA) Q D D(16) ; I $G(OPT)=1,$$SENDEDORD(N)!$$DELORD(N) D D(16.1) Q ;-- WAITING ; I $G(%ARG("SUGTS")),%ARG("SUGTS")'=$$CODTS^W4HZMST(N) D D(16.5) Q ; I $$DISPATH,$$TAW,'$$TAKEAWAY^W4HZMST(N) Q I $$DISPATH,$$PIZUL(N) Q ; I '$$TAW,'$G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N) Q ; I $$KNDO="NSND",$$SENDEDORD(N) Q I $$KNDO="SND",'$$SENDEDORD(N) Q I $$KNDO="FTR",'$$FUTURE(N) Q I $$KNDO="DEL",'$$DELORD(N) Q I $$KNDO="TAW",'$$TAKEAWAY^W4HZMST(N) Q I $$KNDO="BID",'HZMH Q I $$KNDO="PD",$$NOSHUL(N) Q I $$KNDO="NPD",'$$NOSHUL(N) Q I $$KNDO="TBIDS",'HZMH Q ; I '$G(%ARG("DELETEDORDS")),$$DELORD(N),'$G(%ARG("NCA")) D D(19.5) Q ; I $G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N),'HZMH G VIBSHOW ; ;;I $G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N),'$$DELORD(N),'HZMH,'$$DISPATH G VIBSHOW ; I $G(%ARG("DELETEDORDS")),$$DELORD(N) G VIBSHOW ; ;;I $G(%ARG("BIDS")),HZMH,'$$DELORD(N) G VIBSHOW ; I '$G(%ARG("SENDEDORDS")),'$G(%ARG("ALLORDS")),$$SENDEDORD(N),'$$DELORD(N),'HZMH D D(16.2) Q I '$G(%ARG("NOSENDEDORDS")),'$$SENDEDORD(N),'$$DELORD(N),'HZMH D D(16.3) Q D D(17) ; I $G(OPT)=2,'$$SENDEDORD(N)!$$DELORD(N) D D(18) Q ; -- SUBMIT I $G(OPT)=3,'$$DELORD(N) D D(19) Q ; -- DELETE ; D D(19.6) I $$SNDKTC,$$KINDORD="NOSENDED",$$SNDKTCORD(N) D D(19.8) Q ; I '$G(%ARG("NOPAIDORDS")),$$NOSHUL(N),'$$DELORD(N),'HZMH Q I '$G(%ARG("PAIDORDS")),'$$NOSHUL(N),'$$DELORD(N),'HZMH Q ; D D(21) ; N DATHZ S DATHZ=$$DTHZ(N) ;;W "N="_N_" MEDT="_MEDT_" ADDT="_ADDT_" DATHZ="_DATHZ_" CODEHZ="_CODEHZ_"
    ",! I $G(MEDT),DATHZADDT Q D D(24) ; I '$G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N) Q ; D D(25) I '$G(%ARG("BIDS")),HZMH Q ; D D(26) VIBSHOW ; N DATHZ S DATHZ=$$DTHZ(N) I $G(MEDT),DATHZADDT Q N PSL D D(27) I $$MIKUM S PSL=+$P(FULLIND,"^") I $D(MPSL(PSL)) D D(28) Q VIBSHOW1 ; D SHOWORD(MSDHZ,N,NOPC) ; N SHAA,MN S SHAA=$$SHAA^W4HZMST(N) S MN=10000+$TR($J(SHAA*60+$P(SHAA,":",2),4)," ",0) S @$$^W4MAIN("VIB")@(FULLIND)="" I $G(PSL) S MPSL(PSL)="" ; Q ; SENDEDORD(HZ) ; I $$PSL^W4HZMST(HZ) Q 1 I $$PIZUL(HZ) Q 1 Q 0 ; DELORD(HZ) ; I $$DEL^W4DEL(HZ) Q 1 I $$TSHL^W4HZMST(HZ)<0 Q 1 ;;I $$DTHZ(HZ)<$$^W4DZ,'$$SENDEDORD(HZ),$$NOSHUL(HZ),'$$NIGHT^W4PRM Q 2 I $D(@$$^W4ORD@(HZ))'=11 Q 3 Q 0 ; FUTURE(N) ; N DATHZ S DATHZ=$$DTHZ(N) I DATHZ>$H Q 1 Q 0 ; SHAAGV(STAM) I '$$^W4SHAAZ Q 5 Q $$SHAAZ^W4PRM ; FAXORD(HZ) ; I $D(@$$^W3ORD(HZ)@(HZ,"F")) Q 1 Q 0 ; HZMH(HZ) ; I $$^W3PRCOFR(HZ) Q 1 Q 0 ; MOUSEOVER ; N PRMHZ S PRMHZ=N_"~"_$G(MEDT)_"~"_$G(ADDT)_"~"_$G(LKH) W " onMouseOver=""ChangeCursor(this)"" onClick=""ShowOrd('"_N_"','"_PRMHZ_"',1)""",! Q ; ; SHOWORD(MSD,N,NOPC) ; ;;S ^LV("W4DLVORD-SHOWORD0",N)=$G(NOPC) N HZMH,PSL,MPSL S HZMH=$$^W4HZMH(N) D GL I $D(@GL@(N))<11 Q D D(29) S N=$TR(N," ","") ; ;;S ^LV("W4DLVORD-SHOWORD",N)=$G(NOPC) ; N DAT,SHAA,IR ;;,JB S JB=N S DAT=$$TRH^W4HZMST(N) S SHAA=$$SHAA^W4HZMST(N) S IR=$$IR^W4HZMST(N) N CMHD S CMHD=$$HRA2^W4HZMST(N) ; --------- ORDER NUMBER --------- ; D COMPTOT(N) ; I $G(NOPC) D Q ; -- PREPAIR BEG STROKA .D:$L(CMHD) ..I CMHD?1N.N1":10B".P Q ..I CMHD["dpnfd lehia" Q ..I CMHD[":10B" S CMHD=$P(CMHD,":10B",2,20) ..I $$^%L1DC($$TRH^W4HZMST(N),3)'=+$H Q ..N SHAA S SHAA=$$SHAA^W4HZMST(N) ..I $$DELORD(N) Q ..I SHAA*60+$P(SHAA,":",2)<($P($H,",",2)/60) Q ..N TXT S TXT=" "_N_" : "_$$H2U^%L1FRM(CMHD)_" ******" ..S TXTMRQ=TXTMRQ_TXT ; ; I FIRSTLINE,$L(TXTMRQ),$G(OPT) D ; -- SHOW BEG STROKA .W "    " .W "",! .S FIRSTLINE=0 ; ;;W N,! ;----------------------------------- SHOW LINE ---------- W "" ; ;--- COLUMN 1 ( ORDER NUMBER + SIGN FOR DELIVERING ) W "",! ; ;---------------- COLUMN 2 - ORDER DETAILS W "",! ; ; ---------------- COLUMN 3 - TOTAL & PAYMENT KIND W "",! ; ; ---------------- COLUMN 4 - READY I '$$SGYOM,'$$SNDKTC,'$$REPTRH D .W "",! ; ; ---------------- COLUMN 5 - SENDED TIME W "",! ; W "",! Q ; ; CHKSND(N) ; W "" W "" Q ; NEW(HZ,MSD) ; I $G(HZ)="" Q 0 N LKH S LKH=$$NMB^W4HZMST(HZ) I $G(LKH)="" Q 0 I $G(MSD)="" Q 0 I $O(@$$^W4GL("W4LINKI")@(LKH,MSD,HZ),-1)="" Q 1 Q 0 ; MSGTM(DAT,SHAA,IR,ORD) ; N PER S PER=$$PERIOD(DAT,SHAA,IR) I PER=0,'$$SENDEDORD(ORD) W ""_$$^%W1DICT("NOW!")_"" I PER=1 W $$^%W1DICT("TODAY") I PER=-1 Q I PER=2 W $$^%W1DICT("FUTURE") Q ; PERIOD(DAT,SHAA,IR) N TVAH S TVAH=$$THZ^W3TIME(IR) I 'TVAH S TVAH=60 I $$^%L1DC(DAT,3)=+$H,$$MIN(SHAA)-($P($H,",",2)\60)TVAH Q 1 I $$^%L1DC(DAT,3)<+$H Q -1 I $$^%L1DC(DAT,3)>+$H Q 2 Q "" ; MIN(SHAA) ; Q $P(SHAA,":")*60+$P(SHAA,":",2) ; ; SELNAME(GR) ; K ^[$$^W3MAIN]TMP(JB) ; D SEDER(GR) N NXT S NXT=$O(^[$$^W3MAIN]TMP(JB,"")) I NXT="" Q N PR1 S PR1=0 S NXT=$O(^[$$^W3MAIN]TMP(JB,NXT)) I NXT="" S PR1=1 ; W "",! K ^[$$^W3MAIN]TMP(JB) Q ; SELNAME1(INVMSD,MSD) ; Q:$G(INVMSD)="" N VL S VL=$$H2U^%L1FRM($$INV^%L1FRM(INVMSD)) W "",! Q ; SEDER(GR) ; K ^[$$^W3MAIN]TMP(JB) N N,NS D .S N="" F NS=1:1 S N=$O(^[$$^W3MAIN]W3MSDR(GR,N)) Q:N="" D ..I $G(^(N)) D CRTMP(N) Q ; DTHZ(ORD) ; N DTHZ S DTHZ=$$^%L1DC($$TRH^W4HZMST(ORD),3) N SHAA S SHAA=$$SHAA^W4HZMST(ORD) I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 ; I $G(%ARG("GLLINK"))="W4LINKDR" D .S DTHZ=$$^%L1DC($P($$DATCB^W4HZMST(ORD)," "),3) .I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 .S SHAA=$P($$DATCB^W4HZMST(ORD)," ",2) ; I DTHZ Q DTHZ Q $$^W4DZ ; ; CRTMP(MSD) ; N INV,NM S NM=$G(^[$$^W3MAIN]W3MSD(MSD)) S INV=$$INV^%L1FRM(NM) Q:INV="" S ^[$$^W3MAIN]TMP(JB,INV)=MSD Q ; STAT(KOT,VL,PR) I 'VL W "" Q ; W "" Q ; D(C) ; S ^D(N)=C ;;W "N="_N_" C="_C_" "_$H_" ",! Q ; INIT ; K ^D D KILL^%W3DEB("W4DLVORD") D KILL^%W1PRM("PSL") S MSD=$$GETP^%W1PRM("MSD") D ^%W1ARG I $G(%ARG("MSDR")) K MSD S MKBL=$G(MKBL) I $$MY S MKBL=$G(%ARG("MY")) I $$DISPATH D PUT^%W1PRM("DISPATH",$$DISPATH) I $$SNDKTC D PUT^%W1PRM("SNDKTC",$$SNDKTC) D KILL^%W1PRM("DISPATH") D ^W4IN ; --> P1DZ ; I $G(%ARG("MEDAT")) S MEDT=$$^%L1DC(%ARG("MEDAT"),3) I $G(%ARG("ADDAT")) S ADDT=$$^%L1DC(%ARG("ADDAT"),3) ; I '$G(MEDT) S MEDT=P1DZ I $$DISPATH!$$SNDKTC S MEDT=P1DZ-60 I '$G(ADDT) S ADDT=P1DZ+180 ; D PUT^%W3DEB("W4DLVORD","OPT=OPT & MEDT=MEDT & ADDT=ADDT & MSD=MSD & CODE=CODE & LKHR=LKHR & ARG=[%ARG") ; S W4DLVORD("JB")=JB ; S GL=$$^W4ORD ; I $G(%REM) D PUT^%W1PRM("REM",%REM) S PRMDB=0 N N S N="" F S N=$O(@$$^W4GL("PAR")@(N)) Q:N="" I $$PRINTIG^W3PRMDP(N)[">" S PRMDB=1 Q ; I $G(%ARG("KNDO"))="DEL" S %ARG("DELETEDORDS")=1 Q ; KOT ; W "
    " .W "" .W TXTMRQ .W "",! .W "
    " W " "_W4DLVORD_" " ; I $$DISPATH,'$$SENDEDORD(N),'$$DELORD(N),'HZMH D CHKSND(N) ; I $$SNDKTC,'$$SNDKTCORD(N),'$$DELORD(N) D CHKSND(N) ; I '$$DELORD(N),'$$MIKUM D .W "
    ",! .W " " D MSGTM(DAT,SHAA,IR,N) ; I $$MIKUM D .N PSL S PSL=$$PSL^W4HZMST(N) Q:'PSL .W "
    " .W $$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL)))_"" ; W "    		",! ; S %ARG("W4DLVORD")=W4DLVORD D ^W4ORDHD(W4DLVORD,$$SHORTSHOW) W "",! ; W " "_$J($$TSHL^W4HZMST(N),2,2)_" 
    " ; N SHULS S SHULS=$$SHUL^W4HZMST(N)+$$SHULA^W4HZMST(N) N CODTS S CODTS=$$CODTS^W4HZMST(N) N ITRA S ITRA=$$ITRA^W4HZMST(N) ; I SHULS D .W "" . W $$SHOWPAID(N) .W "" . .I CODTS=4,$D(@$$^W4ORD@(N,"TB"))>9 S CODTS=7 . .W "
    " .W "" .D . N MZM,CA,ASR . S MZM=$$MZM^W4HZMST(N) . S CA=$$CA^W4HZMST(N) . S ASR=$$ASR^W4HZMST(N) . I MZM W $$^W3SHOWTS(1)_" "_$J(MZM,2,2)_"
    " . I CA W $$^W3SHOWTS(3)_" "_$J(CA,2,2)_"
    " . I ASR W $$^W3SHOWTS(4)_" "_$J(ASR,2,2)_"
    " .W "    " . .I ITRA D ..W "
    " ..N BGC,FGC S BGC="darkred",FGC="white" ..W "" .. W " "_$$^%W1DICT("ITRA")_" "_$J($$ITRA^W4HZMST(N),2,2)_" " ..W "" ;W " "_$$^W3SHOWTS($$CODTS^W4HZMST(N)) ; I 'SHULS,CODTS<5,ITRA,'HZMH D .I '$G(%ARG("SGYOM")) D ..N BGC,FGC S BGC="darkred",FGC="white" ..I CODTS=4 S BGC="pink",FGC="black" ..W "" ..N PAYMKIND S PAYMKIND=$$PAYMKIND^W4PAYBT(CODTS) ..IF PAYMKIND="" S PAYMKIND="PAYMINLOCAL" ..W " "_$$^%W1DICT(PAYMKIND)_" " ..W "" . .I $G(%ARG("SGYOM")),'$$DELORD(N) D .. W "" .. W " " .. W "",! W "    		" . W "" . W "
    " . W ""_$$TIMEREADY(N)_"" . I 'HZMH,'$$DELORD(N) D .. D PRINTDOC .I $$I^W4PIZUL(N) D .. W ""_$$^%W1DICT("PIZULOF")_"
    "_$$I^W4PIZUL(N)_"    " .W "    		" ; I '$$SNDKTC D .I '$$SENDEDORD(N),'$$DELORD(N) D ..S ZMANS=$S($$TAKEAWAY^W4HZMST(N):$$^%W1DICT("TAKEAWAY!"),1:$$^%W1DICT("WAITING")) .; .I $$SENDEDORD(N) D ..I $$PIZUL(N) S ZMANS=$$^%W1DICT("PIZUL") D Q ...N HZ S HZ="" F S HZ=$O(@$$^W4GL("W4PIZUL")@(N,HZ)) Q:HZ="" I HZ D ....S ZMANS=ZMANS_"
    "_HZ_"" ..N PSL S PSL=$$PSL^W4HZMST(N) Q:'PSL ..S ZMANS=$$ZMANS^W4HZMST(N)_"
    " ..S ZMANS=ZMANS_"" ..S ZMANS=ZMANS_$$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL)))_"" ; I $$SNDKTC D .I '$$SNDKTCORD(N),'$$DELORD(N) D ..S ZMANS=$$^%W1DICT("WAITING") .; .I $$SNDKTCORD(N) D ..S ZMANS=$G(@$$^W4ORD@(N,"SNDKTC")) Q:'ZMANS ..S ZMANS=$ZD(ZMANS,"24:60") ; I '$$DELORD(N) W ZMANS ; I $$DELORD(N) D Q .W " " .D ..I $$DELORD(N)=2 W $$^%W1DICT("DATEOVER") Q ..W $$^%W1DICT("ORDERDELETEBY",$P($G(@$$^W4GL("W4LINK")@(N)),"~",5)) ; W "
     " W $$^%W1DICT(KOT)_" : " W " " W VL_"
    ",! W "" W "",! D STAT("ORDERQN",SHZ,1) D STAT("NEWCLIENTS",SNEW,1) D STAT("WAITING",SNOSBM,1) D STAT("NOSENDED",SNOSHUD,1) D STAT("NOPAID",SNOSHUL,1) D STAT("NODLV",SNODLV,1) D STAT("TOPAY",$J($G(SPAY),2,2),1) W "",! W "
    "_$$^%W1DICT("TOTAL")_"
    ",! Q ; KOTTB ; W "",! W ""_$$^%W1DICT("ORDERNUMBER")_"" W ""_$$^%W1DICT("CUSTOMERDETAILS")_"" W ""_$$^%W1DICT("TOTAL")_"" I $G(OPT) D .I '$$SGYOM,'$$SNDKTC,'$$REPTRH D ..W ""_$$^%W1DICT("READY?")_"" .W ""_$$^%W1DICT("SENDEDTIME")_"" W "",! Q ; TOT ; W "" W " " W $$^%W1DICT("TOTAL") W "",! ; W "",! W "" W "",! W "",! W "",! W "" W "
    ",! W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SHZ) W "" W ""_$$^%W1DICT("DISCOUNTS")_" : "_$J(SHNH,2,2)_""_$$NBSP^%L1FRM(5) W ""_$$^%W1DICT("DLVPAY")_" : "_$J(SDMS,2,2)_"" W "
    " W "",! ; W "",! W " "_$J($G(SPAY),2,2)_" " W "",! ; W "",! ; ; I $G(SNEW),'$$REPTRH D .W " " .W $$^%W1DICT("NEWCLIENTS") .W "",! .W "",! .W "",! .W "",! .W "",! .W "
    ",! .W "  "_$$^%W1DICT("ORDERQN")_" : "_SNEW .W "" .W $$^%W1DICT("DISCOUNTS")_" : "_$J(SNEWHN,2,2) .W "" .W $$^%W1DICT("DLVPAY")_" : "_$J(SNEWDM,2,2) .W "
    ",! .W "",! .W " "_$J(SNEWPAY,2,2)_" " .W "",! .W "",! ; I $O(SMSD($O(SMSD(""))))'="" N RST S RST="" F S RST=$O(SMSD(RST)) Q:RST="" D .W " " .W $$NAME^W3MSD(RST) .W "",! .W "",! .W "",! .W "",! .W "
    ",! .W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SMSD(RST,"Q")) .W "" .W $$^%W1DICT("DLVPAY")_" : "_$J($G(SMSD(RST,"D")),2,2) .W "
    ",! .W "",! .W " "_$J($G(SMSD(RST,"S")),2,2)_" " .W "",! .W "",! ; I '$$REPTRH N SUGT S SUGT="" F S SUGT=$O(SCODTS(SUGT)) Q:SUGT="" D .W "" .W "  " .W $$^W3SHOWTS(SUGT) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SCODTS(SUGT,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SCODTS(SUGT,"S")),2,2)_" " .W " ",! .W "",! ; N MKR I '$$REPTRH S MKR="" F S MKR=$O(SMKR(MKR)) Q:MKR="" D .W "" .W "  " .W $$^W3MKR(MKR) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SMKR(MKR,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SMKR(MKR,"S")),2,2)_" " .W " ",! .W "",! EN ; Q ; ; BUTTONS ; W "",! I '$$DISPATH,'$$SNDKTC D .W " ",! ; D BACK W "
    " D BUTTON("rbtprint",$$^%W1DICT("PRINTORDERLIST"),"Print('"_OPT_"','"_$G(MEDT)_"','"_$G(ADDT)_"','"_$G(CODE)_"')","font-size:"_$$^W3FSZ(16)) W "
    ",! Q ; BACK ; W " " D BUTTON("rbtback",$$^%W1DICT("BACK"),"Back('"_MSD_"')","color:red;font-size:"_$$^W3FSZ(16)) W "",! Q ; GL S GL=$$^W4ORD Q ; DISPATH(STAM) ; Q $G(%ARG("DISPATH")) ; SNDKTC(STAM) ; I $G(%ARG("SNDKTC")) Q 1 I $$GETP^%W1PRM("SNDKTC") Q 1 Q 0 ; SNDKTCORD(HZM) ; N OK S OK=1 N I S I="" F S I=$O(@$$^W4ORD@(HZM,I)) Q:I="" I I D Q:'OK .I $G(^(I))'["\@@" S OK=0 Q OK ; TAW(STAM) ; Q $G(%ARG("TAW")) ; COMPTOT(N) ; N TS S TS=$$TSHL^W4HZMST(N) N DMS S DMS=$$DMSH^W4HZMST(N) N HNH S HNH=$$HNH^W4HZMST(N) ; S SPAY=$G(SPAY)+TS S SDMS=SDMS+DMS S SHNH=SHNH+HNH I '$$^W4PIZUL(N) S SHZ=SHZ+1 ; I $$DELORD(N) S SDEL=SDEL+1 I $$SENDEDORD(N) S SSBM=SSBM+1 ; I '$$SENDEDORD(N),'$$DELORD(N) D .S SNOSBM=SNOSBM+1 ; I $$NOSHUL(N) S SNOSHUL=SNOSHUL+1 ; I '$$SEND2CUST(N) S SNODLV=SNODLV+1 ; D .N CODTS,SUM,ITRA,MZM,CHK,CA,ASR .S CODTS=$$CODTS^W4HZMST(N) .S SUM=TS .I CODTS<2 S CODTS=1 .S ITRA=$$ITRA^W4HZMST(N) .S MZM=$$MZM^W4HZMST(N) .S CHK=$$CHK^W4HZMST(N) .S CA=$$CA^W4HZMST(N) .S ASR=$$ASR^W4HZMST(N) .S SCODTS(1,"S")=$G(SCODTS(1,"S"))+ITRA .I MZM S SCODTS(1,"S")=$G(SCODTS(1,"S"))+MZM .I CHK S SCODTS(2,"S")=$G(SCODTS(2,"S"))+CHK .I CA S SCODTS(3,"S")=$G(SCODTS(3,"S"))+CA .I ASR S SCODTS(4,"S")=$G(SCODTS(4,"S"))+ASR .S SCODTS(CODTS,"Q")=$G(SCODTS(CODTS,"Q"))+1 ; D .N RST S RST=$P($G(@$$GLLINK@(N)),"~") Q:'RST .S SMSD(RST,"Q")=$G(SMSD(RST,"Q"))+1 .S SMSD(RST,"S")=$G(SMSD(RST,"S"))+TS .S SMSD(RST,"D")=$G(SMSD(RST,"D"))+DMS .S SMSD(RST,"HN")=$G(SMSD(RST,"HN"))+$G(HNH) ; I $G(MSD),$$NEW(N,MSD) D .S SNEW=SNEW+1 .S SNEWPAY=SNEWPAY+TS .S SNEWDM=SNEWDM+$$DMSH^W4HZMST(N) .S SNEWHN=SNEWHN+$$HNH^W4HZMST(N) ; N MKR S MKR=$$MKRDLV^W4HZMST(N) I MKR="" S MKR=99 S SMKR(MKR,"Q")=$G(SMKR(MKR,"Q"))+1 S SMKR(MKR,"S")=$G(SMKR(MKR,"S"))+TS Q ; SEND2CUST(ORD) ; I $$PSL^W4HZMST(ORD) Q 1 Q 0 ; NOSHUL(ORD) ; I $$TSHL^W4HZMST(ORD)>($$SHUL^W4HZMST(ORD)+$$SHULA^W4HZMST(ORD)) Q 1 Q 0 ; SHOW4COPY(STAM) ; Q +$G(%ARG("SHOW4COPY")) ; DIVPSL ; W "
    ",! W " ",! ; W " ",! I $G(%ARG("MKBL")) D PSLRCV ; I $$DISPATH D .D PSLCHOICE ; I $$SNDKTC D .D TDSP .D PSLSBM .W "",! ; W " ",! ; W "" D PSLRADIO I $$DISPATH D PSLSHOW W "
    " . D BUTTON("misc",$$^%W1DICT("MISC"),"Misc()","color:brown;font-size:"_$$^W3FSZ(16)) .W "
    ",! Q ; I $$1024^W4WDSCR D . D TDSP . D PSLSHOW . N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN . D BACK .W "",! . .W "" . D ORDSOURCE . D PAYMKIND ; I '$$1024^W4WDSCR D .D TDSP ; W ""_$$^%W1DICT("ORDER")_$$REVAH W "" W "" ; W ""_$$^%W1DICT("AUTHNO")_$$REVAH W "",! W "" ; W ""_$$^%W1DICT("CUSTOMNUMBERORNAME")_$$REVAH D .N CUST S CUST=$$INVH^%L1FRM($G(%ARG("CUSTOM"))) .W "",! W "" ; I '$$DISPATH,'$$1024^W4WDSCR D .D PSLSHOW .I $$DISPATH W " ",! .N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN .D BACK W "",! ; I '$$DISPATH D .W "" . D PSLCHK .W "",! ; ; W "",! Q ; ; HB(PRM) I $G(PRM)="" Q "" S PRM=$$INVH^%L1FRM(PRM) Q $$H2U^%L1FRM(PRM) ; FNDMISCBUT ; W "" ;;D ROUNDBUT^%W1JS("findord",$$^%W1DICT("FINDORDER"),"FindOrder()","color:blue;font-size:"_$$^W3FSZ(16),"wh29,29") D BUTTON("findord",$$^%W1DICT("FINDORDER"),"FindOrder()","color:blue;font-size:"_$$^W3FSZ(16)) W "",! ; W "" ;;D ROUNDBUT^%W1JS("misc",$$^%W1DICT("MISC"),"Misc()","color:brown;font-size:"_$$^W3FSZ(16),"wh29,29") D BUTTON("misc",$$^%W1DICT("MISC"),"Misc()","color:brown;font-size:"_$$^W3FSZ(16)) W "",! Q ; PSLRCV ; W "" W " "_$$^%W1DICT("RECEIVER")_" : "_$$H2U^%L1FRM($$^W4NAME(%ARG("MKBL")))_"" W "",! W " " Q ; PSLCHOICE ; I $$TAW D TDSP G PSLCH1 ; W "",! W " ",! W "" ; PSLCH1 ; D PSLSBM ; I $$DISPATH D .N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN .D TDSP,TDSP .D FULLSHOWRADIO .W " " .D BACK Q ; ; PSLCHK ; D .I '$$1024^W4WDSCR D ..D ORDSOURCE ..; ..D PAYMKIND .; .D SHOWSNDORNOORDERS .; .D TDSP .; .I '$$SNDKTC D ..D SHOWPAIDORNOORDERS .. ..D TDSP .. ..D SHOWDELORDERS .. ..D SHOWFUTORDERS .. ..D SHOWBIDORDERS .. ..I '$$DISPATH D SHOWTAW ; W " ",! Q ; ; ORDSOURCE ; W "" W $$^%W1DICT("ORDERSOURCE")_$$REVAH W "",! W "" Q ; PAYMKIND ; W "" W $$^%W1DICT("PAYMENTKIND")_$$REVAH W "",! W "" Q ; SHOWSNDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOSENDEDORDS")_" " W "" ; D SPACE W $$^%W1DICT("SHOWSENDEDORDS")_" " W "" W "" Q ; SHOWPAIDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOPAIDORDS")_" " W "" ; I '$$1024^W4WDSCR D SPACE I $$1024^W4WDSCR W "" ; W $$^%W1DICT("SHOWPAIDORDS")_" " W "" W "" Q ; SHOWDELORDERS ; W "" W $$^%W1DICT("SHOWDELETEDORDS")_" " W "" W "" Q ; SHOWFUTORDERS ; W "" W $$^%W1DICT("SHOWFUTUREORDS")_" " W "" W "" Q ; SHOWTAW ; W "" W $$^%W1DICT("SHOWTAW")_" " W "" W "" Q ; SHOWBIDORDERS ; W "" W $$^%W1DICT("SHOWBIDS")_" " W "" W "" Q . PSLRADIO ; I '$$DISPATH D .W "" . D KINDORDS .W "",! ; I $$DISPATH D .W "" . W $$^%W1DICT("SHOWALLORDS") . W "" . D SPACE . W $$^%W1DICT("SHOWNOTDLVORDS") . W "" .W "" .; .W " " ; D TIMESORT ; D ASCENDING ; I $$DISPATH D .D TDSP .D SHOWTAW .I '$$1024^W4WDSCR D TDSP,TDSP,TDSP Q ; ; TIMESORT ; W "" W $$^%W1DICT("TIMESORT") W "" D SPACE W $$^%W1DICT("ORDERSORT") W "" W "" Q ; ASCENDING ; W "" W $$^%W1DICT("FROMOLD2NEW") W "" I '$$1024^W4WDSCR D SPACE I $$1024^W4WDSCR W "" W $$^%W1DICT("FROMNEW2OLD") W "" W "" Q ; PSLSHOW ; W "" D BUTTON("show",$$^%W1DICT("SHOW")_" ","ShowOrds()","color:brown;font-size:"_$$^W3FSZ(16)) W "",! Q ; ; PSLSBM ; W "" N SUBMIT S SUBMIT="SUBMIT" I $$SNDKTC S SUBMIT="SEND2KTCH" D BUTTON("submpsl",$$^%W1DICT(SUBMIT),"SubmPsl()","color:green;font-size:"_$$^W3FSZ(16)) W "" Q ; FULLSHOWRADIO ; W "" W $$^%W1DICT("FULLSHOW") W "" D SPACE W $$^%W1DICT("SHORTSHOW") W "" W "" Q ; ; SETDLV(PRM) ; D PUT^%W3DEB("W4DLVORD-SETDLV","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:'HZ 0 N ER S ER=0 ; I $$SNDKTC G SETDLV1 ; N ISHUR S ISHUR=$P(PRM,";",3) N ITRA S ITRA=$$ITRA^W4HZMST(HZ) N CODTS S CODTS=$$CODTS^W4HZMST(HZ) ;;I PRM,ITRA>.5,'ISHUR,CODTS>4!(CODTS=3),'$G(@$$^W4PRM@("NOCHKDLV")) Q "ITRA" I PRM,ITRA>.5,'ISHUR,$D(@$$^W4ORD@(HZ,"CB","V"))>9!(CODTS>4)!(CODTS=3),'$G(@$$^W4PRM@("NOCHKDLV")) Q "ITRA" SETDLV1 ; I PRM S @$$^W4MAIN("TMPDLV")@(HZ)="" Q 1 K @$$^W4MAIN("TMPDLV")@(HZ) Q 1 ; KILLDLV ; K @$$^W4MAIN("TMPDLV") Q ; SETREADY(PRM) ; D PUT^%W3DEB("W4DLVORD-SETREADY","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:HZ'>0 0 I '$$^W4HZFULL(HZ) Q 0 N ER S ER=0 I PRM S @$$^W4ORD@(HZ,"READY")=$H Q $S($$TAKEAWAY^W4HZMST(HZ):3,1:2) K @$$^W4ORD@(HZ,"READY") Q 1 ; SNDORD(PRM) ; N (JB,%ARG,%REM,PRM) K @$$^W4MAIN("TMPER") D ^W4IN D PUT^%W3DEB("W4DLVORD-SNDORD","PRM=PRM") I '$$SNDKTC S PSL=$P(PRM,";") Q:'PSL S ZMANS=$$T^%L1TIME($P($H,",",2)) ; I '$$SNDKTC D .S HZ="" F S HZ=$O(@$$^W4MAIN("TMPDLV")@(HZ)) Q:HZ="" D SGPSL(HZ,PSL) ; I $$SNDKTC D .S HZ="" F S HZ=$O(@$$^W4MAIN("TMPDLV")@(HZ)) Q:HZ="" D ..I $$HZM^W4MSL(HZ),$$FUTUREDT^W4HZMIT(HZ) Q ..D ^W4HZM(HZ,JB) ..S @$$^W4ORD@(HZ,"SNDKTC")=$H ; I $$PRINT^W4MDPPC'="L" D KILLDLV Q ; ; PUTTM(HZM,PSL) ; N (JB,%ARG,%REM,HZM,PSL) I $$TM^W4HZMST(HZM) Q N TM S P1DZ=$$^W4DZ L +@$$^W4GL("P1TM"):1 S TM=$O(@$$^W4GL("P1TM")@(9999999),-1)+1 S @$$^W4GL("P1TM")@(TM)=HZM_"\"_P1DZ_"\"_$H D ^%S2GLSV($$^W4GL("P1TM")_"("_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TM") ; L +@$$^W4GL("P1TMI"):1 S @$$^W4GL("P1TMI")@(P1DZ,TM)=$H D ^%S2GLSV($$^W4GL("P1TMI")_"("_P1DZ_","_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TMI") ; D PUT^W4HZMST(HZM,"TM",TM) D ^%S2GLSV($$^W4ORD_"("_HZM_")",$$^W4FGIB) ; L +@$$^W4GL("P1MSL"):1 S @$$^W4GL("P1MSL")@(P1DZ,PSL,HZM)=$H D ^%S2GLSV($$^W4GL("P1MSL")_"("_P1DZ_","""_PSL_""","""_HZM_""")",$$^W4FGIB) L -@$$^W4GL("P1MSL") ; D ^W4HZGT(HZM) ; I $$HZM^W4MSL(HZM) D .I PSL<1 Q .D PRNDLVDOC(HZM) .I $G(@$$^W4PRM@("2TM")) D ..D PRNDLVDOC(HZM) ; PUTTME K @$$^W4TMPORD Q ; ; KHM(HZM) N N S N="" F S N=$O(@$$^W4GL("P1HM")@(N)) Q:N="" D .K @$$^W4GL("P1HM")@(N,HZM) .D ^%S2GLSV($$^W4GL("P1HM")_"("""_N_""","""_HZM_""")",$$^W4FGIB,"K") Q ; VIEWRCV(STAM) ; I $G(%ARG("VW"))=1 Q 1 Q 0 ; BGCOLOR(ORD) ; I $$DELORD(ORD) W " style=""background-color:black;color:red""" Q I $$^W4HZMH(ORD) W " style=""background-color:96CE98;color:black""" Q I $$FAXORD(ORD) W " style=""background-color:yellow""" Q I $$SENDEDORD(ORD) W " style=""background-color:white""" Q ; I $$PERIOD(DAT,SHAA,IR)=0 D Q ; -- SVETOFOR .N BGCOLOR .I $$^%L1DC(DAT,3)=+$H D ..N RZN S RZN=$$MIN(SHAA)-($P($H,",",2)\60) ..N TIMETM S TIMETM=$G(@$$^W4PRM@("TIMETM")) ..I RZN'>TIMETM S BGCOLOR="pink" Q ..I RZN>TIMETM,RZN<(TIMETM+15) S BGCOLOR="#FFFAAA" Q ;"lightyellow" ..S BGCOLOR="#DFFFC6" ; lightgreen . .W " style=""background-color:"_BGCOLOR_""" " Q ; I $$SF^W4PRM,$$SHABAT(ORD) D .S FGCOLOR="orange" .W " style=""background-color:darkblue;color:"_FGCOLOR_"""" ; I $$SF^W4PRM D .I $$NIGHT(ORD) D Q ..S FGCOLOR="orange" ..W " style=""background-color:darkblue;color:"_FGCOLOR_"""" . .W " style=""background-color:eaeaea""" ; I $$DTHZ(ORD)>$H W " style=""background-color:c0d2ec""" Q ; -- FUTURE I $$TAKEAWAY^W4HZMST(ORD) W " style=""background-color:orange""" Q Q ; KINDORD(STAM) ; I $G(%ARG("ORDKIND"))="" Q "NOSENDED" Q $G(%ARG("ORDKIND")) ; KNDO(STAM) Q $G(%ARG("KNDO")) ; SETPSL(PSL) ; D PUT^%W1PRM("PSL",PSL) Q ; MY(STAM) Q $G(%ARG("MY")) ; CMPR(HZ,NCA) ; N OK S OK=0 I $D(@$$^W4ORD@(HZ,"CB","V"))<10 Q 0 N CRCARDS S CRCARDS=$$CRCARDS^W4HZMST(HZ) I NCA,(","_CRCARDS_",")'[+NCA Q 0 Q 1 ; ; SGPSL(HZ,PSL) ; I '$$^W4HZFULL(HZ) Q ; I $$CODTS^W4HZMST(HZ)=4,'$D(@$$^W4ORD@(HZ,"CB","ASR")) D .N P1TNOPR S P1TNOPR="" ;;I $G(PSL)>0&$G(@$$^W4PRM@("2TM")) S P1TNOPR="" .D SGASR(HZ) ; I '($$CLOSE^W4HZMST(HZ)#2) S @$$^W4ORD@(HZ,"S")=$G(@$$^W4ORD@(HZ,"S"))+1 ; ;;I '$$^W4CLOSE(HZ),'$$ITRA^W4HZMST(HZ),PSL<0 D ; -- HADP HESH TAW I '$$ITRA^W4HZMST(HZ),PSL<0 D ; -- HADP HESH TAW .N P1TNOPR,BLIPR .I $$SHUL^W4HZMST(HZ) D ^W4PCHB(HZ,1) .I $$SHULA^W4HZMST(HZ),'$$SHUL^W4HZMST(HZ) D ^W4PCHB2(HZ) .D SETCLOSE^W4HZMST(HZ) ; I '$$PSL^W4HZMST(HZ) D PUT^W4HZMST(HZ,"PSL",PSL) ; I $$ZMANS^W4HZMST(HZ)="" D PUT^W4HZMST(HZ,"ZMANS",$$T^%L1TIME($P($H,",",2))) ; I PSL>0 D .D PUTTM(HZ,PSL) .;;I '$$^W4CLOSE(HZ),'$$ITRA^W4HZMST(HZ) D D SETCLOSE^W4HZMST(HZ) .I '$$ITRA^W4HZMST(HZ) D D SETCLOSE^W4HZMST(HZ) ..Q:$$NOTM^W4PRM ..N LKHN S LKHN=$$NMB^W4HZMST(HZ) Q:'LKHN Q:$$IFHBMAIL^W4L(LKHN) ..N EMAIL S EMAIL=$$EMAIL^W4HZMST(HZ) ..I EMAIL["@",(EMAIL["."),$$SND2EMAIL^W4PRM!$$IFHBMAIL^W4L(LKHN) Q ..N P1TNOPR,BLIPR ..I $$SHUL^W4HZMST(HZ) D ^W4PCHB(HZ,1) ..;;I $$SHULA^W4HZMST(HZ),'$$SHUL^W4HZMST(HZ) D ^W4PCHB2(HZ) ; -- 08/05/19 .I $$SND2EMAIL^W4PRM J SNDMAIL(JB,HZ) Q ; SGASR(HZM) ; N (JB,%ARG,HZM,P1TNOPR,BLIPR) S ASRL=$$ITRA^W4HZMST(HZM) S (LKHN,CUSN)=$$NMB^W4HZMST(HZM) S LKAH="" ;$$AH^W4L(LKHN) S LKHNH="" S (HRA,LKHR)="" S HZMLK=$$HZMLAK^W4HZMST(HZM) S ASR=ASRL ; S TIPAS="" D ^W4ASR ;;D ^W4T(HZM,1) ; 06/06/18 ; I $$HBNOW^W4L(LKHN),'$$HBNOWMONTH^W4PRM,$$NOW2EMAIL^W4PRM D .J SNDMAIL(JB,HZM,1) ; Q ; ; SNDMAIL(JB,ORD,NOW) N (JB,%ARG,ORD,NOW) Q:'$G(ORD) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N RES,EMAIL,LKHN,NOM S EMAIL=$$EMAIL^W4HZMST(ORD) Q:EMAIL'["@"!(EMAIL'[".") S LKHN=$$NMB^W4HZMST(ORD) Q:'LKHN ; D Q:'NOM .I $G(NOW) S NOM=+$G(@$$^W4ORD@(ORD,"HBNOW")),VD="HB",ND=NOM Q .S NOM=$$NCAB^W4HZMST(ORD) .S VD="HZ",ND=ORD ; D SNDMAIL1(ND,NOM,EMAIL,VD,ORD) ; S EMAIL1=$$EMAIL1^W4HZMST(ORD) I EMAIL1["@",EMAIL1["." D .D SNDMAIL1(ND,NOM,EMAIL1,VD,ORD) Q ; SNDMAIL1(ND,NOM,EMAIL,VD,ORD) N PRM S PRM=ND_";Invoice "_NOM_";"_EMAIL_";"_VD_";0;1;"_$G(@$$^W4PRM@("HOWSEND"),3) ; I VD="HZ" S RES=$$EMAILCONT^W4EMAIL(PRM) I VD="HB" D .S RES=$$EMAILHB^W4EMAIL(PRM) Q:RES .S @$$^W4ORD@(ORD,"SENT2MAIL",EMAIL)=$H_";"_$P(PRM,";",2,1000) Q ; ; PRNDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB ; I $$^W4MSL(NMB),$$BIGTM^W4L(NMB) D Q .S @$$^W4MAIN("TMPBIGTM")@(HZM)=$H ; D PRINTDLVDOC(HZM) Q ; ; PRINTDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB N IET,ITS,SHM,P1HZTM,P1TNOPR,BLIPR,P1HZHB,P1HZHB1,P1HZHB2,P1HZHB3 S IET="ETTM",ITS=1,SHM="TM",P1HZTM="" I $G(@$$^W4PRM@("NOTM")) S P1TNOPR="" I $G(@$$^W4PRM@("MM")),'$G(@$$^W4PRM@("MMTM")) S P1TNOPR="" D P1^W4HZTM Q ; NOPRES(SL) ; I '$G(@$$^W4PRM@("BDNOCHSL")) Q 0 N NM,NM1 S NM=$G(@$$^W4GL("P1SL")@(SL)) I NM="" Q 0 N OK S OK=0 N N S N="" F S N=$O(@$$^W4GL("NAME")@(N)) Q:N="" D Q:OK .S NM1=$G(^(N,1)) .I $$SPA^%L1FRM(NM)=$$SPA^%L1FRM(NM1) S OK=N ; I OK,$G(@$$^W4GL("FILE")@(OK,"CIO"))'="I" Q 1 Q 0 ; HD(STAM) ; I $$CUSTLASTORDS Q "CUSTLASTORDS<>"_$$CUSTLASTORDS_"<>"_$$LKH^W4L($$CUSTLASTORDS) I $$MY,'$$DISPATH Q "MYORDERS" I '$$MY,'$$DISPATH,$$TOMORROW Q "TOMORROWORDERS" I '$$MY,'$$DISPATH,$G(%ARG("MEDAT"))="" Q "DAYORDERS" I $$DISPATH,$$TAW Q "TAKEAWAYORDERS" I $$DISPATH,'$$TAW Q "SENDORDERS" Q "ORDLIST" ; PAYCASH(HZM) ; N IND,VL I '$$^W4HZFULL(HZM) Q "0;ORDERERROR" I $$^W4CLOSE(HZM) Q "0;ORDERCLOSED" S VL=$$ITRA^W4HZMST(HZM) I 'VL G EPAYCASH S IND=$O(@$$^W4ORD@(HZM,"CB","MZ",999),-1)+1 S @$$^W4ORD@(HZM,"CB","MZ",IND)=$J(VL,2,2)_"*"_$H_"*"_$$LASTMLZ^W4HZMST(HZM)_"*"_$$^W4MYDVN D PAYCASH^W4PAYKB(HZM) D ^W4T(HZM,0) EPAYCASH Q "1;"_$$SHOWPAID(HZM) ; SHOWPAID(N) ; Q $$^%W1DICT("PAID")_" "_$J($$SHUL^W4HZMST(N)+$$SHULA^W4HZMST(N),2,2) ; READY(N) ; I $D(@$$^W4ORD@(N,"READY")) Q 1 Q 0 ; TIMEREADY(N) ; N TIME S TIME=$G(@$$^W4ORD@(N,"READY")) I 'TIME Q "" Q $$T^%L1TIME(TIME) ; SGYOM(STAM) ; Q $G(%ARG("SGYOM")) ; SPACE ; W "   " Q ; TDSP ; W " " Q ; PRINTDOC ; W "",! W "" W "" ; W "" W "
    " W "" W "
    ",! Q ; ; KINDORDS ; W "",! Q ; SELECTED(IND) ; I $G(%ARG("KNDO"))=""&(IND="ALL") Q " selected=""selected"" " I $G(%ARG("KNDO"))=IND Q " selected=""selected"" " Q "" ; SETARG ; I $G(%ARG("ASCENDING"))="" S %ARG("ASCENDING")=$S($$MY:0,1:1) I $G(%ARG("TIMESORT"))="" S %ARG("TIMESORT")=$S($$MY:0,1:1) ; I $G(%ARG("NOSENDEDORDS"))="" S %ARG("NOSENDEDORDS")=1 I $G(%ARG("SENDEDORDS"))="" S %ARG("SENDEDORDS")=1 I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 I $G(%ARG("BIDS"))="" S %ARG("BIDS")=1 I $G(%ARG("FUTUREORDS"))="" D .S %ARG("FUTUREORDS")=$S($$HD="DAYORDERS"&'$$SF^W4PRM:0,1:1) I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")=1 I $$TOMORROW D .I $G(%ARG("DELETEDORDS"))="" D ..S %ARG("DELETEDORDS")=+$$SHOWDEL^W4PRM .I $G(%ARG("BIDS"))="" S %ARG("BIDS")=0 I $G(%ARG("DELETEDORDS"))="" D .S %ARG("DELETEDORDS")=$S($$SHOWDEL^W4PRM:1,$G(%ARG("MY")):1,1:0) ; Q ; ; ONCHANGE(STAM) ; Q " onChange=""OnChangePrm()"" " ; BUTTON(ID,VL,PROC,STYLE) D ^W4BUTTON($G(ID),VL,$G(PROC),$G(STYLE)) Q ; REVAH(STAM) ; I $$1024^W4WDSCR Q "
    " Q "  " ; SHORTSHOW(STAM) ; Q $G(%ARG("SHORTSHOW")) ; TOMORROW(STAM) ; Q $G(%ARG("TOMORROW")) ; CUSTLASTORDS(STAM) ; Q $G(%ARG("CUSTLASTORDS")) ; PRINTALLORDS(MDB) ; N N,HZ S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#10) H 1 .S HZ=$$HZ(N) .S A=$$PRINTBON^W4MENUBT(HZ_";;;"_MDB) Q ; PRINTALLKOTMDB ; N PRN S PRN=$G(@$$^W4PRM@("MDBKOT")) Q:'PRN N N,HZ S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#10) H 1 .S HZ=$$HZ(N) .D MDBKOT^W4MDBPC(HZ,PRN) Q ; CUSTALL(STAM) ; Q $G(%ARG("CSALL")) ; NIGHT(ORD) ; N DATCB S DATCB=$$DATCB^W4HZMST(ORD) N TIMECB S TIMECB=$P(DATCB," ",2),DATCB=$P(DATCB," ") N DTCB S DTCB=$$^%L1DC(DATCB,3) ;;I $$SF^W4PRM,DTCB=($H-1)&(TIMECB>17)!(DTCB=+$H&(TIMECB<8)),$ZD($H,"24")<12 Q 1 ;;I $$SF^W4PRM,DTCB=+$H&(TIMECB>17) Q 1 I $$SF^W4PRM,TIMECB>16!(TIMECB<8) Q 1 Q 0 ; SHABAT(ORD) ; N DATCB S DATCB=$P($$DATCB^W4HZMST(ORD)," ") N DTCB S DTCB=$$^%L1DC(DATCB,8) I $$SF^W4PRM,DTCB=6!(DTCB=7) Q 1 Q 0 ; REPTRH(STAM) ; Q $G(%ARG("REPTRH")) ; ; KOTREPTRH ; N HD W "" S HD="REPDEPTRHMEAD" I $G(%ARG("ITEMS")) S HD="REPITEMSTRHMEAD" W $$^%W1DICT(HD,$G(%ARG("MEDAT"))_"<>"_$G(%ARG("ADDAT"))) W "

    ",! ; N REPTRH S REPTRH=$$REPTRH W "",! W "" W "" ; W "" ; W "" ; W "" ; W "" W "",! W "
    " W "",! W " " W $$^%W1DICT("PRICEOFFERS")_" " W "" W " " W $$^%W1DICT("SHOWORDERS")_" " W "" W "
    ",! Q ; SELORD(REPTRH,OPT) ; I REPTRH=OPT W " selected=""selected"" " Q "" ; PIZUL(N) ; Q $$^W4PIZUL(N) ; CRLINKDR ; N A,N,DCB,DTR,SHAAR S N="" F S N=$O(@$$^W4ORD@(N)) Q:N="" I N'<1 D .S A=$G(^(N)),DCB=$P(A,"\",4) Q:'DCB .I $L($P(A,"\"))<4 Q .S DTR=$$^%L1DC($P(DCB," "),3) Q:DTR<50000 .S SHAAR=$P(DCB," ",2) .I SHAAR<6 S DTR=DTR-1 .S @$$^W4GL("W4LINKDR")@(DTR,N)=$$GETP^%W1PRM("MSD") Q ; SENDBIDS() ; N VIB S VIB=$$^W4MAIN("VIB") N N S N="" F S N=$O(@VIB@(N)) Q:N="" D .S HZ=$$HZ(N) . W4DLVORD W4DLVORD(OPT) ; [ 26.03.25 11:42 ] [ 20.03.25 06:37 ] [ 07.03.25 10:59 ] ; === OPT=PC === ; --- OPT=0 -- ; COPY PREV ORDER ; ; --- OPT=1 -- NO SUBMIT ORDER LIST FOR RESTAURANT ; w3rcvhd -> SbmRadio -> w3rcvord PC=1 ; --- OPT=2 -- SUBMIT ORDER LIST FOR RESTAURANT ;w3rcvhd -> SbmRadio -> w3rcvord PC=2 ; --- OPT=3 -- DELETE ORDER LIST FOR RESTAURANT ;w3rcvhd -> SbmRadio -> w3rcvord PC=3 ; --- OPT=4 -- ALL ORDERS ( ELPOS ) ; WITH PHONE - UNREGISTER CUSTOMER REPORT ; w3guest -> ShowStat -> w3rcvord (PC=4, PHONE,HOME) ; WITH CODE - REGISTER CUSTOMER REPORT ; - w3member ; WITHOUT CODE,PHONE - RESTAURANT REPORT ; -- w3rcvhd -> SbmRadio -> w3rcvord PC=4 ;------------------------------------------------------- N (JB,CODE,OPT,HOME,PHONE,%ARG,LKH,LKHR,SUGT,%REM) I '$G(JB) Q ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; I $D(@$$^W4GL("W4LINKDR"))<10 D CRLINKDR ; D CLRCOPY^W4MENU ; I $$SNDKTC D .K %ARG("DISPATH") .D KILL^%W1PRM("DISPATH") ; I $$TOMORROW D .N DT0 S DT0=$$^W4DZ+1 ; $H+1 ; 14/09/20 .S %ARG("MEDAT")=$ZD(DT0,"DD.MM.YY") .N DT S DT=DT0 .I $$^%L1DC(DT0,8)>5,$$SF^W4PRM D ..N DT1 F DT1=DT0:1:DT0+100 Q:$$^%L1DC(DT1,8)=1 ..S DT=DT1 .S %ARG("ADDAT")=$ZD(DT,"DD.MM.YY") .S %ARG("FUTUREORDS")=1 ; D INIT ; W "
    ",! ; I $$CUSTLASTORDS D G TOTLAB .D INITVIB .N N,I,LK S LK=$$CUSTLASTORDS .S TXTMRQ="" .S FIRSTLINE=1 .W "
    " . N STYLE S STYLE="font-size:"_$$^W3FSZ(16) . I $$CUSTALL D . .D ^W4BUTTON("lastords","SHOWLASTORDS","CustLastOrders1('"_LK_"','0')",STYLE) . I '$$CUSTALL D . .D ^W4BUTTON("allords","SHOWALLORDS","CustLastOrders1('"_LK_"','1')",STYLE) .W "

    " .D TBORD .D PUT^%W1PRM("CUSTLASTORDS",LK) .S N="",I=0 F S N=$O(@$$^W4GL("W4LINKI")@(LK,MSD,N),-1) Q:N="" I N D ..S I=I+1 I '$$CUSTALL,I>9 Q ..S W4DLVORD=N ..D SHOWORD(MSD,N,0) ; I $$MIKUM D .S %ARG("TIMESORT")=1 .S %ARG("SHORTSHOW")=1 .S %ARG("NOSENDEDORDS")=0 .S %ARG("SENDEDORDS")=1 .S %ARG("BIDS")=0 .S %ARG("DELETEDORDS")=0 .S %ARG("NOPAIDORDS")=1 .S %ARG("PAIDORDS")=1 .S %ARG("SHOWTAW")=0 .S %ARG("ASCENDING")=0 .S %ARG("FUTUREORDS")=0 .S %ARG("SIK")=0 ; I $$DISPATH!$$SNDKTC D .S %ARG("NOSENDEDORDS")=1 .I $G(%ARG("TIMESORT"))="" S %ARG("TIMESORT")=1 .I $G(%ARG("ASCENDING"))'=0 D ..S %ARG("ASCENDING")=$G(@$$^W4PRM@("ASCDLV"),1) . .I $G(@$$^W4PRM@("SHORTSHOW"))?1N,$G(%ARG("SHORTSHOW"))="" D ..S %ARG("SHORTSHOW")=^("SHORTSHOW") .I $G(%ARG("SHORTSHOW"))="" S %ARG("SHORTSHOW")=1 . .I $G(%ARG("DELETEDORDS"))="" S %ARG("DELETEDORDS")=$S($$DELONLY!($$KNDO="DEL"):1,1:0) .I $G(%ARG("NOSENDEDORDS"))="" S %ARG("NOSENDEDORDS")=1 .I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 .I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 .S %ARG("BIDS")=1 .I $G(@$$^W4PRM@("NOVWTAW"))?1N,$G(%ARG("SHOWTAW"))="" D ..S %ARG("SHOWTAW")='^("NOVWTAW") .I $G(%ARG("TAW")) S %ARG("SHOWTAW")=1 .I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")=1 ; I '$$DISPATH,'$$SNDKTC D SETARG ; I $G(%ARG("NOSENDEDORDS"))=0 D .S %ARG("FUTUREORDS")=0 .S %ARG("BIDS")=0 ; I $$VIEWRCV G DIR ; I $$SHOW4COPY D ; -- SHOW FOR COPY .W "

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

    ",! ; I '$$SHOW4COPY,'$$MY,'$$REPTRH D .N MEDAT,ADDAT,KOT,GLLINK .S MEDAT=$G(%ARG("MEDAT")),ADDAT=$G(%ARG("ADDAT")) .S KOT="" .S GLLINK=$G(%ARG("GLLINK")) .I GLLINK="",'$G(%ARG("TODAY")),'$$CALLTO,'$$TOMORROW D ..I MEDAT=ADDAT S KOT=$$^%W1DICT("ORDERSLIST2DAY",MEDAT) ..I MEDAT'=ADDAT S KOT=$$^%W1DICT("ORDERSLIST2PERIOD",MEDAT_"<>"_ADDAT) .I GLLINK="W4LINKDR" D ..I MEDAT=ADDAT S KOT=$$^%W1DICT("ORDERSRCV2DAY",MEDAT) ..I MEDAT'=ADDAT S KOT=$$^%W1DICT("ORDERSRCV2PERIOD",MEDAT_"<>"_ADDAT) .W "

    "_KOT_"

    ",! .I $$TOMORROW D ..I $$ALL2MSL^W4PRM D Q ...D BUTTON("printords1",$$^%W1DICT("PRINTALLORDS"),"PrintAllOrds('0')","color:blue;font-size:"_$$^W3FSZ(16)) .. ..D BUTTON("printords1",$$^%W1DICT("PRINTALLORDSMDB"),"PrintAllOrds('1')","color:blue;font-size:"_$$^W3FSZ(16)) ..W $$NBSP^%L1FRM(5) ..D BUTTON("printords2",$$^%W1DICT("PRINTALLORDSNOMDB"),"PrintAllOrds('0')","color:blue;font-size:"_$$^W3FSZ(16)) ..I $$SF^W4PRM D ...W $$NBSP^%L1FRM(5) ...D BUTTON("printords3",$$^%W1DICT("PRINTALLKOTMDB"),"PrintAllKotMdb()","color:blue;font-size:"_$$^W3FSZ(16)) ; DIR ; S DRC=$S($G(%ARG("ASCENDING")):1,1:-1) ; S TXTMRQ="" S FIRSTLINE=1 ; K @$$^W4MAIN("VIB") K @$$^W4MAIN("TMP") ; N TMPARG S TMPARG=$$^W4MAIN("TMPARG") K @TMPARG M @TMPARG=%ARG ; D CRVIB(1) ; -- PROYTI VES CYCL NE POKAZYVAYA ; I $$MY D .W "" .W " " . W " " .W " ",! .W "
    " . W $$SHOW^W4KOTMLZ($$MY,"12B") . W "
    ",! .W "
    ",! ; I $$REPTRH D KOTREPTRH ; I $$CALLTO D .W "" . W "" . W "" . W "" . W "" . W "" . W "" . W "" . W "" . W "" . W "",! .W "
    " . W $$^%W1DICT("ORDERNUMBER") . W "" . W "" . W "" . W $$^%W1DICT("MEDATE") . W "" . D ^%W1DAT("MEDAT",$G(%ARG("MEDAT"))) . W "" . W $$^%W1DICT("ADDATE") . W "" . D ^%W1DAT("ADDAT",$G(%ARG("ADDAT"))) . W " " . D BUTTON("rbtshow",$$^%W1DICT("SHOW"),"ShowCallTo()","color:green;font-size:"_$$^W3FSZ(16)) . W "
    ",! ; I '$$VIEWRCV,'$$SNDKTC,'$$REPTRH D KOT ; I '$$REPTRH,'$$MIKUM D DIVPSL ; K @$$^W4MAIN("TMPIRTM") ; D TBORD ; I $E($G(%ARG("ORDER")))="W"!($E($G(%ARG("ORDER")))="w") D .N ORD S ORD=+$E(%ARG("ORDER"),2,20) .I $G(@$$^W4GL("HZLINKI")@(ORD)) S %ARG("ORDER")=$P(^(ORD),"\") Q .S HZMLAK=$E($G(%ARG("ORDER")),2,12) .K %ARG("ORDER") ; I $E($G(%ARG("ORDER")))="T" D .N ORD S ORD=+$E(%ARG("ORDER"),2,20) .I $G(@$$^W4GL("HZLINKTB")@(ORD)) S %ARG("ORDER")=$P(^(ORD),"\") Q .S HZMLAK=$E($G(%ARG("ORDER")),2,12) .K %ARG("ORDER") ; I $E($G(%ARG("ORDER")))="M" D .N ORD S ORD=+$E(%ARG("ORDER"),2,20) .I $G(@$$^W4GL("HZLINKMSH")@(ORD)) S %ARG("ORDER")=$P(^(ORD),"\") Q .S HZMLAK=$E($G(%ARG("ORDER")),2,12) .K %ARG("ORDER") ; I $G(%ARG("ORDER")) D G TOTLAB ; -- SHOW ONE ORDER .N MSDHZ S MSDHZ=$P($G(@$$^W4GL("W4LINK")@(%ARG("ORDER"))),"~") Q:'MSDHZ .I $G(MSD),MSDHZ'=MSD Q .I $G(%ARG("MSDR")),'$D(^[$$^W3MAIN]W3MSDR(%ARG("MSDR"),MSDHZ)) Q .N JB S W4DLVORD=%ARG("ORDER"),JB=W4DLVORD .D SHOWORD(MSDHZ,%ARG("ORDER"),0) ; ; I '$G(%ARG("SIK")) D CRVIB(0) ; -- PROYTI VES CYCL & POKAZAT ; TOTLAB ; I '$$DISPATH,'$$VIEWRCV,'$$SNDKTC D TOT W "",! ; W "
    ",! ; I '$$VIEWRCV,'$$REPTRH D BUTTONS ; W "
    ",! ; W "


    ",! ; ;K ^[$$^W3MAIN]TMPORD(JB) ;I $D(^[$$^W3MAIN]TMPORDB(JB)) D ;.M ^[$$^W3MAIN]TMPORD(JB)=^[$$^W3MAIN]TMPORDB(JB) ; END Q ; ; QN(HZ) ; I '$$DEL^W4DEL(HZ),$$TSHL^W4HZMST(HZ)<-.9 Q 0 Q 1 ; CLEAR ; K %ARG D CLRTMP^W4KORD D KILL^%W1PRM("HZM"),KILL^%W1PRM("DISPATH"),KILL^%W1PRM("SNDKTC") D KILL^%W1PRM("MSGFROMSAVED"),KILL^%W1PRM("WINDLV") K @$$^W4MAIN("VIB"),@$$^W4MAIN("VIB1"),@$$^W4MAIN("TMPARG") Q ; GLLINK(STAM) ; N GLLINK S GLLINK=$$^W4GL("W4LINKD") I $L($G(%ARG("GLLINK"))) S GLLINK=$$^W4GL(%ARG("GLLINK")) Q GLLINK ; ; TBORD ; W "",! D KOTTB Q ; INITVIB ; K SPAY,SHZ,SDMS,SNEW,SMKR,SHNH,SSOAD S (SPAY,SHZ,SDMS,SHNH,SNEW,SNEWDM,SNEWHN,SNEWPAY,SDEL,SSBM,SNOSHUD,SNOSBM,SNOSHUL,SNODLV)=0 S (SPAYM,SHZM,SDMSM,SSOAD)=0 K SMSD,SCODTS Q ; CRVIB(NOPC) ; N HZMH D INITVIB ;;S ^LV("W4DLVORD-CRVIB","NOPC")=$G(NOPC) I '$G(NOPC) G CRVIB1 N SHAAGV S SHAAGV=$$SHAAGV ; I $$CALLTO D G CRVIBE .N DTHM,TMHM,HZ .S DTHM=$H-31 .I $G(%ARG("MEDAT")) S DTHM=$$^%L1DC(%ARG("MEDAT"),3)-1 .I $G(%ARG("CALLTOORD")) S DTHM=DTHM-500 .F S DTHM=$O(@$$^W4GL("W4WHENI")@(DTHM)) Q:DTHM="" Q:(DTHM>($H+3))&($$CALLTO=1)&'$G(%ARG("ADDAT"))&'$G(%ARG("CALLTOORD")) D ..I $G(%ARG("ADDAT")),'$G(%ARG("CALLTOORD")),DTHM>$$^%L1DC(%ARG("ADDAT"),3) Q ..S TMHM="" F S TMHM=$O(@$$^W4GL("W4WHENI")@(DTHM,TMHM)) Q:TMHM="" D ...S HZ="" F S HZ=$O(@$$^W4GL("W4WHENI")@(DTHM,TMHM,HZ)) Q:HZ="" D ....I $G(%ARG("CALLTOORD")) D Q .....I HZ=%ARG("CALLTOORD") S @$$^W4MAIN("TMP")@(DTHM_$J(TMHM,3)_$J(HZ,10))="" ....I '$$^W4HZMH(HZ),'$G(%ARG("MEDAT")),'$G(%ARG("ADDAT")) Q ....I $G(%ARG("MKBL")),+$$MKBL^W4HZMST(HZ)'=+%ARG("MKBL") Q ....I $G(%ARG("BUSPRV"))?1N,+$$KINDORD^W4HZMST(HZ)'=+%ARG("BUSPRV") Q ....S @$$^W4MAIN("TMP")@(DTHM_$J(TMHM,3)_$J(HZ,10))="" ; N DT I $G(MEDT),$G(ADDT) F DT=MEDT:1:ADDT+1 D .N DTTO,SHAA,SL,N .S N="" F S N=$O(@$$GLLINK@(DT,N)) Q:N="" D ..I '$$MSL^W4MSL(N) Q ..; ..S DTTO=$$^%L1DC($$TRH^W4HZMST(N),3) ..S SHAA=$$SHAA^W4HZMST(N) .. ..I $G(%ARG("GLLINK"))="W4LINKDR" D ...S DTTO=$$^%L1DC($P($$DATCB^W4HZMST(N)," "),3) ...S SHAA=$P($$DATCB^W4HZMST(N)," ",2) .. ..I DTTO>(ADDT+1) Q ..I DTTO=(ADDT+1),SHAA'($H+1)) Q ..I $$DISPATH!$$SNDKTC,DTTO.9,'$$^W4HZMH(N) S IND=$E(IND,1,5)_1_$E(IND,6,20) Q .S IND=$E(IND,1,5)_2_$E(IND,6,20) Q Q ; CRVIB1 ; S FIRSTLINE=1 N A,IND,N,MSDHZ,W4DLVORD ;;S ^LV("W4DLVORD-CRVIB1")=$G(NOPC) S IND="" F S IND=$O(@$$^W4MAIN("VIB")@(IND),DRC) Q:IND="" D .S N=$$HZ(IND) .S A=$G(@$$^W4GL("W4LINK")@(N)) .S MSDHZ=$P(A,"~") .S W4DLVORD=N .D SHOWORD(MSDHZ,N,0) ; Q ; ; VIB(FULLIND,N,NOPC) ; N A,MSDHZ,HZMH,HZ I $G(N)="" Q S HZMH=$$^W4HZMH(N) ; S A=$G(@$$^W4GL("W4LINK")@(N)) ; S MSDHZ=$P(A,"~") I $$^W4MM S MSDHZ=$P(A,"~",5) ; I $$REPTRH=3,$$HZM^W4MSD(N) G VIBSHOW1 I 'MSDHZ G VIB1 ; I $G(MSD),MSDHZ'=MSD Q ; D D(1) I $G(%ARG("REST")),MSDHZ'=%ARG("REST") Q D D(2) ; I $G(%ARG("MSDR")),MSDHZ,'$G(^[$$^W3MAIN]W3MSDR(%ARG("MSDR"),MSDHZ)) Q VIB1 ; D D(3) S W4DLVORD=N ;;N JB S JB=N N CODEHZ S CODEHZ=$$NMB^W4HZMST(N) ; I $G(MKBL),MKBL'=$$MKBL^W4HZMST(N) Q I $G(SLH),SLH'=$$PSL^W4HZMST(N) Q D D(4) S LKHR=$G(LKHR) ; I $G(LKH),'$D(@$$^W4GL("LKH")@(LKH)) D .N LK S LK=$O(@$$^W4GL("KLLKTH")@(LKH,"")) .I LK,$D(@$$^W4GL("LKH")@(LK)) S LKH=LK ; I $G(LKH),$$^W4ISCDLK(LKH),'$$^W4KIOSKO(N),CODEHZ'=$P($$SPA^%L1FRM(LKH)," ") Q D D(5) ; I $G(LKHR),$$^W4ISCDLK(LKHR),$G(CODEHZ),'$$^W4KIOSKO(N),LKHR'=$G(@$$^W4GL("P1EZL")@(CODEHZ)) Q D D(6) ; I $G(SUGT),$$CODTS^W4HZMST(N)'=SUGT Q D D(7) ; S IR=$$IR^W4HZMST(N) I $$HZM^W4MSL(N),IR="" S IR="TAKEAWAY" I $L($G(%ARG("IR"))),$G(%ARG("IR"))'="ALL",IR'=$$INVH^%L1FRM(%ARG("IR")) Q D D(8) ; S CUSTOM=$G(CUSTOM) ;;I $L(CUSTOM),$TR(CUSTOM,"-","")'?1N.N,$G(NAME)="" S NAME=CUSTOM,CUSTOM="" I $L($G(NAME)),'$$SRCH^W1SRCH($$NAME^W4HZMST(N),NAME),'$$SRCH^W1SRCH($$MAZMIN^W4HZMST(N),NAME) Q D D(9) ; I $L($G(COMP)),'$$SRCH^W1SRCH($$COMP^W4HZMST(N),COMP) Q D D(10) ; N ADR S ADR=$$SPA^%L1FRM($G(%ARG("ADDR"))) S ADR=$TR(ADR,"/"," ") N KTVM S KTVM=$$KTVM^W4HZMST(N) S KTVM=$TR(KTVM,"/"," ") I $L(ADR),'$$SRCH^W1SRCH(KTVM,ADR) Q D D(10.5) ; I $G(TELB)="",$G(PELE)="",$G(LKH),LKH'=$$NMBKSK^W4KIOSKO S TELB=LKH N TELB1 S TELB1=$TR($G(TELB)," -","") S ^AA("W4DLVORD",N,"TELB1")=TELB1 I $L($G(TELB1)),TELB1'=$$NMBKSK^W4KIOSKO,TELB1'=$TR($$TELB^W4HZMST(N)," -",""),(TELB1'=$TR(CODEHZ," -","")),(TELB1'=$TR($$PELE^W4HZMST(N)," -","")) Q D D(11) ; N PELE1 S PELE1=$TR($G(PELE)," -","") I $L(PELE1),PELE1'=$TR($$PELE^W4HZMST(N)," -",""),PELE1'=$TR(CODEHZ," -",""),PELE1'=$TR($$TELB^W4HZMST(N)," .","") Q D D(12) ; VIBMKR ; I $G(MKR)?1N.N,MKR'=99,MKR'=$$MKR(N) Q I $G(MKR)=99,$$MKRDLV^W4HZMST(N)'="",$$MKRDLV^W4HZMST(N)'=99 Q D D(12.5) N TSHL S TSHL=$$TSHL^W4HZMST(N) I $G(MESUM),TSHLADSUM Q D D(14) ; N HZMLAKHZ S HZMLAKHZ=$$HZMLAK^W4HZMST(N) S:$E(HZMLAKHZ)="W" HZMLAKHZ=$E(HZMLAKHZ,2,10) N HZMLAKHZ1 S HZMLAKHZ1=$$HZMLAKNOM^W4HZMST(N) I $G(HZMLAK)'="",HZMLAK'=HZMLAKHZ,HZMLAK'=HZMLAKHZ1,HZMLAK'=+$$HRAED^W4HZMST(N),HZMLAK'=$$INVH^%L1FRM(HZMLAKHZ) Q D D(15) ; I $TR(CUSTOM,"-","")?1N.N,CUSTOM'=$$NMB^W4HZMST(N) Q I $L(CUSTOM),$TR(CUSTOM,"-","")'?1N.N,'$$SRCH^W1SRCH($$NAME^W4HZMST(N),CUSTOM),'$$SRCH^W1SRCH($$MAZMIN^W4HZMST(N),CUSTOM) Q ; I $G(NCA),'$$CMPR(N,NCA) Q D D(16) ; I $G(OPT)=1,$$SENDEDORD(N)!$$DELORD(N) D D(16.1) Q ;-- WAITING ; N OKSTS S OKSTS=0 I $G(%ARG("SUGTS")) D Q:'OKSTS .I %ARG("SUGTS")=8 D ..N NN S NN="" F S NN=$O(@$$^W4ORD@(N,"CB","ASR",NN)) Q:NN="" I NN D Q:OKSTS ...N A S A=$G(^(NN)) ...I $G(@$$^W4PRM@("CIBUS")),$P(A,"*")=@$$^W4PRM@("CIBUS") S OKSTS=1 Q .I %ARG("SUGTS")=10 D ..N NN S NN="" F S NN=$O(@$$^W4ORD@(N,"CB","ASR",NN)) Q:NN="" I NN D Q:OKSTS ...N A S A=$G(^(NN)) ...I $G(@$$^W4PRM@("10BIS")),$P(A,"*")=@$$^W4PRM@("10BIS") S OKSTS=1 Q .Q:OKSTS .I %ARG("SUGTS")'=$$CODTS^W4HZMST(N) Q .S OKSTS=1 D D(16.5) ; I $$DISPATH,$$TAW,'$$TAKEAWAY^W4HZMST(N) Q I $$DISPATH,$$PIZUL(N) Q I $$DISPATH,$$SNDDLVKTC^W4PRM,'$$SNDKTCORD(N) Q ; I '$$TAW,'$G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N) Q ; I $$KNDO="NSND",$$SENDEDORD(N) Q I $$KNDO="SND",'$$SENDEDORD(N) Q I $$KNDO="FTR",'$$FUTURE(N) Q I $$KNDO="DEL"!$$DELONLY,'$$DELORD(N) Q I $$KNDO="TAW",'$$TAKEAWAY^W4HZMST(N) Q I $$KNDO="BID",'HZMH Q I $$KNDO="PD",$$NOSHUL(N) Q I $$KNDO="NPD",'$$NOSHUL(N) Q I $$KNDO="TBIDS",'HZMH Q ; I $G(@$$^W4PRM@("NOVWDEL-")),$G(%ARG("DELETEDORDS")),$$I^W4DEL(N),$$TSHL^W4HZMST(N)<0 Q I $G(%ARG("DELETEDORDS")),$$DELORD(N) G VIBSHOW I '$G(%ARG("DELETEDORDS")),$$DELORD(N),$$DELONLY!($$KNDO="DEL"),$$^W4DEL(N) G VIBSHOW ; I '$G(%ARG("DELETEDORDS")),$$DELORD(N),'$G(%ARG("NCA")) D D(19.5) Q I $G(%ARG("NIGHT")),$$NIGHT(N) G VIBSHOW I $G(%ARG("NIGHT")),'$$NIGHT(N) Q ; I $G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N),'HZMH G VIBSHOW ; ;;I $G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N),'$$DELORD(N),'HZMH,'$$DISPATH G VIBSHOW ; N DATHZ S DATHZ=$$DTHZ(N) I $G(%ARG("TODAY")),DATHZ<$$^W4DZ,'$$ITRA^W4HZMST(N)!$$DELORD(N) Q ; ;;I $G(%ARG("DELETEDORDS")),$$DELORD(N) G VIBSHOW ; ; I '$G(%ARG("SENDEDORDS")),'$G(%ARG("ALLORDS")),$$SENDEDORD(N),'$$DELORD(N),'HZMH D D(16.2) Q I '$G(%ARG("NOSENDEDORDS")),'$$SENDEDORD(N),'$$DELORD(N),'HZMH D D(16.3) Q D D(17) ; I $G(OPT)=2,'$$SENDEDORD(N)!$$DELORD(N) D D(18) Q ; -- SUBMIT I $G(OPT)=3,'$$DELORD(N) D D(19) Q ; -- DELETE ; D D(19.6) I $$SNDKTC,$$KINDORD="NOSENDED",$$SNDKTCORD(N) D D(19.8) Q ; I '$G(%ARG("NOPAIDORDS")),$$NOSHUL(N),'$$DELORD(N),'HZMH Q I '$G(%ARG("PAIDORDS")),'$$NOSHUL(N),'$$DELORD(N),'HZMH Q D D(21) I $$CALLTO G VIBSHOW1 ; ;;W "N="_N_" MEDT="_MEDT_" ADDT="_ADDT_" DATHZ="_DATHZ_" CODEHZ="_CODEHZ_"
    ",! I $G(MEDT),DATHZADDT Q D D(24) ; I '$G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N) Q ; D D(25) I '$G(%ARG("BIDS")),HZMH Q ; D D(26) VIBSHOW ; N DATHZ S DATHZ=$$DTHZ(N) I $G(MEDT),DATHZADDT Q N PSL D D(27) I $$MIKUM S PSL=+$P(FULLIND,"^") I $D(MPSL(PSL)) D D(28) Q VIBSHOW1 ; D .N EN S EN=0 .I $$SF^W4PRM,$$DISPATH,$$TAKEAWAY^W4HZMST(N),'$$^W4HZMH(N) D Q:EN ..N TRH S TRH=$$TRH^W4HZMST(N) ..I $$^%L1DC(TRH,3)>$$^W4DZ Q ..I $$PAIDIT^W4HZPCHD(N) D S EN=1 Q ...D SGPSL(N,19) ..I $$WOLT^W4HZPCHD(N) D S EN=1 Q ...D SGPSL(N,1) ..D ...N DATCB S DATCB=$$DATCB^W4HZMST(N) ...I $$DIF^%L1TIME($H,DATCB)<15 Q ...N PSL S PSL=2 ...D SGPSL(N,PSL) S EN=1 . .I $G(@$$^W4PRM@("ZAZA")),$$DISPATH,$$WOLT^W4HZPCHD(N) D SGPSL(N,-1) Q . .D SHOWORD(MSDHZ,N,NOPC) ; S @$$^W4MAIN("VIB")@(FULLIND)="" I $G(PSL) S MPSL(PSL)="" ; Q ; SENDEDORD(HZ) ; I $$PSL^W4HZMST(HZ) Q 1 I $$PIZUL(HZ) Q 1 Q 0 ; DELORD(HZ) ; I $$DEL^W4DEL(HZ) Q 1 ;;I $$TSHL^W4HZMST(HZ)<0 Q 1 I $D(@$$^W4ORD@(HZ))'=11 Q 3 Q 0 ; FUTURE(N) ; N DATHZ S DATHZ=$$DTHZ(N) I DATHZ>$H Q 1 Q 0 ; SHAAGV(STAM) I '$$^W4SHAAZ Q 5 Q $$SHAAZ^W4PRM ; FAXORD(HZ) ; I $D(@$$^W3ORD(HZ)@(HZ,"F")) Q 1 Q 0 ; HZMH(HZ) ; I $$^W3PRCOFR(HZ) Q 1 Q 0 ; MOUSEOVER ; N PRMHZ S PRMHZ=N_"~"_$G(MEDT)_"~"_$G(ADDT)_"~"_$G(LKH) W " onMouseOver=""ChangeCursor(this)"" onClick=""ShowOrd('"_N_"','"_PRMHZ_"',1)""",! Q ; ; SHOWORD(MSD,N,NOPC) ; ;;S ^LV("W4DLVORD-SHOWORD0",N)=$G(NOPC) N HZMH,PSL,MPSL S HZMH=$$^W4HZMH(N) D GL I $D(@GL@(N))<11 Q D D(29) S N=$TR(N," ","") ; ;;S ^LV("W4DLVORD-SHOWORD",N)=$G(NOPC) ; N DAT,SHAA,IR ;;,JB S JB=N S DAT=$$TRH^W4HZMST(N) S SHAA=$$SHAA^W4HZMST(N) S IR=$$IR^W4HZMST(N) N CMHD S CMHD=$$HRA2^W4HZMST(N) ; --------- ORDER NUMBER --------- ; D COMPTOT(N) ; I $G(NOPC) D Q ; -- PREPAIR BEG STROKA .D:$L(CMHD) ..I CMHD?1N.N1":10B".P Q ..I CMHD["dpnfd lehia" Q ..I CMHD[":10B" S CMHD=$P(CMHD,":10B",2,20) ..I $$^%L1DC($$TRH^W4HZMST(N),3)'=+$H Q ..N SHAA S SHAA=$$SHAA^W4HZMST(N) ..I $$DELORD(N) Q ..I SHAA*60+$P(SHAA,":",2)<($P($H,",",2)/60) Q ..N TXT S TXT=" "_N_" : "_$$H2U^%L1FRM(CMHD)_" ******" ..S TXTMRQ=TXTMRQ_TXT ; ; I FIRSTLINE,$L(TXTMRQ),$G(OPT) D ; -- SHOW BEG STROKA .W "    " .W "",! .S FIRSTLINE=0 ; ;;W N,! ;----------------------------------- SHOW LINE ---------- W "" ; ;--- COLUMN 1 ( ORDER NUMBER + SIGN FOR DELIVERING ) W "",! ; ;---------------- COLUMN 2 - ORDER DETAILS W "",! ; ; ---------------- COLUMN 3 - TOTAL & PAYMENT KIND W "",! ; ; ---------------- COLUMN 4 - READY I $$IFREADY D TDREADY I $$IFCALL2CL D TDCALL I $$IFSNDY D TDSUPPL ; ; ---------------- COLUMN 5 - SENDED TIME W "",! ; W "",! Q ; ; TDREADY ; W "" Q .I $$CORR^W4PRM D ..N CLRBUT S CLRBUT="green" ..I $D(@$$^W4GL("W4CORHM")@(N))>9 S CLRBUT="red" ..D ^W4BUTTON("","CORRESPONDENCE","Corr('"_N_"')","color:"_CLRBUT_";font-weight:bold") .I $G(@$$^W4ORD@(N,"WHENCOMM")) D ..N TIME S TIME=^("WHENCOMM") ..N DAT S DAT=$P(TIME," ") ..N CLR S CLR="red" ..I $$^%L1DC(DAT,3)<$H S CLR="yellow" ..W "
    " .. W $$^%W1DICT("CALLTO")_"
    "_DAT .. I '$$1024^W4WDSCR W " "_$$H2U^%L1FRM($$^%L1DC(DAT,9))_"`" .. W "
    "_$P(TIME," ",2) ..W "    " ; W "" W "
    " W ""_$$TIMEREADY(N)_"" ; I 'HZMH,'$$DELORD(N) D . D PRINTDOC I $$I^W4PIZUL(N) D . W ""_$$^%W1DICT("PIZULOF")_"
    "_$$I^W4PIZUL(N)_"    " W "",! Q ; TDCALL ; W "" Q ; TDSUPPL ; W "" Q ; CHKSND(N) ; I $$1024^W4WDSCR W "
    ",! W "" W "" Q ; NEW(HZ,MSD) ; I $G(HZ)="" Q 0 N LKH S LKH=$$NMB^W4HZMST(HZ) I $G(LKH)="" Q 0 I $G(MSD)="" Q 0 I $O(@$$^W4GL("W4LINKI")@(LKH,MSD,HZ),-1)="" Q 1 Q 0 ; MSGTM(DAT,SHAA,IR,ORD) ; I $$DELIS^W4PRM,$G(ORD) D Q .N DATTODAY S DATTODAY=$$^%L1DC($$^W4DZ,1) .N DATCB S DATCB=$$DATCB^W4HZMST(ORD) .S DATCB=$P(DATCB," ") .N TRH,SHAA,SHAAZ,DTCB,DTHZ .S TRH=$$TRH^W4HZMST(ORD) .S DTHZ=$$^%L1DC(TRH,3) .S DTCB=$$^%L1DC(DATCB,3) .S SHAA=$$SHAA^W4HZMST(ORD) .S SHAAZ=$$SHAAZ^W4PRM .I DATCB=DATTODAY,DTCB=DTHZ&(SHAA'" ..W "" .. W $$^%W1DICT("TODAY2TODAY") ..W "",! ; N PER S PER=$$PERIOD(DAT,SHAA,IR,$G(ORD)) I PER=0,'$$SENDEDORD(ORD) D .W ""_$$^%W1DICT("NOW!")_"" I PER=1 W $$^%W1DICT("TODAY") I PER=-1 Q I PER>1 D .W "" .W $$^%W1DICT("FUTURE") .W "" Q ; PERIOD(DAT,SHAA,IR,ORD) N TVAH S TVAH=$$THZ^W3TIME(IR) I 'TVAH S TVAH=60 I $$^%L1DC(DAT,3)<+$H Q -1 I $$^%L1DC(DAT,3)>+$H Q 2 I $G(ORD),$$DAHUY^W4HZPCHD(ORD) Q 1.5 I $G(@$$^W4PRM@("TVHKZR")) S TVAH=$G(@$$^W4PRM@("TIMETM")) I $$^%L1DC(DAT,3)=+$H,$$MIN(SHAA)-($P($H,",",2)\60)TVAH Q 1 Q "" ; MIN(SHAA) ; Q $P(SHAA,":")*60+$P(SHAA,":",2) ; ; SELNAME(GR) ; K ^[$$^W3MAIN]TMP(JB) ; D SEDER(GR) N NXT S NXT=$O(^[$$^W3MAIN]TMP(JB,"")) I NXT="" Q N PR1 S PR1=0 S NXT=$O(^[$$^W3MAIN]TMP(JB,NXT)) I NXT="" S PR1=1 ; W "",! K ^[$$^W3MAIN]TMP(JB) Q ; SELNAME1(INVMSD,MSD) ; Q:$G(INVMSD)="" N VL S VL=$$H2U^%L1FRM($$INV^%L1FRM(INVMSD)) W "",! Q ; SEDER(GR) ; K ^[$$^W3MAIN]TMP(JB) N N,NS D .S N="" F NS=1:1 S N=$O(^[$$^W3MAIN]W3MSDR(GR,N)) Q:N="" D ..I $G(^(N)) D CRTMP(N) Q ; ; DTHZ(ORD) ; N DTHZ S DTHZ=$$^%L1DC($$TRH^W4HZMST(ORD),3) N SHAA S SHAA=$$SHAA^W4HZMST(ORD) I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 ; I $G(%ARG("GLLINK"))="W4LINKDR" D .S DTHZ=$$^%L1DC($P($$DATCB^W4HZMST(ORD)," "),3) .S SHAA=$P($$DATCB^W4HZMST(ORD)," ",2) .I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 ; I DTHZ Q DTHZ Q $$^W4DZ ; ; CRTMP(MSD) ; N INV,NM S NM=$G(^[$$^W3MAIN]W3MSD(MSD)) S INV=$$INV^%L1FRM(NM) Q:INV="" S ^[$$^W3MAIN]TMP(JB,INV)=MSD Q ; STAT(KOT,VL,PR) I 'VL W "" Q ; W "" Q ; D(C) ; S ^D(N)=C ;;W "N="_N_" C="_C_" "_$H_" ",! Q ; INIT ; K ^D D KILL^%W3DEB("W4DLVORD") D KILL^%W1PRM("PSL") ; S MSD=$$GETP^%W1PRM("MSD") D ^%W1ARG I $G(%ARG("MSDR")) K MSD S MKBL=$G(MKBL) I $$MY S MKBL=$G(%ARG("MY")) ; I $$DISPATH D PUT^%W1PRM("DISPATH",$$DISPATH) I $$SNDKTC D PUT^%W1PRM("SNDKTC",$$SNDKTC) D KILL^%W1PRM("DISPATH") ; D ^W4IN ; --> P1DZ ; I $G(%ARG("MEDAT")) S MEDT=$$^%L1DC(%ARG("MEDAT"),3) I $G(%ARG("ADDAT")) S ADDT=$$^%L1DC(%ARG("ADDAT"),3) ; ;;I '$G(MEDT) S MEDT=P1DZ I $$DISPATH!$$SNDKTC!$G(%ARG("TODAY")) S MEDT=P1DZ-60 I '$G(MEDT) S MEDT=P1DZ I $$DISPATH S MEDT=P1DZ-60 I '$G(ADDT) S ADDT=P1DZ+280 ; I $G(%ARG("FUTUREORDS"))="" D .S %ARG("FUTUREORDS")=$S($$HD="DAYORDERS"&'$$SF^W4PRM:0,1:1) I $G(%ARG("TODAY")),'$G(%ARG("FUTUREORDS")),'$G(%ARG("MY")) S ADDT=P1DZ ; -- 15/03/20 ; D PUT^%W3DEB("W4DLVORD","OPT=OPT & MEDT=MEDT & ADDT=ADDT & MSD=MSD & CODE=CODE & LKHR=LKHR & ARG=[%ARG") ; S W4DLVORD("JB")=JB ; S GL=$$^W4ORD ; I $G(%REM) D PUT^%W1PRM("REM",%REM) S PRMDB=0 N N S N="" F S N=$O(@$$^W4GL("PAR")@(N)) Q:N="" I $$PRINTIG^W3PRMDP(N)[">" S PRMDB=1 Q ; ;;I $G(%ARG("KNDO"))="DEL"!$$DELONLY S %ARG("DELETEDORDS")=1 I $G(%ARG("KNDO"))="DEL" S %ARG("DELONLY")=1 ; --- 03/11/24 Q ; KOT ; W "
    " .W "" .W TXTMRQ .W "",! .W "
    " I $$MSPYOM^W4PRM D .W "" . W " "_W4DLVORD_" " .W "",! .W "" . W " "_$$^W4MSPYOM(N)_" " .W "" ; I '$$MSPYOM^W4PRM D .W " "_W4DLVORD_" " ; I $$DISPATH,'$$SENDEDORD(N),'$$DELORD(N),'HZMH D CHKSND(N) I $$SNDKTC,'$$SNDKTCORD(N),'$$DELORD(N) D CHKSND(N) ; I '$$DELORD(N),'$$MIKUM D .W "
    ",! .I $$DISPATH,$$FIRE^W4HZMST(N) W "" .W " " D MSGTM(DAT,SHAA,IR,N) ; I '$$MIKUM,$D(@$$^W4ORD@(N,"DETNOTES"))>9 D .W "
    " .D ^W4BTN("NOTES","ShowDetNotes('"_N_"')","BROWN",,"14") ; I $$MIKUM D .N PSL S PSL=$$PSL^W4HZMST(N) Q:'PSL .W "
    " .W $$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL)))_"" ; W "    		",! ; S %ARG("W4DLVORD")=W4DLVORD D ^W4ORDHD(W4DLVORD,$$SHORTSHOW) W "",! ; W " "_$J($$TSHL^W4HZMST(N),2,2)_" 
    " ; N SHULS S SHULS=$$SHUL^W4HZMST(N)+$$SHULA^W4HZMST(N) N CODTS S CODTS=$$CODTS^W4HZMST(N) N ITRA S ITRA=$$ITRA^W4HZMST(N) ; I SHULS D .W "" . W $$SHOWPAID(N) .W "" . .I CODTS=4,$D(@$$^W4ORD@(N,"TB"))>9 S CODTS=7 . .W "
    " .W "" .D .. N MZM,CA,ASR .. S MZM=$$MZM^W4HZMST(N) .. S CA=$$CA^W4HZMST(N) .. S ASR=$$ASR^W4HZMST(N) .. I MZM W $$^W3SHOWTS(1)_" "_$J(MZM,2,2)_"
    " .. I CA W $$^W3SHOWTS(3)_" "_$J(CA,2,2)_"
    " .. I ASR W $$^W3SHOWTS(4)_" "_$J(ASR,2,2)_"
    " .W "    " . .I ITRA D ..W "
    " ..N BGC,FGC S BGC="darkred",FGC="white" ..W "" .. W " "_$$^%W1DICT("ITRA")_" "_$J($$ITRA^W4HZMST(N),2,2)_" " ..W "" ; I 'SHULS,CODTS<5,ITRA,'HZMH D .I '$G(%ARG("SGYOM")) D ..N BGC,FGC S BGC="darkred",FGC="white" ..I CODTS=4,'$$SF^W4PRM S BGC="pink",FGC="black" ..I CODTS=4,$$SF^W4PRM S BGC="white",FGC="black" ..W "" ..N PAYMKIND S PAYMKIND=$$PAYMKIND^W4PAYBT(CODTS) ..IF PAYMKIND="" S PAYMKIND="PAYMINLOCAL" ..W " "_$$^%W1DICT(PAYMKIND)_" " ..W "" . .I $G(%ARG("SGYOM")),'$$DELORD(N) D .. W "" .. W " " .. W "",! W "    		" ; ; I '$$SENDEDORD(N),$$DISPATH,$$TIMERMSL^W4PRM D .N TM0 S TM0=$P($G(@$$^W4ORD@(N,"SVTIME1")),",",2) Q:TM0="" .W "" . N TM S TM=$P($H,",",2)-TM0 . I TM<0 S TM=TM+(24*3600) . Q:TM<60 Q:TM>(2*3600) . W $$T^%L1TIME(TM)_"
    " .W "    " ; I '$$SNDKTC D .I '$$SENDEDORD(N),'$$DELORD(N) D ..S ZMANS=$S($$TAKEAWAY^W4HZMST(N):$$^%W1DICT("TAKEAWAY!"),1:$$^%W1DICT("WAITING")) ..D ...N DT,DZ S DZ=$$^W4DZ,DT="" ...N D F D=DZ:1:DZ+100 I $D(@$$^W4GL("W4SLPLAN")@(D,N)) S DT=D Q ...Q:'DT ...Q:'$D(@$$^W4GL("W4SLPLAN")@(DT,N)) ...N PSL,PSL1 S PSL=+$G(^(N)) Q:'PSL ...S PSL1=" [ "_$$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL)))_" ? ]" ...S ZMANS=ZMANS_"
    " ...S ZMANS=ZMANS_PSL1_"" . .I $$SENDEDORD(N) D ..I $$PIZUL(N) S ZMANS=$$^%W1DICT("PIZUL") D Q ...N HZ S HZ="" F S HZ=$O(@$$^W4GL("W4PIZUL")@(N,HZ)) Q:HZ="" I HZ D ....S ZMANS=ZMANS_"
    "_HZ_"" ..N PSL S PSL=$$PSL^W4HZMST(N) Q:'PSL ..S ZMANS=$$ZMANS^W4HZMST(N)_"
    " ..S ZMANS=ZMANS_"" ..S ZMANS=ZMANS_$$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL)))_"" ; I $$SNDKTC D .I '$$SNDKTCORD(N),'$$DELORD(N) D ..S ZMANS=$$^%W1DICT("WAITING") .; .I $$SNDKTCORD(N) D ..S ZMANS=$G(@$$^W4ORD@(N,"SNDKTC")) Q:'ZMANS ..S ZMANS=$ZD(ZMANS,"24:60") ; I '$$DELORD(N) W ZMANS ; I $$DELORD(N) D Q .W " " .D ..I $$DELORD(N)=2 W $$^%W1DICT("DATEOVER") Q ..N OV,OV1 S OV=$P($G(@$$^W4GL("W4LINK")@(N)),"~",5),OV1="" ..I OV["^" S OV=$P(OV,"^") ..S OV1=$$^W4NAME(OV) ..W $$^%W1DICT("ORDERDELETEBY",OV1) ; I $$DELIS^W4PRM D .W "
    " .I '$$SENDEDORD(N) D Q ..W "",! . .I $$SENDEDORD(N),$G(@$$^W4GL("W4SURE")@(N)) D ..N VL,WHO S VL=$G(^(N)) ..S WHO=$P(VL,"\") Q:WHO="" ..W ""_$$^%W1DICT("MADESURE")_" : "_$$H2U^%L1FRM($$^W4NAME(WHO)) W "
    " I '$$DISPATH,$$^W4HZMH(N),$$CORR^W4PRM D W "" W "" W "
    " W ""_$$TIMECALL(N)_"" W "    		" W "" W "
    " W ""_$$TIMESUPPL(N)_"" W "    		 " W $$^%W1DICT(KOT)_" : " W " " W VL_"
    ",! W "" W "",! D STAT("ORDERQN",SHZ,1) I $$SDSAK^W4PRM D STAT("SSOAD",SSOAD,1) D STAT("NEWCLIENTS",SNEW,1) D STAT("WAITING",SNOSBM,1) D STAT("NOSENDED",SNOSHUD,1) D STAT("NOPAID",SNOSHUL,1) D STAT("NODLV",SNODLV,1) ; I '$$MGR^W4KOTMLZ,$G(@$$^W4PRM@("TOTDLVMG")),'$$REPTRH D .I $$DELIS^W4PRM,$$^W4MYDVN=20!($$^W4MYDVN=22) Q .S SPAY=0 ; D STAT("TOPAY",$J($G(SPAY),2,2),1) W "",! W "
    "_$$^%W1DICT("TOTAL")_"
    ",! Q ; KOTTB ; W "",! W ""_$$^%W1DICT("ORDERNUMBER")_"" W ""_$$^%W1DICT("CUSTOMERDETAILS")_"" W ""_$$^%W1DICT("TOTAL")_"" I $G(OPT) D .I $$IFREADY D ..W ""_$$^%W1DICT("READY?")_"" .I $$IFCALL2CL W ""_$$^%W1DICT("CALLTO")_"" .I $$IFSNDY W ""_$$^%W1DICT("SUPPLIED")_"" .W ""_$$^%W1DICT("SENDEDTIME")_"" W "",! Q ; TOT ; N DV S DV=$$^W4MYDVN ;;I $$DELIS^W4PRM,",21,25,26,27,28,30,"[(","_DV_",") Q I '$$MGR^W4KOTMLZ,$G(@$$^W4PRM@("TOTDLVMG")),'$$REPTRH D .I $$DELIS^W4PRM,$$^W4MYDVN=20!($$^W4MYDVN=22) Q .S (SHNH,SDMS,SNEWHN,SNEWDM,SNEWPAY,SPAY,SSOAD)=0 . .N RST S RST="" F S RST=$O(SMSD(RST)) Q:RST="" D ..S SMSD(RST,"D")=0 ..S SMSD(RST,"S")=0 . .N SUGT S SUGT="" F S SUGT=$O(SCODTS(SUGT)) Q:SUGT="" D ..S SCODTS(SUGT,"S")=0 . .N MKR S MKR="" F S MKR=$O(SMKR(MKR)) Q:MKR="" D ..S SMKR(MKR,"S")=0 ; W "" W " " W $$^%W1DICT("TOTAL") W "",! ; W "",! W "" W "",! W "",! W "",! W "" W "
    ",! W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SHZ) W "" W ""_$$^%W1DICT("DISCOUNTS")_" : "_$J(SHNH,2,2)_""_$$NBSP^%L1FRM(5) W ""_$$^%W1DICT("DLVPAY")_" : "_$J(SDMS,2,2)_"" W "
    " W "",! ; N COLSP S COLSP=2+$$IFREADY+$$IFCALL2CL+$$IFSNDY W "",! W " "_$J($G(SPAY),2,2)_" " W "",! ; W "",! ; ; I $G(SNEW),'$$REPTRH D .W " " .W $$^%W1DICT("NEWCLIENTS") .W "",! .W "",! .W "",! .W "",! .W "",! .W "
    ",! .W "  "_$$^%W1DICT("ORDERQN")_" : "_SNEW .W "" .W $$^%W1DICT("DISCOUNTS")_" : "_$J(SNEWHN,2,2) .W "" .W $$^%W1DICT("DLVPAY")_" : "_$J(SNEWDM,2,2) .W "
    ",! .W "",! .W " "_$J(SNEWPAY,2,2)_" " .W "",! .W "",! ; I $O(SMSD($O(SMSD(""))))'="" N RST S RST="" F S RST=$O(SMSD(RST)) Q:RST="" D .W " " .W $$NAME^W3MSD(RST) .W "",! .W "",! .W "",! .W "",! .W "
    ",! .W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SMSD(RST,"Q")) .W "" .W $$^%W1DICT("DLVPAY")_" : "_$J($G(SMSD(RST,"D")),2,2) .W "
    ",! .W "",! .W " "_$J($G(SMSD(RST,"S")),2,2)_" " .W "",! .W "",! ; I '$$REPTRH N SUGT S SUGT="" F S SUGT=$O(SCODTS(SUGT)) Q:SUGT="" D .W "" .W "  " .W $$^W3SHOWTS(SUGT) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SCODTS(SUGT,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SCODTS(SUGT,"S")),2,2)_" " .W " ",! .W "",! ; N MKR I '$$REPTRH S MKR="" F S MKR=$O(SMKR(MKR)) Q:MKR="" D .W "" .W "  " .W $$^W3MKR(MKR) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SMKR(MKR,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SMKR(MKR,"S")),2,2)_" " .W " ",! .W "",! EN ; Q ; ; BUTTONS ; W "",! I '$$DISPATH,'$$SNDKTC D .W " ",! ; D .I '$G(@$$^W4PRM@("MAPSHOW")) Q .I '$$MAPLAT^W4MAPPRM(1)!'$$MAPLNG^W4MAPPRM(1)!'$$ZOOM^W4MAPPRM(1) Q .D MAPDLV ; D BACK ; W "
    " D BUTTON("rbtprint",$$^%W1DICT("PRINTORDERLIST"),"Print('"_OPT_"','"_$G(MEDT)_"','"_$G(ADDT)_"','"_$G(CODE)_"')","font-size:"_$$^W3FSZ(16)) W "
    ",! Q ; MAPDLV ; W " " D BUTTON("rbtmap",$$^%W1DICT("MAPDLV"),"MapDlv()","color:green;font-size:"_$$^W3FSZ(16)) W "",! Q ; BACK ; W " " D BACKBTN W "",! Q ; BACKBTN ; D BUTTON("rbtback",$$^%W1DICT("BACK"),"Back('"_MSD_"')","color:red;font-size:"_$$^W3FSZ(16)) Q ; GL S GL=$$^W4ORD Q ; DISPATH(STAM) ; Q $G(%ARG("DISPATH")) ; SNDKTC(STAM) ; I $G(%ARG("SNDKTC")) Q 1 I $$GETP^%W1PRM("SNDKTC") Q 1 Q 0 ; SNDKTCORD(HZM) ; N OK S OK=0 N L S L=$O(@$$^W4ORD@(HZM,9999),-1) I L,$G(^(L))["\@@" S OK=1 Q OK ; N I S I="" F S I=$O(@$$^W4ORD@(HZM,I)) Q:I="" I I D Q:'OK .I $G(^(I))'["\@@" S OK=0 Q OK ; ; TAW(STAM) ; Q $G(%ARG("TAW")) ; COMPTOT(N) ; N TS S TS=$$TSHL^W4HZMST(N) N DMS S DMS=$$DMSH^W4HZMST(N) N HNH S HNH=$$HNH^W4HZMST(N) ; S SPAY=$G(SPAY)+TS S SDMS=SDMS+DMS S SHNH=SHNH+HNH I '$$^W4PIZUL(N) S SHZ=SHZ+$$QN(N),SSOAD=SSOAD+$$SOAD^W4HZMST(N) ; I $$DELORD(N) S SDEL=SDEL+1 I $$SENDEDORD(N) S SSBM=SSBM+1 ; I '$$SENDEDORD(N),'$$DELORD(N) D .S SNOSBM=SNOSBM+1 ; I $$NOSHUL(N) S SNOSHUL=SNOSHUL+1 ; I '$$SEND2CUST(N) S SNODLV=SNODLV+1 ; D .N CODTS,SUM,ITRA,MZM,CHK,CA,ASR .S CODTS=$$CODTS^W4HZMST(N) .S SUM=TS .I CODTS<2 S CODTS=1 .S ITRA=$$ITRA^W4HZMST(N) .S MZM=$$MZM^W4HZMST(N) .S CHK=$$CHK^W4HZMST(N) .S CA=$$CA^W4HZMST(N) .S ASR=$$ASR^W4HZMST(N) .S SCODTS(1,"S")=$G(SCODTS(1,"S"))+ITRA .I MZM S SCODTS(1,"S")=$G(SCODTS(1,"S"))+MZM .I CHK S SCODTS(2,"S")=$G(SCODTS(2,"S"))+CHK .I CA S SCODTS(3,"S")=$G(SCODTS(3,"S"))+CA .I ASR S SCODTS(4,"S")=$G(SCODTS(4,"S"))+ASR .I 'MZM,'CHK,'CA,'ASR Q .S SCODTS(CODTS,"Q")=$G(SCODTS(CODTS,"Q"))+1 ; D .N RST S RST=$P($G(@$$GLLINK@(N)),"~") Q:'RST .S SMSD(RST,"Q")=$G(SMSD(RST,"Q"))+$$QN(N) .S SMSD(RST,"S")=$G(SMSD(RST,"S"))+TS .S SMSD(RST,"D")=$G(SMSD(RST,"D"))+DMS .S SMSD(RST,"HN")=$G(SMSD(RST,"HN"))+$G(HNH) ; I $G(MSD),$$NEW(N,MSD) D .S SNEW=SNEW+1 .S SNEWPAY=SNEWPAY+TS .S SNEWDM=SNEWDM+$$DMSH^W4HZMST(N) .S SNEWHN=SNEWHN+$$HNH^W4HZMST(N) ; N MKR S MKR=$$MKR(N) I MKR="" S MKR=99 S SMKR(MKR,"Q")=$G(SMKR(MKR,"Q"))+$$QN(N) S SMKR(MKR,"S")=$G(SMKR(MKR,"S"))+TS Q ; SEND2CUST(ORD) ; I $$PSL^W4HZMST(ORD) Q 1 Q 0 ; NOSHUL(ORD) ; I $$TSHL^W4HZMST(ORD)>($$SHUL^W4HZMST(ORD)+$$SHULA^W4HZMST(ORD)) Q 1 Q 0 ; SHOW4COPY(STAM) ; Q +$G(%ARG("SHOW4COPY")) ; DIVPSL ; W "
    ",! W " ",! ; I $$DISPATH!$$SNDKTC D SHOWDISPATH W "
    " Q ; I $$CALLTO D CALLTOBUT W "" Q ; W "" ; ----------------------------- 1 STROKA S WD=90 I $$1024^W4WDSCR S WD=84 W "" W "" W "" W "" W "",! ; I '$$1024^W4WDSCR W "" ; D TIMESORT ; W "" ; D ASCENDING ; W "" W "
    " D FIND W " " D KINDORDS W "  
    " W "" W "" D SHOWBTN D SPACE D BACKBTN W "" W "" ; W "" ; --------------------------- 2 STROKA W "" W "" W "" S TDSPWD=10 I '$$1024^W4WDSCR S TDSPWD=8 D ORDSOURCE D TDSP D PAYMKIND D TDSP W "" ; D TDSP ; W "" ; D TDSP ; W "" W "",! W "
    "_$$^%W1DICT("ORDER")_$$REVAH W "" W ""_$$^%W1DICT("AUTHNO")_$$REVAH W "",! W ""_$$^%W1DICT("CUSTOMNUMBERORNAME")_$$REVAH D .N CUST S CUST=$$INVH^%L1FRM($G(%ARG("CUSTOM"))) .W "",! W "
    ",! W "" W "",! ; ;;D SRCADR ; -------------------- 3 STROKA ------------------- ; W "" ; --------------------- 4 STROKA ------------------ W "",! W "" W "" D PSLCHK W "",! W "
    ",! W "" W "",! ; W "",! Q ; ; SHOWDISPATH ; W "" W "" W "" W "" W "" D PSLCHOICE ; N WD S WD=25 I $$1024^W4WDSCR S WD=10 W "" ; D FULLSHOWRADIO ; S WD=32 I $$1024^W4WDSCR S WD=27 I $$TAW S WD=$S($$1024^W4WDSCR:42,1:44) W "" ; D SHOWTAW W "" W "
    " D FIND W "   
    " W "" ; N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN D BACK W "",! W "" W "" W "" W "" W "" W "" D TIMESORT W "" D ASCENDING W "" W "
    " W $$^%W1DICT("SHOWALLORDS") W "" D SPACE W $$^%W1DICT("SHOWNOTDLVORDS") W "" W "  
    " W "" D PSLSHOW W "",! Q ; ; SRCADR ; N WD S WD=22 W "" ; --------------------- 3 STROKA ------------------ W "" W "" W "" ;; W "",! W "",! W "",! W "
    "_$$^%W1DICT("ADDRESS")_$$NBSP^%L1FRM(2) ;; W "" ;; W ""_$$^%W1DICT("SEARCH")_$$NBSP^%L1FRM(2) W " " D ^W4BUTTON("SrchDn",">","FindText('search',false)","width:25px;height:25px;background-color:lightgrey") W " " D ^W4BUTTON("SrchUp","<","FindText('search',true)","width:25px;height:25px;background-color:lightgrey") W "
    ",! W "" W "",! Q ; ; CALLTOBUT ; W "" W " " W "" W $$^%W1DICT("SHOW3DAYS")_" " W "" W "" W "" W $$^%W1DICT("SHOWALLCALLBIDS")_" " W "" W "" W " " W "" W "",! . W "",! . W "",! . W "",! . W "",! .W "" .W " " W "" D BACKBTN W "" W " " W "",! Q ; ; HB(PRM) I $G(PRM)="" Q "" S PRM=$$INVH^%L1FRM(PRM) Q $$H2U^%L1FRM(PRM) ; FNDMISCBUT ; W "" ;;D ROUNDBUT^%W1JS("findord",$$^%W1DICT("FINDORDER"),"FindOrder()","color:blue;font-size:"_$$^W3FSZ(16),"wh29,29") D BUTTON("findord",$$^%W1DICT("FINDORDER"),"FindOrder()","color:blue;font-size:"_$$^W3FSZ(16)) W "",! ; W "" ;;D ROUNDBUT^%W1JS("misc",$$^%W1DICT("MISC"),"Misc()","color:brown;font-size:"_$$^W3FSZ(16),"wh29,29") D BUTTON("misc",$$^%W1DICT("MISC"),"Misc()","color:brown;font-size:"_$$^W3FSZ(16)) W "",! Q ; PSLRCV ; W "" W " "_$$^%W1DICT("RECEIVER")_" : "_$$H2U^%L1FRM($$^W4NAME($G(%ARG("MKBL"))))_"" W "",! W " " Q ; ; PSLCHOICE ; I $$TAW!$$SNDKTC D TDSP G PSLCH1 ; W "",! W " ",! D SPACE ; PSLCH1 ; D PSLSBM ; Q ; ; PSLCHK ; N TDSPWD ;;D PAYMKIND ; D SHOWSNDORNOORDERS ; D TDSP ; D SHOWPAIDORNOORDERS ; D TDSP ; ; D DELORDERSONLY ; D SHOWDELORDERS ; D SHOWFUTORDERS ; D SHOWBIDORDERS ; D SHOWTAW Q ; ; ORDSOURCE ; W "" W $$^%W1DICT("ORDERSOURCE")_$$REVAH W "",! W "" Q ; PAYMKIND ; W "" W $$^%W1DICT("PAYMENTKIND")_$$NBSP^%L1FRM(4) D PAYMKIND1^W4DLVORD W "" Q ; PAYMKIND1 ; W "",! Q ; SHOWSNDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOSENDEDORDS")_" " W "" ; D SPACE W $$^%W1DICT("SHOWSENDEDORDS")_" " W "" W "" Q ; SHOWPAIDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOPAIDORDS")_" " W "" ; W $$^%W1DICT("SHOWPAIDORDS")_" " W "" W "" Q ; SHOWDELORDERS ; W "" W $$^%W1DICT("SHOWDELETEDORDS")_" " W "" W "" Q ; SHOWFUTORDERS ; W "" W $$^%W1DICT("SHOWFUTUREORDS")_" " W "" W "" Q ; SHOWTAW ; W "" W $$^%W1DICT("SHOWTAW")_" " W "" W "" Q ; SHOWBIDORDERS ; W "" W $$^%W1DICT("SHOWBIDS")_" " W "" W "" Q ; ; DELORDERSONLY ; W "" W $$^%W1DICT("DELETEDONLY")_" " W "" W "" Q ; TIMESORT ; W "" W $$^%W1DICT("TIMESORT") W "" D SPACE W $$^%W1DICT("ORDERSORT") W "" D SPACE D .W $$^%W1DICT("ADRSORT") .W "" W "" Q ; ASCENDING ; W "" W $$^%W1DICT("FROMOLD2NEW") W "" I '$$1024^W4WDSCR D SPACE W $$^%W1DICT("FROMNEW2OLD") W "" W "" Q ; PSLSHOW ; W "" D SHOWBTN W "",! Q ; FIND ; I $$^W4TABLET=2 Q W "" Q SHOWBTN ; D BUTTON("show",$$^%W1DICT("SHOW")_" ","ShowOrds()","color:brown;font-size:"_$$^W3FSZ(16)) Q ; PSLSBM ; I $$TEAV^W4PRM,$$PAPJ^W4PRM Q W "" N SUBMIT S SUBMIT="SUBMIT" I $$SNDKTC S SUBMIT="SEND2KTCH" D BUTTON("submpsl",$$^%W1DICT(SUBMIT),"SubmPsl()","color:green;font-size:"_$$^W3FSZ(16)) W "" Q ; FULLSHOWRADIO ; W "" W $$^%W1DICT("FULLSHOW") W "" D SPACE W $$^%W1DICT("SHORTSHOW") W "" W "" Q ; ; SETDLV(PRM) ; D PUT^%W3DEB("W4DLVORD-SETDLV","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:'HZ 0 N ER S ER=0 ; I $$SNDKTC G SETDLV1 ; N ISHUR S ISHUR=$P(PRM,";",3) N ITRA S ITRA=$$ITRA^W4HZMST(HZ) N CODTS S CODTS=$$CODTS^W4HZMST(HZ) ;;I PRM,ITRA>.5,'ISHUR,CODTS>4!(CODTS=3),'$G(@$$^W4PRM@("NOCHKDLV")) Q "ITRA" I PRM,ITRA>.5,'ISHUR,$D(@$$^W4ORD@(HZ,"CB","V"))>9!(CODTS>4)!(CODTS=3),'$G(@$$^W4PRM@("NOCHKDLV")) Q "ITRA" SETDLV1 ; I PRM S @$$^W4MAIN("TMPDLV")@(HZ)="" Q 1 K @$$^W4MAIN("TMPDLV")@(HZ) Q 1 ; KILLDLV ; K @$$^W4MAIN("TMPDLV") Q ; SETREADY(PRM) ; D PUT^%W3DEB("W4DLVORD-SETREADY","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:HZ'>0 0 I '$$^W4HZFULL(HZ) Q 0 N ER S ER=0 I PRM D Q $S($$TAKEAWAY^W4HZMST(HZ):3,1:2) .S @$$^W4ORD@(HZ,"READY")=$H . .I $$IFSNDY,'$$PAPJ^W4PRM D ..N PREPTIME S PREPTIME=$G(@$$^W4PRM@("PREPTIME"),5) ..D WR2SNDY(JB,HZ,PREPTIME) . .I $$MAIL2SMS^W4PRM D ..J MAIL2SMS^W4SNDSMS(JB,HZ) ; I $$TRICKER^W4PRM(HZ) D .J ^W4TRICKR(JB,HZ,"COMPLETE") ; K @$$^W4ORD@(HZ,"READY") Q 1 ; ; SETCALL(PRM) ; D PUT^%W3DEB("W4DLVORD-SETCALL","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:HZ'>0 0 I '$$^W4HZFULL(HZ) Q 0 N ER S ER=0 I PRM S @$$^W4ORD@(HZ,"CALL2CL")=$H Q 1 K @$$^W4ORD@(HZ,"CALL2CL") Q 1 ; SETSUPPL(PRM) ; D PUT^%W3DEB("W4DLVORD-SETSUPPL","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:HZ'>0 0 I '$$^W4HZFULL(HZ) Q 0 N ER S ER=0 I PRM S @$$^W4ORD@(HZ,"SUPPLIED")=$H Q 1 K @$$^W4ORD@(HZ,"SUPPLIED") Q 1 ; SNDORD(PRM) ; N (JB,%ARG,%REM,PRM) K @$$^W4MAIN("TMPER") D ^W4IN D PUT^%W3DEB("W4DLVORD-SNDORD","PRM=PRM") I '$$SNDKTC S PSL=$P(PRM,";") Q:'PSL S ZMANS=$$T^%L1TIME($P($H,",",2)) ; I '$$SNDKTC D .S HZ="" F S HZ=$O(@$$^W4MAIN("TMPDLV")@(HZ)) Q:HZ="" D SGPSL(HZ,PSL) ; I $$SNDKTC D .S HZ="" F S HZ=$O(@$$^W4MAIN("TMPDLV")@(HZ)) Q:HZ="" D ..I $$HZM^W4MSL(HZ),$$FUTUREDT^W4HZMIT(HZ) Q ..D TV^W4HZM(HZ,JB) ..S @$$^W4ORD@(HZ,"SNDKTC")=$H ; I $$PRINT^W4MDPPC'="L" D KILLDLV Q ; ; PUTTM(HZM,PSL) ; N (JB,%ARG,%REM,HZM,PSL) I $$TM^W4HZMST(HZM) Q N TM S P1DZ=$$^W4DZ L +@$$^W4GL("P1TM"):1 S TM=$O(@$$^W4GL("P1TM")@(9999999),-1)+1 S @$$^W4GL("P1TM")@(TM)=HZM_"\"_P1DZ_"\"_$H D ^%S2GLSV($$^W4GL("P1TM")_"("_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TM") ; L +@$$^W4GL("P1TMI"):1 S @$$^W4GL("P1TMI")@(P1DZ,TM)=$H D ^%S2GLSV($$^W4GL("P1TMI")_"("_P1DZ_","_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TMI") ; D PUT^W4HZMST(HZM,"TM",TM) D ^%S2GLSV($$^W4ORD_"("_HZM_")",$$^W4FGIB) ; L +@$$^W4GL("P1MSL"):1 S @$$^W4GL("P1MSL")@(P1DZ,PSL,HZM)=$H D ^%S2GLSV($$^W4GL("P1MSL")_"("_P1DZ_","""_PSL_""","""_HZM_""")",$$^W4FGIB) L -@$$^W4GL("P1MSL") ; D ^W4HZGT(HZM) ; I $$HZM^W4MSL(HZM) D .I PSL<1 Q .I $$TMMSL^W4PRM,$$NOTM^W4PRM,'$$TAKEAWAY^W4HZMST(HZM) Q ; -- 04/05/23,19/04/23 .I $$SF^W4PRM,PSL=1!(PSL=19) Q .;;S ^AA("W4DLVORD","PSL",PSL)=PSL .I $G(@$$^W4PRM@("NOPCTM")) Q .D PRNDLVDOC(HZM) .I $G(@$$^W4PRM@("2TM")) D ..D PRNDLVDOC(HZM) ; PUTTME K @$$^W4TMPORD Q ; ; KHM(HZM) N N S N="" F S N=$O(@$$^W4GL("P1HM")@(N)) Q:N="" D .K @$$^W4GL("P1HM")@(N,HZM) .D ^%S2GLSV($$^W4GL("P1HM")_"("""_N_""","""_HZM_""")",$$^W4FGIB,"K") Q ; VIEWRCV(STAM) ; I $G(%ARG("VW"))=1 Q 1 Q 0 ; FGCOLOR(ORD) ; I $$DELORD(ORD) Q "red" I $$NIGHT(ORD) Q "orange" Q "black" ; ; BGCOLOR(ORD) ; I $$DELORD(ORD) W " style=""background-color:black;color:red""" Q I $$^W4HZMH(ORD) W " style=""background-color:96CE98;color:black""" Q I $$FAXORD(ORD) W " style=""background-color:yellow""" Q I $$DELIS^W4PRM,$P($$DATCB^W4HZMST(ORD)," ")=$$TRH^W4HZMST(ORD) D .W " style=""background-color:#DDFFDD""" Q ; -- LIGHTGREEN I $$SENDEDORD(ORD) W " style=""background-color:white""" Q ; I $$PERIOD(DAT,SHAA,IR)=0 D Q ; -- SVETOFOR .N BGCOLOR .I $$^%L1DC(DAT,3)=+$H D ..N RZN S RZN=$$MIN(SHAA)-($P($H,",",2)\60) ..N TIMETM S TIMETM=$G(@$$^W4PRM@("TIMETM")) ..I RZN'>TIMETM S BGCOLOR="pink" Q ..I RZN>TIMETM,RZN<(TIMETM+15) S BGCOLOR="#FFFAAA" Q ;"lightyellow" ..S BGCOLOR="#DFFFC6" ; lightgreen . .W " style=""background-color:"_BGCOLOR_""" " Q ; I $$SF^W4PRM,$$SHABAT(ORD) D .S FGCOLOR="orange" .W " style=""background-color:darkblue;color:"_FGCOLOR_"""" ; I $$NIGHT(ORD) D Q .S FGCOLOR="orange" .W " style=""background-color:darkblue;color:"_FGCOLOR_"""" ; I $$DTHZ(ORD)>$H W " style=""background-color:c0d2ec""" Q ; -- FUTURE I $$TAKEAWAY^W4HZMST(ORD) W " style=""background-color:orange""" Q Q ; ; KINDORD(STAM) ; I $G(%ARG("ORDKIND"))="" Q "NOSENDED" Q $G(%ARG("ORDKIND")) ; KNDO(STAM) Q $G(%ARG("KNDO")) ; DELONLY() Q $G(%ARG("DELONLY")) ; SETPSL(PSL) ; D PUT^%W1PRM("PSL",PSL) Q ; MY(STAM) Q $G(%ARG("MY")) ; CMPR(HZ,NCA) ; Q $$^W4SRCCA(HZ,NCA) ; ; SGPSL(HZ,PSL) ; I $G(HZ)'>0 Q I '$$^W4HZFULL(HZ) Q I $G(@$$^W4GL("P1SL")@(PSL))="zgwl",'$$TAKEAWAY^W4HZMST(HZ) Q ; I $$CODTS^W4HZMST(HZ)=4,'$D(@$$^W4ORD@(HZ,"CB","ASR")),$$ITRA^W4HZMST(HZ) D .N P1TNOPR S P1TNOPR="" ;;I $G(PSL)>0&$G(@$$^W4PRM@("2TM")) S P1TNOPR="" .D SGASR(HZ) ; I '($$CLOSE^W4HZMST(HZ)#2) S @$$^W4ORD@(HZ,"S")=$G(@$$^W4ORD@(HZ,"S"))+$$QN(HZ) ; I '$$ITRA^W4HZMST(HZ),PSL<0 D ; -- HADP HESH TAW .N P1TNOPR,BLIPR .;; '$D(@$$^W4ORD@(HZ,"ETHB","PC")) ; -- 25.12.23 .;;I $$SHUL^W4HZMST(HZ),'$$MSHHBNOW^W4PRM,'$D(@$$^W4ORD@(HZ,"ETHB","PC")) D ^W4PCHB(HZ,1) .I '$$MSHHBNOW^W4PRM D ..N MKR,SHUL,SHULA S MKR=1 ..S SHUL=$$SHUL^W4HZMST(HZ) ..S SHULA=$$SHULA^W4HZMST(HZ) ..I '$$NCAB^W4HZMST(HZ) S MKR=1 ..I SHULA,$D(@$$^W4ORD@(HZ,"ETHB2")) S MKR=0 ..I SHUL,$D(@$$^W4ORD@(HZ,"ETHB","PC")) S MKR=0 ..I SHUL,'$D(@$$^W4ORD@(HZ,"ETHB","PC")) S MKR=1 ..;;I $D(W4BONVW),'$G(MKR) Q ..D ^W4PCHB(HZ,MKR) . .D SETCLOSE^W4HZMST(HZ) ; I '$$PSL^W4HZMST(HZ) D .D PUT^W4HZMST(HZ,"PSL",PSL) . .I $$NEWMLY^W4PRM D ..N HZM,W4MLREST S HZM=HZ,W4MLREST="" D PLU1^W4HZMPC ; I $$ZMANS^W4HZMST(HZ)="" D PUT^W4HZMST(HZ,"ZMANS",$$T^%L1TIME($P($H,",",2))) ; I PSL>0 D .I $$TRICKER^W4PRM(HZ) D ..I $D(WQDLV) D ^W4TRICKR(JB,HZ_"<>"_PSL,"WAY") Q ..J ^W4TRICKR(JB,HZ_"<>"_PSL,"WAY") .D ..I $$TM^W4HZMST(HZ),$$PSL^W4HZMST(HZ)=9999 D Q ...S $P(@$$^W4ORD@(HZ,"TM"),"\")=PSL Q ...L +@$$^W4GL("P1MSL"):1 ...K @$$^W4GL("P1MSL")@(P1DZ,9999,HZM) ...S @$$^W4GL("P1MSL")@(P1DZ,PSL,HZM)=$H ...L -@$$^W4GL("P1MSL") .. ..D PUTTM(HZ,PSL) ..; ..I $$TIPCB^W4PRM D ...N STIP S STIP=0 ...N N S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","V",N)) Q:N="" D ....S RESTIP=$$^W4TIPCB(HZ,N) ; D ; .I $$TAKEAWAY^W4HZMST(HZ),$$SF^W4PRM D ..J SNDTAW(JB,HZ) . .I '$$ITRA^W4HZMST(HZ) D D SETCLOSE^W4HZMST(HZ) ..I $$NOTM^W4PRM Q ; -- 19/12/22 ..;;I $$NOTM^W4PRM,$$SHUL^W4HZMST(HZ),'$$TAKEAWAY^W4HZMST(HZ) K P1TNOPR D ^W4PCHB(HZ,1) Q ..N LKHN S LKHN=$$NMB^W4HZMST(HZ) Q:'LKHN Q:$$IFHBMAIL^W4L(LKHN) ; *** ..;;I '$$TAKEAWAY^W4HZMST(HZ),$$MAIL2SMS^W4PRM Q ; --> 28/06/21 ..N EMAIL S EMAIL=$$EMAIL^W4HZMST(HZ) ..I EMAIL["@",(EMAIL["."),$$SND2EMAIL^W4PRM!$$IFHBMAIL^W4L(LKHN) Q ..N P1TNOPR,BLIPR ..I $$SF^W4PRM,$$SHUL^W4HZMST(HZ),'$$TAKEAWAY^W4HZMST(HZ) D ^W4PCHB(HZ,1) .; .I $$MAIL2SMS^W4PRM,'$$TAKEAWAY^W4HZMST(HZ) D Q ..J MAIL2SMS^W4SNDSMS(JB,HZ) . .I $$SND2EMAIL^W4PRM D Q ..J SNDMAIL(JB,HZ) Q ; ; SGASR(HZM) ; N (JB,%ARG,HZM,P1TNOPR,BLIPR) S ASRL=$$ITRA^W4HZMST(HZM) S (LKHN,CUSN)=$$NMB^W4HZMST(HZM) S LKAH=$$AH^W4L(LKHN) S LKHNH=0 I LKAH,'$$HNH^W4HZMST(HZM) D .S LKHNH=$J(ASRL*LKAH*.01,2,2) .S ASRL=ASRL-LKHNH S LKHR=$$LKHR^W4L(LKHN) S HRA="" S HZMLK=$$HZMLAK^W4HZMST(HZM) S ASR=ASRL ; S TIPAS="" D ^W4ASR ;;D ^W4T(HZM,1) ; 06/06/18 ; I $$HBNOW^W4L(LKHN),'$$HBNOWMONTH^W4PRM,$$NOW2EMAIL^W4PRM D .J SNDMAIL(JB,HZM,1) ; Q ; WR2SNDY(JB,HZ,TIM) ; N CMD,FLOU S FLOU="sndyou"_JB_"_"_HZ S CMD="curl -m 30 --request POST " S CMD=CMD_" --url https://sendimanapi.com/delivery/updateDeliveryPreparationTime " S CMD=CMD_" --header 'Authorization: Basic "_$G(@$$^W4PRM@("SNDY","PW"))_"'" S CMD=CMD_" --header 'Content-Type: application/json'" S CMD=CMD_" --data '{ " S CMD=CMD_"""order_id"": """_HZ_"""," S CMD=CMD_"""cook_time"": """_TIM_"""," S CMD=CMD_"""rest_username"": """_$$REST^WQDLV(HZ)_"""" S CMD=CMD_" }'" S CMD=CMD_" > "_FLOU ; ZSY CMD ; D .N A,DZ S DZ=$$^W4DZ .S @$$^W4GL("SNDY")@(DZ,HZ)=CMD .S @$$^W4GL("SNDY")@(DZ,HZ,"ZSY")=$ZSY .I '$$EXIST^%L1ZOS(FLOU) Q .C FLOU O FLOU:(REWIND:READONLY) .U FLOU R A C FLOU .S @$$^W4GL("SNDY")@(DZ,HZ,"RES")=A .S @$$^W4ORD(HZ)@(HZ,"SNDYPREP")=A Q ; ; SNDMAIL(JB,ORD,NOW) N (JB,%ARG,ORD,NOW) Q:'$G(ORD) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N RES,EMAIL,LKHN,NOM S EMAIL=$$EMAIL^W4HZMST(ORD) Q:EMAIL'["@"!(EMAIL'[".") S LKHN=$$NMB^W4HZMST(ORD) Q:'LKHN ; D Q:'NOM .I $G(NOW) S NOM=+$G(@$$^W4ORD@(ORD,"HBNOW")),VD="HB",ND=NOM Q .S NOM=$$NCAB^W4HZMST(ORD) .S VD="HZ",ND=ORD ; H 1 D SNDMAIL1(ND,NOM,EMAIL,VD,ORD) ; S EMAIL1=$$EMAIL1^W4L(LKHN) I EMAIL1["@",EMAIL1["." D .D SNDMAIL1(ND,NOM,EMAIL1,VD,ORD) Q ; ; SNDMAIL1(ND,NOM,EMAIL,VD,ORD) N PRM S PRM=ND_";Invoice "_NOM_";"_EMAIL_";"_VD_";0;1;"_$G(@$$^W4PRM@("HOWSEND"),3) ; I VD="HZ" S RES=$$EMAILCONT^W4EMAIL(PRM) I VD="HB" D .S RES=$$EMAILHB^W4EMAIL(PRM) Q:RES .S @$$^W4ORD@(ORD,"SENT2MAIL",EMAIL)=$H_";"_$P(PRM,";",2,1000) Q ; ; PRNDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB ; I $$^W4MSL(NMB),$$BIGTM^W4L(NMB) D Q .S @$$^W4MAIN("TMPBIGTM")@(HZM)=$H ; D PRINTDLVDOC(HZM) Q ; ; PRINTDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB N IET,ITS,SHM,P1HZTM,P1TNOPR,BLIPR,P1HZHB,P1HZHB1,P1HZHB2,P1HZHB3 S IET="ETTM",ITS=1,SHM="TM",P1HZTM="" ; I $G(@$$^W4PRM@("NOTM")) S P1TNOPR="" I $G(@$$^W4PRM@("MM")),'$G(@$$^W4PRM@("MMTM")) S P1TNOPR="" D P1^W4HZTM Q ; NOPRES(SL) ; I '$G(@$$^W4PRM@("BDNOCHSL")) Q 0 N OV S OV=$$OV^W4SL(SL) I OV,'$$PRES^W4SL(SL) Q 1 I OV,$$PRES^W4SL(SL) Q 0 ; N NM,NM1 S NM=$G(@$$^W4GL("P1SL")@(SL)) I NM="" Q 1 N OK S OK=0 N N S N="" F S N=$O(@$$^W4GNAME@(N)) Q:N="" D Q:OK .S NM1=$G(^(N,1)) .I $$SPA^%L1FRM(NM)=$$SPA^%L1FRM(NM1) S OK=N ; I OK,$G(@$$^W4GL("FILE")@(OK,"CIO"))'="I" Q 1 I 'OK,$$SLAU^W4PRM Q 1 Q 0 ; ; HD(STAM) ; I $$CUSTLASTORDS Q "CUSTLASTORDS<>"_$$CUSTLASTORDS_"<>"_$$LKH^W4L($$CUSTLASTORDS) I $$MY,'$$DISPATH,'$$SNDKTC Q "MYORDERS" I '$$MY,'$$DISPATH,'$$SNDKTC,$$TOMORROW Q "TOMORROWORDERS" I '$$MY,'$$DISPATH,'$$SNDKTC,$G(%ARG("MEDAT"))="" Q "DAYORDERS" I $$DISPATH,$$TAW Q "TAKEAWAYORDERS" I $$DISPATH,'$$TAW Q "SENDORDERS" I $$SNDKTC Q "ORDERS4KTCPRINT" Q "ORDLIST" ; PAYCASH(HZM) ; N IND,VL I $G(HZM)="" Q "0;ORDERERROR" I '$$^W4HZFULL(HZM) Q "0;ORDERERROR" I $$^W4CLOSE(HZM) Q "0;ORDERCLOSED" S VL=$$ITRA^W4HZMST(HZM) I 'VL G EPAYCASH S IND=$O(@$$^W4ORD@(HZM,"CB","MZ",999),-1)+1 S @$$^W4ORD@(HZM,"CB","MZ",IND)=$J(VL,2,2)_"*"_$H_"*"_$$LASTMLZ^W4HZMST(HZM)_"*"_$$^W4MYDVN D PAYCASH^W4PAYKB(HZM) D ^W4T(HZM,0) EPAYCASH Q "1;"_$$SHOWPAID(HZM) ; SHOWPAID(N) ; Q $$^%W1DICT("PAID")_" "_$J($$SHUL^W4HZMST(N)+$$SHULA^W4HZMST(N),2,2) ; READY(N) ; I $D(@$$^W4ORD@(N,"READY")) Q 1 Q 0 ; CALL2CL(N) ; I $D(@$$^W4ORD@(N,"CALL2CL")) Q 1 Q 0 ; SUPPLIED(N) ; I $D(@$$^W4ORD@(N,"SUPPLIED")) Q 1 Q 0 ; IFREADY(STAM) ; I '$$SGYOM,'$$SNDKTC,'$$REPTRH Q 1 Q 0 ; IFCALL2CL(STAM) ; I '$$SGYOM,'$$SNDKTC,'$$REPTRH,'$$DISPATH,$G(@$$^W4PRM@("CALL2CL")) Q 1 Q 0 ; IFSNDY(STAM) ; Q $$SNDY^W4PRM ; TIMEREADY(N) ; N TIME S TIME=$G(@$$^W4ORD@(N,"READY")) I 'TIME Q "" Q $$T^%L1TIME(TIME) ; TIMECALL(N) ; N TIME S TIME=$G(@$$^W4ORD@(N,"CALL2CL")) I 'TIME Q "" Q $$T^%L1TIME(TIME) ; TIMESUPPL(N) ; N TIME S TIME=$$SUPPLIED^W4HZMST(N) I 'TIME Q "" Q $$T^%L1TIME(TIME) ; SGYOM(STAM) ; Q $G(%ARG("SGYOM")) ; SPACE ; W "   " Q ; TDSP ; W " " Q ; PRINTDOC ; W "",! W "" W "" ; W "" W "
    " W "" W "
    ",! Q ; ; KINDORDS ; W "",! Q ; SELECTED(IND) ; I $G(%ARG("KNDO"))=""&(IND="ALL") Q " selected=""selected"" " I $G(%ARG("KNDO"))=IND Q " selected=""selected"" " Q "" ; SETARG ; I $G(%ARG("ASCENDING"))="" D .S %ARG("ASCENDING")=$S($$MY:0,1:'$G(@$$^W4PRM@("DLVN2O"))) ; I $G(%ARG("TIMESORT"))="" S %ARG("TIMESORT")=$S($$MY:2,1:$G(@$$^W4PRM@("TIMESORT"))+1) ; I $G(%ARG("NOSENDEDORDS"))="" S %ARG("NOSENDEDORDS")=1 I $G(%ARG("SENDEDORDS"))="" S %ARG("SENDEDORDS")=1 I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 I $G(%ARG("BIDS"))="" S %ARG("BIDS")=1 I $G(%ARG("FUTUREORDS"))="" D .S %ARG("FUTUREORDS")=$S($$HD="DAYORDERS"&'$$SF^W4PRM:0,1:1) I $$KNDO="TAW" S %ARG("SHOWTAW")=1 I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")='$G(@$$^W4PRM@("NOVWTAW")) I $$TOMORROW D .I $G(%ARG("DELETEDORDS"))="" D ..S %ARG("DELETEDORDS")=+$$SHOWDEL^W4PRM .I $G(%ARG("BIDS"))="" S %ARG("BIDS")=0 I $G(%ARG("DELETEDORDS"))="" D .S %ARG("DELETEDORDS")=$S($$SHOWDEL^W4PRM!$$DELONLY!($$KNDO="DEL"):1,$G(%ARG("MY"))&'$$DELIS^W4PRM:1,1:0) ; Q ; ; ONCHANGE(STAM) ; Q " onChange=""OnChangePrm()"" " ; BUTTON(ID,VL,PROC,STYLE) D ^W4BUTTON($G(ID),VL,$G(PROC),$G(STYLE)) Q ; REVAH(STAM) ; I $$1024^W4WDSCR Q "
    " Q "  " ; SHORTSHOW(STAM) ; Q $G(%ARG("SHORTSHOW")) ; TOMORROW(STAM) ; Q $G(%ARG("TOMORROW")) ; CUSTLASTORDS(STAM) ; Q $G(%ARG("CUSTLASTORDS")) ; PRINTALLORDS(MDB) ; N (JB,%ARG,%REM,MDB) S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#5) H 1 .S HZM=$$HZ(N) .I $$DEL^W4DEL(HZM) Q .I '$$ALL2MSL^W4PRM S A=$$PRINTBON^W4MENUBT(HZM_";;;"_MDB) Q .D HZMMSL^W4HZMIT Q ; PRINTALLKOTMDB ; N PRN S PRN=$G(@$$^W4PRM@("MDBKOT")) Q:'PRN N N,HZ S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#5) H 1 .S HZ=$$HZ(N) .D MDBKOT^W4MDBPC(HZ,PRN) Q ; CUSTALL(STAM) ; Q $G(%ARG("CSALL")) ; NIGHT(ORD) ; N DATCB S DATCB=$$DATCB^W4HZMST(ORD) N TIMECB S TIMECB=$P(DATCB," ",2),DATCB=$P(DATCB," ") N DTCB S DTCB=$$^%L1DC(DATCB,3) ;;I $$SF^W4PRM,TIMECB>16!(TIMECB<8) Q 1 ; N OK S OK=0 I $$MAAD^W4PRM D I OK Q OK .N DT S DT=$$^%L1DC($$TRH^W4HZMST(ORD),3) .I DT-DTCB>1 Q .I TIMECB*60+$P(TIMECB,":",2)>(19*60)&($$^%L1DC(DTCB,8)=5) S OK=1 Q .I $$^%L1DC(DTCB,8)>5 S OK=1 Q ; I $G(@$$^W4PRM@("ASH","MASOF"))=1702132,(TIMECB*60+$P(TIMECB,":",2))>1290&($$^%L1DC(DTCB,8)=5)!($$^%L1DC(DTCB,8)>5) Q 1 ; -- BAR LEHEM ; N DTT,DTT1 S DTT=$$^%L1DC($$TRH^W4HZMST(ORD),3) S DTT1=$$^%L1DC($$TRH^W4HZMST(ORD),8) I $$DELIS^W4PRM,$G(%ARG("MEDAT")),$G(%ARG("MEDAT"))=$G(%ARG("ADDAT")) D .N DT S DT=$$^%L1DC(%ARG("MEDAT"),3) .I DTT=DT,DTCB=(DT-1)&(DTT1'=1)!(DTCB=(DT-2)&(DTT1=1)),TIMECB>13 S OK=1 Q ; Q OK ; ; SHABAT(ORD) ; N DATCB S DATCB=$P($$DATCB^W4HZMST(ORD)," ") N DTCB S DTCB=$$^%L1DC(DATCB,8) I $$SF^W4PRM,DTCB=6!(DTCB=7) Q 1 Q 0 ; REPTRH(STAM) ; Q $G(%ARG("REPTRH")) ; CALLTO(STAM) ; Q $G(%ARG("CALLTO")) ; ; KOTREPTRH ; N HD W "" S HD="REPDEPTRHMEAD" I $G(%ARG("ITEMS")) S HD="REPITEMSTRHMEAD" W $$^%W1DICT(HD,$G(%ARG("MEDAT"))_"<>"_$G(%ARG("ADDAT"))) W "

    ",! ; N REPTRH S REPTRH=$$REPTRH W "",! W "" W "" ; W "" ; W "" ; W "" ; W "" W "",! W "
    " W "",! W " " W $$^%W1DICT("PRICEOFFERS")_" " W "" W " " W $$^%W1DICT("SHOWORDERS")_" " W "" W "
    ",! Q ; SELORD(REPTRH,OPT) ; I REPTRH=OPT W " selected=""selected"" " Q "" ; PIZUL(N) ; Q $$^W4PIZUL(N) ; CRLINKDR ; N A,N,DCB,DTR,SHAAR S N="" F S N=$O(@$$^W4ORD@(N)) Q:N="" I N'<1 D .S A=$G(^(N)),DCB=$P(A,"\",4) Q:'DCB .I $L($P(A,"\"))<4 Q .S DTR=$$^%L1DC($P(DCB," "),3) Q:DTR<50000 .S SHAAR=$P(DCB," ",2) .I SHAAR<6 S DTR=DTR-1 .S @$$^W4GL("W4LINKDR")@(DTR,N)=$$GETP^%W1PRM("MSD") Q ; SNDTAW(JB,HZ) ; N PRM S PRM=HZ_";Your Order is ready;"_EMAIL_";2;" ; S RES=$$EMAILCONT^W4EMAIL(PRM) Q ; SELKO(VL) ; I +$G(%ARG("BUSPRV"))=VL Q " selected=""selected"" " Q "" ; MKR(N) N MKR S MKR=$$MKRDLV^W4HZMST(N) I $$WOLT^W4HZPCHD(N) S MKR=18 Q MKR ; VIS(ORD) ; N TMP S TMP=$$^W4MAIN("TMP") N OK S OK=0 N N S N="" F S N=$O(@TMP@(N)) Q:N="" D Q:OK .I $$SPA^%L1FRM($E(N,10,18))=ORD S OK=1 Q OK ; CHNSURE(PRM) ; N ORD,VL S ORD=$P(PRM,";"),VL=$P(PRM,";",2) I 'ORD Q "NOORD" N VLOLD S VLOLD=$P($G(@$$^W4GL("W4SURE")@(ORD)),"\") S @$$^W4GL("W4SURE")@(ORD)=VL_"\"_$H_"\"_VLOLD Q 1 W4DLVP W4DLVP(MEDAT,ADDAT) ; DOCH HAZMANOT; [ 07.04.25 06:57 ] [ 06.04.25 17:13 ] [ 20.12.18 19:26 ] N (%ARG,JB,%REM,MEDAT,ADDAT,%REPN) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" S PRPSL=$$PRPSL D ^W4IN D VRM K @VRM N D1,D2 ; S D1=$$^%L1DC(MEDAT,3),D2=$$^%L1DC(ADDAT,3) ; N NN F NN=D1-100:1:D2 I $D(@$$^W4REF@(NN)) D .N N1 S N1="" F S N1=$O(@$$^W4REF@(NN,N1)) Q:N1="" D ..I $$HZM^W4MSD(N1) Q ..I $$^W4HZMH(N1) Q ..I 'PRPSL,$$I^W4PIZUL(N1) Q ..I PRPSL,$$^W4PIZUL(N1) Q ..I PRPSL,$$I^W4PIZUL(N1) Q ..I PRPSL,$$DEL^W4DEL(N1) Q ..S DT=$$^%L1DC($$TRH^W4HZMST(N1),3) ..S SHAA=$$SHAA^W4HZMST(N1) I $$^W4SHAAZ,SHAA<$$SHAAZ^W4PRM S DT=DT-1 ..I DTD2) Q ..S HZM=N1,SSUM=0 N MZ,PAR ..S NMB=$$NMB^W4HZMST(HZM) Q:'$$^W4MSL(NMB) ..S MKBL=$$MKBL^W4HZMST(HZM) ..S MKR=$$MKRDLV^W4HZMST(HZM) S:MKR="" MKR="-" ..I $G(PRPSL) S MKBL=$$PSL^W4HZMST(HZM) S:'MKBL MKBL=9999 ..Q:'MKBL ..D PLU1 ; K %L1PC S %REPN("MEDAT")=MEDAT,%REPN("ADDAT")=ADDAT S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB S %REPN="W4DLVP" I $G(PRPSL) S %REPN="W4PRPS" Q:'$D(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4dlvp.jsp?JB="_JB) Q ; PLU1 N I,PAR,PARO,RF S PARO="" F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D .S RF=$G(^(I)) .S PAR=$P(RF,"\") .I $L(PAR) D PLU2 D ..N N S N="" F S N=$O(@$$^W4ORD@(HZM,I,N)) Q:N="" D ...I $D(^(N))<10 D Q ....S RF=$G(^(N)),PAR=N D PLU3 ... ...N N1,PAR0 S N1="" F S N1=$O(@$$^W4ORD@(HZM,I,N,N1)) Q:N1="" D ....S RF=$G(^(N1)) D PLU4(RF) Q ; PLU2 ;--- SHURA RAGILA N A,COL,PRC,SUM,ST,SUG,N S COL=$P(RF,"\",5),PRC=$P(RF,"\",4),COLP=COL S SUM=PRC*COL I MKBL="" S MKBL=0 I PRPSL S MKBL=9999 I PAR'["%" S PARO=PAR S SUGP=+$$SUG^W4P(PAR) S A="" I $D(PARO) S A=$G(@VRM@(MKBL,SUGP,PARO)) S $P(A,"*",1)=$P(A,"*",1)+COLP I PAR'["%" S $P(A,"*",3)=$P(A,"*",3)+SUM I PAR["%" S SUM=$P(RF,"\",7),$P(A,"*",2)=$P(A,"*",2)-SUM ; -- HANAHA I $D(PARO) S @VRM@(MKR,MKBL,SUGP,PARO)=A Q ; ; PLU3 ;---- TOSAFOT LEVEL 2 N ST0,COL,PRC,SUM,A S ST0=$P(RF,"\",2,25) I '$P(ST0,"\",2),ST0["\+\" S COL=($L(ST0,"+\")-1)*COLP S SUM=$P(ST0,"\",6)*COLP G PLU31 S COL=$P(ST0,"\",2) S:'COL COL=COLP S SUM=$P(ST0,"\")*COL PLU31 N SUGP S SUGP=+$$SUG^W4P(PAR) S A=$G(@VRM@(MKBL,SUGP,PAR)) S $P(A,"*",1)=$P(A,"*",1)+COL S $P(A,"*",3)=$P(A,"*",3)+SUM S @VRM@(MKR,MKBL,SUGP,PAR)=A Q ; PLU4(ST0) ;----- ROSAFOT LEVEL 3 N A,COL,PRC,SUM,PAR,PAR0 S PAR0=$P(ST0,"\") S PAR=$S(PAR0:PAR0,1:$P(ST0,"\",4)) Q:PAR="" S COL=$P(ST0,"\",3) I PAR0 S COL0=COL I 'PAR0,'COL,$G(COL0) S COL=COL0 S SUM=$P(ST0,"\",7)*COL N SUGP S SUGP=+$$SUG^W4P(PAR) S A=$G(@VRM@(MKBL,SUGP,PAR)) S $P(A,"*",1)=$P(A,"*",1)+COL S $P(A,"*",3)=$P(A,"*",3)+SUM S @VRM@(MKR,MKBL,SUGP,PAR)=A Q ; PAR N A S A=$G(@GLOB) S x1=$P(A,"*",1),x2=$P(A,"*",2),x3=$P(A,"*",3)-x2 S PAR1=$$SHEM^W4P(PAR) Q ; VRM ; D ^%W1PCVRM Q ; PRPSL(STAM) ; Q $$GETP^%W1PRM("PRPSL") ; REPNAME(STAM) ; I $$PRPSL Q "ITEMSCOURIERREPORT" Q "ITEMSDELIVERYREPORTS" ; PSL1 ; S:'PSL PSL=0 S PSL1=$G(@$$^W4GL("P1SL")@(PSL)) I PSL=9999 S PSL1="dpznda" Q W4DLVPRP W4DLVPRP ; [ 01.08.23 16:40 ] [ 31.07.23 15:12 ] [ 01.03.22 11:52 ] N (JB,%ARG,%REM) D ^%W1ARG I '$G(%ARG("MEDAT")),'$G(%ARG("ADDAT")) Q ; S DT1=$$^%L1DC($G(%ARG("MEDAT")),3) S DT2=$$^%L1DC($G(%ARG("ADDAT")),3) ; ; S GL="^|"""_$$^W3MAIN_"""|W4DLVPRP" S MSDR=$G(%ARG("MSDR")) I MSDR="" W " MSDR NOT DEFINED !" Q S GLMSDR="^|$$^W3MAIN|W3MSDR("_MSDR_")" ; W "
    ",! W "",! W $$^%W1DICT("DLVPRPNETREPORT",$ZD(DT1,"DD.MM.YY")_"<>"_$ZD(DT2,"DD.MM.YY")) W "",! ; W "

    ",! ; W "",! W "" S COLSPAN=1 S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D .S COLSPAN=COLSPAN+1 .W "",! W "",! ; ; I $$RKZPR D G ET .K SHZ,STIM .F DT=DT1:1:DT2 D ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S A=$G(@GL@(MSDR,DT,MSD)) ...S SHZ(MSD)=$G(SHZ(MSD))+$P(A,"~",2) ...S STIM(MSD)=$G(STIM(MSD))+($P(A,"~")*$P(A,"~",2)) . .W "" .S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ..S TIMA=" " I $G(SHZ(MSD)) S TIMA=$J($G(STIM(MSD))/SHZ(MSD),2,2) ..W "" .W "" ; ; I '$$RKZPR D G ET .F DT=DT1:1:DT2 D ..K SHZ,STIM ..W "" .. W "" ..W "",! ..; ..S MSD="" F S MSD=$O(@GL@(MSDR,DT,MSD)) Q:MSD="" D ...S A=$G(@GL@(MSDR,DT,MSD)) ...S SHZ(MSD)=$P(A,"~",2) ...S STIM(MSD)=$P(A,"~",1) .. ; ..W "" ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S TIMA=" " I $G(STIM(MSD)) S TIMA=$J(STIM(MSD),2,2) ...W "" ..W "",! ; ; ET W "
    "_$$H2U^%L1FRM($$MSD^W3R(MSD))_"
    " ;;_""_$G(SHZ(MSD))_"
    " .. W TIMA ..W "
    " .. W $ZD(DT,"DD.MM.YY") .. W "
    " ;;_""_$G(SHZ(MSD))_"
    " ... W TIMA ...W "
    ",! W "
    ",! Q ; RKZPR(STAM) ; Q $G(%ARG("RKZPR")) ; RKZBR(STAM) ; Q $G(%ARG("RKZBR")) W4DLVTIM W4DLVTIM ; [ 01.03.22 11:52 ] [ 14.02.22 12:05 ] [ 10.02.22 08:26 ] N (JB,%ARG,%REM) D ^%W1ARG I '$G(%ARG("MEDAT")),'$G(%ARG("ADDAT")) Q ; S DT1=$$^%L1DC($G(%ARG("MEDAT")),3) S DT2=$$^%L1DC($G(%ARG("ADDAT")),3) ; ; S GL="^|"""_$$^W3MAIN_"""|W4DLVTIM" S MSDR=$G(%ARG("MSDR")) I MSDR="" W " MSDR NOT DEFINED !" Q S GLMSDR="^|$$^W3MAIN|W3MSDR("_MSDR_")" ; W "
    ",! W "",! W $$^%W1DICT("DLVTIMNETREPORT",$ZD(DT1,"DD.MM.YY")_"<>"_$ZD(DT2,"DD.MM.YY")) W "",! ; W "

    ",! ; W "",! W "" W "" S COLSPAN=1 S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D .S COLSPAN=COLSPAN+1 .W "",! W "",! ; ; I $$RKZBR,$$RKZPR D G ET .K SHZ,STIM .F DT=DT1:1:DT2 D ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S IR="" F S IR=$O(@GL@(MSDR,DT,MSD,IR)) Q:IR="" D ....S A=$G(^(IR)) ....S SHZ(MSD)=$G(SHZ(MSD))+$P(A,"~",2) ....S STIM(MSD)=$G(STIM(MSD))+($P(A,"~")*$P(A,"~",2)) . .W "" .W "" .S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ..S TIMA=" " I $G(SHZ(MSD)) S TIMA=$J($G(STIM(MSD))/SHZ(MSD),2,2) ..W "" .W "" ; ; I $$RKZBR,'$$RKZPR D G ET .F DT=DT1:1:DT2 D ..K SHZ,STIM ..W "" .. W "" ..W "",! ..; ..S MSD="" F S MSD=$O(@GL@(MSDR,DT,MSD)) Q:MSD="" D ...S IR="" F S IR=$O(@GL@(MSDR,DT,MSD,IR)) Q:IR="" D ....S A=$G(^(IR)) ....S SHZ(MSD)=$P(A,"~",2) ....S STIM(MSD)=$P(A,"~",1) .. ; ..W "" ..W "" ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S TIMA=" " I $G(STIM(MSD)) S TIMA=$J(STIM(MSD),2,2) ...W "" ..W "",! ; ; I '$$RKZBR,$$RKZPR D G ET .K SHZ,STIM .F DT=DT1:1:DT2 D ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S IR="" F S IR=$O(@GL@(MSDR,DT,MSD,IR)) Q:IR="" D ....S A=$G(^(IR)) ....S IR1=$$INVH^%L1FRM(IR) ....S SHZ(IR1,MSD)=$G(SHZ(IR1,MSD))+$P(A,"~",2) ....S STIM(IR1,MSD)=$G(STIM(IR1,MSD))+($P(A,"~")*$P(A,"~",2)) . .S IR1="" F S IR1=$O(SHZ(IR1)) Q:IR1="" D ..W "" ..S IR=$$INVH^%L1FRM(IR1) ..W "" ..S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ...S TIMA=" " I $G(SHZ(IR1,MSD)) S TIMA=$J($G(STIM(IR1,MSD))/SHZ(IR1,MSD),2,2) ...W "" ..W "",! ; I '$$RKZBR,'$$RKZPR D G ET .F DT=DT1:1:DT2 D ..K SHZ,STIM ..W "" .. W "" ..W "",! ..; ..S MSD="" F S MSD=$O(@GL@(MSDR,DT,MSD)) Q:MSD="" D ...S IR="" F S IR=$O(@GL@(MSDR,DT,MSD,IR)) Q:IR="" D ....S A=$G(^(IR)) ....S IR1=$$INVH^%L1FRM(IR) Q:IR1="" ....S SHZ(IR1,MSD)=$P(A,"~",2) ....S STIM(IR1,MSD)=$P(A,"~",1) .. ; ..S IR1="" F S IR1=$O(SHZ(IR1)) Q:IR1="" D ...W "" ...S IR=$$INVH^%L1FRM(IR1) ...W "" ...S MSD="" F S MSD=$O(@GLMSDR@(MSD)) Q:MSD="" D ....S TIMA=" " I $G(STIM(IR1,MSD)) S TIMA=$J(STIM(IR1,MSD),2,2) ....W "" ...W "",! ; ET W "
    "_$$^%W1DICT("CITY")_""_$$H2U^%L1FRM($$MSD^W3R(MSD))_"
     " ;;_""_$G(SHZ(MSD))_"
    " .. W TIMA ..W "
    " .. W $ZD(DT,"DD.MM.YY") .. W "
     " ;;_""_$G(SHZ(MSD))_"
    " ... W TIMA ...W "
    "_$$H2U^%L1FRM(IR)_"" ;;_""_$G(SHZ(IR1,MSD))_"
    " ... W TIMA ...W "
    " .. W $ZD(DT,"DD.MM.YY") .. W "
    "_$$H2U^%L1FRM(IR)_"" ;;_""_$G(SHZ(IR1,MSD))_"
    " .... W TIMA ....W "
    ",! W "
    ",! Q ; RKZPR(STAM) ; Q $G(%ARG("RKZPR")) ; RKZBR(STAM) ; Q $G(%ARG("RKZBR")) W4DLVWEB W4DLVWEB ; [ 25.09.18 11:42 ] [ 17.11.10 16:34 ] [ 14.11.10 10:29 ] INIT ; D ^%W1ARG I $L($G(COLOR)) D PUT^%W1PRM("COLOR",COLOR) I $$SFC^W3CSS D PUT^%W1PRM("BODYURL","w3sfreka.jpg") ; I '$L($G(COLOR)),'$$SFC^W3CSS D .D PUT^%W1PRM("COLOR","DRW") .D ^W4BGBODY ; D ^W4CSS D:+$G(MSD) PUT^%W1PRM("MSD",MSD) D:+$G(MSDR) PUT^%W1PRM("MSDR",MSDR) S:+$G(MSD)=0 MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("DLVCSR",2) K @$$^W4TMPORD Q W4DLY W4PTHDLY ; [ 10.03.16 15:05 ] [ I $$PTHDLY^W4PRM H 1 Q W4DLYPRN W4DLYPRN(HZM,JB) ; [ 26.05.24 10:30 ] [ 19.06.23 12:21 ] [ 24.05.23 13:04 ] N (JB,%ARG,HZM) S GLDLY=$$^W4GL("W4DLYPRN") S DT=$$^%L1DC($$TRH^W4HZMST(HZM),3) S SHAA=$$SHAA^W4HZMST(HZM) ; S DATCB=$$DATCB^W4HZMST(HZM) N TMCB S TMCB=$P(DATCB," ",2) S DTCB=$$^%L1DC($P(DATCB," "),3)_","_(TMCB*3600+($P(TMCB,":",2)*60)) S RZN0=$$DIF^%L1TIME(DT_","_(SHAA*3600+($P(SHAA,":",2)*60)),DTCB) S RZN=$$DIF^%L1TIME(DT_","_(SHAA*3600+($P(SHAA,":",2)*60)),$H) ; I RZN<-40 Q ; I $$GETP^%W1PRM("BGJ")=HZM D KILL^%W1PRM("BGJ") ; S IR=$$IR^W4HZMST(HZM) S AZR=$$AZOR^W4HZMST(HZM) ; S MN=SHAA*60+$P(SHAA,":",2) S DAKOT=$$DAKOT^W4HZPCHD(IR,AZR) ; S DLYPRN=$$DLYPRN^W4PRM S SM=+DLYPRN I $$TAKEAWAY^W4HZMST(HZM) D .S DAKOT=$$THZTAW^W3TIME .I $$WOLT^W4HZMST(HZM) S DAKOT=30 ; -- 26.05.24 ; S MN=MN-DAKOT ;;-5 I MN<0 D .S MN=MN+(24*60) .S DT=DT-1 ; S SEC=MN*60 S JB1=$P(JB,".") S IND=DT_$TR($J(SEC,5)," ",0)_$TR($J(HZM,10)," ",0)_$TR($J(JB1,10)," ",0) N LASTIND S LASTIND=$O(@GLDLY@(""),-1) I $E(IND,1,10)=$E(LASTIND,1,10) D .S IND=DT_$TR($J(SEC+3,5)," ",0)_$TR($J(HZM,10)," ",0)_$TR($J(JB1,10)," ",0) . S @$$^W4ORD@(HZM,"SVTIME1")=DT_","_+$E(IND,6,10) ; L +@GLDLY@(IND):1 S @GLDLY@(IND)=HZM_"\"_AZR_"\"_DAKOT L -@GLDLY@(IND) Q W4DMAM W4DMAM(DT1,DT2) ; [ 12.11.24 18:40 ] [ 28.01.21 13:18 ] [ 27.01.21 16:58 ] N (JB,%ARG,%REM,DT1,DT2,DOCH,SGIRATJOM,P1X) ; F DT=DT1:1:DT2 D .K SUMCMAM(DT),SUMNOMAM(DT) .S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" D ..S DTHZ=$G(^(HZ)) ..I $G(P1X("SHUL")),$$NMB^W4HZMST(HZ)'=P1X("SHUL") Q ..I $G(P1X("PART")),$$POS^W4HZMST(HZ)'=P1X("PART") Q ..I $D(SGIRATJOM),'$$Z24^W4PRM,DTHZ[",^" D Q ...K SUMCMAM(DT),SUMNOMAM(DT) ..I $D(SGIRATJOM),'$$Z24^W4PRM,$G(DOCH)'="Z",DTHZ[",?" D Q ...K SUMCMAM(DT),SUMNOMAM(DT) ..I $D(SGIRATJOM),$$Z24^W4PRM,DTHZ[",Z" D Q ...K SUMCMAM(DT),SUMNOMAM(DT) ..I $D(SGIRATJOM),$$Z24^W4PRM,$G(DOCH)'="Z",DTHZ[",Y" D Q ...K SUMCMAM(DT),SUMNOMAM(DT) .. ..;;I '$$^W4CLOSE(HZ) Q ..I '$$SHUL^W4HZMST(HZ),'$$SHULA^W4HZMST(HZ) Q .. ..D SMAM(DT,HZ) ..I '$$^W4LKH Q .. ..N PRMAM,AHMAM ..S NDOC="" F S NDOC=$O(@$$^W4GL("W4DIRD")@(DT,NDOC)) Q:NDOC="" D ...S PRMAM=$$PRMAM^W4DOC(NDOC) ...S AHMAM=$$AHMAM^W4DOC(NDOC) ...N NP,CD,MAMCD,SUM ...S NP="" F S NP=$O(@$$^W4GL("W4DOC")@(NDOC,NP)) Q:NP="" I NP D ....S CD=$$CODE^W4DOC(NDOC,NP) ....S MAMCD=$$MAM(CD) ....S SUM=$J($$QN^W4DOC(NDOC,NP)*$$PRC^W4DOC(NDOC,NP)*(100-$$DISC^W4DOC(NDOC,NP))*.01,2,2) ....I 'PRMAM,MAMCD D .....S SUM=$J(SUM*(100+AHMAM)*.01,2,2) ....I MAMCD D .....S SUMCMAM(DT)=$G(SUMCMAM(DT))+SUM ....I 'MAMCD D .....S SUMNOMAM(DT)=$G(SUMNOMAM(DT))+SUM ; S (SMAM,SUMCMAM,SUMNOMAM)=0 ; F DT=DT1:1:DT2 D .S AHMAM=$$MAMD^W4L(DT) .S SMAM=SMAM+($G(SUMCMAM(DT))*AHMAM/(100+AHMAM)) .S SUMCMAM=SUMCMAM+$G(SUMCMAM(DT)) .S SUMNOMAM=SUMNOMAM+$G(SUMNOMAM(DT)) ; Q $J(SMAM,2,2)_"\"_SUMCMAM_"\"_SUMNOMAM ; MAM(PAR) ; I '$$SUPER^W3PRM,$$NOMAM^W4PRM Q '$$NOMAM^W4P(PAR) Q $$MLMAM^W4MLPRT(PAR) ; ; SMAM(DT,HZ) ; N KF,KF1,KMAM,TSHL,SHUL,SHULA,NP,PAR,SUM,SUMHZ,MAM S KF=1 S TSHL=$$TSHL^W4HZMST(HZ) Q:'TSHL N TOT S TOT=$$TOT^W4HZMST(HZ) S SHUL=$$SHUL^W4HZMST(HZ) S SHULA=$$SHULA^W4HZMST(HZ) ;;I TOT S KF=TSHL/TOT ; *** 28/01 S KF=(SHUL+SHULA)/TSHL ; *** 28/01 S KF1=1 I SHUL+SHULA S KF1=SHUL/(SHUL+SHULA) S SUMHZ=0 ; N K S K=0 S NP="" F S NP=$O(@$$^W4ORD@(HZ,NP)) Q:NP="" I NP D .S PAR=$$PAR^W4HZMST(HZ,NP) Q:PAR="" Q:'$$ISNUM^%L1FRM(PAR) .S SUM=$$SUM^W4HZMST(HZ,NP)+$$SUMHNHP^W4HZMST(HZ,NP) .; .S MAM=$$MAM(PAR) .;;S SUM=$J(SUM*KF*KF1,3,3) .S SUMHZ=SUMHZ+SUM .I MAM D ..S SUMCMAM(DT,HZ)=$G(SUMCMAM(DT,HZ))+SUM .I 'MAM D ..S SUMNOMAM(DT,HZ)=$G(SUMNOMAM(DT,HZ))+SUM .S K=K+1,^AA("W4DMAM",HZ,K)="HZ="_HZ_" PAR="_PAR_" SUM="_SUM_" MAM="_MAM_" CMAM="_$G(SUMCMAM(DT))_" NOMAM="_$G(SUMNOMAM(DT)) ; S KMAM=1 I $G(SUMCMAM(DT,HZ))+$G(SUMNOMAM(DT,HZ)),'$D(@$$^W4ORD@(HZ,"KMAM")) D .S KMAM=$G(SUMCMAM(DT,HZ))/($G(SUMCMAM(DT,HZ))+$G(SUMNOMAM(DT,HZ))) .S @$$^W4ORD@(HZ,"KMAM")=$J(KMAM,5,5) ; N KF2 S KF2=SHUL/TSHL S SUMCMAM(DT,HZ)=$G(SUMCMAM(DT,HZ))*KF2 S SUMNOMAM(DT,HZ)=$G(SUMNOMAM(DT,HZ))*KF2 S SUMCMAM(DT)=$G(SUMCMAM(DT))+SUMCMAM(DT,HZ) S SUMNOMAM(DT)=$G(SUMNOMAM(DT))+SUMNOMAM(DT,HZ) Q W4DMANA W4DMANA(SH,TMPORD) ; [ 01.07.24 15:13 ] [ 30.06.24 12:43 ] [ 02.02.16 19:26 ] N A,A0,I,J,N,CD,CD0,MANA,NSET I $G(TMPORD)="" S TMPORD=$$^W4TMPORD ; F I=SH:-1:1 Q:$$LVST^W3HZMST(JB,I)=0 S A0=$G(@TMPORD@(I)) ; I $$^W4AIN S A0=$$GET^%W1PRM("STPAR0") ; I $$LV(A0)'=0 Q "" ; S CD0=$$CD(A0) I 'CD0 Q "" ; S CD="" ;;F I=SH:-1:1 Q:$$LVST^W3HZMST(JB,I)=0 S A=$G(^(I)),CD=$$CD(A) Q:$$CDA(CD) F I=SH:-1:1 S A=$G(@TMPORD@(I)) Q:$$LVST^W3HZMST(JB,I)=0&'$$^W4AIN S CD=$$CD(A) Q:$$CDA(CD) ; I '$$CDA(CD) Q "" ; S NSET=$E(CD,2,10) D PUT^%W3DEB("W4HZTSF-SETMANA","CD0=CD0&NSET=NSET") S N="" S MANA=+$G(@$$^W4GL("P1EZA")@(CD0,"A"_NSET)) ; I 'MANA D .S MANA=$G(@$$^W4GL("P1EZT")@(CD0,"A"_NSET)) ;;I 'MANA S MANA=0 Q .I MANA S MANA="" Q ; -- 01.07.24 .I $$NOROMA^W4PRM,MANA'["T" S MANA=MANA_"T" ; Q MANA ; CD(A) Q $P(A,"~",2) LV(A) Q $P(A,"~",1) CDA(CD) ; I $E(CD)="A" Q 1 Q 0 W4DMANY W4DMANY ; [ 02.12.24 11:05 ] [ 28.11.24 17:14 ] [ 30.06.23 05:41 ] K (JB,%ARG,%REM) D ^W4IN Q:$G(%ARG("SHOW"))=0 N TMPSCRARG S TMPSCRARG="^[$$^W3MAIN]TMPSCR(JB,""ARG"")" K @TMPSCRARG D ^%W1ARG ; S DT2=$$^%L1DC($G(%ARG("ADDAT")),3) S TIPPD=$S($$^W4TIPPD(DT2):1,$$TIPNO^W4TIPPD(DT2):-1,1:0) I $$^W4TIPCBU(DT2) S TIPPD=1 S %SCRN=$S($$SUPER^W3PRM!$$NOMAM^W4PRM:"W4TOTS",$$MATB^W4PRM:"W4TOTMT",TIPPD=1:"W4TOT",TIPPD=-1:"W4TOTNO",1:"W4TOTT") ; S W4LKH=$$^W4LKH I W4LKH S %SCRN="W4TOTLKH" ; P1 ; S DAT1=%ARG("MEDAT"),DAT2=%ARG("ADDAT") S DAT01=$$^%L1DC(DAT1,3),DAT02=$$^%L1DC(DAT2,3) D .N DAT S DAT=$$^%L1DC(DAT2,2) .S TIPPS=$$TIPPS^W4TOT("") ; K CAOUT D ^W4SUMZRO D 100^W4TOT ; F DATT=DAT01:1:DAT02 D DOT S DAT=$$^%L1DC(DATT,2) D .S GLBL=$$GLTOT^W4LKHSUM($G(DOCH),DAT) D 1011^W4TOT ; S CASHD=$$^W4SUMV(DAT01,DAT02) ; D G2V^W4SUMZRO K @$$^W4MAIN("VRMSUM") ; D 102^W4TOT S PDN=$J(SHUM+HB-HBZ,2,2) S HMK=$$^W4QHMK(DAT01,DAT02) ; S %ARG("PADDING")="0" K %L1SCPC ; S AV="",AVR="",AVD="",AVT="" I SSOAD,'$$SDMSL S AV=$J(SUMMSD+SUMAMSD/SSOAD,2,2) I SSOAD,$$SDMSL S AV=$J(SMHIRA/SSOAD,2,2) ;;S %L1SCPC(67)=AV ; -- 14/2/22 --> COMMENT ; S AHMAM=$$MAMD^W4L(DT2) S %L1SCPC(17)=$J(SMHIRA*100/(100+AHMAM),2,2) S %L1SCPC(81)=$J($G(CAOUT),2,2) S %L1SCPC(85)=$J($G(CAOUT)+CASHD,2,2) ; I $G(@$$^W4PRM@("BITA")) S %L1SCPC(48)="miitqk" I $$MSL^W4PRM D .S %L1SCPC(71)="dcrqna" .S %L1SCPC(73)="migelyna" .S %L1SCPC(62)=$J(BITR,2,2) .S %L1SCPC(63)=$J(BITD+$G(BITT),2,2) ; I $$MSL^W4PRM,$$SDMSL,$$MSLSD^W4PRM D .S %L1SCPC(74)="dcrqna",%L1SCPC(77)=%L1SCPC(74) .S %L1SCPC(76)="migelyna",%L1SCPC(79)=%L1SCPC(76) .S %L1SCPC(64)=SOADR .S %L1SCPC(66)=SOADD+$G(SOADT) .S AVR="",AVD="",AVT="" .I SOADR S AVR=$J(SUMMSD+SUMAMSD+SUMTAW+SUMATAW/SOADR,2,2) .I SOADD!SOADT S AVD=$J(SUMMSL+SUMAMSL+SUMDLP+SUMADLP/(SOADD+$G(SOADT)),2,2) .S %L1SCPC(68)=AVR .S %L1SCPC(69)=AVD ; I $$MSL^W4PRM,$$SDMSL,'$$MSLSD^W4PRM D .S AVR="",AVD="",AVT="" .S %L1SCPC(77)="dcrqnl rvenn" .S %L1SCPC(79)="gelynl rvenn" .I SOADR S AVR=$J(SUMMSD+SUMAMSD+SUMTAW+SUMATAW/SOADR,2,2) .I SMSH S AVD=$J(SUMMSL+SUMAMSL+SUMDLP+SUMADLP/SMSH,2,2) .S %L1SCPC(68)=AVR .S %L1SCPC(69)=AVD ; D PC Q ; ; PC ; K @$$^W4MAIN("TMPREP") PC1 D PCPRM(%SCRN) ; PC2 K @$$^W4MAIN("TMPREP")@("GTR") ; I $D(@$$^W4REPSCR@(%SCRN,"GTR"))#2 D .S @$$^W4MAIN("TMPREP")@("GTR")=@$$^W4REPSCR@(%SCRN,"GTR") ; K @$$^W4MAIN("TMPREP")@("GTD") ; I $D(@$$^W4REPSCR@(%SCRN,"GTD"))>9 D .M @$$^W4MAIN("TMPREP")@("GTD")=@$$^W4REPSCR@(%SCRN,"GTD") ; ; I $D(S4B) D ^%W1FREPB(%SCRN) G KILL ; I $G(DOCH)="Z" D .D KOTZ(MEDAT,NZ) .M @$$^W4GL("Z")@(P1DZ,NZ)=@$$^W4MAIN("TMPREP") .N BIG S BIG="B" I $$^W4LKH S BIG="BL" .S @$$^W4GL("Z")@(P1DZ,NZ)=BIG ; I $G(DOCH)'="Z",%SCRN["W4TOT" D .S @$$^W4MAIN("TMPREP")@("KOT")=$$KOTTOT(MEDAT,ADDAT) ; D ^%W1FREP(%SCRN) ; KILL ; Q ; ; DOT ; W "
    ",! Q ; KOTZ(DAT,NZ) ; N DZ S DZ=$$^%L1DC(DAT,3) N TIME S TIME=$G(@$$^W4GL("Z")@(DZ,NZ,"TIME")) W "",! W " ",! W " " W " ",! I TIME D .W " ",! W "
    - Z -
    "_$$H2U^%L1FRM(DAT_" jix`zl mei zxibq g""ec")_"
    "_$$H2U^%L1FRM(NZ_" ixeciq xtqn")_"
    "_$$H2U^%L1FRM(TIME_" ixewn g""ec zwtd onf")_"
    ",! Q ; KOTTOT(MEDAT,ADDAT) ; N A,FS S FS="style=""font-size:"_$$^W3FSZ(11)_""" " S A="" S A=A_"" S A=A_"" ; I $G(DOCH)="" D .S A=A_" " ; I $G(DOCH)="X" D .S A=A_"" ; I $TR(MEDAT,",.","")'=$TR(ADDAT,",.","") D .S A=A_" " .S A=A_"" ; I $TR(MEDAT,",.","")=$TR(ADDAT,",.","") D .S A=A_" " ; I $G(DOCH)="X" D .S A=A_"" ; S A=A_"
    " S A=A_$$^%W1DICT("ISSUETIME",$ZD($H,"DD.MM.YY 24:60"))_"
    " .S A=A_$$H2U^%L1FRM("melyz irvn` itl itqk g""ec")_"
    - X -
    "_$$H2U^%L1FRM(MEDAT_" jix`zn ")_""_$$H2U^%L1FRM(ADDAT_" jix`z cr")_"
    "_$$H2U^%L1FRM(MEDAT_" jix`zl ")_"
     
    " I $G(%ARG("SHOW")) S A=A_"
    " Q A ; ; PCPRM(%SCRN) ; N %NM,%NOM K @$$^W4GL("TMPREPB") D KILL^%W1PRM("CURSORT") ; N TMPSCRARG S TMPSCRARG="^[$$^W3MAIN]TMPSCR(JB,""ARG"")" I $D(@TMPSCRARG)>9 D .N %N S %N="" F S %N=$O(@TMPSCRARG@(%N)) Q:%N="" D ..I %N'?1U.E Q ..S @%N=$G(@TMPSCRARG@(%N)) ; S %NM="" F S %NM=$O(@$$^W4SCR@(%SCRN,"P","NAME",%NM)) Q:%NM="" D .S %NOM=$G(^(%NM)) .N %VL,%PRM,%TYP .S %VL=$G(@%NM) .S %PRM=$G(@$$^W4SCR@(%SCRN,"P",%NOM,"CRD")) .S %TYP=$P(%PRM,",",3) .I %TYP="N" S %VL=$J(%VL,$P(%PRM,",",5),$P(%PRM,",",5)) .S @$$^W4MAIN("TMPREP")@("P",%NOM)=%VL .S @$$^W4MAIN("TMPREP")@("P",%NOM,"TYP")=%TYP ; I $D(%L1SCPC) D .N %N S %N="" F S %N=$O(%L1SCPC(%N)) Q:%N="" D ..S @$$^W4MAIN("TMPREP")@("P",%N)=$G(%L1SCPC(%N)) ; Q ; INIT ; D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) D PUT^%W1PRM("CSRPRINT","W4DMANYC") Q ; SDMSL(STAM) ; Q $$SDMSL^W4PRM W4DMANY0 W4DMANY ; [ 15.01.13 02:58 ] [ 13.01.13 16:12 ] [ 30.04.12 19:02 ] K (JB,%ARG,%REM) D ^W4IN Q:$G(%ARG("SHOW"))=0 D ^%W1ARG S %SCRN=$S($G(@$$^W4PL@("MATB")):"W4TOTMT",1:"W4TOT") ; S W4LKH=$$^W4LKH I W4LKH S %SCRN="W4TOTLKH" ; P1 ; S TIPPS=$$TIPPS^W4TOT("") S DAT1=%ARG("MEDAT"),DAT2=%ARG("ADDAT") S DAT01=$$^%L1DC(DAT1,3),DAT02=$$^%L1DC(DAT2,3) D 100^W4TOT K SUMMTB S (SUMMSD,SUMMSL,SUMDLP,SUMAMSD,SUMAMSL,SUMADLP,SSOAD,SMSH,TIP1,HAVT,CASHD,SMP,SUMTAW,SUMATAW,STAW)=0 ; F DATT=DAT01:1:DAT02 D DOT S DAT=$$^%L1DC(DATT,2) D .D ^W4SUM ; F DATT=DAT01:1:DAT02 D DOT S DAT=$$^%L1DC(DATT,2) D .S GLBL=$$GLTOT^W4LKHSUM($G(DOCH),DAT) D 1011^W4TOT ; S CASHD=$$^W4SUMV(DAT01,DAT02) ; D 102^W4TOT S PDN=$J(SHUM+HB-HBZ,2,2) ; D PC Q ; ; PC ; K @$$^W4MAIN("TMPREP") PC1 N %NM,%NOM S %NM="" F S %NM=$O(@$$^W4SCR@(%SCRN,"P","NAME",%NM)) Q:%NM="" D .S %NOM=$G(^(%NM)) .N %VL,%PRM,%TYP .S %VL=$G(@%NM) .S %PRM=$G(@$$^W4SCR@(%SCRN,"P",%NOM,"CRD")) .S %TYP=$P(%PRM,",",3) .I %TYP="N" S %VL=$J(%VL,$P(%PRM,",",4),$P(%PRM,",",5)) .S @$$^W4MAIN("TMPREP")@("P",%NOM)=%VL .S @$$^W4MAIN("TMPREP")@("P",%NOM,"TYP")=%TYP ; I $D(%L1SCPC) D .N %N S %N="" F S %N=$O(%L1SCPC(%N)) Q:%N="" D ..S @$$^W4MAIN("TMPREP")@("P",%N)=$G(%L1SCPC(%N)) ; PC2 K @$$^W4MAIN("TMPREP")@("GTR") ; I $D(@$$^W4REPSCR@(%SCRN,"GTR"))#2 D .S @$$^W4MAIN("TMPREP")@("GTR")=@$$^W4REPSCR@(%SCRN,"GTR") ; K @$$^W4MAIN("TMPREP")@("GTD") ; I $D(@$$^W4REPSCR@(%SCRN,"GTD"))>9 D .M @$$^W4MAIN("TMPREP")@("GTD")=@$$^W4REPSCR@(%SCRN,"GTD") ; ;;W ""_$$H2U^%L1FRM($$^W3MSDG($$GET^%W1PRM("MSD")))_"
    ",! ;;W "
    ",! ; ; I $D(S4B) D ^%W1FREPB(%SCRN) G KILL ; I $G(DOCH)="Z" D .D KOTZ(MEDAT,NZ) .M @$$^W4GL("Z")@(P1DZ,NZ)=@$$^W4MAIN("TMPREP") .N BIG S BIG="B" I $$^W4LKH S BIG="BL" .S @$$^W4GL("Z")@(P1DZ,NZ)=BIG ; I $G(DOCH)'="Z",%SCRN["W4TOT" D KOTTOT(MEDAT,ADDAT) ; D ^%W1FREP(%SCRN) ; KILL ;;K @$$^W4MAIN("TMPREP") Q ; DOT ; W "
    ",! Q ; KOTZ(DAT,NZ) ; W "",! W " ",! W " " W " ",! W "
    - Z -
    "_$$H2U^%L1FRM(DAT_" jix`zl mei zxibq g""ec")_"
    "_$$H2U^%L1FRM(NZ_" ixeciq xtqn")_"
    ",! Q ; KOTTOT(MEDAT,ADDAT) ; W "",! W " ",! W "
    "_$$H2U^%L1FRM(MEDAT_" jix`zn ")_""_$$H2U^%L1FRM(ADDAT_" jix`z cr")_"
    ",! Q W4DMANYC W4DMANYC ; [ 11.11.24 19:36 ] [ 01.08.21 14:20 ] [ 09.06.21 10:53 ] N (JB,%ARG,DISP,P1X) S P1TOT=$$GETP^%W1PRM("P1TOT") D KILL^%W1PRM("P1TOT") Q:P1TOT="" ; BG ; S DAT1=$P(P1TOT,"-") S DAT2=$P(P1TOT,"-",2) Q:'DAT1 S:'DAT2 DAT2=DAT1 S (DT,DT1)=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; D .N DAT S DAT=$$^%L1DC(DAT2,2) .S TIPPS=$$TIPPS^W4TOT("") ; ;;K @$$^W4MAIN("VRMSUM") D ^W4SUMZRO D 100^W4TOT ; F DATT=DT1:1:DT2 S DAT=$$^%L1DC(DATT,2) D .S GLBL=$$GLTOT^W4LKHSUM("",DAT) D 1011^W4TOT ; S CASHD=$$^W4SUMV(DT1,DT2) ; D G2V^W4SUMZRO ; K @$$^W4MAIN("VRMSUM") ; ;;S ^AA("SUMDLP")=$G(SUMDLP) ; D 102^W4TOT S PDN=$J(SHUM+HB-HBZ,2,2) S HMK=$$^W4QHMK(DT1,DT2) I '$D(DISP) S DISP=0 ; I '$G(DISP) D HD^W4CB ; -- 11/11/24 ; D ^W4PCPRM ; D ^W4PCTOT ; I $G(@$$^W4PRM@("DOCHL")) D .D ^W4IN,^W4MDPPC,^%L1TS .I '$G(DISP) D ^W4MDPPC Q:'PRINT .K @$$^W4MAIN("TEMP")@("L") .;;S ^AA("W4DMANYC","DOCHL","DISP")=$G(DISP) .S SM=1 .S TXT="" D S1 S TXT="" D S1 .S TXT=$J(P1TOT_" - l zegewl g""ec",32) .S TXTL=$L(TXT) .S TXT=$J("",3)_TXT D S1 .S TXT=$J("",3)_$TR($J("",TXTL)," ","-") D S1 .D ASR^W4LKHZ .I '$G(DISP) D ^W4CUT(PRINT,$G(%MDP("CUT"))) Q ; ; TV(P1TOT,DISP) ; N (JB,%ARG,%REM,P1TOT,DISP) G BG ; S1 ; D ^W4PCST(TXT,$G(DISP,1)) Q W4DMANYL W4DMANYL ; [ 18.01.17 18:04 ] [ 08.10.16 07:20 ] [ 08.09.16 11:04 ] K (JB,%ARG,%REM,DOCH) D ^W4IN Q:$G(%ARG("SHOW"))=0 D ^%W1ARG S %SCRN=$S($G(@$$^W4PL@("MATB")):"W4TOTMT",1:"W4TOT") ; S W4LKH=$$^W4LKH I W4LKH S %SCRN="W4TOTLKH" ; P1 ; S TIPPS=$$TIPPS^W4TOT("") S DAT1=%ARG("MEDAT"),DAT2=%ARG("ADDAT") S DAT01=$$^%L1DC(DAT1,3),DAT02=$$^%L1DC(DAT2,3) D ^W4SUMZRO D 100^W4TOT K SUMMTB S (SUMMSD,SUMMSL,SUMDLP,SUMAMSD,SUMAMSL,SUMADLP,SSOAD,SMSH,TIP1,HAVT,CASHD,SMP,SUMTAW,SUMATAW,STAW)=0 ; F DATT=DAT01:1:DAT02 D DOT S DAT=$$^%L1DC(DATT,2) D .D ^W4SUM ; F DATT=DAT01:1:DAT02 D DOT S DAT=$$^%L1DC(DATT,2) D .S GLBL=$$GLTOT^W4LKHSUM($G(DOCH),DAT) D 1011^W4TOT ; S CASHD=$$^W4SUMV(DAT01,DAT02) ; D 102^W4TOT S PDN=$J(SHUM+HB-HBZ,2,2) ; I $G(%ARG("SGIRATJOM")),DAT01=DAT02 D .N NZ S NZ=$G(%ARG("NZ")) Q:'NZ .I '$G(@$$^W4GL("Z")@(DAT01,NZ,"TIME")) S ^("TIME")=$ZD($H,"DD.MM.YY 24:60") ; D PC Q ; ; PC ; K @$$^W4MAIN("TMPREP") PC1 N %NM,%NOM S %NM="" F S %NM=$O(@$$^W4SCR@(%SCRN,"P","NAME",%NM)) Q:%NM="" D .S %NOM=$G(^(%NM)) .N %VL,%PRM,%TYP .S %VL=$G(@%NM) .S %PRM=$G(@$$^W4SCR@(%SCRN,"P",%NOM,"CRD")) .S %TYP=$P(%PRM,",",3) .I %TYP="N" S %VL=$J(%VL,$P(%PRM,",",4),$P(%PRM,",",5)) .S @$$^W4MAIN("TMPREP")@("P",%NOM)=%VL .S @$$^W4MAIN("TMPREP")@("P",%NOM,"TYP")=%TYP ; I $D(%L1SCPC) D .N %N S %N="" F S %N=$O(%L1SCPC(%N)) Q:%N="" D ..S @$$^W4MAIN("TMPREP")@("P",%N)=$G(%L1SCPC(%N)) ; PC2 K @$$^W4MAIN("TMPREP")@("GTR") ; I $D(@$$^W4REPSCR@(%SCRN,"GTR"))#2 D .S @$$^W4MAIN("TMPREP")@("GTR")=@$$^W4REPSCR@(%SCRN,"GTR") ; K @$$^W4MAIN("TMPREP")@("GTD") ; I $D(@$$^W4REPSCR@(%SCRN,"GTD"))>9 D .M @$$^W4MAIN("TMPREP")@("GTD")=@$$^W4REPSCR@(%SCRN,"GTD") ; ;;W ""_$$H2U^%L1FRM($$^W3MSDG($$GET^%W1PRM("MSD")))_"
    ",! ;;W "
    ",! ; ; I $D(S4B) D ^%W1FREPB(%SCRN) G KILL ; I $G(DOCH)="Z" D .D KOTZ(MEDAT,NZ) .M @$$^W4GL("Z")@(P1DZ,NZ)=@$$^W4MAIN("TMPREP") .N BIG S BIG="B" I $$^W4LKH S BIG="BL" .S @$$^W4GL("Z")@(P1DZ,NZ)=BIG ; I $G(DOCH)'="Z",%SCRN["W4TOT" W $$KOTTOT(MEDAT,ADDAT) ; D ^%W1FREP(%SCRN) ; KILL ;;K @$$^W4MAIN("TMPREP") Q ; DOT ; W "
    ",! Q ; KOTZ(DAT,NZ) ; D KOTZ^W4DMANY(DAT,NZ) Q ; KOTTOT(MEDAT,ADDAT) ; Q $$KOTTOT^W4DMANY(MEDAT,ADDAT) W4DMLZ W4DMLZ ; DOCH MELZARIM [ 24.04.24 13:21 ] [ 22.02.24 13:43 ] [ 06.04.22 14:38 ] N (JB,%ARG,%REM,P1B) D ^W4IN Q:$G(%ARG("SHOW"))=0 I $G(%ARG("SORT")) G S D B S D SHOW Q ; ; B D VRM,TEMP K @VRM,@TEMP ; INPUT : DAT1,DAT2,MESHAA,ADSHAA ; SGR=1 - LEFI PRITIM, 2 -KASPI TV ; D ^%W1ARG S (MESUGS1,ADSUGS1)="" I '$G(MESUGS),'$G(ADSUGS) S MESUGS="",ADSUGS="" I '$TR($G(MESHAA),":",""),'$TR($G(ADSHAA),":","") S MESHAA="",ADSHAA="" S D1=$$^%L1DC(DAT1,3) S D2=$$^%L1DC(DAT2,3) K @VRM N HZM1 S HZM1="",HZM0="" ; HZM0 - FIRST ORDER AFTER Z . ; I $D(P1TIPMZ) S SGR=2 N VRM D VRM N TEMP D TEMP ; S D=D1-1 F S D=$O(@$$^W4REF@(D)) Q:D="" Q:D>D2 D .S HZM="" F S HZM=$O(@$$^W4REF@(D,HZM)) Q:HZM="" I HZM?1N.N D .. ..I $D(P1TIPMZ),@$$^W4REF@(D,HZM)["^",D1=D2 D Q ...K @VRM S HZM0=HZM+1 .. ..I $$^W4CLOSE(HZM) S HZM1=HZM .. ..Q:'($D(@$$^W4ORD@(HZM))#2) ..Q:$$MSL^W4HZMST(HZM) ..I $G(%ARG("SUGHZ"))=1,$$^W4CLOSE(HZM) Q ..I $G(%ARG("SUGHZ"))=2,'$$^W4CLOSE(HZM) Q .. ..D GA^%L1SCREF(HZSCR,$$^W4ORD_"(HZM)") S:MKBL="" MKBL="???" ..; ..I $G(MESUGS)!$G(ADSUGS),$G(NMB) S SUGS=$$SUGL^W4L(NMB) I SUGSADSUGS) Q ..; ..N OKS S OKS=0 ..I MESHAA'="00:00"!(ADSHAA'="24:00") D Q:'OKS ...S MESHAA=MESHAA+$J($P(MESHAA,":",2)/60,2,2) ...S ADSHAA=ADSHAA+$J($P(ADSHAA,":",2)/60,2,2) ...I MESHAA>ADSHAA S ADSHAA=ADSHAA+24 ...I MESHAA<$$ENDZ^W4SHAA,ADSHAA'>$$ENDZ^W4SHAA S MESHAA=MESHAA+24,ADSHAA=ADSHAA+24 ...I ADSHAA<$$ENDZ^W4SHAA S ADSHAA=ADSHAA+24 ...N SHAA1 S SHAA1=$$^W4SHAA(HZM) ...; ...I SHAA10:1,TSHL<0:-1,1:0) .. ..I $G(SGR)'=1 S @VRM@(MLZP,"HZMN",HZM)="" ..I $G(SGR)=1 D ; LEFI PRITIM ...N N S N="" F S N=$O(@$$^W4GL("P1MLZ")@(HZM,N)) Q:N="" D ....S @VRM@(N,"HZMN",HZM)="" .. .. ..D ;------------------------------ > PDN,BTL ... ...I $G(SGR)'=1 S ^("PDN")=$G(@VRM@(MLZP,"PDN"))+TSHL ... ...I $G(SGR)=1 D ;-- PRITIM -- HISHUV PIDYON ....;;Q:'$$^W4CLOSE(HZM) ....S ^("PDN")=$G(@VRM@(MLZP,"PDN"))+DMSH ....S ^("PDN")=$G(@VRM@(MLZP,"PDN"))-HNH ....N N,N1,TS ....S N="" F S N=$O(@$$^W4GL("P1MLZ")@(HZM,N)) Q:N="" D ; N - MELZAR .....S N1="",TS=0,HNHP=0 .....F S N1=$O(@$$^W4GL("P1MLZ")@(HZM,N,N1)) Q:N1="" D ; N1 -- PARIT ......S TS=TS+$P(^(N1),"*",2),HNHP=HNHP+$P(^(N1),"*",4) .....S ^("PDN")=$G(@VRM@(N,"PDN"))+TS-HNHP ... ...S BTL=0 ...I '$G(@$$^W4PRM@("MLZ")) D Q ;------ HISHUV BITULIM IF WAITER PROTECTION ....N I F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D .....Q:$$AVAR^W4HZMST(HZM,I) ; -- LO LEHASHEV BITULEY HAAVARA .....N SUMST S SUMST=$$SUM^W4HZMST(HZM,I) .....N PARST S PARST=$$PAR^W4HZMST(HZM,I) .....I SUMST<0 S BTL=BTL+(-SUMST) ....S ^("BTL")=$G(@VRM@(MLZP,"BTL"))+BTL ... ...;---------- HISHUV BITULIM - NO WAITER PROTECTION ...N N S N="" F S N=$O(@$$^W4ORD@(HZM,"BIT",N)) Q:N="" D ; ....S BTL=0 ....N MZ S MZ=$P(^(N),"*",2) ; -- MELZAR ....I $$SUM^W4HZMST(HZM,N)<0,$$PAR^W4HZMST(HZM,N)'["%" D .....Q:$$AVAR^W4HZMST(HZM,N) .....S BTL=-$$SUM^W4HZMST(HZM,N) .....I $$PAR^W4HZMST(HZM,N+1)["%" S BTL=BTL+(-$$SUM^W4HZMST(HZM,N+1)) ....I 'MZ,$G(MKBL) S MZ=MKBL ....I $D(P1HY) S MZ=$$MLZY(HZM) ....I $G(@$$^W4PRM@("BITA")),$$TSHL^W4HZMST(HZM)'<0,'$D(P1B) Q ; BITA - LEHAZIG RAK BITULEY HAZMANOT SHE BUTLU; P1B - CALL FROM ^P1B ....I MZ S ^("BTL")=$G(@VRM@(MZ,"BTL"))+BTL . .Q:$D(P1TIPDAY) .Q:$G(@$$^W4PRM@("TIPMZM")) ; . .S SY=1 .I '$D(P1TIPMZ)&'$D(SGIRATJOM)!$G(@$$^W4PRM@("TIPMZM")) D ..N J S J=D_"^" F S J=$O(@$$^W4GL("TIPMZ")@(J)) Q:J="" Q:$P(J,"^")'=D D ...I $G(^(J))["?" S SY=SY+1 ...N N1 S N1="" F S N1=$O(@$$^W4GL("TIPMZ")@(J,N1)) Q:N1="" D ;-- N1 - MELZAR ....N N11 S N11=N1 ....I $D(P1HY) S N1=$$MLZY1(D,SY) ....Q:'$$ALL ....S @VRM@(N11,"TIP")=$G(@VRM@(N11,"TIP"))+$G(@$$^W4GL("TIPMZ")@(J,N11)) ; I $G(SGR)=1 D ; -- HISHUV MISP SOADIM LEFI KAMUT PRITIM .N N,HZ,MLZP,I,SMLZ,SD .S N="" F S N=$O(@VRM@(N)) Q:N="" D ; -- N - MELZAR ..K @VRM@(N,"SOAD") ..S HZ="",I=0 ..F S HZ=$O(@VRM@(N,"HZMN",HZ)) Q:HZ="" D S I=I+(SD/$S('SMLZ:1,1:SMLZ)) ...S SD=$$SOAD^W4HZMST(HZ) ...N N1 S N1="",SMLZ=0 ...F S N1=$O(@$$^W4GL("P1MLZ")@(HZ,N1)) Q:N1="" S SMLZ=SMLZ+1 ; - K-VO PAR-V ..S @VRM@(N,"SOAD")=$J(I,2,2) ; Q:$D(P1TIPDAY) ; I $D(P1TIPMZ),D1=D2 D G Z2 ;---------- HISHUV ZIKUIM LE DOH TIPIM BE MEZUMAN .N DAT S DAT=$$^%L1DC($$^%L1DC(D1,1),2) .N N,A S N="" F S N=$O(@$$^W4GL("TOT")@(DAT,"MIN3",1,N)) Q:N="" Q:N'?5N D ..S A=$G(^(N)) S ^("ZIC")=$G(@VRM@(N,"ZIC"))+A ; ;------------------------------------ HISHSUV ZICUIM RAGIL S N="" F S N=$O(@$$^W4GL("P1TZ")@(N)) Q:N="" D GA^%L1SCREF("P1TZ",$$^W4GL("P1TZ")_"(N)") D .I DZ'D2,MLZ D ..I $G(NMB),$L(NMB)<4,$G(MESUGS)!$G(ADSUGS),$$SUGS^W4L(NMB)ADSUGS) Q ..S:CA<0 CA=-CA ..S ^("ZIC")=$G(@VRM@(MLZ,"ZIC"))+(MZM+CHK+CA+$G(ASR)+$G(TL)) ..S @VRM@(MLZ,"TZ",N)="" ; N - NOM TEUD ZIC ; ;------------------------------------ HORADAT ZICUIM Z2 I $G(SGR)'=1 S N="" F S N=$O(@VRM@(N)) Q:N="" D .S ^("PDN")=$G(@VRM@(N,"PDN"))-$G(^("ZIC")) .S ^("PDNHB")=$G(@VRM@(N,"PDNHB"))-$G(^("ZIC")) ; S I=0,N="" K @TEMP ; S (SUMPD,SUMSHR,SUMTIP,SUMBIT,SUMSD,SUMHZ,SUMZIC,SUMHN,SUMHNCB)=0 ; ;----------------------- SIKUMIM LEFI KOL MELZARIM --- ; F S N=$O(@VRM@(N)) Q:N="" D .N TIP S TIP=+$G(@VRM@(N,"TIP")) .S SUMPD=SUMPD+$G(@VRM@(N,"PDN"))+$S($$TIPPD:TIP,1:0) .S SUMSHR=SUMSHR+$G(@VRM@(N,"SHER")) .S SUMTIP=SUMTIP+TIP .S SUMHN=SUMHN+$G(@VRM@(N,"HNH"))-$G(^("CIBHN")) .S SUMSD=SUMSD+$G(@VRM@(N,"SOAD")) .S SUMHZ=SUMHZ+$G(@VRM@(N,"HZM")) .S SUMBIT=SUMBIT+$G(@VRM@(N,"BTL")) .S SUMZIC=SUMZIC+$G(@VRM@(N,"ZIC")) .S SUMHNCB=SUMHNCB+$G(@VRM@(N,"CIBHN")) ; D TEMP I $G(SGR)=1 G Z3 ; I $D(P1TIPMZ) D Q ;---- DOCH MELZARIM IF CALL FROM TIPIM B MEZUMAN .K @VRM@("TIPMZ") .N LNZ S LNZ=LASTZ ; ? .I $D(@$$^W4GL("TIPMZ")@(LNZ)) D ..S N="" F S N=$O(@$$^W4GL("TIPMZ")@(LNZ,N)) Q:N="" D ...S @VRM@(N,"TIPMZ")=$G(@$$^W4GL("TIPMZ")@(LNZ,N)) . .F S N=$O(@VRM@(N)) Q:N="" D ..S I=I+1 S TIP=$G(^(N,"TIP")) ..S @TEMP@(I)=N_"\"_$$^W4NAME(N)_"\" ..S @TEMP(I)=@TEMP(I)_($G(@VRM@(N,"PDN"))+TIP)_"\" ..S @TEMP@(I)=@TEMP@(I)_"\"_$G(@VRM@(N,"SHER"))_"\"_TIP_"\" ..S @TEMP@(I)=@TEMP@(I)_+$G(@VRM@("TIPMZ"))_"\"_(TIP+$G(^("TIPMZ"))) ; ; Z3 ;---------------------- DOCH MELZARIM ---------------- ; 1 2 3 4 5 6 7 8 9 10 11 12 ;MLZ\NAME\SHER\BTL\HNH\ZIC\TIP\PDN\SOAD\HZM\PDNHB\HNHCIB ; S N="" F S N=$O(@VRM@(N)) Q:N="" D .N PDN S PDN=$G(@VRM@(N,"PDN"))+$S($$TIPPD:$G(@VRM@(N,"TIP")),1:0) .I $G(SGR)=2,'$D(P1JOM) S PDN=$G(@VRM@(N,"PDNHB")) .N J,OK S OK=0 S:PDN OK=1 .I 'OK F J="SHER","BTL","HNH","ZIC","HZM","SOAD","TIP","PDNHB" D DD ..I $G(@VRM@(N,J)) S OK=1 .Q:'OK .S I=I+1 S @TEMP@(I)=N_"\"_$$^W4NAME(N)_"\" .I '$$MTAW S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"SHER"))_"\" .S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"BTL"))_"\" .S @TEMP@(I)=@TEMP@(I)_($G(@VRM@(N,"HNH"))-$G(^("CIBHN")))_"\" .S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"ZIC"))_"\" .I '$$MTAW S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"TIP"))_"\" .S @TEMP@(I)=@TEMP@(I)_PDN_"\" .I '$$MTAW S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"SOAD"))_"\" .S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"HZM"))_"\" .S @TEMP@(I)=@TEMP@(I)_$G(@VRM@(N,"PDNHB"))_"\"_$G(^("CIBHN"))_"\@@" ; Q:$D(P1JOM) ; I SUMSD S SOADMZ=$J(SUMPD/SUMSD,2,2) ; D S4B ; END K @TEMP,@VRM Q ; ; MSP0 ; N PDN,SOAD,MSOAD S PDN=$P(@$$^W4MAIN("TEMP")@(SH),"\",8) S SOAD=$P(^(SH),"\",9) Q:'SOAD S MSOAD=$J(PDN/SOAD,2,2) Q ; ; S4B ; K %S4B N I ; S %S4B("FIX")=2,%S4B("LEFT")=4 S %S4B("VGR1")=4,%S4B("NOEXP")="",%S4B("INV")="" S %S4B("NGR1")=20 ; ; 1 2 3 4 5 6 7 8 9 10 11 12 N MC1 S MC1="MLZ\NAME\SHER\BTL\HNH\ZIC\TIP\PDN\SOAD\HZM\PDNHB\CIBHN" I $$MTAW S MC1="MLZ\NAME\BTL\HNH\ZIC\PDN\HZM\PDNHB\CIBHN" ; N MC2,MC2SUM S MC2="MLZ\NAME\HZM\PDN\SOAD\AVR\TIP\ZIC\BTL\HNH\CIBHN" I $$MTAW S MC2="MLZ\NAME\HZM\PDN\AVR\ZIC\BTL\HNH\CIBHN" ; S MC2SUM="\SUMHZM\SUMPD\SUMSD\\SUMTIP\SUMZIC\SUMBT\SUMHN\SUMHBCB" ; D S4GB ; K @S4B F I=1:1 Q:'$D(@TEMP@(I)) D .N T,T1 S T=$G(@TEMP@(I)),T1="" .D SET^%L1FRM(T,MC1,"\","T1",MC2,"\") ; --- T --> T1 .; .I '$$MTAW D ..S $P(T1,"\",6)=$S($P(T1,"\",5):$J($P(T1,"\",4)/$P(T1,"\",5),2,2),1:"") ..F J=1,2,3,5 S $P(@S4B@(I),"\",J)=$P(T1,"\",J) ..F J=4,6:1:11 S $P(@S4B@(I),"\",J)=$J($P(T1,"\",J),2,2) ..I $G(@$$^W4PRM@("COEF")) D ...S $P(@S4B@(I),"\",7)=$J($P(@S4B@(I),"\",7)*@$$^W4PRM@("COEF"),2,2) . .I $$MTAW D ..S $P(T1,"\",5)=$S($P(T1,"\",3):$J($P(T1,"\",4)/$P(T1,"\",3),2,2),1:"") ..F J=1,2,3 S $P(@S4B@(I),"\",J)=$P(T1,"\",J) ..F J=4:1:9 S $P(@S4B@(I),"\",J)=$J($P(T1,"\",J),2,2) ; ;-------------- SICUMIM D SUM4B ; I $G(@$$^W4PRM@("COEF")) S SUMSHR=$J($G(SUMSHR)*@$$^W4PRM@("COEF"),2,2) ; S @SUM4B="\\"_SUMHZ_"\"_$J(SUMPD,2,2) ; I '$$MTAW D .S @SUM4B=@SUM4B_"\"_$S($G(SGR)=1:"",1:SUMSD) .S @SUM4B=@SUM4B_"\"_$S($G(SGR)=1!'SUMSD:"",1:$J(SUMPD/SUMSD,2,2)) .S @SUM4B=@SUM4B_"\"_$J(SUMTIP,2,2) ; I $$MTAW S @SUM4B=@SUM4B_"\"_$S($G(SGR)=1!'SUMHZ:"",1:$J(SUMPD/SUMHZ,2,2)) ; S @SUM4B=@SUM4B_"\"_$J(SUMZIC,2,2) S @SUM4B=@SUM4B_"\"_$J(SUMBIT,2,2) S @SUM4B=@SUM4B_"\"_$J(SUMHN,2,2)_"\"_$J(SUMHNCB,2,2) ; D S4BPRM ; Q ; ; T(S) ; Q $P(S,":")*60+$P(S,":",2) ; SUM(HZM,MLZ) ; S SUM=0 N N S N="" F S N=$O(@$$^W4GL("P1MLZ")@(HZM,MLZ,N)) Q:N="" D .S SUM=SUM+$P(^(N),"*",2)-$P(^(N),"*",4) Q ; MLZP(HZM) ; I $D(P1HY) S MLZP=$$MLZY(HZM) Q MLZP N MKBL S MKBL=$$MKBL^W4HZMST(HZM) S MLZP=MKBL I $G(@$$^W4PRM@("MLZ")),$G(@$$^W4GL("P1MLZ")@(HZM)),$G(@$$^W4PRM@("LAST")),$G(SGR)=2 S MLZP=@$$^W4GL("P1MLZ")@(HZM) Q MLZP ; MLZY(HZM) ; N DT,MLZY,HZMY S DT=$$^%L1DC($$DATK^W4HZMST(HZM),3) I '$D(@$$^W4GL("P1HY")@(DT)) S MLZY="99999" Q MLZY I $D(@$$^W4GL("P1HY")@(DT,HZM)) S MLZY=^(HZM) Q MLZY S HZMY=$O(@$$^W4GL("P1HY")@(DT,HZM),-1) I HZMY="" Q "99999" S MLZY=@$$^W4GL("P1HY")@(DT,HZMY) Q MLZY ; MLZY1(DT,SY) ; S MLZY=99999 N N,Y S N="",Y=0 F S N=$O(@$$^W4GL("P1HY")@(DT,N)) Q:N="" D Q:Y=SY .S Y=Y+1 I Y=SY S MLZY=$G(@$$^W4GL("P1HY")@(DT,N)) Q MLZY ; TIPPD(STAM) ; Q $$^W4TIPPD ; VRM ; S VRM=$$^W4MAIN("VRM") Q ; TEMP ; S TEMP=$$^W4MAIN("TEMP") Q ; SUM4B ; S SUM4B=$$BG^W4MAIN("S4B")_"99999)" Q S4GB ; S S4B=$$^W4MAIN("S4B") Q MTAW(STAM) ; Q $$MTAW^W4MTAW ; ALL(STAM) ; I '$G(MESUGS),'$G(ADSUGS),'$G(MESHAA),'$G(ADSHAA) Q 1 Q 0 ; SHOW ; N (JB,%ARG,%REM) D ^%W1ARG S %SCRN="W4DMLZ" I $$MTAW S %SCRN="W4DCSR" D S4BPRM W "
    " W $$^%W1DICT("SORT")_$$NBSP^%L1FRM(2) W "",! W $$NBSP^%L1FRM(1) W "
    ",! ; S S4B="" D PC^W4DMANY Q ; S4BPRM ; S %S4B("PRM")="|'SODEXO' zegpd| zegpd| milehia |miekif|mitih|creql rvenn| micreq | zexikn |zepnfd| xvln my |xvln 'qn|" I $D(P1HY) S %S4B("PRM")="|'SODEXO' zegpd| zegpd | milehia| zexiy |creql rvenn|micreq|dtwd+oeict| mitih | miekif |zepnfd| y""ng` my |y""ng` 'qn|" I $$MTAW D .S %S4B("PRM")="| zegpd | milehia | miekif | oeaygl rvenn | zexikn | zepeayg| (z)i`tew my |(z)i`tew 'qn|" S %S4B("PRINT")="",%S4B("VIEW")="" ; S %S4B("RG",2)="H" S %S4B("VRB","SGR")=$G(%ARG("SGR")) K %S4BO Q W4DMN W4DMN ; DOCH DMEY MISHL NOSAFIM [ 18.02.25 23:38 ] [ 15.01.25 12:13 ] [ 26.12.24 09:08 ] N (JB,%ARG,%REM) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^%W1ARG S SIT="zayl" ; ; W "
    ",! W "",! W "" W "",! W "",! W "
    " W $$H2U^%L1FRM($$^W3MSDG($$GET^%W1PRM("MSD")))_" : " I '$$DPS W $$^%W1DICT("DMNREPORT") I $$DPS W $$^%W1DICT("DPSREPORT") W "
    ",! ; S COLSPAN=7 I $$DPS S COLSPAN=6 ; I '$G(MEDAT),'$G(ADDAT) D Q .N DTZ S DTZ=$$^W4DZ .W "",! . W "" . W "",! . W " ",! . W "",! . W " ",! . W "",! . W "",! . W " ",! .W "
    " . D ^%W1DAT("MEDAT",DTZ,$$^%W1DICT("FROMDATE")) . W " " . D ^%W1DAT("ADDAT",DTZ,$$^%W1DICT("UNTILDATE")) . W " " . D ROUNDBUT^%W1JS("sbm",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") . W "" . D ROUNDBUT^%W1JS("backid",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") . W "
    ",! ; ; S MEDT=$$^%L1DC($G(MEDAT),3) S ADDT=$$^%L1DC($G(ADDAT),3) ; D DIVBUT W "
    " ; D KOT ; W "
    ",! ; W "" W "" W "" W "" W "" W "" W "" I '$$DPS W "" W "" W "" W "" ; I '$$DPS D .W "" .I $$EDIT W "" .W "" ; I $$DPS D .W "" .W "" .W "" ; I $$EDIT D .W "" W "",! ; S VRM=$$^W4MAIN("VRM") K @VRM ; F DT=MEDT:1:ADDT D .I '$$DMNALL S HZM="" F S HZM=$O(@$$^W4GL("W4LINKD")@(DT,HZM)) Q:HZM="" D HZM .I $$DMNALL S HZM="" F S HZM=$O(@$$^W4REF@(DT,HZM)) Q:HZM="" D HZM ; ; K STOPAY,SDMSH,SDMN,SHZ S (STOPAY,SDMSH,SDMN,SHZ)=0 ; S PSL="" F S PSL=$O(@VRM@(PSL)) Q:PSL="" D .I $G(%ARG("PSL")),PSL'=%ARG("PSL") Q .S DT="" F S DT=$O(@VRM@(PSL,DT)) Q:DT="" D ..S HOUR="" F S HOUR=$O(@VRM@(PSL,DT,HOUR)) Q:HOUR="" D ...I HOUR="" S HOUR=" " ...S HZM="" F S HZM=$O(@VRM@(PSL,DT,HOUR,HZM)) Q:HZM="" D ....S ST=$G(^(HZM)) ....D TRHZ(PSL,DT,HZM,ST) . .I '$$EDIT D ..W "" ..W "",! ..W "",! ..W "",! ..W "",! ..W "",! ..I $$DPS D ...W "",! ..W "",! . I '$$DELIS^W4PRM!$$DPS D TOT ; W "",! K @VRM K @$$^W4MAIN("VRMPSL") Q ; ; HZM ; I $$^W4PIZUL(HZM) Q I $$DEL^W4DEL(HZM) Q ; S %SCRN="P1HZ" D GA^W4SCREF(%SCRN,$$^W4ORD_"(HZM)") I 'MZM,$$DPS Q ; S BAIT=$$BAIT^W4HZMST(HZM),DIRA=$E($$DIRA^W4HZMST(HZM),1,7) I BAIT,DIRA S BAIT=BAIT_"/"_DIRA S ADR=BAIT_" "_$$KTV^W4HZMST(HZM) ; S IR=$$IR^W4HZMST(HZM) N DTH S DTH=$$^%L1DC(TRH,3) ; I $$^W4ISCDLK(LKHN) S NMB=LKHN N NMB1 S NMB1=$TR(NMB,"-","") I $G(MEPSL),PSL$G(ADPSL)) S OK=0 Q ; S IR=$$SPA^%L1FRM($G(IR)) I $$^W4MSL(NMB),IR="" S IR="TAKEAWAY" ;;I $$TAKEAWAY(IR) Q I IR="eti aia` lz" S IR="aia` lz" S PSL=$$PSL^W4HZMST(HZM) I '$$DMNALL Q:'PSL S PSL=+PSL ; I $$DMNALL,$$^W4MSD(NMB) D .S IR="",ADR="" .N DATCB S DATCB=$$DATCB^W4HZMST(HZM) .S TRH=$P(DATCB," ") .S SHAA=$P(DATCB," ",2) ; S ST=HZM_"\"_TRH_"\"_IR_"\"_NMB_"\"_ADR_"\"_SHAA_"\"_TSHL_"\"_$S($$DPS:MZM,1:DMSH) S:SHAA="" SHAA="00:00" I $$DMNALL,$$^W4MSD(NMB) S @$$GL@(HZM)=MZM S @VRM@(PSL,DT,SHAA,HZM)=ST Q ; ; TRHZ(PSL,DT,HZM,ST) ; D PRS^%L1FRM(ST,"HZM\TRH\IR\NMB\ADR\SHAA\TSHL\DMSH","\") W "" N PSL1 S PSL1=$$PSL1(PSL) I $$DMNALL,'PSL,$$HZM^W4MSL(HZM) S PSL1=$$^%W1DICT("NOCOURIER") W "",! W "",! W "",! W "",! W "",! I '$$DPS W "",! W "",! W "",! W "",! W "",! ; S SHZ=SHZ+1 S SHZ(PSL)=$G(SHZ(PSL))+1 S STOPAY=STOPAY+TSHL S STOPAY(PSL)=$G(STOPAY(PSL))+TSHL ; S SDMSH=SDMSH+DMSH S SDMSH(PSL)=$G(SDMSH(PSL))+DMSH ; N VL S VL=$$VL(HZM) S SDMN=SDMN+VL S SDMN(PSL)=$G(SDMN(PSL))+VL ; I '$$EDIT!$$HZM^W4MSD(HZM)!$$NOPSL(HZM) D .W "",! . .I $$DPS D ..W "",! . .I $$EDIT W "",! ; I $$EDIT,$$HZM^W4MSL(HZM),'$$NOPSL(HZM) D . S:$G(IR)="" IR=" " . .I '$$DPS D .. W "",! . .W "",! . .I $$DPS D ..W "",! .;;S ^AA("W4DMN",HZM,"VL")=VL .;;S ^AA("W4DMN",HZM,"DMSH")=DMSH .W "",! ; W "",! Q ; ; MVT ; S MVT(1)="onefn" S MVT(2)="wiy" S MVT(3)="`-k" S MVT(4)="dtwd" S MVT(5)="yelz" Q ; ; PRM ; Q ; TAKEAWAY(IR) ; I $TR(IR," .","")'="TAKEAWAY",$TR(IR," .","")'="TAW" Q 0 Q 1 ; D(NOM) ; ;;S ^D(HZM)=NOM Q ; VL(HZM) ; Q $G(@$$GL@(HZM)) ; EDIT(STAM) ; Q $G(%ARG("EDIT")) ; DIVBUT ; N VIS S VIS="hidden" I $$EDIT S VIS="visible" W "
    "_$$^%W1DICT("COURIER")_""_$$^%W1DICT("DATE")_""_$$^%W1DICT("CITY")_""_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("ADDRESS")_""_$$^%W1DICT("TIME")_""_$$^%W1DICT("ORDER")_""_$$^%W1DICT("TOPAY")_""_$$^%W1DICT("DLVPAY")_""_$$^%W1DICT("PREVPAY")_""_$$^%W1DICT("ADDDLVPAY")_""_$$^%W1DICT("PAIDCASH")_""_$$^%W1DICT("DPSPAY")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("CHANGED")_"
    "_$$PSL1(PSL)_""_$G(SHZ(PSL))_""_$J($G(STOPAY(PSL)),2,2)_""_$J($G(SDMSH(PSL)),2,2)_""_$J($G(SDMN(PSL)),2,2)_"" ... W $J($G(SDMN(PSL))-$G(SDMSH(PSL)),2,2) ...W "
    "_PSL1_""_TRH_""_$$H2U^%L1FRM(IR)_""_NMB_""_$$H2U^%L1FRM($$NAME^W4HZMST(HZM))_""_$$H2U^%L1FRM(ADR)_""_SHAA_""_HZM_""_$J(TSHL,2,2)_""_$J(DMSH,2,2)_"" . W $J(VL,2,2) .W "" .. W $J(VL-DMSH,2,2) ..W " " .. W $G(@$$^W4GL("W4DMNPRV")@(PSL,IR)) .. W "" . W " " . W "" .W "" .. W "" ..W "
    ",! W "" W "" W "" ; W "" ; W "" I '$$MZSM^W4PRM,$$EDIT D .W "" ; I '$$EDIT D .W "" W "" W "",! W "
     " W $$^%W1DICT("EDIT")_" " W "",! W "" S VRM0=$$^W4MAIN("VRM0") K @VRM0 F DT=MEDT:1:ADDT D .S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" D ..I $D(@$$^W4ORD@(HZ,"TM")) S A=$G(^("TM")) D ...S PSL=$P(A,"\") I $$DMNALL S PSL=+PSL ...I PSL!$$DMNALL D ....S @VRM0@(PSL)="" ; S VRMPSL=$$^W4MAIN("VRMPSL") K @VRMPSL S PSL="" F J=1:1 S PSL=$O(@VRM0@(PSL)) Q:PSL="" D .N A S A=$G(@$$^W4GL("P1SL")) .S IND=$E($$INV^%L1FRM(A),1,10) .S IND=IND_J .S @VRMPSL@(IND)=PSL ; W "" W " " .W "" .W "" . W "" .W "" W "" W "
    ",! Q ; KOT ; W "" D .I MEDAT=ADDAT W $$^%W1DICT("TODATE",MEDAT) Q .W $$^%W1DICT("FROMDATETODATE",MEDAT_"<>"_ADDAT) Q W "",! W "
    ",! Q ; ; SAVE(PRM) ; N HZM,VL,PSL,IR,DPS,TRH S ^AA("W4DMN-SAVE","PRM")=PRM S HZM=$P(PRM,";") S VL=$P(PRM,";",2) S DPS=$P(PRM,";",3) S TRH=$P(PRM,";",4) I 'HZM Q "NOORDER" I 'TRH Q "NODATE" ; I DPS S @$$^W4GL("W4DPS")@(HZM)=VL I 'DPS S @$$^W4GL("W4DMN")@(HZM)=VL S IR=$$IR^W4HZMST(HZM) S PSL=+$$PSL^W4HZMST(HZM) I $L(IR),$L(PSL),'DPS S @$$^W4GL("W4DMNPRV")@(PSL,IR)=VL ; I DPS,PSL D ;;,'$$MZSM^W4PRM D ; -- 18.12.24 .N DT S DT=$$^%L1DC(TRH,3) .N SHAA S SHAA=$$SHAA^W4HZMST(HZM) I SHAA?1N.E,SHAA<$$SHAAZ^W4PRM S DT=DT-1 .S $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\")=$P($G(@$$^W4GL("W4SLHFK")@(DT,PSL)),"\")+VL .S $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\",3)=$ZD($H,"24:60") Q 1 ; DPS(STAM) ; Q $G(%ARG("DPS")) ; GL(STAM) ; I $$DPS Q $$^W4GL("W4DPS") Q $$^W4GL("W4DMN") ; PSL1(PSL) N PSL1 S PSL1="" ;;I PSL<0 S PSL1="TAKE AWAY" Q PSL1 I PSL<0 S PSL1=$$^%W1DICT("CUSTOMERSTAKEAWAY") Q PSL1 S PSL1=$$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL))) Q PSL1 ; TOT ; W "",! W ""_$$^%W1DICT("TOTAL")_"",! W ""_$G(SHZ)_"",! W ""_$J(STOPAY,2,2)_"",! W ""_$J(SDMSH,2,2)_"",! ; I '$$EDIT D .W ""_$J(SDMN,2,2)_"",! .I $$DPS W ""_$J(SDMN-SDMSH,2,2)_"",! ; I $$EDIT D .I '$$DPS W " ",! .W "" .W " " .W "",! . .I $$DPS D ..W "" ..W " " ..W "",! . .N PSL S PSL=$G(%ARG("PSL")) .; .I '$$MZSM^W4PRM!'$$EDIT!'PSL!($G(%ARG("MEDAT"))'=$G(%ARG("ADDAT"))) D Q ..W " ",! . .W "" .N DT S DT=$$^%L1DC($G(%ARG("ADDAT")),3) .D ..W $$^%W1DICT("HFKMZSM")_" " ..W "" ..W $$^%W1DICT("NIS")_" "_"
    ",! ..W "",! .W "",! W "",! Q ; ; CLRDT(PRM) ; N MEDAT,ADDAT,MEDT,ADDT,DT,PSL S MEDAT=$P(PRM,";"),MEDT=$$^%L1DC(MEDAT,3) S ADDAT=$P(PRM,";",2),ADDT=$$^%L1DC(ADDAT,3) S PSL=$P(PRM,";",3) F DT=MEDT:1:ADDT D .I '$G(PSL) K @$$^W4GL("W4SLHFK")@(DT) .I $G(PSL) K @$$^W4GL("W4SLHFK")@(DT,PSL) Q 1 ; DMNALL() Q $G(@$$^W4PRM@("DMNALL")) ; NOPSL(HZM) ; I $$HZM^W4MSD(HZM) Q 1 N PSL S PSL=$$PSL^W4HZMST(HZM) I 'PSL Q 1 Q 0 ; DIFMZSM(PRM) ; N (JB,%ARG,PRM) S DT=$P(PRM,";") I 'DT Q 0 S PSL=$P(PRM,";",2) I 'PSL Q 0 S SUM=$P(PRM,";",3) N RZ S RZ=SUM-$G(@$$^W4GL("W4MZSMHF")@(DT,PSL)) S RZ=$J(RZ,1,1) Q RZ ; ITRAHFK(PRM) ; N VL,DAT,PSL,DT S VL=$P(PRM,";") S PSL=$P(PRM,";",2) I 'PSL Q 0 S DAT=$P(PRM,";",3) I 'DAT Q 0 S DT=$$^%L1DC(DAT,3) I 'DT Q 0 Q +$G(@$$^W4GL("W4MZSMHF")@(DT,PSL)) ; PTMG ; I $$MZSM^W4PRM Q I '$$PAPJ^W4PRM Q D ^W4MDPPC I $G(PRINT)<3 Q D ^W4SETPC(PRINT,$G(%MDP("P"))) D ^W4PTHDLY Q W4DMN0 W4DMN ; DOCH DMEY MISHL NOSAFIM [ 31.01.24 11:56 ] [ 04.01.24 06:25 ] [ 21.12.23 14:00 ] N (JB,%ARG,%REM) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^%W1ARG ; ; W "
    ",! W "",! W "" W "" W "" W "
    " W $$H2U^%L1FRM($$^W3MSDG($$GET^%W1PRM("MSD")))_" : " I '$$DPS W $$^%W1DICT("DMNREPORT") I $$DPS W $$^%W1DICT("DPSREPORT") W "
    ",! ; S COLSPAN=7 I $$DPS S COLSPAN=6 ; I '$G(MEDAT),'$G(ADDAT) D Q .N DTZ S DTZ=$$^W4DZ .W "",! . W "" . W "" . W " ",! . W "" . W " ",! . W "" . W "" . W " ",! .W "
    " . D ^%W1DAT("MEDAT",DTZ,$$^%W1DICT("FROMDATE")) . W " " . D ^%W1DAT("ADDAT",DTZ,$$^%W1DICT("UNTILDATE")) . W " " . D ROUNDBUT^%W1JS("sbm",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") . W "" . D ROUNDBUT^%W1JS("backid",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") . W "
    ",! ; ; S MEDT=$$^%L1DC($G(MEDAT),3) S ADDT=$$^%L1DC($G(ADDAT),3) ; D DIVBUT W "
    " ; D KOT ; W "
    ",! ; W "" W "" W "" W "" W "" W "" W "" I '$$DPS W "" W "" W "" W "" ; I '$$DPS D .W "" .I $$EDIT W "" .W "" ; I $$DPS D .W "" .W "" .W "" ; I $$EDIT D .W "" W "",! ; S VRM=$$^W4MAIN("VRM") K @VRM ; F DT=MEDT:1:ADDT D .S HZM="" F S HZM=$O(@$$^W4GL("W4LINKD")@(DT,HZM)) Q:HZM="" D HZM ; ; K STOPAY,SDMSH,SDMN,SHZ S (STOPAY,SDMSH,SDMN,SHZ)=0 ; S PSL="" F S PSL=$O(@VRM@(PSL)) Q:PSL="" D .I $G(%ARG("PSL")),PSL'=%ARG("PSL") Q .S DT="" F S DT=$O(@VRM@(PSL,DT)) Q:DT="" D ..S SHAA="" F S SHAA=$O(@VRM@(PSL,DT,SHAA)) Q:SHAA="" D ...S HZM="" F S HZM=$O(@VRM@(PSL,DT,SHAA,HZM)) Q:HZM="" D ....S ST=$G(^(HZM)) ....D TRHZ(PSL,DT,HZM,ST) . .I '$$EDIT D ..W "" ..W "" ..W "" ..W "" ..W "" ..W "" ..I $$DPS D ...W "" . I '$$DELIS^W4PRM!$$DPS D TOT ; W "",! K @VRM K @$$^W4MAIN("VRMPSL") Q ; ; HZM ; I $$^W4PIZUL(HZM) Q ; S %SCRN="P1HZ" D GA^W4SCREF(%SCRN,$$^W4ORD_"(HZM)") I 'MZM,$$DPS Q ; S BAIT=$$BAIT^W4HZMST(HZM),DIRA=$E($$DIRA^W4HZMST(HZM),1,7) I BAIT,DIRA S BAIT=BAIT_"/"_DIRA S ADR=BAIT_" "_$$KTV^W4HZMST(HZM) ; S IR=$$IR^W4HZMST(HZM) N DTH S DTH=$$^%L1DC(TRH,3) ; I $$^W4ISCDLK(LKHN) S NMB=LKHN N NMB1 S NMB1=$TR(NMB,"-","") I $G(MEPSL),PSL$G(ADPSL)) S OK=0 Q ; S IR=$$SPA^%L1FRM($G(IR)) I $$^W4MSL(NMB),IR="" S IR="TAKEAWAY" ;;I $$TAKEAWAY(IR) Q I IR="eti aia` lz" S IR="aia` lz" S PSL=$$PSL^W4HZMST(HZM) Q:'PSL ; S ST=HZM_"\"_TRH_"\"_IR_"\"_NMB_"\"_ADR_"\"_SHAA_"\"_TSHL_"\"_$S($$DPS:MZM,1:DMSH) S:SHAA="" SHAA="00:00" S @VRM@(PSL,DT,SHAA,HZM)=ST Q ; ; TRHZ(PSL,DT,HZM,ST) ; D PRS^%L1FRM(ST,"HZM\TRH\IR\NMB\ADR\SHAA\TSHL\DMSH","\") W "" N PSL1 S PSL1=$$PSL1(PSL) W "" W "" W "" W "" W "" I '$$DPS W "" W "" W "" W "" W "" ; S SHZ=SHZ+1 S SHZ(PSL)=$G(SHZ(PSL))+1 S STOPAY=STOPAY+TSHL S STOPAY(PSL)=$G(STOPAY(PSL))+TSHL ; S SDMSH=SDMSH+DMSH S SDMSH(PSL)=$G(SDMSH(PSL))+DMSH ; N VL S VL=$$VL(HZM) S SDMN=SDMN+VL S SDMN(PSL)=$G(SDMN(PSL))+VL ; I '$$EDIT D .W "" .I $$DPS D ..W "" ; I $$EDIT D . S:$G(IR)="" IR=" " .I '$$DPS D .. W "" . .W "" .I $$DPS D ..W "" . .W "" ; W "" Q ; ; ; MVT ; S MVT(1)="onefn" S MVT(2)="wiy" S MVT(3)="`-k" S MVT(4)="dtwd" S MVT(5)="yelz" Q ; ; PRM ; Q ; TAKEAWAY(IR) ; I $TR(IR," .","")'="TAKEAWAY",$TR(IR," .","")'="TAW" Q 0 Q 1 ; D(NOM) ; ;;S ^D(HZM)=NOM Q ; VL(HZM) ; Q $G(@$$GL@(HZM)) ; EDIT(STAM) ; Q $G(%ARG("EDIT")) ; DIVBUT ; N VIS S VIS="hidden" I $$EDIT S VIS="visible" W "
    "_$$^%W1DICT("COURIER")_""_$$^%W1DICT("DATE")_""_$$^%W1DICT("CITY")_""_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("ADDRESS")_""_$$^%W1DICT("TIME")_""_$$^%W1DICT("ORDER")_""_$$^%W1DICT("TOPAY")_""_$$^%W1DICT("DLVPAY")_""_$$^%W1DICT("PREVPAY")_""_$$^%W1DICT("ADDDLVPAY")_""_$$^%W1DICT("PAIDCASH")_""_$$^%W1DICT("DPSPAY")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("CHANGED")_"
    "_$$PSL1(PSL)_""_$G(SHZ(PSL))_""_$J($G(STOPAY(PSL)),2,2)_""_$J($G(SDMSH(PSL)),2,2)_""_$J($G(SDMN(PSL)),2,2)_"" ... W $J($G(SDMN(PSL))-$G(SDMSH(PSL)),2,2) ...W "
    "_PSL1_""_TRH_""_$$H2U^%L1FRM(IR)_""_NMB_""_$$H2U^%L1FRM($$NAME^W4HZMST(HZM))_""_$$H2U^%L1FRM(ADR)_""_SHAA_""_HZM_""_$J(TSHL,2,2)_""_$J(DMSH,2,2)_"" . W $J(VL,2,2) .W "" .. W $J(VL-DMSH,2,2) ..W "" .. W $G(@$$^W4GL("W4DMNPRV")@(PSL,IR)) .. W "" . W " " . W "" .W "" .. W "" ..W "
    ",! W "" W "" W "" ; W "" ; W "" W "" I '$$EDIT D .W "" W "" W "",! W "
     " W $$^%W1DICT("EDIT")_" " W "",! W "" S VRM0=$$^W4MAIN("VRM0") K @VRM0 F DT=MEDT:1:ADDT D .S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" D ..I $D(@$$^W4ORD@(HZ,"TM")) S A=$G(^("TM")) D ...S PSL=$P(A,"\") ...I PSL D ....S @VRM0@(PSL)="" ; S VRMPSL=$$^W4MAIN("VRMPSL") K @VRMPSL S PSL="" F J=1:1 S PSL=$O(@VRM0@(PSL)) Q:PSL="" D .N A S A=$G(@$$^W4GL("P1SL")) .S IND=$E($$INV^%L1FRM(A),1,10) .S IND=IND_J .S @VRMPSL@(IND)=PSL ; W "" W " " W "" W "" . W "" .W "" W "" W "
    ",! Q ; KOT ; W "" D .I MEDAT=ADDAT W $$^%W1DICT("TODATE",MEDAT) Q .W $$^%W1DICT("FROMDATETODATE",MEDAT_"<>"_ADDAT) Q W "",! W "
    ",! Q ; SAVE(PRM) ; N HZM,VL,PSL,IR,DPS,TRH S ^AA("W4DMN-SAVE","PRM")=PRM S HZM=$P(PRM,";") S VL=$P(PRM,";",2) S DPS=$P(PRM,";",3) S TRH=$P(PRM,";",4) I 'HZM Q "NOORDER" I 'TRH Q "NODATE" ; I DPS S @$$^W4GL("W4DPS")@(HZM)=VL I 'DPS S @$$^W4GL("W4DMN")@(HZM)=VL S IR=$$IR^W4HZMST(HZM) S PSL=$$PSL^W4HZMST(HZM) I $L(IR),$L(PSL),'DPS S @$$^W4GL("W4DMNPRV")@(PSL,IR)=VL ; I DPS,PSL D .N DT S DT=$$^%L1DC(TRH,3) .S $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\")=$P($G(@$$^W4GL("W4SLHFK")@(DT,PSL)),"\")+VL .;;I $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\",2)'?.P Q .;;S $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\",2)=RCVR .S $P(@$$^W4GL("W4SLHFK")@(DT,PSL),"\",3)=$ZD($H,"24:60") Q 1 ; DPS(STAM) ; Q $G(%ARG("DPS")) ; GL(STAM) ; I $$DPS Q $$^W4GL("W4DPS") Q $$^W4GL("W4DMN") ; PSL1(PSL) N PSL1 S PSL1="" ;;I PSL<0 S PSL1="TAKE AWAY" Q PSL1 I PSL<0 S PSL1=$$^%W1DICT("CUSTOMERSTAKEAWAY") Q PSL1 S PSL1=$$H2U^%L1FRM($G(@$$^W4GL("P1SL")@(PSL))) Q PSL1 ; TOT ; W "" W ""_$$^%W1DICT("TOTAL")_"" W ""_$G(SHZ)_"" W ""_$J(STOPAY,2,2)_"" W ""_$J(SDMSH,2,2)_"" ; I '$$EDIT D .W ""_$J(SDMN,2,2)_"" .I $$DPS W ""_$J(SDMN-SDMSH,2,2)_"" ; I $$EDIT D .I '$$DPS W " " .W "" .W " " .W "" . .I $$DPS D ..W "" ..W " " ..W "" . .W " " W "",! Q ; ; CLRDT(PRM) ; N MEDAT,ADDAT,MEDT,ADDT,DT,PSL S MEDAT=$P(PRM,";"),MEDT=$$^%L1DC(MEDAT,3) S ADDAT=$P(PRM,";",2),ADDT=$$^%L1DC(ADDAT,3) S PSL=$P(PRM,";",3) F DT=MEDT:1:ADDT D .I '$G(PSL) K @$$^W4GL("W4SLHFK")@(DT) .I $G(PSL) K @$$^W4GL("W4SLHFK")@(DT,PSL) Q 1 W4DMPCO0 W4DMPCON(FUNC,POST) ; [ 22.08.13 14:34 ] [ 24.05.13 16:00 ] [ 05.11.12 17:28 ] N (JB,%ARG,%REM,FUNC,POST,ER,ER1) S ER=0,ER1="" S MAXDL=800 ; S HEADER="""Content-Type:text/xml""" S HEADER1="""SOAPAction:http://shva.co.il/xmlwebservices/"_FUNC_"""" ; S URL="https://www.shva-online.co.il/ash/test/abscheck/absrequest.asmx" I $G(@$$^W4PRM@("ASH","MASOF"))'["0962305" D .S URL="https://www.shva-online.co.il/ash/abscheck/absrequest.asmx" ; S FLTO=$$DIR^W4SHV_"shvin"_$$^W4MYDVN ; -- ADDR + PRM O FLTO:(NEWVERSION:REWIND) U FLTO W "url="_URL C FLTO ; S FLOUT=$$DIR^W4SHV_"shvout"_$$^W4MYDVN C FLOUT:DELETE ; I $$^%L1ZOS(10,FLOUT)>0 ZSY "/bin/rm "_FLOUT ; S CMD="curl -s -H "_HEADER_" -H "_HEADER1_" --data-binary @"_POST_" -o "_FLOUT_" -K "_FLTO ;;S CMD=CMD_" | xmllint --format - " ; ZSY CMD S ^DMP("CMD")=$ZSY ; S H=+$H S @$$^W4GL("W4DMPCMD")@(H,JB,$O(@$$^W4GL("W4DMPCMD")@(H,JB,9999999),-1)+1)=$E(CMD,1,MAXDL) S ^DMP("CMD1")=$ZSY I $ZSY S ER=-$ZSY,ER1="CONNECTIONERROR" G ECON ; F JJ=1:1:10 Q:$$^%L1ZOS(10,FLOUT)'<0 H 1 I $$^%L1ZOS(10,FLOUT)<0 S ER=-.2,ER1="NOANSWER" G ECON ; S CMD1="/bin/cat "_FLOUT_"|/usr/bin/xmllint --format --encode cp862 --output "_FLOUT_" -" ZSY CMD1 H 1 I $ZSY S ER=-$ZSY,ER1=" "_ER_"CONNECTIONERROR" G ECON ; D ^%L1TS S MYDVN=$$^W4MYDVN D GL K @GL S I=0 ; O FLOUT:(REWIND:READONLY) F D Q:$ZEOF .U FLOUT R A .S I=I+1,@GL@(I)=$TR($E(A,1,MAXDL),TSS,TS0) .I $L(A)>MAXDL D ..S @GL@(I)=@GL@(I)_">>>" ..N J F J=1:1 D Q:$L(A)<((J+1)*MAXDL+1) ...S I=I+1,@GL@(I)=$TR($E(A,J*MAXDL+1,(J+1)*MAXDL),TSS,TS0) ...I $L(A)>((J+1)*MAXDL) S @GL@(I)=@GL@(I)_">>>" ...; C FLOUT ECON Q ; GL S GL=$$^W4MAIN("TMPDMP") Q W4DMPCON W4DMPCON(FUNC,POST) ; [ 09.12.20 08:19 ] [ 13.09.16 12:05 ] [ 22.08.13 14:33 ] N (JB,%ARG,%REM,FUNC,POST,ER,ER1) S ER=0,ER1="" S MAXDL=800 ; S HEADER="""Content-Type:text/xml""" S HEADER1="""SOAPAction:http://shva.co.il/xmlwebservices/"_FUNC_"""" ; S URL="https://www.shva-online.co.il/ash/test/abscheck/absrequest.asmx" I $G(@$$^W4PRM@("ASH","MASOF"))'["0962305" D .S URL="https://www.shva-online.co.il/ash/abscheck/absrequest.asmx" ; S MYDVN=$$^W4MYDVN S FLTO=$$DIR^W4SHV_"shvin"_MYDVN ; -- ADDR + PRM O FLTO:(NEWVERSION:REWIND) U FLTO W "url="_URL C FLTO ; S FLOUT=$$DIR^W4SHV_"shvout"_MYDVN C FLOUT:DELETE ; I $$^%L1ZOS(10,FLOUT)>0 ZSY "/bin/rm "_FLOUT ; S CMD="curl -s "_$$^W4IHTPPS_" -H "_HEADER_" -H "_HEADER1_" --data-binary @"_POST_" -o "_FLOUT_" -K "_FLTO ;;S CMD=CMD_" | xmllint --format - " ; ZSY CMD S ^DMP("CMD")=$ZSY ; S H=+$H N IND S IND=$O(@$$^W4GL("W4DMPCMD")@(H,JB,9999999),-1)+1 S @$$^W4GL("W4DMPCMD")@(H,JB,IND,"CMD")=$E(CMD,1,MAXDL) S @$$^W4GL("W4DMPCMD")@(H,JB,IND,"CMD","ZSY")=$ZSY I $ZSY S ER=-$ZSY,ER1="CONNECTIONERROR" G ECON ; F JJ=1:1:10 Q:$$^%L1ZOS(10,FLOUT)'<0 H 1 I $$^%L1ZOS(10,FLOUT)<0 S ER=-.2,ER1="NOANSWER" G ECON ; S CMD1="/bin/cat "_FLOUT_"|/usr/bin/xmllint --format --encode cp862 --output "_FLOUT_" -" ZSY CMD1 S @$$^W4GL("W4DMPCMD")@(H,JB,IND,"CMD1")=$E(CMD1,1,MAXDL) S @$$^W4GL("W4DMPCMD")@(H,JB,IND,"CMD1","ZSY")=$ZSY H 1 I $ZSY S ER=-$ZSY,ER1=" "_ER_"CONNECTIONERROR" G ECON ; D ^%L1TS D GL K @GL S I=0 ; O FLOUT:(REWIND:READONLY) F D Q:$ZEOF .U FLOUT R A .S I=I+1,@GL@(I)=$TR($E(A,1,MAXDL),TSS,TS0) .I $L(A)>MAXDL D ..S @GL@(I)=@GL@(I)_">>>" ..N J F J=1:1 D Q:$L(A)<((J+1)*MAXDL+1) ...S I=I+1,@GL@(I)=$TR($E(A,J*MAXDL+1,(J+1)*MAXDL),TSS,TS0) ...I $L(A)>((J+1)*MAXDL) S @GL@(I)=@GL@(I)_">>>" ...; C FLOUT ECON Q ; GL S GL=$$^W4MAIN("TMPDMP") Q W4DMSD W4DMSD ; -- DOH MISSADOT LEFI SUGEY TASHLUM ; [ 03.11.20 15:02 ] [ 21.05.20 14:41 ] [ 20.05.20 17:55 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATHADTRHT) S OK=0 Q S TRHT=$$^%L1DC(DATH,1) Q ; HZM ; D GA^W4SCREF("P1HZMS",$$^W4ORD_"(HZM)") I $$^W4MSD(NMB) S OK=0 Q S MSD=$$MSDHZM^W4HZMST(HZM) I 'MSD S OK=0 Q I MSDADMSD) S OK=0 Q I $$MSDR^W4PRM,'$D(^[$$^W3MAIN]W3MSDR($$MSDR^W4PRM,MSD)) S OK=0 Q ; N TSHL1,KF,KF2,CA1,MZM1,ASR1,AH1,AH2,AM1,AM2,TOPAY,CA2,MZM2,ASR2,HNQ S TSHL1=TSHL-DMSH S TSHL2=TSHL1 S TSHL3=TSHL S HNQ=0 I $G(@$$^W4ORD@(HZM,"MYDISC")),TSHL'<0 D .S HNQ=HNH .S TSHL2=TSHL1+HNQ .S TSHL3=TSHL+HNQ ; S KF=1 I TSHL3 S KF=$J(TSHL2/TSHL3,5,5) S CA1=$J(CA*KF,2,2) S MZM1=$J(MZM*KF,2,2) S ASR1=$J(ASR*KF,2,2) S AH1=$$AMALA^W3R(MSD) S AH2=$$AMALACA^W3R(MSD) S AM1=$J(TSHL2*AH1/100,2,2) S AM2=$J(TSHL2*AH2/100,2,2) ; I $G(@$$^W4ORD@(HZM,"MYDISC")),TSHL<0 S OK=0 Q ; S TOPAY=TSHL2-AM1-AM2 S x1=CA1,x2=MZM1,x3=ASR1,x4=$J(TSHL2,2,2),x5=AM1,x6=AM2 S KF2=1 I TSHL2 S KF2=$J(TSHL2-AM1/TSHL2,5,5) S CA2=$J(CA1*KF2-AM2,2,2) S MZM2=$J(MZM1*KF2,2,2) S ASR2=$J(ASR*KF2,2,2) S x7=CA2 S x8=MZM2 S x9=ASR2 S x10=HNQ S x11=$J(TOPAY,2,2) Q W4DMSD0 W4DMSD ; -- DOH MISSADOT LEFI SUGEY TASHLUM ; [ 03.03.20 16:30 ] [ 04.02.20 05:12 ] [ 29.01.20 07:08 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATHADTRHT) S OK=0 Q S TRHT=$$^%L1DC(DATH,1) Q ; HZM ; D GA^W4SCREF("P1HZMS",$$^W4ORD_"(HZM)") I $$^W4MSD(NMB) S OK=0 Q S MSD=$$MSDHZM^W4HZMST(HZM) I 'MSD S OK=0 Q I MSDADMSD) S OK=0 Q I $$MSDR^W4PRM=6,MSD<6000 S OK=0 ; N TSHL1,KF,KF2,CA1,MZM1,ASR1,AH1,AH2,AM1,AM2,TOPAY,CA2,MZM2,ASR2,HNQ S TSHL1=TSHL-DMSH S KF=1 I TSHL S KF=$J(TSHL1/TSHL,5,5) S CA1=$J(CA*KF,2,2) S MZM1=$J(MZM*KF,2,2) S ASR1=$J(ASR*KF,2,2) S AH1=$$AMALA^W3R(MSD) S AH2=$$AMALACA^W3R(MSD) S AM1=$J(TSHL1*AH1/100,2,2) S AM2=$J(TSHL1*AH2/100,2,2) S HNQ=0 I $G(@$$^W4ORD@(HZM,"MYDISC")) D .I TSHL<0 S HNQ=TSHL1-AM1-AM2 Q .S HNQ=HNH ; S TOPAY=TSHL1-AM1-AM2-HNQ S x1=CA1,x2=MZM1,x3=ASR1,x4=$J(TSHL1,2,2),x5=AM1,x6=AM2 S KF2=1 I TSHL1 S KF2=$J(TSHL1-AM1/TSHL1,5,5) S CA2=$J(CA1*KF2-AM2,2,2) S MZM2=$J(MZM1*KF2,2,2) S ASR2=$J(ASR*KF2,2,2) S x7=CA2 S x8=MZM2 S x9=ASR2 S x10=HNQ S x11=$J(TOPAY,2,2) Q W4DMSDL W4DMSDL ; -- DOH MISSADOT LEFI LAKOHOT ; [ 07.05.20 10:59 ] [ 04.05.20 13:23 ] [ 04.03.20 10:31 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATHADTRHT) S OK=0 Q S TRHT=$$^%L1DC(DATH,1) Q ; HZM ; D GA^W4SCREF("P1HZMS",$$^W4ORD_"(HZM)") I $$^W4MSD(NMB) S OK=0 Q S MSD=$$MSDHZM^W4HZMST(HZM) I 'MSD S OK=0 Q I MSDADMSD) S OK=0 Q I $$MSDR^W4PRM=6,MSD<6000 S OK=0 ; N TSHL1,KF,KF2,AH1,AH2,AM1,AM2,TOPAY,HNQ S LKH=NMB ;$$NMB^W4HZMST(HZM) S LKH1=NAME ; $$NAME^W4HZMST(HZM) S TSHL1=TSHL-DMSH S KF=1 I TSHL S KF=$J(TSHL1/TSHL,5,5) S AH1=$$AMALA^W3R(MSD) S AH2=$$AMALACA^W3R(MSD) S AM1=$J(TSHL1*AH1/100,2,2) S AM2=$J(TSHL1*AH2/100,2,2) S HNQ=0 I $G(@$$^W4ORD@(HZM,"MYDISC")),TSHL'<0 D .S HNQ=HNH ; I $G(@$$^W4ORD@(HZM,"MYDISC")),TSHL<0 S OK=0 Q ; S TOPAY=TSHL1-AM1-AM2+HNQ S x1=TSHL1 S x2=AM1 S x3=AM2 S x4=$J(HNQ,2,2) S x5=TOPAY Q W4DMSH W4DMSH(DLV) ; [ 13.06.23 16:49 ] [ 27.07.17 13:47 ] [ N (JB,%ARG,DLV) ; S HZM=$$GETP^%W1PRM("HZM") S NMB=$$GETP^%W1PRM("NMB") I $$^W4MSD(NMB) Q DLV I $$^W4CLOSE(HZM) Q DLV I $$HZMLAK^W3HZMST(JB)["W" Q DLV ; I '$D(@$$^W4TMPORD) Q DLV ; ;;Q $$DMSH^W3HZMST(JB) ; -- 13.06.23 Q $$DMSHMSD^W3HZMST(JB) W4DMSPEC W4DMSPEC ; [ 12.11.24 18:40 ] [ 19.06.22 09:33 ] [ 23.04.18 13:48 ] N (JB,%ARG,%REM) S P1DZ=$$^W4DZ S JB=+$G(JB) D KILL^%W3DEB("W4DMSPEC") D PUT^%W3DEB("W4DMSPEC","%ARG=[%ARG") I $G(JB)="" W " JB number is not defined ! " Q ; W "
    ",! ; W "",! W " " W " " W " " W " " W " " W " ",! N N,NN,I D GLTMP K @GLTMP ; N I,N S N="" F I=1:1 S N=$O(@$$^W4GL("W4DMSPEC")@(N)) Q:N="" D .S @GLTMP@(N)=$G(@$$^W4GL("W4DMSPEC")@(N)) .S @GLTMP@(N,"I")=I ; S N=$O(@GLTMP@("")) W "" W $$LINE("1;"_N) W "",! ; F I=2:1 S N=$O(@GLTMP@(N)) Q:N="" D .W "" W $$LINE(I_";"_N) W "",! ; W "
    "_$$^%W1DICT("NPP")_""_$$^%W1DICT("CUSTCODE")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("DLVPAY")_"
    ",! W "
    ",! Q ; ; SAVEND(STAM) ; N N,PARHR,NOK D GLTMP S NOK=0 ; N N S N="" F S N=$O(@GLTMP@(N)) Q:N="" D Q:NOK .S VL=$G(@GLTMP@(N)) I '$D(^(N,"DEL")),'$$ISNUM^%L1FRM(VL) S NOK=$G(@GLTMP@(N,"I")) I NOK Q NOK ; K @$$^W4GL("W4DMSPEC") ; N N S N="" F S N=$O(@GLTMP@(N)) Q:N="" D .S VL=$G(@GLTMP@(N)) .I $D(@GLTMP@(N,"DEL")) Q .S @$$^W4GL("W4DMSPEC")@(N)=VL ; K @GLTMP ; Q 0 ; ; GLTMP S GLTMP=$$^W4MAIN("TMP") Q ; ; LINE(PRM) ; N I,LKH S I=$P(PRM,";") S LKH=$P(PRM,";",2) N GLTMP D GLTMP N ST S ST="" S ST=ST_" " ; S ST=ST_" + " S ST=ST_"
    " S ST=ST_" - " S ST=ST_" " ; S ST=ST_" " S ST=ST_$$VVLKH(I_";"_LKH) S ST=ST_" " ; N LKHAME S LKHNAME=$$LKH^W4L(LKH) S ST=ST_" " S ST=ST_"  "_$$H2U^%L1FRM(LKHNAME) S ST=ST_" " ; S ST=ST_" " S ST=ST_"" Q ST ; ; SETLKH(PRM) D PUT^%W3DEB("W4DMSPEC-SETLKH","PRM=PRM") N LKH,I,VL S LKH=$P(PRM,";") I LKH="" Q "CODENOTEXIST" S I=$P(PRM,";",2) S VL=$P(PRM,";",3) N GLTMP D GLTMP ; I $G(@GLTMP@(LKH,"I")),^("I")'=I Q "SAMECODE" I '$D(@$$^W4GL("LKH")@(LKH)) Q "CODENOTEXIST" N N S N="" F S N=$O(@GLTMP@(N)) Q:N="" D .I $G(^(N,"I"))=I,N'=LKH K @GLTMP@(N) S @GLTMP@(LKH)=VL S @GLTMP@(LKH,"I")=I N LKH1 S LKH1=$$LKH^W4L(LKH) Q "OK~"_$$H2U^%L1FRM(LKH1) ; SETDMS(PRM) D PUT^%W3DEB("W4DMSPEC-SETDMS","PRM=PRM") N LKH,I,VL S LKH=$P(PRM,";") I LKH="" Q "CODENOTEXIST" S VL=$P(PRM,";",2) N GLTMP D GLTMP I '$D(@$$^W4GL("LKH")@(LKH)) Q "CODENOTEXIST" I '$$ISNUM^%L1FRM(VL) Q "NUMBERONLY" S @GLTMP@(LKH)=VL Q "OK" ; DELROW(LKH) ; Q:$G(LKH)="" N GLTMP D GLTMP I '$D(@GLTMP@(LKH,"DEL")) S @GLTMP@(LKH,"DEL")=1 Q K @GLTMP@(LKH,"DEL") Q ; VVLKH(PRM) ; N I,VL,IDCD,IDNM S I=$P(PRM,";") S VL=$P(PRM,";",2) S IDCD="lkh"_I S IDNM="lkhnm"_I S PROC="SetCust(\'"_I_"\',\'"_IDCD_"\',\'"_IDNM_"\')" N FIND S FIND="Find('"_I_"','"_IDCD_"','"_IDNM_"','"_PROC_"')" N A S A=" " S A=A_"" Q A W4DMZPR W4DMZPR(MEDAT,ADDAT) ; DOCH HAZMANOT; [ 19.03.21 11:39 ] [ 29.11.17 11:10 ] [ 27.11.17 13:41 ] N (%ARG,JB,%REM,MEDAT,ADDAT,%REPN) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" D ^W4IN D VRM K @VRM N D1,D2 ; S D1=$$^%L1DC(MEDAT,3),D2=$$^%L1DC(ADDAT,3) ; N NN F NN=D1:1:D2 I $D(@$$^W4REF@(NN)) D .N N1 S N1="" F S N1=$O(@$$^W4REF@(NN,N1)) Q:N1="" D ..S HZM=N1,SSUM=0 N MZ,PAR ..S %SCRN=HZSCR D GA^W4SCREF(HZSCR,$$^W4ORD_"(HZM)") ..Q:$$^W4MSL(NMB) ..I '$G(@$$^W4PRM@("MLZ")) K @$$^W4GL("P1MLZ")@(HZM) D PLU1 .. ..S MZ="" F S MZ=$O(@$$^W4GL("P1MLZ")@(HZM,MZ)) Q:MZ="" D ...S PAR="" F S PAR=$O(@$$^W4GL("P1MLZ")@(HZM,MZ,PAR)) Q:PAR="" D ....N COLP,SUMP,A ....S COLP=$P($G(^(PAR)),"*"),SUMP=$P($G(^(PAR)),"*",2) ....S HNHP=$P($G(^(PAR)),"*",4) ....S SUGP=+$$SUG^W4P(PAR) ....S A=$G(@VRM@(MZ,SUGP,PAR)) ....S $P(A,"*",1)=$P(A,"*",1)+COLP ....I $E(PAR,1,2)'="A-" S $P(A,"*",2)=$P(A,"*",2)+HNHP ....S $P(A,"*",3)=$P(A,"*",3)+SUMP ....S @VRM@(MZ,SUGP,PAR)=A ; K %L1PC S %REPN("MEDAT")=MEDAT,%REPN("ADDAT")=ADDAT S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB S %REPN="W4MZPR" I $$^W4MTAW S %REPN="W4CSPR" Q:'$D(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4dmzpr.jsp?JB="_JB) Q ; PLU1 D PLU1^W4HZMPC Q ; PAR N A S A=$G(@GLOB) S x1=$P(A,"*",1),x2=$P(A,"*",2),x3=$P(A,"*",3)-x2 S PAR1=$$SHEM^W4P(PAR) Q ; VRM ; D ^%W1PCVRM Q W4DOC W4DOC ; [ 14.11.24 09:17 ] [ 24.12.23 10:06 ] [ 22.06.23 11:31 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D ^%W1ARG S W4DOC="" S NUMBER=$G(%ARG("NUMBER")) I $G(SPK) D PUT^%W1PRM("SPK",SPK) D PUT^%W1PRM("LHBCUR",NUMBER_";"_SPK) ; I $TR($G(%ARG("NUMBER")),"0123456789","")="HZ",$G(LKH)="",$G(%ARG("SPK")),NUMBER D .S LKH=%ARG("SPK"),%ARG("LKH")=%ARG("SPK") .D PUT^%W1PRM("LKH",LKH) .D PUT^%W1PRM("NUMBER",+NUMBER) .D KILL^%W1PRM("SPK") .K %ARG("SPK") ; S NOM=$$NOM(NUMBER) ; --> NOM IN ^W4DOC S NUMBER=+NUMBER ; S DAT=$$DAT(NOM) S LKH=$$LKH(NOM) ; S DOC=$$GETDOC(NOM) D PUT^%W1PRM("DOC",DOC) ; D GLTMP S GL=$$GL($G(%ARG("NUMBER"))) I $G(NUMBER) D PUT^%W1PRM("NUMBER",+NUMBER) ; I NOM,$D(@GL@(NOM))=11 D ; --- DOC NUMBER --> GLTMP .K @GLTMP .M @GLTMP=@GL@(NOM) ; D KOTHSB(NUMBER,LKH,DAT,DOC) ; W "
    ",! ; I $$MTB^W4LKH D SELMTB ; D DAF1 ; I $G(%ARG("NEWDOC")) K %ARG("NUMBER") S NOM=0,NUMBER=0 ; W "
    " W "
    ",! W "",! W "" I '$$HMKI^W4LHB D .W "" ; I $$HMKI^W4LHB D .W "" ; W "" W "" W "",! W "
    " . N SBM S SBM=$S($$INP($G(%ARG("NUMBER")))!$$HZ!$$HZMH:"SUBMIT",1:"SUBMITANDPRINT") . D ROUNDBUT^%W1JS("Submit",$$^%W1DICT(SBM),"Submit('"_NOM_"')","color:green",",,,100") .W "" . D ROUNDBUT^%W1JS("Pay",$$^%W1DICT("PAY"),"Pay('"_LKH_"')","color:green",",,,100") .W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "
    ",! ; I $$PRCCSR D DIVPRCCSR Q ; ; KOTHSB(NMB,LKH,DAT,DOC) ; D PUT^%W3DEB("W4DOC-KOTHSB","NMB=NMB&LKH=LKH&DAT=DAT&DOC=DOC") D ^W4KOTHSB(NMB,LKH,DAT,DOC) ; I $$INP,$$IHBTM(NMB) D LISTTM("GLTMP") ; --- RESHIMAT TM LE SIMUN ; I DOC="IHB"!(DOC="ITM")!(DOC="HBW")!(DOC="TM"),$G(%ARG("VD"))'="TMZ" D .W "",! .D TBORD(DOC,NOM,"HZ") .I DOC="HBW"!(DOC="TM") D TBORD(DOC,NOM,"HZMH") .W "
    ",! Q ; ; TBORD(DOC,NOM,DOCFROM) ; N ORG,SUG I $E(DOC)="I",'$G(SPK) Q I $E(DOC)="I" S ORG=SPK_"_I",SUG="I" E S ORG=LKH,SUG="O" ; W "",! W "",! N DOCNAME S DOCNAME="ORDER" I DOCFROM="HZMH" S DOCNAME="PRICEOFFER" W $$^%W1DICT(DOCNAME) W "",! ; W "" N IDORD S IDORD="order" I DOCFROM="HZMH" S IDORD="hzmh" W "",! W "",! ; W "" D ROUNDBUT^%W1JS("FindOrd",$$^%W1DICT("FIND"),"FindOrd('"_DOCFROM_"','"_ORG_"','"_DAT_"')","color:black",",,,70") W "",! ; W "" D .N PROC S PROC="ShowOrd('" .D ROUNDBUT^%W1JS("ShowOrd",$$^%W1DICT("SHOW"),PROC_ORG_"','"_DOCFROM_"')") W "",! ; N DOC S DOC=$$DOC($G(%ARG("NUMBER"))) ; I $L(DOC) D .I SUG="I",$$IHBTM(NMB) Q .I SUG="I",$D(@$$^W4GL("W4INP")@(ORG,DOC,+$G(%ARG("NUMBER")),1)) Q .I SUG="O",$D(@$$^W4GL("W4ORD")@(+$G(%ARG("NUMBER")),1)) Q ;-- ????? .W "" . N COPYTO S COPYTO="COPY2INVOICE" . I $G(DOC)="ITM" S COPYTO="COPY2DLVDOC" . D ROUNDBUT^%W1JS("Copy2Invoice",$$^%W1DICT(COPYTO),"CopyOrd2Invoice('"_DOCFROM_"','"_ORG_"')","color:darkblue",",,,140") .W "",! W "",! Q ; ; ORD(DOCFROM,ORG,NOM) ; N SUG S SUG="O" I ORG["_I" S ORG=$P(ORG,"_I"),SUG="I" D GLTMP ; N TORD S TORD=$G(@GLTMP@("ORD")) I TORD,TORD["HZMH",DOCFROM="HZMH" Q TORD I TORD,TORD["HZMH",DOCFROM'="HZMH" Q "" I TORD,TORD'["HZMH",DOCFROM="HZMH" Q "" I TORD Q TORD ; I '$G(NOM) Q "" I SUG="I" Q $G(@$$^W4GL("W4INP")@(ORG,"IHB",+NOM,"ORD")) ; N ORD S ORD=$G(@$$^W4GL("W4DOC")@(+NOM,"ORD")) I DOCFROM="HZ",ORD'["HZMH" Q ORD Q $S(ORD:+ORD,1:"") ; ; LISTTM(GL) ; N MZ,MT,N,ND W "",! W " ",! .W " ",! W "
    " N VDTM F VDTM="ITM","ITZ" D .S N="" F S N=$O(@GL@(VDTM,N)) Q:N="" D ..S ND=N S:N<0 ND=-N ..I N<0!$$IHBZ S MZ(ND)="" Q ..S MT(ND)="" ; I $D(MT) D .W $$^%W1DICT("DLVDOCLIST")_" : " .S N="" F S N=$O(MT(N)) Q:N="" D ..W "" ..W N_"" I $O(MT(N))'="" W "," .W "
    ",! ; I $D(MZ) D .W $$^%W1DICT("DLVBACKDOCLIST")_" : " .S N="" F S N=$O(MZ(N)) Q:N="" D ..W N I $O(MZ(N))'="" W "," .W "
    ",! Q ; TD W "" Q TDLTR W " ",! Q ; COLST(NOM) S NOM=$G(NOM) N GL,GLTMP S GL=$$GL D GLTMP N VL,COL,N S COL=0 ; I $$GETTMP(NOM) D Q COL .S N="" F S N=$O(@GLTMP@(N)) Q:N="" S COL=COL+1 ; Q $O(@GL@(NOM,99999),-1) ; ; SHOWPRMAM ; W "",! W " " W " ",! I $$GETP^%W1PRM("PRKUP") D .W " " .W " " I $$GETP^%W1PRM("PRKUP")=0 D .W " " ; W " ",! W "
    " W " "_$$^%W1DICT("PRICENOTINCLUDEDTAX")_" " W " " W " " .W " "_$$^%W1DICT("PRICEINCLUDEDTAX")_" " .W " " .W " " .W " "_$$^%W1DICT("CSRITEMS") .W " " .W " "_$$^%W1DICT("MLYITEMS") .W "
    ",! Q ; DAF1 ; D DAFBODY(NOM) ; D TOT(NOM) ; D SHOWTOT(NOM) ET ; W "",! ; I '$$HMKI^W4LHB D .W "

    " .W "
    ",! . N EDITCMNT S EDITCMNT="" . D DIVCMNT^W4LCBCR(NOM,0,$$CMNT(NOM),$$PRV(NOM),0) .W "
    ",! Q ; ; DAFBODY(NOM) ; N (JB,%ARG,LKH,DAT,NOM,NUMBER) ; I '$D(NOM) S NOM=0 ; I $$MLYPRT D .W "",! . W "" . W "",! . W "",! .W "
    " . W $$^%W1DICT("FORITEMSHOWPRESSKEY") . W "
    ",! ; I '$$INP D .D SHOWPRMAM .D PUT^%W1PRM("PRMAM",$$PRMAM(NOM)) ; I $$ERUA^W3PRM,$$DOC(NOM)="HZMH" D ERUADET ; W "

    ",! ; W "",! ; W "" S WD=18 ;;I $$NOTEDIT(NOM) S WD=14 W " ",! W " ",! ; I $$PRMSER D .W " ",! I $$MLYPRT D .W " ",! ; I $$COLOR D .W " ",! I $$SIZE D .W " ",! ; I '$$^W4MLQNMH D .W " ",! .W " ",! ; I $$^W4MLQNMH D .W " ",! .W " ",! ; I '$$NODISCST D .W " ",! ; W " ",! W " ",! ; I $$CMNST^W4LKH D .W " ",! ; W "",! ; S COLST=$$COLST(NOM) I COLST<5 S COLST=5 ; S (SUMBF,SUMAF)=0 ; I $G(NOM) F I=1:1:COLST+1 D LINE(NOM,I) ; I '$G(NOM) D .N I,I1,N1 S I=0,N1="" .N GLTMP D GLTMP .N N S N="" F S N=$O(@GLTMP@(N)) Q:N="" I N S I=I+1,N1=N D LINE(0,N) .I I<5 F I1=I+1:1:5 S N1=N1+1 D LINE(0,N1) Q ; ; ONKEYPRESS ; S ONKEYPRESS=" onKeyPress=""OnKeyPress(event,'"_I_"','"_NOM_"')"" " Q ; READONLY(NOM) S NOM=$G(NOM) N TX S TX="" I $$NOTEDIT(NOM) S TX=" readonly=""readonly"" " ; S TX=TX_" style=""color:"_$S($$HBZ(NOM)!$$ITZ(NOM)!$$IHBZ(NOM):"red",1:"black") I $$NOTEDIT(NOM) S TX=TX_";background-color:#eaeaea" S TX=TX_"""" Q TX ; NOTEDIT(NOM) ; N NOTEDIT S NOTEDIT=$$IHBTM(NOM) N GLTMP,MAXLINE D GLTMP S MAXLINE=$O(@GLTMP@(99999),-1) I NOTEDIT,$G(I),I>MAXLINE Q 0 Q NOTEDIT ; ; LINE(NOM,I) ; N ONKEYPRESS D ONKEYPRESS ; W "" N PRM S PRM=NOM_";"_I ; W "",! ; W "",! ; I $$PRMSER D .W " ",! ; I $$MLYPRT D .W " ",! ; I $$COLOR D .W " ",! I $$SIZE D .W " ",! ; I '$$^W4MLQNMH D .W " ",! .W " ",! ; I $$^W4MLQNMH D .W " ",! .W " ",! ; I '$$NODISCST D .W " ",! ; N BFTAX S BFTAX=$$INPBFTAX(PRM) D TDLTR W " id=""bft"_I_""">"_BFTAX_" "_$$SMBMTB_"",! S SUMBF=SUMBF+BFTAX N AFTAX S AFTAX=$$INPAFTAX(PRM) D TDLTR W " id=""aft"_I_""">"_AFTAX_" "_$$SMBMTB_"",! S SUMAF=SUMAF+AFTAX ;;W "PRM="_PRM_" BFTAX="_BFTAX_" AFTAX="_AFTAX_" SUMAF="_SUMAF_"
    ",! ; I $$CMNST^W4LKH D .W " ",! W "",! Q ; ; INPCODE(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" ; I '$$NOTEDIT(NOM) D .S ST=ST_"" ; N PREF,CD S PREF="",CD=$$CODE(NOM,I) S ST=ST_" " .S ST=ST_" " .S ST=ST_" " Q ST ; ; PRKUP(STAM) ; ;;I $$ONEGLPAR^W3PRM!$$GETP^%W1PRM("PRKUP") Q 1 I $G(%ARG("PRKUP")) Q 1 I $$GETP^%W1PRM("PRKUP") Q 1 Q 0 ; GLP(STAM) ; N GLP S GLP="PAR" I $$MLYPRT S GLP="MLPAR" Q GLP ; INPNAME(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N NAME,DIRNAME S DIRNAME=$$DIRNAME S NAME=$$SHOWNAME($$NAME(NOM,I)) N ST S ST="" Q ST ; INPSERNUM(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; GLMLEM(STAM) Q $$^W4GL("MLMIDA") ; INPEM(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,7) S:'VL VL=1 ; ;;I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$GLMLEM@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPCOLOR(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,9) ; I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$^W4GL("W4COLOR")@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPSIZE(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,10) I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$^W4GL("W4SIZE")@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPPRC(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; PRCCSR() I '$$ONEGLPAR^W3PRM Q 0 Q +$G(@$$^W4GL("W3PRM")@("PRCCSR")) ; INPQN(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; INPDISC(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; INPBFTAX(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) Q $$NUM($$BFTAX(NOM,I)) ; INPAFTAX(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) Q $$NUM($$AFTAX(NOM,I)) ; INPCMNST(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N CMNT,DIRNAME S DIRNAME=$$DIRNAME S CMNT=$$SHOWCMNST($$CMNST(NOM,I)) N ST S ST="" Q ST ; ; SHOWTOT(NOM) W "" D SPACE S AHMAM=$$AHMAM(NOM) W "" ; I '$$INP D .D TDLTR W " id=""bftot"">"_$J(SHUMLD*100/(100+AHMAM),2,2)_" "_$$SMBMTB_"" I $$INP D .D TDLTR W " id=""bftot"">"_$J(LMAM,2,2)_" "_$$SMBMTB_"" ; D TDLTR W " id=""aftot"">"_$J(SHUMLD,2,2)_" "_$$SMBMTB_"" ; W "",! ; W "" D SPACE W " " D TDLTR W " id=""tot"">"_$J($G(SHUMLD),2,2)_" "_$$SMBMTB_"" D LASTTD W "",! ; W "" D SPACE W "" W "" D LASTTD W "",! ; W "" D SPACE W "",! W "" D LASTTD W "",! ; W "" D SPACE W "" W "" D LASTTD W "",! ; I $$^W4NOIGUL D SHOWMAM I '$$^W4NOIGUL S IGUL=0 ; W "" D SPACE W " " D TDLTR W " id=""total"">"_$J(SHUM-IGUL,2,2)_" "_$$SMBMTB_"" D LASTTD W "",! ; I '$$^W4NOIGUL D .W "" . D SPACE . W "" . D TDLTR W " id=""igul"">"_$J(IGUL,2,2)_" "_$$SMBMTB_"" . D LASTTD .W "",! .; .D SHOWMAM . .W "" D SPACE . W "" . D TDLTR W " id=""itot"">"_$J($J(SHUM,0,0),2,2)_" "_$$SMBMTB_"" . D LASTTD .W "",! ; Q ; ; LASTTD ; I '$$NOTEDIT(NOM) W "",! Q ; SHOWMAM ; I $$INP Q S AHMAM=$$AHMAM(NOM)_"%" W "" D SPACE W "" D TDLTR W " id=""tax"">"_$J($G(MAM),2,2)_" "_$$SMBMTB_"" D LASTTD W "",! Q ; GETLKH(NUMBER) I $$INP($G(NUMBER)) Q $$SPK Q $$GETP^%W1PRM("LKH") ; SPK(STAM) N SPK S SPK=0 I $G(%ARG("SPK")) S SPK=%ARG("SPK") I 'SPK S SPK=$$GETP^%W1PRM("SPK") I SPK["_" S SPK=$P(SPK,"_") Q SPK ; GETDAT(STAM) Q $$SPA^%L1FRM($$GETP^%W1PRM("DAT")) ; GETDOC(NOMDOC) ; S NOMDOC=$G(NOMDOC) N VD S VD="" ; I NOMDOC,$$GLOBNAME(NOMDOC)="W4DOC" D I $L(VD) Q VD .I $D(@$$GL@(NOMDOC,"H")) S VD="HBW" Q .I $D(@$$GL@(NOMDOC,"TM")) S VD="TM" Q .I $D(@$$GL@(NOMDOC,"TMZ")) S VD="TMZ" Q .I $D(@$$GL@(NOMDOC,"TZ")) S VD="TZ" Q .I $D(@$$GL@(NOMDOC,"HMK")) S VD="HMK" Q .I $D(@$$GL@(NOMDOC,"HZMH")) S VD="HZMH" Q ; I NOMDOC,$$GLOBNAME(NOMDOC)="W4INP" Q $$DOC(NOMDOC) I NOMDOC,$$DOCNOM(NOMDOC)'="" Q $$DOCNOM(NOMDOC) ; I $G(%ARG("VD"))="HBZ" Q "TZ" I $G(%ARG("VD"))="HMKI" Q "HMK" I $L($G(%ARG("VD"))) Q %ARG("VD") I $L($G(%ARG("DOC"))) Q %ARG("DOC") I $$GETP^%W1PRM("VD")="HBZ" Q "TZ" I $$HZ^W4LHB Q "HZ" I $$TM^W4LHB Q "TM" I $$TMZ^W4LHB Q "TMZ" I $$HMKI^W4LHB Q "HMK" I $$GET^%W1PRM("VD")="ITZ" Q "ITZ" I $$GET^%W1PRM("VD")="IHZ" Q "IHZ" Q $$DOC(NOMDOC) ; ; HZ(STAM) ; Q $$HZ^W4LHB ; HZMH(STAM) ; Q $$HZMH^W4LHB ; GETPRMAM(STAM) Q $$GET^%W1PRM("PRMAM") ; PUTHD(PRM) ; N (JB,%ARG,%REM,PRM) D GLTMP S ST=PRM S TZ=$P(ST,";") S LKH=$$GETLKH D PUT^%W3DEB("W4DOC-PUTHD","ST=ST & LKH=LKH") ; I TZ,LKH D .I $$INP D PUT^W4SPK(LKH,TZ,"TZ") Q .D PUT^W4L(LKH,TZ,"TZ") ; S DISCPRC=$P(ST,";",2) S DISCNIS=$P(ST,";",3) S DMSH=$P(ST,";",4) S HRA=$$CNWEB^%L1FRM($P(ST,";",5)) S HRA=$$INVH^%L1FRM(HRA) S MTB=$P(ST,";",6) ; S $P(@GLTMP,"\",9)=$TR(HRA,"\*","/X") S $P(@GLTMP,"\",12)=DISCPRC S $P(@GLTMP,"\",13)=DISCNIS S $P(@GLTMP,"\",14)=DMSH S $P(@GLTMP,"\",15)=TZ S $P(@GLTMP,"\",18)=MTB Q ; PUT(PRM) ; N (JB,%ARG,%REM,PRM) D GLTMP S ST=PRM S SH=$P(ST,";") Q:'SH S CD=$TR($$CNWEB^%L1FRM($P(ST,";",2)),"\","/") S NAME=$$CNWEB^%L1FRM($P(ST,";",3)) I $$DIRNAME="RTL" S NAME=$$INVH^%L1FRM(NAME) S PRC=+$P(ST,";",4) S QN=+$P(ST,";",5) S DISC=+$P(ST,";",6) S SERNUM=$TR($P(ST,";",7),"\","/") S EM=$TR($P(ST,";",8),"\","/") S COLOR=$TR($P(ST,";",9),"\","/") S SIZE=$TR($P(ST,";",10),"\","/") S CMNST=$$CNWEB^%L1FRM($TR($P(ST,";",11),"\","/")) I $$DIRNAME="RTL" S CMNST=$$INVH^%L1FRM(CMNST) S EM=$$RKVG(EM) ; S @GLTMP@(SH)=CD_"\"_$TR(NAME,"\","/")_"\"_PRC_"\"_QN_"\"_DISC_"\\"_$$SPA^%L1FRM(EM) S $P(@GLTMP@(SH),"\",8)=SERNUM S COLOR=$$RKVG(COLOR) S SIZE=$$RKVG(SIZE) ; S $P(@GLTMP@(SH),"\",9)=COLOR S $P(@GLTMP@(SH),"\",10)=SIZE S $P(@GLTMP@(SH),"\",11)=CMNST Q ; ; RKVG(RKV) D .I RKV?1N.N.E S RKV=$P(RKV," ")_" "_$$INVH^%L1FRM($P(RKV," ",2,20)) Q .S RKV=$$INVH^%L1FRM(RKV) Q RKV ; ; SUBMIT(PRM,PR) ; -- SAVE NEW N (JB,%ARG,%REM,PRM,PR) ; D GLTMP S TMP=($G(PR)="TMP") D PUT^%W3DEB("W4DOC-SUBMIT","PRM=PRM & PR=PR & TMP=TMP") ; S NOM=$P(PRM,";",1) I NOM="KUP" D .S NOM=$O(@$$^W4GL("W4TMKUP"))+1 .S @$$^W4GL("W4TMKUP")=NOM ; S ORD=$P(PRM,";",2) S PRMAM=0 I '$$INP S PRMAM=$P(PRM,";",3) S TZ=$P(PRM,";",4) ; S HRA=$P(PRM,";",5) S HRA=$$CNWEB^%L1FRM(HRA) S PRV=$P(HRA,"~",2) S HRA=$P(HRA,"~") S HRA=$$INVH^%L1FRM(HRA) ; S DISCPRC=$P(PRM,";",6) S DISCNIS=$P(PRM,";",7) S DMSH=$P(PRM,";",8) S MTB=$P(PRM,";",9) ; S ERUADATE=$P(PRM,";",10) S ERUATIME=$P(PRM,";",11) S GUESTS=$P(PRM,";",12) S MAZMIN=$$INVH^%L1FRM($P(PRM,";",13)) S PELEMAZMIN=$P(PRM,";",14) ; S COLST=$$COLST(NOM) S SHUM=$P(PRM,";",15) S DATI=$P(PRM,";",16) S DATP=$P(PRM,";",17) ; S LKH=$$LKH(NOM) S DAT=$$DAT(NOM) S LKH1=$$LKHNAME(NOM) S KTV=$$KTV(NOM) ; I '$L(TZ),$$GETDOC(NOM)="HBW",$$PRMTZMAM,SHUM'<$$PRMTZMAM Q "NOTTZ" I TZ?1N.N,TZ,'$$^W4TZ(TZ) Q "ERRTZ" I '$$INP,'$$TZ^W4L(LKH),TZ D PUT^W4L(LKH,TZ,"TZ") ; I PRMAM="",'$$INP S PRMAM=$$GETPRMAM ; SBMTV ; N GL S GL=$$GL S NMBDOC=0 ; I 'TMP D .I 'NOM S NMBDOC=$$LASTNOM+1 ; --- IF NEW . .I $G(NOM) D ..N DATOLD,DT,VDOC ..S DATOLD=$$DAT(NOM) D PUT^%W3DEB("W4DOC-SUBMIT","DATOLD=DATOLD&NOM=NOM") ..D ...S DT=$$^%L1DC(DATOLD,3) ...S VDOC=$$DOC(NOM) ... ...I $$INP(NOM) D ; ----- DELETE PREVIOUS VERSION OF DOCUMENT ....D KILL^W4INPDIR(DT,LKH,VDOC,+NOM) ....I VDOC="IHZ"!(NOM["IHZ") Q ....I VDOC="IHBZ"!(NOM["IHBZ"),$D(@$$^W4GL("W4INP")@($$SPK,"IHBZ",+NOM,"ITZ")) Q ....I VDOC="IHB"!(NOM["IHB"&(NOM'["IHBZ")),$D(@$$^W4GL("W4INP")@($$SPK,"IHB",+NOM,"ITM")) Q ....D ^W4SETMLY(DT,VDOC,LKH,+NOM,-1) .. ..;;I $$HZ(NOM) D ; ----- DELETE PREVIOUS VERSION OF DOCUMENT ...N NUMBER S NUMBER=+$$GETP^%W1PRM("NUMBER") ...S @$$^W4GL("W4ORD")@(+NOM,"NUMBER")=NUMBER ...D KILL^W4ORDD(LKH,+NUMBER) .. ..S NMBDOC=NOM . .N GL0 S GL0=$E(GL,1,$L(GL)-1) .N I F I=1:1 Q:'$D(@GL@(NMBDOC,I)) K @GL@(NMBDOC,I) D ..D ^%S2GLSV(GL0_","""_NMBDOC_""","_I_")",$$^W4FGIB,"K") ; S (SSUMBF,SSUMAF)=0 S AHMAM=$$AHMAM(0) ; ; --------------------- SAVING ----------------------------- N AHMAM1,INP S INP=$$INP N N,I,SQN S N="",I=0,SQN=0 F S N=$O(@GLTMP@(N)) Q:N="" I N D .N ST S ST=$G(^(N)) .N QN,PRC,DISC,NAME,CD .S CD=$$CODE(0,N) .S QN=$$QN(0,N),PRC=$$PRC(0,N),DISC=$$DISC(0,N),NAME=$$NAME(0,N) .S MAMCD=$$MAM^W4DMAM(CD) .I 'QN,'PRC,'DISC,$L(NAME)=0 Q .S SQN=SQN+QN .S AHMAM1=$S(MAMCD:AHMAM,1:0) . .I 'TMP S I=I+1,@GL@(NMBDOC,I)=$G(@GLTMP@(N)) ; --- !!!!!!-- SAVING --!!!!!!!!! . .I '$$INP,PRMAM D ..S SUMAF=$J(QN*PRC*(100-DISC)*.01,2,2) ..S SUMBF=$J(SUMAF*100/(100+AHMAM1),2,2) . .I 'PRMAM!$$INP D ..S SUMBF=$J(QN*PRC*(100-DISC)*.01,2,2) ..S SUMAF=$J(SUMBF*(100+AHMAM1)*.01,2,2) . .S SSUMBF=SSUMBF+SUMBF .S SSUMAF=SSUMAF+SUMAF ; N BELONG I $G(ORD),ORD'["HZMH" S BELONG=$$BELONG($$^W4ORDD(LKH,ORD),$$DOC(NOM),NMBDOC) I BELONG Q "ORDBELONG2DOC;"_BELONG I $G(ORD),ORD["HZMH" S BELONG=$$BELONG(ORD,$$DOC(NOM),NMBDOC) I BELONG Q "ORDBELONG2DOC;"_BELONG ; I $G(ORD) D SETORD ; S SUMTD=(SSUMAF*(100-DISCPRC)*.01)-DISCNIS+DMSH I 'SQN,'SSUMAF,'SUMTD Q "NODATA!" ; S IGUL=0 I '$$^W4NOIGUL D .S IGUL=$J($J(SUMTD,0,0)-$J(SUMTD,2,2),2,2) .S SUMTD=$J($J(SUMTD,0,0),2,2) ; ;;S MAM=(SSUMAF-SSUMBF)+((SUMTD-SSUMAF)*AHMAM/(100+AHMAM)) S MAM=(SSUMAF-SSUMBF) ;;W "SSUMAF="_SSUMAF_" SSUMBF="_SSUMBF_" SUMTD="_SUMTD,! I SSUMAF S MAM=$J(MAM*SUMTD/SSUMAF,2,2) ; S MAM=$J(MAM,2,2) ; D PUT^%W3DEB("W4DOC-SUBMIT","SSUMBF=SSUMBF & SSUMAF=SSUMAF & SUMTD=SUMTD & IGUL=IGUL & MAM=MAM") ; I 'TMP L +@GL@(NMBDOC):1 ; N STHD I $$INP S DAT=DATI S STHD=LKH_"\"_$TR(LKH1,"\","/")_"\"_$TR(KTV,"\","/")_"\"_DAT_"\"_AHMAM_"\"_SUMTD_"\"_MAM_"\"_$ZD($H,"DD.MM.YY 24:60")_"\"_$TR(HRA,"\","/")_"\"_IGUL_"\"_PRMAM_"\"_DISCPRC_"\"_DISCNIS_"\"_DMSH_"\"_$TR(TZ,"\","/")_"\"_PRV ; N VDOC S VDOC=$$GETDOC(NOM) ; I $$INP D .I $G(DATP) S $P(STHD,"\",17)=DATP .N STHD0 I $G(NMBDOC) S STHD0=$G(@GL@(NMBDOC)) .S $P(STHD,"\",19)=$P(STHD0,"\",19) .S $P(STHD,"\",20)=$P(STHD0,"\",20) . .I VDOC="IHB"!(VDOC="IHBZ") D SETITRA^W4SPK(LKH,SUMTD) ; S $P(STHD,"\",18)=MTB S $P(STHD,"\",21)=$$PRKUP ; S $P(STHD,"\",22)=ERUADATE S $P(STHD,"\",23)=ERUATIME S $P(STHD,"\",24)=GUESTS S $P(STHD,"\",25)=MAZMIN S $P(STHD,"\",26)=PELEMAZMIN ; D PUT^%W3DEB("W4DOC-SUBMIT","STHD=STHD&NMBDOC=NMBDOC") ; I 'TMP D ; -------- SAVING .S @GL@(NMBDOC)=STHD . .I VDOC="IHB"!(VDOC="IHBZ"),$D(@GLTMP@("ITM"))>9!($D(@GLTMP@("ITZ"))>9) D ..N VDTM,VDTM1,TM1 F VDTM="ITM" D ..N TM S TM="" F S TM=$O(@GLTMP@(VDTM,TM)) Q:TM="" D ...S VDTM1=VDTM,TM1=TM I TM<0 S VDTM1="ITZ",TM1=-TM ...I VDOC="IHBZ" S VDTM1="ITZ" ...K @$$^W4GL("W4FREEDOC")@(LKH,VDTM1,TM1) ; LKH=SPK ...S @GL@(NMBDOC,"ITM",TM)="" ...I $L(VDOC) S @$$^W4GL("W4INP")@(LKH,VDTM1,TM1,VDOC)=NMBDOC . .K @GLTMP ; ---------- DELETE ! ; I TMP S @GLTMP=STHD ; S NOMHSB=0 N DT S DT=$$^%L1DC(DAT,3) ; I 'TMP D .I VDOC="HBW" D SVHBW Q . .I $$HBZ D SVHBZ Q . .I VDOC="TM"!(VDOC="TMZ") D SVTM Q . .I VDOC="HZMH",'NOM D SVHZMH Q .I VDOC="HZMH" S NOMHSB=+$$GETP^%W1PRM("NUMBER") . .I VDOC="HZ" D ..S @GL@(NMBDOC,"MKR")=$H ..N NUMBER S NUMBER=+$$GETP^%W1PRM("NUMBER") ..S NOMHSB=NUMBER ..D SET^W4ORDD(LKH,NUMBER,NMBDOC) ; I 'TMP,$$INP D .S NOMHSB=NMBDOC .D SET^W4INPDIR(DT,LKH,VDOC,NMBDOC) ; I 'TMP,VDOC'="HZMH",VDOC'="HZ" D .D PUT^%W3DEB("W4DOC-SUBMIT-SETMLY","DT=DT&VDOC=VDOC&LKH=LKH&NMBDOC=NMBDOC") .N VD S VD=$S($$INP:VDOC,1:"OUT") .D ^W4SETMLY(DT,VD,LKH,NMBDOC) ; L ; SUBMITE ; K @$$^W4MAIN("VRM") Q NOMHSB_$S($$HBZ:"Z",VDOC="TM":"T",VDOC="TMZ":"TMZ",VDOC="HZ":"HZ",VDOC="ITM":"ITM",VDOC="IHB":"IHB",VDOC="ITZ":"ITZ",VDOC="IHZ":"IHZ",VDOC="IHBZ":"IHBZ",VDOC="HZMH":"HZMH",1:"") ; ; SETORD ; I $D(@GL@(NMBDOC))=11 S @GL@(NMBDOC,"ORD")=ORD ; I $$INP,$D(@$$^W4GL("W4INP")@($$SPK,"IHZ",ORD,1)) D Q .N DOC S DOC=$$DOC(NMBDOC) Q:DOC="" .S @$$^W4GL("W4INP")@($$SPK,"IHZ",ORD,DOC)=NMBDOC ; I '$$INP D .N LKH S LKH=$$GETP^%W1PRM("LKH") Q:LKH="" . .I ORD'["HZMH" D ..N NOMORD S NOMORD=$$^W4ORDD(LKH,ORD) Q:'NOMORD ..I $D(@$$^W4GL("W4ORD")@(NOMORD,1)) D ...S $P(@$$^W4GL("W4ORD")@(NOMORD),"\",20)=NMBDOC . .I ORD["HZMH" D ..N ORDN S ORDN=+ORD ..N NOMORD S NOMORD=$G(@$$^W4GL("W4DIR")@("HZMH",ORDN)) Q:'NOMORD ..S $P(@$$^W4GL("W4DOC")@(NOMORD),"\",20)=NMBDOC Q ; ; SVDOC(VD,NMBDOC) ; S NOMHSB=$$^W4NEWNMB(VD) ; L +@GL@(NMBDOC):1 S @GL@(NMBDOC,VD)=NOMHSB S @GL@(NMBDOC,VD,"MKR")=$H D ^%S2GLSV(GL_"("""_NMBDOC_""","""_VD_""")",$$^W4FGIB) L -@GL@(NMBDOC) ; L +@$$^W4GL("W4DIR")@(VD,NOMHSB):1 S @$$^W4GL("W4DIR")@(VD,NOMHSB)=NMBDOC L -@$$^W4GL("W4DIR")@(VD,NOMHSB) ; N VD1 S VD1=VD I $$HBZ S VD1=VD_"Z" D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD1_""","_NOMHSB_")",$$^W4FGIB) D W4DIRD(DT,NMBDOC) Q ; ; SVHBW ;-- INPUT: NMBDOC,DT,LKH,DAT,SUMTD N VDOC S VDOC="H" D SVDOC(VDOC,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,"H","0H") D PUT^%W1PRM("MKRYD",NOMHSB_$$GETDOC) Q ; SVHBZ ;-- INPUT: NMBDOC,LKH,DAT,SUMTD N VD S VD=$$GETDOC D HBMIN(NMBDOC) D SVDOC(VD,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0D") D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q ; SVTM ;-- INPUT: NMBDOC,LKH,DAT,SUMTD N VD S VD=VDOC D SVDOC(VD,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0H") ; I VDOC="TM" D .N NOMDOC S NOMDOC=$$^W4NOMTD(NOMHSB,VDOC) .L +@$$^W4GL("P1HL3")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1I")@(NOMDOC):1 .S @$$^W4GL("P1HL3")@(LKH,NOMDOC)=$$^%L1DC(DAT,3)_"*"_SUMTD_"*"_DAT_"*"_$ZD($H,"24:60")_"**"_$TR(LKH1,"\*","/X")_"*"_AHMAM_"*"_MAM .S @$$^W4GL("P1HL1")@(LKH,NOMDOC)=@$$^W4GL("P1HL3")@(LKH,NOMDOC) .S @$$^W4GL("P1HL1I")@(NOMDOC,LKH)="" .D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD_""","_NOMHSB_")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL3")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1I")_"("""_NOMDOC_""")",$$^W4FGIB) ; I VDOC="TMZ" D .N NOMDOC S NOMDOC=$$^W4NOMTD(NOMHSB,VDOC) .L +@$$^W4GL("P1HL4")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1I")@(NOMDOC):1 .S @$$^W4GL("P1HL4")@(LKH,NOMDOC)=$$^%L1DC(DAT,3)_"*"_-SUMTD_"*"_DAT_"*"_$ZD($H,"24:60")_"**"_$TR(LKH1,"\*","/X")_"*"_AHMAM_"*"_-MAM .S @$$^W4GL("P1HL1")@(LKH,NOMDOC)=@$$^W4GL("P1HL4")@(LKH,NOMDOC) .S @$$^W4GL("P1HL1I")@(NOMDOC,LKH)="" .D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD_""","_NOMHSB_")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL4")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1I")_"("""_NOMDOC_""")",$$^W4FGIB) ; D PUT^%W1PRM("MKRYD",NOMHSB_$$GETDOC) Q ; ; SVHZMH ; N VD S VD="HZMH" D SVDOC(VD,NMBDOC) D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q ; PUTHMK(STAM) ; N GL,GLTMP,NMBDOC,NOMHSB S GL=$$GL D GLTMP S NMBDOC=$$LASTNOM+1 N VD S VD="HMK" ; N N,I S N="",I=0 F S N=$O(@GLTMP@(N)) Q:N="" D .N ST S ST=$G(^(N)) .S I=I+1,@GL@(NMBDOC,I)=@GLTMP@(N) ; S @GL@(NMBDOC)=$G(@GLTMP) ; S NOMHSB=$$^W4NEWNMB(VD) ; I $$GETP^%W1PRM("ELPOS") D .L +@$$^W4GL("P1HB")@(NOMHSB):1 .N DT S DT=+$H .S @$$^W4GL("P1HB")@(NOMHSB)="W"_NMBDOC_"\"_DT_"\"_$H .S @$$^W4GL("P1HBI")@(DT,NOMHSB)=$H .L ; ; S @GL@(NMBDOC,VD)=NOMHSB S @GL@(NMBDOC,VD,"MKR")=$H ; D ^%S2GLSV(GL_"("_+NMBDOC_")",$$^W4FGIB) ; L +@$$^W4GL("W4DIR")@(VD,NOMHSB):1 S @$$^W4GL("W4DIR")@(VD,NOMHSB)=NMBDOC L -@$$^W4GL("W4DIR")@(VD,NOMHSB) D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD_""","""_NOMHSB_""")",$$^W4FGIB) ; D W4DIRD(+$H,NMBDOC) ; N LKH,DAT,SUMTD S LKH=$$LKH(NMBDOC) S DAT=$$DAT(NMBDOC) S SUMTD=$$SUMTD(NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0") ; N DT S DT=$$^%L1DC(DAT,3) D PUT^%W3DEB("W4DOC-SUBMIT-PUTHMK","DT=DT&VDOC=VDOC&LKH=LKH&NMBDOC=NMBDOC") N VD S VD=$S($$INP:"VDOC",1:"OUT") D ^W4SETMLY(DT,VD,LKH,NMBDOC) ; D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q NMBDOC_";"_NOMHSB ; ; GL(NUMBER) ; I '$$INP($G(NUMBER)) Q $$^W4GL($$GLOBNAME($G(NUMBER))) Q $$^W4GL($$GLOBNAME($G(NUMBER)))_"("""_$$GETLKH($G(NUMBER))_""","""_$$DOC($G(NUMBER))_""")" ; GLOBNAME(NUMBER) I $$INP($G(NUMBER)) Q "W4INP" I $$DOC(NUMBER)="HZ" Q "W4ORD" Q "W4DOC" ; GLTMP ; S GLTMP=$$^W4MAIN("TMPHBK") Q ; GLHR ; S GLHR=$$GL_"(NMBDOC,""CMNT"")" Q ; ; GET(NOM,SH,NRZ) N GL,GLTMP S GL=$$GL D GLTMP N VL ; I $$GETTMP(NOM) D Q VL .N GLTMP D GLTMP .S VL=$P($G(@GLTMP@(SH)),"\",NRZ) ; S VL=$P($G(@GL@(NOM,SH)),"\",NRZ) Q VL ; ; CODE(NOM,SH) ; Q $TR($$GET(NOM,SH,1),"*?","") ; NAME(NOM,SH) ; Q $$GET(NOM,SH,2) ; PRC(NOM,SH) ; Q $J($$GET(NOM,SH,3),2,2) ; QN1(NOM,SH) ; Q $$GET(NOM,SH,4) ; DISC(NOM,SH) ; Q $$GET(NOM,SH,5) ; EM(NOM,SH) ; Q $$GET(NOM,SH,7) ; SERIAL(NOM,SH) ; Q $$GET(NOM,SH,8) ; CLR(NOM,SH) ; Q $$GET(NOM,SH,9) ; SZ(NOM,SH) ; Q $$GET(NOM,SH,10) ; CMNST(NOM,SH) ; Q $$GET(NOM,SH,11) ; QN(NOM,SH) ; N QN S QN=$$QN1(NOM,SH) I $$HBZ(NOM),$G(NOM) S QN=-QN Q QN ; BFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " N CD S CD=$$CODE(NOM,SH) I $$PRMAM(NOM) Q $J($$SUMST(NOM,SH)*100/(100+$$AHMAMP(NOM,CD)),2,2) Q $J($$SUMST(NOM,SH),2,2) ; ; AFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " ; N CD S CD=$$CODE(NOM,SH) I '$$PRMAM(NOM) Q $J($$SUMST(NOM,SH)*(100+$$AHMAMP(NOM,CD))*.01,2,2) Q $J($$SUMST(NOM,SH),2,2) ; ; SUMST(NOM,SH) Q $J($$QN(NOM,SH)*$$PRC(NOM,SH)*(100-$$DISC(NOM,SH))*.01,2,2) ; LASTNOM(STAM) Q $O(@GL@(999999),-1) ; LKH(NOM) ; S NOM=$G(NOM) I 'NOM!$$INP Q $$GETLKH(NOM) N LKH S LKH=$P($G(@$$GL@(NOM)),"\",1) I LKH="" Q $$GETLKH(NOM) Q LKH ; LKHNAME(NOM) ; N LKH S LKH=$$LKH(NOM) I '$G(NOM),$$INP Q $$NAME^W4SPK(LKH) I '$G(NOM),'$$INP Q $$LKH^W4L(LKH) N LKHNAME S LKHNAME=$P($G(@$$GL@(NOM)),"\",2) I $$INP,LKHNAME="" Q $$NAME^W4SPK(LKH) Q LKHNAME ; KTV(NOM) ; N LKH S LKH=$$LKH(NOM) I '$G(NOM),$$INP Q $$KTVMM^W4SPK(LKH) I '$G(NOM),'$$INP Q $$KTVMM^W4L(LKH) N KTV S KTV=$P($G(@$$GL@(NOM)),"\",3) I $$INP,KTV="" Q $$KTVMM^W4SPK(LKH) Q KTV ; DAT(NOM) ; I $$IHBTM(NOM),$G(%ARG("DAT")) Q $$^%L1DC($G(%ARG("DAT")),".") I '$G(NOM) Q $$GETDAT N DAT N GLOB S GLOB=$$GL D PUT^%W3DEB("W4DOC-DAT","GLOB=GLOB & NOM=NOM") S DAT=$$SPA^%L1FRM($P($G(@GLOB@(NOM)),"\",4)) I DAT="",$$INP Q $$GETDAT Q DAT ; AHMAM(NOM) ; I '$G(NOM) Q $G(@$$^W4PRM@("MAM")) N AHMAM S AHMAM=$P($G(@$$GL@(NOM)),"\",5) I AHMAM="" Q $G(@$$^W4PRM@("MAM")) Q AHMAM ; AHMAMP(NOM,CD) ; I $$INP,'$$MLMAM^W4MLPRT(CD) Q 0 Q $$AHMAM($G(NOM)) ; SUMTD(NOM) ; N SUMTD D GLTMP ;;I '$G(NOM) Q "" I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",6) S SUMTD=$P($G(@$$GL@(NOM)),"\",6) ; I $$HBZ(NOM),$G(NOM) S SUMTD=-SUMTD Q SUMTD ; MAM(NOM) ; N MAM D GLTMP ;;I '$G(NOM) Q "" I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",7) S MAM=$P($G(@$$GL@(NOM)),"\",7) I NOM,$$HBZ(NOM) S MAM=-MAM Q MAM ; KMAM(NOM) ; N AHMAM S AHMAM=$$AHMAM(NOM) N SUM S SUM=$$SUMTD(NOM) N MAM S MAM=$$MAM(NOM) N AHR S AHR="" I SUM'>MAM Q AHR S AHR=MAM*100/(SUM-MAM) I 'AHMAM Q 0 Q $J(AHR/AHMAM,4,4) ; ISSUE(NOM) ; I '$G(NOM) Q $ZD($H,"DD.MM.YY") Q $P($G(@$$GL@(NOM)),"\",8) ; CMNT(NOM) ; N GLTMP D GLTMP I $$GETTMP(NOM) Q $$H2U^%L1FRM($P($G(@GLTMP),"\",9)) Q $$H2U^%L1FRM($P($G(@$$GL@(NOM)),"\",9)) ; PRV(NOM) ; N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",16) Q $P($G(@$$GL@(NOM)),"\",16) ; IGUL(NOM) ; I '$G(NOM) Q "" D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",10) S IGUL=$P($G(@$$GL@(NOM)),"\",10) I $G(NOM),$$HBZ(NOM) S IGUL=-IGUL Q IGUL ; PRMAM(NOM) ; I $$INP Q 0 I '$G(NOM) Q $S($G(%ARG("PRMAM"))="":$$PRMAM^W4LKH,1:$G(%ARG("PRMAM"))) Q $P($G(@$$GL@(NOM)),"\",11) ; DISCPRC(NOM) ; N AHTMP,GLTMP D GLTMP S AHTMP=$P($G(@GLTMP),"\",12) I '$$INP,AHTMP="",$$AH^W4L($$LKH(NOM)) S AHTMP=$$AH^W4L($$LKH(NOM)) I $$GETTMP(NOM) Q AHTMP Q $P($G(@$$GL@(NOM)),"\",12) ; DISCNIS(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",13) N DISCNIS S DISCNIS=$P($G(@$$GL@(NOM)),"\",13) I $G(NOM),$$HBZ(NOM) S DISCNIS=-DISCNIS Q DISCNIS ; DMSH(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",14) N DMSH S DMSH=$P($G(@$$GL@(NOM)),"\",14) I $G(NOM),$$HBZ(NOM) S DMSH=-DMSH Q DMSH ; TZ(NOM) ; N TZ N GLTMP D GLTMP I '$G(NOM),$G(%ARG("LKH")) D Q TZ .S TZ=$$TZ^W4L(%ARG("LKH")) I '$G(NOM),$G(%ARG("SPK")) D Q TZ .S TZ=$$TZ^W4SPK(%ARG("SPK")) I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",15) Q $P($G(@$$GL@(NOM)),"\",15) ; MTB(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",18) N MTB S MTB=$P($G(@$$GL@(NOM)),"\",18) Q MTB ; PRKUPDOC(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",21) N PRKUP S PRKUP=$P($G(@$$GL@(NOM)),"\",21) Q PRKUP ; GUESTS(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",24) N GUESTS S GUESTS=$P($G(@$$GL@(NOM)),"\",24) Q GUESTS ; MAZMIN(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",25) N MAZMIN S MAZMIN=$P($G(@$$GL@(NOM)),"\",25) Q MAZMIN ; PELEMAZMIN(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",26) N PELEMAZMIN S PELEMAZMIN=$P($G(@$$GL@(NOM)),"\",26) Q PELEMAZMIN ; HRA(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",9) Q $P($G(@$$GL@(NOM)),"\",9) ; ERUADATE(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",22) Q $P($G(@$$GL@(NOM)),"\",22) ; ERUATIME(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",23) Q $P($G(@$$GL@(NOM)),"\",23) ; DIRNAME() Q $$DIRNAME^W3PRM ; SHOWNAME(NAME) ; I $$DIRNAME="RTL" Q $$H2U^%L1FRM(NAME) Q NAME ; SHOWCMNST(TXT) ; I $$DIRNAME="RTL" Q $$H2U^%L1FRM(TXT) Q TXT ; NUM(RKV) I '$G(RKV) Q " " Q RKV ; SPACE D TDN,TDN I $$PRMSER D TDN I $$MLYPRT D TDN I $$COLOR D TDN I $$SIZE D TDN D TDN,TDN Q ; PRMTZMAM(STAM) ; Q $$PRMTZMAM^W4HSBYAD ; NOM(NUMBER) ; N VD S VD="H" N NOM I '$G(NUMBER) Q 0 I $TR(NUMBER,"1234567890","")="T" S NUMBER=+NUMBER,VD="TM" I $TR(NUMBER,"1234567890","")="TMZ" S NUMBER=+NUMBER,VD="TMZ" I $TR(NUMBER,"1234567890","")="Z" S NUMBER=+NUMBER,VD="TZ" I $TR(NUMBER,"1234567890","")="HZ" S NUMBER=+NUMBER,VD="HZ" I $TR(NUMBER,"1234567890","")="HMK" S NUMBER=+NUMBER,VD="HMK" I $TR(NUMBER,"1234567890","")="ITM"!($$DOC="ITM") S NUMBER=+NUMBER,VD="ITM" I $TR(NUMBER,"1234567890","")="ITZ"!($$DOC="ITZ") S NUMBER=+NUMBER,VD="ITZ" I $TR(NUMBER,"1234567890","")="IHZ"!($$DOC="IHZ") S NUMBER=+NUMBER,VD="IHZ" I $TR(NUMBER,"1234567890","")="IHB"!($$DOC="IHB") S NUMBER=+NUMBER,VD="IHB" I $TR(NUMBER,"1234567890","")="IHBZ"!($$DOC="IHBZ") S NUMBER=+NUMBER,VD="IHBZ" I $TR(NUMBER,"1234567890","")="HZMH" S NUMBER=+NUMBER,VD="HZMH" ; I VD="ITM"!(VD="IHB")!(VD="ITZ")!(VD="IHBZ")!(VD="IHZ") D PUT^%W1PRM("DOC",VD) Q NUMBER ; I VD="HZ" D Q NOM .S NOM=0 N LKH S LKH=$$GETP^%W1PRM("LKH") Q:LKH="" .S NOM=$$^W4ORDD(LKH,NUMBER) .D PUT^%W1PRM("DOC",VD) ; S NOM=$G(@$$^W4GL("W4DIR")@(VD,NUMBER)) I NOM="" S NOM=$P($G(@$$^W4GL("KLIN")@(VD,NUMBER)),"W",2) Q NOM ; ; TOT(NOM) ; N GLTMP S MAM=$$MAM(NOM) S AHMAM=$$AHMAM(NOM) ; S SHUM=$$SUMTD(NOM) ; S DISCPRC=$$DISCPRC(NOM) S DISCNIS=$$DISCNIS(NOM) S DMSH=$$DMSH(NOM) S IGUL=$$IGUL(NOM) ; S SHUMLD=SHUM-IGUL-DMSH+DISCNIS N SHUMLD0 S SHUMLD0=SHUMLD I DISCPRC<100 S SHUMLD=$J(SHUMLD*100/(100-DISCPRC),2,2) S DISCA=$J(SHUMLD-SHUMLD0,2,2) ; S LMAM=SHUM-MAM S BFMAM=0 I SHUM S BFMAM=$J(LMAM*(SHUMLD/SHUM),2,2) Q ; ; INIT ; D ^%W1ARG,^W3CSS,GLTMP I $G(FIRST) K @GLTMP I $G(NUMBER),$$IHBTM(NUMBER) Q ; D PUT^%W1PRM("LKH",$G(LKH)) D PUT^%W1PRM("SPK",$G(SPK)) D PUT^%W1PRM("DAT",$$SPA^%L1FRM($G(DAT))) D PUT^%W1PRM("DOC",$G(DOC)) S $P(@GLTMP,"\")=$G(LKH) S $P(@GLTMP,"\",2)=$G(LKH1) S $P(@GLTMP,"\",3)=$G(KTV) S $P(@GLTMP,"\",4)=$G(DAT) S $P(@GLTMP,"\",5)=$G(AHMAM) Q ; DEL(SH) ; D PUT^%W3DEB("W4DOC-DEL","SH=SH") N GLTMP D GLTMP D DEL^%L1GSEQ(GLTMP,SH) Q ; HBMIN(NOMDOC) ; N I,J F I=1:1 Q:'$D(@GL@(NOMDOC,I)) D .S $P(^(I),"\",4)=-$P(^(I),"\",4) F J=6,7,10,13,14 D .S $P(@GL@(NOMDOC),"\",J)=-$P($G(@GL@(NOMDOC)),"\",J) Q ; HBZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="TZ" Q 1 Q 0 ; IHBZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="IHBZ" Q 1 I $$GETDOC(NOM)="[-]" Q 1 Q 0 ; IHZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="IHZ" Q 1 Q 0 ; ITM(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="ITM" Q 1 Q 0 ; ITZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="ITZ" Q 1 Q 0 ; TMZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="TMZ" Q 1 Q 0 ; RED(STAM) ; Q "color:"_$S($$HBZ($G(NOM))!$$ITZ($G(NOM)):"black",1:"red") ; NORED(STAM) ; Q "color:"_$S($$HBZ($G(NOM))!$$ITZ($G(NOM)):"red",1:"black") ; W4DIRD(DT,NOMDOC) ; S NOMDOC=+NOMDOC L +@$$^W4GL("W4DIRD")@(DT):1 S @$$^W4GL("W4DIRD")@(DT,NOMDOC)=$H L -@$$^W4GL("W4DIRD")@(DT) D ^%S2GLSV($$^W4GL("W4DIRD")_"("_DT_","""_NOMDOC_""")",$$^W4FGIB) Q ; PRMSER(STAM) ; Q $$SERNUM^W3PRM ; INP(NUMBER) ; Q ($E($$DOC($G(NUMBER)))="I") ; MLYPRT(STAM) ; I $$INP Q 1 I $$GETP^%W1PRM("ELPOS")&'$$GETP^%W1PRM("PRKUP") Q 1 Q 0 ; DOCNOM(NUMBER) ; I $G(NUMBER),$TR(NUMBER,"1234567890","")="ITM" Q "ITM" I $G(NUMBER),$TR(NUMBER,"1234567890","")="ITZ" Q "ITZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHZ" Q "IHZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHB" Q "IHB" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHBZ" Q "IHBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="[-]" Q "IHBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="Z" Q "HBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="T" Q "TM" I $G(NUMBER),$TR(NUMBER,"1234567890","")="TMZ" Q "TMZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="HZ" Q "HZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="HZMH" Q "HZMH" Q "" ; DOC(NUMBER) ; N D S D="" I $G(NUMBER),$L($TR(NUMBER,"1234567890","")) S D=$$DOCNOM(NUMBER) I D'="" Q D ; I $L($G(%ARG("DOC"))) S D=%ARG("DOC") I $G(D)="" S D=$$GETP^%W1PRM("DOC") Q D ; IHBTM(NOM) ; I $G(%ARG("IHBTM")) Q 1 I '$G(NOM) Q 0 D GLTMP I $D(@GLTMP@("ITM"))>9 Q 1 I $D(@$$GL@(NOM,"ITM"))>9 Q 1 I $D(@$$GL@(NOM,"ITZ"))>9 Q 1 Q 0 ; GETTMP(NOM) ; D GLTMP I '$G(NOM) Q 1 I $$INP,$D(@GLTMP)=11 Q 1 Q 0 ; ; COPYORD2INVOICE(PRM) ; D PUT^%W3DEB("W4DOC-COPYORD","PRM=PRM") N ORG,NOMORD,NOM,SUG,I,PRMAM,NUMBER,NOM,NUMBERORD,DOC ; S ORG=$P(PRM,";",1),SUG="O" I ORG["_I" S ORG=$P(ORG,"_I"),SUG="I" ; S NUMBERORD=$P(PRM,";",2) S NUMBER=$P(PRM,";",3) S NOMORD=NUMBERORD S PRMAM=$P(PRM,";",4) S DOC=$P(PRM,";",5) ; I SUG="O" D .I DOC="HZ" S NOMORD=$$^W4ORDD(ORG,NUMBERORD) .I DOC="HZMH" S NOMORD=$G(@$$^W4GL("W4DIR")@(DOC,+NUMBERORD)) ; I $$INP S PRMAM=0 ; I 'NOMORD Q "NOORD" I SUG="I",'NUMBER Q "NOHB" ; S NOM=$$NOM(NUMBER) ; N W4INP,W4ORD S W4INP=$$^W4GL("W4INP") S W4ORD=$$^W4GL("W4ORD") I DOC="HZMH" S W4ORD=$$^W4GL("W4DOC") N VD S VD=DOC ;; S VD=$$GETP^%W1PRM("DOC") ; I SUG="I",$L(VD),$D(@W4INP@(ORG,VD,NOM,1)) Q "DOCEXIST" I SUG="O",NOM,$D(@$$^W4GL("W4DOC")@(NOM,1)) Q "DOCEXIST" ; N BELONG S BELONG=$$BELONG(NOMORD,VD,NOM) I BELONG,DOC'="HZMH" Q "ORDBELONG2DOC;"_BELONG I BELONG,DOC="HZMH" Q "PRICEOFFERBELONG2DOC;"_BELONG ; D GLTMP K @GLTMP ; I SUG="I" S @GLTMP=$G(@W4INP@(ORG,"IHZ",NOMORD)) ; S @GLTMP@("ORD")=NUMBERORD ; I SUG="I" D .F I=1:1 Q:'$D(@W4INP@(ORG,"IHZ",NOMORD,I)) D ..S @GLTMP@(I)=$G(@W4INP@(ORG,"IHZ",NOMORD,I)) ; I SUG="O" D .F I=1:1 Q:'$D(@W4ORD@(NOMORD,I)) D ..S @GLTMP@(I)=$G(@W4ORD@(NOMORD,I)) ..I PRMAM,'$$INP D ...N A S A=$G(@GLTMP@(I)) ...I '$P(A,"\",11) D ....S $P(@GLTMP@(I),"\",3)=$J($P(@GLTMP@(I),"\",3)*(100+$$MAM^W4PRM)*.01,2,2) ..I 'PRMAM D ...N A S A=$G(@GLTMP@(I)) ...I $P(A,"\",11) D ....N AHMAM S AHMAM=$P(A,"\",5) ....S $P(@GLTMP@(I),"\",3)=$J($P(@GLTMP@(I),"\",3)*100/(100+AHMAM)*.01,2,2) ; Q "OK" ; ; EXISTORD(ORD) N ORG,VD,NOM S ORG=$P(ORD,";",2),VD=$P(ORD,";",3),ORD=$P(ORD,";") I ORG="" Q 0 I 'ORD Q 0 ; I ORG["_I",$E(VD)'="I" S VD="I"_VD ; I $E(VD)'="I",ORG'["_I" D Q +NOM .I ORD["HZMH" S NOM=$G(@$$^W4GL("W4DIR")@("HZMH",+ORD)) Q .S NOM=$$^W4ORDD(ORG,+ORD) ; S ORG=$P(ORG,"_") Q $D(@$$^W4GL("W4INP")@(ORG,"IHZ",ORD,1)) ; ; BELONG(ORD,VDOC,NOM) Q $$^W4BLNORD(ORD,$G(VDOC),$G(NOM)) ; COLOR(STAM) ; Q $$COLOR^W4LKH ; SIZE(STAM) ; Q $$SIZE^W4LKH ; NODISCST(STAM) ; Q $$NODISCST^W4LKH ; SMBMTB(STAM) ; Q $$^W4SMBMTB ; SELMTB ; N A,N W "
    "_$$^%W1DICT("CODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("SERIAL")_""_$$^%W1DICT("EM")_""_$$^%W1DICT("COLOR")_""_$$^%W1DICT("SIZE")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("DISCPERCENT")_""_$$^%W1DICT("BEFORETAX")_""_$$^%W1DICT("AFTERTAX")_""_$$^%W1DICT("COMMENT")_"
    " W $$INPCODE(PRM) W ""_$$INPNAME(PRM)_""_$$INPSERNUM(PRM)_"" . W $$INPEM(PRM) .W ""_$$INPCOLOR(PRM)_""_$$INPSIZE(PRM)_""_$$INPPRC(PRM)_""_$$INPQN(PRM)_""_$$INPQN(PRM)_""_$$INPPRC(PRM)_""_$$INPDISC(PRM)_""_$$INPCMNST(PRM)_"
    "_$$^%W1DICT("TOTAL")_" 
    "_$$^%W1DICT("AFTERTAX")_" 
    "_$$^%W1DICT("DISCPERCENT")_" " W "" W ""_DISCA_" "_$$SMBMTB_"
    "_$$^%W1DICT("DISCNIS")_" " W "" W " "_$$SMBMTB W "
    "_$$^%W1DICT("DLVPAY")_" " W "" W " "_$$SMBMTB W "
    "_$$^%W1DICT("TOTAL")_" 
    "_$$^%W1DICT("IGUL")_" 
    "_$$^%W1DICT("TOTALROUNDED")_" 
     
    "_$$^%W1DICT("TAX",AHMAM)_" 
    ",! W "" W " ",! W "
    " W "   "_$$^%W1DICT("CURRENCY")_" " W "",! W "
    ",! Q ; CHNPRC(PRM) ; N SH,EM,PRCO,EMO S SH=$P(PRM,";") I 'SH Q "-" S EM=$P(PRM,";",2) ; S PRCO=$$PRC(0,SH) S EMO=$$EM(0,SH) Q $J(PRCO*$$NEWKF^W4PRT(EM,EMO),2,2) ; ERUADET ; N (JB,%ARG,%REM,NOM,VW) W "",! W "" W "",! ; W "",! ; W "",! ; W "",! ; W "",! ; W "",! ; W "",! W "",! W "
    " W $$^%W1DICT("ERUADATE")_" " W "",! I '$D(VW) D ^%W1DAT("ERUADATE",$$ERUADATE(NOM)) I $D(VW) W $$RKV($$ERUADATE(NOM)) W "" W $$^%W1DICT("ERUATIME") W "" I '$D(VW) D TIME^%W1DAT("ERUATIME",$$ERUATIME(NOM)) I $D(VW) W $$RKV($$ERUATIME(NOM)) W "" W "   " W $$^%W1DICT("GUESTSNUMBER")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$GUESTS(NOM)) W "" W "   " W $$^%W1DICT("MAZMIN")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$H2U^%L1FRM($$MAZMIN(NOM))) W "" W "   " W $$^%W1DICT("PELE")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$PELEMAZMIN(NOM)) W "
    ",! Q ; RKV(VL) N ST S ST="" S ST=ST_VL S ST=ST_"" Q ST ; DIVPRCCSR ; W "
    ",! W "

    ",! W "

    "_$$^%W1DICT("PRCCSR")_" " W "

    ",! W "

    ",! W "

    " W "",! W $$NBSP^%L1FRM(3) W "",! W "

    ",! Q W4DOC0 W4DOC ; [ 12.06.17 12:38 ] [ 21.05.17 12:40 ] [ 11.05.17 10:04 ] N (JB,%ARG,%REM) D ^%W1ARG S W4DOC="" S NUMBER=$G(%ARG("NUMBER")) I $G(SPK) D PUT^%W1PRM("SPK",SPK) D PUT^%W1PRM("LHBCUR",NUMBER_";"_SPK) ; I $TR($G(%ARG("NUMBER")),"0123456789","")="HZ",$G(LKH)="",$G(%ARG("SPK")),NUMBER D .S LKH=%ARG("SPK"),%ARG("LKH")=%ARG("SPK") .D PUT^%W1PRM("LKH",LKH) .D PUT^%W1PRM("NUMBER",+NUMBER) .D KILL^%W1PRM("SPK") .K %ARG("SPK") ; S NOM=$$NOM(NUMBER) ; --> NOM IN ^W4DOC S NUMBER=+NUMBER ; S DAT=$$DAT(NOM) S LKH=$$LKH(NOM) ; S DOC=$$GETDOC(NOM) D PUT^%W1PRM("DOC",DOC) ; D GLTMP S GL=$$GL($G(%ARG("NUMBER"))) I $G(NUMBER) D PUT^%W1PRM("NUMBER",+NUMBER) ; I NOM,$D(@GL@(NOM))=11 D ; --- DOC NUMBER --> GLTMP .K @GLTMP .M @GLTMP=@GL@(NOM) ; D KOTHSB(NUMBER,LKH,DAT,DOC) ; W "
    ",! ; I $$MTB^W4LKH D SELMTB ; D DAF1 ; I $G(%ARG("NEWDOC")) K %ARG("NUMBER") S NOM=0,NUMBER=0 ; W "
    " W "
    ",! W "",! W "" I '$$HMKI^W4LHB D .W "" ; I $$HMKI^W4LHB D .W "" ; W "" W "" W "",! W "
    " . N SBM S SBM=$S($$INP($G(%ARG("NUMBER")))!$$HZ!$$HZMH:"SUBMIT",1:"SUBMITANDPRINT") . D ROUNDBUT^%W1JS("Submit",$$^%W1DICT(SBM),"Submit('"_NOM_"')","color:green",",,,100") .W "" . D ROUNDBUT^%W1JS("Pay",$$^%W1DICT("PAY"),"Pay('"_LKH_"')","color:green",",,,100") .W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "
    ",! Q ; ; KOTHSB(NMB,LKH,DAT,DOC) ; D PUT^%W3DEB("W4DOC-KOTHSB","NMB=NMB&LKH=LKH&DAT=DAT&DOC=DOC") D ^W4KOTHSB(NMB,LKH,DAT,DOC) ; I $$INP,$$IHBTM(NMB) D LISTTM("GLTMP") ; --- RESHIMAT TM LE SIMUN ; I DOC="IHB"!(DOC="ITM")!(DOC="HBW")!(DOC="TM") D .W "",! .D TBORD(DOC,NOM,"HZ") .I DOC="HBW"!(DOC="TM") D TBORD(DOC,NOM,"HZMH") .W "
    ",! Q ; ; TBORD(DOC,NOM,DOCFROM) ; N ORG,SUG I $E(DOC)="I",'$G(SPK) Q I $E(DOC)="I" S ORG=SPK_"_I",SUG="I" E S ORG=LKH,SUG="O" ; W "",! W "",! N DOCNAME S DOCNAME="ORDER" I DOCFROM="HZMH" S DOCNAME="PRICEOFFER" W $$^%W1DICT(DOCNAME) W "",! ; W "" N IDORD S IDORD="order" I DOCFROM="HZMH" S IDORD="hzmh" W "",! W "",! ; W "" D ROUNDBUT^%W1JS("FindOrd",$$^%W1DICT("FIND"),"FindOrd('"_DOCFROM_"','"_ORG_"','"_DAT_"')","color:black",",,,70") W "",! ; W "" D .N PROC S PROC="ShowOrd('" .D ROUNDBUT^%W1JS("ShowOrd",$$^%W1DICT("SHOW"),PROC_ORG_"','"_DOCFROM_"')") W "",! ; N DOC S DOC=$$DOC($G(%ARG("NUMBER"))) ; I $L(DOC) D .I SUG="I",$$IHBTM(NMB) Q .I SUG="I",$D(@$$^W4GL("W4INP")@(ORG,DOC,+$G(%ARG("NUMBER")),1)) Q .I SUG="O",$D(@$$^W4GL("W4ORD")@(+$G(%ARG("NUMBER")),1)) Q ;-- ????? .W "" . N COPYTO S COPYTO="COPY2INVOICE" . I $G(DOC)="ITM" S COPYTO="COPY2DLVDOC" . D ROUNDBUT^%W1JS("Copy2Invoice",$$^%W1DICT(COPYTO),"CopyOrd2Invoice('"_DOCFROM_"','"_ORG_"')","color:darkblue",",,,120") .W "",! W "",! Q ; ; ORD(DOCFROM,ORG,NOM) ; N SUG S SUG="O" I ORG["_I" S ORG=$P(ORG,"_I"),SUG="I" D GLTMP ; N TORD S TORD=$G(@GLTMP@("ORD")) I TORD,TORD["HZMH",DOCFROM="HZMH" Q TORD I TORD,TORD["HZMH",DOCFROM'="HZMH" Q "" I TORD,TORD'["HZMH",DOCFROM="HZMH" Q "" I TORD Q TORD ; I '$G(NOM) Q "" I SUG="I" Q $G(@$$^W4GL("W4INP")@(ORG,"IHB",+NOM,"ORD")) ; N ORD S ORD=$G(@$$^W4GL("W4DOC")@(+NOM,"ORD")) I DOCFROM="HZ",ORD'["HZMH" Q ORD Q $S(ORD:+ORD,1:"") ; ; LISTTM(GL) ; N MZ,MT,N,ND W "",! W " ",! .W " ",! W "
    " N VDTM F VDTM="ITM","ITZ" D .S N="" F S N=$O(@GL@(VDTM,N)) Q:N="" D ..S ND=N S:N<0 ND=-N ..I N<0!$$IHBZ S MZ(ND)="" Q ..S MT(ND)="" ; I $D(MT) D .W $$^%W1DICT("DLVDOCLIST")_" : " .S N="" F S N=$O(MT(N)) Q:N="" D ..W "" ..W N_"" I $O(MT(N))'="" W "," .W "
    ",! ; I $D(MZ) D .W $$^%W1DICT("DLVBACKDOCLIST")_" : " .S N="" F S N=$O(MZ(N)) Q:N="" D ..W N I $O(MZ(N))'="" W "," .W "
    ",! Q ; TD W "" Q TDLTR W " ",! Q ; COLST(NOM) S NOM=$G(NOM) N GL,GLTMP S GL=$$GL D GLTMP N VL,COL,N S COL=0 ; I $$GETTMP(NOM) D Q COL .S N="" F S N=$O(@GLTMP@(N)) Q:N="" S COL=COL+1 ; Q $O(@GL@(NOM,99999),-1) ; ; SHOWPRMAM ; W "",! W " " W " ",! I $$GETP^%W1PRM("PRKUP") D .W " " .W " " I $$GETP^%W1PRM("PRKUP")=0 D .W " " ; W " ",! W "
    " W " "_$$^%W1DICT("PRICENOTINCLUDEDTAX")_" " W " " W " " .W " "_$$^%W1DICT("PRICEINCLUDEDTAX")_" " .W " " .W " " .W " "_$$^%W1DICT("CSRITEMS") .W " " .W " "_$$^%W1DICT("MLYITEMS") .W "
    ",! Q ; DAF1 ; D DAFBODY(NOM) ; D TOT(NOM) ; D SHOWTOT(NOM) ET ; W "",! ; I '$$HMKI^W4LHB D .W "

    " .W "
    ",! . N EDITCMNT S EDITCMNT="" . D DIVCMNT^W4LCBCR(NOM,0,$$CMNT(NOM),$$PRV(NOM),0) .W "
    ",! Q ; ; DAFBODY(NOM) ; N (JB,%ARG,LKH,DAT,NOM,NUMBER) ; I '$D(NOM) S NOM=0 ; I $$MLYPRT D .W "",! . W "" . W "",! . W "",! .W "
    " . W $$^%W1DICT("FORITEMSHOWPRESSKEY") . W "
    ",! ; I '$$INP D .D SHOWPRMAM .D PUT^%W1PRM("PRMAM",$$PRMAM(NOM)) ; I $$ERUA^W3PRM,$$DOC(NOM)="HZMH" D ERUADET ; W "

    ",! W "",! ; W "" S WD=18 ;;I $$NOTEDIT(NOM) S WD=14 W " ",! W " ",! ; I $$PRMSER D .W " ",! I $$MLYPRT D .W " ",! ; I $$COLOR D .W " ",! I $$SIZE D .W " ",! ; I '$$^W4MLQNMH D .W " ",! .W " ",! ; I $$^W4MLQNMH D .W " ",! .W " ",! ; I '$$NODISCST D .W " ",! ; W " ",! W " ",! ; I $$CMNST^W4LKH D .W " ",! ; W "",! ; S COLST=$$COLST(NOM) I COLST<5 S COLST=5 ; I $G(NOM) F I=1:1:COLST+1 D LINE(NOM,I) ; I '$G(NOM) D .N I,I1,N1 S I=0,N1="" .N GLTMP D GLTMP .N N S N="" F S N=$O(@GLTMP@(N)) Q:N="" I N S I=I+1,N1=N D LINE(0,N) .I I<5 F I1=I+1:1:5 S N1=N1+1 D LINE(0,N1) Q ; ; ONKEYPRESS ; S ONKEYPRESS=" onKeyPress=""OnKeyPress(event,'"_I_"','"_NOM_"')"" " Q ; READONLY(NOM) S NOM=$G(NOM) N TX S TX="" I $$NOTEDIT(NOM) S TX=" readonly=""readonly"" " ; S TX=TX_" style=""color:"_$S($$HBZ(NOM)!$$ITZ(NOM)!$$IHBZ(NOM):"red",1:"black") I $$NOTEDIT(NOM) S TX=TX_";background-color:#eaeaea" S TX=TX_"""" Q TX ; NOTEDIT(NOM) ; N NOTEDIT S NOTEDIT=$$IHBTM(NOM) N GLTMP,MAXLINE D GLTMP S MAXLINE=$O(@GLTMP@(99999),-1) I NOTEDIT,$G(I),I>MAXLINE Q 0 Q NOTEDIT ; ; LINE(NOM,I) ; N ONKEYPRESS D ONKEYPRESS ; W "" N PRM S PRM=NOM_";"_I ; W "",! ; W "",! ; I $$PRMSER D .W " ",! ; I $$MLYPRT D .W " ",! ; I $$COLOR D .W " ",! I $$SIZE D .W " ",! ; I '$$^W4MLQNMH D .W " ",! .W " ",! ; I $$^W4MLQNMH D .W " ",! .W " ",! ; I '$$NODISCST D .W " ",! D TDLTR W " id=""bft"_I_""">"_$$INPBFTAX(PRM)_" "_$$SMBMTB_"",! D .D TDLTR W " id=""aft"_I_""">"_$$INPAFTAX(PRM)_" "_$$SMBMTB_"",! ; I $$CMNST^W4LKH D .W " ",! W "",! Q ; ; INPCODE(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" ; I '$$NOTEDIT(NOM) D .S ST=ST_"" ; S ST=ST_" " .S ST=ST_" " .S ST=ST_" " Q ST ; ; PRKUP(STAM) ; ;;I $$ONEGLPAR^W3PRM!$$GETP^%W1PRM("PRKUP") Q 1 I $G(%ARG("PRKUP")) Q 1 I $$GETP^%W1PRM("PRKUP") Q 1 Q 0 ; GLP(STAM) ; N GLP S GLP="PAR" I $$MLYPRT S GLP="MLPAR" Q GLP ; INPNAME(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N NAME,DIRNAME S DIRNAME=$$DIRNAME S NAME=$$SHOWNAME($$NAME(NOM,I)) N ST S ST="" Q ST ; INPSERNUM(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; GLMLEM(STAM) Q $$^W4GL("MLMIDA") ; INPEM(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,7) S:'VL VL=1 ; ;;I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$GLMLEM@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPCOLOR(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,9) ; I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$^W4GL("W4COLOR")@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPSIZE(PRM) N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" N VL S VL=+$$GET(NOM,I,10) I $$NOTEDIT(NOM) D Q ST .N ZN S ZN=$G(@$$^W4GL("W4SIZE")@(VL)) .I ZN="" S ST=" " Q .S ST=$$H2U^%L1FRM(ZN) ; S ST="" Q ST ; ; INPPRC(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; INPQN(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; INPDISC(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N ST S ST="" Q ST ; INPBFTAX(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) Q $$NUM($$BFTAX(NOM,I)) ; INPAFTAX(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) Q $$NUM($$AFTAX(NOM,I)) ; INPCMNST(PRM) ; N NOM,I S NOM=$P(PRM,";"),I=$P(PRM,";",2) D ONKEYPRESS N CMNT,DIRNAME S DIRNAME=$$DIRNAME S CMNT=$$SHOWCMNST($$CMNST(NOM,I)) N ST S ST="" Q ST ; ; SHOWTOT(NOM) W "" D SPACE S AHMAM=$$AHMAM(NOM) W "" D TDLTR W " id=""bftot"">"_$J(SHUMLD*100/(100+AHMAM),2,2)_" "_$$SMBMTB_"" D .D TDLTR W " id=""aftot"">"_$J(SHUMLD,2,2)_" "_$$SMBMTB_"" W "",! ; W "" D SPACE W " " D TDLTR W " id=""tot"">"_$J($G(SHUMLD),2,2)_" "_$$SMBMTB_"" D LASTTD W "",! ; W "" D SPACE W "" W "" D LASTTD W "",! ; W "" D SPACE W "",! W "" D LASTTD W "",! ; W "" D SPACE W "" W "" D LASTTD W "",! ; I $$^W4NOIGUL D SHOWMAM ; W "" D SPACE W " " D TDLTR W " id=""total"">"_$J(SHUM-IGUL,2,2)_" "_$$SMBMTB_"" D LASTTD W "",! ; I '$$^W4NOIGUL D .W "" . D SPACE . W "" . D TDLTR W " id=""igul"">"_$J(IGUL,2,2)_" "_$$SMBMTB_"" . D LASTTD .W "",! .; .D SHOWMAM . .W "" D SPACE . W "" . D TDLTR W " id=""itot"">"_$J($J(SHUM,0,0),2,2)_" "_$$SMBMTB_"" . D LASTTD .W "",! ; Q ; ; LASTTD ; I '$$NOTEDIT(NOM) W "",! Q ; SHOWMAM ; S AHMAM=$$AHMAM(NOM)_"%" W "" D SPACE W "" D TDLTR W " id=""tax"">"_$J($G(MAM),2,2)_" "_$$SMBMTB_"" D LASTTD W "",! Q ; GETLKH(NUMBER) I $$INP($G(NUMBER)) Q $$SPK Q $$GETP^%W1PRM("LKH") ; SPK(STAM) N SPK S SPK=0 I $G(%ARG("SPK")) S SPK=%ARG("SPK") I 'SPK S SPK=$$GETP^%W1PRM("SPK") I SPK["_" S SPK=$P(SPK,"_") Q SPK ; GETDAT(STAM) Q $$SPA^%L1FRM($$GETP^%W1PRM("DAT")) ; GETDOC(NOMDOC) ; S NOMDOC=$G(NOMDOC) N VD S VD="" ; I NOMDOC,$$GLOBNAME(NOMDOC)="W4DOC" D I $L(VD) Q VD .I $D(@$$GL@(NOMDOC,"H")) S VD="HBW" Q .I $D(@$$GL@(NOMDOC,"TM")) S VD="TM" Q .I $D(@$$GL@(NOMDOC,"TZ")) S VD="TZ" Q .I $D(@$$GL@(NOMDOC,"HMK")) S VD="HMK" Q .I $D(@$$GL@(NOMDOC,"HZMH")) S VD="HZMH" Q ; I NOMDOC,$$GLOBNAME(NOMDOC)="W4INP" Q $$DOC(NOMDOC) ; I $G(%ARG("VD"))="HBZ" Q "TZ" I $$GETP^%W1PRM("VD")="HBZ" Q "TZ" I $G(%ARG("VD"))="",$L($G(%ARG("DOC"))) Q %ARG("DOC") I $$HZ^W4LHB Q "HZ" I $$TM^W4LHB Q "TM" I $$HMKI^W4LHB Q "HMK" I $G(%ARG("VD"))="ITZ" Q "ITZ" I $$GET^%W1PRM("VD")="ITZ" Q "ITZ" I $G(%ARG("VD"))="IHZ" Q "IHZ" I $$GET^%W1PRM("VD")="IHZ" Q "IHZ" Q $$DOC(NOMDOC) ; ; HZ(STAM) ; Q $$HZ^W4LHB ; HZMH(STAM) ; Q $$HZMH^W4LHB ; GETPRMAM(STAM) Q $$GET^%W1PRM("PRMAM") ; PUTHD(PRM) ; N (JB,%ARG,%REM,PRM) D GLTMP S ST=PRM S TZ=$P(ST,";") S LKH=$$GETLKH D PUT^%W3DEB("W4DOC-PUTHD","ST=ST & LKH=LKH") ; I TZ,LKH D .I $$INP D PUT^W4SPK(LKH,TZ,"TZ") Q .D PUT^W4L(LKH,TZ,"TZ") ; S DISCPRC=$P(ST,";",2) S DISCNIS=$P(ST,";",3) S DMSH=$P(ST,";",4) S HRA=$$CNWEB^%L1FRM($P(ST,";",5)) S HRA=$$INVH^%L1FRM(HRA) S MTB=$P(ST,";",6) ; S $P(@GLTMP,"\",9)=$TR(HRA,"\*","/X") S $P(@GLTMP,"\",12)=DISCPRC S $P(@GLTMP,"\",13)=DISCNIS S $P(@GLTMP,"\",14)=DMSH S $P(@GLTMP,"\",15)=TZ S $P(@GLTMP,"\",18)=MTB Q ; PUT(PRM) ; N (JB,%ARG,%REM,PRM) D GLTMP S ST=PRM S SH=$P(ST,";") Q:'SH S CD=$TR($$CNWEB^%L1FRM($P(ST,";",2)),"\","/") S NAME=$$CNWEB^%L1FRM($P(ST,";",3)) I $$DIRNAME="RTL" S NAME=$$INVH^%L1FRM(NAME) S PRC=+$P(ST,";",4) S QN=+$P(ST,";",5) S DISC=+$P(ST,";",6) S SERNUM=$TR($P(ST,";",7),"\","/") S EM=$TR($P(ST,";",8),"\","/") S COLOR=$TR($P(ST,";",9),"\","/") S SIZE=$TR($P(ST,";",10),"\","/") S CMNST=$$CNWEB^%L1FRM($TR($P(ST,";",11),"\","/")) I $$DIRNAME="RTL" S CMNST=$$INVH^%L1FRM(CMNST) S EM=$$RKVG(EM) ; S @GLTMP@(SH)=CD_"\"_$TR(NAME,"\","/")_"\"_PRC_"\"_QN_"\"_DISC_"\\"_$$SPA^%L1FRM(EM) S $P(@GLTMP@(SH),"\",8)=SERNUM S COLOR=$$RKVG(COLOR) S SIZE=$$RKVG(SIZE) ; S $P(@GLTMP@(SH),"\",9)=COLOR S $P(@GLTMP@(SH),"\",10)=SIZE S $P(@GLTMP@(SH),"\",11)=CMNST Q ; ; RKVG(RKV) D .I RKV?1N.N.E S RKV=$P(RKV," ")_" "_$$INVH^%L1FRM($P(RKV," ",2,20)) Q .S RKV=$$INVH^%L1FRM(RKV) Q RKV ; ; SUBMIT(PRM,PR) ; -- SAVE NEW N (JB,%ARG,%REM,PRM,PR) ; D GLTMP S TMP=($G(PR)="TMP") D PUT^%W3DEB("W4DOC-SUBMIT","PRM=PRM & PR=PR & TMP=TMP") ; S NOM=$P(PRM,";",1) S ORD=$P(PRM,";",2) S PRMAM=0 I '$$INP S PRMAM=$P(PRM,";",3) S TZ=$P(PRM,";",4) ; S HRA=$P(PRM,";",5) S HRA=$$CNWEB^%L1FRM(HRA) S PRV=$P(HRA,"~",2) S HRA=$P(HRA,"~") S HRA=$$INVH^%L1FRM(HRA) ; S DISCPRC=$P(PRM,";",6) S DISCNIS=$P(PRM,";",7) S DMSH=$P(PRM,";",8) S MTB=$P(PRM,";",9) ; S ERUADATE=$P(PRM,";",10) S ERUATIME=$P(PRM,";",11) S GUESTS=$P(PRM,";",12) S MAZMIN=$$INVH^%L1FRM($P(PRM,";",13)) S PELEMAZMIN=$P(PRM,";",14) ; S COLST=$$COLST(NOM) S SHUM=$P(PRM,";",15) S DATI=$P(PRM,";",16) S DATP=$P(PRM,";",17) ; S LKH=$$LKH(NOM) S DAT=$$DAT(NOM) S LKH1=$$LKHNAME(NOM) S KTV=$$KTV(NOM) ; I '$L(TZ),$$GETDOC(NOM)="HBW",$$PRMTZMAM,SHUM'<$$PRMTZMAM Q "NOTTZ" I TZ?1N.N,TZ,'$$^W4TZ(TZ) Q "ERRTZ" I '$$INP,'$$TZ^W4L(LKH),TZ D PUT^W4L(LKH,TZ,"TZ") ; I PRMAM="",'$$INP S PRMAM=$$GETPRMAM ; SBMTV ; N GL S GL=$$GL S NMBDOC=0 ; I 'TMP D .I 'NOM S NMBDOC=$$LASTNOM+1 ; --- IF NEW . .I $G(NOM) D ..N DATOLD,DT,VDOC ..S DATOLD=$$DAT(NOM) D PUT^%W3DEB("W4DOC-SUBMIT","DATOLD=DATOLD&NOM=NOM") ..D ...S DT=$$^%L1DC(DATOLD,3) ...S VDOC=$$DOC(NOM) ... ...I $$INP(NOM) D ; ----- DELETE PREVIOUS VERSION OF DOCUMENT ....D KILL^W4INPDIR(DT,LKH,VDOC,+NOM) ....I VDOC="IHZ"!(NOM["IHZ") Q ....I VDOC="IHBZ"!(NOM["IHBZ"),$D(@$$^W4GL("W4INP")@($$SPK,"IHBZ",+NOM,"ITZ")) Q ....I VDOC="IHB"!(NOM["IHB"&(NOM'["IHBZ")),$D(@$$^W4GL("W4INP")@($$SPK,"IHB",+NOM,"ITM")) Q ....D ^W4SETMLY(DT,VDOC,LKH,+NOM,-1) .. ...I $$HZ(NOM) D ; ----- DELETE PREVIOUS VERSION OF DOCUMENT ....N NUMBER S NUMBER=+$$GETP^%W1PRM("NUMBER") ....S @$$^W4GL("W4ORD")@(+NOM,"NUMBER")=NUMBER ....D KILL^W4ORDD(LKH,+NUMBER) .. ..S NMBDOC=NOM . .N GL0 S GL0=$E(GL,1,$L(GL)-1) .N I F I=1:1 Q:'$D(@GL@(NMBDOC,I)) K @GL@(NMBDOC,I) D ..D ^%S2GLSV(GL0_","""_NMBDOC_""","_I_")",$$^W4FGIB,"K") ; S (SSUMBF,SSUMAF)=0 S AHMAM=$$AHMAM(0) ; ; --------------------- SAVING ----------------------------- N AHMAM1 N N,I,SQN S N="",I=0,SQN=0 F S N=$O(@GLTMP@(N)) Q:N="" I N D .N ST S ST=$G(^(N)) .N QN,PRC,DISC,NAME,CD .S CD=$$CODE(0,N) .S QN=$$QN(0,N),PRC=$$PRC(0,N),DISC=$$DISC(0,N),NAME=$$NAME(0,N) .S MAMCD=$$MAM^W4DMAM(CD) .I 'QN,'PRC,'DISC,$L(NAME)=0 Q .S SQN=SQN+QN .S AHMAM1=$S(MAMCD:AHMAM,1:0) . .I 'TMP S I=I+1,@GL@(NMBDOC,I)=@GLTMP@(N) ; --- !!!!!!-- SAVING --!!!!!!!!! . .I '$$INP,PRMAM D ..S SUMAF=$J(QN*PRC*(100-DISC)*.01,2,2) ..S SUMBF=$J(SUMAF*100/(100+AHMAM1),2,2) . .I 'PRMAM!$$INP D ..S SUMBF=$J(QN*PRC*(100-DISC)*.01,2,2) ..S SUMAF=$J(SUMBF*(100+AHMAM1)*.01,2,2) . .S SSUMBF=SSUMBF+SUMBF .S SSUMAF=SSUMAF+SUMAF ; N BELONG I $G(ORD),ORD'["HZMH" S BELONG=$$BELONG($$^W4ORDD(LKH,ORD),$$DOC(NOM),NMBDOC) I BELONG Q "ORDBELONG2DOC;"_BELONG I $G(ORD),ORD["HZMH" S BELONG=$$BELONG(ORD,$$DOC(NOM),NMBDOC) I BELONG Q "ORDBELONG2DOC;"_BELONG ; I $G(ORD) D SETORD ; S SUMTD=(SSUMAF*(100-DISCPRC)*.01)-DISCNIS+DMSH I 'SQN,'SSUMAF,'SUMTD Q "NODATA!" ; S IGUL=0 I '$$^W4NOIGUL D .S IGUL=$J($J(SUMTD,0,0)-$J(SUMTD,2,2),2,2) .S SUMTD=$J($J(SUMTD,0,0),2,2) ; S MAM=(SSUMAF-SSUMBF)+((SUMTD-SSUMAF)*AHMAM/(100+AHMAM)) ; ;;S MAM=SUMTD*AHMAM/(100+AHMAM) S MAM=$J(MAM,2,2) ; D PUT^%W3DEB("W4DOC-SUBMIT","SSUMBF=SSUMBF & SSUMAF=SSUMAF & SUMTD=SUMTD & IGUL=IGUL & MAM=MAM") ; I 'TMP L +@GL@(NMBDOC):1 ; N STHD I $$INP S DAT=DATI S STHD=LKH_"\"_$TR(LKH1,"\","/")_"\"_$TR(KTV,"\","/")_"\"_DAT_"\"_AHMAM_"\"_SUMTD_"\"_MAM_"\"_$ZD($H,"DD.MM.YY 24:60")_"\"_$TR(HRA,"\","/")_"\"_IGUL_"\"_PRMAM_"\"_DISCPRC_"\"_DISCNIS_"\"_DMSH_"\"_$TR(TZ,"\","/")_"\"_PRV ; N VDOC S VDOC=$$GETDOC(NOM) ; I $$INP D .I $G(DATP) S $P(STHD,"\",17)=DATP .I VDOC="IHB"!(VDOC="IHBZ") D SETITRA^W4SPK(LKH,SUMTD) ; S $P(STHD,"\",18)=MTB S $P(STHD,"\",21)=$$PRKUP ; S $P(STHD,"\",22)=ERUADATE S $P(STHD,"\",23)=ERUATIME S $P(STHD,"\",24)=GUESTS S $P(STHD,"\",25)=MAZMIN S $P(STHD,"\",26)=PELEMAZMIN ; D PUT^%W3DEB("W4DOC-SUBMIT","STHD=STHD&NMBDOC=NMBDOC") ; I 'TMP D ; -------- SAVING .S @GL@(NMBDOC)=STHD . .I VDOC="IHB"!(VDOC="IHBZ"),$D(@GLTMP@("ITM"))>9!($D(@GLTMP@("ITZ"))>9) D ..N VDTM,VDTM1,TM1 F VDTM="ITM" D ..N TM S TM="" F S TM=$O(@GLTMP@(VDTM,TM)) Q:TM="" D ...S VDTM1=VDTM,TM1=TM I TM<0 S VDTM1="ITZ",TM1=-TM ...I VDOC="IHBZ" S VDTM1="ITZ" ...K @$$^W4GL("W4FREEDOC")@(LKH,VDTM1,TM1) ; LKH=SPK ...S @GL@(NMBDOC,"ITM",TM)="" ...I $L(VDOC) S @$$^W4GL("W4INP")@(LKH,VDTM1,TM1,VDOC)=NMBDOC . .K @GLTMP ; ---------- DELETE ! ; I TMP S @GLTMP=STHD ; S NOMHSB=0 N DT S DT=$$^%L1DC(DAT,3) ; I 'TMP D .I VDOC="HBW" D SVHBW Q . .I $$HBZ D SVHBZ Q . .I VDOC="TM" D SVTM Q . .I VDOC="HZMH",'NOM D SVHZMH Q .I VDOC="HZMH" S NOMHSB=+$$GETP^%W1PRM("NUMBER") . .I VDOC="HZ" D ..S @GL@(NMBDOC,"MKR")=$H ..N NUMBER S NUMBER=+$$GETP^%W1PRM("NUMBER") ..S NOMHSB=NUMBER ..D SET^W4ORDD(LKH,NUMBER,NMBDOC) ; I 'TMP,$$INP D .S NOMHSB=NMBDOC .D SET^W4INPDIR(DT,LKH,VDOC,NMBDOC) ; I 'TMP,VDOC'="HZMH",VDOC'="HZ" D .D PUT^%W3DEB("W4DOC-SUBMIT-SETMLY","DT=DT&VDOC=VDOC&LKH=LKH&NMBDOC=NMBDOC") .N VD S VD=$S($$INP:VDOC,1:"OUT") .D ^W4SETMLY(DT,VD,LKH,NMBDOC) ; L ; SUBMITE ; K @$$^W4MAIN("VRM") Q NOMHSB_$S($$HBZ:"Z",VDOC="TM":"T",VDOC="HZ":"HZ",VDOC="ITM":"ITM",VDOC="IHB":"IHB",VDOC="ITZ":"ITZ",VDOC="IHZ":"IHZ",VDOC="IHBZ":"IHBZ",VDOC="HZMH":"HZMH",1:"") ; ; SETORD ; S @GL@(NMBDOC,"ORD")=ORD ; I $$INP,$D(@$$^W4GL("W4INP")@($$SPK,"IHZ",ORD,1)) D Q .N DOC S DOC=$$DOC(NMBDOC) Q:DOC="" .S @$$^W4GL("W4INP")@($$SPK,"IHZ",ORD,DOC)=NMBDOC ; I '$$INP D .N LKH S LKH=$$GETP^%W1PRM("LKH") Q:LKH="" . .I ORD'["HZMH" D ..N NOMORD S NOMORD=$$^W4ORDD(LKH,ORD) Q:'NOMORD ..I $D(@$$^W4GL("W4ORD")@(NOMORD,1)) D ...S $P(@$$^W4GL("W4ORD")@(NOMORD),"\",20)=NMBDOC . .I ORD["HZMH" D ..N ORDN S ORDN=+ORD ..N NOMORD S NOMORD=$G(@$$^W4GL("W4DIR")@("HZMH",ORDN)) Q:'NOMORD ..S $P(@$$^W4GL("W4DOC")@(NOMORD),"\",20)=NMBDOC Q ; ; SVDOC(VD,NMBDOC) ; S NOMHSB=$$^W4NEWNMB(VD) ; L +@GL@(NMBDOC):1 S @GL@(NMBDOC,VD)=NOMHSB S @GL@(NMBDOC,VD,"MKR")=$H D ^%S2GLSV(GL_"("""_NMBDOC_""","""_VD_""")",$$^W4FGIB) L -@GL@(NMBDOC) ; L +@$$^W4GL("W4DIR")@(VD,NOMHSB):1 S @$$^W4GL("W4DIR")@(VD,NOMHSB)=NMBDOC L -@$$^W4GL("W4DIR")@(VD,NOMHSB) ; N VD1 S VD1=VD I $$HBZ S VD1=VD_"Z" D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD1_""","_NOMHSB_")",$$^W4FGIB) D W4DIRD(DT,NMBDOC) Q ; SVHBW ;-- INPUT: NMBDOC,DT,LKH,DAT,SUMTD N VDOC S VDOC="H" D SVDOC(VDOC,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,"H","0H") D PUT^%W1PRM("MKRYD",NOMHSB_$$GETDOC) Q ; SVHBZ ;-- INPUT: NMBDOC,LKH,DAT,SUMTD N VD S VD=$$GETDOC D HBMIN(NMBDOC) D SVDOC(VD,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0D") D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q ; SVTM ;-- INPUT: NMBDOC,LKH,DAT,SUMTD N VD S VD="TM" D SVDOC(VD,NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0H") D .N NOMDOC S NOMDOC="DOC-"_NOMHSB .L +@$$^W4GL("P1HL3")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1")@(LKH,NOMDOC):1 .L +@$$^W4GL("P1HL1I")@(NOMDOC):1 .S @$$^W4GL("P1HL3")@(LKH,NOMDOC)=$$^%L1DC(DAT,3)_"*"_SUMTD_"*"_DAT_"*"_$ZD($H,"24:60")_"**"_$TR(LKH1,"\*","/X")_"*"_AHMAM_"*"_MAM .S @$$^W4GL("P1HL1")@(LKH,NOMDOC)=@$$^W4GL("P1HL3")@(LKH,NOMDOC) .S @$$^W4GL("P1HL1I")@(NOMDOC,LKH)="" .D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD_""","_NOMHSB_")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL3")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1")_"("""_LKH_""","""_NOMDOC_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1I")_"("""_NOMDOC_""")",$$^W4FGIB) D PUT^%W1PRM("MKRYD",NOMHSB_$$GETDOC) Q ; SVHZMH ; N VD S VD="HZMH" D SVDOC(VD,NMBDOC) D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q ; PUTHMK(STAM) ; N GL,GLTMP,NMBDOC,NOMHSB S GL=$$GL D GLTMP S NMBDOC=$$LASTNOM+1 N VD S VD="HMK" ; N N,I S N="",I=0 F S N=$O(@GLTMP@(N)) Q:N="" D .N ST S ST=$G(^(N)) .S I=I+1,@GL@(NMBDOC,I)=@GLTMP@(N) ; S @GL@(NMBDOC)=$G(@GLTMP) ; S NOMHSB=$$^W4NEWNMB(VD) ; I $$GETP^%W1PRM("ELPOS") D .L +@$$^W4GL("P1HB")@(NOMHSB):1 .N DT S DT=+$H .S @$$^W4GL("P1HB")@(NOMHSB)="W"_NMBDOC_"\"_DT_"\"_$H .S @$$^W4GL("P1HBI")@(DT,NOMHSB)=$H .L ; ; S @GL@(NMBDOC,VD)=NOMHSB S @GL@(NMBDOC,VD,"MKR")=$H ; D ^%S2GLSV(GL_"("_+NMBDOC_")",$$^W4FGIB) ; L +@$$^W4GL("W4DIR")@(VD,NOMHSB):1 S @$$^W4GL("W4DIR")@(VD,NOMHSB)=NMBDOC L -@$$^W4GL("W4DIR")@(VD,NOMHSB) D ^%S2GLSV($$^W4GL("W4DIR")_"("""_VD_""","""_NOMHSB_""")",$$^W4FGIB) ; D W4DIRD(+$H,NMBDOC) ; N LKH,DAT,SUMTD S LKH=$$LKH(NMBDOC) S DAT=$$DAT(NMBDOC) S SUMTD=$$SUMTD(NMBDOC) D ^W4HSBSV(NOMHSB,LKH,"W"_NMBDOC,$$^%L1DC(DAT,3),SUMTD,VD,"0") ; N DT S DT=$$^%L1DC(DAT,3) D PUT^%W3DEB("W4DOC-SUBMIT-PUTHMK","DT=DT&VDOC=VDOC&LKH=LKH&NMBDOC=NMBDOC") N VD S VD=$S($$INP:"VDOC",1:"OUT") D ^W4SETMLY(DT,VD,LKH,NMBDOC) ; D PUT^%W1PRM("MKRYD",NOMHSB_VD) Q NMBDOC_";"_NOMHSB ; ; GL(NUMBER) ; I '$$INP($G(NUMBER)) Q $$^W4GL($$GLOBNAME($G(NUMBER))) Q $$^W4GL($$GLOBNAME($G(NUMBER)))_"("""_$$GETLKH($G(NUMBER))_""","""_$$DOC($G(NUMBER))_""")" ; GLOBNAME(NUMBER) I $$INP($G(NUMBER)) Q "W4INP" I $$DOC(NUMBER)="HZ" Q "W4ORD" Q "W4DOC" ; GLTMP ; S GLTMP=$$^W4MAIN("TMPHBK") Q ; GLHR ; S GLHR=$$GL_"(NMBDOC,""CMNT"")" Q ; ; GET(NOM,SH,NRZ) N GL,GLTMP S GL=$$GL D GLTMP N VL I $$GETTMP(NOM) D Q VL .N GLTMP D GLTMP .S VL=$P($G(@GLTMP@(SH)),"\",NRZ) ; S VL=$P($G(@GL@(NOM,SH)),"\",NRZ) Q VL ; CODE(NOM,SH) ; Q $$GET(NOM,SH,1) ; NAME(NOM,SH) ; Q $$GET(NOM,SH,2) ; PRC(NOM,SH) ; Q $J($$GET(NOM,SH,3),2,2) ; QN1(NOM,SH) ; Q $$GET(NOM,SH,4) ; DISC(NOM,SH) ; Q $$GET(NOM,SH,5) ; EM(NOM,SH) ; Q $$GET(NOM,SH,7) ; SERIAL(NOM,SH) ; Q $$GET(NOM,SH,8) ; CLR(NOM,SH) ; Q $$GET(NOM,SH,9) ; SZ(NOM,SH) ; Q $$GET(NOM,SH,10) ; CMNST(NOM,SH) ; Q $$GET(NOM,SH,11) ; QN(NOM,SH) ; N QN S QN=$$QN1(NOM,SH) I $$HBZ(NOM),$G(NOM) S QN=-QN Q QN ; BFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " I $$PRMAM(NOM) Q $J($$SUMST(NOM,SH)*100/(100+$$AHMAM(NOM)),2,2) Q $J($$SUMST(NOM,SH),2,2) ; AFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " I '$$PRMAM(NOM) Q $J($$SUMST(NOM,SH)*(100+$$AHMAM(NOM))*.01,2,2) Q $J($$SUMST(NOM,SH),2,2) ; SUMST(NOM,SH) Q $J($$QN(NOM,SH)*$$PRC(NOM,SH)*(100-$$DISC(NOM,SH))*.01,2,2) ; LASTNOM(STAM) Q $O(@GL@(999999),-1) ; LKH(NOM) ; S NOM=$G(NOM) I 'NOM!$$INP Q $$GETLKH(NOM) N LKH S LKH=$P($G(@$$GL@(NOM)),"\",1) I LKH="" Q $$GETLKH(NOM) Q LKH ; LKHNAME(NOM) ; N LKH S LKH=$$LKH(NOM) I '$G(NOM),$$INP Q $$NAME^W4SPK(LKH) I '$G(NOM),'$$INP Q $$LKH^W4L(LKH) N LKHNAME S LKHNAME=$P($G(@$$GL@(NOM)),"\",2) I $$INP,LKHNAME="" Q $$NAME^W4SPK(LKH) Q LKHNAME ; KTV(NOM) ; N LKH S LKH=$$LKH(NOM) I '$G(NOM),$$INP Q $$KTVMM^W4SPK(LKH) I '$G(NOM),'$$INP Q $$KTVMM^W4L(LKH) N KTV S KTV=$P($G(@$$GL@(NOM)),"\",3) I $$INP,KTV="" Q $$KTVMM^W4SPK(LKH) Q KTV ; DAT(NOM) ; I $$IHBTM(NOM),$G(%ARG("DAT")) Q $$^%L1DC($G(%ARG("DAT")),".") I '$G(NOM) Q $$GETDAT N DAT N GLOB S GLOB=$$GL D PUT^%W3DEB("W4DOC-DAT","GLOB=GLOB & NOM=NOM") S DAT=$$SPA^%L1FRM($P($G(@GLOB@(NOM)),"\",4)) I DAT="",$$INP Q $$GETDAT Q DAT ; AHMAM(NOM) ; I '$G(NOM) Q $G(@$$^W4PRM@("MAM")) N AHMAM S AHMAM=$P($G(@$$GL@(NOM)),"\",5) I AHMAM="" Q $G(@$$^W4PRM@("MAM")) Q AHMAM ; SUMTD(NOM) ; N SUMTD D GLTMP ;;I '$G(NOM) Q "" I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",6) S SUMTD=$P($G(@$$GL@(NOM)),"\",6) ; I $$HBZ(NOM),$G(NOM) S SUMTD=-SUMTD Q SUMTD ; MAM(NOM) ; N MAM D GLTMP ;;I '$G(NOM) Q "" I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",7) S MAM=$P($G(@$$GL@(NOM)),"\",7) I NOM,$$HBZ(NOM) S MAM=-MAM Q MAM ; KMAM(NOM) ; N AHMAM S AHMAM=$$AHMAM(NOM) N SUM S SUM=$$SUMTD(NOM) N MAM S MAM=$$MAM(NOM) N AHR S AHR="" I SUM'>MAM Q AHR S AHR=MAM*100/(SUM-MAM) Q $J(AHR/AHMAM,4,4) ; ISSUE(NOM) ; I '$G(NOM) Q $ZD($H,"DD.MM.YY") Q $P($G(@$$GL@(NOM)),"\",8) ; CMNT(NOM) ; N GLTMP D GLTMP I $$GETTMP(NOM) Q $$H2U^%L1FRM($P($G(@GLTMP),"\",9)) Q $$H2U^%L1FRM($P($G(@$$GL@(NOM)),"\",9)) ; PRV(NOM) ; N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",16) Q $P($G(@$$GL@(NOM)),"\",16) ; IGUL(NOM) ; I '$G(NOM) Q "" D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",10) S IGUL=$P($G(@$$GL@(NOM)),"\",10) I $G(NOM),$$HBZ(NOM) S IGUL=-IGUL Q IGUL ; PRMAM(NOM) ; I $$INP Q 0 I '$G(NOM) Q $S($G(%ARG("PRMAM"))="":$$PRMAM^W4LKH,1:$G(%ARG("PRMAM"))) Q $P($G(@$$GL@(NOM)),"\",11) ; DISCPRC(NOM) ; N AHTMP,GLTMP D GLTMP S AHTMP=$P($G(@GLTMP),"\",12) I '$$INP,AHTMP="",$$AH^W4L($$LKH(NOM)) S AHTMP=$$AH^W4L($$LKH(NOM)) I $$GETTMP(NOM) Q AHTMP Q $P($G(@$$GL@(NOM)),"\",12) ; DISCNIS(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",13) N DISCNIS S DISCNIS=$P($G(@$$GL@(NOM)),"\",13) I $G(NOM),$$HBZ(NOM) S DISCNIS=-DISCNIS Q DISCNIS ; DMSH(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",14) N DMSH S DMSH=$P($G(@$$GL@(NOM)),"\",14) I $G(NOM),$$HBZ(NOM) S DMSH=-DMSH Q DMSH ; TZ(NOM) ; N TZ N GLTMP D GLTMP I '$G(NOM),$G(%ARG("LKH")) D Q TZ .S TZ=$$TZ^W4L(%ARG("LKH")) I '$G(NOM),$G(%ARG("SPK")) D Q TZ .S TZ=$$TZ^W4SPK(%ARG("SPK")) I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",15) Q $P($G(@$$GL@(NOM)),"\",15) ; MTB(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",18) N MTB S MTB=$P($G(@$$GL@(NOM)),"\",18) Q MTB ; PRKUPDOC(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",21) N PRKUP S PRKUP=$P($G(@$$GL@(NOM)),"\",21) Q PRKUP ; GUESTS(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",24) N GUESTS S GUESTS=$P($G(@$$GL@(NOM)),"\",24) Q GUESTS ; MAZMIN(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",25) N MAZMIN S MAZMIN=$P($G(@$$GL@(NOM)),"\",25) Q MAZMIN ; PELEMAZMIN(NOM) ; S NOM=$G(NOM) N GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",26) N PELEMAZMIN S PELEMAZMIN=$P($G(@$$GL@(NOM)),"\",26) Q PELEMAZMIN ; HRA(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",9) Q $P($G(@$$GL@(NOM)),"\",9) ; ERUADATE(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",22) Q $P($G(@$$GL@(NOM)),"\",22) ; ERUATIME(NOM) ; N HRA,GLTMP D GLTMP I $$GETTMP(NOM) Q $P($G(@GLTMP),"\",23) Q $P($G(@$$GL@(NOM)),"\",23) ; DIRNAME() Q $$DIRNAME^W3PRM ; SHOWNAME(NAME) ; I $$DIRNAME="RTL" Q $$H2U^%L1FRM(NAME) Q NAME ; SHOWCMNST(TXT) ; I $$DIRNAME="RTL" Q $$H2U^%L1FRM(TXT) Q TXT ; NUM(RKV) I '$G(RKV) Q " " Q RKV ; SPACE D TDN,TDN I $$PRMSER D TDN I $$MLYPRT D TDN I $$COLOR D TDN I $$SIZE D TDN D TDN,TDN Q ; PRMTZMAM(STAM) ; Q $$PRMTZMAM^W4HSBYAD ; NOM(NUMBER) ; N VD S VD="H" N NOM I '$G(NUMBER) Q 0 I $TR(NUMBER,"1234567890","")="T" S NUMBER=+NUMBER,VD="TM" I $TR(NUMBER,"1234567890","")="Z" S NUMBER=+NUMBER,VD="TZ" I $TR(NUMBER,"1234567890","")="HZ" S NUMBER=+NUMBER,VD="HZ" I $TR(NUMBER,"1234567890","")="HMK" S NUMBER=+NUMBER,VD="HMK" I $TR(NUMBER,"1234567890","")="ITM"!($$DOC="ITM") S NUMBER=+NUMBER,VD="ITM" I $TR(NUMBER,"1234567890","")="ITZ"!($$DOC="ITZ") S NUMBER=+NUMBER,VD="ITZ" I $TR(NUMBER,"1234567890","")="IHZ"!($$DOC="IHZ") S NUMBER=+NUMBER,VD="IHZ" I $TR(NUMBER,"1234567890","")="IHB"!($$DOC="IHB") S NUMBER=+NUMBER,VD="IHB" I $TR(NUMBER,"1234567890","")="IHBZ"!($$DOC="IHBZ") S NUMBER=+NUMBER,VD="IHBZ" I $TR(NUMBER,"1234567890","")="HZMH" S NUMBER=+NUMBER,VD="HZMH" ; I VD="ITM"!(VD="IHB")!(VD="ITZ")!(VD="IHBZ")!(VD="IHZ") D PUT^%W1PRM("DOC",VD) Q NUMBER ; I VD="HZ" D Q NOM .S NOM=0 N LKH S LKH=$$GETP^%W1PRM("LKH") Q:LKH="" .S NOM=$$^W4ORDD(LKH,NUMBER) .D PUT^%W1PRM("DOC",VD) ; S NOM=$G(@$$^W4GL("W4DIR")@(VD,NUMBER)) I NOM="" S NOM=$P($G(@$$^W4GL("KLIN")@(VD,NUMBER)),"W",2) Q NOM ; ; TOT(NOM) ; N GLTMP S MAM=$$MAM(NOM) S AHMAM=$$AHMAM(NOM) ; S SHUM=$$SUMTD(NOM) ; S DISCPRC=$$DISCPRC(NOM) S DISCNIS=$$DISCNIS(NOM) S DMSH=$$DMSH(NOM) S IGUL=$$IGUL(NOM) ; S SHUMLD=SHUM-IGUL-DMSH+DISCNIS N SHUMLD0 S SHUMLD0=SHUMLD I DISCPRC<100 S SHUMLD=$J(SHUMLD*100/(100-DISCPRC),2,2) S DISCA=$J(SHUMLD-SHUMLD0,2,2) ;;S BFMAM=SHUMLD*100/(100+AHMAM) ;;S LMAM=SHUM*100/(100+AHMAM) ; S LMAM=SHUM-MAM S BFMAM=0 I SHUM S BFMAM=$J(LMAM*(SHUMLD/SHUM),2,2) Q ; ; INIT ; D ^%W1ARG,^W3CSS,GLTMP I $G(FIRST) K @GLTMP I $G(NUMBER),$$IHBTM(NUMBER) Q ; D PUT^%W1PRM("LKH",$G(LKH)) D PUT^%W1PRM("SPK",$G(SPK)) D PUT^%W1PRM("DAT",$$SPA^%L1FRM($G(DAT))) D PUT^%W1PRM("DOC",$G(DOC)) S $P(@GLTMP,"\")=$G(LKH) S $P(@GLTMP,"\",2)=$G(LKH1) S $P(@GLTMP,"\",3)=$G(KTV) S $P(@GLTMP,"\",4)=$G(DAT) S $P(@GLTMP,"\",5)=$G(AHMAM) Q ; DEL(SH) ; D PUT^%W3DEB("W4DOC-DEL","SH=SH") N GLTMP D GLTMP D DEL^%L1GSEQ(GLTMP,SH) Q ; HBMIN(NOMDOC) ; N I,J F I=1:1 Q:'$D(@GL@(NOMDOC,I)) D .S $P(^(I),"\",4)=-$P(^(I),"\",4) F J=6,7,10,13,14 D .S $P(@GL@(NOMDOC),"\",J)=-$P($G(@GL@(NOMDOC)),"\",J) Q ; HBZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="TZ" Q 1 Q 0 ; IHBZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="IHBZ" Q 1 I $$GETDOC(NOM)="[-]" Q 1 Q 0 ; IHZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="IHZ" Q 1 Q 0 ; ITM(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="ITM" Q 1 Q 0 ; ITZ(NOM) ; S NOM=$G(NOM) I $$GETDOC(NOM)="ITZ" Q 1 Q 0 ; RED(STAM) ; Q "color:"_$S($$HBZ($G(NOM))!$$ITZ($G(NOM)):"black",1:"red") ; NORED(STAM) ; Q "color:"_$S($$HBZ($G(NOM))!$$ITZ($G(NOM)):"red",1:"black") ; W4DIRD(DT,NOMDOC) ; S NOMDOC=+NOMDOC L +@$$^W4GL("W4DIRD")@(DT):1 S @$$^W4GL("W4DIRD")@(DT,NOMDOC)=$H L -@$$^W4GL("W4DIRD")@(DT) D ^%S2GLSV($$^W4GL("W4DIRD")_"("_DT_","""_NOMDOC_""")",$$^W4FGIB) Q ; PRMSER(STAM) ; Q $$SERNUM^W3PRM ; INP(NUMBER) ; Q ($E($$DOC($G(NUMBER)))="I") ; MLYPRT(STAM) ; I $$INP Q 1 I $$GETP^%W1PRM("ELPOS")&'$$GETP^%W1PRM("PRKUP") Q 1 Q 0 ; DOC(NUMBER) ; N D I $G(NUMBER),$TR(NUMBER,"1234567890","")="ITM" Q "ITM" I $G(NUMBER),$TR(NUMBER,"1234567890","")="ITZ" Q "ITZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHZ" Q "IHZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHB" Q "IHB" I $G(NUMBER),$TR(NUMBER,"1234567890","")="IHBZ" Q "IHBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="[-]" Q "IHBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="Z" Q "HBZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="T" Q "TM" I $G(NUMBER),$TR(NUMBER,"1234567890","")="HZ" Q "HZ" I $G(NUMBER),$TR(NUMBER,"1234567890","")="HZMH" Q "HZMH" ; I $L($G(%ARG("DOC"))) S D=%ARG("DOC") I $G(D)="" S D=$$GETP^%W1PRM("DOC") Q D ; IHBTM(NOM) ; I $G(%ARG("IHBTM")) Q 1 I '$G(NOM) Q 0 D GLTMP I $D(@GLTMP@("ITM"))>9 Q 1 I $D(@$$GL@(NOM,"ITM"))>9 Q 1 I $D(@$$GL@(NOM,"ITZ"))>9 Q 1 Q 0 ; GETTMP(NOM) ; D GLTMP I '$G(NOM) Q 1 I $$INP,$D(@GLTMP)=11 Q 1 Q 0 ; ; COPYORD2INVOICE(PRM) ; D PUT^%W3DEB("W4DOC-COPYORD","PRM=PRM") N ORG,NOMORD,NOM,SUG,I,PRMAM,NUMBER,NOM,NUMBERORD,DOC ; S ORG=$P(PRM,";",1),SUG="O" I ORG["_I" S ORG=$P(ORG,"_I"),SUG="I" ; S NUMBERORD=$P(PRM,";",2) S NUMBER=$P(PRM,";",3) S NOMORD=NUMBERORD S PRMAM=$P(PRM,";",4) S DOC=$P(PRM,";",5) ; I SUG="O" D .I DOC="HZ" S NOMORD=$$^W4ORDD(ORG,NUMBERORD) .I DOC="HZMH" S NOMORD=$G(@$$^W4GL("W4DIR")@(DOC,+NUMBERORD)) ; I $$INP S PRMAM=0 ; I 'NOMORD Q "NOORD" I SUG="I",'NUMBER Q "NOHB" ; S NOM=$$NOM(NUMBER) ; N W4INP,W4ORD S W4INP=$$^W4GL("W4INP") S W4ORD=$$^W4GL("W4ORD") I DOC="HZMH" S W4ORD=$$^W4GL("W4DOC") N VD S VD=DOC ;; S VD=$$GETP^%W1PRM("DOC") ; I SUG="I",$L(VD),$D(@W4INP@(ORG,VD,NOM,1)) Q "DOCEXIST" I SUG="O",NOM,$D(@$$^W4GL("W4DOC")@(NOM,1)) Q "DOCEXIST" ; N BELONG S BELONG=$$BELONG(NOMORD,VD,NOM) I BELONG,DOC'="HZMH" Q "ORDBELONG2DOC;"_BELONG I BELONG,DOC="HZMH" Q "PRICEOFFERBELONG2DOC;"_BELONG ; D GLTMP K @GLTMP ; I SUG="I" S @GLTMP=$G(@W4INP@(ORG,"IHZ",NOMORD)) ; S @GLTMP@("ORD")=NUMBERORD ; I SUG="I" D .F I=1:1 Q:'$D(@W4INP@(ORG,"IHZ",NOMORD,I)) D ..S @GLTMP@(I)=$G(@W4INP@(ORG,"IHZ",NOMORD,I)) ; I SUG="O" D .F I=1:1 Q:'$D(@W4ORD@(NOMORD,I)) D ..S @GLTMP@(I)=$G(@W4ORD@(NOMORD,I)) ..I PRMAM,'$$INP D ...N A S A=$G(@GLTMP@(I)) ...I '$P(A,"\",11) D ....S $P(@GLTMP@(I),"\",3)=$J($P(@GLTMP@(I),"\",3)*(100+$$MAM^W4PRM)*.01,2,2) ..I 'PRMAM D ...N A S A=$G(@GLTMP@(I)) ...I $P(A,"\",11) D ....N AHMAM S AHMAM=$P(A,"\",5) ....S $P(@GLTMP@(I),"\",3)=$J($P(@GLTMP@(I),"\",3)*100/(100+AHMAM)*.01,2,2) ; Q "OK" ; ; EXISTORD(ORD) N ORG,VD,NOM S ORG=$P(ORD,";",2),VD=$P(ORD,";",3),ORD=$P(ORD,";") I ORG="" Q 0 I 'ORD Q 0 ; I ORG["_I",$E(VD)'="I" S VD="I"_VD ; I $E(VD)'="I",ORG'["_I" D Q +NOM .I ORD["HZMH" S NOM=$G(@$$^W4GL("W4DIR")@("HZMH",+ORD)) Q .S NOM=$$^W4ORDD(ORG,+ORD) ; S ORG=$P(ORG,"_") Q $D(@$$^W4GL("W4INP")@(ORG,"IHZ",ORD,1)) ; ; BELONG(ORD,VDOC,NOM) Q $$^W4BLNORD(ORD,$G(VDOC),$G(NOM)) ; COLOR(STAM) ; Q $$COLOR^W4LKH ; SIZE(STAM) ; Q $$SIZE^W4LKH ; NODISCST(STAM) ; Q $$NODISCST^W4LKH ; SMBMTB(STAM) ; Q $$^W4SMBMTB ; SELMTB ; N A,N W "
    "_$$^%W1DICT("CODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("SERIAL")_""_$$^%W1DICT("EM")_""_$$^%W1DICT("COLOR")_""_$$^%W1DICT("SIZE")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("DISCPERCENT")_""_$$^%W1DICT("BEFORETAX")_""_$$^%W1DICT("AFTERTAX")_""_$$^%W1DICT("COMMENT")_"
    " W $$INPCODE(PRM) W ""_$$INPNAME(PRM)_""_$$INPSERNUM(PRM)_"" . W $$INPEM(PRM) .W ""_$$INPCOLOR(PRM)_""_$$INPSIZE(PRM)_""_$$INPPRC(PRM)_""_$$INPQN(PRM)_""_$$INPQN(PRM)_""_$$INPPRC(PRM)_""_$$INPDISC(PRM)_""_$$INPCMNST(PRM)_"
    "_$$^%W1DICT("TOTAL")_" 
    "_$$^%W1DICT("AFTERTAX")_" 
    "_$$^%W1DICT("DISCPERCENT")_" " W "" W ""_DISCA_" "_$$SMBMTB_"
    "_$$^%W1DICT("DISCNIS")_" " W "" W " "_$$SMBMTB W "
    "_$$^%W1DICT("DLVPAY")_" " W "" W " "_$$SMBMTB W "
    "_$$^%W1DICT("TOTAL")_" 
    "_$$^%W1DICT("IGUL")_" 
    "_$$^%W1DICT("TOTALROUNDED")_" 
     
    "_$$^%W1DICT("TAX",AHMAM)_" 
    ",! W "" W " ",! W "
    " W "   "_$$^%W1DICT("CURRENCY")_" " W "",! W "
    ",! Q ; CHNPRC(PRM) ; N SH,EM,PRCO,EMO S SH=$P(PRM,";") I 'SH Q "-" S EM=$P(PRM,";",2) ; S PRCO=$$PRC(0,SH) S EMO=$$EM(0,SH) Q $J(PRCO*$$NEWKF^W4PRT(EM,EMO),2,2) ; ERUADET ; N (JB,%ARG,%REM,NOM,VW) W "",! W "" W "",! ; W "",! ; W "",! ; W "",! ; W "",! ; W "",! ; W "",! W "",! W "
    " W $$^%W1DICT("ERUADATE")_" " W "",! I '$D(VW) D ^%W1DAT("ERUADATE",$$ERUADATE(NOM)) I $D(VW) W $$RKV($$ERUADATE(NOM)) W "" W $$^%W1DICT("ERUATIME") W "" I '$D(VW) D TIME^%W1DAT("ERUATIME",$$ERUATIME(NOM)) I $D(VW) W $$RKV($$ERUATIME(NOM)) W "" W "   " W $$^%W1DICT("GUESTSNUMBER")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$GUESTS(NOM)) W "" W "   " W $$^%W1DICT("MAZMIN")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$H2U^%L1FRM($$MAZMIN(NOM))) W "" W "   " W $$^%W1DICT("PELE")_$$NBSP^%L1FRM(3) I '$D(VW) D .W "" I $D(VW) W $$RKV($$PELEMAZMIN(NOM)) W "
    ",! Q ; RKV(VL) N ST S ST="" S ST=ST_VL S ST=ST_"" Q ST ; W4DOCDEL W4DOCDEL(VD,NOM) ; [ 27.12.15 19:01 ] [ I '$G(NOM) Q 0 I $G(VD)="" Q 0 I $D(@$$^W4GL("W4DOC")@(+NOM,VD,"DEL")) Q 1 I $D(@$$^W4GL("W4DOC")@(+NOM,VD,"DELETED")) Q 1 Q 0 ; DELETED(NUMBER) ; N GL S GL=$$GL^W4DOC(NUMBER) I $D(@GL@(+NUMBER,"DELETED")) Q 1 Q 0 W4DOCVW W4DOCVW ; [ 12.11.24 18:41 ] [ 11.04.23 12:45 ] [ 31.01.19 11:05 ] N (JB,%ARG,%REM) S NUMBER=$G(%ARG("NUMBER")) D PUT^%W1PRM("DOCVWNUMBER",NUMBER) I $G(%ARG("LKH")) D PUT^%W1PRM("LKH",$TR(%ARG("LKH"),"-","")) ; I $$^W4NOBACK S %ARG("SHOW")=1 ; D TYPDOC(NUMBER) ; --> DOC ; S NUMBER=+NUMBER ; S NOM=$$NOM($G(DOC),NUMBER) ; --> IN ^W4DOC ; S SPK=$$SPK I $$INP,SPK="" D ER("SUPPLIER NOT DEFINED !") Q ; I DOC="HBW" I 'NOM D ER("INVOICE "_NUMBER_" NOT EXIST !") Q I DOC="TZ" I 'NOM D ER("DEBET INVOICE "_NUMBER_" NOT EXIST !") Q I DOC="TM" I 'NOM D ER("SHIPPING RECORD "_NUMBER_" NOT EXIST !") Q I DOC="TMZ" I 'NOM D ER("BACK SHIPPING RECORD "_NUMBER_" NOT EXIST !") Q I DOC="ITZ" I 'NOM D ER("BACK SHIPPING RECORD "_NUMBER_" NOT EXIST !") Q I DOC="IHZ"!(DOC="HZ") I 'NOM D ER("ORDER "_NUMBER_" NOT EXIST !") Q I DOC="HZMH" I 'NOM D ER("PRICE OFFER "_NUMBER_" NOT EXIST !") Q I 'NOM Q ; D .D GLTMP K @GLTMP .M @GLTMP=@$$GL^W4DOC@(NOM) ; S DAT=$$DAT(NOM) S LKH=$$LKH(NOM) S PRV=$$PRV(NOM) S MTB=$$MTB(NOM) S:'MTB MTB=1 S %ARG("MTB")=MTB S SMBMTB=$$^W4SMBMTB ; D PUT^%W3DEB("W4DOCVW","DAT=DAT&LKH=LKH&PRV=PRV&DOC=DOC") ; D KOTHSB(NUMBER,LKH,DAT,DOC) ; D DAF1 ; I $G(%ARG("NEWDOC")) K %ARG("NOM") S NOM=0 ; I $G(DOC)="HZMH",$$ERUA^W3PRM D .W $$^%W1DICT("CANCELERUA",24) .W "

    ",! ; D DIVBUT(DOC,NUMBER,PRV) ; S W4DOC="" D TBLCOPY^W4HSBYVW ; D DIVSIGN^W4LHBVW ; W "
    ",! Q ; ; KOTHSB(NMB,LKH,DAT,DOC) ; D ^W4KOTHSB(NMB,LKH,DAT,DOC) ; I $G(DOC)="HZ"!($G(DOC)="HZMH") D .W "",! . W "" . W "" . W "" . W "" . W "",! .W "
     " . W $$H2U^%L1FRM(HB) . W " 
    ",! ; I $G(DOC)="IHB"!($G(DOC)="ITM")!($G(DOC)="HBW")!($G(DOC)="TM")!($G(DOC)="TMZ") D .W "",! . W "" . W "",! . W "" . W "" . W "" .W "
    " . N ORD,ORDN S ORD=$$ORD(LKH,DOC,NMB),ORDN=+ORD S:'ORDN ORDN="" . N NMORD S NMORD="ORDER" . I ORD["HZMH" S NMORD="PRICEOFFER" . W $$^%W1DICT(NMORD) . W "" .. W ORDN . E D .. W ";cursor:pointer"" onClick=""ShowCustOrd('"_LKH_"','"_ORD_"')"" " .. W ">" .. W ORDN . W " 
    ",! ; N GL S GL=$$GL^W4DOC S NMB=+$G(NMB) I $D(@GL@(NMB,"ITM"))>9!($D(@GL@(NMB,"ITZ"))>9) D LISTTM^W4DOC($E(GL,1,$L(GL)-1)_","""_NMB_""")") Q ; ORD(ORG,DOC,NMB) ; I $E(DOC)="I" Q $G(@$$^W4GL("W4INP")@(ORG,"IHB",+NMB,"ORD")) ; S ORD=$G(@$$^W4GL("W4DOC")@(+$$NOM(DOC,+NMB),"ORD")) Q ORD ; ; LTR(STAM) Q $$LTR^W4DOC ; ---- NOM AS PARAMETER HBZ OR NO ; TD W "" Q TDLTR D TDLTR^W4DOC ; ---- NOM AS PARAMETER HBZ OR NO Q TDLTR1 D TDLTR W " class=""tdbd"" >" ; ---- NOM AS PARAMETER HBZ OR NO Q TDLTR2 S DOC=$G(DOC) W " ",! Q ; ; DAF1 ; N (JB,%ARG,%REM,LKH,DAT,NOM,DOC,SMBMTB) ;------ NOM - NOMER V ^W4DOC D DAFBODY(NOM) ; D SPACETR ; D TOT^W4DOC(NOM) ; W "" D SPACE W ""_$$^%W1DICT("TOTAL")_$$REVAH_"" ;;D TDLTR W " id=""bftot""> "_$J(SHUMLD*100/(100+$$AHMAM(NOM)),2,2)_" "_SMBMTB_" " D TDLTR W " id=""bftot""> "_$J(BFMAM,2,2)_" "_SMBMTB_" " W "",! ; W "" D SPACE W " "_$$^%W1DICT("AFTERTAX")_" " D TDLTR W " id=""tot""> "_$J($G(SHUMLD),2,2)_" "_SMBMTB_" " W "" W "",! ; I DISCA D .W "" . D SPACE . W "" W $$^%W1DICT("DISCPERCENT")_" " . W $$DISCPRC(NOM) . W "" . D TDLTR2 W " id=""disca""> "_$J(DISCA,2,2)_" "_SMBMTB_" " .W "",! ; I $$DISCNIS(NOM) D .W "" .D SPACE .W ""_$$^%W1DICT("DISCNIS")_" ",! .D TDLTR2 W "> " . W $J($$DISCNIS(NOM),2,2)_" "_SMBMTB_" " .W "" .W "" .W "",! ; I $$DMSH(NOM) D .W "" .D SPACE .W " "_$$^%W1DICT("DLVPAY")_" " .D TDLTR W "> " . W $J($$DMSH(NOM),2,2)_" "_SMBMTB_" " .W " " .W " " .W "",! ; I $$^W4NOIGUL!'IGUL D .D SHOWMAM ; I DISCA!($$DISCNIS(NOM))!($$DMSH(NOM)) D .W "" . D SPACE . W " "_$$^%W1DICT("TOTAL")_" " . D TDLTR W " id=""total"" "_$S($$^W4NOIGUL!'IGUL:$$BOLET,1:"")_" >" . W " "_$J(SHUM-IGUL,2,2)_" "_SMBMTB_" " . W "" .W "",! ; I '$$^W4NOIGUL,IGUL D .W "" . D SPACE . W ""_$$^%W1DICT("IGUL")_" " . D TDLTR W " id=""igul""> "_$J(IGUL,2,2)_" "_SMBMTB_" " . W "" .W "",! .; .D SHOWMAM . .W "" D SPACE . W ""_$$^%W1DICT("TOTALROUNDED")_" " . D TDLTR W " id=""itot"" "_$$BOLET_" > "_$J($J(SHUM,0,0),2,2)_" "_SMBMTB_" " . W "" .W "",! ; ; ET ; W "",! ; W "

    " W "
    ",! W "
    ",! I $L($$CMNT(NOM)) D .W $$^%W1DICT("COMMENT")_" : " .W ""_$$CMNT(NOM)_"" .I $$PRV(NOM) W "   [ "_$$^%W1DICT("PRIVATEINF")_" ]" W "
    ",! W "
    ",! Q ; BOLET(STAM) Q "style=""font-weigt:bold;font-size:"_$$^W3FSZ(16)_""" " ; DAFBODY(NOM) ; I '$D(NOM) S NOM=0 S SMBMTB=$$^W4SMBMTB ; I $$PRMAM(NOM),'$$INP D .W "",! .W " " .W " " .W " ",! .W "
    " .W " "_$$^%W1DICT("PRICEINCLUDEDTAX")_" " .W "
    ",! ; W "
    ",! ; I $$ERUA^W3PRM D ERUADET ; I $$INP D .W "",! .W "" . W "" . W "",! . W "" .W "",! .W "
    " D FND^W4TKDOC1 W "" . W $$^%W1DICT("*CODEWITHOUTMAM") . W " 
    ",! ; S COLST=$$COLST(NOM) ; W "",! ; W "" W " ",! ; W " ",! ; I $$SERNUM^W3PRM D .W " ",! ; I $$INP D .W " ",! ; I $$COLOR D .W " ",! ; I $$SIZE D .W " ",! ; I '$$^W4MLQNMH D .W " ",! .W " ",! I $$^W4MLQNMH D .W " ",! .W " ",! ; I '$$NODISCPRC(NOM) D .W " ",! ; W " ",! ;;W " ",! ; I $$CMNST^W4LKH,'$$NOCMNST(NOM) D .W " ",! W "",! ; F I=1:1:COLST D .I $$NODATA(NOM,I) Q .; .W "" .D ..W " ",! . .S DIRNAME=$$DIRNAME .N NAME S NAME=$$SHOWNAME($$NAME(NOM,I)) .I NAME="" S NAME=" " .W " ",! .I $$SERNUM^W3PRM D ..W " ",! .I $$INP D ..W " ",! .I $$COLOR D ..W " ",! .I $$SIZE D ..W " ",! . . .I '$$^W4MLQNMH D TDPRC,TDQN .I $$^W4MLQNMH D TDQN,TDPRC . .I '$$NODISCPRC(NOM) D ..W " ",! . .W " ",! .;;W " ",! . .I $$CMNST^W4LKH,'$$NOCMNST(NOM) D ..W " ",! .W "",! Q ; ; TDPRC ; W " ",! Q ; TDQN ; D TDLTR1 W $$REVAH_$$NUM($$QN(NOM,I))_$$REVAH_"",! Q ; SHOWMAM ; W "" D SPACE W " " D TDLTR W " id=""lmam""> "_$J(SHUM-MAM,2,2)_" "_SMBMTB_" " W "" W "",! ; S AHMAM=$$AHMAM(NOM)_"%" W "" D SPACE W "" D TDLTR W " id=""tax""> "_$J($G(MAM),2,2)_" "_SMBMTB_" " W "" W "",! Q ; GETDAT(STAM) Q $$GET^%W1PRM("DAT") ; GETDOC(STAM) ; Q $$GET^%W1PRM("DOC") ; GETPRMAM(STAM) Q $$GET^%W1PRM("PRMAM") ; COLST(NOM) Q $$COLST^W4DOC(NOM) ; GET(NOM,SH,NRZ) Q $$GET^W4DOC(NOM,SH,NRZ) ; CODE(NOM,SH) ; Q $$CODE^W4DOC(NOM,SH) ; NAME(NOM,SH) ; Q $$NAME^W4DOC(NOM,SH) ; SERIAL(NOM,SH) ; Q $$SERIAL^W4DOC(NOM,SH) ; EM(NOM,SH) ; N EM S EM=$$EM^W4DOC(NOM,SH) S EM=$$SPA^%L1FRM(EM) I $$ISNUM^%L1FRM(EM) Q $$H2U^%L1FRM($G(@$$^W4GL("MLMIDA")@(EM))) ; I $E(EM)?1N S EM=$P(EM," ",2,20) Q $$H2U^%L1FRM(EM) ; CLR(NOM,SH) ; N CLR S CLR=$$CLR^W4DOC(NOM,SH) I $P(CLR," ")=0 Q " " I $E(CLR)?1N S CLR=$P(CLR," ",2,20) Q $$H2U^%L1FRM(CLR) ; SZ(NOM,SH) ; N SZ S SZ=$$SZ^W4DOC(NOM,SH) I $P(SZ," ")=0 Q " " I $E(SZ)?1N S SZ=$P(SZ," ",2,20) Q $$H2U^%L1FRM(SZ) ; PRC(NOM,SH) ; Q $$PRC^W4DOC(NOM,SH) ; QN(NOM,SH) ; Q $$QN^W4DOC(NOM,SH) ; DISC(NOM,SH) ; Q $$DISC^W4DOC(NOM,SH) ; BFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " I $$PRMAM(NOM),'$$INP Q $J($$SUMST(NOM,SH)*100/(100+$$AHMAM(NOM)),2,2) Q $J($$SUMST(NOM,SH),2,2) ; AFTAX(NOM,SH) ; I '$$QN(NOM,SH)!'$$PRC(NOM,SH) Q " " I '$$PRMAM(NOM)!$$INP Q $J($$SUMST(NOM,SH)*(100+$$AHMAM(NOM))*.01,2,2) Q $J($$SUMST(NOM,SH),2,2) ; SUMST(NOM,SH) Q $J($$QN(NOM,SH)*$$PRC(NOM,SH)*(100-$$DISC(NOM,SH))*.01,2,2) ; CMNST(NOM,SH) ; Q $$CMNST^W4DOC(NOM,SH) ; LASTNOM(STAM) Q $O(@GL@(999999),-1) ; LKH(NOM) ; Q $$LKH^W4DOC(NOM) ; LKHNAME(NOM) ; Q $$LKHNAME^W4DOC(NOM) ; KTV(NOM) ; Q $$KTV^W4DOC(NOM) ; DAT(NOM) ; Q $$DAT^W4DOC(NOM) ; AHMAM(NOM) ; Q $$AHMAM^W4DOC(NOM) ; SUMTD(NOM) ; Q $$SUMTD^W4DOC(NOM) ; MAM(NOM) ; Q $$MAM^W4DOC(NOM) ; ISSUE(NOM) ; Q $$ISSUE^W4DOC(NOM) ; CMNT(NOM) ; Q $$CMNT^W4DOC(NOM) ; PRV(NOM) ; Q $$PRV^W4DOC(NOM) ; MTB(NOM) ; Q $$MTB^W4DOC(NOM) ; IGUL(NOM) ; Q $$IGUL^W4DOC(NOM) ; PRMAM(NOM) ; Q $$PRMAM^W4DOC(NOM) ; DISCPRC(NOM) ; Q $$DISCPRC^W4DOC(NOM) ; DISCNIS(NOM) ; Q $$DISCNIS^W4DOC(NOM) ; DMSH(NOM) ; Q $$DMSH^W4DOC(NOM) ; HRA(NOM) ; Q $$HRA^W4DOC(NOM) ; TZ(NOM) ; Q $$TZ^W4DOC(NOM) ; DIRNAME() Q $$DIRNAME^W4DOC ; SHOWNAME(NAME) ; Q $$SHOWNAME^W4DOC(NAME) ; NUM(RKV) I 'RKV Q " " Q RKV ; SPACE D TDN,TDN I $$SERNUM^W3PRM D TDN I $$INP D TDN I '$$NODISCPRC(NOM) D TDN I $$COLOR D TDN I $$SIZE D TDN Q ; SPACETR W "" D TDN,TDN I $$SERNUM^W3PRM D TDN I $$INP D TDN D TDN,TDN,TDN I '$$NODISCPRC(NOM) D TDN W "",! Q ; PRMTZMAM(STAM) ; Q $$PRMTZMAM^W4HSBYAD ; ; NOM(DOC,NUMBER) ; N NOM ; I DOC="ITM"!(DOC="IHB")!(DOC="ITZ")!(DOC="IHBZ")!(DOC="IHZ") Q NUMBER ; ;;I DOC="HZMH"!$$HZMH^W4LHB S NOM=$G(@$$^W4GL("W4DIR")@("HZMH",+NUMBER)) Q NOM I DOC="HZMH"!(NUMBER["HZMH") S NOM=$G(@$$^W4GL("W4DIR")@("HZMH",+NUMBER)) Q NOM ; I DOC="HZ" D Q NOM .S NOM=0 S LKH=$$GETP^%W1PRM("LKH") Q:LKH="" .S NOM=$$^W4ORDD(LKH,+NUMBER) ; I $$TM^W4LHB S NOM=$P($G(@$$^W4GL("KLIN")@("TM",+NUMBER)),"W",2) Q NOM I $$TMZ^W4LHB S NOM=$P($G(@$$^W4GL("KLIN")@("TMZ",+NUMBER)),"W",2) Q NOM ; I $L($G(DOC)) D I NOM Q NOM .N CODDOC S CODDOC=$$CODDOC^W4KOTHSB(DOC) .S NOM=$P($G(@$$^W4GL("KLIN")@(CODDOC,+NUMBER)),"W",2) ; S NOM=$G(@$$^W4GL("W4DIR")@("H",NUMBER)) ; --- WAS HB 13/12/16 I NOM="" S NOM=$P($G(@$$^W4GL("KLIN")@("H",NUMBER)),"W",2) Q NOM ; ; NODISCPRC(NOM) ; N COLST S COLST=$$COLST(NOM) N OK S OK=0 N I F I=1:1:COLST I $$DISC(NOM,I) S OK=1 Q Q 'OK ; NOCMNST(NOM) ; N COLST S COLST=$$COLST(NOM) N OK S OK=0 N I F I=1:1:COLST I $$CMNST(NOM,I)'="" S OK=1 Q Q 'OK ; NODATA(NOM,SH) ; I $$CODE(NOM,SH)'="" Q 0 I $$NAME(NOM,SH)'="" Q 0 I $$PRC(NOM,SH) Q 0 I $$QN(NOM,SH) Q 0 I $$DISC(NOM,SH) Q 0 I $$BFTAX(NOM,SH) Q 0 I $$AFTAX(NOM,SH) Q 0 Q 1 ; COPY(PRM) ; N GL,GLTMP,NOM,DAT,LKH S NOM=$P(PRM,";") Q:'NOM S DAT=$P(PRM,";",2) Q:'DAT D PUT^%W1PRM("DAT",DAT) S LKH=$$LKH(NOM) D PUT^%W1PRM("LKH",LKH) S GL=$$GL^W4DOC D GLTMP K @GLTMP N I F I=1:1 Q:'$D(@GL@(NOM,I)) D .M @GLTMP@(I)=@GL@(NOM,I) ; S @GLTMP=$$DISCPRC(NOM)_"\"_$$DISCNIS(NOM)_"\"_$$DMSH(NOM)_"\"_$$HRA(NOM) Q ; GLTMP ; D GLTMP^W4DOC Q ; REVAH(STAM) ; Q "  " ; CSR(STAM) ; Q $$CSR^W4LCBCR ; CSRPRINT(NMB) ; Q $$^W4PCHMK(NMB) ; DIVBUT(DOC,NUMBER,PRV) ; W "
    ",! W "
    "_$$^%W1DICT("CODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("SERIAL")_""_$$^%W1DICT("EM")_""_$$^%W1DICT("COLOR")_""_$$^%W1DICT("SIZE")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("QUANTITY")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("DISCPERCENT")_""_$$^%W1DICT("BEFORETAX")_""_$$^%W1DICT("AFTERTAX")_""_$$^%W1DICT("COMMENT")_"
    " .. D .. .N PREF S PREF=" " .. .N CD S CD=$$CODE(NOM,I) .. .I $$INP,'$$MLMAM^W4MLPRT(CD) S PREF="*" .. .W PREF_CD ..W ""_$$REVAH_NAME_""_$$REVAH_$$SERIAL(NOM,I)_""_$$REVAH_$$EM(NOM,I)_""_$$REVAH_$$CLR(NOM,I)_""_$$REVAH_$$SZ(NOM,I)_""_$$REVAH_$$NUM($J($$DISC(NOM,I),2,2))_" "_$$REVAH_$$NUM($$BFTAX(NOM,I))_" "_SMBMTB_" "_$$REVAH_$$NUM($$AFTAX(NOM,I))_" "_SMBMTB_" " .. W $$REVAH_$$H2U^%L1FRM($$CMNST(NOM,I)) ..W "
    " W $$REVAH_$$NUM($$PRC(NOM,I))_" "_SMBMTB W "
    "_$$^%W1DICT("BEFORETAX")_" 
    "_$$^%W1DICT("TAX",AHMAM)_" 
    ",! W "" I $G(DOC)="HZMH",'$$VIEWONLY D .W "" .W "" ; W "" W "" ; I $$CSR,$E($TR(NUMBER,"0123456789",""))'="I",$E($G(DOC))'="I" D . W "" . W "",! ; I $$VIEWONLY G EX ; I DOC="ITM"!(DOC="IHB")!(DOC="IHBZ")!(DOC="IHZ")!(DOC="HZ")!(DOC="HZMH") D .I DOC="ITM",'$$FREE($$SPK,"ITM",NUMBER) Q .I DOC="IHZ"&$$DELETED(%ARG("NUMBER")) Q .I $E(DOC)="I" N W4HSB D ^W4HSBGET(NUMBER,DOC,SPK) . .D:'$G(W4HSB("PAID")) .. N NOM .. I DOC="IHZ"&$$PRINTED(%ARG("NUMBER")) Q .. I DOC="HZ"!(DOC="HZMH"),$$ORDV^W4BLNORD(LKH,%ARG("NUMBER")) Q ; I $$BLNG^W4ORDD(NOM) Q .. W "" .. W "",! . . W "" . W "",! . . I DOC="IHB",$D(@$$^W4GL("W4INP")@(SPK,"IHB",+NUMBER,"ITM")) D .. W "" . I DOC="TM"!(DOC="TMZ")!(DOC="HBW") D .N DOC1 S DOC1=DOC I DOC1="HBW" S DOC1="H" .I $$DEL(DOC1,$$NOM(DOC,NUMBER)) Q .W "",! ; I '$$VIEWONLY,$$FROMHB!($$GETP^%W1PRM("VD")="TM") D .W "" .I '$$^W4NOBACK D ..W "" EX ; I '$$^W4NOBACK D .W "" ; W "" W "" ; W "",! W "
    " . W $$^%W1DICT("HIDEPRICES")_"  " . W "" .W " " D ^W4BUTTON("Print",$$^%W1DICT("PRINT"),"PrintAndBack('"_PRV_"')","color:green") W " " . D ^W4BUTTON("CSRPrint",$$^%W1DICT("CSRPRINT"),"CSRPrint('"_NUMBER_"','"_DOC_"','"_$$SPK_"')","color:green") . W " " .. D UPDBUT .. W " " . D . .I DOC="IHZ",SPK'="",$$CLOSEBYHB^W4SPDOC(SPK,DOC,NUMBER) W " " Q . .I DOC="IHZ" D CANCELBUT Q . .I DOC="HZ"!(DOC="HZMH"),$$ORDV^W4BLNORD(LKH,%ARG("NUMBER")) Q ; I $$BLNG^W4ORDD(NOM) Q . .I $G(W4HSB("PAID")) W " " Q . .D DELBUT . W " " .. D TMLIST .. W "" .D ..D DELBUT .W "" . N TXTCOPY . S TXTCOPY="COPY2NEWDOC" . D ^W4BUTTON("Copy",$$^%W1DICT(TXTCOPY),"Copy2NewInvoice()","color:darkblue") .W " " . D ^W4BUTTON("Back",$$^%W1DICT("BACK"),"Back()","color:red") .W " " W "
    ",! Q ; UPDBUT ; N ORG S ORG=$$SPK I DOC="HZ",$G(%ARG("LKH")) S ORG=$G(%ARG("LKH")) D ^W4BUTTON("Update",$$^%W1DICT("UPDATE"),"Update('"_DOC_"','"_ORG_"','"_NUMBER_"')","color:darkgreen") Q ; TMLIST ; N ORG S ORG=$$SPK D ^W4BUTTON("tmlist",$$^%W1DICT("DLVDOCLIST"),"DlvDocList('"_ORG_"','"_NUMBER_"')","color:darkgreen") Q ; DELBUT ; N ORG,NMB,DEL S ORG=$G(%ARG("LKH")),NMB=$G(%ARG("NUMBER")) I ORG="",$$SPK'="" S ORG=$$SPK S DEL=$$^%W1DICT("CANCEL") I $E(DOC)="I" S ORG=$$SPK,NMB=NUMBER,DEL=$$^%W1DICT("DELETE") D ^W4BUTTON("Delete",DEL,"Delete('"_DOC_"','"_ORG_"','"_NUMBER_"','0')","color:red") Q ; CANCELBUT ; D ^W4BUTTON("Delete",$$^%W1DICT("CANCEL"),"Delete('"_DOC_"','"_$$SPK_"','"_NUMBER_"','1')","color:red") Q ; PRINTED(NUMBER) ; N GL S GL=$$GL^W4DOC(NUMBER) I $D(@GL@(+NUMBER,"PRINTED")) Q 1 Q 0 ; DELETED(NUMBER) ; Q $$DELETED^W4DOCDEL(NUMBER) ; FROMHB(STAM) ; I $$GETP^%W1PRM("VD")="H" Q 1 I $$GETP^%W1PRM("VD")="" Q 1 Q 0 ; INP(STAM) Q $E($G(%ARG("DOC"))="I")!($E($TR($G(%ARG("NUMBER")),"0123456789",""))="I") ; DELDOC(PRM) ; N VD,SPK,NOM,VDTM,VDTM1,ND,DELALL,CNC S VD=$P(PRM,";") S SPK=$P(PRM,";",2) I SPK["_" S SPK=$P(SPK,"_") I SPK="" Q "WRONGORG" S NOM=+$P(PRM,";",3) S DELALL=$P(PRM,";",4) S CNC=$P(PRM,";",5) D PUT^%W3DEB("W4DOCVW-DELDOC","PRM=PRM&VD=VD&SPK=SPK&NOM=NOM") ; I $E(VD)'="I" Q $$DELOUTDOC(VD,SPK,$P(PRM,";",3)) ; N GLINP S GLINP=$$^W4GL("W4INP")_"("""_SPK_""","""_VD_""","""_NOM_""")" N A S A=$G(@GLINP) I A="" Q "NODOC" N DT S DT=$$^%L1DC($P(A,"\",4),3) I 'DT Q "WRONGDATE" ; I VD="IHZ" D Q "OK" .N J F J=6,7,10,13,14 S $P(@GLINP,"\",J)=0 .N LAST S LAST=$O(@GLINP@(99999),-1) .N I F I=1:1:LAST S A=$G(@GLINP@(I)) D ..N J F J=4,5 D ...S $P(A,"\",J)=-$P(A,"\",J) ..S @GLINP@(LAST+I)=A .S @GLINP@("DELETED")=$H ; I VD="IHB"!(VD="IHBZ") D .F VDTM="ITM","ITZ" D ..N N S N="" F S N=$O(@GLINP@(VDTM,N)) Q:N="" D ...S VDTM1=VDTM,ND=N I N<0 S ND=-N,VDTM1="ITZ" ...I VD="IHBZ" S VDTM1="ITZ" ...S ND=+ND ...I 'DELALL S @$$^W4GL("W4FREEDOC")@(SPK,VDTM1,ND)=DT_"\"_$ZD($H,"DD.MM.YY 24:60") ...K @$$^W4GL("W4INP")@(SPK,VDTM1,ND,VD) ...D ^W4GIB("K",$$^W4GL("W4INP"),SPK_";"_VDTM1_";"_ND_";"_VD) ...Q:'DELALL ...D DELDOC^W4SETMLY(VDTM1,SPK,ND) ...M @$$^W4GL("W4INPDEL")@(SPK,VDTM1,ND)=@$$^W4GL("W4INP")@(SPK,VDTM1,ND) ...D ^W4GIB("S",$$^W4GL("W4INPDEL"),SPK_";"_VDTM1_";"_ND_";"_VD) ...K @$$^W4GL("W4INP")@(SPK,VDTM1,ND) ...D ^W4GIB("K",$$^W4GL("W4INP"),SPK_";"_VDTM1_";"_ND_";"_VD) ; K @$$^W4INPDIR@(DT,SPK,VD,+NOM) D ^W4GIB("K",$$^W4INPDIR,DT_";"_SPK_";"_VD_";"_+NOM) D DELDOC^W4SETMLY(VD,SPK,+NOM) M @$$^W4GL("W4INPDEL")@(SPK,VD,+NOM)=@$$^W4GL("W4INP")@(SPK,VD,+NOM) D ^W4GIB("S",$$^W4GL("W4INPDEL"),SPK_";"_VD_";"_+NOM) K @$$^W4GL("W4INP")@(SPK,VD,+NOM) D ^W4GIB("K",$$^W4GL("W4INP"),SPK_";"_VD_";"_+NOM) Q "OK" ; ; DELOUTDOC(VD,LKH,NUMBER) N NOM S NOM=$$NOM(VD,+NUMBER) I 'NOM Q 0 ; N TM S TM=(VD="TM") N TMZ S TMZ=(VD="TMZ") ; N GL S GL=$$GL^W4DOC ; I 'TM,'TMZ D .D GLTMP K @GLTMP .M @GLTMP=@GL@(NOM) ; I TM!TMZ D .D DELHB^W4LCBCR(GL_"("""_NOM_""")") ; I VD="HZMH"!(VD="HZ")!(VD="HI") D Q "OK" .N J F J=6,7,10,12,13,14 S $P(@GL@(NOM),"\",J)=0 .N LAST S LAST=$O(@GL@(NOM,99999),-1) .N I F I=1:1:LAST S A=$G(@GL@(NOM,I)) D ..N J F J=4,5 D ...S $P(A,"\",J)=-$P(A,"\",J) ..S @GL@(NOM,LAST+I)=A .S @GL@(NOM,"DELETED")=$H ; N HRA S HRA=$$INVH^%L1FRM($$TV^%W1DICT($$^%W1LNG,$S(TM:"DELDLVDOC",TMZ:"DELDLVBACKDOC",1:"DELINVOICE"),+NUMBER)) N PRM ; S PRM="0;"_$$ORD^W4DOC(LKH,NOM)_";"_$$PRMAM^W4DOC(NOM)_";"_$$TZ^W4DOC(NOM) S PRM=PRM_";"_$$INVH^%L1FRM($$TV^%W1DICT($$^%W1LNG,"DELDOCUMENT",+NUMBER)) S PRM=PRM_";"_$$DISCPRC^W4DOC(NOM)_";"_$$DISCNIS^W4DOC(NOM) S PRM=PRM_";"_$$DMSH^W4DOC(NOM) S PRM=PRM_";"_$$MTB^W4DOC(NOM)_";"_-$$SUMTD^W4DOC(NOM) ; N VDNEW S VDNEW=VD I 'TM,'TMZ S VDNEW="TZ" N VDOLD S VDOLD=$S(TM:"TM",TMZ:"TMZ",1:"H") ; D PUT^%W1PRM("DOC",VDNEW) D PUT^%W1PRM("LKH",LKH) D PUT^%W1PRM("DAT",$ZD($H,"DD.MM.YY")) ; N NDOC S NDOC=$$SUBMIT^W4DOC(PRM) ; N NEWNOM S NEWNOM=$$NOM(VDNEW,+NDOC) S $P(@$$^W4GL("W4DOC")@(NOM),"\",9)=$$TV^%W1DICT($$^%W1LNG,$S(TM:"DELETEDDOCUMENT",1:"DELETEDINVOICE"),+NDOC) S @$$^W4GL("W4DOC")@(NOM,VDOLD,"DELETED")=$H_"\"_+NDOC_"\"_NOM S @$$^W4GL("W4DOC")@(NEWNOM,VDNEW,"DEL")=$H_"\"_+NUMBER_"\"_NEWNOM Q +NDOC ; ; VIEWONLY(STAM) ; I $$VIEWONLY^W3PRM Q 1 I $G(%ARG("VIEWONLY")) Q 1 I $G(%ARG("SHOW")) Q 1 Q 0 ; IHBTM(DOC,NOM) ; I $G(DOC)="IHB",$D(@$$GL^W4DOC@(NOM,"ITM"))>9 Q 1 I $G(DOC)="IHB",$D(@$$GL^W4DOC@(NOM,"ITZ"))>9 Q 1 I $G(DOC)="IHBZ",$D(@$$GL^W4DOC@(NOM,"ITM"))>9 Q 1 I $G(DOC)="IHBZ",$D(@$$GL^W4DOC@(NOM,"ITZ"))>9 Q 1 Q 0 ; FREE(SPK,VD,NDOC) ; I $G(SPK)=""!($G(VD)="")!($G(NDOC)="") Q 0 I $D(@$$^W4GL("W4FREEDOC")@(SPK,VD,NDOC)) Q 1 Q 0 ; PRINT(NUMBER) ; N NOM,DOC D KILL^%W1PRM("MKRYD") I $D(@$$GL^W4DOC(NUMBER)) D .S DOC=$$DEFDOC(NUMBER) Q:DOC="" .S NOM=$$NOM(DOC,NUMBER) .S @$$GL^W4DOC(NUMBER)@(+NOM,"PRINTED")=$H Q 1 ; DEFDOC(NUMBER) I NUMBER,NUMBER?1N.N Q "HBW" N DOP S DOP=$TR(NUMBER,"1234567890","") I DOP="Z" Q "TZ" I DOP="T" Q "TM" I DOP="TMZ" Q "TMZ" Q DOP ; DEL(VD,NOM) ; Q $$^W4DOCDEL(VD,NOM) ; COLOR(STAM) Q $$COLOR^W4LKH SIZE(STAM) Q $$SIZE^W4LKH ; SMBMTB(STAM) ; Q $$^W4SMBMTB ; SPK(STAM) ; N SPK S SPK=$G(%ARG("SPK")) I SPK["_" S SPK=$P(SPK,"_") Q SPK ; TYPDOC(NUMBER) ; S DOC=$$GETDOC^W4DOC ; I NUMBER,NUMBER?1N.N,DOC="" S DOC="HBW" ; I $TR(NUMBER,"0123456789","")="Z" S DOC="TZ",%ARG("VD")="HBZ" I $TR(NUMBER,"0123456789","")="T" S DOC="TM",%ARG("VD")="TM" I $TR(NUMBER,"0123456789","")="TMZ" S DOC="TMZ",%ARG("VD")="TMZ" I $TR(NUMBER,"0123456789","")="HZ" S DOC="HZ",%ARG("DOC")="HZ" I $TR(NUMBER,"0123456789","")="HMK" S DOC="HMK",%ARG("VD")="HMK" I $TR(NUMBER,"0123456789","")="IHB" S DOC="IHB",%ARG("DOC")="IHB" I $TR(NUMBER,"0123456789","")="IHBZ" S DOC="IHBZ",%ARG("DOC")="IHBZ" I $TR(NUMBER,"0123456789 ","")="[-]" S DOC="IHBZ",%ARG("DOC")="IHBZ" I $TR(NUMBER,"0123456789","")="ITM" S DOC="ITM",%ARG("DOC")="ITM" I $TR(NUMBER,"0123456789","")="ITZ" S DOC="ITZ",%ARG("DOC")="ITZ" I $TR(NUMBER,"0123456789","")="IHZ" S DOC="IHZ",%ARG("DOC")="IHZ" I $TR(NUMBER,"0123456789","")="HZMH" S DOC="HZMH",%ARG("DOC")="HZMH" Q ; ; ER(TXT) ; W TXT,! H 2 W "",! Q ; MAILNMDOC(NUMBER) ; I $TR(NUMBER,"0123456789","")="Z" Q "debet%20invoice" I $TR(NUMBER,"0123456789","")="T" Q "delivery%20document" I $TR(NUMBER,"0123456789","")="TMZ" Q "delivery%20back%20document" I $TR(NUMBER,"0123456789","")="HZ" Q "order" I $TR(NUMBER,"0123456789","")="HZMH" Q "Bid" I $TR(NUMBER,"0123456789","")="HMK" Q "tax%20invoice/receipt" I $TR(NUMBER,"0123456789","")="IHB" Q "purchaseier%20invoice" I $TR(NUMBER,"0123456789","")="IHBZ" Q "credit%20invoice" I $TR(NUMBER,"0123456789","")="[-]" Q "purchase%20credit%20invoice" I $TR(NUMBER,"0123456789","")="ITM" Q "purchase%20delivery%20document" I $TR(NUMBER,"0123456789","")="ITZ" Q "purchase%20delivery%20refund%20document" I $TR(NUMBER,"0123456789","")="IHZ" Q "purchase%20order" I NUMBER="INVL" Q "Invoices%20list" Q "invoice" ; NOPCHBCD(STAM) ; I $G(%ARG("PRINT"))&$$NOPCHBCD^W4PRM Q 1 Q 0 ; ERUADET ; N VW S VW="" D ERUADET^W4DOC Q W4DOHMSD W4DOHMSD ; [ 20.02.22 10:24 ] [ 31.05.17 09:44 ] [ 23.12.14 08:13 ] DT ; ;W "METRH="_METRH,! ;W "ADTRH="_ADTRH,! I DTADTRH S OK=2 Q N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) S OK=0 Q ;W DT_" "_$ZD(DT,"DD.MM.YY") S TRH=$ZD(DT,"DD.MM.YY") S OK=1 Q ; HZ ; ;W HZ,! S NMB=$$NMB^W4HZMST(HZ) I NMBADNMB) S OK=0 Q S x1=$$FULLDEL(HZ) S x2=$$SHNH^W4HZMST(HZ) S x3=$$HNHAH^W4HZMST(HZ) S x4=$$HNHA^W4HZMST(HZ) S x5=$$DELNOTEX(HZ) S x6=$$DELEX(HZ) S x7=$$AHP(HZ) S x8=$$TSHL^W4HZMST(HZ) S x9=$$SHUL^W4HZMST(HZ)-$$STIP^W4HZMST(HZ) S x10=$$STIP^W4HZMST(HZ) S x11=$$SHUL^W4HZMST(HZ) S x12=$$ZICCA(HZ) S x13=$$ZICMZM(HZ) Q ; SUM(HZ,I) ; Q $$SUM^W4HZMST(HZ,I) ; FULLDEL(HZ) ; N SBIT,SUM S SBIT=0 I '$$^W4DEL(HZ) Q 0 N I S I="" F S I=$O(@$$^W4ORD@(HZ,I)) Q:I="" D .S SUM=$$SUM(HZ,I) Q:SUM'<0 .I $$AVAR^W4HZMST(HZ,I) Q .S SBIT=SBIT+SUM ; Q SBIT ; ; DELNOTEX(HZ) ; N DNE,ST S DNE=0 N N S N="" F S N=$O(@$$^W4ORD@(HZ,"BIT",N)) Q:N="" D .I $$AVAR^W4HZMST(HZ,I) Q .I $$EX2KITCH^W4HZMST(HZ,N) Q .S DNE=DNE+$$SUM(HZ,N) ; Q DNE ; ; DELEX(HZ) ; N DE,ST S DE=0 N N S N="" F S N=$O(@$$^W4ORD@(HZ,"BIT",N)) Q:N="" D .I $$AVAR^W4HZMST(HZ,I) Q .I '$$EX2KITCH^W4HZMST(HZ,N) Q .S DE=DE+$$SUM(HZ,N) ; Q DE ; ; AHP(HZ) ; N AHP,SUM S AHP=0 N I S I="" F S I=$O(@$$^W4ORD@(HZ,I)) Q:I="" D .I $E($G(^(I)),"\")'="-",$P($G(^(I)),"\")'["%" Q .S SUM=$$SUM(HZ,I) Q:SUM'<0 .S AHP=AHP+SUM ; Q AHP ; ; ZICCA(HZ) ; N ZICCA,SUM S ZICCA=0 N N S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","V",N)) Q:N="" I N D .S SUM=$P($G(^(N)),"*",7) Q:SUM'<0 .S ZICCA=ZICCA+SUM ; Q ZICCA ; ; ZICMZM(HZ) ; N ZICMZM,SUM S ZICMZM=0 N N S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","MZ",N)) Q:N="" I N D .N A S A=$G(^(N)) .S SUM=$P(A,"*") Q:SUM'<0 .S ZICMZM=ZICMZM+SUM-$P(A,"*",5)-$P(A,"*",6) ; Q ZICMZM W4DOS W4DOS(%CMD,%PATH,%OUT,%TR) ; [ 30.11.08 13:05 ] [ 24.11.08 18:06 ] [ 03.10.06 13:42 ] N (JB,%REM,%CMD,%PATH,%OUT,%TR) I '$L($G(%OUT)) S %OUT="w4dos."_$$^W4MYDVN 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 $$^W4ZOS(10,DOSEMU)<0 S DOSEMU="/usr/bin/dosemu.bin" I $$^W4ZOS(2,%NMF0) ; O %NMF0:(WRITE:NEWVERSION) U %NMF0 W "#!/bin/bash -f",!! W "TERM=linux",! ; S %ST=DOSEMU_" -k -D -a -E "_%NMF1 I $L($G(%OUT)) S %ST=%ST_" > "_%OUT ;;I '$L($G(%OUT)),$G(%TR)'="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r %L1FLTR" ;;I '$L($G(%OUT)),$G(%TR)="B" S %ST=%ST_" | "_$$^%L1ENVAR("gtm_dist")_"/mumps -r TV^%L1FLTR" W %ST,! ; C %NMF0 I $$^W4ZOS(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 $$^W4ZOS(2,%NMF0) I $$^W4ZOS(2,%NMF) Q ; PATH(STAM) ; N PATHDOS I $D(@$$^W4GL("PATHDOS")) S PATHDOS=$G(@$$^W4GL("PATHDOS")) G PATH1 S PATHDOS=$G(@$$^W4PL@("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(@$$^W4GL("PATHDOS")) S @$$^W4GL("PATHDOS")=PATHDOS Q PATHDOS W4DP1 W4DP1 ; [ 27.10.23 05:26 ] [ 21.11.22 07:57 ] [ 16.11.22 09:40 ] N (JB,%REM,%ARG,SGIRATJOM,DOCH,DISP) G M ; TV S P1TV="" M N (JB,%REM,%ARG,SGIRATJOM,DOCH,DISP,P1TV,NS,NS1,SUGP,SUGP1,MEPAR,MEPAR1,ADPAR,ADPAR1,SUGDOH,MEDAT,ADDAT,MIUN,SET,SUMK,SUMHN,SHUM,SLMAM,CAI,SAI,CNT) D ^W4IN D ^%W1ARG D KILL^%W1PRM("COMPDAT") ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S SET=$G(SET,2) S NS=$G(NS) I 'NS S NS="" S NS1="" I NS S NS1=$G(@$$^W4GL("P1SET")@(NS)) S SUGP=$G(SUGP) I 'SUGP S SUGP="" S SUGP1="" I SUGP S SUGP1=$G(@$$^W4GL("PARSUG")@(SUGP)) S MEPAR=$G(MEPAR) S MEPAR1="" I MEPAR S MEPAR1=$$SHEM^W4P(MEPAR) S ADPAR=$G(ADPAR) S ADPAR1="" I ADPAR S ADPAR1=$$SHEM^W4P(ADPAR) S SUGDOCH=$G(SUGDOCH) S DAT01=$$^%L1DC(MEDAT,2) S DAT1=MEDAT S DAT02=$$^%L1DC(ADDAT,2) S DAT2=ADDAT ; K @$$^W4MAIN("VRM") ; S SET=$G(SET,2) ; I SET'=5&'$D(P1DSHL)&'$D(P1KTV)&'$D(P1LAK)&'$D(P1KVLAK)&'$$SGYOM D G D .D:SET=2 CLPLU .D:SET'=2 PLUHZ .D ALL($$^W4GL("PLUTOT")) ; --> ^VRM ; D FRMVC ; D S N="",I=0,(SUMK,SHUM,SUMHN,CAI,SAI,CNT)=0 S TEMP=$$^W4MAIN("TEMP") S TEMP1=$$^W4MAIN("TEMP1") S VRM=$$^W4MAIN("VRM") K @TEMP,@TEMP1 ; S (SREV,SAL,SHUMAL)=0 ; I SET'=4!$D(REVAH) D .S N="" F S N=$O(@VRM@(N)) Q:N="" D FRM ; N IND S N="" F S N=$O(@TEMP@(N)) Q:N="" D .N A S A=$G(^(N)) .N CD,CD1 S CD=$P(A,"\"),CD1=CD .N NM,NM1 S NM=$P(A,"\",2),NM1=NM .D ..I CD["-T" S CD1=$P(CD,"-"),NM1=NM_" (z)",CD=CD+.000001 Q ..I $$DD^W4EZA(CD) S NM1=NM_" (`)" Q ..I $$DD^W4EZT(CD) S NM1=NM_" (w)" Q .N A1 S A1=$G(@TEMP@(N)) .S $P(A1,"\")=CD1 .S $P(A1,"\",2)=NM1 .S @TEMP1@(CD)=A1 ; K @TEMP S I=0,SLMAM=0 S N="" F S N=$O(@TEMP1@(N)) Q:N="" D .S I=I+1 .N A S A=$G(@TEMP1@(N)) .S @TEMP@(I)=A ; K @TEMP1 ; N DD S DD=$$^%L1DC(MEDAT,3) N AHMAM S AHMAM=$$MAMD^W4L(DD) S SLMAM=0 F I=1:1 Q:'$D(@TEMP@(I)) D .I $G(SHUM) D ..N SUM S SUM=$P(@TEMP@(I),"\",5) ..S $P(^(I),"\",8)=$J(SUM*100/SHUM,2,2) ..N CD S CD=$P(^(I),"\") ..N LMAM S LMAM=SUM ..I '$$NOMAM^W4P(CD) S LMAM=$J(SUM*100/(100+AHMAM),2,2) ..S $P(@TEMP@(I),"\",7)=LMAM,SLMAM=SLMAM+LMAM .Q ; S SHUM=$J(SHUM,2,2) S CNT=SUMK-CAI I $D(REVAH) D .S SAHREV="" .I $G(SAL) S SAHREV=$J(SHUMAL-SAL/SAL*100,2,2) ; K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRM1") ; Q ; ; FRM ; ^VRM(JB,PRT) --> ^TEMP(JB,I) ; VRM= KAM*SUM*HNH ;------------------ N ST,PAR,SUG,COLV,HNV,SUMV ; S PAR=N S:PAR[":" PAR=$P(PAR,":",2) Q:PAR="" ; S PAR=$$^W4CDSUPR(PAR) I $G(NS),'$D(@$$^W4GL("P1SET")@(NS,$P(PAR,"-"))) Q S ST=$G(@$$^W4MAIN("VRM")@(N)) Q:'ST S COLV=$P(ST,"*") S SUMV=$P(ST,"*",2) S HNV=$P(ST,"*",3) S SUMK=SUMK+COLV S SHUM=SHUM+SUMV-HNV,SUMHN=SUMHN+HNV ; I $$DD^W4EZA(PAR)!$$DD^W4EZT(PAR) D .S CAI=CAI+COLV,SAI=SAI+SUMV-HNV ; S:'COLV $P(ST,"*")="" S MH=$J($$MH^W4P(PAR),2,2) S:'MH MH="" I SET=5 S MH="",$P(ST,"*",2)="",COLV="",SHUM=0 S I=I+1 S @$$^W4MAIN("TEMP")@(I)=PAR_"\"_$$SHEM^W4P(PAR)_"\"_COLV_"\"_HNV_"\"_(SUMV-HNV)_"\"_MH_"\" ;_$S($D(@$$^W4GL("P1EZ")@(PAR)):"ztqez",1:"") ; EFRM D:$D(REVAH) Q .N A S A=$G(@$$^W4MAIN("TEMP")@(I)) .S AL=$$ALUT(PAR) .N REV S REV=0 .I AL S REV=$P(A,"\",5)-(AL*$P(A,"\",3)) .S SREV=SREV+REV .S SAL=SAL+(AL*$P(A,"\",3)) .I AL S SHUMAL=SHUMAL+$P(A,"\",5) .; PAR,SHEM,KAM SUM,MH .S @$$^W4MAIN("TEMP")@(I)=$P(A,"\",1,3)_"\"_$P(A,"\",5,6)_"\"_$J(AL,2,2)_"\"_$J(REV,2,2)_"\" Q ; ; ALUT(MUZAR) ; N N,ALUT,AHZ S ALUT=0 S N="" F S N=$O(@$$^W4GML("YZM")@(MUZAR,N)) Q:N="" D .N A S A=$G(^(N)) .S AHZ=$P(A,"\",2) I 'AHZ S AHZ=100 .S ALUT=ALUT+(A*$$MHAL(N)*100/AHZ) Q $J(ALUT,2,2) ; MHAL(N) Q $J($P($G(@$$^W4GLM("PARIT")@(N,3)),"*",4),3,3) ; FRMVC ; -- ^P1H -> ^P1HZ --> N MVC,TRH,LKH,PAR,HZM,KM,PARIT,OK K @$$^W4MAIN("VRM"),@$$^W4MAIN("MMM") S TRH=$$^%L1DC(DAT1,3)-1 ; N DT2 S DT2=$$^%L1DC(DAT2,3) F S TRH=$O(@$$^W4GL("P1H")@(TRH)) Q:TRH="" Q:TRH>DT2 D .D PUT^%W1PRM("COMPDAT",$ZD(TRH,"DD.MM.YY")) .S HZM="" F S HZM=$O(@$$^W4GL("P1H")@(TRH,HZM)) Q:HZM="" D D CLZ ..I $$^W4HZMH(HZM) Q ..I $$I^W4PIZUL(HZM) Q ..I $G(P1DSHL),+$G(@$$^W4ORD@(HZM,"TM"))'=P1DSHL Q ..I $D(P1DSHL),'$D(@$$^W4ORD@(HZM,"TM")) Q ..I $D(P1KTV),$$KTV^W4L($P(@$$^W4ORD@(HZM),"\"))_" "'[(P1KTV_" ") Q .. ..I $D(P1LAK) D Q:'OK S @$$^W4MAIN("MMM")@(HZM)="" ...S OK=0 Q:$D(@$$^W4MAIN("MMM")@(HZM)) ...I $$NMB^W4HZMST(HZM)=P1LAK,$$^W4MSL(P1LAK) S OK=1 Q ...I $$NMB^W4HZMST(HZM)'=P1LAK D Q:'OK ....I $$MSL^W4HZMST(HZM) Q ....I '$D(@$$^W4ORD@(HZM,"CB","ASR")) D Q .....I $$LKHN^W4HZMST(HZM)=P1LAK S OK=1 Q ....N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D Q:OK .....I $P(^(N),"*")=P1LAK S OK=1 Q ..; ..I $D(P1KVLAK) D Q:'OK S @$$^W4MAIN("MMM")@(HZM)="" ...S OK=0 Q:$D(@$$^W4MAIN("MMM")@(HZM)) ...N LAK S LAK=$$NMB^W4HZMST(HZM) ...I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ...I $$^W4MSL(LAK) Q ...I '$D(@$$^W4ORD@(HZM,"CB","ASR")) D Q ....S LAK=$$LKHN^W4HZMST(HZM) ....I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ...N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D Q:OK ....S LAK=$P(^(N),"*") I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ..; ..F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) I $$HRP^W4HZMST(HZM,I)["rvan"&(SET=5)!(SET'=5) D ...D PARVRM(^(I)) D ....S I1=I N I S PARIT=PAR ....S I="" F S I=$O(@$$^W4ORD@(HZM,I1,I)) Q:I="" D PARTSF(I,^(I)) ; I $G(DOCH)="Y"!($G(DOCH)="Z") D .N LAST,DT2 S DT2=$$^%L1DC(DAT2,3) .N LAST S LAST=$O(@$$^W4GL("P1H")@(DT2,99999999),-1) .I LAST S ^(LAST)=$G(@$$^W4GL("P1H")@(DT2,LAST))_",P" Q ; ; CLZ ; I '$$SGYOM Q ; I $D(DOCH),$G(@$$^W4GL("P1H")@(TRH,HZM))["^" D Q .I ^(HZM)[",P"!$O(@$$^W4GL("P1H")@(TRH,HZM)) K @$$^W4MAIN("VRM") ; I $G(DOCH)="Y"!($G(DOCH)="X"),$G(@$$^W4GL("P1H")@(TRH,HZM))["?" D .I ^(HZM)[",P"!$O(@$$^W4GL("P1H")@(TRH,HZM)) K @$$^W4MAIN("VRM") Q ; ; CLPLU ; N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ;;Q:DT2-DT1>31 D ^W4CLPLU(DT1,DT2) Q ; PLUHZ ; N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ;;Q:DT2-DT1>31 D ^W4CLPLU(DT1,DT2) Q ; ; ALL(GLB) ; ^PLUTOT(DAT,MRK,PAR) -- ^VRM(JB,PRT) N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ; F DT=DT1:1:DT2 D .N PAR,COL1,SUM1,COL,SUM,ST,SHN,HN1,DAT,A S DAT=$ZD(DT,"YYMMDD") .D PUT^%W1PRM("COMPDAT",$ZD(DT,"DD.MM.YY")) .S PAR="" F S PAR=$O(@GLB@(DAT,MRK,PAR)) Q:PAR="" S A=$G(^(PAR)) I $P(PAR,"-")'="" D ..S PAR=$$EZD(PAR) ..I PAR<$G(MEPAR) Q ..I $G(ADPAR),PAR>$G(ADPAR) Q ..I $G(NS),PAR,'$D(@$$^W4GL("P1SET")@(NS,$P(PAR,"-"))) Q ..I $G(SUGP),$$SUG^W4P($P(PAR,"-"))'=SUGP Q ..S COL1=$P(A,"*"),SUM1=$P(A,"*",2),HN1=$P(A,"*",4) ..S MH1=$$MH^W4P($P(PAR,"-")) ..S PRT=PAR ..S ST=$G(@$$^W4MAIN("VRM")@(PRT)) ..S COL=$P(ST,"*"),SUM=$P(ST,"*",2),SHN=$P(ST,"*",3) ..N SCOL S SCOL=COL+COL1 ..I SCOL["." S SCOL=$J(SCOL,3,3) ..S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) ..S $P(@$$^W4MAIN("VRM")@(PRT),"*",3)=SHN+HN1 .Q Q ; PARVRM(STHZ) ; N PRT,COL,COL1,ST,SUM,SUM1 S PAR=$P(STHZ,"\",1) S PAR=$$EZD(PAR) S PRT=PAR Q:PRT="" ; I PAR?1N.N D .S PRT=PAR .S PRT=PRT_$S($P(STHZ,"\",2)'="":"-"_$P(STHZ,"\",2),1:"-00") ; S COL1=$P(STHZ,"\",5) S SUM1=$P(STHZ,"\",7)-$P(STHZ,"\",6) S ST=$G(@$$^W4MAIN("VRM")@(PRT)) S COL=$P(ST,"*"),SUM=$P(ST,"*",2) N SCOL S SCOL=COL+COL1 I SCOL["." S SCOL=$J(SCOL,3,3) S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) S COLP=COL1 Q ; ; PARTSF(PAR,STTSF) ; N PRT,COL,COL1,ST,SUM,SUM1,MHT S PAR=$$EZD(PAR) S PRT=PAR ; D .I '$P(STTSF,"\",3) S COL1=COLP Q .S COL1=+$P(STTSF,"\",3) ; S MHT=$P(STTSF,"\",2) S SUM1=COL1*MHT ;;*4 PTSF Q:$G(PRT)="" S ST=$G(@$$^W4MAIN("VRM")@(PRT)) S COL=$P(ST,"*"),SUM=$P(ST,"*",2) N SCOL S SCOL=COL+COL1 I SCOL["." S SCOL=$J(SCOL,3,3) S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) Q ; ; ; PRT1 S @%PRT1="" I $L($G(@%PRT)) S @%PRT1=$$SHEM^W4P(%PRT) Q EREND S %SC("ER")=1 Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DP1-CHKPRM","MEPAR=ADPAR & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MEPAR>ADPAR Q "0;RANGENOTVALID;;MEPAR" Q 1 ; SCRN(STAM) ; Q "W4DP1" ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; ; SGYOM(STAM) ; I $D(SGIRATJOM) Q 1 Q 0 ; EZD(PAR) ; I $G(PAR)="" Q "" I $P(PAR,"-")="" Q "" I $G(@$$^W4GL("W4EZD")@(PAR)) Q ^(PAR) I $G(@$$^W4GL("W4EZD")@($P(PAR,"-"))) Q ^($P(PAR,"-")) Q PAR W4DP10 W4DP1 ; [ 19.10.21 18:01 ] [ 10.10.21 10:42 ] [ 18.01.21 14:50 ] N (JB,%REM,%ARG,SGIRATJOM,DOCH,DISP) G M ; TV S P1TV="" M N (JB,%REM,%ARG,SGIRATJOM,DOCH,DISP,P1TV,NS,NS1,SUGP,SUGP1,MEPAR,MEPAR1,ADPAR,ADPAR1,SUGDOH,MEDAT,ADDAT,MIUN,SET,SUMK,SUMHN,SHUM,SLMAM,CAI,SAI,CNT) D ^W4IN D ^%W1ARG ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S SET=$G(SET,2) S NS=$G(NS) I 'NS S NS="" S NS1="" I NS S NS1=$G(@$$^W4GL("P1SET")@(NS)) S SUGP=$G(SUGP) I 'SUGP S SUGP="" S SUGP1="" I SUGP S SUGP1=$G(@$$^W4GL("PARSUG")@(SUGP)) S MEPAR=$G(MEPAR) S MEPAR1="" I MEPAR S MEPAR1=$$SHEM^W4P(MEPAR) S ADPAR=$G(ADPAR) S ADPAR1="" I ADPAR S ADPAR1=$$SHEM^W4P(ADPAR) S SUGDOCH=$G(SUGDOCH) S DAT01=$$^%L1DC(MEDAT,2) S DAT1=MEDAT S DAT02=$$^%L1DC(ADDAT,2) S DAT2=ADDAT ; K @$$^W4MAIN("VRM") ; S SET=$G(SET,2) ; I SET'=5&'$D(P1DSHL)&'$D(P1KTV)&'$D(P1LAK)&'$D(P1KVLAK)&'$$SGYOM D G D .D:SET=2 CLPLU .D:SET'=2 PLUHZ .D ALL($$^W4GL("PLUTOT")) ; --> ^VRM ; D FRMVC ; D S N="",I=0,(SUMK,SHUM,SUMHN,CAI,SAI,CNT)=0 S TEMP=$$^W4MAIN("TEMP") S TEMP1=$$^W4MAIN("TEMP1") S VRM=$$^W4MAIN("VRM") K @TEMP,@TEMP1 ; S (SREV,SAL,SHUMAL)=0 ; I SET'=4!$D(REVAH) D .S N="" F S N=$O(@VRM@(N)) Q:N="" D FRM ; N IND S N="" F S N=$O(@TEMP@(N)) Q:N="" D .N A S A=$G(^(N)) .N CD,CD1 S CD=$P(A,"\"),CD1=CD .N NM,NM1 S NM=$P(A,"\",2),NM1=NM .D ..I CD["-T" S CD1=$P(CD,"-"),NM1=NM_" (z)",CD=CD+.000001 Q ..I $$D^W4EZA(CD) S NM1=NM_" (`)" Q ..I $$D^W4EZT(CD) S NM1=NM_" (w)" Q .N A1 S A1=@TEMP@(N) .S $P(A1,"\")=CD1 .S $P(A1,"\",2)=NM1 .S @TEMP1@(CD)=A1 ; K @TEMP S I=0,SLMAM=0 S N="" F S N=$O(@TEMP1@(N)) Q:N="" D .S I=I+1 .N A S A=$G(@TEMP1@(N)) .S @TEMP@(I)=A ; K @TEMP1 ; N DD S DD=$$^%L1DC(MEDAT,3) N AHMAM S AHMAM=$$MAMD^W4L(DD) S SLMAM=0 F I=1:1 Q:'$D(@TEMP@(I)) D .I $G(SHUM) D ..N SUM S SUM=$P(@TEMP@(I),"\",5) ..S $P(^(I),"\",8)=$J(SUM*100/SHUM,2,2) ..N CD S CD=$P(^(I),"\") ..N LMAM S LMAM=SUM ..I '$$NOMAM^W4P(CD) S LMAM=$J(SUM*100/(100+AHMAM),2,2) ..S $P(@TEMP@(I),"\",7)=LMAM,SLMAM=SLMAM+LMAM .Q ; S SHUM=$J(SHUM,2,2) S CNT=SUMK-CAI I $D(REVAH) D .S SAHREV="" .I $G(SAL) S SAHREV=$J(SHUMAL-SAL/SAL*100,2,2) ; ;;K @$$^W4MAIN("VRM") ; *** ;;K @$$^W4MAIN("VRM1") ; *** ; Q ; ; FRM ; ^VRM(JB,PRT) --> ^TEMP(JB,I) ; VRM= KAM*SUM*HNH ;------------------ N ST,PAR,SUG,COLV,HNV,SUMV ; S PAR=N S:PAR[":" PAR=$P(PAR,":",2) Q:PAR="" ; S PAR=$$^W4CDSUPR(PAR) I $G(NS),'$D(@$$^W4GL("P1SET")@(NS,$P(PAR,"-"))) Q S ST=$G(@$$^W4MAIN("VRM")@(N)) Q:'ST S COLV=$P(ST,"*") S SUMV=$P(ST,"*",2) S HNV=$P(ST,"*",3) S SUMK=SUMK+COLV S SHUM=SHUM+SUMV-HNV,SUMHN=SUMHN+HNV ; I $$D^W4EZA(PAR)!$$D^W4EZT(PAR) D .S CAI=CAI+COLV,SAI=SAI+SUMV-HNV ; S:'COLV $P(ST,"*")="" S MH=$J($$MH^W4P(PAR),2,2) S:'MH MH="" I SET=5 S MH="",$P(ST,"*",2)="",COLV="",SHUM=0 S I=I+1 S @$$^W4MAIN("TEMP")@(I)=PAR_"\"_$$SHEM^W4P(PAR)_"\"_COLV_"\"_HNV_"\"_(SUMV-HNV)_"\"_MH_"\" ;_$S($D(@$$^W4GL("P1EZ")@(PAR)):"ztqez",1:"") ; EFRM D:$D(REVAH) Q .N A S A=@$$^W4MAIN("TEMP")@(I) .S AL=$$ALUT(PAR) .N REV S REV=0 .I AL S REV=$P(A,"\",5)-(AL*$P(A,"\",3)) .S SREV=SREV+REV .S SAL=SAL+(AL*$P(A,"\",3)) .I AL S SHUMAL=SHUMAL+$P(A,"\",5) .; PAR,SHEM,KAM SUM,MH .S @$$^W4MAIN("TEMP")@(I)=$P(A,"\",1,3)_"\"_$P(A,"\",5,6)_"\"_$J(AL,2,2)_"\"_$J(REV,2,2)_"\" Q ; ; ALUT(MUZAR) ; N N,ALUT,AHZ S ALUT=0 S N="" F S N=$O(@$$^W4GML("YZM")@(MUZAR,N)) Q:N="" D .N A S A=$G(^(N)) .S AHZ=$P(A,"\",2) I 'AHZ S AHZ=100 .S ALUT=ALUT+(A*$$MHAL(N)*100/AHZ) Q $J(ALUT,2,2) ; MHAL(N) Q $J($P($G(@$$^W4GLM("PARIT")@(N,3)),"*",4),3,3) ; FRMVC ; -- ^P1H -> ^P1HZ --> N MVC,TRH,LKH,PAR,HZM,KM,PARIT,OK K @$$^W4MAIN("VRM"),@$$^W4MAIN("MMM") S TRH=$$^%L1DC(DAT1,3)-1 ; N DT2 S DT2=$$^%L1DC(DAT2,3) F S TRH=$O(@$$^W4GL("P1H")@(TRH)) Q:TRH="" Q:TRH>DT2 D .S HZM="" F S HZM=$O(@$$^W4GL("P1H")@(TRH,HZM)) Q:HZM="" D D CLZ ..I $$^W4HZMH(HZM) Q ..I $$I^W4PIZUL(HZM) Q ..I $G(P1DSHL),+$G(@$$^W4ORD@(HZM,"TM"))'=P1DSHL Q ..I $D(P1DSHL),'$D(@$$^W4ORD@(HZM,"TM")) Q ..I $D(P1KTV),$$KTV^W4L($P(@$$^W4ORD@(HZM),"\"))_" "'[(P1KTV_" ") Q .. ..I $D(P1LAK) D Q:'OK S @$$^W4MAIN("MMM")@(HZM)="" ...S OK=0 Q:$D(@$$^W4MAIN("MMM")@(HZM)) ...I $$NMB^W4HZMST(HZM)=P1LAK,$$^W4MSL(P1LAK) S OK=1 Q ...I $$NMB^W4HZMST(HZM)'=P1LAK D Q:'OK ....I $$MSL^W4HZMST(HZM) Q ....I '$D(@$$^W4ORD@(HZM,"CB","ASR")) D Q .....I $$LKHN^W4HZMST(HZM)=P1LAK S OK=1 Q ....N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D Q:OK .....I $P(^(N),"*")=P1LAK S OK=1 Q ..; ..I $D(P1KVLAK) D Q:'OK S @$$^W4MAIN("MMM")@(HZM)="" ...S OK=0 Q:$D(@$$^W4MAIN("MMM")@(HZM)) ...N LAK S LAK=$$NMB^W4HZMST(HZM) ...I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ...I $$^W4MSL(LAK) Q ...I '$D(@$$^W4ORD@(HZM,"CB","ASR")) D Q ....S LAK=$$LKHN^W4HZMST(HZM) ....I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ...N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D Q:OK ....S LAK=$P(^(N),"*") I $$^W4MSL(LAK),$$SUGL^W4L(LAK)=P1KVLAK S OK=1 Q ..; ..F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) I $$HRP^W4HZMST(HZM,I)["rvan"&(SET=5)!(SET'=5) D ...N A S A=$G(@$$^W4ORD@(HZM,I)) ...D PARVRM(A) D ....S I1=I N I S PARIT=PAR ....S I="" F S I=$O(@$$^W4ORD@(HZM,I1,I)) Q:I="" D PARTSF(I,^(I)) ; I $G(DOCH)="Y"!($G(DOCH)="Z") D .N LAST,DT2 S DT2=$$^%L1DC(DAT2,3) .N LAST S LAST=$O(@$$^W4GL("P1H")@(DT2,99999999),-1) .I LAST S ^(LAST)=@$$^W4GL("P1H")@(DT2,LAST)_",P" Q ; ; CLZ ; I '$$SGYOM Q ; I $D(DOCH),$G(@$$^W4GL("P1H")@(TRH,HZM))["^" D Q .I ^(HZM)[",P"!$O(@$$^W4GL("P1H")@(TRH,HZM)) K @$$^W4MAIN("VRM") ; I $G(DOCH)="Y"!($G(DOCH)="X"),$G(@$$^W4GL("P1H")@(TRH,HZM))["?" D .I ^(HZM)[",P"!$O(@$$^W4GL("P1H")@(TRH,HZM)) K @$$^W4MAIN("VRM") Q ; ; CLPLU ; N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ;;Q:DT2-DT1>31 D ^W4CLPLU(DT1,DT2) Q ; PLUHZ ; N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ;;Q:DT2-DT1>31 D ^W4CLPLU(DT1,DT2) Q ; ; ALL(GLB) ; ^PLUTOT(DAT,MRK,PAR) -- ^VRM(JB,PRT) N DT1,DT2 S DT1=$$^%L1DC(DAT01,4) S DT2=$$^%L1DC(DAT02,4) ; F DT=DT1:1:DT2 D .N PAR,COL1,SUM1,COL,SUM,ST,SHN,HN1,DAT,A S DAT=$ZD(DT,"YYMMDD") .S PAR="" F S PAR=$O(@GLB@(DAT,MRK,PAR)) Q:PAR="" S A=$G(^(PAR)) I $P(PAR,"-")'="" D ..S PAR=$$EZD($P(PAR,"-")) ..I PAR<$G(MEPAR) Q ..I $G(ADPAR),PAR>$G(ADPAR) Q ..I $G(NS),PAR,'$D(@$$^W4GL("P1SET")@(NS,$P(PAR,"-"))) Q ..I $G(SUGP),$$SUG^W4P($P(PAR,"-"))'=SUGP Q ..S COL1=$P(A,"*"),SUM1=$P(A,"*",2),HN1=$P(A,"*",4) ..S MH1=$$MH^W4P($P(PAR,"-")) ..S PRT=PAR ..S ST=$G(@$$^W4MAIN("VRM")@(PRT)) ..S COL=$P(ST,"*"),SUM=$P(ST,"*",2),SHN=$P(ST,"*",3) ..N SCOL S SCOL=COL+COL1 ..I SCOL["." S SCOL=$J(SCOL,3,3) ..S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) ..S $P(@$$^W4MAIN("VRM")@(PRT),"*",3)=SHN+HN1 .Q Q ; PARVRM(STHZ) ; N PRT,COL,COL1,ST,SUM,SUM1 S PAR=$P(STHZ,"\",1) S PRT=PAR Q:PRT="" S PRT=$$EZD(PRT) ; I PAR?1N.N.".".N D .S PRT=PRT_$S($P(STHZ,"\",2)'="":"-"_$P(STHZ,"\",2),1:"-00") ; S COL1=$P(STHZ,"\",5) S SUM1=$P(STHZ,"\",7)-$P(STHZ,"\",6) S ST=$G(@$$^W4MAIN("VRM")@(PRT)) S COL=$P(ST,"*"),SUM=$P(ST,"*",2) N SCOL S SCOL=COL+COL1 I SCOL["." S SCOL=$J(SCOL,3,3) S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) S COLP=COL1 Q ; ; PARTSF(PAR,STTSF) ; N PRT,COL,COL1,ST,SUM,SUM1,MHT S PRT=PAR S PRT=$$EZD($P(PAR,"-")) ; D .I '$P(STTSF,"\",3) S COL1=COLP Q .S COL1=+$P(STTSF,"\",3) ; S MHT=$P(STTSF,"\",2) S SUM1=COL1*MHT ;;*4 PTSF S ST=$G(@$$^W4MAIN("VRM")@(PRT)) S COL=$P(ST,"*"),SUM=$P(ST,"*",2) N SCOL S SCOL=COL+COL1 I SCOL["." S SCOL=$J(SCOL,3,3) S @$$^W4MAIN("VRM")@(PRT)=SCOL_"*"_(SUM+SUM1) Q ; ; ; PRT1 S @%PRT1="" I $L($G(@%PRT)) S @%PRT1=$$SHEM^W4P(%PRT) Q EREND S %SC("ER")=1 Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DP1-CHKPRM","MEPAR=ADPAR & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MEPAR>ADPAR Q "0;RANGENOTVALID;;MEPAR" Q 1 ; SCRN(STAM) ; Q "W4DP1" ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; ; SGYOM(STAM) ; I $D(SGIRATJOM) Q 1 Q 0 ; EZD(PAR) ; I $G(@$$^W4GL("W4EZD")@(PAR)) Q ^(PAR) Q PAR W4DPARM0 W4DPARMM ; [ 10.10.14 18:29 ] [ N (JB,%ARG) ; D INIT D FRM ; W "
    ",! W "" W $$^%W1DICT("MONTHITEMREPORT",MM1_"<>"_YY1) W "",! ; W "

    ",! S FIX=" style=""position:fixed;left:200px"" " ; W "",! W " " W " ",! W " ",! W " ",! F DT=DT1:1:DT2 D .W "",! W " ",! ; K SS S PAR="" F K=1:1 S PAR=$O(@VRM@(PAR)) Q:PAR="" D .W "" .W " " .W " " .S PAR1=$$SHEM^W4P(PAR) .W " " .F DT=DT1:1:DT2 D ..S VL=$S(PRSUM:$G(@VRM@(PAR,DT,"SUM")),1:$G(@VRM@(PAR,DT,"QN"))) ..D RKV(VL) ..S SS(DT)=$G(SS(DT))+VL .W "",! ; W "" W "" W "" F DT=DT1:1:DT2 D .S VL=$G(SS(DT)) .D RKV(VL) W "",! ; W "
    "_$$^%W1DICT("LINE")_""_$$^%W1DICT("ITEMNUMBER")_""_$$^%W1DICT("ITEMNAME")_""_$ZD(DT,"DD.MM.YY")_"
    "_K_""_PAR_""_$$H2U^%L1FRM(PAR1)_"
      
    ",! W "
    ",! ; K @VRM Q ; ; YY ; W $$^%W1DICT("CHOICEYEAR")_" " W "",! Q ; MM ; W $$^%W1DICT("CHOICEMONTH")_" " W "",! Q ; RKV(VL) ; S VL=$G(VL) I VL,$G(PRSUM) S VL=$J(VL,2,2) I 'VL S VL="-" W " "_VL_"" Q ; INIT ; S YYYYMM=$G(%ARG("YYYYMM")) S MM=$E(YYYYMM,5,6) S MM1=$$TV^%W1DICT($$^%W1LNG,"MM"_+MM) S YY1=$E(YYYYMM,1,4) S YY=$E(YY1,3,4) S PRSUM=$G(%ARG("PRSUM")) S MM=$TR($J(MM,2)," ",0) S DT1=$$^%L1DC("01"_MM_YY,3) S DT2=$$LM^%L1DC(DT1) ; S PLUTOT=$$^W4GL("PLUTOT") S VRM=$$^W4MAIN("VRM") K @VRM D MRK^W4IN Q ; FRM ; F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .S PAR="" F S PAR=$O(@PLUTOT@(DAT,MRK,PAR)) Q:PAR="" I PAR?1N.N.".".N D ..S A=$G(@PLUTOT@(DAT,MRK,PAR)) ..S @VRM@(PAR,DT,"QN")=$G(@VRM@(PAR,DT,"QN"))+$P(A,"*") ..S @VRM@(PAR,DT,"SUM")=$G(@VRM@(PAR,DT,"SUM"))+$P(A,"*",2)-$P(A,"*",4) Q ; ; W4DPARMM W4DPARMM ; [ 12.11.24 18:42 ] [ 18.02.22 11:17 ] [ 02.12.21 10:38 ] N (JB,%ARG) ; D INIT D FRM ; W "
    ",! W "" W $$^%W1DICT("MONTHITEMREPORT",MM1_"<>"_YY1) W "",! ; W "

    ",! W "" W "" W "" ; W "" ; W "" ; W "" ; F J=1:1:7 D .W "",! ; W "",! ; D SELDAY("FROM","meday") D SELDAY("TO","adday") ; W " ",! ; W " ",! ; W " ",! W "",! W "
    " W $$^%W1DICT("GROUP") S GRSEL=$G(%ARG("GROUP")) I 'GRSEL S GRSEL="ALL" W "",! W " " W $$^%W1DICT("PERQN")_" " W "" W $$^%W1DICT("PERSUM")_" " W "" . W $$^%W1DICT("DAY"_J)_" " . W "",! .W " ",! D ROUNDBUT^%W1JS("show",$$^%W1DICT("SHOW"),"ChangeKind()","color:green","wh,22") W " ",! D ROUNDBUT^%W1JS("print",$$^%W1DICT("PRINT"),"Print()","color:blue","wh,22") W " ",! D ROUNDBUT^%W1JS("back",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") W "
    ",! ; W "
    ",! D DIVEXC^%W1PC1("W4DPARMM") ;;W "
    ",! ; S PG=0 D KOT ; K SS S RZ=35 S PAR="" F S PAR=$O(@VRM@(PAR)) Q:PAR="" D .I $G(%ARG("GROUP")),$$SUG^W4P(PAR)'=$G(%ARG("GROUP")) Q .S K=K+1 I K>RZ D KOT .S EX="" .W "" .W " "_K_"" .S EX=EX_$$EXC(K) .W " "_PAR_"" .S EX=EX_$$EXC(PAR) .S PAR1=$$H2U^%L1FRM($$SHEM^W4P(PAR)) .S EX=EX_$$EXC($$SHEM^W4P(PAR)) .I PAR1="" S PAR1=" " .W " "_PAR1_"" .S SG=0 .; .F DT=DT1:1:DT2 D ..I '$$CONDT(DT) Q ..S VL=$S(PRSUM:$G(@VRM@(PAR,DT,"SUM")),1:$G(@VRM@(PAR,DT,"QN"))) ..D RKV(VL) ..S SS(DT)=$G(SS(DT))+VL ..S SG=SG+VL .I PRSUM S SG=$J(SG,2,2) .D RKV(SG,1) .W "",! .D WEX(EX) ; S EX="" W "" W " " S EX=EX_$$EXC("") W " " S EX=EX_$$EXC("") W " " S EX=EX_$$EXC("") S SG=0 F DT=DT1:1:DT2 D .I '$$CONDT(DT) Q .S VL=$G(SS(DT)) .D RKV(VL) .S SG=SG+VL I PRSUM S SG=$J(SG,2,2) D RKV(SG,1) W "",! D WEX(EX) ; W "",! W "
    ",! C FLCSV ; Q ; ; YY ; W $$^%W1DICT("CHOICEYEAR")_" " W "",! Q ; MM ; W $$^%W1DICT("CHOICEMONTH")_" " W "",! Q ; RKV(VL,PRTOT) ; S VL=$G(VL) I VL,$G(PRSUM) S VL=$J(VL,2,2) I 'VL S VL=" " W " "_VL_"" I $D(EX) S EX=EX_$$EXC(+VL) Q ; INIT ; S YYYYMM=$G(%ARG("YYYYMM")) S MM=$E(YYYYMM,5,6) S MM1=$$TV^%W1DICT($$^%W1LNG,"MM"_+MM) S YY1=$E(YYYYMM,1,4) S YY=$E(YY1,3,4) S MM=$TR($J(MM,2)," ",0) S DT1=$$^%L1DC("01"_MM_YY,3) S DT2=$$LM^%L1DC(DT1) ; I $G(%ARG("MEDAY")) S DT1=$$^%L1DC($TR($J(%ARG("MEDAY"),2)," ",0)_MM_YY,3) I $G(%ARG("ADDAY")) S DT2=$$^%L1DC($TR($J(%ARG("ADDAY"),2)," ",0)_MM_YY,3) ; S PRSUM=$G(%ARG("PRSUM")) ; S PLUTOT=$$^W4GL("PLUTOT") S VRM=$$^W4MAIN("VRM") K @VRM D MRK^W4IN D OPEXC("W4DPARMM","csv") Q ; FRM ; F DT=DT1:1:DT2 D .I '$$CONDT(DT) Q .S DAT=$ZD(DT,"YYMMDD") .S PAR="" F S PAR=$O(@PLUTOT@(DAT,MRK,PAR)) Q:PAR="" I $$ISNUM^%L1FRM(PAR) D ..S A=$G(@PLUTOT@(DAT,MRK,PAR)) ..S @VRM@(PAR,DT,"QN")=$G(@VRM@(PAR,DT,"QN"))+$P(A,"*") ..S @VRM@(PAR,DT,"SUM")=$G(@VRM@(PAR,DT,"SUM"))+$P(A,"*",2)-$P(A,"*",4) Q ; ; CONDT(DT) ; N NDT I $G(%ARG("MEDAY")),$ZD(DT,"DD")<$G(%ARG("MEDAY")) Q 0 I $G(%ARG("ADDAY")),$ZD(DT,"DD")>$G(%ARG("ADDAY")) Q 0 S NDT=$$^%L1DC(DT,8) I $G(%ARG("DAYS"))="" Q 1 I $E(%ARG("DAYS"),NDT) Q 1 Q 0 ; SELDAY(RKV,ID) N DT1,DT2,MEDAY,ADDAY S DT1=$$^%L1DC("01"_MM_YY,3) S DT2=$$LM^%L1DC(DT1) S MEDAY=1 I $G(%ARG("MEDAY")) S MEDAY=%ARG("MEDAY") S ADDAY=+$ZD(DT2,"DD") I $G(%ARG("ADDAY")) S ADDAY=%ARG("ADDAY") ; W ""_$$^%W1DICT(RKV)_" " W "",! W "" Q ; ; OPEXC(COD,FMT) ; S FL=$$FL^%W1FREPX(COD,FMT) S FLCSV=FL_"."_FMT1 N A,B,I,J,RZD S ^LEVDEB("FLCSV")=FLCSV O FLCSV:(REWIND:NEWVERSION:WRITE:SYSTEM="rwx":GROUP="rx":WORLD="rx") Q ; EXC(VL) ; Q $$RKV^%W1PCEX(VL) ; WEX(TX) ; U FLCSV W TX,! U 0 Q ; KOT ; I PG D .W "",! .D PGBREAK ; S HD="" S PG=PG+1 W "

    ",! W " "_$$^%W1DICT("PAGE")_" "_PG_" " W "

    ",! S K=0 W "",! W " " W " ",! S HD=HD_$$EXC($$TV^%W1DICT($$^%W1LNG,"LINE")) W " ",! S HD=HD_$$EXC($$TV^%W1DICT($$^%W1LNG,"ITEMNUMBER")) W " ",! S HD=HD_$$EXC($$TV^%W1DICT($$^%W1LNG,"ITEMNAME")) ; F DT=DT1:1:DT2 D .I '$$CONDT(DT) Q .W "",! .S HD=HD_$$EXC($ZD(DT,"DD.MM.YY")_" "_$$^%L1DC(DT,9)) ; W "" S HD=HD_$$EXC($TR($$TV^%W1DICT($$^%W1LNG,"TOTAL"),"""","")) W " ",! ; D WEX(HD) Q ; ; PGBREAK ; W "

    ",! Q W4DPARS W4DPARS ; DOSCH PRITIM LEFI SHAOT [ 26.03.23 09:50 ] [ 21.02.22 07:17 ] [ 24.10.21 16:25 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$D(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S %REPN="W4PARS" S @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4dpars.jsp?JB="_JB) Q ; ; DAT ; I '$$GETP^%W1PRM("W4DPARS") D .D ^W4CLPLU(METRH,ADTRH) .D PUT^%W1PRM("W4DPARS",$H) ; N DT S DT=$$^%L1DC(DAT,4) I DTADTRH S OK=0 Q ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) S OK=0 Q ; S TRH=$$^%L1DC(DAT,1) Q ; PAR ; S DEP1="" S DEP=$$DEP^W4P(PAR) ; I DEPADDEP) S OK=0 Q S SUGP=$$SUG^W4P(PAR) I SUGPADSUGP) S OK=0 Q ; SHAA S SHAA1=+$TR(SHAA," ","") I $$^W4SHAAZ,SHAA1<$$SHAAZ^W4PRM S SHAA1=SHAA1+24 I SHAA123 S SHAA1=SHAA1-24,KDM="24+" S SHAA1=KDM_$J(+SHAA1,2)_" - "_$J(SHAA1+1,2) Q W4DPAY W4DPAY ; -- DOH LEFI SUGEY TASHLUM ; [ 25.06.24 06:41 ] [ 21.02.22 06:06 ] [ 05.06.17 11:13 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATHADTRHT) S OK=0 Q N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DATH,8)) S OK=0 Q ; S TRHT=$$^%L1DC(DATH,1) Q ; ; HZM D GA^W4SCREF("P1HZMS",$$^W4ORD_"("_HZM_")") S MLZ=MKBL I $$^W4MSD(NMB),$G(@$$^W4PRM@("LAST")),$G(@$$^W4PRM@("MLZ")) D .I $G(@$$^W4GL("P1MLZ")@(HZM)) S MLZ=$G(^(HZM)) ; I MLZADMLZ) S OK=0 Q ; S MLZ1=$$^W4NAME(MLZ) N AVR S AVR=0 I CHK,$G(@$$^W4ORD@(HZM,"CB","CH",1))[("*B*") S AVR=CHK,CHK=0 S x1=TSHL,x2=MZM,x3=CHK,x4=AVR,x5=CA,x6=ASR,x7=TL,x8=TIP Q W4DPAYD W4DPAYD ; -- TASHLUMIM LE SHLIHIM [ 11.04.18 17:57 ] [ 17.05.15 12:26 ] [ 20.03.12 11:38 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATH<$$^%L1DC(METRH,3)!(DATH>$$^%L1DC(ADTRH,3)) S OK=0 Q S TRH=$$^%L1DC(DATH,1) Q ; HZM N TRH D GA^W4SCREF("P1HZ",$$^W4ORD_"(HZM)") I $L(NMB)<4 S OK=0 Q S:'$G(PSL) PSL=9999 I 'MEPSL S MEPSL=-1 I PSLADPSL)!'PSL S OK=0 Q S PSL1="" I PSL S PSL1=$G(@$$^W4GL("P1SL")@(PSL)) S x1=TSHL,x2=MZM,x3=CHK,x4=CA,x5=ASR S x6=DMSH S x7=TIP Q W4DPAYK W4DPAYK ; -- DOH LEFI SUGEY TASHLUM ; [ 29.08.19 18:16 ] [ 05.06.17 11:13 ] [ S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) Q ; DATH I DATHADTRHT) S OK=0 Q S TRHT=$$^%L1DC(DATH,1) Q ; HZM D GA^W4SCREF("P1HZMS",$$^W4ORD_"(HZM)") S MLZ=MKBL I MLZADMLZ) S OK=0 Q ; S MLZ1=$$^W4NAME(MLZ) S EMDA=$$POS^W4HZMST(HZM) S x1=TSHL,x2=MZM,x3=CHK,x4=CA,x5=ASR,x6=TL,x7=TIP Q W4DPAYM W4DPAYM ; -- TASHLUMIM LE MELZARIM ; [ 21.02.22 06:36 ] [ 04.06.14 15:56 ] [ 20.03.12 08:00 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")=$G(%ARG("REPN")) ;;S IND=$$^%L1FP(^rep(%REPN,"FLD"),"*","x6",1) ;;S $P(^rep(%REPN,"FLD0"),"*",IND)=$S($G(^P1PRM("TL")):"",1:"-") Q ; DATH I DATHADTRHT) S OK=0 Q N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DATH,8)) S OK=0 Q S TRHT=$$^%L1DC(DATH,1) Q ; HZM D GA^W4SCREF("P1HZMS",$$^W4ORD_"(HZM)") I $$^W4MSL(NMB) S OK=0 Q S MLZ=MKBL I $G(@$$^W4PRM@("LAST")),$G(@$$^W4PRM@("MLZ")) D .I $G(@$$^W4GL("P1MLZ")@(HZM)) S MLZ=$G(^(HZM)) ; I MLZADMLZ) S OK=0 Q I NMBADNMB) S OK=0 Q ; S SHAA=+$P(ZMANK," ",2) S SHAA1=SHAA I SHAA<5 S SHAA1=SHAA1+24 I ADSHAAADEMDA) S OK=0 Q S ATAR=+$G(@$$^W4GL("W4POSATR")@(EMDA)) I ATARADATAR) S OK=0 Q S SUGS=$$SUGL^W4L(NMB) I SUGSADSUGS) S OK=0 Q S MLZ1=$$^W4NAME(MLZ) S x1=TSHL,x2=MZM,x3=CHK,x4=CA,x5=ASR,x6=TL,x7=TIP Q W4DPBIT W4DPBIT(%REPN) ; [ 20.02.22 12:49 ] [ 20.12.18 19:26 ] [ 16.12.17 11:31 ] N (JB,%ARG,%REM,%REPN) ; ---- LIFNEY QUERY !! S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" ; K %L1PC S %REPN("HZSCR")=HZSCR S %REPN("MISHL")=MISHL S %REPN("TRH","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN S @$$^%W1GLREP@("MIUN","PROG")="TRH^W4DPBIT" D PUT^%W1PRM("HRFREP","w4dpbit.jsp?JB="_JB_"&REPN="_%REPN) Q ; TRH D ^%W1PCVRM K @VRM S MEDATH=$$^%L1DC(METRH,3) S ADDATH=$$^%L1DC(ADTRH,3) ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") ; F DT=MEDATH:1:ADDATH S HZM=MEHZM-1 D .I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) Q .F S HZM=$O(@$$^W4REF@(DT,HZM)) Q:HZM="" Q:HZM>ADHZM I $D(@$$^W4ORD@(HZM)) D ..S OK=1 D HZM Q:OK'=1 ..Q:$$SHIHZUR(HZM) ..I $G(@$$^W4GL("P1DEL")@(HZM))&($G(^(HZM))'=HZM) Q ..Q:$$^W4HZMH(HZM) ..Q:$$I^W4PIZUL(HZM) ..N I F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D ...N PARIT,CAMP,STP,STT ...S STP=^(I),PARIT=$P(STP,"\"),CAMP=$P(STP,"\",5) ...Q:CAMP'<0 Q:$$EXIT($$EX2KITCH^W4HZMST(HZM,I)) ...I $$AVAR^W4HZMST(HZM,I) Q ...I PARIT'ADPAR D CR1(STP) ... ...N N S N="" F S N=$O(@$$^W4ORD@(HZM,I,N)) Q:N="" S STT=$G(^(N)) D ....I N["A-" D Q .....N PAR S PAR=$P(N,"-",3) Q:PARADPAR) .....D CR2(PAR,$P(STT,"\",2),0) ....Q:NADPAR) ....N COL S COL=+$P(STT,"\",3) ....D CR2(N,COL,COL*$P(STT,"\",2)) ; S %L1PC("CONTINUE")="" Q ; SHIHZUR(HZM) ; N B S B=$P($G(@$$^W4ORD@(HZM,"HR2")),"\\",2) I $E(B,$L(B))=">" Q 1 Q 0 ; CR1(A) ; N B,PAR S PAR=$P(A,"\") D PRI S B=$G(@VRM@(DT,SHAA,HZM,PAR)) S @VRM@(DT,SHAA,HZM,PAR)=$P(B,"*")+$P(A,"\",5)_"*"_($P(B,"*",2)+$P(A,"\",7)-$P(A,"\",6)) Q ; CR2(PAR,C,S) ; D PRI N B S B=$G(@VRM@(DT,SHAA,HZM,PAR)) S @VRM@(DT,SHAA,HZM,PAR)=$P(B,"*")+C_"*"_($P(B,"*",2)+S) Q ; PRI N I F I="DT","SHAA","HZM","PAR" D .I $G(@I)="" S @I=" - " .I $G(@I)["*" S @I=$TR(@I,"*","X") Q ; HZM ; S %SCRN=HZSCR D GA^W4SCREF(HZSCR,$$^W4ORD_"(HZM)") S PSL="" I $L(NMB)>3 D .S SHAA=$P(SHAA,":",1,2) I $L(NMB)<4 D .S SHAA=$P(ZMANK," ",2) N SHAA1 S SHAA1=SHAA I $$^W4SHAAZ,SHAA<$$SHAAZ^W4PRM S SHAA1=SHAA+24 I SHAA1ADHZM I $D(@$$^W4ORD@(HZM)) D ..S OK=1 D HZM Q:OK'=1 ..Q:$$SHIHZUR(HZM) ..I $$^W4DEL(HZM),$$^W4DEL(HZM)'=HZM Q ..Q:$$^W4HZMH(HZM) ..Q:$$I^W4PIZUL(HZM) ..N I S I="" F S I=$O(@$$^W4ORD@(HZM,"BIT",I)) Q:I="" S A=$G(^(I)) D ...I '$D(@$$^W4ORD@(HZM,I)) Q ...N PARIT,CAMP,STP,STT ...S STP=^(I),PARIT=$P(STP,"\"),CAMP=$P(STP,"\",5) ...Q:CAMP'<0 ...Q:$$AVAR^W4HZMST(HZM,I) ...S WHODEL=$$WHODEL^W4HZMST(HZM,I) ...I WHODEL?.P S WHODEL=MKBL ...S WHODEL=$$DOP^W4NAME(WHODEL) ...S EXIT=$$EX2KITCH^W4HZMST(HZM,I) ...S SIBA=$$SIBA^W4HZMST(HZM,I) ...S SIBA1=$$SIBA1^W4HZMST(HZM,I) ...I SIBA1="" S SIBA1=$TR($$SPA^%L1FRM($P(STP,"\",8)),">","") S:SIBA1="" SIBA1=" " ...I $G(ADSIBA),SIBAADSIBA) Q ...I $G(ADEXIT),EXITADEXIT) Q ...S SIBA1=$E(SIBA1,1,128) ...I PARIT'ADPAR D CR1(STP) ...N N S N="" F S N=$O(@$$^W4ORD@(HZM,I,N)) Q:N="" S STT=$G(^(N)) D ....I N["A-" D Q .....N PAR S PAR=$P(N,"-",3) Q:PARADPAR) .....D CR2(PAR,$P(STT,"\",2),0) ....Q:NADPAR) ....N COL S COL=+$P(STT,"\",3) ....D CR2(N,COL,COL*$P(STT,"\",2)) S %L1PC("CONTINUE")="" Q ; SHIHZUR(HZM) ; N B S B=$P($G(@$$^W4ORD@(HZM,"HR2")),"\\",2) I $E(B,$L(B))=">" Q 1 Q 0 ; CR1(A) ; I $G(SIBA)="" S SIBA=0 N B,B1,PAR S PAR=$P(A,"\") D PRI S B=$G(@VRM@(SIBA,SIBA1,+EXIT,WHODEL,DT,SHAA,HZM,PAR)) S B1=$G(@VRM1@(DT,SIBA,SIBA1,+EXIT,HZM)) S @VRM@(SIBA,SIBA1,+EXIT,WHODEL,DT,SHAA,HZM,PAR)=$P(B,"*")+$P(A,"\",5)_"*"_($P(B,"*",2)+$P(A,"\",7)-$P(A,"\",6)) S @VRM1@(DT,SIBA,SIBA1,+EXIT,HZM)=$P(B1,"*")+$P(A,"\",5)_"*"_($P(B1,"*",2)+$P(A,"\",7)-$P(A,"\",6)) Q ; CR2(PAR,C,S) ;-- C - COL, S - SUM D PRI N B,B1 S B=$G(@VRM@(SIBA,SIBA1,+EXIT,WHODEL,DT,SHAA,HZM,PAR)) S B1=$G(@VRM1@(DT,SIBA,SIBA1,+EXIT,HZM)) S @VRM@(SIBA,SIBA1,+EXIT,WHODEL,DT,SHAA,HZM,PAR)=($P(B,"*")+C)_"*"_($P(B,"*",2)+S) S @VRM1@(DT,SIBA,SIBA1,+EXIT,HZM)=($P(B1,"*")+C)_"*"_($P(B1,"*",2)+S) Q ; PRI N I F I="EXIT","SIBA","SIBA1","WHODEL","DT","SHAA","HZM","PAR" D .I $G(@I)="" S @I=" - " .I $G(@I)["*" S @I=$TR(@I,"*","X") Q ; HZM ; S %SCRN=HZSCR D GA^W4SCREF(HZSCR,$$^W4ORD_"(HZM)") S PSL="" I $L(NMB)>3 D .S SHAA=$P(SHAA,":",1,2) I $L(NMB)<4 D .S SHAA=$P(ZMANK," ",2) N SHAA1 S SHAA1=SHAA I $$^W4SHAAZ,SHAA<$$SHAAZ^W4PRM S SHAA1=SHAA+24 I SHAA1$G(ADHZM)) I $D(@$$^W4ORD@(HZM)) D ..Q:$$^W4HZMH(HZM) ..Q:$$I^W4PIZUL(HZM) ..I $D(@$$^W4ORD@(HZM,"CB","HNH1")) D ...S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","HNH1",N)) Q:N="" D ; NIS DISC ....S A=$G(^(N)) Q:A="" ....S TOTHN=$$TOTHN^W4HZMST(HZM) ....S WHO=$P(A,"*",3) ....S VH=1 ....I WHO["MVC1-" S WHO=$P($P(WHO,"-",1,2),"MVC",2)_"rvan",VH=9 ....I WHO="" S WHO="00000" ....S SUMHN=$P(A,"*",1) ....S SIBA1=$P(A,"*",5) ....S SIBA=$P(A,"*",6) ....I 'SIBA S SIBA=$$FNDSIB(SIBA1) ....I SIBA="" S SIBA=0 ....I SIBA1="" S SIBA1=" " ....I 'SUMHN Q ....S @VRM@(DT,WHO,HZM,VH,"H"_N,SIBA,SIBA1)=$J(TOTHN,2,2)_"*0*"_$J(SUMHN,2,2) .. ..I $D(@$$^W4ORD@(HZM,"CB","ASR")) D ; -- CUST DISC ...S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D ....S A=$G(^(N)) Q:A="" ....S TOTHN=$P(A,"*",4) ....S WHO=$$MKBL^W4HZMST(HZM) ....I WHO="" S WHO="00000" ....S AH=$P(A,"*",2) ....S SUMHN=$P(A,"*",3) ....S SIBA1="gewll dgpd" ....S SIBA=$$FNDSIB(SIBA1) ....I SIBA="" S SIBA=0 ....I SIBA1="" S SIBA1=" " ....I 'AH,'SUMHN Q ....S @VRM@(DT,WHO,HZM,3,"L"_N,SIBA,SIBA1)=$J(TOTHN+SUMHN,2,2)_"*"_AH_"*"_$J(SUMHN,2,2) .. ..S HNH2=$$HNH2^W4HZMST(HZM) ; -- AROUND ..I HNH2 D ...S TOTHN=$$TSHL^W4HZMST(HZM) ...S WHO=$$MKBL^W4HZMST(HZM) ...I WHO="" S WHO="00000" ...S SUMHN=HNH2 ...S SIBA1="oeayg lebir" ...S SIBA=0 ...I 'HNH2 Q ...S @VRM@(DT,WHO,HZM,4,0,SIBA,SIBA1)=$J(TOTHN,2,2)_"*0*"_$J(HNH2,2,2) ..; ..N HNHAH S HNHAH=$$HNHAH^W4HZMST(HZM) ..I HNHAH,'($D(@$$^W4ORD@(HZM,"HNH"))#2) D ...S SIBA=0,SIBA1="reci `l" ...I +HNHAH=100 D ....S SIBA1="OTH" ....N N S N="" F S N=$O(@$$^W4GL("P1SHNH")@(N)) Q:N="" D .....I $TR($G(^(N)),".","")["OTH" S SIBA=N ...S @$$^W4ORD@(HZM,"HNH")=HNHAH_"*"_$$LASTMLZ^W4HZMST(HZM)_"*"_SIBA_"*"_SIBA1 .. ..I $D(@$$^W4ORD@(HZM,"HNH"))#2 D ;--- % DISC ...S A=$G(^("HNH")) Q:A="" ...S A=$G(^("HNH")),TOTHN=$$TOTHN^W4HZMST(HZM) Q:'TOTHN ...S WHO=$P(A,"*",2) S:WHO="" WHO="00000" ...S SIBA=+$P(A,"*",3) ...S SIBA1=$P(A,"*",4) ...I SIBA1="" S SIBA1=" " ...I 'A Q ...S @VRM@(DT,WHO,HZM,2,0,SIBA,SIBA1)=$J(TOTHN,2,2)_"*"_+A_"*"_$J(TOTHN*A*.01,2,2) .. ..N I F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) S A=$G(^(I)) I $$ISHNHP^W4HZMST($P(A,"\")) D ...S WHO=$$WHOHNH^W4HZMST(HZM,I) ...I WHO?.P S WHO=$$MKBL^W4HZMST(HZM) S:WHO="" WHO="00000" ...S SIBA=+$$SIBHNH^W4HZMST(HZM,I) ...S SIBA1=$$SIBHNH1^W4HZMST(HZM,I) ...I SIBA1="" S SIBA1=$TR($$SPA^%L1FRM($P(A,"\",8)),">","") ...I SIBA1="" S SIBA1=" " ...S NST=I ...I $G(@$$^W4ORD@(HZM,I,"O2T")) S NST=^("O2T") ...S AHNHP=-A Q:'AHNHP&'$$SUM^W4HZMST(HZM,I) ...S VH=5 ...I +AHNHP=100 S VH=6 ...I $$HNHSHAA(A) S VH=7 ...S @VRM@(DT,WHO,HZM,VH,NST,SIBA,SIBA1)=$$SUM^W4HZMST(HZM,I-1)_"*"_AHNHP_"*"_-$$SUM^W4HZMST(HZM,I) ; S %L1PC("CONTINUE")="" Q ; ; PRI N I F I="DT","WHO","SIBA","SIBA1","HZM","NST" D .I $G(@I)="" S @I=" - " .I $G(@I)["*" S @I=$TR(@I,"*","X") Q ; NAME(WHO) ; N MVC I WHO?1N.N Q $$^W4NAME(WHO) I $E(WHO,1,2)="1-" S MVC=+$P(WHO,"-",2) I MVC Q $G(@$$^W4GL("W4MVC1")@(MVC)) Q "" ; SUGH ; Q ; ST ; S x1=$P($G(@GLOB),"*") S x2=$P($G(@GLOB),"*",2) S x3=$P($G(@GLOB),"*",3) I $G(SUGH)>4 S x4=x3 E S x5=x3 Q ; FNDSIB(SIBA1) ; N OK S OK=0 N N S N="" F S N=$O(@$$^W4GL("P1SHNH")@(N)) Q:N="" D Q:OK .I $$SPA^%L1FRM($G(^(N)))=$$SPA^%L1FRM(SIBA1) S OK=N Q OK ; HNHSHAA(A) ; I $P(A,"\",8)["dry itl dgpd" Q 1 Q 0 W4DPMH W4DPMH(DAT1,DAT2,JB) ; [ 13.02.25 14:57 ] [ 05.04.22 08:11 ] [ 05.12.21 22:58 ] N (JB,%ARG,%REM,DAT1,DAT2) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" BG ; ; D ^W4IN,VRM K @VRM S HNHALL=1 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) D PUT^%W1PRM("W4DPMHDT1",DT1) D PUT^%W1PRM("W4DPMHDT2",DT2) ; F DT=DT1:1:DT2 S HZM="" F S HZM=$O(@$$^W4REF@(DT,HZM)) Q:HZM="" D .I $$^W4HZMH(HZM) Q .I $$I^W4PIZUL(HZM) Q .D T ; --> T .S DAT=$ZD(DT,"YYMMDD") D FRMVRM(HZM) ; K %L1PC S %REPN("MEDATT")=$$^%L1DC(DAT1,3),%REPN("ADDATT")=$$^%L1DC(DAT2,3) ; --- NE ISP-T MEDAT,ADDAT !!!! S %REPN("MEDATT","VIEW")=1 S %REPN("ADDATT","VIEW")=1 ;;S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB S %REPN="W4DPMH" D PUT^%W1PRM("W4DPMH",1) Q:'$D(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4dpmh.jsp?JB="_JB) ; END Q ; ; DAT S DATT=$$^%L1DC(DAT,1) I 'MEMH1 S MEMH1=-999 Q ; PAR ; D PAR1 I PARADPARIT S OK=0 Q S SUGP=$$SUG^W4P(PAR) I SUGPADSUGP) S OK=0 Q S MHL=+$P($G(@$$^W4GL("PARSUG")@(SUGP,1)),"\") I MEMHL,MHLADMHL S OK=0 Q Q ; MH ; Q ; HZM N GL S GL=$G(@GLOB) S x1=$P(GL,"*",7) ; --- BIT YAZU Q S x2=$P(GL,"*",9) ; --- BIT YAZU S S x3=$P(GL,"*",1) ; --- KAMUT N MH S MH=$P(GL,"*",3) ; N AHMAM S AHMAM=$$MAMD^W4L($$^%L1DC(DAT,4)) N PRTIP S PRTIP=$$GETP^%W1PRM("W4DPMHTIP") S x4=$P(GL,"*",4) ; -- HNHP S x5=$P(GL,"*",5); -- HNH S x6=$P(GL,"*",10); -- TIP+SHER I 'PRTIP S (x5,x6)=0 S x7=$P(GL,"*",2)-x4 S x7=x7-x5+x6 S x8=$J(x7*100/(100+AHMAM),2,2) ; I MEMH1,MHADMH1 S OK=0 Q ;;S MH1=MH ;$TR($J(MH,2,2),".","_") S MH1=$TR($J(MH,2,2),".","_") S MH1=$P(MH1,"_",2)_"_"_$P(MH1,"_",1) ; -- 05/12/21 S OK=1 Q ; ; PAR1 Q:$G(PARIT)="" S PAR=PARIT I $E(PARIT,1,2)="A-" S PAR=$P(PARIT,"-",3) G PAR10 I PARIT?1N.N1"-"1N.N D Q .S PAR=$P(PARIT,"-") .S PARIT1=$$SHEM^W4P(PAR)_" "_$G(@$$^W4GL("P1SBR")@($P(PARIT,"-",2))) PAR10 S PARIT1=$$SHEM^W4P(PAR) Q ; ; FRMVRM(HZM) N N1,PAR,RF,PLU1,HNHD S PLU1="" N TIP S TIP=$$TIP^W4HZMST(HZM) N DT S DT=$$^%L1DC($$DATK^W4HZMST(HZM),3) ; S HNHD=$$HNH^W4HZMST(HZM) S TSFMH=$$DMSH^W4HZMST(HZM) I $$^W4TIPPD S TSFMH=TSFMH+TIP ; F N1=1:1 Q:'$D(@$$^W4ORD@(HZM,N1)) D .S PAR=$P($G(@$$^W4ORD@(HZM,N1)),"\") Q:PAR="" S RF=^(N1) .Q:'$$CDPAR(PAR) .D PLU2 D ..N N S N="" F S N=$O(@$$^W4ORD@(HZM,N1,N)) Q:N="" D ...N PAR,RF S RF=$G(^(N)),PAR=N D:$D(@$$^W4ORD@(HZM,N1,N))<10 PLU3 D ....S N3="" F S N3=$O(@$$^W4ORD@(HZM,N1,N,N3)) Q:N3="" D SUM3($G(^(N3))) Q ; ; PLU2 ;--- ITEM LEVEL N COL,PRC,SUM,ST,SUG,N,NEXT,CD Q:PAR="" I '$$CDPAR(PAR) Q S SUG=$P(RF,"\",2),COL=$P(RF,"\",5) S PRC=$P(RF,"\",4),SUM=$J(PRC*COL,2,2) ;;S MIN=$S($TR(SUG," ","")[">":1,1:0) S MIN=$$EX2KITCH^W4HZMST(HZM,N1) S HNHP=0,AHP=0 S CD=$P($G(@$$^W4ORD@(HZM,N1+1)),"\") I CD["-",CD["%" S AHP=+$E(CD,2,10) S HNHP=SUM*AHP*.01 D HNHC S COLP=COL D PLT Q ; PLU3 ;-- ADDS LEVEL 1 N ST0,COL,PRC,SUM,PARO,SUMHN S ST0=$P(RF,"\",2,25) S (HNHP,HNHC)=0 S PRC=$P(ST0,"\") S COL=+$P(ST0,"\",2) S SUM=PRC*COL I $G(AHP) S HNHP=SUM*AHP*.01 D HNHC D PLT Q ; ; SUM3(ST) ;-- ADDS LEVEL 2 N PAR,SUMHN S HNHP=0,HNHC=0 I $P(ST,"\") D Q .S PAR=$P(ST,"\") .S (COL,COL0)=$P(ST,"\",3) .S PRC=$P(ST,"\",7) .S SUM=COL*PRC .I $G(AHP) S HNHP=SUM*AHP*.01 .D HNHC .D PLT ; S PAR=$P(ST,"\",4) S COL=$P(ST,"\",3) S PRC=$P(ST,"\",7) S SUM=COL*PRC I $G(AHP) S HNHP=SUM*AHP*.01 D HNHC D PLT Q ; ; PLT ; N ST Q:'$$CDPAR(PAR) S PAR=$$EZD(PAR) Q:PAR="" S ST=$G(@VRM@(DAT,MRK,PAR,$J(PRC,2,2),HZM)) D SUMST S @VRM@(DAT,MRK,PAR,$J(PRC,2,2),HZM)=ST Q ; SUMST ; S $P(ST,"*",1)=$P(ST,"*",1)+COL S $P(ST,"*",2)=$P(ST,"*",2)+SUM S $P(ST,"*",3)=PRC S $P(ST,"*",4)=$P(ST,"*",4)+HNHP S $P(ST,"*",5)=$P(ST,"*",5)+HNHC S $P(ST,"*",10)=$P(ST,"*",10)+TSFMHP I SUM<0 D .S $P(ST,"*",6)=$P(ST,"*",6)-COL ; BITULIM COL .I $G(MIN) S $P(ST,"*",7)=$P(ST,"*",7)-COL ; BITULIM SHE YAZU (COL) .S $P(ST,"*",8)=$P(ST,"*",8)-SUM ; BITULIM SUM .I $G(MIN) S $P(ST,"*",9)=$P(ST,"*",9)-SUM ; BITULIM SHE YAZU (SUM) Q ; ; T ; N A,I,SUM,HRA,PAR,NMP S (T,T1,T2,T3,T4)=0 F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D .S A=$G(^(I)) S PAR=$P(A,"\") Q:PAR="" .S SUM=$P(A,"\",7),HRA=$TR($P(A,"\",8),".","") .S NMP=$TR($P(A,"\",3),".","") .S T=T+SUM ; -- SHUM LIFNEY ANAHOT .I HRA'["TAW",HRA'["SEQ",HRA'["SEC" S T1=T1+SUM .I HRA["TAW" S T2=T2+SUM .I NMP'[" "!(I<$O(@$$^W4MAIN("THZ1")@(9999),-1)) S T4=T4+SUM .I $P(A,"\")'="",'$D(@$$^W4GL("PRTBH")@(PAR)) S T3=T3+SUM ; -- FOR HNH Q ; HNHC ; I '$$CDPAR(PAR) Q S HNHC=0,TSFMHP=0 I T,$G(HNHD) S HNHC=HNHD*((SUM-HNHP)/T) ; I T S TSFMHP=TSFMH*((SUM-HNHP)/T) ; Q ; VRM ; D ^%W1PCVRM Q ; EZD(PAR) ; I $G(PAR)="" Q "" I $G(@$$^W4GL("W4EZD")@(PAR)) Q ^(PAR) I $G(@$$^W4GL("W4EZD")@($P(PAR,"-"))) Q ^($P(PAR,"-")) Q PAR ; CDPAR(PAR) ; I $TR(PAR,".","")?1N.N Q 1 Q 0 W4DPMM1 W4DPMM1(PAR,MEDT,ADDT) ; [ 17.09.18 07:14 ] [ 13.09.17 18:25 ] [ 12.10.14 10:55 ] [ N (JB,%ARG,%REM,PAR,MEDT,ADDT) ; I $G(PAR)="" W "ITEM NOT DEFINED",! Q ; D CLOSE^W4FIND W "

    ",! S VRM=$$^W4MAIN("VRM") S PAR1=$$SHEM^W4P(PAR) W "" W PAR_" "_$$H2U^%L1FRM(PAR1) W "",! ; W "

    ",! ; W "
    "_$$^%W1DICT("LINE")_""_$$^%W1DICT("ITEMNUMBER")_""_$$^%W1DICT("ITEMNAME")_""_$ZD(DT,"DD.MM.YY")_" "_$$H2U^%L1FRM($$^%L1DC(DT,9))_""_$$^%W1DICT("TOTAL")_"
    ",! W "" W "",! W "",! W "",! W "" ; S (SQN,SSUM)=0 F DT=MEDT:1:ADDT D .I $G(%ARG("DAYS")),'$E($G(%ARG("DAYS")),$$^%L1DC(DT,8)) Q .W "" .W " ",! .S QN=$G(@VRM@(PAR,DT,"QN")),SQN=SQN+QN .S SUM=$G(@VRM@(PAR,DT,"SUM")),SSUM=SSUM+SUM .D RKV(QN) .D RKV($J(SUM,2,2)) .W "" ; W "" W "" D RKV(SQN) D RKV($J(SSUM,2,2)) W "" ; W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("QUANT")_""_$$^%W1DICT("SUM")_"
    "_$ZD(DT,"DD.MM.YY")_" "_$$H2U^%L1FRM($$^%L1DC(DT,9))_"
     
    ",! W "
    ",! Q ; RKV(VL) ; D RKV^W4DPARMM(VL) Q W4DPNMAM W4DPNMAM(STAM) ; [ 06.10.21 12:56 ] [ N (JB) S OK=0 S N="" F S N=$O(@$$^W4GL("DEP")@(N)) Q:N="" D Q:OK .I $P($G(^(N,1)),"\")=0 S OK=1 Q OK W4DPRAON W4DPRAON ; [ 25.02.20 04:53 ] [ 26.12.15 09:50 ] [ 29.09.15 07:49 ] ;--- INPUT - DAT1,DAT2 N (JB,%ARG,%REM) ; I '$G(%ARG("MEDAT")),'$G(%ARG("ADDAT")) D ASK Q ; S LKH=$G(%ARG("LKH")) ;;S ADLKH=$G(%ARG("ADLKH")) ;;I ADLKH="" S ADLKH=9999999999 ; S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) ; D DIVBUT ; D VRM,KLF D FRM D PC K @VRM Q ; ASK ; W "
    " W "
    ",! W "",! W "" W " " W " " W " " W "",! W " " W "" W "" W "",! W "
    " W "",! D ASKLKH W "
    ",! W "    		" D ^%W1DAT("MEDAT",""," "_$$^%W1DICT("FROMDATE")_" ") W "" D ^%W1DAT("ADDAT",""," "_$$^%W1DICT("TODATE")_" ") 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 ; ASKLKH ; W "" W " " W $$^%W1DICT("CUSTCODE") W "",! W " " S FIND="Find('custcd','custcd','LKH','600px','120px','300px','400px','0')" W "",! W " ",! W " ",! W "",! Q ; VRM S VRM=$$^W4MAIN("VRM") Q KLF S KLF=$$^W4GL("KLF") Q ; FRM ; K @VRM I $$^W4ISCDLK(LKH) D FRMLKH(LKH) Q S LKH="" F S LKH=$O(@KLF@(LKH)) Q:LKH="" D FRMLKH(LKH) Q ; FRMLKH(LKH) ; N NOM,DT,NP,A,CHK,SUM S NOM="" F S NOM=$O(@KLF@(LKH,"CB",NOM)) Q:NOM="" D .N HD S HD=$G(^(NOM)) .;;S MZ=$P(HD,"\",2) .;;I MZ D ..S DT=$$^%L1DC($P(HD,"\",4),4) ..I DTADDT) Q ..S @VRM@(DT,LKH,NOM,"MZ")=MZ .S NP="" F S NP=$O(@KLF@(LKH,"CB",NOM,NP)) Q:NP="" D ..S A=$G(^(NP)) ..S SUM=+$$SUM(A) ..S DT=$$DT(A) ..I DTADDT) Q ..S CHK=+$$CHK(A) ..S @VRM@(DT,LKH,NOM,CHK)=SUM Q ; SUM(A) Q $P(A,"\") DT(A) Q $$^%L1DC($P(A,"\",7),3) CHK(A) Q $P(A,"\",6) ; PC ; W "
    ",! S IL=0,PG=1,RSIZE=33,SHLN=3,SSHLN=0 D KOT ; S SSUM=0 S DT="" F S DT=$O(@VRM@(DT)) Q:DT="" D .W "",! .W " ",! .W " "_$$^%W1DICT("DATEPRAON")_" "_$ZD(DT,"DD.MM.YY")_" ",! .W " ",! .W "",! .S LKH="" F S LKH=$O(@VRM@(DT,LKH)) Q:LKH="" D ..S NOM="" F S NOM=$O(@VRM@(DT,LKH,NOM)) Q:NOM="" D ...S CHK="" F S CHK=$O(@VRM@(DT,LKH,NOM,CHK)) Q:CHK="" D ....S SUM=$G(^(CHK)) ....S SHLN=SHLN+1 ....I SHLN>RSIZE D PAGEBREAK ....W "" ....W "  "_LKH_" " ....W "  "_$$H2U^%L1FRM($$LKH^W4L(LKH))_" " ....W "  "_NOM_" " ....W "  "_$S(CHK="MZ":$$^%W1DICT("CASH"),1:CHK)_" " ....D RKV(SUM,"darkblue") ....S SSUM=SSUM+SUM . .W "",! ; W "" W "  ",! W "  ",! W "  ",! W " "_$$^%W1DICT("TOTAL")_" ",! D RKV(SSUM,"darkblue",1) W "",! W "",! ; I 'SHLN D .W "",! ; W "
    ",! ; Q ; PAGEBREAK ; W "",! W "

    ",! S PG=PG+1 D KOT S SHLN=0 Q ; KOT ; W ""_$$^%W1DICT("PRAONREPORT")_"
    ",! ; W "" W " " ;;W " ",! ;;W " ",! ;;W " ",! ;;W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W "
    "_$$^%W1DICT("MELKH")_""_MELKH_""_$$^%W1DICT("ADLKH")_""_ADLKH_"    "_$$^%W1DICT("PAGE")_" : "_PG_"
    "_$$^%W1DICT("MEDATE")_""_MEDAT_""_$$^%W1DICT("ADDATE")_""_ADDAT_" 
    ",! ; W "
    ",! ; W "",! W " " W " " W " " W " " W " " W " " W " ",! Q ; RKV(RKV,COLOR,IT) ; I $G(COLOR)="" S COLOR="black" I 'RKV S RKV="" I RKV S RKV=$J(RKV,2,2) S STYLE=" style=""color:"_COLOR I RKV<0 S STYLE=" style=""color:red" I $G(IT) S STYLE=STYLE_";font-weight:bold" S STYLE=STYLE_"""" W "" Q ; HDSTYLE(STAM) ; Q " style=""color:brown;font-weight:bold""" ; DIVBUT ; W "
    " W "
    ",! W "
    "_$$^%W1DICT("CUSTOMNUMBER")_""_$$^%W1DICT("CUSTOMNAME")_""_$$^%W1DICT("RECEIPTNMB")_""_$$^%W1DICT("NCHECK")_""_$$^%W1DICT("SUM")_"
     "_RKV_" 
    ",! W "" W " " W "" W "" W "",! W "
    " D ROUNDBUT^%W1JS("Print",$$^%W1DICT("PRINT"),"Print()","color:green",",,,100") W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "

    ",! Q W4DPRTEN W4DPRTEN ; [ 18.08.16 11:06 ] [ 28.07.16 13:27 ] [ N (JB,%ARG) ; Q:$G(%ARG("SHOW"))=0 D ^W4IN D ^%W1ARG ; D GET ; S %SCRN=$$SCRN D PCPRM^W4DMANY(%SCRN) Q ; ; GET ; S GLPA=$$^W4GL("PRTENDA") S GLPE=$$^W4GL("PRTEND") S TMP=$$^W4MAIN("TMPREP") K @TMP ; S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; S I=0,(SAHBG,EXIT,SAHFN)=0 S DT=DT1-1 F S DT=$O(@GLPA@(DT)) Q:DT="" Q:DT>DT2 D .S PRT="" F S PRT=$O(@GLPA@(DT,PRT)) Q:PRT="" D ..S A=$G(^(PRT)) ..S B=$G(@GLPE@(DT,PRT)) ..S PRT1=$$SHEM^W4P(PRT) ..S I=I+1 ..S DAT=$ZD(DT,"DD.MM.YY") ..S @TMP@("G",I)=DAT_"\"_PRT_"\"_PRT1_"\"_+A_"\"_(A-B)_"\"_+B ..S SAHBG=SAHBG+A ..S SAHFN=SAHFN+B S EXIT=SAHBG-SAHFN Q ; CHKPRM(STAM) ; I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) ; Q "W4DPRTEN" W4DPRTSF W4DPRTSF(MEDAT,ADDAT) ; [ 17.08.21 07:49 ] [ 16.08.21 15:37 ] [ 10.08.21 12:07 ] N (JB,%ARG,%REM,MEDAT,ADDAT) Q:$G(%ARG("SHOW"))=0 I '$D(JB) W " JB number is not defined ! " Q N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; S PG=0,RSIZE=26,SSUM=0 ; S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) I 'ADDT S ADDT=+$H ; S MEKV=$G(%ARG("MEKV")) S ADKV=$G(%ARG("ADKV")) I 'ADKV S ADKV=9999999 ; D PREP(MEDT,ADDT) ; W "
    ",! W "
    ",! ; BODY ; D TMP S I=0,K=0 S KV="" F S KV=$O(@TMP@(KV)) Q:KV="" D .I KVADKV) Q .S K=K+1 I K=1 D KOT(KV,1,1) .D ..I I+4'>RSIZE,K>1 D KOT(KV,1) Q ..I I+4>RSIZE D PEREH(1) . .S PRT="" F S PRT=$O(@TMP@(KV,PRT)) Q:PRT="" I PRT'<0 D ..I $TR(PRT,".-","")'?1N.N Q ..S I=I+1 I I>RSIZE,$$PRINT D PEREH(0) ..D STR(KV,PRT) ..D STRADD(KV,PRT) ..W "
    ",! ; W "" W "" W $$^%W1DICT("TOTAL") W "" W " " W " " W " " W ""_$J(SSUM,2,2)_"" W "",! ; W "",! W "
    ",! Q ; ; STR(KV,PRT) ; W "" W " " W " "_PRT_" " W "" ; W " "_$$H2U^%L1FRM($$SHEM^W4P(PRT))_"" ; W "" S MH=$$MH(PRT) W $J(MH,2,2) W "",! ; W "" W $$KAM(KV,PRT) W "" ; W "" W $J($$SUM(KV,PRT),2,2) W "",! W "",! Q ; ; STRADD(KV,PRT) ; N N,A S N="" F S N=$O(@TMP@(KV,PRT,N)) Q:N="" I N D .I $TR(N,".-","")'?1N.N Q .S A=$G(^(N)) .S I=I+.33 I I>RSIZE,$$PRINT D PEREH(0) .S CDT=N .W "" .W " "_$$NBSP^%L1FRM(10)_CDT_"" .N NMT S NMT=$$SHEM^W4P(CDT) .W " "_$$H2U^%L1FRM($$SPA^%L1FRM(NMT))_"" .W "" . S MHT=$$MHT(PRT,CDT) . W $J(MHT,2,2) .W "" .W " "_$$KAMT(KV,PRT,CDT)_"" .W " "_$$SUMT(KV,PRT,CDT)_"" .W "",! Q ; PEREH(PCKV) ; D CLOSETBL I $$PRINT D PGBREAK D KOT(KV,PCKV,1) Q ; CLOSETBL ; W "",! Q ; KOT(KV,PCKV,PRH) ; I $G(PRH) S I=2 D .W "
    ",! . W "" . W $$^%W1DICT("PRTSFREPORT") . W "
    " . W "" . W $$^%W1DICT("FROMDATE")_" "_MEDAT_" "_$$^%W1DICT("UNTILDATE")_" "_ADDAT . W "",! .W "
    ",! ; I $G(PCKV) D . W "
    " . W "",! . W "",! . W "",! . W "",! . W "
    " . W $$H2U^%L1FRM($G(@$$^W4GL("PARSUG")@(KV))) . W "
    ",! .S I=I+1 ; S BORD=0 ;1 ; N WD S WD=60 I $$PRINT S WD=90 W "",! ; W "" W "" W "" W "" W "" W "" W "",! S I=I+1 Q ; PGBREAK ; W "

    ",! Q ; ADD(STAM) ; Q $G(%ARG("ADD")) ; ; PRINT(STAM) ; I $G(%ARG("PRINT")) Q 1 Q 0 ; ; TMP S TMP=$$^W4MAIN("TMP") Q ; KAM(KV,PRT) ; Q $P($G(@TMP@(KV,PRT)),"*") ; SUM(KV,PRT) ; Q $J($P($G(@TMP@(KV,PRT)),"*",2),2,2) ; KAMT(KV,PRT,CDT) ; Q $P($G(@TMP@(KV,PRT,CDT)),"*") ; SUMT(KV,PRT,CDT) ; Q $J($P($G(@TMP@(KV,PRT,CDT)),"*",2),2,2) ; MH(PRT) N MH,%ARG S MH=$$MH^W4P(PRT) Q MH ; MHT(PRT,CDT) N MHT,%ARG S MHT=$G(@$$^W4GL("MHT")@(PRT,CDT)) Q MHT ; SID(STAM) ; Q $G(%ARG("SID")) ; PREP(MEDT,ADDT) ; N (JB,%ARG,%REM,MEDT,ADDT,SSUM) D TMP K @TMP S SSUM=0 S REF=$$^W4REF S DT=MEDT-1 F S DT=$O(@REF@(DT)) Q:DT="" Q:DT>ADDT D .S HZ="" F S HZ=$O(@REF@(DT,HZ)) Q:HZ="" D ..I $$^W4HZMH(HZ) Q ..I $$I^W4PIZUL(HZ) Q ..S N1="" F S N1=$O(@$$^W4ORD@(HZ,N1)) Q:N1="" I N1 D ...S A=$G(^(N1)) ...S PRT=$P(A,"\"),QN=$P(A,"\",5),MH=$P(A,"\",4),SUM=QN*MH ...Q:PRT?.P ...S KV=+$$SUG^W4P(PRT) ...S $P(@TMP@(KV,PRT),"*")=$P($G(@TMP@(KV,PRT)),"*")+QN ...S $P(@TMP@(KV,PRT),"*",2)=$P($G(@TMP@(KV,PRT)),"*",2)+SUM ...S SSUM=SSUM+SUM ...S N2="" F S N2=$O(@$$^W4ORD@(HZ,N1,N2)) Q:N2="" D ....S A2=$G(^(N2)) ....I $D(^(N2))<10 D Q .....S QNT=+$P(A2,"\",3) .....S MHT=$P(A2,"\",2) .....S SUMT=QNT*MHT .....S $P(@TMP@(KV,PRT,N2),"*")=$P($G(@TMP@(KV,PRT,N2)),"*")+QNT .....S $P(@TMP@(KV,PRT,N2),"*",2)=$P($G(@TMP@(KV,PRT,N2)),"*",2)+SUMT .....S SSUM=SSUM+SUMT ..... .....S N3="" F S N3=$O(@$$^W4ORD@(HZ,N1,N2,N3)) Q:N3="" D ......S A3=$G(^(N3)) ......S CD3=$P(A3,"\") I 'CD3 S CD3=+$P(A3,"\",4) ......S QNT=+$P(A3,"\",3) ......S MHT=$P(A3,"\",7) ......S SUMT=QNT*MHT ......S $P(@TMP@(KV,PRT,CD3),"*")=$P($G(@TMP@(KV,PRT,CD3)),"*")+QNT ......S $P(@TMP@(KV,PRT,CD3),"*",2)=$P($G(@TMP@(KV,PRT,CD3)),"*",2)+SUMT ......S SSUM=SSUM+SUMT Q W4DPSHL W4DPSHL(MEDAT,ADDAT) ; DOCH HAZMANOT; [ 16.12.17 11:36 ] [ 20.04.17 17:18 ] [ 23.11.11 19:01 ] N (JB,%ARG,%REM,MEDAT,ADDAT,%REPN) D ^W4IN,^%W1PCVRM K @VRM S D1=$$^%L1DC(MEDAT,3),D2=$$^%L1DC(ADDAT,3) ; F NN=D1:1:D2 I $D(@$$^W4REF@(NN)) S N1="" D .F S N1=$O(@$$^W4REF@(NN,N1)) Q:N1="" D ..I $$^W4HZMH(N1) Q ..I $$^W4PIZUL(N1) Q ..S HZM=N1,SSUM=0 N MZ,PAR D ...S NMB=$$NMB^W4HZMST(HZM) Q:$$^W4MSL(NMB) D PLU1 ; S %REPN="W4SHPR" S %REPN("PRTN")=$$^%W1JB S %REPN("MEDAT")=MEDAT,%REPN("ADDAT")=ADDAT S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4dpshl.jsp?JB="_JB) END Q ; PLU1 N I,PAR,RF F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D .S PAR=$$PAR^W4HZMST(HZM,I) S RF=^(I) D ..Q:'$L(PAR) S SUGS=$$SUGL^W4L(NMB) S:'SUGS SUGS=0 D PLU2 ..N N S N="" F S N=$O(@$$^W4ORD@(HZM,I,N)) Q:N="" D ...S RF=^(N),PAR=N D PLU3 Q ; PLU2 ; N COL,PRC,SUM,ST,SUG,N,A S COL=$P(RF,"\",5),PRC=$P(RF,"\",4),COLP=COL S SUM=PRC*COL I PAR'["%" D .S PARO=PAR .S SUGP=+$$SUG^W4P(PAR),DEP=+$$DEP^W4P(PAR) ; S A="" I $D(PARO) S A=$G(@VRM@(SUGS,NMB,DEP,SUGP,PARO)) S $P(A,"*",1)=$P(A,"*",1)+COLP I PAR'["%" S $P(A,"*",3)=$P(A,"*",3)+SUM D HNH I PAR["%" S SUM=$P(RF,"\",7),$P(A,"*",2)=$P(A,"*",2)-SUM I $D(PARO) S @VRM@(SUGS,NMB,DEP,SUGP,PARO)=A Q ; PLU3 ; N ST0,COL,PRC,SUM,PARO,SUMHN S ST0=$P(RF,"\",2,25) S PARO=PAR N PAR S PAR=PARO I $E(PAR,1,2)="A-" D G PLU31 .S COL=+ST0,SUM=0,PRC=0 .S PARO=PAR,PAR="A-"_$P(PAR,"-",3) I ST0["\+\" D .S COL=($L(ST0,"+\")-1)*COLP .S SUM=$P(ST0,"\",6)*COLP I ST0'["\+\" D .S COL=$P(ST0,"\",2) S:'COL COL=COLP .S SUM=$P(ST0,"\")*COL S PRC=$P(ST0,"\") ; PLU31 N SUGP S SUGP=+$$SUG^W4P(PAR) S DEP=+$$DEP^W4P(PAR) S A=$G(@VRM@(SUGS,NMB,DEP,SUGP,PAR)) S $P(A,"*",1)=$P(A,"*",1)+COL S $P(A,"*",3)=$P(A,"*",3)+SUM S @VRM@(SUGS,NMB,DEP,SUGP,PAR)=A Q ; ; PAR N A S A=$G(@GLOB) S x1=$P(A,"*",1),x2=$P(A,"*",3) S x3=$P(A,"*",2) S x4=$P(A,"*",4) S x5=$J(x2-x3-x4,2,2) S PAR1=$$SHEM^W4P(PAR) I $G(SUGS),$G(^SUGS(SUGS))["OTH" D .S x2=$J($$MH^W4P(PAR)*x1,2,2),x4=x2-x3 .S x5=$J(x2-x3-x4,2,2) Q ; HNH ; Q W4DSPM W4DSPM ; [ 12.05.17 16:04 ] [ 01.04.17 13:05 ] [ 28.02.17 18:37 ] ;--- INPUT - DAT1,DAT2 ; ; ASONLY = 1 (KOLEL HAZMANOT , 2 -HESB & LAK BILVAD ) ; PRATI - ONE CUSTOMER ONLY N (JB,%ARG,%REM) ; D ^%W1ARG ; I $G(ADSPK)="" S ADSPK=9999999999 ; S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) ; D DIVBUT ; D FRM^W4DSPP(JB,MEDAT,ADDAT,$G(MESPK),$G(ADSPK)) D RIKUZ D PC S DIVDOWN="" D DIVBUT W "

    ",! K @VRM Q ; ; RIKUZ ; D ^%W1PCVRM D VRM1 K @VRM1 ; N SPK,DAT,SUGTD,NOMTD,NP,SUG,SUMTD S SPK="" F IL=1:1 S SPK=$O(@VRM@(SPK)) Q:SPK="" D .S DAT="" F S DAT=$O(@VRM@(SPK,DAT)) Q:DAT="" D ..S SUGTD="" F S SUGTD=$O(@VRM@(SPK,DAT,SUGTD)) Q:SUGTD="" D ...S NOMTD="" F S NOMTD=$O(@VRM@(SPK,DAT,SUGTD,NOMTD)) Q:NOMTD="" D ....S NP="" F S NP=$O(@VRM@(SPK,DAT,SUGTD,NOMTD,NP)) Q:NP="" D .....N A S A=$G(^(NP)) .....S SUG="?" .....S SUMTD=$P(A,"\") .....S SUMHV=$P(A,"\",2) .....I SUGTD=0 S SUG=0 .....I SUGTD=2 S SUG=1 .....I SUGTD=3 S SUG=4 .....I SUGTD=4 S SUG=2 .....I SUGTD=5 S SUG=2 .....I SUGTD=6 S SUG=3 .....I SUGTD=7 S SUG=3 .....S IND=SPK .....I $$SORT S IND=$$^W4ABCIND(SPK,$$SPK^W4L(SPK)) .....S @VRM1@(IND)=SPK .....S @VRM1@(IND,SUG)=$G(@VRM1@(IND,SUG))+SUMTD ; D FRMTMPREP Q ; ; ; PC ; W "

    ",! D PCPRM^W4DMANY("W4DSPMR") ; D DIVEXC^%W1PC1("W4DSPMR","%W1FREPX") ; S IL=0,PG=1,RSIZE=33,SHLN=3,SSHLN=0 S (SITRA0,SSKUP,SSHSBY,SSCB,SSTZ)=0 D KOT ; S IND="" F S IND=$O(@VRM1@(IND)) Q:IND="" D .S SPK=$G(^(IND)) .S SHLN=SHLN+1,SSHLN=SSHLN+1 .I SHLN>RSIZE D PAGEBREAK .W "
    " .W " " .W " " .N ITRA0,SKUP,SHSBY,SCB,ITRA .S ITRA0=$G(@VRM1@(IND,0)) .S SITRA0=SITRA0+ITRA0 .S SKUP=$G(@VRM1@(IND,1)) .S SSKUP=SSKUP+SKUP .S SHSBY=$G(@VRM1@(IND,2)) .S SSHSBY=SSHSBY+SHSBY .S STZ=$G(@VRM1@(IND,3)) .S SSTZ=SSTZ+STZ .S SCB=$G(@VRM1@(IND,4)) .S SSCB=SSCB+SCB .S ITRA=ITRA0+SKUP+SHSBY-STZ-SCB . .D RKV(ITRA0) .D RKV(SKUP,"darkblue") .D RKV(SHSBY,"darkblue") .D RKV(STZ,"red") .D RKV(SCB,"darkgreen") .D RKV(ITRA) . .W "",! ; W "",! W " ",! W " ",! D RKV(SITRA0,"darkblue",1) D RKV(SSKUP,"darkblue",1) D RKV(SSHSBY,"darkblue",1) D RKV(SSTZ,"red",1) D RKV(SSCB,"green",1) S SITRA=SITRA0+SSKUP+SSHSBY-SSTZ-SSCB D RKV(SITRA,"darkblue",1) W "",! W "
    "_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("QUANT")_""_$$^%W1DICT("SUM")_"
     "_SPK_"  "_$$H2U^%L1FRM($$NAME^W4SPK(SPK))_" 
    "_$$^%W1DICT("TOTAL")_" 
    ",! ; I 'SSHLN D .W "",! ; W "
    ",! ; Q ; PAGEBREAK ; W "",! W "

    ",! S PG=PG+1 D KOT S SHLN=0 Q ; KOT ; W "" ; W " " W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W " ",! W "
    "_$$^%W1DICT("PAGE")_" : "_PG_"
    "_$$^%W1DICT("MESPK")_""_$G(MESPK)_""_$$^%W1DICT("ADSPK")_""_$G(ADSPK)_" 
    "_$$^%W1DICT("MEDATE")_""_$G(MEDAT)_""_$$^%W1DICT("ADDATE")_""_$G(ADDAT)_" 
    ",! ; W "
    ",! ; W "",! W " " W " " W " " W " " I '$$^W4LKH D .W " " .W " " I $$^W4LKH D .W " " .W " " W " " W " " W " " W " ",! Q ; RKV(RKV,COLOR,IT) ; I $G(COLOR)="" S COLOR="black" I 'RKV S RKV="" I RKV S RKV=$J(RKV,2,2) S STYLE=" style=""color:"_COLOR I RKV<0 S STYLE=" style=""color:red" I $G(IT) S STYLE=STYLE_";font-weight:bold" S STYLE=STYLE_"""" W "" Q ; VRM1 ; S VRM1=$$^W4MAIN("VRM1") Q ; HDSTYLE(STAM) ; Q " style=""color:brown;font-weight:bold""" ; DIVBUT ; W "
    " W "
    ",! W "
    "_$$^%W1DICT("SUPPLNUMBER")_""_$$^%W1DICT("SUPPLNAME")_""_$$^%W1DICT("ITRA0")_""_$$^%W1DICT("BUINGSUM")_""_$$^%W1DICT("ARMINVOICESUM")_""_$$^%W1DICT("AUTOINVOICES")_""_$$^%W1DICT("OTHERINVOICES")_""_$$^%W1DICT("DEBINVOICES")_""_$$^%W1DICT("PAYMENTS")_""_$$^%W1DICT("ITRA")_"
     "_RKV_" 
    ",! W "" W "",! ; W " " ; W "" ; W "" W "",! W "
    " I '$D(DIVDOWN) D .W $$^%W1DICT("ABCSORT")_" " .W " " ; I $D(DIVDOWN) W " " W "" D ROUNDBUT^%W1JS("Print",$$^%W1DICT("PRINT"),"Print()","color:green",",,,100") W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "

    ",! Q ; ; FRMTMPREP ; D TMPREP K @TMPREP ; N IND,SPK,I,ST,ITRA0,SKUP,SHSBY,STZ,SCB,ITRA S I=0 ; S IND="" F S IND=$O(@VRM1@(IND)) Q:IND="" D .S SPK=$G(^(IND)) I SPK="" S SPK=IND .Q:'SPK .S ST=SPK_"\"_$$SPK^W4L(SPK) .S ITRA0=$G(@VRM1@(IND,0)) .S SKUP=$G(@VRM1@(IND,1)) .S SHSBY=$G(@VRM1@(IND,2)) .S STZ=$G(@VRM1@(IND,3)) .S SCB=$G(@VRM1@(IND,4)) .I 'SKUP,'SHSBY,'STZ,'SCB Q .S ST=ST_"\"_ITRA0 .S ST=ST_"\"_SKUP .S ST=ST_"\"_SHSBY .S ST=ST_"\"_STZ .S ST=ST_"\"_SCB .S ITRA=ITRA0+SKUP+SHSBY-STZ-SCB .S ST=ST_"\"_ITRA .S I=I+1 .S @TMPREP@("G",I)=ST Q ; TMPREP ; S TMPREP=$$^W4MAIN("TMPREP") Q ; SORT(STAM) ; Q $G(%ARG("SORT")) W4DSPP W4DSPP ; [ 31.01.19 10:21 ] [ 12.05.17 17:44 ] [ 01.04.17 13:01 ] ;--- INPUT - DAT1,DAT2 N (JB,%ARG,%REM) ; D ^%W1ARG W "
    " W "
    ",! W "",! W "" W " " W "" W "" W "",! W "
    " D ROUNDBUT^%W1JS("Print",$$^%W1DICT("PRINT"),"Print()","color:green",",,,100") W " " D ROUNDBUT^%W1JS("Back",$$^%W1DICT("BACK"),"Back()","color:red",",,,100") W "
    ",! W "
    ",! ; D ^%W1PCVRM I '$D(@VRM) D .D FRM(JB,MEDAT,ADDAT,MESPK,ADSPK) ; D PC Q ; ; FRM(JB,MEDAT,ADDAT,MESPK,ADSPK) ; N (JB,%ARG,%REM,MEDAT,ADDAT,MESPK,ADSPK) D PRM K @VRM ; D KLFKP ; S SHS=0,FIN=0 S SSUMH=0,SSUMZ=0,SUMH=0,SUMZ=0 K STRINGP ; K @TEMPL S N="" F S N=$O(@$$^W4GL("KLF")@(N)) Q:N="" D .N N1 S N1=$TR(N,"-","") .N MESTRING1 S MESTRING1=$TR(MESTRING,"-","") .N ADSTRING1 S ADSTRING1=$TR(ADSTRING,"-","") .I MESTRING?1U.E,$E(N1,1,$L(MESTRING1))'=MESTRING1 Q .I MESTRING1'?1U.E,N1ADSTRING1 Q .S SUGL=$$SUGL^W4L(N) I 'SUGL S SUGL=1 .I SUGL<$G(MESUGL) Q .I $G(ADSUGL),SUGL>ADSUGL Q .;;I $$SLAVE(N),'$D(@$$^W4GL("KLF")@(N,"H")),'$D(@$$^W4GL("KLF")@(N,"TZ")),'$D(@$$^W4GL("KLF")@(N,"CB")),'$D(@$$^W4GL("P1LHB")@(N)) Q .S @TEMPL@(N)=N ; S NNN="" F S NNN=$O(@TEMPL@(NNN)) Q:NNN="" I NNN'="PC" S STRING=NNN D .S SUMH=0,SUMZ=0,SHZ=0 K M .S FIRST=1 . .D ; -- HISHUV ITRA KODEMET ..N KLOST,ITRA0,ITRA1 ..S DAT0=$$^%L1DC(DAT1,"2-1") ..; ..D BDKRKZ(STRING) .. ..I $$GAMHZ D ^W4KLOST S ITRA=ITRA0 Q ;-- KOLEL HAZMANOT ..I $$CBHB S ITRA=$$CBH^W4KLOST(STRING,$$^%L1DC($$^%L1DC(DAT0,1),3)) ; HESB & KAB . .S DAT=$$CR^W4DTL(DAT0) .F S DAT=$O(@KLFKP@(DAT)) Q:DAT="" S DT=$$DT^W4DTL(DAT) I DT'DT2 Q ...I $$CBHB,DOC'="H",DOC'="CB",DOC'="TZ" Q ...I $$GAMHZ,DOC'="H",DOC'="CB",DOC'="TZ",DOC'="HZ",DOC'="HMK",DOC'="TM" Q ...I $$GAMHZ,DOC="HMK"!(DOC="TM"),'$$^W4LKH Q ...; ...S NUMBER="" F S NUMBER=$O(@KLFKP@(DAT,DOC,NUMBER)) Q:NUMBER="" D I $D(M) D SETST ....K M ....S STR=$G(^(NUMBER)) ....I FIRST D .....S FIRST=0 .....S M("SUGTD")=0 .....S M("ZHUT")="",M("HOVA")="",M("NOMTD")="" .....N DAT S DAT=$$CR^W4DTL(DAT1)_"0000" .....S M("ITRA")=$J(ITRA,2,2),M("SUMH")=ITRA .....D SETST .... ....S M("ZHUT")=$P(STR,"\",1) ....S M("HOVA")=$P(STR,"\",2) ....I +M("HOVA")=+M("ZHUT"),DOC'="H",DOC'="TZ",DOC'="HMK" K M Q ....S M("SUMH")=$S(M("HOVA"):M("HOVA"),M("ZHUT"):M("ZHUT"),1:$P(STR,"\",3)) ....S M("TRH")=$$^%L1DC(DAT,1) ....S M("SUGTD")=$S(DOC="HZ":1,DOC="H":$$SUGHB(NUMBER),DOC="CB":3,DOC="TZ":$$SUGHBZ(NUMBER),DOC["HMK":$$SUGHMK(NUMBER),DOC="TM":10,1:"") ....S M("NOMTD")=$S(NUMBER<0:-NUMBER,1:$P(NUMBER,"-",1,2)) .... ....I DOC="HZ"!(DOC="TM"),$$HB(STRING,DOC,NUMBER) D Q .....S M("ZHUT")="",M("HOVA")="" ....D ; I $G(ASONLY)=2 D ; *** LEV 26/02/15 .....I DOC="H"&NUMBER>0,M("SUMH") S M("HOVA")=$J(M("SUMH"),2,2) .....I DOC="TZ"!(NUMBER<0),M("SUMH") S M("HOVA")=$J(-M("SUMH"),2,2),M("ZHUT")="" .... ....I +M("HOVA")=+M("ZHUT"),DOC="H"!(DOC="TZ") S M("ZHUT")="" ....S M("ITRA")=ITRA+M("HOVA")-M("ZHUT"),ITRA=M("ITRA") .... ....D SUMHZ ...Q ..Q .Q ; D PUT^%W1PRM("W4DSPP",1) Q ; ; PC ; D PRM ; W "
    ",! S IL=0,PG=1,RSIZE=33,SHLN=0,SSHLN=0 S (SSHOV,SSZHUT,SLITRA,LITRA)=0 ; S SPK="" F IL=1:1 S SPK=$O(@VRM@(SPK)) Q:SPK="" D .S (SHOV,SZHUT)=0 .I IL=1 D KOT(SPK) S SHLN=SHLN+3 .I IL>1 D PAGEBREAK .S DAT="" F S DAT=$O(@VRM@(SPK,DAT)) Q:DAT="" D ..S SUGTD="" F S SUGTD=$O(@VRM@(SPK,DAT,SUGTD)) Q:SUGTD="" D ...S NOMTD="" F S NOMTD=$O(@VRM@(SPK,DAT,SUGTD,NOMTD)) Q:NOMTD="" D ....S NP="" F S NP=$O(@VRM@(SPK,DAT,SUGTD,NOMTD,NP)) Q:NP="" D .....N A S A=$G(^(NP)) Q:A="" .....S SHLN=SHLN+1,SSHLN=SSHLN+1 .....I SHLN>RSIZE D PAGEBREAK .....N DOP S DOP="" I SUGTD=4 S DOP="HY" .....S PRM=SPK_"n"_SUGTD_"n"_NOMTD_DOP_"n"_NP .....W "" .....W " "_$$^%L1DC(DAT,1)_"" .....W "  " .....I SUGTD=0 W "" .....W $$H2U^%L1FRM($$NAMEDOC(SUGTD)) .....N HBN S HBN=$$HBN(SPK,"HZ",NOMTD) .....I SUGTD=1,HBN W " [ "_$$H2U^%L1FRM("'yg")_" "_HBN_" ]" .....I SUGTD=0 W "" .....W "" .....W " "_NOMTD_"" .....D RKV($P(A,"\"),$S(SUGTD=6!(SUGTD=7):"red",1:""),$S(SUGTD=0:1,1:"")) ;- SHUM BE TEUDA .....D RKV($P(A,"\",2),"darkblue") S SHOV=SHOV+$P(A,"\",2) .....D RKV($P(A,"\",3),"green") S SZHUT=SZHUT+$P(A,"\",3) .....D RKV($P(A,"\",4),"black") S LITRA=$P(A,"\",4) .....W "",! .;---------------------- ITOGO ------- .W "" .W " "_$$^%W1DICT("TOTAL")_"" .W "  " .W "  " .W "  " . .S SSHOV=SSHOV+SHOV .S SSZHUT=SSZHUT+SZHUT .S SLITRA=SLITRA+LITRA . .D RKV(SHOV,"darkblue",1) .D RKV(SZHUT,"green",1) .D RKV(LITRA,"black",1) .W "",! . ; I 'SSHLN D .W "",! ; W "" W " "_$$^%W1DICT("TOTALALLCUSTOMERS")_"" W "  " W "  " W "  " D RKV(SSHOV,"darkblue",1) D RKV(SSZHUT,"green",1) D RKV(SLITRA,"black",1) W "",! W "",! W "
    ",! K @TEMPL K @VRM Q ; TEMPL S TEMPL=$$^W4MAIN("TEMPL") Q KLFKP S KLFKP=$$^W4GL("KLF")_"(STRING,""KP"")" Q SUMHZ ; S SUMH=SUMH+M("HOVA"),SUMZ=SUMZ+M("ZHUT") S SSUMH=SSUMH+M("HOVA"),SSUMZ=SSUMZ+M("ZHUT") Q ; HB(STRING,DOC,NOMTD) ; N OK S OK=0 N NOMTD S NOMTD=$$^W4NOMTD(NOMTD,DOC) I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,"HSB")) Q 1 N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,I,"HSB")) S OK=1 Q I OK Q OK N LK S LK="" F S LK=$O(@$$^W4GL("P1EZLI")@(STRING,LK)) Q:LK="" D .I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,"HSB")) S OK=1 Q .N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,I,"HSB")) S OK=1 Q Q OK ; ; HBN(STRING,DOC,NOMTD) ; N OK S OK=0 N NOMTD S NOMTD=$$^W4NOMTD(NOMTD,DOC) N ST S ST="" N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(STRING,NOMTD,I,"HSB")) D .S ST=ST_$G(^("HSB"))_"," I $L(ST) Q $E(ST,1,$L(ST)-1) ; N LK S LK="" F S LK=$O(@$$^W4GL("P1EZLI")@(STRING,LK)) Q:LK="" D .I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,"HSB")) S OK=1 Q .N I F I=1:1:20 I $D(@$$^W4GL("P1HL1")@(LK,NOMTD,I,"HSB")) D ..S ST=ST_$G(^("HSB"))_"," I $L(ST) S ST=$E(ST,1,$L(ST)-1) Q ST ; SETST ; N NP,IND1,IND2,IND3 S IND2=$G(M("SUGTD")) I IND2="" S IND2="-" S IND3=$G(M("NOMTD")) I IND3="" S IND3="-" S NP=$O(@VRM@(STRING,DAT,IND2,IND3,9999),-1)+1 S @VRM@(STRING,DAT,IND2,IND3,NP)=$G(M("SUMH"))_"\"_$G(M("HOVA"))_"\"_$G(M("ZHUT"))_"\"_$G(M("ITRA")) Q ; SLAVE(SPK) ; I $G(@$$^W4GL("P1EZL")@(SPK)) Q 1 Q 0 GAMHZ(STAM) Q $$GAMHZ^W4DLKM ; CBHB(STAM) Q $$CBHB^W4DLKM ; NAMEDOC(SUGTD) ; N SUGTD1 S SUGTD1="" I SUGTD=0 Q "zncew dxzi" I SUGTD=1 Q "dpnfd" I SUGTD=2 Q "fekix zipeayg" I SUGTD=3 Q "dlaw" I SUGTD=4 Q "'ci zipeayg" I SUGTD=5 Q "'tn zipeayg" I SUGTD=6 Q "iekif zipeayg" I SUGTD=7 Q "'tn iekif zipeayg" I SUGTD=8 Q "dlaw/qn zipeayg" I SUGTD=9 Q "'tn dlaw/qn zipeayg" I SUGTD=10 Q "gelyn zcerz" I SUGTD=11 Q "iekif fekix zipeayg" Q SUGTD1 ; PAGEBREAK ; W "",! W "

    ",! S PG=PG+1 D KOT(SPK) S SHLN=0 Q ; KOT(SPK) ; W ""_SPK_" "_$$H2U^%L1FRM($$SPK^W4L(SPK))_"
    ",! ; W "" D MEADL ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! W "
    "_$$^%W1DICT("MEDATE")_""_$G(%ARG("MEDAT"))_""_$$^%W1DICT("ADDATE")_""_$G(%ARG("ADDAT"))_"
    ",! ; W "" W " " W " ",! W " ",! W " ",! W " ",! ; W "
    "_$$H2U^%L1FRM($$KTVM^W4L(SPK))_""_$$^%W1DICT("TEL")_" : "_$$TELB^W4L(SPK)_""_$$^%W1DICT("PAGE")_" : "_PG_"
    ",! W "
    ",! ; W "",! W " " W " " W " " W " " W " " W " " W " " W " " W " ",! Q ; RKV(RKV,COLOR,IT) ; I $G(COLOR)="" S COLOR="black" I 'RKV S RKV="" I RKV S RKV=$J(RKV,2,2) S STYLE=" style=""color:"_COLOR I RKV<0 S STYLE=" style=""color:red" I $G(IT) S STYLE=STYLE_";font-weight:bold" S STYLE=STYLE_"""" W "" Q SUGHB(NOM) ; N LK I NOM<0 Q 11 S LK=$G(@$$^W4GL("KLIN")@("H",NOM)) I LK["+" Q 2 I LK["W" Q 5 Q 4 ; SUGHBZ(NOM) ; N LK S LK=$G(@$$^W4GL("KLIN")@("TZ",NOM)) I LK["W" Q 7 I LK["+" Q 11 Q 6 ; SUGHMK(NOM) ; N LK S LK=$G(@$$^W4GL("KLIN")@("HMK",NOM)) I LK["W" Q 9 Q 8 ; HDSTYLE(STAM) ; Q " style=""color:brown;font-weight:bold""" ; DEBT(STAM) ; Q +$G(%ARG("DEBT")) ; ZHUT(DOC) ; I $G(DOC)="CB" Q 1 Q 0 ; MEADL ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! ; W " " W " ",! W " ",! W " ",! W " ",! W " ",! Q ; PRM ; D ^%W1PCVRM D TEMPL S %ARG("MEKVZ")=$G(MEKVZ) S %ARG("ADKVZ")=$G(ADKVZ) S PRTN=$$^%W1JB S DAT1=$$^%L1DC(MEDAT,2) S DAT2=$$^%L1DC(ADDAT,2) S MESTRING=$TR(MESPK,"-","") I MESTRING,MESTRING<1000,'$$^W4LKH S MESTRING=1000 S ADSTRING=$TR(ADSPK,"-","") D MEADSUGL^W4DLKM S:'ADSTRING (ADSTRING,ADSPK)=99999999999 S:'ADSUGL ADSUGL=99999 ;;S ASONLY=3-ASONLY S DT1=$$^%L1DC(DAT1,4) S DT2=$$^%L1DC(DAT2,4) Q ; BDKRKZ(STRING) ; N DAT,OK N GLRKZ S GLRKZ=$$^W4GL("P1LHB") N GLKL S GLKL=$$^W4GL("KLF") N NUM S NUM="" F S NUM=$O(@GLRKZ@(STRING,NUM)) Q:NUM="" D .N DT0 S DT0=$G(@GLRKZ@(STRING,NUM,"HB","DF")) Q:'DT0 .N DAT0 S DAT0=$ZD(DT0,"YYYYMMDD")_"0000" .N SUM S SUM=$G(@GLRKZ@(STRING,NUM,"HB","SHUM")) Q:'SUM .S OK=0 .S DAT=DAT0 F S DAT=$O(@GLKL@(STRING,"KP",DAT)) Q:DAT="" D Q:OK ..I $D(@GLKL@(STRING,"KP",DAT,"H",NUM)) S OK=1 .Q:OK Q:NUM<1 .S DAT=$E(DAT0,1,8)_"0099" .S @GLKL@(STRING,"KP",DAT,"H",NUM)="\\"_SUM Q W4DTIP W4DTIP ; -- TASHLUMIM LE MELZARIM ; [ 04.12.24 05:31 ] [ 04.12.23 14:44 ] [ 21.02.22 06:11 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" ; K %L1PC S %REPN="W4DTIP" ;S %REPN("HZSCR")=HZSCR ;S %REPN("MISHL")=MISHL S %REPN("TRH","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN S @$$^%W1GLREP@("MIUN","PROG")="TRH^W4DTIP" S @$$^%W1GLPRM@("BEGIN")=1 Q ; ; TRH ; N DT,HZM,STIP,TIPMZ,TIPCH,TIPCA,TIPAS,MEDATH,ADDATH ; D ^%W1PCVRM K @VRM S MEDATH=$$^%L1DC(METRH,3) S ADDATH=$$^%L1DC(ADTRH,3) S:'$G(MEHZM) MEHZM="" S:'$G(ADHZM) ADHZM="99999999" ; N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") ; F DT=MEDATH:1:ADDATH S HZM=MEHZM-1 S:HZM<0 HZM="" D .I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) Q .F S HZM=$O(@$$^W4REF@(DT,HZM)) Q:HZM="" Q:HZM>ADHZM I $D(@$$^W4ORD@(HZM)) D ..I $$^W4HZMH(HZM) Q ..I $$I^W4PIZUL(HZM) Q ..S MKBL=$$MKBL^W4HZMST(HZM) ..I $G(@$$^W4PRM@("LAST")),$G(@$$^W4PRM@("MLZ")) D ...I $G(@$$^W4GL("P1MLZ")@(HZM)) S MKBL=$G(^(HZM)) ..S:'MKBL MKBL="00000" ..I $$HZM^W4MSL(HZM) S MKBL=$$PSL^W4HZMST(HZM) S:MKBL="" MKBL=9999 ..I $G(ADMKBL),MKBL<$G(MEMKBL)!($G(MKBL)>ADMKBL) Q .. ..S TIPMZ=$$STIPVT^W4HZMST(HZM,"MZ") ..S TIPCH=$$STIPVT^W4HZMST(HZM,"CH") ..S TIPCA=$$STIPVT^W4HZMST(HZM,"V") ..S TIPAS=$$STIPVT^W4HZMST(HZM,"ASR") ..S STIP=TIPMZ+TIPCH+TIPCA+TIPAS Q:'STIP ..S @VRM@(DT,MKBL,HZM)=STIP_"*"_TIPMZ_"*"_TIPCH_"*"_TIPCA_"*"_TIPAS . .N DT1 S DT1=DT_"^" .N GLTIP S GLTIP=$$^W4GL("TIPMZ") .F S DT1=$O(@GLTIP@(DT1)) Q:DT1="" Q:DT1'[(DT_"^") D ..S MKBL="" F S MKBL=$O(@GLTIP@(DT1,MKBL)) Q:MKBL="" D ...S (STIP,TIPMZ)=$G(^(MKBL)) ...N STIP0,TIPMZ0 S STIP0=$P($G(@VRM@(DT,MKBL,9999999)),"*",1) ...S TIPMZ0=$P($G(@VRM@(DT,MKBL,9999999)),"*",2) ...S @VRM@(DT,MKBL,9999999)=(STIP+STIP0)_"*"_(TIPMZ+TIPMZ0) ; S %L1PC("CONTINUE")="" Q ; DT ; S TRH=$$^%L1DC(DT,1) Q ; MKBL ; S MKBL1=$$^W4NAME(MKBL) Q ; HZM ; N SHAA1 ;;S ^AA(HZM,"GLOB")=$G(GLOB) S SHAA=$P($$ZMANK^W4HZMST(HZM)," ",2) I $$HZM^W4MSL(HZM) S SHAA=$$SHAA^W4HZMST(HZM) S SHAA1=SHAA I SHAA<5 S SHAA1=SHAA1+24 I ADSHAA,ADSHAA8 Q 19_DAT Q 20_DAT ; CRYYMM(DAT) ; Q $E($$CR(DAT),1,6) ; FULL(DAT) ; Q $E($$CR(DAT),1,8) ; YYMM(DAT) Q $E($$CRYYMM(DAT),3,6) ; FYYMM(DAT) Q $$CRYYMM(DAT) ; NP(DAT) ; I $L(DAT)<9 Q 0 Q $E(DAT,9,12) ; DT(DAT) ; Q $$^%L1DC($$W4DTL(DAT),4) W4DTLM W4DTLM(DT) ; HAZAGAT TLUSHEY MATANA BE DOH SGIRAT YOM [ 11.07.17 16:27 ] [ 15.09.16 10:03 ] [ 10.03.16 06:25 ] N (JB,%REM,%ARG,DT,DISP,NZ,P1X) D ^W4IN,^%L1TS D ^W4MDPPC S SM=5 ; D CRVRM ; S ST="" D W I $$HB D .S ST=" "_$$^%L1DC(DT,1)_" - l mipetew yenin g""ec" D W .S ST="-----------------------------------" D W .S ST=" mekq : oetew 'qn : dpnfd 'qn" S PRKOT=1 D W K PRKOT .S ST="-----------------------------------" D W I '$$HB D .S ST=" "_$$PCTX("REPZCOUP")_" "_$$^%L1DC(DT,1) D W .S ST=$TR($J("",30)," ","-") .S ST=" "_$$PCTX("ORDER",5)_" : "_$$PCTX("COUPNUMBER",12)_" : "_$$PCTX("SUM",8)_" " S PRKOT=1 D W K PRKOT ..S ST=$TR($J("",30)," ","-") ; S HZM="" F S HZM=$O(@VRM@(HZM)) Q:HZM="" D .S TL="" F S TL=$O(@VRM@(HZM,TL)) Q:TL="" D ..S A=$G(^(TL)),TL1=TL ..I TL<0 S TL1=$S($$HB:"'vig ",1:"Out")_" "_$J(-TL,7) ..I $$HB S ST=$J($P(A,"\",2),7,2)_" : "_$J(TL1,12)_" : "_$J($P(A,"\"),7) ..I '$$HB S ST=$J($P(A,"\"),7)_" : "_$J(TL1,12)_" : "_$J($P(A,"\",2),7,2) ..D W ; S ST="------------------------------------" D W I $$HB S ST=$J(SUM,7,2)_" : "_$J(COL,8)_": mipetew k""dq " D W I '$$HB S ST=$$PCTX("TOTALCOUP")_" : "_$J(COL,8)_" : "_$J(SUM,7,2) D W S ST="" D W I +$G(P1X)'=2,'$G(DISP) D ^W4CUT(PRINT,$G(%MDP("CUT"))) K @VRM Q ; W ; S:'$D(NZ) NZ=0 D ^W4PCST(ST,$G(DISP)) Q ; ; CRVRM ; S VRM=$$^W4MAIN("VRM") K @VRM ; S (COL,SUM)=0 S TL="" F S TL=$O(@$$^W4GL("W4TLMTN")@(TL)) Q:TL="" D .Q:$$DTTS^W4TLMTN(TL)'=DT .S PAID=$$PAID^W4TLMTN(TL) Q:'PAID .S HZM=$$HZMPAID^W4TLMTN(TL) .S @VRM@(HZM,TL)=HZM_"\"_PAID .S COL=COL+$S(PAID>0:1,1:-1) .S SUM=SUM+PAID Q ; HB(STAM) ; Q $$^%W1HB ; PCTX(KEY,L) Q $$^W4PCTX(KEY,$G(L)) W4DTM W4DTM ; DOCH TM [ 23.10.14 10:00 ] [ 12.09.13 07:15 ] [ 27.01.11 14:55 ] N (JB,%ARG,%REM) Q:$G(%ARG("SHOW"))=0 D PUT^%W1PRM("VD","TM") D ^W4IN D ^%W1ARG I '$G(MELKH) S MELKH="" I '$G(ADLKH) S ADLKH=99999999999 ; D GET ; S %SCRN=$$SCRN D PCPRM^W4DMANY(%SCRN) Q ; GET ; N KLIN S KLIN=$$^W4GL("KLIN") N CODDOC S CODDOC=$$CODDOC N TMPREP S TMPREP=$$^W4MAIN("TMPREP") K @TMPREP K @$$^W4MAIN("TMPREPB") ; S I=0 S (SUMTM,SLMAM,SMAM,SAH)=0 ; S N="" F S N=$O(@KLIN@(CODDOC,N)) Q:N="" D .S LK=$$LK^W4STRING(CODDOC,N) .I $TR(LK,"-","")<$TR(MELKH,"-","") Q .I $TR(LK,"-","")>$TR(ADLKH,"-","") Q .D LINETM(N,LK) Q ; LINETM(N,LK) ; D ^W4HSBGET(N,"TM") Q:$D(W4HSB)<10 ; Q:'$G(W4HSB("TODATE")) ; I $$^%L1DC(W4HSB("TODATE"),3)<$$^%L1DC(DAT1,3) Q I $$^%L1DC(W4HSB("TODATE"),3)>$$^%L1DC(DAT2,3) Q ; I $G(%ARG("MESUM")),W4HSB("TOT")<%ARG("MESUM") Q I $G(%ARG("ADSUM")),W4HSB("TOT")>%ARG("ADSUM") Q ; I $G(%ARG("MENOM")),N<%ARG("MENOM") Q I $G(%ARG("ADNOM")),N>%ARG("ADNOM") Q ; S I=I+1 S @TMPREP@("G",I)=N_"\"_W4HSB("TODATE")_"\"_LK_"\"_$$LKH^W4L(LK) S @TMPREP@("G",I)=@TMPREP@("G",I)_"\"_$J(W4HSB("LMAM"),2,2)_"\"_$J(W4HSB("MAM"),2,2)_"\"_$J(W4HSB("TOT"),2,2) S SUMTM=SUMTM+1 S SLMAM=SLMAM+W4HSB("LMAM") S SMAM=SMAM+W4HSB("MAM") S SAH=SAH+W4HSB("TOT") Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4DTM-CHKPRM","MELKH=MELKH & ADLKH=ADLKH & DAT1=DAT1 & DAT2=DAT2") I '$$DATVLD(DAT1) Q "0;DATENOTVALID;;DAT1ID"_$$DATVLD(DAT1) I '$$DATVLD(DAT2) Q "0;DATENOTVALID;;DAT2ID"_$$DATVLD(DAT2) I $$^%L1DC(DAT2,3)<$$^%L1DC(DAT1,3) Q "0;RANGENOTVALID;;DAT1IDdd" I MELKH>ADLKH Q "0;RANGENOTVALID;;MELKH" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4DTM" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N TM S TM=$$TMG(A) W " style=""cursor:pointer;color:black;font-size:"_$$^W3FSZ(11) W """" N CODDOC S CODDOC=$$CODDOC N LK S LK=$$LK^W4STRING(CODDOC,TM) W " onClick=""ShowItemsInvoice('"_TM_"T','"_LK_"','ifr')""" Q ; TD ; Q LKG(A) ; Q $P(A,"\",3) ; TMG(A) ; Q $P(A,"\") ; CODDOC(STAM) Q "TM" W4DTMRPR W4DTMRPR ; [ 30.10.22 15:59 ] [ 07.04.22 20:08 ] [ SET(PRM) ; N DAT,TIME,DD,MM,YY S DAT=$P(PRM,";") S DD=$E(DAT,1,2) S MM=$E(DAT,4,5) S YY=$E(DAT,7,8) ; S TM=$P(PRM,";",2) ; S ST="sudo date -s 20"_YY_"-"_MM_"-"_DD ZSY ST ; ZSY "sudo date -s "_TM ZSY "sudo /sbin/hwclock --systohc" H 10 D LOADPRNPRG^W4SERV Q ; HR ; W "",! Q ; ; MN ; W "",! Q W4DU2DU1 W4DU2DU1 ; [ 17.08.11 11:12 ] [ S DUMP=$$^W4GL("DUMP") S DUMP1=$$^W4GL("DUMP1") K @DUMP1 S N="" F S N=$O(@DUMP@(N)) Q:N="" D .S A=$G(^(N)) .S DAT=$P(A,"|",7) .S TIM=$P(A,"|",6) .S DT=$$^%L1DC(DAT,3) .S TM=TIM*3600+($P(TIM,":",2)*60) .S TM=$TR($J(TM,5)," ",0) .F I=1:1 Q:'$D(@DUMP1@(DT_TM_I)) .S @DUMP1@(DT_TM_I)=N Q W4DUMP W4DUMP(PRM) ; [ 09.07.18 08:39 ] [ 03.07.18 17:08 ] [ 14.06.18 15:07 ] N (JB,%ARG,%REM,PRM) D PUT^%W3DEB("W4DUMP","PRM=PRM") S ASM=$P(PRM,";",1) S DAT=$P(PRM,";",2) S MYDVN=$$^W4MYDVN,UR=1 S ER=0,ER1="" S DATE=20_$$^%L1DC(DAT,2) S INDMP=0,OKPC=0 ; I ASM D I OKPC G END1 .D ^W4MDPPC I '$G(PRINT) G END1 .D ^%L1TS .S INDMP=$P($G(@$$^W4GL("TRANL")@("ASM",ASM)),"^") Q:'INDMP .I INDMP,$D(@$$^W4GL("DUMP")@(INDMP,"PC"))>9 D ..S N="" F S N=$O(@$$^W4GL("DUMP")@(INDMP,"PC",N)) Q:N="" D ...S STPC=$TR($G(^(N)),TS0,TSS) ...S STPC=$J(STPC,40) ...S @$$^W4PC@(PRINT,$ZP(@$$^W4PC@(PRINT,99999))+1)=STPC ..D ^W4CUT(PRINT,$G(%MDP("CUT"))) ..S OKPC=1 ; I $$EMV^W4PRM G END1 ; D GL,GL1 D PUT^%W3DEB("W4DUMP","DATE=DATE&ASM=ASM") ; D GETDUMP(DATE,ASM) ; I $G(ER) D .N DAT1 S DAT1=$ZD($$^%L1DC(DAT,3)+1,"YYYYMMDD") .D GETDUMP(DAT1,ASM) .I $G(ER) D ..S DAT1=$ZD($$^%L1DC(DAT,3)-1,"YYYYMMDD") ..D GETDUMP(DAT1,ASM) ; I $G(ER) G END1 ; S DPSINFO="DepositInfo" S TRANSMIT="Transmit" S TOTALS="Totals" ; S I=0,RES="" CYC S I=I+1 ; I '$D(@GL1@(I)) G END S A=$G(^(I)) ; I A[("<"_DPSINFO) D .S BGDPS=I .S SPK=$$GET(I,"Retailer",DPSINFO) .S BGOI=BGDPS CYCORD .S BGOI=$$FIND(BGOI,TRANSMIT,DPSINFO) .I 'BGOI S I=$$FINDEND(BGDPS,DPSINFO,"") Q .S K=0 K M .S ASM=$$GET(BGOI,"ReferenceNumber",TRANSMIT) .S DATE=$$GET(BGOI,"TransmitDateTime",TRANSMIT) .S SHAA=$P($P(DATE," ",2),":",1,2) .S DATE=$P(DATE," ") .;;S DATE=$$TR2($P(DATE,"/",2))_"/"_$$TR2($P(DATE,"/",1))_"/"_$P(DATE,"/",3) .S NAME=$$GET(BGOI,"TerminalName",TRANSMIT) .S NAME=$$INVH^%L1FRM($$FUNC^%LCASE(NAME)) .S ISRNUM=$$GET(BGOI,"IsrCompanyNum",TRANSMIT) .S CALNUM=$$GET(BGOI,"CalCompanyNum",TRANSMIT) .S DINNUM=$$GET(BGOI,"DinersCompanyNum",TRANSMIT) .S AMEXNUM=$$GET(BGOI,"AmexCompanyNum",TRANSMIT) .S LEUMINUM=$$GET(BGOI,"LeumiCardCompanyNum",TRANSMIT) .S FILENUM=$$GET(BGOI,"FileNum",TRANSMIT) . .S BGDI=BGOI .; CYCD .S BGDI=$$FIND(BGDI,TOTALS,TRANSMIT) .I 'BGDI S BGOI=$$FINDEND(BGOI,TRANSMIT,DPSINFO) G CYCORD .S II=BGDI .S SUGC=0 CYCII .S II=II+1 Q:'$D(@GL1@(II)) .S A=$G(^(II)) Q:A[("<"_TOTALS) .; .I A["" S SUGC=0 .I A["" S SUGC=1 .I A["" S SUGC=2 .I A["" S SUGC=3 .I A["" S SUGC=4 .I A["" S SUGC=6 .I A["" S ZH=0 .I A["" S ZH=1 .I A["" S NIS=1 .I A["" S NIS=0 .I A["" S M(+$G(SUGC),+$G(ZH),+$G(NIS),"S")=$$GETVL(II,"Amount") .I A["" S M(+$G(SUGC),+$G(ZH),+$G(NIS),"Q")=$$GETVL(II,"Trans") .G CYCII ; G CYC END D PC END1 ;;K @GL,@GL1 Q ER_";"_ER1 ; ; 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 F J=I+1:1 Q:'$D(@GL1@(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 F J=I+1:1 Q:'$D(@GL1@(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=$$SPA^%L1FRM($G(@GL1@(I+1))) I A="" Q "" I $E(A)="<" Q "" ;;S ZN=$P(A,"<"_EL_">",2) S ZN=$P(A,"") S ZN=$$REG(ZN) Q $$SPA^%L1FRM(ZN) ; 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=$$FUNC^%UCASE(TXT) S TXT=$TR(TXT,TSS,TS0) Q TXT ; PC ; S MAS(3)=$G(NAME) S MAS(5)=$E($G(@$$^W4PRM@("ASH","MASOF")),1,7) ; S MAS(8)=$G(DATE) S MAS(10)=$G(SHAA) S MAS(12)=$G(ISRNUM) S MAS(14)=$G(CALNUM) S MAS(16)=$G(DINNUM) S MAS(18)=$G(AMEXNUM) S MAS(20)=$G(LEUMINUM) S MAS(22)=$G(ASM) S MAS(24)=$G(FILENUM) ; S MAS(30)=$G(M(0,0,1,"Q")) S MAS(33)=$$JS($G(M(0,0,1,"S"))) S MAS(35)=$G(M(0,1,1,"Q")) S MAS(37)=$$JS($G(M(0,1,1,"S"))) ; S MAS(39)=$G(M(1,0,1,"Q")) S MAS(40)=$$JS($G(M(1,0,1,"S"))) S MAS(58)=$G(M(1,1,1,"Q")) S MAS(60)=$$JS($G(M(1,1,1,"S"))) ; S MAS(62)=$G(M(2,0,1,"Q")) S MAS(63)=$$JS($G(M(2,0,1,"S"))) S MAS(64)=$G(M(2,1,1,"Q")) S MAS(65)=$$JS($G(M(2,1,1,"S"))) ; S MAS(70)=$G(M(3,0,1,"Q")) S MAS(71)=$$JS($G(M(3,0,1,"S"))) S MAS(72)=$G(M(3,1,1,"Q")) S MAS(73)=$$JS($G(M(3,1,1,"S"))) ; S MAS(75)=$G(M(4,0,1,"Q")) S MAS(76)=$$JS($G(M(4,0,1,"S"))) S MAS(77)=$G(M(4,1,1,"Q")) S MAS(78)=$$JS($G(M(4,1,1,"S"))) ; S MAS(80)=$G(M(6,0,1,"Q")) S MAS(81)=$$JS($G(M(6,0,1,"S"))) S MAS(82)=$G(M(6,1,1,"Q")) S MAS(83)=$$JS($G(M(6,1,1,"S"))) ; S LAB="DUMP" S MAS("EHAD")=1 D ^W4CB Q ; JS(SUM) ; Q $J(SUM*.01,2,2) GL ; S GL=$$^W4MAIN("TMPDMP") Q GL1 ; S GL1=$$^W4MAIN("TMPDMP1") Q GETDUMP(DAT,ASM) ; D ^W4SHVDMP(DAT,ASM) I ER Q D GL,GL1 S TOTTRANS="TotalTransDeals" ; N I,J,A S I=0,A="" GETDUMPC ; S I=I+1 Q:'$D(@GL@(I)) S A=A_$G(^(I)) I $E(A,$L(A)-2,$L(A))=">>>" D G GETDUMPC .S A=$E(A,1,$L(A)-3) ; I A[TOTTRANS D FRM(A) S A="" G GETDUMPC Q ; FRM(A) ; K @GL1 N J,SH S SH=0 S J=$F(A,TOTTRANS) ; K ETAG FRMC I J>$L(A) G FRMEND I $$LTE(A,J) D SETETAG S ETAG="",J=J+4 G FRMC ; I '$$LTB(A,J) S J=J+1 S:$D(ETAG) ETAG=ETAG_$E(A,J) G FRMC ; I $L($G(ETAG)) D SETETAG ; S J=J+4 S TAG="" ; FRMT I J>$L(A) G FRMEND I $$GT(A,J) S J=J+3 G FRMD S TAG=TAG_$E(A,J) S J=J+1 G FRMT ; FRMD ; S SH=SH+1 S @GL1@(SH)="<"_TAG_">" S DATA="" FRMDJ S J=J+1 I J>$L(A) G FRMEND I '$$LT(A,J) S DATA=DATA_$E(A,J) G FRMDJ ; S ETAG="</"_TAG ; I $E(A,J,J+$L(ETAG)-1)=ETAG D .S SH=SH+1 .S @GL1@(SH)=DATA .S SH=SH+1 .S @GL1@(SH)="" .S TAG="" .S J=$F(A,ETAG,J)+4 K ETAG G FRMC FRMEND Q ; ; LT(A,J) I $E(A,J)="&",$E(A,J+1)="l",$E(A,J+2)="t",$E(A,J+3)=";" Q 1 Q 0 ; LTB(A,J) I $E(A,J)="&",$E(A,J+1)="l",$E(A,J+2)="t",$E(A,J+3)=";",$E(A,J+4)'="/" Q 1 Q 0 ; LTE(A,J) I $E(A,J)="&",$E(A,J+1)="l",$E(A,J+2)="t",$E(A,J+3)=";",$E(A,J+4)="/" Q 1 Q 0 ; GT(A,J) I $E(A,J)="&",$E(A,J+1)="g",$E(A,J+2)="t",$E(A,J+3)=";" Q 1 Q 0 ; TR2(A) ; Q $TR($J(A,2)," ",0) ; SETETAG ; I '$L($G(ETAG)) Q S ETAG=$P(ETAG,"&") S SH=SH+1 S @GL1@(SH)="" K ETAG Q W4DVTBFX W4DVTBFX(HG) ; [ 12.02.25 13:20 ] [ 02.08.23 15:28 ] [ N DIR S DIR=$S($$^%W1DIR="RTL":"LTR",1:"RTL") Q "
    " W4DZ W4DZ(STAM) ; [ 10.09.08 16:13 ] [ 20.02.05 12:49 ] [ N P1DZ S P1DZ=$G(@$$^W4GL("P1DZ"),+$H) Q P1DZ W4EDTIME W4EDTIME ; [ 14.03.24 11:15 ] [ 28.11.21 15:17 ] [ 08.02.19 09:34 ] N (JB,%ARG) S HZM=$$GETP^%W1PRM("HZM") ; W "
    ",! W "


    ",! W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("KINDOFDOCUMENT")_""_$$^%W1DICT("NUMBEROFDOC")_""_$$^%W1DICT("SUMOFDOC")_""_$$^%W1DICT("HOVA")_""_$$^%W1DICT("ZHUT")_""_$$^%W1DICT("ITRA")_"
     "_RKV_" 
    "_$$^%W1DICT("MESUGL")_""_MESUGL_" "_MESUGL1_""_$$^%W1DICT("ADSUGL")_""_ADSUGL_" "_ADSUGL1_"
    "_$$^%W1DICT("MESPK")_""_MESPK_""_$$^%W1DICT("ADSPK")_""_ADSPK_"
    ",! W "" D DATE W "",! ; W "" W "",! W "" W "" W "",! ; W "" W "",! W "" W "",! W "
    " W $$^%W1DICT("TYPEDLVTIME") W "" D SHAA W "" D ADSHAA W "
    " W $$^%W1DICT("COMMENT") W "" D COMMENT W "
    ",! ; W "


    ",! D ^W4BTN("SUBMIT","Submit()","green") W $$NBSP^%L1FRM(10) D ^W4BTN("BACK","Back()","red") W "

    ",! W "",! Q ; DATE ; S %W1DAT("CLND")="2;270" S TODAT=$$TRH^W4HZMST(HZM) D ^%W1DAT("TODATE",TODAT,$$^%W1DICT("TYPEDLVDATE")) Q ; SHAA S TOSHAAHZ=$$SHAA^W4HZMST(HZM) W "",! ; W "",! ; Q ; ; ADSHAA ; S ADSHAAHZ=$$ADSHAA^W4HZMST(HZM) W $$^%W1DICT("ADSHAA") W $$NBSP^%L1FRM(3) W "",! ; W "",! Q ; ; SET(PRM) ; N (JB,%ARG,PRM) S HZM=$$GETP^%W1PRM("HZM") I HZM<1 Q "NOMORDERWRONG" S DAT=$P(PRM,";") S TM=$P(PRM,";",2) I TM'[":" Q "TIMEWRONG" S TMAD=$P(PRM,";",3) S TM=$TR($J($P(TM,":"),2)," ",0)_":"_$TR($J($P(TM,":",2),2)," ",0) S TMAD=$TR($J($P(TMAD,":"),2)," ",0)_":"_$TR($J($P(TMAD,":",2),2)," ",0) S CMNT=$$CNWEB^%L1FRM($P(PRM,";",4)) S CMNT=$$INVH^%L1FRM(CMNT) D PUT^W4HZMST(HZM,"TRH",DAT) D PUT^W4HZMST(HZM,"SHAA",TM) ; I $$ADSHAA^W4PRM D .D PUT^W4HZMST(HZM,"ADSHAA",TMAD) .S @$$^W4ORD@(HZM,"ADSHAA")=TMAD ; D PUT^W4HZMST(HZM,"HRAED",CMNT) S MSD=$$GETP^%W1PRM("MSD") D ^W4LINK(HZM,MSD,$$NMB^W4HZMST(HZM)) Q 1 ; COMMENT ; N PRM S PRM="IN" W "" Q W4ELPOS W4ELPOS(STAM) ; [ 11.10.18 12:02 ] [ 14.09.17 11:18 ] [ 03.02.17 05:35 ] I $$^W4LKH Q 0 I $$GETP^%W1PRM("DLVCSR")="WEB" Q 0 I $$DLVWEB^W4DLVCSR!$$ONLINE^W4DLVCSR Q 0 I $$CALLCENTER^W4PRM Q 0 Q (+$$GETP^%W1PRM("ELPOS")=1) W4EMAIL W4EMAIL(LKHN,NUMBER,VD,WD) ; [ 23.03.25 12:07 ] [ 05.06.24 14:57 ] [ 25.03.24 19:33 ] N (JB,%ARG,LKHN,NUMBER,VD,WD,HZM) W "

    ",! W "",! W "" ; D HOWSEND ; I $$^W4TABLET=2 D .W "",!,"" W " " ; W "" ; W "" ; W "" W "" ; W "" ; W "" ; I $$MYMAIL^W4PRM'="",$$MYMAIL^W4PRM["@",$$MYMAIL^W4PRM["." D SEND2SELF ; W "",! ; D COMMENT2MAIL ; D CRNEWMAIL(LKHN,5) ; W "
    " W $$SELMAIL($G(LKHN)) W "" D ADDMAILBUT(LKHN) W "" D DELMAILBUT(LKHN) W " " D OPENMAIL W " " S HDMAIL=$$HDMAIL($G(VD),NUMBER) D ^W4BUTTON("sendmail",$$^%W1DICT("SEND2MAIL"),"SendMail('"_HDMAIL_"','"_NUMBER_"','"_$G(VD)_"')","color:blue") W "
    ",! W "

    ",! W "
    ",! Q ; ; ADDMAILBUT(LKHN) ; D ^W4BUTTON("addmail",$$^%W1DICT("ADDMAIL"),"AddMail()","color:green") Q ; DELMAILBUT(LKHN,SELMAILID) ; I $G(SELMAILID)="" S SELMAILID="Email" D ^W4BUTTON("delmail",$$^%W1DICT("DELMAIL"),"DelMail('"_LKHN_"','"_SELMAILID_"')","color:red") Q ; OPENMAIL ; ;;D ^W4BUTTON("openmail",$$^%W1DICT("OPENMAIL"),"OpenMail()","color:blue") W "",! Q ; HDMAIL(VD,NUMBER) ; N DOP S DOP="" I $$SF^W4PRM S DOP="SFactory " N HDMAIL S HDMAIL=DOP_"Invoice "_NUMBER D I $G(VD)="HZMH" S HDMAIL=DOP_$S($$SF^W4PRM:"Order ",1:"Bid ")_NUMBER D I $G(VD)="HZ" S HDMAIL=DOP_"Order "_NUMBER D I $G(VD)="HMK",$$^W4ELPOS S HDMAIL=DOP_"Invoice for order "_NUMBER D I $G(VD)="CB" S HDMAIL=DOP_"Receipt "_DOP_NUMBER D Q HDMAIL ; HOWSEND ; W "" W $$^%W1DICT("HOWSENDDOC")_" " W "",! W "" Q ; CRNEWMAIL(LKHN,COLS,COLSP) N SELMAILID S SELMAILID="Email" I LKHN[";" S SELMAILID=$P(LKHN,";",2),LKHN=$P(LKHN,";") I '$G(COLS) S COLS=1 ;;W "",! W "" I $G(COLSP) W "" ; W "" W "" W "",! ;;W "
     " W "",! W "" W "",! W "",! W "",! W "",! W "
    " S SZ=50 I $$^W4TABLET=2 S SZ=42 W "" W "" D ^W4BUTTON("sbmnewmail",$$^%W1DICT("SUBMIT"),"SubmitNewMail('"_LKHN_"','"_SELMAILID_"')","color:green") W "" D ^W4BUTTON("cncnewmail",$$^%W1DICT("CANCEL"),"CancelNewMail()","color:red") W "
    ",! W "    		 
    ",! Q ; ; SELMAIL(LKHN,SELMAILID) ; S LKHN=$G(LKHN) I $G(SELMAILID)="" S SELMAILID="Email" N SEL S SELEMAIL="" S SEL="" Q SEL ; EMST(EMAIL) ; Q $$FUNC^%UCASE($$SPA^%L1FRM(EMAIL)) ; SELECTEDMAIL(N1) ; S N1=$$EMST(N1) N OK S OK=0 I $G(%ARG("NEWMAIL"))'="" Q (N1=$$EMST(%ARG("NEWMAIL"))) ; N HZM S HZM=$$GETP^%W1PRM("HZM") ; I $G(HZM)<1 D Q OK .N EM S EM=$$EMST($$EMAIL^W3HZMST(JB)) .I $L(EM),EM=N1 S OK=1 ; N EM S EM=$O(@$$^W4ORD@(HZM,"SENT2MAIL","")) S EM=$$EMST(EM) I $L(EM),$O(@$$^W4ORD@(HZM,"SENT2MAIL",EM))="" Q (EM=N1) ; S EM=$$EMST($$EMAIL^W3HZMST(JB)) I $L(EM) Q (EM=N1) ; S EM=$$EMAIL^W4HZMST(HZM) I $L(EM) Q (EM=N1) ; Q 0 ; ; NEWMAIL(PRM) ; N MAIL,LKH S MAIL=$P(PRM,";",1,1) I MAIL'["@"!(MAIL'[".") Q "EMAILADDRISWRONG" S MAIL=$$SPA^%L1FRM(MAIL) S MAIL=$$FUNC^%UCASE(MAIL) S LKH=$P(PRM,";",2,2) I LKH'="" D ; ,$D(@$$^W4GL("LKH")@(LKH)) D .I $$EMAIL^W4L(LKH)'["@" D PUT^W4L(LKH,MAIL,"EMAIL") .I MAIL'=$$EMAIL^W4L(LKH) D ..S @$$^W4GL("LKH")@(LKH,"E",MAIL)=$H Q 1 ; DELMAIL(PRM) ; N MAIL,LKH S MAIL=$P(PRM,";",1,1) I MAIL="" Q "NOTMAIL" S LKH=$P(PRM,";",2,2) I LKH="" Q "CUSTOMERNOTEXIST" I MAIL=$$EMAIL^W4L(LKH),$D(@$$^W4GL("LKH")@(LKH))=11 D PUT^W4L(LKH,"","EMAIL") I MAIL=$$EMAIL1^W4L(LKH),$D(@$$^W4GL("LKH")@(LKH))=11 D PUT^W4L(LKH,"","EMAIL1") N HZM S HZM=$$GETP^%W1PRM("HZM") I HZM>0 D .N EMAIL S EMAIL=$$EMAIL^W4HZMST(HZM) .I $$SPA^%L1FRM(EMAIL)'=$$SPA^%L1FRM(MAIL) Q .K @$$^W4ORD@(HZM,"EMAIL") K @$$^W4GL("LKH")@(LKH,"E",MAIL) Q 1 ; ; COMMENT2MAIL ; N VSB S VSB="visible" I $$SEL(1) S VSB="collapse" ; W "" W "",! W ""_$$^%W1DICT("COMMENT2MAIL")_" :
    " W "    ",! W "",! W "",! ; D WHENCOMM ; N PELE S PELE="" I $G(HZM) D .S PELE=$$PELE^W4HZMST(HZM) .I PELE="",$E($$TELB^W4HZMST(HZM),1,2)="05"!($E($$TELB^W4HZMST(HZM))=5) S PELE=$$TELB^W4HZMST(HZM) I PELE="",$G(LKHN) S PELE=$$PELE^W4L(LKHN) I PELE="",$G(LKHN),$E($$TELB^W4L(LKHN),1,2)="05"!($E($$TELB^W4L(LKHN))=5) S PELE=$$TELB^W4L(LKHN) I $E(PELE)=5 S PELE="0"_PELE S PELE=$TR(PELE,"-","") ; I $$IFWHATSAPP D D WHATSAPP($G(VD),NUMBER,PELE) .I '$G(HZM) W " " W "",! Q ; ; SEND2SELF ; W "" N HDMAIL1 S HDMAIL1=HDMAIL I $$DELIS^W4PRM S HDMAIL1="Send2Self "_HDMAIL D ^W4BUTTON("send2self","SEND2SELF","SendMail('"_HDMAIL1_"','"_NUMBER_"','"_$G(VD)_"','1')","green") W "" Q ; ; WHENCOMM ; I '$G(HZM) W " " Q I $G(HZM),$$HZM^W4MSD(HZM) W " " Q ; N ZMANCOM S ZMANCOM=$G(@$$^W4ORD@(HZM,"WHENCOMM")) N DATCOM,TIMECOM,SHAACOM,MINCOM S DATCOM=$P(ZMANCOM," ") S TIMECOM=$P(ZMANCOM," ",2) S SHAACOM=+TIMECOM S MINCOM=+$P(TIMECOM,":",2) ; I 'DATCOM S DATCOM="00.00.00" I TIMECOM="" S TIME="00:00" ; I '$G(HZM) W " " Q I '$$^W4HZMH(HZM) W " " Q ; W "" W $$^%W1DICT("WHENCOMMUNICATE"),"  " W "",! W "" ; W "" W "" W "" Q ; ; EMAILCONT(PRM) ; N VD S VD=$P($P(PRM,";",4),"^") I $$PCHBP Q $$EMAILCONT^W4PCHBP(PRM) I VD="HB"!(VD="HY")!(VD="HBZ")!(VD="CB") Q $$EMAILHB(PRM) Q "NOTVD" ; ; EMAILHB(PRM) N (JB,%ARG,PRM) D ^%L1TS ; D PARSEPRM(PRM) ; --> NOM,HDMAIL,EMAIL,VD ; S EMAIL=$$CLA^%L1FRM(EMAIL) I EMAIL'["@",$G(%ARG("WHATSAPP"))="" Q "EMAILWRONG" ; D PRM^W4MAIL ; --> FROM,SMRP,USER,PSW ; N WEB S WEB=$$WEB^W3MAIN I WEB["//" S WEB=$P(WEB,"//",2,20) I $E(WEB,$L(WEB))'="/" S WEB=WEB_"/" ; S FILE="/tmp/sndmail"_$G(JB) O FILE:(NEWVERSION:REWIND:WRITE) U FILE W "",! D ECONT(VD,NOM) W "",! C FILE ; D PROCFILE(FILE,COMMENT,HOWSEND) ;; --> FILE1,FILEC ; I $G(%ARG("WHATSAPP"))'="" D Q $ZSY .N PELE S PELE=$G(%ARG("WHATSAPP")) .D SNDWHATSAPP^W4PCHBP($G(HDMAIL),FILE1,PELE) ; N WHATSAPP S WHATSAPP=0 I $$DELIS^W4PRM,$$GETP^%W1PRM("MKRYD") S WHATSAPP=1 ; J SEND(JB,PRM,SMTP,USER,PSW,FROM,FILE1,FILEC,WHATSAPP) ; Q $ZSY ; ; SEND(JB,PRM,SMTP,USER,PSW,FROM,FILE1,FILEC,WHATSAPP) ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N NOM,HDMAIL,EMAIL,HOWSEND,PSEUDO S NOM=$P(PRM,";",1) S HDMAIL=$P(PRM,";",2) S EMAIL=$P(PRM,";",3) I EMAIL["[" S EMAIL=$P(EMAIL,"[") N VD S VD=$P(PRM,";",4) S HOWSEND=$P(PRM,";",7) I 'HOWSEND S HOWSEND=3 S PSEUDO=FROM I $$SF^W4PRM S PSEUDO="SFactory@5666666.co.il" ; L +^AL:10 ; S MSG="/pos/sbin/smail.py -m """_SMTP_""" -u """_USER_""" -p """_PSW_""" " S MSG=MSG_" -j """_HDMAIL_""" -s """_FROM_""" -y """_PSEUDO_""" " S MSG=MSG_" -r """_EMAIL_""" " I HOWSEND=1,$G(FILE1)'="" S MSG=MSG_" -b """_FILE1_""" " ; I HOWSEND=2!(HOWSEND=3) D .I $G(FILE1)'="" S MSG=MSG_" -a """_FILE1_""" " .I $G(FILEC)'="" S MSG=MSG_" -b """_FILEC_""" " ; S ^AL(JB,"MSG")=$E(MSG,1,800) zsy MSG ; S ^AL(JB,"ZSY")=$ZSY N MKRMAIL S MKRMAIL=$$GETP^%W1PRM("MKRMAIL") ; I MKRMAIL["W4FAXHTM" D .N HZ S HZ=$P(MKRMAIL,";",2) Q:'HZ .D MAILRES(HZ,EMAIL) ; D KILL^%W1PRM("MKRMAIL") ; L -^AL ; ;;S ^AA("W4EMAIL-SEND","VD")=VD ;;S ^AA("WHATSAPP-END","WHATSAPP")=$G(WHATSAPP) ; I $E($G(WHATSAPP),1,2)="05" D G CF .N PELE S PELE=WHATSAPP .D SNDWHATSAPP^W4PCHBP($G(HDMAIL),FILE1,PELE) ; I $G(WHATSAPP),VD="H"!(VD="HB")!(VD="HBZ")!(VD="HY"),NOM D .N PRTZ S PRTZ=0 .N LK I VD="H"!(VD="HB")!(VD="HY") S LK=$G(@$$^W4GL("KLIN")@("H",NOM)) .I VD="HBZ"!(VD="TZ") S LK=$G(@$$^W4GL("KLIN")@("TZ",NOM)),PRTZ=1 .I LK["+" S LK=$P(LK,"+") .N PELE S PELE=$$PELE^W4L(LK) .;;S ^AA("W4EMAIL-SEND","LK")=LK .;;S ^AA("W4EMAIL-SEND","PELE")=PELE . .I $L(PELE)>9 D ..D SNDWHATSAPP^W4PCHBP($G(HDMAIL),FILE1,PELE) ; CF C FILE1:(DELETE) C FILEC:(DELETE) ; D PROT(PRM,FILE1) Q ; ; ECONT(VD,NOM) ; S %ARG("NOM")=NOM S %ARG("MAIL")=1 S %ARG("VD")=VD ; W "
    ",! I '$$LOGO^W4KOTHSB D ^W4MSDNAM ; I VD="HB" D ^W4LHBVW ; I VD="HY"!(VD="HBZ") D ^W4HSBYVW ; I VD="CB" D .S %ARG("NOBACK")=1 .S %ARG("MAIL")=1 .D ^W4LCBCR W "
    ",! Q ; ; PARSEPRM(PRM) ; S NOM=$P(PRM,";") S HDMAIL=$P(PRM,";",2) S EMAIL=$P(PRM,";",3) S VD=$P(PRM,";",4) S HOWSEND=$P(PRM,";",7) S %ARG("ORDCONT")=$P(PRM,";",8) S %ARG("WHATSAPP")=$P(PRM,";",14) S COMMENT=$P(PRM,";",15,1000) Q ; PCHBP(STAM) ; I $$^W4ELPOS,VD="HZMH"!(VD="HZ")!(VD="HMK")!(VD="TM") Q 1 Q 0 ; PROT(PRM,FILE) ; D PARSEPRM(PRM) I $G(EMAIL)="" Q N FILEA S FILEA=$$FILEA(JB,VD,NOM) ZSY "cp "_FILE_" "_$$WEBL^W3MAIN_$$GETP^%W1PRM("MSD")_"/"_FILEA S @$$^W4GL("W4EMPROT")@($$^W4DZ,NOM_"VD"_VD,EMAIL)=$H_";"_$ZSY_";"_PRM_"<>"_FILEA I $E(VD,1,2)="HZ" D .S @$$^W4ORD@(+NOM,"SENT2MAIL",EMAIL,"FILE")=FILEA .S @$$^W4ORD@(+NOM,"SENT2MAIL",EMAIL,"FILE",+$H_$TR($J($P($H,",",2),5)," ",0))=FILEA Q ; FILEA(JB,VD,NOM) Q "AEM"_$ZD($H,"YYMMDD")_$TR($J($P($H,",",2),5)," ",0)_"JB"_JB_"VD"_VD_"NOM"_NOM ; PROCCOMMENT(COMMENT) S COMMENT=$$INVH^%L1FRM(COMMENT) S COMMENT=$$CNWEB^%L1FRM(COMMENT) ; I $$CMNTMAIL^W4PRM,$G(ORD),'$$TAKEAWAY^W4HZMST(ORD) Q $$NEWPROCCOMMENT(COMMENT,ORD) ; -- ORD FROM W4PCHBP ; S TX="" I $$SF^W4PRM D .S TX="
    xfeg liina xy`le mipekp dpnfdd ihxty `ceel yi
    " ; I '$$DELIS^W4PRM D .S TX="
    sxevn uaew geztl `p jnqna ditvl
    epil` mzipty dcez" ; I $G(ORD),$$TAWREADY(ORD),$G(@$$^W4PRM@("SENDREADY")) D .S TX=TX_"
    dpken jly dpnfd


    " .I $$TAKEAWAY^W4HZMST(ORD) D ..S TX=TX_"

    zgwl `eal `p

    " ; S COMMENT=$$H2U^%L1FRM(TX)_"
    "_$$H2U^%L1FRM(COMMENT) G PROCCOMMENT2 ; PROCCOMMENT1(COMMENT) ; PROCCOMMENT2 ; S COMMENT=$$RPL^%L1FRM(COMMENT,"_","
    ") ; S COMMENT="
    "_COMMENT_"

    " ; S COMMENT=COMMENT_"
    " ; ;;I $$DELIS^W4PRM D .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("qilc zeevn dkxaa") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("sxevn uaew geztl `p jnqna ditvl") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("epil` mzipty dcez")_"
    " .;;S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("dwtq`d cren iptl zery 24 cr dpnfd lhal ozip")_"
    " .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("bg iptl mini 10 milehia oi`")_"
    " .;;S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("cxynl zeptl `p zepnfd lehia ldepl")_"
    " .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("iptl zery 24 dpnfd lhal ozip `l")_"
    " . .S COMMENT=COMMENT_"


    "_$$H2U^%L1FRM("v""ca zgbyda oixcdn deext / ialg gahn xyk") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("zepaxd zgbyda ixya gahn") .S COMMENT=COMMENT_"
    " ; I $L($G(@$$^W4PRM@("MELEL")))>1 D .N MELEL S MELEL=^("MELEL") .S COMMENT=COMMENT_"
    " .N J F J=$L(MELEL,"_"):-1:1 D ..N ST,STN S ST=$P(MELEL,"_",J) ..S COMMENT=COMMENT_$$H2U^%L1FRM(ST)_"
    " .S COMMENT=COMMENT_"
    " ; N EMAIL S EMAIL=$G(@$$^W4PL@("ESEK",6)) S COMMENT=COMMENT_$$H2U^%L1FRM("l`ec")_" : "_EMAIL_"
    " ; S COMMENT=COMMENT_$$H2U^%L1FRM($G(@$$^W4PL@(2)))_"
    " S COMMENT=COMMENT_$$H2U^%L1FRM("lh")_" "_$G(@$$^W4PL@("ESEK",3))_" " S COMMENT=COMMENT_$$^%W1DICT("FAX")_" "_$G(@$$^W4PL@("ESEK",5))_"
    " N SITE S SITE=$G(@$$^W4PL@("ESEK",8)) ; I $L(SITE) D .S COMMENT=COMMENT_"" . S COMMENT=COMMENT_SITE .S COMMENT=COMMENT_"" S COMMENT=COMMENT_"
    " ; Q COMMENT ; ; SELECTED(I) ; I $$SEL(I) Q " selected=""selected"" " Q "" ; SEL(I) ; Q +I=$G(@$$^W4PRM@("HOWSEND"),3) ; ; PROCFILE(FILE,COMMENT,HOWSEND) ; --> FILE1,FILEC N DV S DV=$$^W4MYDVN S FILEC="/tmp/sndmailc"_DV_"_"_$G(JB) ; O FILEC:(NEWVERSION:REWIND:WRITE) U FILEC ; -- COMMENT FILE S COMMENT=$$PROCCOMMENT(COMMENT) W COMMENT,! C FILEC ; N FILE0 S FILE0="/tmp/sndmail1"_DV_"_"_$G(JB) S FILE1=FILE0_".html" C FILE1:(DELETE) ZSY "rm "_FILE1 O FILE1:(NEWVERSION:REWIND:WRITE) O FILE:(REWIND:READONLY) F U FILE R A Q:$ZEOF U FILE1 W A C FILE:(DELETE) C FILE1 ; I HOWSEND=3 D .N FILE2 S FILE2=FILE0_".pdf" .ZSY "rm "_FILE2 .ZSY "/pos/sbin/htmltopdf -q "_FILE1_" "_FILE2 . .I '$$SGNPDF^W4PRM!($G(HDMAIL)'["Invoice") D ..I $ZSY S ^AL(JB,"ZSY")=$ZSY_";"_FILE1_";"_FILE2_";ERRORPDFCNV" Q ..S FILE1=FILE2 . .I $$SGNPDF^W4PRM,$G(HDMAIL)["Invoice" D ..S VD=$P($G(VD),"^") ..;;I '(VD="HB"!(VD="HY")!(VD="HBZ")!(VD="CB")) Q ..N FILE3 S FILE3=FILE0_"sgn.pdf" ..ZSY "rm "_FILE3 ..ZSY "/pos/sbin/pdfsign.sh "_FILE2_" "_FILE3 ..I $ZSY S ^AL(JB,"ZSY")=$ZSY_";"_FILE1_";"_FILE2_";"_FILE3_";ERRORPDFCNV" Q ..S FILE1=FILE3 Q ; ; HB(TX) ; Q $$HB^W4SNDINV(TX) ; NEWPROCCOMMENT(COMMENT,ORD) ; N ST S ST="
    " S ST=ST_"
    "_$$H2U^%L1FRM("sxevn uaew geztl `p jnqna ditvl") S ST=ST_"
    "_$$H2U^%L1FRM("epil` mzipty dcez")_"
    " S ST=ST_"" S ST=ST_$$ROW("dpnfd 'qn",ORD) S ST=ST_$$ROW("'lh",$$TELB^W4HZMST(ORD)) S ST=ST_$$ROW("ciip 'lh",$$PELE^W4HZMST(ORD)) I $$SOAD^W4HZMST(ORD)>1 D .S ST=ST_$$ROW("micreq 'qn",$$SOAD^W4HZMST(ORD)) S ST=ST_$$ROW(" : gelynl zaezk",$$KTVM^W4HZMST(ORD)) S ST=ST_$$ROW("dnew",$$KOMA^W4HZMST(ORD)) S ST=ST_$$ROW("jix`z",$$TRH^W4HZMST(ORD)) S ST=ST_$$ROW("dry",$$SHAA^W4HZMST(ORD)) S ST=ST_$$ROW("melyzl k""dq",$J($$TSHL^W4HZMST(ORD),2,2)) ; N CODTS,CODTS1 S CODTS=$$CODTS^W4HZMST(ORD),CODTS1="" I CODTS S CODTS1=$$^W3SHOWTS(CODTS) S ST=ST_$$ROW("melyz zxev",CODTS1) S ST=ST_"

    " ; S ST=ST_$$PROCCOMMENT1($$H2U^%L1FRM(COMMENT))_"
    " Q ST ; ; ROW(TX,RKV) ; Q ""_$$H2U^%L1FRM(TX)_""_$$H2U^%L1FRM(RKV)_"" ; TAWREADY(ORD) ; N TAWR S TAWR=$G(@$$^W4ORD@(ORD,"READY")) I TAWR="" Q 0 N H S H=+$H+$P($H,",",2) N HRD S HRD=TAWR+$P(TAWR,",",2) I H-HRD<120 Q 1 I H-HRD<0 D Q RES .I $H-TAWR'=1 S RES=0 Q .I $P($H,",",2)+86400-$P(TAWR,",",2)>120 S RES=0 .S RES=1 Q 0 ; ; MAILRES(HZ,EMAIL) ; S $P(@$$^W4ORD@(HZ,"DBF"),"\",10)=EMAIL_"~"_$ZSY_"~"_$H ; I '$ZSY D Q .D SETOK^W4FAXHTM(HZ) .S @$$^W4ORD@(HZ,"EMAIL")=EMAIL_"~"_$H .S @$$^W4ORD@(HZ,"EMAIL",EMAIL)=$H ; S $P(@$$^W4ORD@(HZ,"DBF"),"\",6)=$ZSY Q ; ; IFWHATSAPP() ; I '$G(@$$^W4PRM@("WHATSAPP")) Q 0 Q 1 ; *** 21/01/24 N HZM S HZM=$$GETP^%W1PRM("HZM") I 'HZM Q 0 I '$$^W4HZMH(HZM) Q 0 Q 1 ; WHATSAPP(VD,NUMBER,PELE) ; S HDMAIL=$$HDMAIL($G(VD),NUMBER) W "" W $$^%W1DICT("WHATSAPPNUMBER")_" " W "" W $$NBSP^%L1FRM(2) D ^W4BUTTON("sendwhatsapp",$$^%W1DICT("SEND"),"SendMail('"_HDMAIL_"','"_NUMBER_"','"_$G(VD)_"','','1')","color:blue") W "" Q W4EMAIL0 W4EMAIL(LKHN,NUMBER,VD,WD) ; [ 20.08.20 11:42 ] [ 11.08.20 22:14 ] [ 07.08.20 17:16 ] N (JB,%ARG,LKHN,NUMBER,VD,WD,HZM) W "
    ",! W "",! W "" ; D HOWSEND ; W " " ; W "" ; W "" ; W "" W "" ; W "" ; W "" W "",! ; D COMMENT2MAIL ; D CRNEWMAIL(LKHN,5) ; W "" D WHATSAPP W "",! W "
    " W $$SELMAIL($G(LKHN)) W "" D ADDMAILBUT(LKHN) W "" D DELMAILBUT(LKHN) W " " D OPENMAIL W " " S HDMAIL=$$HDMAIL($G(VD),NUMBER) D ^W4BUTTON("sendmail",$$^%W1DICT("SEND2MAIL"),"SendMail('"_HDMAIL_"','"_NUMBER_"','"_$G(VD)_"')","color:blue") W "
    ",! W "

    ",! W "
    ",! Q ; ; ADDMAILBUT(LKHN) ; D ^W4BUTTON("addmail",$$^%W1DICT("ADDMAIL"),"AddMail()","color:green") Q ; DELMAILBUT(LKHN,SELMAILID) ; I $G(SELMAILID)="" S SELMAILID="Email" D ^W4BUTTON("delmail",$$^%W1DICT("DELMAIL"),"DelMail('"_LKHN_"','"_SELMAILID_"')","color:red") Q ; OPENMAIL ; ;;D ^W4BUTTON("openmail",$$^%W1DICT("OPENMAIL"),"OpenMail()","color:blue") W "",! Q ; HDMAIL(VD,NUMBER) ; N DOP S DOP="" I $$SF^W4PRM S DOP="SFactory " N HDMAIL S HDMAIL=DOP_"Invoice "_NUMBER D I $G(VD)="HZMH" S HDMAIL=DOP_$S($$SF^W4PRM:"Order ",1:"Bid ")_NUMBER D I $G(VD)="HZ" S HDMAIL=DOP_"Order "_NUMBER D I $G(VD)="HMK",$$^W4ELPOS S HDMAIL=DOP_"Invoice for order "_NUMBER D I $G(VD)="CB" S HDMAIL=DOP_"Receipt "_DOP_NUMBER D Q HDMAIL ; HOWSEND ; W "" W $$^%W1DICT("HOWSENDDOC")_" " W "",! W "" Q ; CRNEWMAIL(LKHN,COLS,COLSP) N SELMAILID S SELMAILID="Email" I LKHN[";" S SELMAILID=$P(LKHN,";",2),LKHN=$P(LKHN,";") I '$G(COLS) S COLS=1 ;;W "",! W "" I $G(COLSP) W "" ; W "" W "" W "",! ;;W "
     " W "",! W "" W "",! W "",! W "",! W "",! W "
    " W "" W "" D ^W4BUTTON("sbmnewmail",$$^%W1DICT("SUBMIT"),"SubmitNewMail('"_LKHN_"','"_SELMAILID_"')","color:green") W "" D ^W4BUTTON("cncnewmail",$$^%W1DICT("CANCEL"),"CancelNewMail()","color:red") W "
    ",! W "    		 
    ",! Q ; ; SELMAIL(LKHN,SELMAILID) ; S LKHN=$G(LKHN) I $G(SELMAILID)="" S SELMAILID="Email" N SEL S SELEMAIL="" S SEL="" Q SEL ; EMST(EMAIL) ; Q $$FUNC^%UCASE($$SPA^%L1FRM(EMAIL)) ; SELECTEDMAIL(N1) ; S N1=$$EMST(N1) N OK S OK=0 I $G(%ARG("NEWMAIL"))'="" Q (N1=$$EMST(%ARG("NEWMAIL"))) ; N HZM S HZM=$$GETP^%W1PRM("HZM") ; I $G(HZM)<1 D Q OK .N EM S EM=$$EMST($$EMAIL^W3HZMST(JB)) .I $L(EM),EM=N1 S OK=1 ; N EM S EM=$O(@$$^W4ORD@(HZM,"SENT2MAIL","")) S EM=$$EMST(EM) I $L(EM),$O(@$$^W4ORD@(HZM,"SENT2MAIL",EM))="" Q (EM=N1) ; S EM=$$EMST($$EMAIL^W3HZMST(JB)) I $L(EM) Q (EM=N1) ; S EM=$$EMAIL^W4HZMST(HZM) I $L(EM) Q (EM=N1) ; Q 0 ; ; NEWMAIL(PRM) ; N MAIL,LKH S MAIL=$P(PRM,";",1,1) I MAIL'["@"!(MAIL'[".") Q "EMAILADDRISWRONG" S MAIL=$$SPA^%L1FRM(MAIL) S MAIL=$$FUNC^%UCASE(MAIL) S LKH=$P(PRM,";",2,2) I LKH'="" D ; ,$D(@$$^W4GL("LKH")@(LKH)) D .I $$EMAIL^W4L(LKH)'["@" D PUT^W4L(LKH,MAIL,"EMAIL") .I MAIL'=$$EMAIL^W4L(LKH) D ..S @$$^W4GL("LKH")@(LKH,"E",MAIL)=$H Q 1 ; DELMAIL(PRM) ; N MAIL,LKH S MAIL=$P(PRM,";",1,1) I MAIL="" Q "NOTMAIL" S LKH=$P(PRM,";",2,2) I LKH="" Q "CUSTOMERNOTEXIST" I MAIL=$$EMAIL^W4L(LKH),$D(@$$^W4GL("LKH")@(LKH))=11 D PUT^W4L(LKH,"","EMAIL") I MAIL=$$EMAIL1^W4L(LKH),$D(@$$^W4GL("LKH")@(LKH))=11 D PUT^W4L(LKH,"","EMAIL1") N HZM S HZM=$$GETP^%W1PRM("HZM") I HZM>0 D .N EMAIL S EMAIL=$$EMAIL^W4HZMST(HZM) .I $$SPA^%L1FRM(EMAIL)'=$$SPA^%L1FRM(MAIL) Q .K @$$^W4ORD@(HZM,"EMAIL") K @$$^W4GL("LKH")@(LKH,"E",MAIL) Q 1 ; ; COMMENT2MAIL ; N VSB S VSB="visible" I $$SEL(1) S VSB="collapse" W "" W "",! W ""_$$^%W1DICT("COMMENT2MAIL")_" :
    " W "    ",! W "",! W "",! ; D WHENCOMM W "",! Q ; ; WHATSAPP Q W "" W $$^%W1DICT("TEL") W $$NBSP^%L1FRM(2) W "" W $$NBSP^%L1FRM(2) N PROC S PROC="SendMail('"_HDMAIL_"','"_NUMBER_"','"_$G(VD)_"','1')" D ^W4BUTTON("snd2whatsapp","SEND2WHATSAPP",PROC,"green") W "" Q ; ; WHENCOMM ; I '$G(HZM) W " " Q ; N ZMANCOM S ZMANCOM=$G(@$$^W4ORD@(HZM,"WHENCOMM")) N DATCOM,TIMECOM,SHAACOM,MINCOM S DATCOM=$P(ZMANCOM," ") S TIMECOM=$P(ZMANCOM," ",2) S SHAACOM=+TIMECOM S MINCOM=+$P(TIMECOM,":",2) ; I 'DATCOM S DATCOM="00.00.00" I TIMECOM="" S TIME="00:00" ; I '$G(HZM) W " " Q I '$$^W4HZMH(HZM) W " " Q ; W "" W $$^%W1DICT("WHENCOMMUNICATE"),"  " W "",! W "" ; W "" W "" W "" Q ; ; EMAILCONT(PRM) ; N VD S VD=$P($P(PRM,";",4),"^") I $$PCHBP Q $$EMAILCONT^W4PCHBP(PRM) I VD="HB"!(VD="HY")!(VD="HBZ")!(VD="CB") Q $$EMAILHB(PRM) Q "NOTVD" ; ; EMAILHB(PRM) N (JB,%ARG,PRM) D ^%L1TS ; D PARSEPRM(PRM) ; --> NOM,HDMAIL,EMAIL,VD ; S EMAIL=$$CLA^%L1FRM(EMAIL) I EMAIL'["@" Q "EMAILWRONG" ; D PRM^W4MAIL ; --> FROM,SMRP,USER,PSW ; N WEB S WEB=$$WEB^W3MAIN I WEB["//" S WEB=$P(WEB,"//",2,20) I $E(WEB,$L(WEB))'="/" S WEB=WEB_"/" ; S FILE="/tmp/sndmail"_$G(JB) O FILE:(NEWVERSION:REWIND:WRITE) U FILE W "",! D ECONT(VD,NOM) W "",! C FILE ; D PROCFILE(FILE,COMMENT,HOWSEND) ; J SEND(JB,PRM,SMTP,USER,PSW,FROM,FILE1,FILEC) Q $ZSY ; ; SEND(JB,PRM,SMTP,USER,PSW,FROM,FILE1,FILEC) ; N HDMAIL,EMAIL,HOWSEND,PSEUDO S HDMAIL=$P(PRM,";",2) S EMAIL=$P(PRM,";",3) I EMAIL["[" S EMAIL=$P(EMAIL,"[") S HOWSEND=$P(PRM,";",7) I 'HOWSEND S HOWSEND=3 S PSEUDO=FROM I $$SF^W4PRM S PSEUDO="SFactory@5666666.co.il" ; L +^AL:10 ; S MSG="/pos/sbin/smail.py -m """_SMTP_""" -u """_USER_""" -p """_PSW_""" " S MSG=MSG_" -j """_HDMAIL_""" -s """_FROM_""" -y """_PSEUDO_""" " S MSG=MSG_" -r """_EMAIL_""" " I HOWSEND=1,$G(FILE1)'="" S MSG=MSG_" -b """_FILE1_""" " ; I HOWSEND=2!(HOWSEND=3) D .I $G(FILE1)'="" S MSG=MSG_" -a """_FILE1_""" " .I $G(FILEC)'="" S MSG=MSG_" -b """_FILEC_""" " ; S ^AL(JB,"MSG")=$E(MSG,1,800) zsy MSG ; S ^AL(JB,"ZSY")=$ZSY N MKRMAIL S MKRMAIL=$$GETP^%W1PRM("MKRMAIL") ; I MKRMAIL["W4FAXHTM" D .N HZ S HZ=$P(MKRMAIL,";",2) Q:'HZ .D MAILRES(HZ,EMAIL) ; D KILL^%W1PRM("MKRMAIL") ; L -^AL ; C FILE1:(DELETE) C FILEC:(DELETE) ; D PROT(PRM,FILE1) Q ; ; ECONT(VD,NOM) ; S %ARG("NOM")=NOM S %ARG("MAIL")=1 S %ARG("VD")=VD ; W "
    ",! I '$$LOGO^W4KOTHSB D ^W4MSDNAM ; I VD="HB" D ^W4LHBVW ; I VD="HY"!(VD="HBZ") D ^W4HSBYVW ; I VD="CB" D .S %ARG("NOBACK")=1 .S %ARG("MAIL")=1 .D ^W4LCBCR W "
    ",! Q ; PARSEPRM(PRM) ; S NOM=$P(PRM,";") S HDMAIL=$P(PRM,";",2) S EMAIL=$P(PRM,";",3) S VD=$P(PRM,";",4) S HOWSEND=$P(PRM,";",7) S COMMENT=$P(PRM,";",14,1000) Q ; PCHBP(STAM) ; I $$^W4ELPOS,VD="HZMH"!(VD="HZ")!(VD="HMK")!(VD="TM") Q 1 Q 0 ; PROT(PRM,FILE) ; D PARSEPRM(PRM) I $G(EMAIL)="" Q N FILEA S FILEA=$$FILEA(JB,VD,NOM) ZSY "cp "_FILE_" "_$$WEBL^W3MAIN_$$GETP^%W1PRM("MSD")_"/"_FILEA S @$$^W4GL("W4EMPROT")@($$^W4DZ,NOM_"VD"_VD,EMAIL)=$H_";"_$ZSY_";"_PRM_"<>"_FILEA I $E(VD,1,2)="HZ" D .S @$$^W4ORD@(+NOM,"SENT2MAIL",EMAIL,"FILE")=FILEA .S @$$^W4ORD@(+NOM,"SENT2MAIL",EMAIL,"FILE",+$H_$TR($J($P($H,",",2),5)," ",0))=FILEA Q ; FILEA(JB,VD,NOM) Q "AEM"_$ZD($H,"YYMMDD")_$TR($J($P($H,",",2),5)," ",0)_"JB"_JB_"VD"_VD_"NOM"_NOM ; PROCCOMMENT(COMMENT) S COMMENT=$$INVH^%L1FRM(COMMENT) S COMMENT=$$CNWEB^%L1FRM(COMMENT) ; I $$CMNTMAIL^W4PRM,$G(ORD),'$$TAKEAWAY^W4HZMST(ORD) Q $$NEWPROCCOMMENT(COMMENT,ORD) ; -- ORD FROM W4PCHBP ; S TX="" I $$SF^W4PRM D .S TX="
    xfeg liina xy`le mipekp dpnfdd ihxty `ceel yi
    " ; I '$$DELIS^W4PRM D .S TX="
    sxevn uaew geztl `p jnqna ditvl
    epil` mzipty dcez" ; I $G(ORD),$$TAWREADY(ORD) D .S TX=TX_"

    dpken jly dpnfd


    " .I $$TAKEAWAY^W4HZMST(ORD) D ..S TX=TX_"

    zgwl `eal `p

    " ; S COMMENT=$$H2U^%L1FRM(TX)_"
    "_$$H2U^%L1FRM(COMMENT) G PROCCOMMENT2 ; PROCCOMMENT1(COMMENT) ; PROCCOMMENT2 ; S COMMENT=$$RPL^%L1FRM(COMMENT,"_","
    ") ; S COMMENT="
    "_COMMENT_"

    " ; S COMMENT=COMMENT_"
    " ; ;;I $$DELIS^W4PRM D .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("qilc zeevn dkxaa") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("sxevn uaew geztl `p jnqna ditvl") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("epil` mzipty dcez")_"
    " .;;S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("dwtq`d cren iptl zery 24 cr dpnfd lhal ozip")_"
    " .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("bg iptl mini 10 milehia oi`")_"
    " .;;S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("cxynl zeptl `p zepnfd lehia ldepl")_"
    " .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("iptl zery 24 dpnfd lhal ozip `l")_"
    " . .S COMMENT=COMMENT_"


    "_$$H2U^%L1FRM("v""ca zgbyda oixcdn deext / ialg gahn xyk") .S COMMENT=COMMENT_"
    "_$$H2U^%L1FRM("zepaxd zgbyda ixya gahn") .S COMMENT=COMMENT_"
    " ; I $L($G(@$$^W4PRM@("MELEL")))>1 D .N MELEL S MELEL=^("MELEL") .S COMMENT=COMMENT_"
    " .N J F J=$L(MELEL,"_"):-1:1 D ..N ST,STN S ST=$P(MELEL,"_",J) ..S COMMENT=COMMENT_$$H2U^%L1FRM(ST)_"
    " .S COMMENT=COMMENT_"
    " ; N EMAIL S EMAIL=$G(@$$^W4PL@("ESEK",6)) S COMMENT=COMMENT_$$H2U^%L1FRM("l`ec")_" : "_EMAIL_"
    " ; S COMMENT=COMMENT_$$H2U^%L1FRM($G(@$$^W4PL@(2)))_"
    " S COMMENT=COMMENT_$$H2U^%L1FRM("lh")_" "_$G(@$$^W4PL@("ESEK",3))_" " S COMMENT=COMMENT_$$^%W1DICT("FAX")_" "_$G(@$$^W4PL@("ESEK",5))_"
    " N SITE S SITE=$G(@$$^W4PL@("ESEK",8)) ; I $L(SITE) D .S COMMENT=COMMENT_"" . S COMMENT=COMMENT_SITE .S COMMENT=COMMENT_"" S COMMENT=COMMENT_"
    " ; Q COMMENT ; ; SELECTED(I) ; I $$SEL(I) Q " selected=""selected"" " Q "" ; SEL(I) ; Q +I=$G(@$$^W4PRM@("HOWSEND"),3) ; PROCFILE(FILE,COMMENT,HOWSEND) ; --> FILE1,FILEC S FILEC="/tmp/sndmailc"_$G(JB) O FILEC:(NEWVERSION:REWIND:WRITE) U FILEC ; S COMMENT=$$PROCCOMMENT(COMMENT) W COMMENT,! C FILEC ; N FILE0 S FILE0="/tmp/sndmail1"_$G(JB) S FILE1=FILE0_".html" O FILE1:(NEWVERSION:REWIND:WRITE) O FILE:(REWIND:READONLY) ; F U FILE R A Q:$ZEOF U FILE1 W A C FILE:(DELETE) C FILE1 ; I HOWSEND=3 D .N FILE2 S FILE2=FILE0_".pdf" .ZSY "/pos/sbin/htmltopdf -q "_FILE1_" "_FILE2 . .I '$$SGNPDF^W4PRM!($G(HDMAIL)'["Invoice") D ..I $ZSY S ^AL(JB,"ZSY")=$ZSY_";"_FILE1_";"_FILE2_";ERRORPDFCNV" Q ..S FILE1=FILE2 . .I $$SGNPDF^W4PRM,$G(HDMAIL)["Invoice" D ..S VD=$P($G(VD),"^") ..I '(VD="HB"!(VD="HY")!(VD="HBZ")!(VD="CB")) Q ..N FILE3 S FILE3=FILE0_"sgn.pdf" ..ZSY "/pos/sbin/pdfsign.sh "_FILE2_" "_FILE3 ..I $ZSY S ^AL(JB,"ZSY")=$ZSY_";"_FILE1_";"_FILE2_";"_FILE3_";ERRORPDFCNV" Q ..S FILE1=FILE3 Q ; ; HB(TX) ; Q $$HB^W4SNDINV(TX) ; NEWPROCCOMMENT(COMMENT,ORD) ; N ST S ST="
    " S ST=ST_"
    "_$$H2U^%L1FRM("sxevn uaew geztl `p jnqna ditvl") S ST=ST_"
    "_$$H2U^%L1FRM("epil` mzipty dcez")_"
    " S ST=ST_"" S ST=ST_$$ROW("dpnfd 'qn",ORD) S ST=ST_$$ROW("'lh",$$TELB^W4HZMST(ORD)) S ST=ST_$$ROW("ciip 'lh",$$PELE^W4HZMST(ORD)) I $$SOAD^W4HZMST(ORD)>1 D .S ST=ST_$$ROW("micreq 'qn",$$SOAD^W4HZMST(ORD)) S ST=ST_$$ROW(" : gelynl zaezk",$$KTVM^W4HZMST(ORD)) S ST=ST_$$ROW("dnew",$$KOMA^W4HZMST(ORD)) S ST=ST_$$ROW("jix`z",$$TRH^W4HZMST(ORD)) S ST=ST_$$ROW("dry",$$SHAA^W4HZMST(ORD)) S ST=ST_$$ROW("melyzl k""dq",$J($$TSHL^W4HZMST(ORD),2,2)) ; N CODTS,CODTS1 S CODTS=$$CODTS^W4HZMST(ORD),CODTS1="" I CODTS S CODTS1=$$^W3SHOWTS(CODTS) S ST=ST_$$ROW("melyz zxev",CODTS1) S ST=ST_"

    " ; S ST=ST_$$PROCCOMMENT1($$H2U^%L1FRM(COMMENT))_"
    " Q ST ; ; ROW(TX,RKV) ; Q ""_$$H2U^%L1FRM(TX)_""_$$H2U^%L1FRM(RKV)_"" ; TAWREADY(ORD) ; N TAWR S TAWR=$G(@$$^W4ORD@(ORD,"READY")) I TAWR="" Q 0 N H S H=+$H+$P($H,",",2) N HRD S HRD=TAWR+$P(TAWR,",",2) I H-HRD<120 Q 1 I H-HRD<0 D Q RES .I $H-TAWR'=1 S RES=0 Q .I $P($H,",",2)+86400-$P(TAWR,",",2)>120 S RES=0 .S RES=1 Q 0 ; ; MAILRES(HZ,EMAIL) ; S $P(@$$^W4ORD@(HZ,"DBF"),"\",10)=EMAIL_"~"_$ZSY_"~"_$H ; I '$ZSY D Q .D SETOK^W4FAXHTM(HZ) .S @$$^W4ORD@(HZ,"EMAIL")=EMAIL_"~"_$H .S @$$^W4ORD@(HZ,"EMAIL",EMAIL)=$H ; S $P(@$$^W4ORD@(HZ,"DBF"),"\",6)=$ZSY Q W4EMP W4EMP ; [ 21.06.20 16:09 ] [ 30.10.10 08:11 ] [ 20.04.10 14:48 ] N (JB,%ARG,SRCH) D GL I '$D(JB) W " JB number is not defined ! " Q I $G(%ARG("NOSHOW")) Q D PUT^%W3DEB("W4EMP","%ARG=[%ARG & SRCH=SRCH") I $D(%ARG("KV")) D PUT^%W1PRM("KV",%ARG("KV")) W "
    ",! W ""_$$^%W1DICT("EMPTABLE")_"",! W "",! W "" W "" W "" W "" W "" W "",! N N,I S N="",I=0 F S N=$O(@GL@(N)) Q:N="" D .N SUG S SUG=$$SUG(N) .I $G(%ARG("CDKV")),%ARG("CDKV")=SUG Q .I $G(%ARG("KV")),%ARG("KV")'=SUG Q .I $G(%ARG("KV"))="NO",SUG Q .;;W "N="_N_" 5",! .I $L($G(SRCH)),'$$^W1SRCH(SRCH,N,$$^W4NAME(N)) Q .;;W "N="_N_" 6",! .W "" S I=I+1 . .W "" . .W "" . .I '$G(%ARG("SET")) W "" . .W "" .W "",! W "
    "_$$^%W1DICT("EMPID")_""_$$^%W1DICT("EMPNAME")_""_$$^%W1DICT("EMPGROUP")_""_$$^%W1DICT("SIGN")_"
     "_N_"  "_$$H2U^%L1FRM($$^W4NAME(N))_"  "_$$SUG1(N)_" 
    ",! W "
    ",! Q ; GL ; S GL="^[$$^W3MAIN]TMPEMP($$^%W1JB)" Q SUG(EMP) D GL Q $P($G(@GL@(EMP)),"\") ; SUG1(EMP) D GL N SUG S SUG=$$SUG(EMP) I 'SUG Q $$^%W1DICT("NOGROUP") Q $$H2U^%L1FRM($G(@$$^W4GL("LEVKVZ")@(SUG))) W4EMPL W4EMPL ; [ 06.04.22 14:37 ] [ 30.10.10 08:12 ] [ 19.04.10 20:14 ] N (JB,%ARG,SRCH) D GL I '$D(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W4EMPL","%ARG=[%ARG & SRCH=SRCH") W "
    ",! W ""_$$^%W1DICT("ITEMSTABLE")_"",! W "",! W "" W "" W "" W "" W "",! N N,I S N="",I=0 F S N=$O(@GL@(N)) Q:N="" D .I $L($G(SRCH)),'$$^W1SRCH(SRCH,N) Q .W "" S I=I+1 . .W "" . .W "" . .W "" .W "",! W "
    "_$$^%W1DICT("EMPLCODE")_""_$$^%W1DICT("EMPLNAME")_""_$$^%W1DICT("SIGN")_"
     "_N_"  "_$$H2U^%L1FRM($$^W4NAME(N))_" 
    ",! W "
    ",! Q ; GL ; S GL=$$^W4GNAME Q ; W4EMV3 W4EMV3(PAY,SUGIS,SUGAS,MG,VIZ,DATT,P1,PN,PC,ASHTZ,ASHCVV2,AUTHNO) ; [ 29.12.24 12:08 ] [ 12.04.24 12:25 ] [ 03.04.24 13:42 ] N (JB,%ARG,PAY,SUGIS,SUGAS,MG,VIZ,DATT,P1,PN,PC,ASHTZ,ASHCVV2,AUTHNO,UIDBIT,STOUT) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; S MSG="" S STPRM="PAY="_$G(PAY)_"&SUGIS="_$G(SUGIS)_"&SUGAS="_$G(SUGAS)_"&MG="_$G(MG) S STPRM=STPRM_"&VIZ="_$G(VIZ)_"&DATT="_$G(DATT)_"&P1="_$G(P1)_"&PN="_$G(PN)_"&PC="_$G(PC)_"&UIDBIT="_$G(UIDBIT) S STPRM=STPRM_"&ASHTZ="_$G(ASHTZ)_"&ASHCVV2="_$G(ASHCVV2)_"&AUTHNO="_$G(AUTHNO) ; S HD="{" S HD=HD_$$RKV("jsonrpc","2.0",1) S HD=HD_","_$$RKV("method","doTransaction",1) S HD=HD_",""params"":[" S HD=HD_"""ashrait"",{" ; S VUID=$$VUID^W4STRINW ; S HZD=+$$GETP^%W1PRM("HZM")_"\"_$ZD($H,"DD.MM.YY 24:60") D DB("W4EMV3",+$G(VUID),"HZM",HZD) D DB("W4EMV3",+$G(VUID),"STPRM",STPRM) ; S INDL0=$G(@$$^W4GL("TRANL")) S INDL=$O(@$$^W4GL("TRANL")@(999999),-1) S:INDL<1 INDL=1 I INDL DV,FLIND ; ; D .L +@$$^W4GL("W4TRCNMB"):2 .N SH S SH=$G(@$$^W4GL("W4TRCNMB")) .S TRCNMB=$P(SH,";")_";"_($P(SH,";",2)+1) .S @$$^W4GL("W4TRCNMB")=TRCNMB .L -@$$^W4GL("W4TRCNMB") ; I $G(VIZ),'$L($G(MG)) G YAD ; S ST=$$RKV("amount",PAY) S ST=ST_","_$$RKV("vuid",VUID,1) S ST=ST_","_$$RKV("currency",376,1) S ST=ST_","_$$RKV("creditTerms",SUGAS) ; S TRCODE=1 S ST=ST_","_$$RKV("tranCode",TRCODE) ; S TRTYPE=1 I SUGIS=51 S TRTYPE=53 S ST=ST_","_$$RKV("tranType",TRTYPE) ; I SUGAS=6,$G(PN) D ; -- CREDIT PAYMENT .S ST=ST_","_$$RKV("creditPayments",PN) ; I SUGAS=8 D ; --- PAYMENTS .I $G(PN),$G(P1),$G(PC) D ..S ST=ST_","_$$RKV("payments",PN) ..S ST=ST_","_$$RKV("firstPaymentAmount",P1) ..S ST=ST_","_$$RKV("otherPaymentAmount",PC) ; I $L($G(MG)) S ST=ST_","_$$RKV("cardTrack2",MG,1) ; I $G(VIZ),'$L($G(MG)) D ; -- NO TRACK2 .S ST=ST_","_$$RKV("posEntryMode",50) .S ST=ST_","_$$RKV("cardNumber",VIZ,1) .I $G(ASHCVV2) S ST=ST_","_$$RKV("cvv",ASHCVV2,1) .I '$G(DATT) S DATT=1249 .S ST=ST_","_$$RKV("expDate",$E(DATT,3,4)_$E(DATT,1,2),1) ; I $G(ASHTZ) S ST=ST_","_$$RKV("cardHolderID",ASHTZ,1) I $G(AUTHNO) S ST=ST_","_$$RKV("authNum",AUTHNO,1) S ST=ST_","_$$RKV("sysTraceNumber",TRCNMB,1) ; S FOOT="}]," ; ; S ID=$O(@GL@(99999),-1)+1 S ID=$TR($J(INDL,5)," ",0)_$TR($J(ID,5)," ",0) S FOOT=FOOT_$$RKV("id",ID,1) S FOOT=FOOT_"}" ; S STR=HD_ST_FOOT ; S FL=$$PATH_"tmpemv"_FLIND ; D DB("W4EMV3",+$G(VUID),"STR",STR) ; O FL:(NEWVERSION:REWIND) U FL W STR C FL ; S URL=$$URL(DV) I URL="" S STA=999,MSG="NOADR" G END ; S FLOU=$$PATH_"tmpemvou"_FLIND ; ; D .N HZM S HZM=$$GETP^%W1PRM("HZM") Q:'HZM .Q:'$G(VUID) Q:'$G(ID) Q:'$G(PAY) .N IND S IND=$O(@$$^W4ORD@(HZM,"CB","V",999),-1)+1 .K @$$^W4ORD@(HZM,"EMVP",IND) .S @$$^W4ORD@(HZM,"EMVP",IND,"STIN")=STPRM .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","VUID")=VUID .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","ID")=ID .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","DV")=$$^W4MYDVN .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","URL")=URL .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","FLIND")=FLIND .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","AMOUNT")=PAY ; D CMD(FL,URL,FLOU) ; I $$SIZE^%L1ZOS(FLOU)<1!'$$EXIST^%L1ZOS(FLOU)!($G(ER)=28) D G:$G(MSG)'="" END .H 10 S MSG="",ER="" .D GETBYVUID(VUID,ID,URL,FLIND) ; --> FLOU,ER .I '$$EXIST^%L1ZOS(FLOU) S STA=999,MSG="NOANSWER" Q .I ER=28 S STA=999,MSG="CONNECT TIMEOUT" Q ; G TV ; OU(FLOU) ; ; TV D FL2ARR(FLOU) N A,I S A="" F I=1:1 Q:'$D(ARR(I)) S A=A_ARR(I) ;;K ARR N ST1,ST2 S ST1=$P($P(A,"merchantReceipt",2),"customerReceipt") S ST2=$P(A,"customerReceipt",2) D GETFLD(ST1,1) D GETFLD(ST2,2) ; S OUT("STA")=$$GET(A,"statusCode") S STA=OUT("STA") ; N GETID S GETID=$$GET(A,"id") I JB'=1,GETID'=ID D G:STA=999 END .N GETID S GETID=$$GET(A,"vuid") .I JB'=1,GETID'=VUID S STA=999,MSG="ID OR VUID IS WRONG" ; N RESMSG S RESMSG=$$FUNC^%UCASE($$GET(A,"statusMessage")) S OUT("RESMSG")=$$U2H($$CLR(RESMSG)) S OUT("SOLEK")=$$GET(A,"solek") S OUT("SAPAK")=$$GET(A,"authCodeSolek") ;;S OUT("SAPAKTEL")=$$SPA^%L1FRM($P($P(HD,"""solek_phone"":",2),",")) S OUT("AUTHNO")=$$GET(A,"issuerAuthNum") ; S OUT("MUTAG")=$$GET(A,"mutag") S OUT("MANPIK")=$$GET(A,"manpik") S OUT("VIZ")=$$GETPC("xtqn",1) I '$L(OUT("VIZ")) S OUT("VIZ")=$$GET(A,"cardNumber") I OUT("VIZ")["*" S OUT("VIZ")=$TR(OUT("VIZ"),"*",".") S OUT("MASOF")=$$GETPC("seqn xtqn",1) I OUT("MASOF")="" D .S OUT("MASOF")=$$GET(A,"acquirerMerchantID") S OUT("NMCARD")=$$INVH^%L1FRM($$GETPC("qihxk",1)) I OUT("NMCARD")="" D .S OUT("NMCARD")=$$GET(A,"cardName") S OUT("UID")=$$GET(A,"uid") S OUT("VUID")=$$GET(A,"vuid") S OUT("ID")=$$GET(A,"id") S OUT("FLIND")=$G(FLIND) S OUT("AMOUNT")=$G(PAY) S OUT("URL")=$G(URL) ; TV1 ; S HZM=$$GETP^%W1PRM("HZM") ; M ^LV($$DT,$P($H,",",2),"W4EMV3",+$G(VUID),"OUT")=OUT ; ; I $G(OUT("STA"))?."-"1N.N D .S $E(STOUT,1,3)=$$DOP^%L1FRM($G(OUT("STA")),3) ; D DB("W4EMV3",+$G(VUID),"STOUT0",$G(STOUT)) I '$G(UIDBIT) D .S $E(STOUT,24)=$S($E($G(OUT("MUTAG")))?1N:$E($G(OUT("MUTAG"))),1:" ") .S $E(STOUT,60)=$S($E($G(OUT("MANPIK")))?1N:$E($G(OUT("MANPIK"))),1:" ") .S $E(STOUT,25)=$S($E($G(OUT("SOLEK"))):$E($G(OUT("SOLEK"))),1:" ") ; I $G(OUT("VIZ")) D .S $E(STOUT,5,23)=$$TR($G(OUT("VIZ")),19) S $E(STOUT,71,77)=$$TR($G(OUT("AUTHNO")),7) S $E(STOUT,104,118)=$$HBR^%L1FRM($G(OUT("NMCARD")),15) ; D DB("W4EMV3",+$G(VUID),"STOUT",STOUT) S STA=$E(STOUT,1,3) S MSG=$G(OUT("RESMSG")) ; I HZM,'$$^W4CLOSE(HZM) D .S LAST=$O(@$$^W4ORD@(HZM,"CB","V",999),-1)+1 .M @$$^W4ORD@(HZM,"EMV",LAST)=ARRPC .S @$$^W4ORD@(HZM,"EMV",LAST,"STOUT")=STOUT .S @$$^W4ORD@(HZM,"EMV",LAST,"STIN")=STPRM .M @$$^W4ORD@(HZM,"EMV",LAST,"OUT")=OUT ; I $$^W4AUTHCD(STA) D .S MSG=$TR($G(OUT("SAPAKTEL"))_"^"_$G(OUT("SAPAK")),"""","") ; I STA="000" D .I $G(HZM) D Q:STA=999 ..I $$^W4CLOSE(HZM),'$$NOCLDLVZ^W4PRM S STA=999,MSG="PAIDED" Q ..N ITRA S ITRA=$$ITRA^W4HZMST(HZM) I 'ITRA S STA=999,MSG="PAIDED" Q . .I '$D(EMV3) S TRREC=$$GET(A,"tranRecord") .I $D(EMV3) S TRREC=$$GET(A,"settelment_record") .D REC2GL(TRREC,GL,3000) ; ;;ZWR ARR ;;ZWR ARRPC M ^LV($$DT,+$P($H,",",2),"W3EMV3",+$G(VUID),"OUT1")=OUT D DB("W3EMV3",+$G(VUID),"OUT2","OK~"_STA_"~"_$G(MSG)_"~"_$G(STOUT)_"~~"_$G(OUT("UID"))) ;;ZWR TRREC END ; Q "OK~"_STA_"~"_$G(MSG)_"~"_$G(STOUT)_"~~"_$G(OUT("UID")) ; ; TR(VL,LN) ; Q $$TR^W4STRINW(VL,LN) ; RKV(NM,VL,PRTX) ; I VL'?1N.N,$G(PRTX)'="0" S PRTX=1 N OU S OU=""""_NM_""":" I $G(PRTX) S OU=OU_"""" S OU=OU_VL I $G(PRTX) S OU=OU_"""" Q OU ; GET(A,NM) N B,P S B="" S P=""""_NM_""":" I A[P D .S B=$P(A,P,2) .S B=$$CLR(B) Q B ; CLR(B) ; S B=$P(B,",") S B=$P(B,"]") S B=$P(B,"}") I $E(B)="""" S B=$E(B,2,$L(B)-1) Q $$SPA^%L1FRM(B) ; ; GETFLD(ST,N) ; S K=0 S PSK="""fieldName"":" S PSK1="""FIELDVALUE"":" I ST[PSK D .F J=1:1:$L(ST,PSK) D ..S VL=$P(ST,PSK,J+1) ..S VL=$$FUNC^%UCASE(VL) ..; ..S VL1=$$CLR($P(VL,PSK1,1)) ..S VL1=$$U2H(VL1) ..S VL2=$$CLR($P(VL,PSK1,2)) ..S VL2=$$U2H(VL2) ..S K=K+1 ..N IND S IND=VL1 ;;$$INVH^%L1FRM(VL1) ..N CONT S CONT=VL2 ;$$INVH^%L1FRM(VL2) ..S ARRPC(N,K)=IND_":"_CONT ..I IND'="" S ARRPC1(N,IND)=CONT Q ; ; GETPC(IND,N) I $G(IND)="" Q "" Q $G(ARRPC1(N,IND)) ; ; FL2ARR(FL) ; N A,I C FL O FL:(REWIND:READONLY) S I=0 K ARR F U FL R A Q:$ZEOF D .S I=I+1,ARR(I)=A C FL Q ; ; REC2GL(REC,GL,LEN) ; ---- IF STA = "000" ; N DV S DV=$$^W4MYDVN ; I $G(VUID),$L(VUID)>8,$G(^LV($$DT,+$P($H,",",2),"W4EMV3-RES",+$G(VUID),"RES"))=0 D Q .D DB("W4EMV3-RES",+$G(VUID),"DVJB",DV_"\"_JB) ; N FLTR S FLTR=$$PATH_"tran"_$$^W4DZ_"_"_DV_"_"_JB_"_"_+$G(HZM) ; ----- !!!! ; N FLOU S FLOU=$$PATH_"tranout"_$$^W4DZ_"_"_DV_"_"_JB_"_"_+$G(HZM) ; I $$EXIST^%L1ZOS(FLTR) ZSY "rm "_FLTR I $$EXIST^%L1ZOS(FLOU) ZSY "rm "_FLOU ; O FLTR:(REWIND:NEWVERSION:WRITE) U FLTR W REC C FLTR ; D SETTL I $ZSY H 3 D SETTL I $ZSY H 3 D SETTL ; I $ZSY S STA=999,MSG="TRANERROR" ZSY "rm "_FLTR Q ; N RES,RESMSG ; S SHTROU=0 BDTROU I $$EXIST^%L1ZOS(FLOU) D .N A,A0 S (A,A0)="" .O FLOU:(REWIND:READONLY) U FLOU R A0 R:'$ZEOF A C FLOU .D DB("W4EMV3-RES",+$G(VUID),"A0",A0) .D DB("W4EMV3-RES",+$G(VUID),"A",A) .I A0["Result" S A=A0 .ZSY "rm "_FLOU .S RES=$$GET(A,"Result") .S RESMSG=$$GET(A,"ResultMessage") .S RESMSG=$$FUNC^%UCASE(RESMSG) .S RESMSG=$$U2H(RESMSG) . .D DB("W4EMV3-RES",+$G(VUID),"RES",RES) ; I RES,SHTROU<2 H 2 S SHTROU=SHTROU+1 D SETTL G BDTROU I RES S STA=RES,MSG=RESMSG Q ; I '$G(LEN) S LEN=3000 ; ------- > ^TRANL ; N NR S NR=$O(@GL@(999999),-1)+1 S @GL@(NR,"VUID")=$G(OUT("VUID")) S @GL@(NR,"UID")=$G(OUT("UID")) S @GL@(NR,"STIN")=$G(STPRM) S @GL@(NR,"STOUT")=$G(STOUT) ; N HZM S HZM=$$GETP^%W1PRM("HZM") I HZM D .N HZMIND S HZMIND=$O(@$$^W4ORD@(HZM,"CB","V",999),-1) .S @GL@(NR,"HZM")=HZM .S @GL@(NR,"HZMIND")=+HZMIND ; REC2GLC S @GL@(NR)=$E(REC,1,LEN) I $L(REC)>LEN S @GL@(NR,">")="" S NR=NR+1,REC=$E(REC,LEN+1,$L(REC)) G REC2GLC Q ; ; U2H(ST) S OU=$$CLRQ^W3SORD(ST) Q OU ; DIR(STAM) ; Q $$EMVDIR^W4PRM ; PATH(STAM) ; Q "/tmp/" ; BITOLD S STOUT="" N N S N="" F S N=$O(@GL@(N)) Q:N="" I $E(N)?1N D Q:$L(STOUT) .I $G(^(N,"UID"))=UIDBIT S STOUT=$G(@GL@(N,"STOUT")) ; S STA="000" S MSG="dlhea dwqr" S OUT("VUID")=VUID S OUT("UID")="-"_UIDBIT S $E(STOUT,1,3)="000" S $E(STOUT,61,62)=51 S $E(STOUT,63)=1 S $E(STOUT,78,85)="00000000" S $E(STOUT,86,93)="00000000" S $E(STOUT,94,95)="00" N NR S NR=$O(@GL@(999999),-1)+1 S @GL@(NR)="CANCEL" S @GL@(NR,"VUID")=$G(OUT("VUID")) S @GL@(NR,"UID")=$G(OUT("UID")) S @GL@(NR,"STIN")=$G(STPRM) S @GL@(NR,"STOUT")=$G(STOUT) Q ; YAD ; N EMV3 S EMV3="" D EMV^W4STRINW Q $$^W4EMVCON(ST,STOUT,VUID) ; DVIND ; S DV=$$^W4MYDVN S FLIND=$$^W4DZ_"_"_DV_"_"_JB_"_"_$$GETP^%W1PRM("HZM")_"_"_$TR($H,",","") Q ; GETBYVUID(VUID,ID,URL,FLIND) ; N FL S FL=$$PATH_"tmpvuid"_FLIND O FL:(NEWVERSION:WRITE) U FL W "{",! W $$RKV("jsonrpc","2.0",1)_",",! W $$RKV("method","getTransactionByVuid",1)_",",! W $$RKV("id",ID,1)_",",! W """params"":[",! W """ashrait"",{",! W $$RKV("vuid",VUID,1),! W "}]}",! C FL S FLOU=$$PATH_"tmpvuidou"_FLIND D CMD(FL,URL,FLOU) Q ; URL(DV) ; N ADR,URL S ADR=$$EMVADR^W4POSEMV(DV) I ADR="" S ADR=$$EMVADR^W4POSEMV(1) I ADR="" Q "" ; I ADR'[":" S ADR=ADR_":8080" S URL="http://"_ADR_"/SPICy" Q URL ; ; CMD(FL,URL,FLOU) ; --> ER N CMD,DZ S CMD="curl -s -k -m 60 --connect-timeout 25 -H ""Content-Type:application/json"" -d@'"_FL_"' '"_URL_"' -o "_FLOU S DZ=$$^W4DZ ;;N SH S SH=$O(^W4CMDEMV(DZ,99999999),-1)+1 ;;S ^[$$^W3MAIN]W4CMDEMV(DZ,SH)=CMD D DB("W4EMV3-CMD",+$G(VUID),"CMD",CMD) I $$EXIST^%L1ZOS(FLOU) ZSY "rm "_FLOU ZSY CMD S ER=$ZSY ;;S ^[$$^W3MAIN]W4CMDEMV(DZ,SH,"ER")=ER D DB("W4EMV3-CMD",+$G(VUID),"CMD-ER",ER) ;;ZSY "rm -f "_FL Q ; SETTL ; N CMD S CMD=$$EMVDIR^W4PRM_"SPIShell settelment --tran-uid """_$G(OUT("UID"))_""" " S CMD=CMD_" --tran-file "_FLTR_" > "_FLOU ZSY "rm "_FLOU D DB("W4EMV3-SETTL",+$G(VUID),"CMD",CMD) ZSY CMD D DB("W4EMV3-SETTL",+$G(VUID),"ZSY",$ZSY) Q ; DB(IND,VUID,RKV,VL) N H,H2 S H=$$DT ;$$^W4DZ S H2=$P($H,",",2) S ^LV(H,H2,IND,VUID,RKV)=VL Q ; DT() ; Q +$H W4EMV4 W4EMV4(PAY,SUGIS,SUGAS,MG,VIZ,DATT,P1,PN,PC,ASHTZ,ASHCVV2,AUTHNO) ; [ 24.04.25 06:17 ] [ 05.02.25 06:57 ] [ 28.01.25 04:36 ] N (JB,%ARG,PAY,SUGIS,SUGAS,MG,VIZ,DATT,P1,PN,PC,ASHTZ,ASHCVV2,AUTHNO,UIDBIT,STOUT) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; S RESMSG="" S STPRM="PAY="_$G(PAY)_"&SUGIS="_$G(SUGIS)_"&SUGAS="_$G(SUGAS)_"&MG="_$G(MG) S STPRM=STPRM_"&VIZ="_$G(VIZ)_"&DATT="_$G(DATT)_"&P1="_$G(P1)_"&PN="_$G(PN)_"&PC="_$G(PC)_"&UIDBIT="_$G(UIDBIT) S STPRM=STPRM_"&ASHTZ="_$G(ASHTZ)_"&ASHCVV2="_$G(ASHCVV2)_"&AUTHNO="_$G(AUTHNO) ; S DZ=$$^W4DZ S DV=$$^W4MYDVN S SEC=$P($H,",",2) S HZM=+$$GETP^%W1PRM("HZM") ; S VUID=DZ_"_"_DV_"_"_SEC_"_"_HZM ; S OK=0 F I=1:1:10 D Q:OK H 1 .D CMD("GETSTATUS") .S TPESTAT=$$GET("details") .S TPERES=$$GET("result") .S TPESTAT=$$FUNC^%UCASE(TPESTAT) .S TPERES=$$FUNC^%UCASE(TPERES) .;;S ^AA("W4EMV4","TPESTAT",HZM)=TPESTAT .;;S ^AA("W4EMV4","TPERES",HZM)=TPERES .I TPESTAT["ASHRAITREADY"&(TPERES["TRUE") S OK=1 ; I 'OK D G END .S MSG="SERVER IS BUSY" ; S HZD=+$$GETP^%W1PRM("HZM")_"\"_$ZD($H,"DD.MM.YY 24:60") ; D DB("W4EMV4",$G(VUID),"HZM",HZD) D DB("W4EMV4",$G(VUID),"STPRM",STPRM) ; S INDL0=$G(@$$^W4GL("TRANL")) S INDL=$O(@$$^W4GL("TRANL")@(999999),-1) S:INDL<1 INDL=1 I INDL DV,FLIND ; S TRTYPE=1 I SUGIS=51 S TRTYPE=53 ; S YYMM=$E(DATT,3,4)_$E(DATT,1,2) S PRM=VUID_";"_PAY_";"_TRTYPE_";"_+$G(PN)_";"_+$G(P1)_";"_VIZ_";"_$G(YYMM)_";"_$G(ASHCVV2)_";"_$G(ASHTZ)_";"_$G(AUTHNO) ; D .Q:'$G(VUID) Q:'$G(PAY) .N IND S IND=$O(@$$^W4ORD@(HZM,"CB","V",999),-1)+1 .K @$$^W4ORD@(HZM,"EMVP",IND) .S @$$^W4ORD@(HZM,"EMVP",IND,"STIN")=STPRM .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","VUID")=VUID .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","DV")=$$^W4MYDVN .S @$$^W4ORD@(HZM,"EMVP",IND,"OUT","AMOUNT")=PAY ; I $L($G(VIZ))>6 S FUNC="TRANCNP" E S FUNC="TRAN" G DOCMD1 DOCMD(FUNC,PRM,HZM) DOCMD1 D CMD(FUNC,PRM,HZM) ; N ST1,ST2 ; S OUT("STA")=$$GET("result_code") I OUT("STA")="" S OUT("STA")=$$GET("CODE") S STA=OUT("STA") ; N RESMSG S RESMSG=$$GET("result_msg") I RESMSG=""!(RESMSG="-") S RESMSG=$$GET("message") I RESMSG=""!(RESMSG="-") S RESMSG="ERROR "_STA S OUT("RESMSG")=RESMSG ; S OUT("AUTHNO")=$$GET("issuer_auth_num") I OUT("AUTHNO")'?.P D .S (STA,OUT("STA"))="000" ; --5/02/25 .S RESMSG="DONE_OK" ; S OUT("SOLEK")=$$GET("ACQUIRER") S OUT("SAPAK")=$$GET("auth_code_manpik") ; S OUT("MUTAG")=$$GET("brand") S OUT("MANPIK")=$$GET("issuer") ; S OUT("VIZ")=$$GET("card_number") I OUT("VIZ")["*" S OUT("VIZ")=$TR(OUT("VIZ"),"*",".") ; S OUT("VUID")=$$GET("trans_POS_id") S OUT("MASOF")=$$GET("acquirer_merchantID") S OUT("AMOUNT")=$$GET("amount") S (UID,OUT("UID"))=$$GET("trans_TPE_id") S (NMCARD,OUT("NMCARD"))=$$GETKEY("qihxk") ; ; TV1 ; M ^LV($$DT,$P($H,",",2),"W4EMV4",$G(VUID),"OUT")=OUT N GLPR D GLPR^W4EMVN N SHPR S SHPR=$O(@GLPR@(DZ,99999),-1)+1 M @GLPR@($$DT,SHPR,$G(VUID),"OUT")=OUT ; ; I $G(OUT("STA"))?."-"1N.N D .S $E(STOUT,1,3)=$$DOP^%L1FRM($G(OUT("STA")),3) ; D DB("W4EMV4",$G(VUID),"STOUT0",$G(STOUT)) I '$G(UIDBIT) D .S $E(STOUT,24)=$S($E($G(OUT("MUTAG")))?1N:$E($G(OUT("MUTAG"))),1:" ") .S $E(STOUT,60)=$S($E($G(OUT("MANPIK")))?1N:$E($G(OUT("MANPIK"))),1:" ") .S $E(STOUT,25)=$S($E($G(OUT("SOLEK"))):$E($G(OUT("SOLEK"))),1:" ") ; I $G(OUT("VIZ")) D .S $E(STOUT,5,23)=$$TR($G(OUT("VIZ")),19) S $E(STOUT,71,77)=$$TR($G(OUT("AUTHNO")),7) S $E(STOUT,104,118)=$$HBR^%L1FRM($G(OUT("NMCARD")),15) ; D DB("W4EMV4",$G(VUID),"STOUT",STOUT) S STA=$E(STOUT,1,3) S MSG=$G(OUT("RESMSG")) ; I HZM,'$$^W4CLOSE(HZM),'$G(UIDBIT) D .S LAST=$O(@$$^W4ORD@(HZM,"CB","V",999),-1)+1 .M @$$^W4ORD@(HZM,"EMV",LAST)=ARRPC .S @$$^W4ORD@(HZM,"EMV",LAST,"STOUT")=STOUT .S @$$^W4ORD@(HZM,"EMV",LAST,"STIN")=STPRM .M @$$^W4ORD@(HZM,"EMV",LAST,"OUT")=OUT ; I $$^W4AUTHCD(STA) D .S MSG=$TR($G(OUT("SAPAKTEL"))_"^"_$G(OUT("SAPAK")),"""","") ; I STA="000" D .I $G(HZM) D Q:STA=999 ..I $$^W4CLOSE(HZM) S STA=999,MSG="PAIDED" Q ..N ITRA S ITRA=$$ITRA^W4HZMST(HZM) I 'ITRA S STA=999,MSG="PAIDED" Q ; M ^LV($$DT,+$P($H,",",2),"W4EMV4",$G(VUID),"OUT1")=OUT END ; I $G(STA)?.P S STA="-998" N ANS S ANS="OK~"_STA_"~"_$G(MSG)_"~"_$G(STOUT)_"~~"_$G(OUT("UID"))_"~"_$G(OUT("VUID")) D DB("W4EMV4",$G(VUID),"OUT-ANS",ANS) Q ANS ; ; TR(VL,LN) ; S VL=$E(VL,1,LN) S VL=$TR($J(VL,LN)," ",0) Q VL ; RKV(NM,VL,PRTX) ; I VL'?1N.N,$G(PRTX)'="0" S PRTX=1 N OU S OU=""""_NM_""":" I $G(PRTX) S OU=OU_"""" S OU=OU_VL I $G(PRTX) S OU=OU_"""" Q OU ; GET(NM) N OK S OK=0 N TMPRSP S TMPRSP=$$TMPRSP^W4EMVN N VL S VL="" N I,A S I=0 F S I=$O(@TMPRSP@(I)) Q:I="" I I D Q:OK .S A=$G(^(I)) .I A[(""""_NM_""":") S VL=$P(A,(""""_NM_""":"),2),OK=1 I OK Q $$CLR(VL) Q "-" ; GETKEY(NM) N OK S OK=0 N TMPRSP S TMPRSP=$$TMPRSP^W4EMVN N VL S VL="" N I,A S I=0 F S I=$O(@TMPRSP@(I)) Q:I="" I I D Q:OK .S A=$G(^(I)) .I A[("""key"":"""_NM_"""") D ..N B S B=$G(@TMPRSP@(I+1)) I B'["""value""" Q ..S VL=$P(B,"""value"":",2),OK=1 I OK Q $$CLR(VL) Q "-" ; CLR(B) ; S B=$P(B,",") S B=$$SPA^%L1FRM(B) S B=$P(B,"]") S B=$P(B,"}") I $E(B)="[" S B=$E(B,2,$L(B)) I $E(B)="{" S B=$E(B,2,$L(B)) I $E(B)="""" S B=$E(B,2,$L(B)-1) Q $$SPA^%L1FRM(B) ; ; DIR(STAM) ; Q $$EMVDIR^W4PRM ; PATH(STAM) ; Q "/tmp/" ; DVIND ; S DV=$$^W4MYDVN S FLIND=DZ_"_"_DV_"_"_JB_"_"_HZM_"_"_$TR($H,",","") Q ; CMD(FUNC,PRM,HZM) ; D ^W4EMVN(FUNC,$G(PRM),$G(HZM)) Q ; DB(IND,VUID,RKV,VL) S:$G(VUID)="" VUID=0 N H,H2 S H=$$DT ;$$^W4DZ S H2=$P($H,",",2) S ^LV(H,H2,IND,VUID,RKV)=VL N GLPR S GLPR=$$^W4GL("W4EMVNPR") N SH S SH=$O(@GLPR@($$^W4DZ,99999),-1)+1 S @GLPR@($$^W4DZ,SH,VUID,"W4EMV4",RKV)=VL Q ; DT() ; Q +$H W4EMVASH W4EMVASH(JB) ; [ 12.05.23 15:03 ] [ 26.03.22 20:57 ] [ 25.03.22 14:15 ] N (JB,%ARG,%REM) ; ------------------ EMV DEVICE UPDATE N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S DV=$$^W4MYDVN S DT=$$^W4DZ ; S FLIND=DV_"_"_JB_"_"_DT ; S FL=$$PATH_"tmpash"_FLIND ; S IDASH=$O(@$$^W4GL("TRANL")@(999999),-1) I IDASH<1 S IDASH=1 ; O FL:(NEWVERSION:REWIND) U FL W "{",! W """jsonrpc"": ""2.0"",",! W """method"": ""doPeriodic""," W """params"": [",! W """ashrait"",",! W "{}",! W "],",! W """id"": """_IDASH_""" ",! W "}",! C FL ; S GLEMV=$$^W4GL("W4POSEMV") K M S N="" F S N=$O(@GLEMV@(N)) Q:N="" D .S A=$G(^(N)) .S ADR=$P(A,"\",2) Q:'ADR .S M(ADR)="" ; S ADR="" F S ADR=$O(M(ADR)) Q:ADR="" D SEND2EMV(ADR) ; Q ; ; SEND2EMV(ADR) ; I ADR'[":" S ADR=ADR_":8080" S URL="http://"_ADR_"/SPICy" S FLOU=$$PATH_"tmpashou"_FLIND S CMD="curl -s -k -H ""Content-Type:application/json"" -d@"_FL_" "_URL_" -o "_FLOU S DZ=$$^W4DZ S ^[$$^W3MAIN]W4CMDEMV(DZ,$O(^W3CMDEMV(DZ,99999999),-1)+1)=CMD ZSY CMD S ER=$ZSY Q ; ; PATH(STAM) ; Q "/tmp/" W4EMVCON W4EMVCON(ST,STOUT,VUID) ; [ 29.08.23 17:57 ] [ 23.08.23 16:18 ] [ 22.08.23 11:11 ] N (JB,%ARG,%REM,ST,STOUT,OUT,EMV3,VUID,UIDBIT) D ^%L1TS ; ZSY ST ; --- CURL ; N H,H2 S H=+$H,H2=$P($H,",",2) ; D DB(H,H2) ; I $ZSY Q "ERROR ZSY="_$ZSY ; S FILE=$$FLOU S GL=$$^W4MAIN("TMP") K @GL ; S RES=$$^%L1JSON(FILE,GL,"V") ; -- =1 ; G TV1 TV() ; TV1 ; M ^TMP1=^TMP ; *** ; S TMPEMV=$$^W4MAIN("TMPEMV") K @TMPEMV K OUT ; S HD="" S N2="" F S N2=$O(@GL@(0,N2)) Q:N2="" D .N TX,VL,A .S A=$G(^(N2)) .S TX=$$FUNC^%UCASE($$SPA^%L1FRM($P(A,":"))) .S VL=$$FUNC^%UCASE($$SPA^%L1FRM($P(A,":",2,20))) .S TX=$$CLRQ^W3SORD(TX) .S VL=$$CLRQ^W3SORD(VL) .S HD=HD_TX_":"_VL_"," ; S @TMPEMV=$E(HD,1,$L(HD)-1) ; S N1="" F S N1=$O(@GL@(N1)) Q:N1="" D .S N2="" F S N2=$O(@GL@(N1,N2)) Q:N2="" D ..S A=$G(^(N2)) ..D PARSE(N1,N2,A) ; M ^LV(H,H2,"EMVCON","OUT")=OUT ; S HZM=$$GETP^%W1PRM("HZM") ; ;;M ^TMPEMV1=^TMPEMV ; *** ; I HZM,'$$^W4CLOSE(HZM) D .N LAST S LAST=$O(@$$^W4ORD@(HZM,"CB","V",999),-1)+1 .M @$$^W4ORD@(HZM,"EMV",LAST)=@TMPEMV ; ; I $G(OUT("STA"))?."-"1N.N D .S $E(STOUT,1,3)=$$TR($G(OUT("STA")),3) ; I '$G(UIDBIT) D .S $E(STOUT,24)=$S($E($G(OUT("MUTAG")))?1N:$E($G(OUT("MUTAG"))),1:" ") .S $E(STOUT,60)=$S($E($G(OUT("MANPIK")))?1N:$E($G(OUT("MANPIK"))),1:" ") .S $E(STOUT,25)=$S($E($G(OUT("SOLEK"))):$E($G(OUT("SOLEK"))),1:" ") ; I $G(OUT("VIZ")) D .S $E(STOUT,5,23)=$$TR($G(OUT("VIZ")),19) I $L($G(OUT("AUTHNO"))) S $E(STOUT,71,77)=$$TR($G(OUT("AUTHNO")),7) I $L($G(OUT("NMCARD"))) S $E(STOUT,104,118)=$$HBR^%L1FRM($G(OUT("NMCARD")),15) ; D DB1(H,H2,"EMVCON","STOUT",STOUT) ; K @GL S STA=$E(STOUT,1,3) S MSG=$G(OUT("RESMSG")) ; I $$^W4AUTHCD(STA) D .S MSG=$TR($G(OUT("SAPAKTEL"))_"^"_$G(OUT("SAPAK")),"""","") ; I STA="000",$G(OUT("UID")),$D(@$$^W4GL("W4EMVUID")@(OUT("UID"))),'$G(UIDBIT) S STA=990,MSG="PAIDED" ; I STA="000",$D(EMV3) D .N ARR,FLOU .S FLOU=$$FLOU .D FL2ARR^W4EMV3(FLOU) .N I,A,TRREC S A="" .F I=1:1 Q:'$D(ARR(I)) S A=A_ARR(I) .S TRREC=$$GET^W4EMV3(A,"settelment_record") .D REC2GL^W4EMV3(TRREC,GL,3000) ; S ^LV(H,H2,"EMVCON","MSG")=$G(MSG) D DB1(H,H2,"EMVCON","MSG",$G(MSG)) Q "OK~"_STA_"~"_MSG_"~"_STOUT_"~~"_$G(OUT("UID"))_"~"_$G(VUID) ; ; TR(VL,LN) ; Q $$TR^W4STRINW(VL,LN) ; DIROU(STAM) ; Q $G(@$$^W4PRM@("ASH","PATHTRAN")) ; ; PARSE(N1,N2,A) ; N TX,VL S TX=$$FUNC^%UCASE($$SPA^%L1FRM($P(A,":"))) S VL=$$FUNC^%UCASE($$SPA^%L1FRM($P(A,":",2,20))) S TX=$$CLRQ^W3SORD(TX) S VL=$$CLRQ^W3SORD(VL) ; I N1=0 D Q .I TX="RESULT" S OUT("STA")=VL .I TX="RESULTMESSAGE" S OUT("RESMSG")=VL .I TX="SOLEK_NAME" S OUT("SOLEKNAME")=VL .I TX="SOLEK_PHONE" S OUT("SOLEKPHONE")=VL ; I N1=1 D .I TX="xtqn" S OUT("VIZ")=VL .I TX="witpn xeyi`" S OUT("AUTHNO")=VL .I TX="seqn 'qn" S OUT("MASOF")=VL .I TX="qihxk" S OUT("NMCARD")=$$INVH^%L1FRM(VL),VL=OUT("NMCARD") ; I N1=3!(N1=2) D .I TX="UID" S OUT("UID")=VL .I TX="VUID" S OUT("VUID")=VL .I TX="SOLEK" S OUT("SOLEK")=VL .I TX="SOLEK_COMP_NUMBER" S OUT("SAPAK")=VL .I TX="SOLEK_PHONE" S OUT("SAPAKTEL")=VL .I TX="ISSUER_AUTH_NUM" S OUT("AUTHNO")=VL .I TX="MUTAG" S OUT("MUTAG")=VL .I TX="MANPIK" S OUT("MANPIK")=VL ; S @TMPEMV@(N1,N2)=TX_":"_VL Q ; FLOU(STAM) ; N FLOU S FLOU=$P(ST,"--output-file=",2) S FLOU=$P(FLOU," 2>") Q FLOU ; DB(H,H2) ; I $$GETP^%W1PRM("HZM") D .N VL S VL=$$GETP^%W1PRM("HZM")_"\"_$ZD($H,"DD.MM.YY 24:60") .D DB1(H,H2,"EMVCON","HZM",VL) D DB1(H,H2,"EMVCON","I_ST",ST) D DB1(H,H2,"EMVCON","I_ST-ZSY",$ZSY) D DB1(H,H2,"EMVCON","STOUT0",$G(STOUT)) D DB1(H,H2,"EMVCON","VUID",$G(VUID)) Q ; DB1(H,H2,IND,RKV,VL) S ^LV(H,H2,IND,RKV)=$G(VL) Q W4EMVN W4EMVN(FUNC,PARAM,HZM) ; [ 27.04.25 16:30 ] [ 24.04.25 07:43 ] [ 05.02.25 07:06 ] N (JB,%ARG,FUNC,PARAM,HZM) ; ;;S ^AA("W4EMVN","FUNC")=FUNC ;;S ^AA("W4EMVN","PARAM")=$G(PARAM) ;;S ^AA("W4EMVN","HZM")=$G(HZM) ; D KILL^%W1PRM("EMVNER") D INIT($G(PARAM)) ; D GLPR N SH S SH=$O(@GLPR@(DZ,99999),-1)+1 ; S @GLPR@(DZ,SH)="W4EMVN\---------------- "_$ZD($H,"DD.MM.YY 24:60")_"\"_$G(FUNC)_"\"_$G(PARAM)_"\"_$G(HZM) ; S TMPRSP=$$TMPRSP K @TMPRSP ; I FUNC="GETTOKEN" D GETTOKEN G END ; S TKTIME=$$TOKENTIME ; I 'TKTIME!($$DIF^%L1TIME($H,TKTIME)>(23*60)) D GETTOKEN ; S TOKEN=$$TOKEN ; I $L(TOKEN)<10 D G END .S @TMPRSP@(1)="{""result_code"": ""NOTTOKEN"";""result_msg"": ""TOKEN NOT EXIST""}" ; I $G(CLIENTID)="" D G END .S @TMPRSP@(1)="{""result_code"": ""NOBRIDGEID"";""result_msg"": ""BRIDGEID NOT DEFINED""}" ; O FILEPRM:(WRITE:NEWVERSION) U FILEPRM D PRM(FUNC) C FILEPRM ; O FILEDATA:(WRITE:NEWVERSION) U FILEDATA D DATA(FUNC,$G(PARAM)) C FILEDATA ; S TMPRSP=$$TMPRSP K @TMPRSP I $$EXIST^%L1ZOS(FILEOU) ZSY "rm "_FILEOU S CMD="curl -m 90 -s -K '"_FILEPRM_"' --location '"_($$URL_CLIENTID)_"' -d @'"_FILEDATA_"' -o '"_FILEOU_"'" ZSY CMD ; S ER=$ZSY ; D SETNP(DV) ; D PROT(CMD,ER) I ER D G END .S @TMPRSP@(1)="{""result_code"": "_-ER_"";""result_msg"": ""$ZSY="_ER_"""}" ; D READRESP(FILEOU) END I $G(ER) D PUT^%W1PRM("EMVNER",ER) Q ; ; INIT(PARAM) ; S VUID=$P(PARAM,";") S DZ=$P(VUID,"_") I DZ="" S DZ=$$^W4DZ S DV=$P(VUID,"_",2) I DV="" S DV=$$^W4MYDVN S SEC=$P(VUID,"_",3) S HZM=$P(VUID,"_",4) ; D FLNM ; S GROUPID="Damka" S CLIENTID=$$EMVID(DV) ; S FILEPRM=FLNM_".prm" S FILEOU=FLNM_".out" S FILEDATA=FLNM_".data" ; C FILEPRM:(DELETE) C FILEDATA:(DELETE) C FILEOU:(DELETE) Q ; ; EMVID(DV) ; N ST S ST=$G(@$$^W4GL("W4POSEMV")@(DV)) ;;Q "2290251608__1409108" ; *** 03/07/24 Q $P(ST,"\",4) ; FLNM ; S FLNM="/tmp/tmpemvn"_VUID Q ; PROT(CMD,ER) ; N GLPR D GLPR N SH S SH=$O(@GLPR@(DZ,99999),-1)+1 S @GLPR@(DZ,SH)=CMD S @GLPR@(DZ,SH,"ZSY")=ER_"\"_$ZD($H,"DD.MM.YY 24:60")_"\"_$G(HZM) Q ; ; PRM(FUNC) ; D WRITEPRM("POST") Q ; ; DATA(FUNC,PARAM) I FUNC="GETSTATUS" D GETSTATUS I FUNC="RESETSTATE" D RESETSTATE I FUNC="TRAN" D TRAN(PARAM,0) I FUNC="TRANCNP" D TRAN(PARAM,1) I FUNC="RESTORE" D RESTORE(PARAM) I FUNC="REFUND" D REFUND(PARAM) I FUNC="GETPARAMS" D GETPARAMS I FUNC="SEND" D SEND I FUNC="EMVCIB" D EMVCIB(PARAM) I FUNC="EMVTNB" D EMVCIB(PARAM) I FUNC="DISPQR" D DISPQR(PARAM) I FUNC="RESTQR" D RESTQR(PARAM) Q ; ;-------------------------------- FUNCTIONS ------------------------ ; GETSTATUS ; W "{",! D NID("GETSTATUS") W """method"": ""Get_Status"" " W "}",! Q ; ; RESETSTATE ; W "{",! D NID("RESETSTATE") W """method"": ""Reset_State"" " W "}",! Q ; ; TRAN(PARAM,CNP) ; N POSID,SUM,TRTYPE N DBL,DBLPER,WAITCRD ; S DBL=+$G(@$$^W4PRM@("EMVN","CHKDBL")) S DBLPER=+$G(@$$^W4PRM@("EMVN","DBLPER")) S WAITCARD=+$G(@$$^W4PRM@("EMVN","WAITCARD"),60) ; ;;S PARAM=$$^W4DZ_"_"_$$^W4MYDVN_"_"_$P($H,",",2)_"_"_+$G(HZM) ; *** ;;S PARAM=PARAM_";500;1;1;0;5326105300985846;2604;658;307376384" ;*** ;;S PARAM=PARAM_";500;1;1;0;4580160014629200;1;2701;872;307376384" D PRS^%L1FRM(PARAM,"VUID;SUM;TRTYPE;PN;P1;CARD;YYMM;CVV;TZ",";") S POSID=DV ; D RKV1("{") I '$G(CNP) D .D RKV("method","Perform_Transaction",1) I $G(CNP) D .D RKV("method","Perform_CNP_Transaction",1) ; D NID("TRAN") ; D RKV("details","{",0,1) D RKV("trans_POS_id",VUID,1) D RKV("pos_id",POSID,1) D RKV("amount",+SUM) D RKV("currency_code",376) D RKV("emv_trans_type",+TRTYPE) D RKV("conversion_rate","1.0") D RKV("credit_terms",1) D RKV("num_payments",+PN) D RKV("first_payment",+P1) D RKV("payments_link",0) ; I $G(CNP) D .S CNPTRTYPE=2 .I $G(HZM),$$HZM^W4MSD(HZM) S CRNTRTYPE=1 .D RKV("CNP_transaction_type",CNPTRTYPE) .D RKV("card_number",CARD,1) .D RKV("expiration_date_yymm",YYMM,1) .D RKV("cvv",CVV,1) .D RKV("id_num",TZ,1) ; D RKV("is_preapproved","false") D RKV("authorization","",1) D RKV("additional_info",HZM,1) ; S DBL=$S(DBL:"true",1:"false") D RKV("check_double_trans",DBL) D RKV("double_trans_check_period_sec",+DBLPER,0,$S($G(CNP):1,1:0)) I '$G(CNP) D .D RKV("card_reading_timeout_sec",+WAITCARD,0,1) ; -- 27/10/24 -> CMNT D RKV1("}") D RKV1("}") Q ; ; REFUND(PARAM) ; ; D PRS^%L1FRM(PARAM,"VUID;TRPOSID;POSID",";") ; D RKV1("{") D NID("REFUND") D RKV("method","Cancel_Transaction",1) D RKV("details","{",0,1) D RKV("trans_POS_id",TRPOSID,1) D RKV("pos_id",POSID,1,1) D RKV1("}") D RKV1("}") Q ; ; RESTORE(TRPOSID) ; ;;D PRS^%L1FRM(PARAM,"VUID;TRPOSID;POSID",";") ; D RKV1("{") D NID("RESTORE") D RKV("method","Get_POS_Trans_Details",1) D RKV("details","{",0,1) D RKV("trans_POS_id",TRPOSID,1,1) D RKV1("}") D RKV1("}") Q ; GETPARAMS ; N DV S DV=$$^W4MYDVN D RKV1("{") D NID("GETPARAMS") D RKV("method","Get_TPE_Params",1,1) D RKV1("}") Q ; ; SEND ; D RKV1("{") D NID("SEND") D RKV("method","Perform_Periodic_Update",1,1) D RKV1("}") Q ; ; EMVCIB(PARAM) ; S VUID=PARAM ; D RKV1("{") D NID("EMVCIB") D RKV("method","Read_MSR_Card",1) D RKV("details","{",0,1) D RKV("message","Pass Card",1,0) D RKV("timeout_sec",30,0,1) D RKV1("}") D RKV1("}") Q ; ; DISPQR(PARAM) ; N URL,IMG S IMG=$P(PARAM,";")_".img" S URL=$P(PARAM,";",2) ; D RKV1("{") D NID("DISPQR") D RKV("method","Display_QR_Code",1) D RKV("details","{",0,1) D RKV("img_file_name",IMG,1) D RKV("hyperlink",URL,1) D RKV("timeout_sec",60,0,1) D RKV1("}") D RKV1("}") Q ; ; RESTQR(PARAM) ; N URL,IMG ; D RKV1("{") D NID("DISPQR") D RKV("method","Reset_State",1,1) D RKV1("}") Q ; ; GETTOKEN ; N FUNC S FUNC="GETTOKEN" D INIT($G(PARAM)) K @$$^W4GL("W4EMVN")@(DV,"TOKEN") S TOKEN="" ZSY "rm "_FILEOU S CMD=$$WEBL^W3MAIN_"w4token.sh > "_FILEOU ; ZSY CMD ; S ER=$ZSY D PROT(CMD,ER) I ER U 0 W "ERROR "_$ZSY,! Q ; D READRESP(FILEOU,1) ; N A,I ; F I=1:1 Q:'$D(@TMPRSP@(I)) S A=$G(^(I)) D .I A["token" S TOKEN=$$SPA^%L1FRM($P(A,":",2,250)) ; I 'ER D .I $E(TOKEN,$L(TOKEN))="," S TOKEN=$E(TOKEN,1,$L(TOKEN)-1) .I $E(TOKEN)="""" S TOKEN=$E(TOKEN,2,$L(TOKEN)) .I $E(TOKEN,$L(TOKEN))="""" S TOKEN=$E(TOKEN,1,$L(TOKEN)-1) .; .S @$$^W4GL("W4EMVN")@(DV,"TOKEN")=TOKEN .S @$$^W4GL("W4EMVN")@(DV,"TOKEN","TIME")=$H Q ; ; WRITEPRM(MTD) I $G(MTD)="" S MTD="POST" W "-X "_MTD,! I $G(TOKEN)'="" W "-H ""Authorization: Bearer "_TOKEN_""" ",! W "-H ""Content-Type: application/json"" ",! ;;W "--location ""https://bridge.kupot.co.il/api/bridge/Damka/"_CLIENTID_""" " Q ; RKV(NM,VL,STR,NOZPT) ; N ST S ST=""""_NM_""":" I $G(STR) S ST=ST_"""" S ST=ST_VL I $G(STR) S ST=ST_"""" I '$G(NOZPT) S ST=ST_"," W ST,! ; D PROTRKV(ST) Q ; ; RKV1(VL) N ST S ST=VL W ST,! D PROTRKV(ST) Q ; ; PROTRKV(ST) ; N GLPR D GLPR N SH S SH=+$O(@GLPR@(DZ,99999),-1) N SH1 S SH1=$O(@GLPR@(DZ,SH,"CONT",99999),-1)+1 S @GLPR@(DZ,SH,"CONT",SH1)=ST Q ; ; READRESP(FILEOU,NOUPR) ; S TMPRSP=$$TMPRSP K @TMPRSP ; I '$$EXIST^%L1ZOS(FILEOU) Q N FILEDOS S FILEDOS=FILEOU ;;S FILEDOS=$P(FILEOU,".out")_".dos" ;;ZSY "iconv -f utf-8 -t cp862 "_FILEOU_" -o "_FILEDOS C FILEDOS O FILEDOS:(REWIND:READONLY) N GLPR D GLPR N SH S SH=$O(@GLPR@(DZ,99999),-1)+1 N SH1 S SH1=0 N DV S DV=$$^W4MYDVN ; S K0=0 F U FILEDOS R A Q:$ZEOF D .S K0=K0+1,^AA("W4EMVN-REP",K0,"A")=$E(A,1,1800) .N K F K=1:1:$L(A,",") D ..S SH1=SH1+1 ..N ST,ST1 S ST=$$SPA^%L1FRM($P(A,",",K)) ..I $G(FUNC)="GETTOKEN",ST["""token""" S ST1=ST ..E S ST1=$P(ST,":")_":"_$$U2H^%L1CNV($P(ST,":",2,250)) ..S @TMPRSP@(SH1)=ST1 ..S @GLPR@(DZ,SH,"RESP",DV,+$G(HZM),SH1)=ST1 ; C FILEDOS Q ; ; TMPRSP() Q $$^W4MAIN("TMPRSP") ; TOKEN() ; Q $G(@$$^W4GL("W4EMVN")@(DV,"TOKEN")) ; TOKENTIME() ; Q $G(@$$^W4GL("W4EMVN")@(DV,"TOKEN","TIME")) ; NP(DV) ; Q DZ_"_"_DV_"_"_SEC_"_"_+$G(HZM) ; SETNP(DV) S @$$^W4GL("W4EMVN")@(DV,"NP")=$$NP(DV) Q ; NID(FUNC) ; N NP S NP=$$NP(DV) N NID S NID=(DV*1000)+NP D RKV("id",NID,1) Q ; URL() Q "https://bridge.kupot.co.il/api/bridge/Damka/" ; GLPR ; S GLPR=$$^W4GL("W4EMVNPR") Q W4EMVNPR W4EMVNPR(DAT,ORDPR) ; [ 16.04.24 13:18 ] [ 19.10.23 12:33 ] [ 07.09.23 14:05 ] N (JB,%ARG,DAT,ORDPR) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; I $G(%ARG("SHOW"))=0 Q I $G(JB)="" W "JB NOT DEFINED !" Q I $G(DAT)="" S DAT=+$H S DT=$$^%L1DC(DAT,3) ; W "
    ",! W "

    ",! W $$^%W1DICT("EMVNPR",$ZD(DT,"DD.MM.YY")) W "

    ",! S GL=$$^W4GL("W4EMVNPR") S GL0=GL_"("_DT ; S PRVW=0 I '$G(ORDPR) S PRVW=1 S N=GL0_")" F S N=$Q(@N) Q:N="" Q:N'[GL0 D .S IND=N I IND["|" S IND=$P(IND,"|",3) .S ST=$G(@N) . .I ST["\----------" D ..I $G(ORDPR) S PRVW=($P(ST,"\",5)=ORDPR) ..S ST=$P(ST,"\",1,2)_"\"_$P(ST,"\",3)_""_"\"_$P(ST,"\",4,20) ..I $P(ST,"\",5) S ST=$P(ST,"\",1,4)_" "_$$^%W1DICT("ORDER")_" : "_$P(ST,"\",5)_"" ..I PRVW W "
    ",! . .Q:'PRVW . .I ST?1"{""key"":".E!(ST?1"""value"":".E)!(ST?1"""report"":".E)!(ST?1"""result_msg"":".E) D .. S ST=$P(ST,":")_":"_$$H2U^%L1FRM($P(ST,":",2,200)) .I IND["""STOUT" D ;!(IND["""OUT-ANS""") D ..S ST=$$H2U^%L1FRM(ST) .W IND," = ",ST,"
    ",! W "
    ",! Q W4ESEK W4ESEK ; [ 27.07.16 12:53 ] [ 15.06.10 15:52 ] [ 17.12.09 12:24 ] GET ; S NAME=$$H2U^%L1FRM($G(@$$^W4PL@("ESEK",1))) S KTOV=$$H2U^%L1FRM($G(@$$^W4PL@("ESEK",2))) S TEL=$G(@$$^W4PL@("ESEK",3)) S MURSH=$G(@$$^W4PL@("ESEK",4)) S SNIF=$G(@$$^W4PL@("SNIF")) S LOGO=$G(@$$^W4PL@("LOGO")) Q SAVE(PARAM) ; N (JB,%ARG,%REM,PARAM) D PUT^%W3DEB("W4ESEK-SAVE","PARAM=PARAM") F II=1:1:$L(PARAM,";") D .N COUP S COUP=$P(PARAM,";",II) .N A,B S A=$P(COUP,"="),B=$P(COUP,"=",2) .Q:$E(A)'?1A S @A=$$CNWEB^%L1FRM(B) ; K @$$^W4PL@("ESEK") S @$$^W4PL@("ESEK",1)=$$INVH^%L1FRM($G(NAME)) S @$$^W4PL@("ESEK",2)=$$INVH^%L1FRM($G(KTOV)) S @$$^W4PL@("ESEK",3)=$G(TEL) S @$$^W4PL@("ESEK",4)=$G(MURSH) S @$$^W4PL@("SNIF")=$G(SNIF) S @$$^W4PL@("LOGO")=$G(LOGO) I $$^%L1MRK S @$$^W4GL("MRKZ")@($$^%L1MRK)=@$$^W4PL@("ESEK",1) Q 1 W4ETHB2 W4ETHB2(JB,DT1,DT2) ; [ 17.10.22 21:59 ] [ 29.05.22 07:38 ] [ 05.05.22 08:02 ] N (JB,%ARG,DT1,DT2) ; D LKH^W4REST ; N DZ S DZ=$$^W4DZ F DT=DT1:1:DT2 D .S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" D ..I DT'>DZ,$D(@$$^W4ORD@(HZ,"CB","ASR")),'$D(@$$^W4ORD@(HZ,"ETHB2")) D ...S N="" F S N=$O(@$$^W4ORD@(HZ,"CB","ASR",N)) Q:N="" I N D ....S ST=$G(^(N)) ....S MSP="-"_HZ_"."_N ....S LKHN=$P(ST,"*") I 'LKHN Q ....S ASR=$P(ST,"*",4) I 'ASR Q ....S TLUSH=$P(ST,"*",8) ....S KMTL=$P(ST,"*",9) ....D SETHB2(DT,HZ,N,MSP,LKHN,ASR,TLUSH,KMTL) ; F DT=DZ:1:DZ+120 D TKDAT(DT) TKLINK ; S DZ=$$^W4DZ F DT=DZ-50:1:DZ+30 D TKLINKD(DT) Q ; ; TKDAT(DT) ; I DT<$$^W4DZ Q N HZ,TRH,DTHZ S HZ="" F S HZ=$O(@$$^W4REF@(DT,HZ)) Q:HZ="" D .I '$$HZM^W4MSL(HZ) Q .;;I $$SHUL^W4HZMST(HZ)>1!($$SHULA^W4HZMST(HZ)>1) Q .I $$SHUL^W4HZMST(HZ)!$$SHULA^W4HZMST(HZ),'$$ITRA^W4HZMST(HZ) Q .I $$^W4CLOSE(HZ)!$$DLV^W4CLOSE(HZ) Q .S TRH=$$TRH^W4HZMST(HZ) .S DTHZ=$$^%L1DC(TRH,3) .I DTHZ=(DT+1),$$^W4SHAAZ,$$SHAA^W4HZMST(HZ)<$$SHAAZ^W4PRM S DTHZ=DTHZ-1 . .I DTHZ>DT D ..D ^W4MVP1H(DT,DTHZ,HZ) ..D PUT^W4HZMST(HZ,"DATK",$ZD(DTHZ,"DD.MM.YY")) ..S @$$^W4GL("W4LINKD")@(DTHZ,HZ)=$G(@$$^W4GL("W4LINKD")@(DT,HZ)) ..K @$$^W4GL("W4LINKD")@(DT,HZ) Q ; ; TKLINKD(DT) ; N MSD S MSD=$$GETP^%W1PRM("MSD") N DZ S DZ=$$^W4DZ I DTDZ,DTHZ'=DT D ..S @$$^W4GL("W4LINKD")@(DTHZ,HZ)=$G(@$$^W4GL("W4LINKD")@(DT,HZ)) ..K @$$^W4GL("W4LINKD")@(DT,HZ) Q ; ; SETHB2(DT,HZM,MSAS,MSP,LKHN,ASR,TLUSH,KMTL) S @$$^W4ORD@(HZM,"ETHB2")=$G(@$$^W4ORD@(HZM,"ETHB2"))_MSP_"," S $P(@$$^W4ORD@(HZM,"CB","ASR",MSAS),"*",10)=MSP D .S @$$^W4GL("P1HB2")@(MSP)=HZM_"\"_DT_"\"_$H_"\"_LKHN_"\"_ASR_"\"_$G(@$$^W4GL("P1EZL")@(LKHN))_"\"_$G(TLUSH)_"\"_$G(KMTL) .S @$$^W4GL("P1HB2I")@(DT,MSP)=$H Q W4EX W4EX(RKV,PR) ; [ 31.10.19 16:19 ] [ 31.01.17 14:24 ] [ 11.12.16 15:56 ] I '$D(TS0)!'$D(TS1) D ^%L1TS I '$D(FLCSV) Q ;;N $ZT S $ZT="G ER^W4EX" N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ER^W4EX" N VL S VL=RKV ; U FLCSV N LNG S LNG=$$^%W1LNG I $E(LNG)'?1U S LNG="H" I $G(PR)="DICT" D .S VL=$$INVH^%L1FRM($$TV^%W1DICT(LNG,RKV)) .S VL=$TR(VL,TS0,TS1) I $G(PR)="H" S VL=$TR($$INVH^%L1FRM(VL),TS0,TS1) I $G(PR)="N" D .S VL=$J(VL,2,2) I $G(PR)="D" S VL=$TR(VL,".","/") W VL,"," U 0 END ; Q ; WEXR ; U FLCSV W ! U 0 Q ; OPCSV(COD) ; N $ZT S $ZT="G ER" D FLCSV(COD) N A,B,I,J S RZD="," C FLCSV:(DELETE) zsy "rm -f "_FLCSV O FLCSV:(REWIND:NEWVERSION:WRITE) D PUT^%W1PRM("FLCSV",FLCSV) EOPCSV Q ; CLCSV ; ;;N $ZT S $ZT="D SVER^%L1X G ECLCSV" N $ZT S $ZT="D SVER^%L1X G ER" C FLCSV ;;ZSY "unix2dos "_FLCSV ;; 31/01/17 ECLCSV Q ; DIRL(STAM) ; N DIR S DIR=$$WEBL^W3MAIN_+$$GET^%W1PRM("MSD")_"/" Q ; EXCEL(STAM) ; N A,FL,FLCSV S FLCSV=$$GETP^%W1PRM("FLCSV") I FLCSV="" Q "" S FL=$P(FLCSV,"/",$L(FLCSV,"/")-1,255) S A=" "_FL_"" Q A ; FLCSV(COD) ; N SHCSV,FMT1 S FMT1="csv" S FL=$$WEBL^W3MAIN_$$GETP^%W1PRM("MSD")_"/"_COD_$$^W4MYDVN ;;$$FL^%W1FREPX("W4SPDOC","csv") N MRKZ S MRKZ="" I $G(@$$^W4GL("MERKAZ")) S MRKZ="_"_^("MERKAZ")_"_" N IND S IND=COD_MRKZ_$$^W4MYDVN S SHCSV=$O(@$$^W4MAIN("TMPCSV")@(IND,FMT1,9999999),-1)+1 S @$$^W4MAIN("TMPCSV")@(IND,FMT1,SHCSV)=$H S FLCSV=FL_"_"_SHCSV_".csv" Q ; ER ; D SVER^%L1X G END W4EXPORD W4EXPORD(DT1,DT2) ; [ 23.02.22 18:22 ] [ N (JB,%ARG,%REM,DT1,DT2) S TMPORD=$$^W4TMPORD S FILE=$$DIR_"tmpexpord_"_DT1_"_"_DT2_"_"_JB C FILE:(DELETE) O FILE:(WRITE:NEWVERSION) F DT=DT1:1:DT2 D .S N="" F S N=$O(@$$^W4REF@(DT,N)) Q:N="" D ..U 0 W N,! ..K @TMPORD ..S A=$$^W4GETHZ(N) ..S HD=$G(@TMPORD) ..S ST=$TR($J("",100)," ",$C(9)) ..F J=1:1:$L(HD,"~") S $P(ST,$C(9),J)=$P(HD,"~",J) ..S N1="" F S N1=$O(@TMPORD@(N1)) Q:N1="" I N1 D ...S B=$G(^(N1)) ...F J=1:1:10 S $P(ST,$C(9),80+J)=$P(B,"~",J) ...U FILE W ST,! C FILE Q ; DIR(STAM) ; Q "/tmp/" ; ; READ ; S JB=1 S DT1=$H-20,DT2=+$H S FILE=$$DIR_"tmpexpord_"_DT1_"_"_DT2_"_"_JB O FILE:(REWIND:READONLY) S N=0 F U FILE R A Q:$ZEOF D .S N=N+1 .U 0 W N," ",A,!! C FILE Q W4EXZ2 W4EXZ2(COD,FMT) ; [ 28.03.18 15:03 ] [ Q W4EZA W4EZA(STAM) ; [ 06.01.22 15:41 ] [ 03.01.22 16:41 ] [ 26.03.14 12:35 ] Q $$^W4GL("P1EZA") ; D(PAR) ; I $G(PAR)="" Q 0 Q $D(@$$W4EZA@(PAR)) ; DD(PAR) I $G(PAR)="" Q 0 Q ($$D(PAR)>9) W4EZAT W4EZAT(PAR) ; [ 25.07.23 06:34 ] [ 24.07.23 20:50 ] [ 06.01.22 15:30 ] N (JB,PAR,PRHDST) I $G(PAR)="" Q 0 N NMB S NMB=$$GETP^%W1PRM("NMB") I NMB?1N.N,$$^W4MSD(NMB),$$NOTSFMSD^W4PRM=1 Q 0 I $$DD^W4EZA(PAR)!$$DD^W4EZT(PAR) Q 1 Q 0 ; STPAR(STAM) ; N STPAR S STPAR=$$GET^%W1PRM("STPAR") S PAR=$P(STPAR,"~",2) I 'PAR Q 0 Q $$W4EZAT(PAR) ; REF(PAR) ; I $$DD^W4EZA(PAR) Q $$^W4EZA_"("""_PAR_""")" I $$DD^W4EZT(PAR) Q $$^W4EZT_"("""_PAR_""")" Q "" W4EZH W4EZH(STAM) ; [ 08.11.13 13:29 ] [ 22.04.13 15:45 ] [ 07.04.13 09:45 ] Q $$^W4GL("P1EZH") ; KV(STAM) ; Q $$^W4GL("P1EZHK") ; NP(CD) ; I $G(CD)="" Q "" Q $G(@$$^W4GL("P1EZH")@(CD)) ; NPKV(CD) ; I $G(CD)="" Q "" N SUG S SUG=$$SUG^W4P(CD) I SUG="" Q "" Q $G(@$$^W4GL("P1EZHK")@(SUG)) ; D(CD) ; N OK S OK=0 I $G(CD)="" Q "" N GLH S GLH=$$^W4GL("P1EZH")_"(CD)" I $D(@GLH)>9 D Q OK-$S($G(@GLH)="NO":.5,1:0) .I $$DH(GLH) S OK=1 Q .S OK=0 N SUG S SUG=$$SUG^W4P(CD) I SUG="" Q 0 S GLH=$$^W4GL("P1EZHK")_"(SUG)" I $D(@GLH)>9 D Q OK-$S($G(@GLH)="NO":.5,1:0) .I $$DH(GLH) S OK=2 Q .S OK=0 Q OK ; DH(GLH) ; N OK S OK=0 N N S N="" F S N=$O(@GLH@(N)) Q:N="" I $D(@$$^W4GL("P1CODH")@(N)) S OK=1 Q Q OK ; MUST(CD) ; I '$$D(CD) Q 0 I $G(@$$^W4GL("P1EZH")@(CD))="NO" Q 0 I $G(@$$^W4GL("P1EZH")@(CD))'="NO",$$D(CD)=1 Q 1 I $$D(CD)'=2 Q 0 N SUG S SUG=$$SUG^W4P(CD) I SUG="" Q 0 Q $$MUSTGR(SUG) ; MUSTGR(SUG) ; I $G(SUG)="" Q 0 I $D(@$$^W4GL("P1EZHK")@(SUG))<10 Q 0 I $G(@$$^W4GL("P1EZHK")@(SUG))="NO" Q 0 Q 2 W4EZI W4EZI(CD) ; [ 26.11.18 09:31 ] [ 25.11.18 13:23 ] [ N (JB,CD) I $G(CD),'$$^W4EZAT(CD)!$$^W4AIN,$$TSF(CD) Q $S($$^W4AIN:2,1:1) Q 0 ; TSF(CD) ; I '$G(CD) Q 0 I $D(@$$^W4GL("P1EZI")@(CD))=11 Q 1 I $D(@$$^W4GL("P1EZKI")@(+$$SUG^W4P(CD)))=11 Q 1 Q 0 W4EZKI W4EZKI(COD) ; [ 02.01.17 10:02 ] [ 04.07.12 17:09 ] [ 19.10.09 09:40 ] Q ($D(@$$^W4GL("P1EZKI")@(+$$SUG^W4P(COD)))>9) G(COD) ; Q $G(@$$^W4GL("P1EZKI")@(+$$SUG^W4P(COD))) W4EZL W4EZL ; [ 28.06.22 11:19 ] [ 18.05.20 11:17 ] [ 12.02.17 16:47 ] N (JB,%ARG) S JB=+$G(JB) D KILL^%W3DEB("W4EZL") D PUT^%W3DEB("W4EZL","%ARG=[%ARG") I $G(JB)="" W " JB number is not defined ! " Q ; D PUT^%W1PRM("LKHR",$G(%ARG("CODE"))) S LKHR=$G(%ARG("CODE")) ; ; W "
    ",! ; W "",! ; W "" W " ",! I $$^W4TABLET'=2 W " ",! W "" W "",! ; W " " W " ",! ; N LKHNAME S LKHNAME=$$LKH^W4L(LKHR) ; W " ",! W " ",! W "
    " W "" W " "_$$^%W1DICT("SHOWMAINCUSTOMS") W "  
     
    " W $$^%W1DICT("MAINCUSTOMER") W " : " ; W "  ",! W "",! W " " W " "_$$H2U^%L1FRM(LKHNAME) W "
    ",! ; W "
    ",! ; W "",! W " " W " " W " " W " " W " ",! N N,NN,I D GLLK K @GLLK ; I LKHR D .N I,N .S N="" F I=1:1 S N=$O(@$$^W4GL("P1EZLI")@(LKHR,N)) Q:N="" D ..S @GLLK@(N)=$G(@$$^W4GL("P1EZLI")@(LKHR,N)) ..S @GLLK@(N,"I")=I .S N="" S N=$O(@GLLK@(N)) D LINE(1,N) .F I=2:1 S N=$O(@GLLK@(N)) Q:N="" D LINE(I,N) ; W "
    "_$$^%W1DICT("NPP")_""_$$^%W1DICT("CUSTCODE")_""_$$^%W1DICT("CUSTOMNAME")_"
    ",! W "
    ",! Q ; ; SAVEND ; N N,LKHR S LKHR=$$GET^%W1PRM("LKHR") Q:'LKHR D GLLK S N="" F S N=$O(@$$^W4GL("P1EZL")@(N)) Q:N="" D .N A S A=$$SPA^%L1FRM($G(^(N))) Q:A="" .I A=LKHR K @$$^W4GL("P1EZL")@(N) ; K @$$^W4GL("P1EZLI")@(LKHR) ; N N S N="" F S N=$O(@GLLK@(N)) Q:N="" D .I $D(@GLLK@(N,"DEL")) Q .I $L(LKHR)<4 Q .S @$$^W4GL("P1EZLI")@(LKHR,N)=$G(@GLLK@(N)) .S @$$^W4GL("P1EZL")@(N)=LKHR K @GLLK Q ; ; GLLK S GLLK=$$^W4MAIN("TMPLKH") Q ; ; LINE(I,N) ; W "" W " " ; W " + " W "
    " W " - " W " ",! ; W " " W $$VVLK(I_";"_N) W " ",! ; N LKHNAME S LKHNAME=$$LKH^W4L(N) W " " W "  "_$$H2U^%L1FRM(LKHNAME) W " ",! W "",! Q ; ; SETCUST(PRM) N LK,I S LK=$P(PRM,";") I LK="" Q "CODENOTEXIST" S I=$P(PRM,";",2) N MAIN S MAIN=$$GET^%W1PRM("LKHR") I LK=MAIN Q "CUSTEQMAIN" N GLLK D GLLK I $G(@GLLK@(LK,"I")),^("I")'=I Q "SAMECODE" I '$$D^W4L(LK) Q "CODENOTEXIST" I '$$ISCR^W4L(LK) Q "CUSTNOTCREDIT" S @GLLK@(LK)="" S @GLLK@(LK,"I")=I N LK1 S LK1=$$LKH^W4L(LK) Q "OK~"_$$H2U^%L1FRM(LK1) ; DELROW(LK) ; Q:$G(LK)="" N GLLK D GLLK I '$D(@GLLK@(LK,"DEL")) S ^("DEL")=1 Q K @GLLK@(LK,"DEL") Q ; VVLK(PRM) ; N I,VL S I=$P(PRM,";") S VL=$P(PRM,";",2) N FIND S FIND="Find('custcd"_I_"','custcd"_I_"','LKH','','','','','','SetCust(\'"_I_"\')')" N A S A=" " S A=A_"" Q A ; WD() ; I $$^W4TABLET=2 Q "98%" Q "80%" W4EZM W4EZM ; [ 09.08.14 07:06 ] [ 30.07.14 14:48 ] [ 29.07.14 13:24 ] Q GLEZM(STAM) ; Q $$^W4GL("MLEZM") ; GLEZMI(STAM) ; Q $$^W4GL("MLEZMI") ; TMP(STAM) ; Q "^[$$^W3MAIN]TMPEZM(JB)" ; MANOT(MAIN,PRTMP) ; I $G(MAIN)="" Q 1 I $G(PRTMP) Q +$G(@$$TMP@(MAIN)) Q +$G(@$$GLEZM@(MAIN)) ; CD(A) ; Q $P(A,"\") ; NAME(A) ; Q $P(A,"\",2) ; EM(A) ; Q $P(A,"\",3) ; EM1(A) ; N MD S MD=$$EM(A) I MD="" Q " " Q $$H2U^%L1FRM($G(@$$^W4GL("MLMIDA")@(MD))) ; QNETTO(A) ; Q $P(A,"\",4) ; AHEX(A) ; Q $P(A,"\",5) ; ALUT(CD,A) ; I '$$KP^W4PK(CD),$D(@$$GLEZM@(CD))>9,$$MANOT(CD) Q $$TOTALUT^W4EZMIDK(CD)/$$MANOT(CD) Q $P(A,"\",6) ; SUMST(CD,A) ; N AHEX S AHEX=$$AHEX(A) I 'AHEX Q 0 N KF S KF=$$NEWKF^W4PRT($$EM(A),$$EMSFR^W4PRT(CD)) S:KF KF=1 Q $J($$QNETTO(A)*$$ALUT(CD,A)*KF*100/AHEX,2,2) ; QNST(A) ; N AHEX S AHEX=$$AHEX(A) I 'AHEX Q 0 Q $J($$QNETTO(A)*100/AHEX,2,2) ; QNONE(MAIN,PRT,PRTMP) ; N MANA S MANOT=$$MANOT(MAIN,$G(PRTMP)) I 'MANOT Q "" N A I '$G(PRTMP) S A=$G(@GLEZM@(MAIN,PRT)) I $G(PRTMP) S A=$G(@$$TMP@(MAIN,PRT)) I A="" Q "" N EM S EM=$$EM(A) N EMSFR S EMSFR=$$EMSFR^W4PRT(PRT) N KF S KF=1 I $L(EM),$L(EMSFR),EM'=EMSFR D .S KF=$$NEWKF^W4PRT(EM,EMSFR) Q $J($$QNST(A)*KF/MANOT,3,3) ; W4EZM11 W4EZM11(CD,NM,PRC) ; [ 05.07.16 11:28 ] [ 04.07.16 17:33 ] [ N PRM,RES,MLEZM,MLEZMI S PRM=CD_"~"_$$INVH^%L1FRM(NM)_"~NO~1~1~0~0~1~"_PRC S RES=$$SAVE^W4MLPRT(PRM) I RES'=1 Q S MLEZM=$$GLEZM^W4EZM S MLEZMI=$$GLEZMI^W4EZM S @MLEZM@("K"_CD)=1 S @MLEZM@("K"_CD,CD)="1\"_NM_"\1\1.000\100.00\" S @MLEZMI@(CD,"K"_CD)=$H Q W4EZMIDK W4EZMIDK ; [ 02.12.21 10:39 ] [ 11.05.17 10:59 ] [ 24.03.16 13:50 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q Q:$G(%ARG("NOSHOW")) I $G(%ARG("PRKUP"))?1N.N D PUT^%W1PRM("PRKUP",%ARG("PRKUP")) D PUT^%W3DEB("W4EZMIDK","%ARG=[%ARG") ; S MAIN=$$MAIN Q:MAIN="" ; D TMPEZM I $$VIEW K @TMPEZM ; I $G(%ARG("COPYFROM")) D PAR2TMP(%ARG("COPYFROM"),MAIN) G MV I $G(%ARG("NEW"))!$$VIEW D PAR2TMP(MAIN) MV ; I $L($G(%ARG("CDMV2PR"))) D MVEZM2PR(%ARG("CDMV2PR")) I $L($G(%ARG("CDMV2EZM"))) D MVPR2EZM(%ARG("CDMV2EZM")) ; I $G(%ARG("SAVE")) D SAVE(%ARG("SAVE")) ; W "
    ",! ; W "" W " " W " " W " ",! ; W "",! ; W " " W " ",! ; I $$PRKUP D .W " " Q . . W "" .W " " .W "",! ; S MANOT=$$MANOT(MAIN,'$$VIEW) S MHMZR=$$MHMZR(MAIN) S MHLMAM=$$MHLMAM(MAIN) ; W " ",! ; W " ",! ; W " " W " ",! W "",! ; I '$$VIEW D .W "",! .W "",! .W " ",! ; W "
    " W " "_$$CAPTION_"",! W "
     
    " I $$VIEW W $$BOLD($$CLR^W4PK(MAIN)_" "_$$H2U^%L1FRM($$NM(MAIN)),"","12","DARKBLUE")_" " I '$$VIEW D .W $$^%W1DICT("PRODUCT")_" " .W " ",! .; I '$$PRKUP,'$$VIEW D . D SHOWCARD(MAIN) . ; W "" . W $$^%W1DICT("PRICE2ONEDISH")_" " . I $$VIEW!($$GETP^%W1PRM("PRKUP")=2) W $$BOLD($J($$MH^W4P($$CLR^W4PK(MAIN)),2,2)) W "
    " W $$^%W1DICT("MANOT")_" " I $$VIEW!($$AUTOMANOT&'$$PRKUP) W $$BOLD(MANOT,"manot") I '$$VIEW,'$$AUTOMANOT!$$PRKUP D .W " ",! W " " ; W " " W $$^%W1DICT("PRICE")_" " W ""_$J(MHMZR*MANOT,2,2),! W "",! W " " W $$^%W1DICT("BEFORETAX")_" " W ""_$J(MHLMAM*MANOT,2,2),! W "",! W " " W "
    " W "
    " D SELFROM W "" .W " ",! .W "
    ",! ; ;;W "
    ",! ; I MAIN="" W "
    " Q ; I $$^W4EZAT(MAIN),$$PRKUP D W "",! Q .W "",! ; W "",! W "" W "" W "" W "" W "" W "" W "" I '$$VIEW D .W "" W "",! ; N N,I ; ; VW ; D SHOWCONT(MAIN) ; D TOT ; W "
    "_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("EM")_""_$$^%W1DICT("QNETTO")_""_$$^%W1DICT("EXITPERCENT")_""_$$^%W1DICT("ALUT")_""_$$^%W1DICT("SIGN")_"
    ",! ; I $$VWED W "
    ",! D W "
    ",! .W "" .W "" .I $G(%ARG("CLOSE"))!($G(%ARG("WIN"))="IFR") D ..W "" ..W "" .W "
    " D SAVEBUT(MAIN) W " " D CLOSE W "
    ",! ; W "",! Q ; ; SHOWCONT(MAIN) ; N NP S NP="",I=0 F S NP=$O(@TMPEZM@(MAIN,NP)) Q:NP="" D .N A S A=$G(^(NP)) .N N S N=$$CDEZM(A) Q:N="" .W "",! S I=I+1 . .W " "_N_" " .W "",! . .W " "_$$H2U^%L1FRM($$NAME(A)) . W "
    " . W $$^%W1DICT("PRICE2ONE",$$EMSFR1^W4PRT(N))_": "_$J($$ALUT(N,A),2,2)_"" . W " 
    ",! . I '$$VIEW D .. D SHOWCARD(N) .. I $D(@$$GLEZM^W4EZM@(N))>9 D SHOWTREE(N) .W "",! . .W "" . I $$VIEWONLY W $$EM1(A) . I $$EDIT D . .W "" . .W "
    "_$$EM1(A)_"" .W "",! . .W "" . I $$VIEWONLY W $J($$QNETTO(A),3,3) . I $$EDIT D . .W "" .W "",! . .W "" . I $$VIEWONLY W $$AHEX(A) . I $$EDIT D . .W "" .W "",! . .W "" . W $$SUMST(N,A) .W "",! . .I '$$VIEW D ..W "" .. W "" ..W "",! .W "",! Q ; ; TOT ; N CDMAIN S CDMAIN=$$^W4PK(MAIN,$$PRKUP) N TOTALUT S TOTALUT=$$TOTALUT(CDMAIN,'$$VIEW) N MANOT,ALUTONE S MANOT=$$MANOT(CDMAIN,'$$VIEW) S ALUTONE="" I MANOT>0 S ALUTONE=$J(TOTALUT/MANOT,2,2) N MHLMAM S MHLMAM=$$MHLMAM(CDMAIN) ; W "" D TDSP W "" W $$^%W1DICT("TOTALUT") W "" D TDTOT W " id=""totalut"" >" W $J(TOTALUT,2,2) W "" W "",! ; W "" D TDSP W "" W $$^%W1DICT("TOTALUT2ONE") W "" D TDTOT W "id=""alutone"" >" D .W $J(ALUTONE,2,2) Q .W " " W "" W "",! ; W "" D TDSP W "" W $$^%W1DICT("PROFITPERCENT") W "" D TDTOT W " id=""profit"" >" I TOTALUT D .W $J((MHLMAM*MANOT-TOTALUT/TOTALUT)*100,2,2) I 'TOTALUT W " " W "" W "",! ; W "" D TDSP W "" W $$^%W1DICT("FOODCOST") W "" D TDTOT W " id=""foodcost"" >" I MHLMAM,MANOT D .W $J(TOTALUT/(MHLMAM*MANOT),2,2) E W " " W "" W "",! Q ; TDSP ; W " " W "",! Q ; TDTOT ; W "",! .I '$$^W4MUCHIT D ..W "",! ..D PUT^%W1PRM("CDKV","ALL") . .N NN,II S NN="",II=0 F S NN=$O(@$$^W4GL("PARSUG")@(NN)) Q:NN="" D ..S II=II+1 ..N A S A=$G(^(NN)) ..W "",! ; ; I FIRSTGR="PRT"!'$$PRKUP D .I FIRSTGR="EZM" D ..W " id=""grezm""" ..W " onChange=""NewView("_JB_")""" ..W " >",! . .I FIRSTGR="PRT" D ..W " id=""grprt""" ..W " onChange=""ShowPrt("_JB_",'')""" ..W " >",! . .I '$$^W4MUCHIT W "",! .; .N NN,II S NN="",II=0 F S NN=$O(@$$^W4GL("MLSUGP")@(NN)) Q:NN="" D ..S II=II+1 ..N A S A=$G(^(NN)) ..W "",! ; W "",! Q ; ; GETOPT ; N CDKV S CDKV=$S($G(%ARG("CDKV")):%ARG("CDKV"),1:$$GET^%W1PRM("CDKV")) Q:CDKV="" D GETLIST(JB_";"_CDKV) Q ; ; GETLIST(PRM) ; D PUT^%W3DEB("W4EZMIDK-GETLIST","PRM=PRM") N MAINCHN S MAINCHN=$$GET^%W1PRM("MAINCHN") ;;I MAINCHN S MAIN="" D PUT^%W1PRM("MAINCHN",0) N JB,CDKV S JB=$P(PRM,";"),CDKV=$P(PRM,";",2) I JB="" Q ; S MAIN=$$VIBMAIN($G(MAIN),$G(CDKV),$G(SRCH),"SEL") Q ; VIBMAIN(MAIN,CDKV,SRCH,PRM) ; N I,A S I=0,A="" N NM,PRSRC I $G(MAIN)'="",$G(PRM)'="SEL" Q N PRT S PRT="" F S PRT=$O(@$$GLPAR@(PRT)) Q:PRT="" D I $G(PRM)'="SEL",$G(MAIN)'="" Q .I CDKV,$$SUG(PRT)'=CDKV Q .I $$NOSHOW(PRT) Q .I $G(%ARG("TREESONLY")),$D(@$$GLEZM@($$CODP(PRT)))<10 Q .S NM=$$NM(PRT) .S PRSRC="" I '$$PRKUP S PRSRC="ML" .I $G(SRCH)'="",'$$^W1SRCH(SRCH,PRT,NM,PRSRC) Q .S I=I+1 .I I=1,MAIN="" S MAIN=$$CODP(PRT) . .I $G(PRM)="SEL" D ..S A="" ..W A,! ; Q MAIN ; ; PUTCDKV(PRM) ; N JB,CDKV S JB=$P(PRM,";"),CDKV=$P(PRM,";",2) I JB=""!(CDKV="") Q D PUT^%W1PRM("CDKV",CDKV) Q ; ; SWAPN(PRN) ; D TMPEZM S NST="" S MAIN=$$MAIN D CLEAR N NEWST,CD S NEWST=+PRM,NST=$P(PRM,";",2) G:'NEWST SWPNE G:'NST SWPNE Q $$SWAPN1(NEWST,NST,1) ; ; SWAPN1(NEWST,NST,PR) ; N TMPM,TMPEZM D TMPEZM N TMPM S TMPM=$E(TMPEZM,1,$L(TMPEZM)-1)_","""_MAIN_""")" N MAIN S MAIN=$$MAIN I MAIN="" Q 0 N VLO S VLO=$G(@TMPM@(NST)) D DEL^%L1GSEQ(TMPM,NST) N N,I,OK S N="",I=0,OK=0 I NST+1",! W "" ; N PRT S PRT="" F S PRT=$O(@$$GLPAR@(PRT)) Q:PRT="" D .I $$CODP(PRT)=$$CODP($G(MAIN)) Q .I $D(@$$GLEZM@($$CODP(PRT)))<10 Q .S NM=$$NM(PRT) .S A="" .W A,! ; W "",! W " " W "",! ; W "",! Q ; ; CDEZM(A) ; Q $$CD^W4EZM(A) ; NAME(A) ; Q $$NAME^W4EZM(A) ; EM(A) ; Q $$EM^W4EZM(A) ; EM1(A) ; N EM1 S EM1=$$EM1^W4EZM(A) I EM1="" S EM1=" " Q EM1 ; QNETTO(A) ; Q $$QNETTO^W4EZM(A) ; AHEX(A) ; Q $$AHEX^W4EZM(A) ; ALUT(N,A) ; Q $$ALUT^W4EZM(N,A) ; SUMST(CD,A) ; Q $$SUMST^W4EZM(CD,A) ; NEWST(CD) ; Q CD_"\"_$$MLNAME(CD)_"\"_$$MLEM(CD)_"\1.000\100.00\"_$J($$MLMH(CD),2,2) ; MLNAME(CD) ; Q $$MLNAME^W4MLPRT(CD) ; ; MLEM(CD) ; Q $$EMSFR^W4PRT(CD) ; ; MLMH(CD) ; Q $J($$MHAL^W4MLPRT(CD),2,2) ; ; COMP(PRM) ; N MAIN S MAIN=$P(PRM,";") I MAIN="" Q 0 N CD S CD=$P(PRM,";",2) I CD="" Q 0 N QN S QN=$P(PRM,";",4) N AHEX S AHEX=$P(PRM,";",5) I AHEX'>0 Q 0 N EM S EM=$P(PRM,";",6) S:EM=""!(EM=0) EM=1 N VIEW S VIEW=$P(PRM,";",7) S MAIN=$$CODP(MAIN) D TMPEZM I $$VWEDIT(VIEW) S MAIN=$$CLR^W4PK(MAIN),TMPEZM=$$^W4MAIN("TMPEZMV") S NP=$$GETNP1(MAIN,CD) ; N EMOLD S EMOLD=$P($G(@TMPEZM@(MAIN,NP)),"\",3) S $P(@TMPEZM@(MAIN,NP),"\",3)=EM N KF S KF=$$NEWKF^W4PRT(EM,$$MLEM(CD)) ; S $P(@TMPEZM@(MAIN,NP),"\",4)=QN S $P(@TMPEZM@(MAIN,NP),"\",5)=$J(AHEX,2,2) ; I $$AUTOMANOT,$$VWEDIT(VIEW)!'$$PRKUP D .S $P(@TMPEZM@(MAIN),"\")=$$COMPMANOT(MAIN_";"_VIEW,1) ; N MH S MH=$P($G(@TMPEZM@(MAIN,NP)),"\",6) I MH="" S MH=$$MLMH(CD) N AL S AL=$J(MH*QN*KF*100/AHEX,2,2) Q AL ; REFRESH(MAIN) ; N A,CD,N,TMPEZM,NEWPRC D TMPEZM S MAIN=$$CODP(MAIN) S N="" F S N=$O(@TMPEZM@(MAIN,N)) Q:N="" D .S A=$G(^(N)) .S CD=$$CDEZM(A) Q:CD="" .S EM=$$EM(A) .S NEWPRC=$$MLMH(CD)*$$NEWKF^W4PRT(EM,$$EMSFR^W4PRT(CD)) .D SETPRC(MAIN,N,NEWPRC) Q ; SETPRC(MAIN,NP,NEWPRC) ; D TMPEZM S $P(@TMPEZM@(MAIN,NP),"\",6)=$J(NEWPRC,2,2) Q ; GETNP(MAIN,CD) ; S MAIN=$$CODP(MAIN) N TMPEZM,N,A D TMPEZM Q $$GETNP1(MAIN,CD) ; GETNP1(MAIN,CD) ; N OK S OK=0 N N S N="" F S N=$O(@TMPEZM@(MAIN,N)) Q:N="" D Q:OK .S A=$G(^(N)) .I $$CDEZM(A)=CD S OK=N Q OK ; FOODCOST(MAIN,PRTMP) ; N MH,GLEZM S GLEZM=$$GLEZM S PRTMP=$G(PRTMP) S MH=$$MHLMAM(MAIN)*$$MANOT(MAIN,PRTMP) I 'MH Q 0 Q $J($$TOTALUT(MAIN,PRTMP)/MH,2,2) ; MANOT(MAIN,PRTMP) ; N GLEZM S GLEZM=$$GLEZM I $G(MAIN)="" Q 1 S MAIN=$$CODP(MAIN) N MANOT S MANOT="" ; I $$AUTOMANOT,'$$PRKUP!$$VWED D Q MANOT .S MANOT=$$COMPMANOT($P(MAIN,";")_";"_$$VIEW,$G(PRTMP)) ; I $G(PRTMP) D .D TMPEZM .S MANOT=$$MANOT^W4EZM(MAIN,1) .I 'MANOT S MANOT=1,$P(@TMPEZM@(MAIN),"\")=MANOT ; I '$G(PRTMP) D .S MANOT=$P($G(@GLEZM@(MAIN)),"\") .I MANOT="",$D(@GLEZM@(MAIN))>9 D ..S MANOT=1,$P(@GLEZM@(MAIN),"\")=MANOT ; Q MANOT ; ; MHMZR(MAIN) ; I $$PRKUP!$$KP^W4PK(MAIN) Q $$MH^W4P($$CLR^W4PK(MAIN)) Q $J($$MHAL^W4MLPRT(MAIN),2,2) ; ; MHLMAM(MAIN) ; N MH S MH=$$MHMZR(MAIN) I $$PRKUP!$$KP^W4PK(MAIN) Q $J(MH*100/(100+$$MAM^W4PRM),2,2) Q $J(MH,2,2) ; SETMANOT(PRM) ; N MAIN,MANOT,RES,TMPEZM S MAIN=$P(PRM,";") I MAIN="" Q "ERR;NOMAIN" S MAIN=$$CODP(MAIN) S MANOT=$P(PRM,";",2) I 'MANOT S MANOT=1 D TMPEZM S $P(@TMPEZM@(MAIN),"\")=MANOT S RES=$J($$MHMZR(MAIN)*MANOT,2,2)_";" S RES=RES_$J($$MHLMAM(MAIN)*MANOT,2,2)_";" Q RES ; PRKUP(STAM) ; ;;I $$GETP^%W1PRM("PRKUP")&'$$GETP^%W1PRM("MLPRT")&'$G(%ARG("MLPRT")) Q 1 I $$GETP^%W1PRM("PRKUP")&'$G(%ARG("MLPRT")) Q 1 Q 0 ; CODP(PAR) ; I $G(PAR)="" Q "" Q $$^W4PK(PAR,+$$PRKUP) ; NMMD(PRM) ; N EM,MAIN,CD,A S EM=$P(PRM,";") I EM="" Q "ERR;NOEM" S MAIN=$P(PRM,";",2) I MAIN="" Q "ERR;NOMAIN" S CD=$P(PRM,";",3) I CD="" Q "ERR;NOCODE" S MAIN=$$CODP(MAIN) S A=$G(@$$TMP^W4EZM@(MAIN,CD)) ; N OLDEM S OLDEM=$$EM^W4EZM(A) N GLMIDA S GLMIDA=$$^W4GL("MLMIDA") N GLMKDM S GLMKDM=$$^W4GL("MLMKDM") I $L(OLDEM),'$G(@GLMKDM@(EM,OLDEM)),'$G(@GLMKDM@(OLDEM,EM)) Q "ERR;NOKFMD;"_$G(@GLMIDA@(OLDEM))_"<>"_$G(@GLMIDA@(EM))_";"_OLDEM Q $G(@GLMIDA@(EM)) ; SHOWCARD(PRT) W "" Q ; SHOWTREE(PRT) W " " Q ; FSZBUT(STAM) ; Q "font-size:"_$$^W3FSZ(9) ; VIEW(STAM) ; Q $G(%ARG("VIEW")) ; BOLD(VL,ID,SIZE,COLOR) ; N ST S ST=""_VL_"" Q ST ; CLOSE ; D ROUNDBUT^%W1JS("newinvoice",$$^%W1DICT("CLOSE"),"Close()","color:red","wh,22") Q ; SAVEBUT(MAIN) ; D ROUNDBUT^%W1JS("save",$$^%W1DICT("SAVE"),"Save('"_MAIN_";;"_$$VIEW_"')"_$S($G(%ARG("CLOSE")):";Close()",1:""),"color:green","wh,22") Q ; AUTOMANOT(STAM) ; Q $$AUTOMANOT^W3PRM ; COMPMANOT(MAIN,PRTMP) ; N VIEW S VIEW="" N GLEZM S GLEZM=$$GLEZM^W4EZM I $G(PRTMP) S GLEZM=$$TMP^W4EZM ; I $P(MAIN,";",2) D ; -- VWED .S VIEW=$P(MAIN,";",2) .S MAIN=$$CLR^W4PK($P(MAIN,";")) .I $G(PRTMP),VIEW S GLEZM=$$^W4MAIN("TMPEZMV") ; N KAM S KAM=0 S MAIN=$P(MAIN,";") N N S N="" F S N=$O(@GLEZM@(MAIN,N)) Q:N="" D .S KAM=KAM+$P($G(^(N)),"\",4) Q $J(KAM,3,3) ; ; VWED(STAM) ; Q ($$VIEW=2) ; VWEDIT(VIEW) ; Q (VIEW=2) ; EDIT(STAM) ; Q ($$VIEW'=1) ; VIEWONLY(STAM) ; Q ($$VIEW=1) W4EZMPRT W4EZMPRT ; [ 03.01.16 08:04 ] [ 12.08.14 16:00 ] [ 11.08.14 16:19 ] N (JB,%ARG,SRCH) Q:$G(%ARG("NOSHOW")) I '$D(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W4EZMPRT","%ARG=[%ARG & SRCH=SRCH") I $D(%ARG("KV")) D PUT^%W1PRM("KV",%ARG("KV")) D TMPEZM W "
    ",! W ""_$$^%W1DICT("ITEMSTABLE")_"",! W "",! W "" W "" W "" W "" W "" W "",! N N,I ; N MAIN S MAIN=$$MAIN I MAIN="" W "
    "_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("PRICE")_""_$$^%W1DICT("SIGN")_"
    ",! ; D PUT^%W3DEB("W4EZMPRT","MAIN=MAIN") Q:MAIN="" ; N MPR N N1 S N1="" F S N1=$O(@TMPEZM@(MAIN,N1)) Q:N1="" D .N A S A=$G(^(N1)) .N CD S CD=$P(A,"\") Q:CD="" .S MPR(CD)="" ; S N="",I=0 F S N=$O(@$$GLMLPAR@(N)) Q:N="" D .N SUG S SUG=$$MLSUGP^W4MLPRT(N) .I $G(%ARG("KV")),%ARG("KV")'=SUG Q .I $L($G(SRCH)),'$$^W1SRCH(SRCH,N,"","ML") Q .I $D(MPR(N)) Q .I '$$PRKUP^W4EZMIDK,N=MAIN Q . .W "" S I=I+1 . .W " "_N_" " . .W " "_$$H2U^%L1FRM($$MLNAME^W4MLPRT(N))_" " . .W " "_$J($$MHAL^W4MLPRT(N),2,2)_" " . .W "" . W " " .W "" .W "",! W "",! W "",! Q ; TMPEZM ; D TMPEZM^W4EZMIDK Q ; MAIN(STAM) ; I $L($G(%ARG("MAIN"))) Q $$CODP^W4EZMIDK($G(%ARG("MAIN"))) I $L($$GETP^%W1PRM("MAIN")) Q $$CODP^W4EZMIDK($$GETP^%W1PRM("MAIN")) Q "" ; GLMLPAR(STAM) ; Q $$^W4GL("MLPAR") W4EZT W4EZT(STAM) ; [ 06.01.22 15:41 ] [ 03.01.22 16:41 ] [ 06.11.16 05:44 ] Q $$^W4GL("P1EZT") ; D(PAR) ; I $G(PAR)="" Q 0 Q $D(@$$W4EZT@(PAR)) ; ; DD(PAR) I $G(PAR)="" Q 0 Q ($$D(PAR)>9) W4FASTGR W4FASTGR ; [ 05.08.23 18:46 ] [ 10.05.22 13:47 ] [ 10.08.21 12:36 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W4FASTGR","%ARG=[%ARG") D GL ; W "
    ",! ; W "" W $$KOT W "",! ; W "",! ; W "" W " " W " " W " " W "",! ; N N,I S N="",I=0 F S N=$O(@GL@(N)) Q:N="" I $$^W4VWGR(N) D .W "" S I=I+1 . .W "" . .W "" . .N ID,PROC S ID="chfast"_N .S PROC="OnClickTbl('"_N_"','TblFastGr','trfast','chfast')" .D ^W4TDCHBX(ID,PROC) . .W "",! W "",! Q ; ; GL S GL=$$^W4MAIN("TMPGR") S GLOB=$$^W4GL("W4FASTGR") I $$GETP^%W1PRM("GLOB")'="" S GLOB=$$^W4GL($$GETP^%W1PRM("GLOB")) Q ; SAVE(PRM) ; N CD,NM,MH,DESC,GR,SHOW D GL L +@GLOB:1 K @GLOB M @GLOB=@GL L -@GLOB Q ; MVGR2FAST(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D GL S PRM=$E(PRM,1,$L(PRM)-1) N I,N,K S K=0 S N="" F I=1:1 S N=$O(@GL@(N)) Q:N="" I $$^W4VWGR(N) S K=K+1 N SAH S SAH=K+$L(PRM,";")-1 D COLXY^W4HZTFR I SAH>COLX Q "FASTGRMAX;"_COLX N OK S OK=0 I PRM="" Q 0 N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .S @GL@(CD)="" .S OK=1 Q OK ; MVFAST2GR(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D GL S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q 0 N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .K @GL@(CD) .S OK=1 Q OK ; ; GR2TMP ; D GL L +@GL:1 K @GL M @GL=@GLOB L -@GL Q ; INIT ; D KILL^%W1PRM("GLOB") I $G(%ARG("GLOB"))'="" D PUT^%W1PRM("GLOB",GLOB) I $G(%ARG("MSD")) D PUT^%W1PRM("MSD",%ARG("MSD")) S MSD=$$GETP^%W1PRM("MSD") D ^W3CSS D GR2TMP Q ; KOT(STAM) ; Q $$^%W1DICT("FASTGROUPSLIST") ; STYLE(N) ; Q " style=""background-color:"_$$BGCOLOR(N)_""" " ; BGCOLOR(N) ; I '$$^W4VWGR(N) Q "pink" Q "white" W4FAXHTM W4FAXHTM(HZ,MKR,FAX) ; [ 01.08.21 14:31 ] [ 09.06.21 10:53 ] [ 13.02.20 18:05 ] N (JB,%ARG,%REM,HZ,MKR,FAX) S MSD=$$MSD(HZ) G:MSD="" END S MSDR=$$MSDR^W4PRM S FAX=$$FAX(MSD,$G(FAX)) S MAIL="" I FAX["@",FAX["." S MAIL=FAX,FAX="" ; S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",3)=MSD ; S %ARG("FAXHTM")=1 D PUT^%W1PRM("FAXHTM",1) I $$FAX2MAIL^W3PRM!$$SND2MAIL^W3R(MSD)!'FAX!$L(MAIL) S A=$$SNDMAIL(HZ,MAIL) I A=1,$$SND2MAIL^W3R(MSD)'=2 G END ; I FAX="" G END S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",4)=FAX ; I '$D(JB) S JB=$$^%W1SsID("W3ORD") S FLHZ="FAX"_HZ_"."_MSD S FLFAX=$$WEBL^W3MAIN_MSD_"/fax/"_FLHZ I $$MM^W4PRM S FLFAX=$$WEBL^W3MAIN_MSDR_"/fax/"_FLHZ_".html" ; N $ZT ; C FLFAX O FLFAX:(NEWVERSION:WRITE) U FLFAX W "",! ; ; I $$^%L1ZOS(10,$$WEBL^W3MAIN_"w3hdfax"_MSDR_".gif")>-1 D .W "
    " . W "" .W "


    ",! ; S %ARG("FAX")=FAX D ^W4PCHBP(HZ,+$G(MKR)) ; ---------------- !!!!!!!!!!!!!!!!!!!! W "",! ; C FLFAX ; I $$FAXPDF^W4PRM!$$OLDFAX^W4PRM D CHNCOLOR ; S FX2="cat "_FLFAX_" | mail -n -s ""order "_HZ_""" "_FAX_"@fax.tc" ; I $$FAXPDF^W4PRM D .S FAX=$TR(FAX,"+-","") .N FLPDF S FLPDF=$P(FLFAX,".html")_".pdf" .ZSY "rm "_FLPDF .N CMD S CMD="/pos/sbin/htmltopdf -q "_FLFAX_" "_FLPDF .;;S ^AA("CMDPDF")=CMD .ZSY CMD .S FX2="/usr/bin/faxspool -C - "_FAX_" """_FLPDF_"""" ; I FX2'[">" S FX2=FX2_" > null" ;;S ^AA("CMDFAX")=FX2 D PUT^%W3DEB("W4FAXHTM","FX2=FX2") ; N E1,E2 ZSY FX2 S E2=$ZSY ;;S ^AA("CMDFAX","RES")=E2 ; I '$ZSY D .D SETOK(HZ) .S @$$^W4ORD(HZ)@(HZ,"FAX")=FAX_"~"_$H_"~"_$$GETP^%W1PRM("MLZR")_"~"_$$^W4MYDVN .Q:FAX="" .S @$$^W4ORD(HZ)@(HZ,"FAX",FAX)=$H_"~"_$$GETP^%W1PRM("MLZR")_"~"_$$^W4MYDVN ; I E2 D .S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",6)=E2 .S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",4)=FAX_"~"_E2_"~"_$H ; N IND S IND=$P($H,",")_$TR($J($P($H,",",2),5)," ",0)_"_"_FAX S @$$^W4ORD(HZ)@(HZ,"FAXSTA",IND)=E2 END D PUT^%W1PRM("FAXHTM",0) Q ; ; FAX(MSD,FAX) ; S FAX=$$SPA^%L1FRM($G(FAX)) I $L($G(FAX))>6 Q FAX S FAX=$$SPA^%L1FRM($TR($$FAX^W3R(MSD),"-","")) S:$E(FAX)="!" FAX=$E(FAX,2,20) Q:$L(FAX)<7 "" Q FAX ; ; FAXALW(MSD,FAX) ; I $E(FAX)="!" Q 0 Q $$FAXALW^W3R(MSD) ; MAINPAGE(STAM) ; Q $$WEB^W3MAIN ; SNDMAIL(HZ,MAIL) ; S MSD=$$MSD(HZ) I $G(MSD)="" Q "NOTREST" ; I $G(MAIL)="" S MAIL=$$EMAIL^W3R(MSD) I MAIL="" Q "NOTMAIL" I MAIL'["@"!(MAIL'[".") Q "MAILWRONG" N PRM S PRM=HZ_";Order "_HZ_";"_MAIL_";1;0;3;;;" D PUT^%W1PRM("MKRMAIL","W4FAXHTM;"_HZ) S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",10)=MAIL Q $$EMAILCONT^W4PCHBP(PRM) ; ; SEND(HZ) ; N MSD,MKR S MKR=1 D SENDTRY(HZ,MKR) ; I $$ER(HZ) D SENDTRY(HZ,MKR) ; -- ERROR I $$ER(HZ) D SENDTRY(HZ,MKR) ; -- ERROR ; Q ; ; SENDTRY(HZ,MKR,FAX,CMNT) N (JB,%ARG,%REM,HZ,MKR,FAX,CMNT,TRY) I '$G(TRY) S TRY=1 I $$FAXTIME(HZ) S MKR=0 ; D W4FAXHTM(HZ,+$G(MKR),$G(FAX)) ; N TRY S TRY=$$TRY(HZ)+1 S $P(@$$^W4ORD@(HZ,"DBF"),"\",7)=+$G(TRY) S START=$$START(HZ) S $P(START,"^",TRY)=$H S $P(@$$^W4ORD@(HZ,"DBF"),"\",8)=START S $P(@$$^W4ORD@(HZ,"DBF"),"\",9)=$G(CMNT) Q ; ; DBF(N) I $G(N)="" Q "" Q $G(@$$^W4ORD@(N,"DBF")) ; FAXTIME(N) N DBF S DBF=$$DBF(N) Q $P(DBF,"\",2) ; FAXNOM(N) N DBF S DBF=$$DBF(N) Q $P(DBF,"\",4) ; ER(N) N DBF S DBF=$$DBF(N) Q $P(DBF,"\",6) ; TRY(N) N DBF S DBF=$$DBF(N) Q $P(DBF,"\",7) ; START(N) N DBF S DBF=$$DBF(N) N ST S ST=$P(DBF,"\",8) I $P(ST,"^",$$TRY(N)) Q $P(ST,"^",$$TRY(N)) Q ST ; COMMENT(N) N DBF S DBF=$$DBF(N) N ST S ST=$P(DBF,"\",9) Q ST ; ; STATFAX(N) ; N FAXTIME S FAXTIME=$$FAXTIME(N) N FAXLATE S FAXLATE=$P($$FAXLATE(N),"\",2) ; -- MIN N START S START=$$START(N) N MSD S MSD=$$MSDHZM^W4HZMST(N) N ER S ER=$P($G(@$$^W4ORD@(N,"DBF")),"\",6) ; N ST S ST="" ; N TRY S TRY=$$TRY(N) ; S IMGFAX=$$IMGFAX(N) ; S ST="" S ST=ST_"["_($$FAXCOPY^W3R(MSD)+1)_":"_$$SENDEDFAX(N)_"]" S ST=ST_"" ; I $L($$FAX^W4HZMST(N))!$L($$EMAIL^W4HZMST(N)) D Q ST .S ST=ST_$$IMG^W4MMTIME("ShowFax('"_N_"')",IMGFAX)_" " .S ST=ST_$ZD(FAXTIME,"24:60") .N SND S SND=$$SND2MAIL^W3R(MSD) .I ('$$FAX^W4HZMST(N)!$$FAXERR^W4HZMST(N))&(SND=0!(SND=2)) S ST=ST_" "_$$VOSCL .I ('$L($$EMAIL^W4HZMST(N))!$$EMAILERR^W4HZMST(N))&(SND=1!(SND=2)) S ST=ST_$$VOSCL .I FAXLATE>0 S ST=$$TB(ST,FAXLATE) ; I TRY<2 D Q ST .S ST=ST_$$IMG^W4MMTIME("ShowRestFax('"_MSD_"')",IMGFAX)_" " .S ST=ST_""_$$^%W1DICT("INWAITING")_"" .I FAXLATE>0 S ST=$$TB(ST,FAXLATE) ; I TRY<3 D Q ST .S ST=ST_$$IMG^W4MMTIME("ShowFax('"_N_"')",IMGFAX)_" " .S ST=ST_$$^%W1DICT("RETRY",TRY) .I FAXLATE>0 S ST=$$TB(ST,FAXLATE) ; N ER S ER=$$ER(N) S ST=ST_$$IMG^W4MMTIME("ShowFax('"_N_"')",IMGFAX)_" " N ERRMSG S ERRMSG=ST_$$^%W1DICT("ERROR",ER) N ER1 S ER1="" I ER S ER1=$G(@$$^W4GL("W4FAXERR")@(ER)) I ER1'="" S ERRMSG=$$^%W1DICT(ER1) Q ERRMSG_" " ; ; IMGFAX(N) ; N IMG S IMG="w4mmimg.png" N MSDHZ S MSDHZ=$$MSDHZM^W4HZMST(N) I MSDHZ,$$ARMFAX^W3R(MSDHZ) S IMG="w4finger.png" Q IMG ; SENDEDFAX(N) ; N I S I=0 N N1 S N1="" F S N1=$O(@$$^W4ORD@(N,"FAXSTA",N1)) Q:N1="" I $G(^(N1))=0 S I=I+1 Q I ; FAXLATE(N) ; N DIF N RCVTIME S RCVTIME=$$DATCB^W4HZMST(N) ; N DT S DT=$$^%L1DC($P(RCVTIME," "),3) ; S RCVTIME=DT_","_(($P(RCVTIME," ",2)*3600)+($P($P(RCVTIME," ",2),":",2)*60)) ; N FAXTIME S FAXTIME=$$FAXTIME(N) ; I 'FAXTIME D .S DIF=$$DIFTIME($H,RCVTIME) ; I FAXTIME D .S DIF=$$DIFTIME(FAXTIME,RCVTIME) ; S DIF=DIF-5 ; I DIF<5 Q 0 I DIF<10 Q "1\"_DIF I DIF<15 Q "2\"_DIF Q "3\"_DIF ; ; SHOWFAX(N) ; N FAX S FAX=$$FAX^W4HZMST(N) N FAXTRY S FAXTRY=$$FAXTRY^W4HZMST(N) N MAIL S MAIL=$$EMAIL^W4HZMST(N) N MAILTRY S MAILTRY=$$EMAILTRY^W4HZMST(N) N COMMENT S COMMENT=$$COMMENT(N) N FAXER S FAXER=$$FAXERR^W4HZMST(N) N MAILER S MAILER=$$EMAILERR^W4HZMST(N) N ST S ST="" ; I $D(@$$^W4ORD@(N,"FAXSTA")) S ST=$$HISTFAX(N) G SHOWFAXEM ; I $L(FAX) S ST=FAX I FAXER S ST=FAXTRY_" - ERROR "_FAXER I 'FAXER,FAX="",FAXTRY="" S ST="FAX ERROR" ; SHOWFAXEM ; I $L(MAIL),'MAILER D .S ST=ST_$S($L(ST):"
    ",1:"")_MAIL ; I MAILER D .S ST=ST_$S($L(ST):"
    ",1:"")_MAILTRY_" - ERROR "_MAILER ; I $L(COMMENT) S ST=ST_"
    "_COMMENT Q ST ; SHOWDIF(TIME) ; Q " [+"_TIME_"] " ; MSD(HZ) ; Q $$MSDHZM^W4HZMST(HZ) ; SETOK(HZ) N MSD S MSD=$$MSD(HZ) Q:'MSD S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\")=4 S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",2)=$H S $P(@$$^W4ORD(HZ)@(HZ,"DBF"),"\",6)=0 ; I $$MM^W4PRM D .N HACHANA S HACHANA=$$HACHANA^W3R(MSD) S:'HACHANA HACHANA=30 .S HACHANA=HACHANA*60 .N READYTIME .S READYTIME=$H*86400+$P($H,",",2)+HACHANA .S $P(@$$^W4ORD(HZ)@(HZ,"READY"),"\")=(READYTIME\86400)_","_(READYTIME#86400) Q ; DIFTIME(T1,T2) ; Q $$DIF^%L1TIME(T1,T2) ; TB(ST,TIME) ; S ST="
    "_$$^%W1DICT("GROUPCODE")_""_$$^%W1DICT("GROUPNAME")_""_$$^%W1DICT("SIGN")_"
     "_N_"  " . W $$H2U^%L1FRM($G(@$$^W4GL("PARSUG")@(N))) .W " 
    " S ST=ST_"" S ST=ST_"
    "_ST_" [+"_TIME_"]
    " Q ST ; VOSCL(STAM) ; Q " !" ; CHNCOLOR ; N A,A1 N FLFAX1 S FLFAX1=FLFAX_"__1" O FLFAX:(REWIND:READONLY) U 0 I $$^%L1ZOS(10,FLFAX1)>0 ZSY "rm "_FLFAX1 O FLFAX1:(WRITE:NEWVERSION:REWIND) F U FLFAX R A Q:$ZEOF D .S A1=$$CHNCOLOR1(A) .U FLFAX1 W A1,! C FLFAX,FLFAX1 U 0 ; I $$^%L1ZOS(10,FLFAX)>0 ZSY "rm "_FLFAX ZSY "mv "_FLFAX1_" "_FLFAX I $$^%L1ZOS(10,FLFAX1)>0 ZSY "rm "_FLFAX1 Q ; CHNCOLOR1(A) ; N A1,J,J1,JJ S A1="",J=0,J1=0 CHNCOLOR2 ; S J=J+1 I J>$L(A) G CHNCOLORE I $E(A,J,J+5)="color:",$E(A,J-1)'="-" D G CHNCOLOR2 .F JJ=J+6:1:$L(A) Q:$E(A,JJ)="""" Q:$E(A,JJ)=";" .S SMB=";" I $E(A,JJ)="""" S SMB="""" .S A1=A1_"color:black"_SMB .S J=JJ ; S A1=A1_$E(A,J) G CHNCOLOR2 CHNCOLORE ; Q A1 ; HISTFAX(HZ) ; N (JB,%ARG,%REM,HZ) N ST S ST="" N N S N="" F S N=$O(@$$^W4ORD@(HZ,"FAXSTA",N),-1) Q:N="" D .S A=$G(^(N)) .S FAX=$P(N,"_",2) .S TIME=$P(N,"_") .S H=$E(TIME,1,5)_","_+$E(TIME,6,10) .S STAT=$S($P(A,"~"):"ERROR "_$P(A,"~"),'$P(A,"~",2):"OK",1:$P(A,"~",3)) .S ST=ST_$ZD(H,"DD.MM.YY 24:60")_" "_FAX_" "_STAT_"
    " Q ST W4FAXSTA W4FAXSTA(PRM) ; [ 24.09.19 14:00 ] [ 23.09.19 10:38 ] [ N (JB,%ARG,%REM,PRM) S DLM="~" S HZ=$P(PRM,DLM) S FAX=$P(PRM,DLM,2) S MSD=$P(PRM,DLM,3) S STA=$P(PRM,DLM,4),STA1="" ; F I=1:1 S T=$T(STAT+I) Q:T="" Q:T[" Q ;" I STA=$P(T,";",2) S STA1=$P(T,";",3) ; S GL=$$^W4MAIN("W4FAXSTA") S D=$P($H,",") S T=$P($H,",",2) S @GL@(D,T)=HZ_"~"_FAX_"~"_MSD_"~"_STA_"~"_STA1 S $P(@$$^W4ORD@(HZ,"FAXSTA",IND),"~",2)=STA S $P(@$$^W4ORD@(HZ,"FAXSTA",IND),"~",3)=STA1 S $P(@$$^W4ORD@(HZ,"FAXSTA",IND),"~",4)=D S $P(@$$^W4ORD@(HZ,"FAXSTA",IND),"~",5)=T Q ; STAT ; ;0;SENT; ;1;ERRCMD; ;2;ERROPN; ;3;ERRMOD; ;4;BUSY; ;5;NODIAL; ;10;NO CAR; ;12;PAGE ERR; ;15;INTRPT; Q ; W4FBAR W4FBAR(STAM) ; [ 07.11.08 10:43 ] [ 19.05.08 18:44 ] [ I $G(@$$^W4PRM@("FBAR",$$^W4MYDVN)) Q 1 Q 0 W4FGIB W4FGIB(STAM) ; [ 11.04.14 06:09 ] [ 07.04.13 14:36 ] [ 25.07.11 05:54 ] S PATHGB=$$PATHGB END ; N ZD S ZD=$ZDIR ;;D PUT^%W3DEB("W4FGIB","PATHGB=PATHGB & ZD=ZD") N DZ S DZ=+$H I $$MSD^W4DLVCSR!$$DLV^W4DLVCSR D .S DZ=$$^W4DZ Q PATHGB_"#J"_$ZD(DZ,"YYMMDD") ; PATHGB(STAM) ; N MSD S MSD=$$GET^%W1PRM("MSD") I 'MSD S MSD=1 N PATHGB S PATHGB=$$MSM^W3MAIN S:$E(PATHGB,$L(PATHGB))'="/" PATHGB=PATHGB_"/" S PATHGB=PATHGB_+$G(MSD)_"/jour/" Q PATHGB W4FIND W4FIND(FIND,GL,SUPER) ; [ 20.03.25 12:15 ] [ 28.01.25 12:53 ] [ 14.11.24 10:41 ] N (JB,FIND,%ARG,%REM,GL,SUPER) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S PRTN=$$^%W1JB ; S TMPPAR=$$^W4MAIN("TMPPAR") K @TMPPAR I $$USMLPAR(GL),$G(@$$^W4GL("W3PRM")@("NOVWOLD")) D .N TMPOLD S TMPOLD=$$^W4MAIN("TMPOLD") K @TMPOLD .S @TMPOLD=$ZD($H,"DD.MM.YY 24:60")_"\"_$$^W4MYDVN .N DT S DT="" F S DT=$O(@$$^W4GL("W4MLY")@(DT)) Q:DT="" D ..N PAR S PAR="" F S PAR=$O(@$$^W4GL("W4MLY")@(DT,PAR)) Q:PAR="" D ...S @TMPPAR@(PAR,DT)="" ; BG S FIND=$G(FIND),GLB="" S FIND=$$CNWEB^%L1FRM(FIND) ;;S ^AA("W4FIND","FIND")=FIND I $G(GL)="" W "GL is not defined !",! Q ; I $E(FIND,$L(FIND))="=" S FIND=$E(FIND,1,$L(FIND)-1) I $E(FIND)="=" S FIND=$E(FIND,2,$L(FIND)) ;;S ^AA("W4FIND","FIND1")=FIND ; I GL["^|M|" S GLB="^|$$^W3MAIN|"_$P(GL,"|",3) G SUP S:$E(GL)="^" GL=$E(GL,2,20) S:GL["|" GL=$P(GL,"|",3) S:GL["]" GL=$P(GL,"]",2) ; I $G(%ARG("MSDR")) D .I $G(%ARG("MSD")) Q .N MSD S MSD=$O(^|$$^W3MAIN|W3MSDR(%ARG("MSDR"),"")) I MSD S %ARG("MSD")=MSD ; I GL="LKH",$$ONLINE^W4DLVCSR S GL="LKHA" ; I GL'="MDP",GL'="LKH" S GLB=$$^W4GL(GL) ; SUP I $G(SUPER) D .D CRSUG^W4HZTFR .K @$$^W4MAIN("TMPIT") .N N,N1,PARCAT S PARCAT=$$^W4MAIN("PARCAT") .;;F I=1:1:120 Q:$D(@PARCAT)=11&$G(@PARCAT) H 1 .S N="" F S N=$O(@PARCAT@(N)) Q:N="" D ..S N1="" F S N1=$O(@PARCAT@(N,N1)) Q:N1="" D ...S @$$^W4MAIN("TMPIT")@(N1)=$$SHEM^W4P(N1) .S GLB=$$^W4MAIN("TMPIT") M ; I GL="LKH" D .N GL D GL^W3L S GLB=GL ; I GL="MDP" S GLB=$$^W4PRM_"(""MDP"")" ; S TMPST=$$^W4MAIN("TMPST") K @TMPST ; S ENG=0 I $$ENG(FIND)!($$^%W1DIR="LTR") S ENG=1 ; I FIND'="" D .S FIND=$$SPA^%L1FRM($$CLEAR^%L1FRM(FIND)) .I ENG S FIND=$$FUNC^%UCASE(FIND) Q ; S ITEM="" I GL="LKH"!(GL="LKHA") S ITEM=999 N LKHR S LKHR=$$GETP^%W1PRM("LKHR") ; N FIND1 S FIND1=$TR(FIND,"-","") ; N GLEZLI S GLEZLI=$$^W4GL("P1EZLI") I GL="LKH",$$^W4DLVCSR,FIND1?1N.N,$D(@GLEZLI@(FIND1))>9,'$G(%ARG("MAIN")) D G VIEW .D ADDTBL(FIND1) .N N S N="" F S N=$O(@GLEZLI@(FIND1,N)) Q:N="" D ..D ADDTBL(N) ; I GL="LKH",$$^W4DLVCSR,FIND1?1N.N,'$D(@$$^W4GL("LKH")@(FIND1))!$$CLOSED^W4L(FIND1),$D(@$$^W4GL("KLLKTH")@(FIND1))>9 D G VIEW .N N S N="" F S N=$O(@$$^W4GL("KLLKTH")@(FIND1,N)) Q:N="" D ..D ADDTBL(N) ; I FIND?1N.N,$D(@GLB@(FIND)) D ADDTBL(FIND) I $$SUPER^W3PRM G VIEW I FIND?1U.U."-".N,$D(@GLB@(FIND)) D ADDTBL(FIND) ; I FIND?.P,FIND'="`" D G VIEW .F J=1:1:1999 S ITEM=$O(@GLB@(ITEM)) Q:ITEM="" D ADDTBL(ITEM) ; F S ITEM=$O(@GLB@(ITEM)) Q:ITEM="" D .I FIND?1U.U."-",$E(ITEM,1,$L(FIND))=FIND D ADDTBL(ITEM) Q .N NAME S NAME=$$NAME(ITEM) .I ENG,$$^%W1DIR="LTR" S NAME=$$FUNC^%UCASE(NAME) .I ENG,(" "_NAME_" ")[(" "_FIND) D ADDTBL(ITEM) Q .;;I (" "_NAME_" ")[(FIND_" ") D ADDTBL(ITEM) Q .I $$SRCH^W1SRCH(NAME,FIND) D ADDTBL(ITEM) Q .N NAME1 S NAME1=NAME .I NAME["ee" S NAME1=$$RPL^%L1FRM(NAME1,"ee","e") .N FIND1 S FIND1=FIND .I FIND["ee" S FIND1=$$RPL^%L1FRM(FIND1,"ee","e") .I $$SRCH^W1SRCH(NAME1,FIND1) D ADDTBL(ITEM) Q ; I $D(@TMPST)<10,FIND["-" S FIND=$TR(FIND,"-","") G BG ; I $$USMLPAR(GL),$G(%ARG("SORT"))!$G(@$$^W4PRM@("SORTITRA")) D .N TMPST1 S TMPST1=$$^W4MAIN("TMPST1") K @TMPST1 .N ITEM S ITEM="" F S ITEM=$O(@TMPST@(ITEM)) Q:ITEM="" D ..I $G(%ARG("SORT"))=2!$G(@$$^W4PRM@("SORTITRA")) D ...N IT S IT=1000000-$$^W4GETMLY(ITEM) ...S IT=$J(IT,10,0) ...S ^AA("W4FIND",ITEM,"IT")=IT ...N ITM S ITM=ITEM I ITM'["_" S ITM=IT_"_"_ITEM ...I $D(@TMPST@(ITEM))#2 S @TMPST1@(ITM)=@TMPST@(ITEM) . .K @TMPST .M @TMPST=@TMPST1 .K @TMPST1 ; VIEW ; W "
    ",! D CLOSE W "
    ",! W "
    ",! ; W "
    ",! ; I $G(%ARG("HD"))'="" D .W "" .W $$^%W1DICT(%ARG("HD")) .W "",! .W "
    ",! ; W "",! ; N ITEM,ITEM1,ITM S ITM="" F S ITM=$O(@TMPST@(ITM)) Q:ITM="" D .S ITEM=ITM I ITM["_" S ITEM=$P(ITM,"_",$L(ITM,"_")) .Q:ITEM="" .S ITEM1=$$NAME(ITEM) Q:ITEM1="" .W "" .W "" . .I GL="LKH" D ..W "",! ..I $G(%ARG("NOADDR")) Q ..W "" . .I GL="PAR" D ..N MH S MH=$$MH^W4P(ITEM) I $$INP S MH=$$MHAL^W4P(ITEM) ..W "" . .I $$USMLPAR(GL) D ..N MH S MH=0 ..D ...I $$ONEGLPAR^W3PRM S MHCSR=$$MH^W4P(ITEM) ...I $$GETP^%W1PRM("SPK") D I MH Q ....S MH=$G(@$$^W4GL("MLSPKMH")@($$GETP^%W1PRM("SPK"),ITEM)) ...S MH=$$MHAL^W4MLPRT(ITEM) .. ..W "" ..I '$$NOVWMHAL^W3PRM!(GL="PAR") D ...W "" .. ..I $$ONEGLPAR^W3PRM W "" .. . .I $E(GL,1,3)="LKH",$G(%ARG("ITRA")) D ..W "" . .W "",! W "
    " .W ITEM_"   "_$$H2U^%L1FRM(ITEM1) .W ""_$$^%W1DICT("CUSTCLOSED") ..I $$MAZAV^W4L(ITEM)'<1 W "> " ..W "" .. W $$H2U^%L1FRM($$KTVM^W4L(ITEM)) ..W ""_$J(MH,2,2)_"[ "_$$^W4GETMLY(ITEM)_" ]"_$J(MH,2,2)_""_$J(MHCSR,2,2)_""_$J($$ITRA^W4L(ITEM),2,2)_"
    ",! W "
    ",! ; D CLOSE K @$$^W4MAIN("TMPIT") Q ; ; ADDTBL(ITEM) ; I $G(LKHR),GL="LKH",$D(@$$^W4GL("P1EZLI")@(LKHR,ITEM)) Q I '$$USL(ITEM) Q S @TMPST@(ITEM)="" Q ; ENG(TXT) ; N OK S OK=1 N J F J=1:1:$L(TXT) I $A(TXT,J)<32!($A(TXT,J)>90) S OK=0 Q Q OK ; NAME(ITEM) ; N ST,NAME I GL="PAR" D Q NAME .S NAME=$$SHEM^W4P(ITEM) ; I GL="MDP" Q $P($G(@GLB@(ITEM,1)),"\",4) ; I GL="B1CLUB" Q $P($G(@GLB@(ITEM,1)),"\",3) ; I GL="PARSHA" D Q ST .S ST=$$MHPNAME^W3MHPSHA(ITEM) .S ST=ST_" "_$$^%W1DICT("FROM")_" "_$$^%W1DICT("DAY"_$$MEYOM^W3MHPSHA(ITEM)) .S ST=ST_" "_$$^%W1DICT("TO")_" "_$$^%W1DICT("DAY"_$$ADYOM^W3MHPSHA(ITEM)) .S ST=ST_" "_$$^%W1DICT("FROM")_" "_$$MESHAA^W3MHPSHA(ITEM) .S ST=ST_" "_$$^%W1DICT("TO")_" "_$$ADSHAA^W3MHPSHA(ITEM) ; S NAME=$G(@GLB@(ITEM)) S NAME=$TR(NAME,"-"," ") ; -- 07/02/17 I GL'="NAME" Q NAME ; Q $G(@GLB@(ITEM,1)) ; USL(ITEM) ; I GL["NAME",$G(%ARG("PAIL")),'$$GET1^W4LEVPR(ITEM,"PAIL") Q 0 I GL["LKH",$G(%ARG("MAIN"))=1,$G(@$$^W4GL("P1EZL")@(ITEM)) Q 0 I GL["LKH",$G(%ARG("MAIN"))=2,'$D(@$$^W4GL("P1EZLI")@(ITEM)) Q 0 I $G(%ARG("GL"))="PAR",$L(ITEM),'$$^W4PRTVW(ITEM),'$G(%ARG("VWALL")) Q 0 N OK S OK=1 I $$USMLPAR(GL),$G(@$$^W4GL("W3PRM")@("NOVWOLD")) D Q OK .N LAST S LAST=$O(@$$^W4MAIN("TMPPAR")@(ITEM,99999),-1) .I $H-LAST>365 S OK=0 S @$$^W4MAIN("TMPOLD")@(ITEM)=LAST Q 1 ; INP(STAM) ; I $G(%ARG("INP")) Q 1 I $$INP^W4DOC Q 1 I $G(%ARG("GL"))="MLPAR" Q 1 Q 0 ; CLOSE ; D ROUNDBUT^%W1JS("close",$$^%W1DICT("CLOSE"),"Close()","color:red","wh,22") Q ; SORTBYMLY ; D ROUNDBUT^%W1JS("sortbymly",$$^%W1DICT("SORTBYMLY"),"SortByMly()","color:blue","wh,22") Q ; CLOSED(LK) ; Q $$CLOSED^W4L(LK) ; LK(FIND,GL) ; I GL="LKH",$$^W4ISCDLK(FIND) Q 1 Q 0 ; USMLPAR(GL) ; I GL="MLPAR" Q 1 I $$NEWMLY^W3PRM,GL="PAR",$$ONEGLPAR^W3PRM Q 1 Q 0 W4FINDIT W4FINDIT(FIND) ; [ 12.11.24 18:42 ] [ 04.09.14 12:18 ] [ 27.10.09 18:18 ] N (JB,FIND,%ARG,%REM) S FIND=$G(FIND) D PUT^%W3DEB("W4FINDIT","FIND=FIND") ;;I FIND="" Q S GL=$$^W4GL("PAR") ; K ^[$$^W3MAIN]TMPST(JB) I FIND'="" D .S FIND=$$SPA^%L1FRM($$CLEAR^%L1FRM(FIND)) .S FIND=$$INVH^%L1FRM(FIND) ; S PAR="" I FIND="" D G VIEW .F S PAR=$O(@GL@(PAR)) Q:PAR="" D ADDTBL(PAR) ; I $$ISNUM^%L1FRM(FIND) D ADDTBL(FIND) ;; G VIEW ; F S PAR=$O(@GL@(PAR)) Q:PAR="" I (" "_$$SHEM^W4P(PAR)_" ")[(FIND_" ") D ADDTBL(PAR) ; VIEW ; D CLOSE^W4FIND W "",! S PAR="" F S PAR=$O(^[$$^W3MAIN]TMPST(JB,PAR)) Q:PAR="" D .W " ",! W "
    "_PAR_"   "_$$H2U^%L1FRM($$SHEM^W4P(PAR))_"
    ",! ; ;;D CLOSE^W4FIND Q ADDTBL(PAR) ; S ^[$$^W3MAIN]TMPST(JB,PAR)="" Q W4FIRE W4FIRE(HZM,MDP,NOFIRE) ; [ 01.08.22 15:35 ] [ 26.05.22 07:56 ] [ 24.05.22 10:00 ] N I,TXT,%MDP,NMB,MKBL,ZMANK,FIRE,PRINT,MKBL,MSL S MSL=0 I HZM D .S NMB=$$NMB^W4HZMST(HZM) .S MKBL=$$MKBL^W4HZMST(HZM) .S ZMANK=$$ZMANK^W4HZMST(HZM) .I $$HZM^W4MSL(HZM) S MSL=1 ; I 'HZM D .S NMB=$$NMB^W3HZMST(JB) .S MKBL=$$MKBL^W3HZMST(JB) .S ZMANK=$$DATCB^W3HZMST(JB) ; D ^W4MDP(MDP) Q:'$G(PRINT) D ^%L1TS ; I $$BONSCR^W4HZPCHD($G(PRINT)) D Q .I '$G(NOFIRE) D SET Q .I $G(NOFIRE) D KILL ; ;;S PRINT=$P(PRINT,"-")_"-99" ; *** LEV 02/05/2015 ; ;;F I=1:1:3 Q:'$D(@$$^W4GL("P1LOCK")@("PCHZ")) H 1 ; L +@$$^W4PC@(PRINT):2 S TXT=$G(%MDP("BEEP"))_$G(%MDP("BEEP"))_$G(%MDP("IE")) D S2 I 'MSL S TXT=%MDP("B")_$J("",8)_$J(NMB,3)_" ogley "_%MDP("N") D S1 I MSL S TXT=%MDP("B")_$J(NMB,12)_" gewl"_%MDP("N") D S1 N LKH1 S LKH1=$$^W4SHULHN(NMB) I LKH1'="" D .S TXT=%MDP("B")_$$HBR^%L1FRM(LKH1,17)_%MDP("N") D S1 ; I 'MSL D .S TXT="" D S1 .S TXT=$J("",4)_%MDP("B")_$J($$SHORT^W4NAME(MKBL),10)_" xvln "_%MDP("N") D S1 ; S TXT="" D S1 ; N HZM1 I HZM D .S HZM1=HZM .I $$MSPYOM^W4PRM S HZM1=$$^W4MSPYOM(HZM) .S TXT=$J("",14)_%MDP("BB")_$J(HZM1,7)_%MDP("N")_" dpnfd " D S1 .S TXT="" D S1 ; S TXT=$J("",2)_ZMANK_" : dpnfd zlaw onf " D S1 S TXT=$J($$T^%L1TIME($P($H,",",2)),22)_" : dqtcd onf" D S1 S TXT="" D S1 N FIRENM S FIRENM="F I R E" I $L($G(@$$^W4PRM@("FIRENM"))) D .S FIRENM=$G(@$$^W4PRM@("FIRENM")) I $G(NOFIRE) S FIRENM=FIRENM_" l e h i a" N SP S SP=$J("",14-$L(FIRENM)\2) S FIRENM="! "_SP_FIRENM_SP_" !" S TXT=%MDP("BB")_FIRENM_%MDP("N"),TXT("R")=1 D S1 S TXT=$C(10) D S1 I $G(HZM1) D .N L S L=19-$L(HZM1)\2 .N B S B=$G(%MDP("BB")) .N N S N=$G(%MDP("N")) .N INV S INV=$G(%MDP("I")) .N EI S EI=$G(%MDP("IE")) .N LN,TX S TX=$J("",L)_HZM1_$J("",L) S LN=$L(TX) .S TXT=B_INV_$J("",LN)_N_EI D S1 .S TXT=B_INV_TX_N_EI D S1 .S TXT=B_INV_$J("",LN)_N_EI D S1 ; S TXT=$C(10) D S1 D ^W4CUT(PRINT,%MDP("CUT")) I '$G(NOFIRE) D SET I $G(NOFIRE) D KILL L Q ; S1 S:$D(TXT("R")) TXT=%MDP("R")_TXT_%MDP("RL") S @$$^W4PC@(PRINT,$ZP(@$$^W4PC@(PRINT,999999))+1)=$J("",1)_$TR(TXT,TS0,TSS) K TXT Q ; S2 Q:'$G(PRINT) S @$$^W4PC@(PRINT,$ZP(@$$^W4PC@(PRINT,999999))+1)=TXT K TXT Q ; SET ; I $D(@$$^W4TMPORD@(1)) D .N TIME,MIN S TIME=$ZD($H,"24:60") .N TM S TM=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) .N LAST S LAST=$O(@$$^W4TMPORD@(9999),-1) .I LAST S @$$^W4TMPORD@("FIRE","SH",LAST)=TIME_";"_TM . .I $G(MDP) D ..K @$$^W4TMPORD@("NOFIRE","MDP",MDP) ..I $D(@$$^W4TMPORD@("NOFIRE","MDP"))<9 K @$$^W4TMPORD@("NOFIRE") ..S @$$^W4TMPORD@("FIRE","MDP",MDP)=TIME ..N FIRETM S FIRETM=$G(@$$^W4TMPORD@("FIRE","TIME",TM)) ..S (FIRETM,@$$^W4TMPORD@("FIRE","TIME",TM))=$S($L(FIRETM):FIRETM_","_MDP,1:MDP) ..S @$$^W4TMPORD@("FIRE")=TIME_" [ "_FIRETM_" ]" . .I '$G(MDP) D ..N FIRETM S FIRETM=$G(@$$^W4TMPORD@("FIRE","TIME",TM)) ..S (FIRETM,@$$^W4TMPORD@("FIRE","TIME",TM))="" ..S @$$^W4TMPORD@("FIRE")=TIME . .S @$$^W4TMPORD@("NEW","FIRE")=$H ; ; I '$D(@$$^W4TMPORD@(1)) D .N HZM S HZM=$$GETP^%W1PRM("HZM") .I HZM'>0,$$GETP^%W1PRM("NMB") S HZM=$$^W4HZFR($$GETP^%W1PRM("NMB")) .; .I HZM<1 Q .N TIME,MIN S TIME=$ZD($H,"24:60") .N TM S TM=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) .N TMPF S TMPF=$$^W4MAIN("TMPF") K @TMPF .N RES S RES=$$^W4GETHZ(HZM,TMPF) .N LAST S LAST=$O(@TMPF@(99999),-1) .I LAST S @$$^W4ORD@(HZM,"FIRE","SH",LAST)=TIME_";"_TM .K @TMPF .; .I $G(MDP) D ..K @$$^W4ORD@(HZM,"NOFIRE","MDP",MDP) ..I $D(@$$^W4ORD@(HZM,"NOFIRE","MDP"))<9 K @$$^W4ORD@(HZM,"NOFIRE") ..S @$$^W4ORD@(HZM,"FIRE","MDP",MDP)=TIME ..N FIRETM S FIRETM=$G(@$$^W4ORD@(HZM,"FIRE","TIME",TM)) ..S (FIRETM,@$$^W4ORD@(HZM,"FIRE","TIME",TM))=$S($L(FIRETM):FIRETM_","_MDP,1:MDP) ..S @$$^W4ORD@(HZM,"FIRE")=TIME_" [ "_FIRETM_" ]" . .I '$G(MDP) D ..N FIRETM S FIRETM=$G(@$$^W4ORD@(HZM,"FIRE","TIME",TM)) ..S (FIRETM,@$$^W4ORD@(HZM,"FIRE","TIME",TM))="" Q ; ; KILL ; N TIME S TIME=$ZD($H,"24:60") N TM S TM=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) N LAST S LAST=$O(@$$^W4TMPORD@(999),-1) I LAST S @$$^W4TMPORD@("NOFIRE","SH",LAST)=TIME_";"_TM ; I $G(MDP) D .K @$$^W4TMPORD@("FIRE","MDP",MDP) .I $D(@$$^W4TMPORD@("FIRE","MDP"))<9 K @$$^W4TMPORD@("FIRE") .S @$$^W4TMPORD@("NOFIRE","MDP",MDP)=TIME ; N NOFIRETM S NOFIRETM=$G(@$$^W4TMPORD@("NOFIRE","TIME",TM)) S (NOFIRETM,@$$^W4TMPORD@("NOFIRE","TIME",TM))=$S($L(NOFIRETM):NOFIRETM_","_$G(MDP),1:$G(MDP)) S @$$^W4TMPORD@("NOFIRE")=TIME_" [ "_NOFIRETM_" ]" S @$$^W4TMPORD@("FIRE")="" Q ; ISFIRE(CD) ; N NM S NM=$$SHEM^W4P(CD) Q $$ISFIRENM(NM) ; ISFIRENM(NM) ; I NM["FIRE" Q 1 I NM["UP!" Q 1 Q 0 ; ISFIREORD(ORD) ; I $$FIRE^W4HZMST(ORD)'="" Q 1 Q 0 W4FIRE0 W4FIRE(HZM,MDP,NOFIRE) ; [ 13.05.15 20:42 ] [ 11.05.15 10:38 ] [ 23.03.14 09:27 ] N I,TXT,%MDP,NMB,MKBL,ZMANK,FIRE,PRINT,MKBL I HZM D .S NMB=$$NMB^W4HZMST(HZM) .S MKBL=$$MKBL^W4HZMST(HZM) .S ZMANK=$$ZMANK^W4HZMST(HZM) ; I 'HZM D .S NMB=$$NMB^W3HZMST(JB) .S MKBL=$$MKBL^W3HZMST(JB) .S ZMANK=$$DATCB^W3HZMST(JB) ; D ^W4MDP(MDP) Q:'$G(PRINT) D ^%L1TS S PRINT=$P(PRINT,"-")_"-99" ; F I=1:1:5 Q:'$D(@$$^W4GL("P1LOCK")@("PCHZ")) H 1 ; S TXT=$G(%MDP("BEEP"))_$G(%MDP("BEEP")) D S2 S TXT=%MDP("B")_$J("",8)_$J(NMB,3)_" ogley "_%MDP("N"),TXT("R")=1 D S1 S TXT=$J("",4)_%MDP("B")_$J($$SHORT^W4NAME(MKBL),10)_" xvln "_%MDP("N") D S1 I HZM S TXT=$J("",21)_$J(HZM,7)_" dpnfd " D S1 S TXT=$J("",2)_ZMANK_" : dpnfd zlaw onf " D S1 S TXT=$J($$T^%L1TIME($P($H,",",2)),22)_" : dqtcd onf" D S1 S TXT="" D S1 S TXT=%MDP("B")_$S($G(NOFIRE):" F I R E l e h i a ",1:" F I R E !!! ")_%MDP("N"),TXT("R")=1 D S1 S TXT="" D S1 D ^W4CUT(PRINT,%MDP("CUT")) I '$G(NOFIRE) D SET I $G(NOFIRE) D KILL Q ; S1 S:$D(TXT("R")) TXT=%MDP("R")_TXT_%MDP("RL") L +@$$^W4PC@(PRINT):5 S @$$^W4PC@(PRINT,$ZP(@$$^W4PC@(PRINT,999999))+1)=$J("",1)_$TR(TXT,TS0,TSS) K TXT L Q ; S2 Q:'$G(PRINT) L @$$^W4PC@(PRINT):5 S @$$^W4PC@(PRINT,$ZP(@$$^W4PC@(PRINT,999999))+1)=TXT K TXT L Q ; SET ; I $D(@$$^W4TMPORD@(1)) D .N TIME,MIN S TIME=$ZD($H,"24:60") .N TM S TM=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) .N LAST S LAST=$O(@$$^W4TMPORD@(999),-1) .I LAST S @$$^W4TMPORD@("FIRE","SH",LAST)=TIME_";"_TM . .I $G(MDP) D ..K @$$^W4TMPORD@("NOFIRE","MDP",MDP) ..I $D(@$$^W4TMPORD@("NOFIRE","MDP"))<9 K @$$^W4TMPORD@("NOFIRE") ..S @$$^W4TMPORD@("FIRE","MDP",MDP)=TIME ..N FIRETM S FIRETM=$G(@$$^W4TMPORD@("FIRE","TIME",TM)) ..S (FIRETM,@$$^W4TMPORD@("FIRE","TIME",TM))=$S($L(FIRETM):FIRETM_","_MDP,1:MDP) ..S @$$^W4TMPORD@("FIRE")=TIME_" [ "_FIRETM_" ]" . .I '$G(MDP) D ..N FIRETM S FIRETM=$G(@$$^W4TMPORD@("FIRE","TIME",TM)) ..S (FIRETM,@$$^W4TMPORD@("FIRE","TIME",TM))="" ..S @$$^W4TMPORD@("FIRE")=TIME ; Q ; ; KILL ; N TIME S TIME=$ZD($H,"24:60") N TM S TM=$P($H,",")_$TR($J($P($H,",",2),5)," ",0) N LAST S LAST=$O(@$$^W4TMPORD@(999),-1) I LAST S @$$^W4TMPORD@("NOFIRE","SH",LAST)=TIME_";"_TM ; I $G(MDP) D .K @$$^W4TMPORD@("FIRE","MDP",MDP) .I $D(@$$^W4TMPORD@("FIRE","MDP"))<9 K @$$^W4TMPORD@("FIRE") .S @$$^W4TMPORD@("NOFIRE","MDP",MDP)=TIME ; N NOFIRETM S NOFIRETM=$G(@$$^W4TMPORD@("NOFIRE","TIME",TM)) S (NOFIRETM,@$$^W4TMPORD@("NOFIRE","TIME",TM))=$S($L(NOFIRETM):NOFIRETM_","_$G(MDP),1:$G(MDP)) S @$$^W4TMPORD@("NOFIRE")=TIME_" [ "_NOFIRETM_" ]" Q ; ISFIRE(CD) ; N NM S NM=$$SHEM^W4P(CD) Q $$ISFIRENM(NM) ; ISFIRENM(NM) ; I NM["FIRE" Q 1 I NM["UP!" Q 1 Q 0 ; ISFIREORD(ORD) ; I $$FIRE^W4HZMST(ORD)'="" Q 1 Q 0 W4FNDDLV W4FNDDLV ; [ 25.11.24 12:56 ] [ 14.02.24 14:12 ] [ 15.07.23 07:14 ] N (JB,%ARG,%REM) I $$DLV^W4DLVCSR D ^W4IN N TDWIDTH,TDALIGN,TDDIR ; N MSD S MSD=$$GET^%W1PRM("MSD") ; D PUT^%W3DEB("W3FNDLK","MSD=MSD") ; W "
    ",! W "
    ",! ; W "" W $$^%W1DICT("INPUTORDERDETAILSFORSEARCH") W "",! ; W "

    ",! ; W "",! W "" W "",! W "" W "",! W "",! W "",! ; W "" D NAME D COMP W "",! ; W "",! D TELB D PELE W "",! ; W "",! D TDR W $$^%W1DICT("CITY") W "" D TDL D .N FNDDLV S FNDDLV="" .D SELCITY^W3ORDDET("CITY") W "" D TDR W $$^%W1DICT("MAKOR") W "" D TDL D MKR^W3ORDLKH("") W "" W "",! ; W "" D TDR W $$^%W1DICT("MEDATE") W "" W "" ; D TDR W $$^%W1DICT("TODATE") W "" ; W "" W "",! ; W "" D TDR W $$^%W1DICT("FROMSUM") W "" D TDL W " " W " " W "" D TDR W $$^%W1DICT("TOSUM") W "" D TDL W "" W " " W "" W "",! ; W "" I '$$MM^W4PRM D .D TDR . W $$^%W1DICT("CUSTOMERORDER") .W "" .D TDL . W "" . W "  " .W "" ; I $$MM^W4PRM D .D TDR . W $$^%W1DICT("RESTAURANT") .W "" .W "" ; D TDR W $$^%W1DICT("CREDITCARD4") W "" D TDL W "" W " " W "" W "",! ; W "" D TDR W $$^%W1DICT("COURIERNUMBER") W "" D TDL D .W "",! W "" ; D TDR W $$^%W1DICT("RECEIVERNUMBER") W "" D TDL D .W "",! W "" W "",! W "",! D TDR W $$^%W1DICT("KINDOFORDER") W "" W "" ; D TDR W $$^%W1DICT("KINDOFPAYMENT") W "" ; W "" W "",! ; D PCLINE ; W "
    "_$$^%W1DICT("ORDERNUMBER")_"  ",! W $$NBSP^%L1FRM(5) D SELKINDNMB W ""_$$^%W1DICT("CODEORTEL")_" 
    " ;;S %W1DAT("NODAY")="" D ^%W1DAT("MEDAT",$G(P1DZ)) W "" W "" W "" ;;W "" W "" ; I $$1024^W4WDSCR W "" W "" ; W "" W "",! W "
    " ;; W "" ;;W "" N SM S SM=0 ;365 D ^%W1DAT("ADDAT",$G(P1DZ)+SM) W "
    " W $$^%W1DICT("ORDDATE") W "" W "" W $$^%W1DICT("ORDRCVDATE") W "" W "
    ",! W "
    " . W "",! .W "
    " D KINDORDS^W4DLVORD W "" D PAYMKIND1^W4DLVORD W "
    ",! W "
    ",! ; W "
    ",! W "

     

    ",! ; W "
    ",! ; W "",! W " ",! ;;D BTN^W3ORDDET("rbtfind",$$^%W1DICT("SEARCHORDER"),"FindOrd()","background-color:green;color:white;font-size:"_$$^W3FSZ(18)) ;;D BTN^W3ORDDET("rbtback",$$^%W1DICT("BACK"),"Back()","background-color:red;color:white;font-size:"_$$^W3FSZ(18)) ; W "" W "" W " ",! W "
    " D ^W4BTN($$^%W1DICT("SEARCHORDER"),"FindOrd()","green<>white",,,12) W "" D ^W4BTN($$^%W1DICT("BACK"),"Back()","red<>white",,,12) W "
    ",! ; W "
    ",! I $$KBVRT^W4PRM D ^W4KBABC Q ; TELB D TD W " "_$$^%W1DICT("TEL")_"" W "  " D INP("TELB",100,12,"LTR") Q PELE D TD W " "_$$^%W1DICT("MOBIL")_"" W " " D INP("PELE",100,12,"LTR") Q NAME D TD W " "_$$^%W1DICT("NAME")_"" W "  " D INP("NAME",160,30,$$^%W1DIR) Q COMP D TD W " "_$$^%W1DICT("COMPANYNAME")_"" W " " D INP("COMP",160,30,$$^%W1DIR) Q ; TD ; W "",! K TDSPAN,TDWIDTH,TDALIGN,TDDIR Q ; INP(RKV,WD,SIZE,DIR) ; D .W "9 D ...W " onKeyUp=""FindStreet(this)""" . .W $$INPBGCOLOR^W3ORDDET . .W " tabindex="""_$$TABIND^W3ORDDET(RKV)_""" " .W " />" .I RKV="NAME" D ..W " ",! W "",! Q ; PCLINE ; W " ",! Q ; TDR ; W "" Q ; TDL ; W "" ;;W "" Q ; SELKINDNMB ; W "",! Q W4FNDHZM W4FNDHZM ; [ 15.06.22 13:58 ] [ 14.01.22 07:43 ] [ 11.01.22 05:47 ] N (JB,%ARG,%REM) D ^W4IN N TDWIDTH,TDALIGN,TDDIR ; D CLRCOPY^W4MENU ; N MSD S MSD=$$GET^%W1PRM("MSD") ; D PUT^%W3DEB("W3FNDLK","MSD=MSD") ; W "
    ",! W "
    ",! ; W "" W $$^%W1DICT("INPUTORDERDETAILSFORSEARCH") W "",! ; W "

    ",! ; S WD=80 I $$1024^W4WDSCR S WD=90 I $$^W4TABLET=2 G TBLPHONE ; W "",! D PCLINE ; W "" W "",! W "",! ; D TDR W $$^%W1DICT("TABLEORCUSTOMNUMBER") W "" W "" W "",! ; W "" W " " D TDR W $$^%W1DICT("MEDATE") W "" W "" D TDR W $$^%W1DICT("TODATE") W "" W "" W "",! ; W "" D TDR W $$^%W1DICT("FROMSUM") W "" D TDL W " " W $$NBSP^%L1FRM(2) W "" D TDR W $$^%W1DICT("TOSUM") W "" D TDL W "" W $$NBSP^%L1FRM(4) W "" W "",! ; W "" D TDR W $$^%W1DICT("CREDITCARD4") W "" D TDL W "" W $$NBSP^%L1FRM(3) W "" W "" W "",! ; ; D PCLINE W "
    "_$$^%W1DICT("ORDERNUMBER")_"" W $$NBSP^%L1FRM(3) W "",! W ""_$$NBSP^%L1FRM(3) W " " W "  ",! W "
    " D ^%W1DAT("MEDAT",$G(P1DZ)) W "" ;;S %W1DAT("NODAY")="" D ^%W1DAT("ADDAT",$G(P1DZ)) W "
     
    ",! W "
    ",! ; W "
    ",! W "
    ",! ; W "",! W " ",! D BTN^W3ORDDET("rbtfind",$$^%W1DICT("SEARCHORDER"),"FindOrd()","background-color:green;color:white;font-size:18") D BTN^W3ORDDET("rbtback",$$^%W1DICT("BACK"),"Back()","background-color:red;color:white;font-size:18") W " ",! W "
    ",! ; W "
    ",! Q ; TELB D TD W " "_$$^%W1DICT("TEL")_"" W "  " D INP("TELB",100,12,"LTR") Q PELE D TD W " "_$$^%W1DICT("MOBIL")_"" W " " D INP("PELE",100,12,"LTR") Q NAME D TD W " "_$$^%W1DICT("NAME")_"" W "  " D INP("NAME",160,30,$$^%W1DIR) Q COMP D TD W " "_$$^%W1DICT("COMPANYNAME")_"" W " " D INP("COMP",160,30,$$^%W1DIR) Q ; TD ; W "",! K TDSPAN,TDWIDTH,TDALIGN,TDDIR Q ; INP(RKV,WD,SIZE,DIR) ; D .W "" W "",! Q ; PCLINE ; W " ",! Q ; TDR ; W "" Q ; TDL ; W "" Q ; SHOW(N) ; Q 1 ; SETPRM(PRM) ; N VP S VP="FNDORD" D PRS^%L1FRM(PRM,"NMB;MEDAT;ADDAT;MESUM;ADSUM;NCA",";") D KILL^W4TMPANS(VP) D PUT^W4TMPANS(VP,"MEDATE",MEDAT) D PUT^W4TMPANS(VP,"ADDATE",ADDAT) D PUT^W4TMPANS(VP,"CREDITCARDNUMBER",NCA) D PUT^W4TMPANS(VP,"HZMLK","") D PUT^W4TMPANS(VP,"FROMSUM",MESUM) D PUT^W4TMPANS(VP,"UNTILSUM",ADSUM) ; I NMB D .D PUT^W4TMPANS(VP,"FROMTABLE",NMB) .D PUT^W4TMPANS(VP,"UNTILTABLE",NMB) ; I 'NMB D .D PUT^W4TMPANS(VP,"FROMTABLE","") .D PUT^W4TMPANS(VP,"UNTILTABLE",99999999999) ; D PUT^W4TMPANS(VP,"KINDOFORDER","") D PUT^W4TMPANS(VP,"KINDOFPAYMENT","") Q 1 ; ; TBLPHONE ; W "",! D PCLINE ; W "" W "",! W "",! W "",! ; W "" D TDR W $$^%W1DICT("TABLEORCUSTOMNUMBER") W "" W "" W "",! ; W "" W " " D TDR W $$^%W1DICT("MEDATE") W "" W "" W "",! ; W "" D TDR W $$^%W1DICT("TODATE") W "" W "" W "",! ; W "" D TDR W $$^%W1DICT("FROMSUM") W "" D TDL W $$NBSP^%L1FRM(3) W " " W "  " W "" W "" ; W "" D TDR W $$^%W1DICT("TOSUM") W "" D TDL W "" W $$NBSP^%L1FRM(3) W "" W "",! ; W "" D TDR W $$^%W1DICT("CREDITCARD4") W "" D TDL W "" W $$NBSP^%L1FRM(3) W "" W "" W "",! ; ; D PCLINE W "
    "_$$^%W1DICT("ORDERNUMBER")_"" W $$NBSP^%L1FRM(3) W "" W "
    " W $$NBSP^%L1FRM(2) W " " W "  ",! W "
    " W $$NBSP^%L1FRM(3) D ^%W1DAT("MEDAT",$G(P1DZ)) W "
    " ;;S %W1DAT("NODAY")="" W $$NBSP^%L1FRM(3) D ^%W1DAT("ADDAT",$G(P1DZ)) W "
     
    ",! W "
    ",! ; W "

    ",! W "
    ",! W "",! W " ",! D BTN^W3ORDDET("rbtfind",$$^%W1DICT("SEARCHORDER"),"FindOrd()","background-color:green;color:white;font-size:"_$$^W3FSZ(16)_"""") D BTN^W3ORDDET("rbtback",$$^%W1DICT("BACK"),"Back()","background-color:red;color:white;font-size:"_$$^W3FSZ(16)_"""") W " ",! W "
    ",! ; W "
    ",! Q W4FNDORD W4FNDORD ; [ 23.01.17 15:11 ] [ 15.07.16 12:53 ] [ 31.08.10 15:51 ] N (JB,%ARG,%REM) D VW("FNDORD") Q Q ; VW(VP) ; W "
    ",! ; N VZ S VZ=$G(%ARG("VZ"),"SUM") ; I $$LASTSTAGE^W4SCASK()'?.P D ; -- SHOW PREVIOUS ANSWERS .D CRTMPSHOW .Q:'$D(@$$^W4MAIN("TMPSHOW")) .N NP,K S NP="" F K=1:1 S NP=$O(@$$^W4MAIN("TMPSHOW")@(NP)) Q:NP="" .N WD S WD=12*K S:WD>90 WD=90 .S WD=WD_"%" .W "
    ",! .W "",! .W "",! .N NP S NP="" F S NP=$O(@$$^W4MAIN("TMPSHOW")@(NP)) Q:NP="" D ..S A=$G(^(NP)) ..S NM=$P(A,";") ..D TH W $$^%W1DICT(NM)_"",! .W "",! .W "",! .N NP S NP="" F S NP=$O(@$$^W4MAIN("TMPSHOW")@(NP)) Q:NP="" D ..S A=$G(^(NP)) ..S VL=$P(A,";",2) .. ..W "",! .W "",! .W "
    "_$$RKV(VL)_"
    ",! .W "
    ",! ; D ; .I '$L($G(%ARG("VZ"))) Q . .D VWTBL(VP,%ARG("VZ"),"W4ASK","W4TMPANS") . .Q:'$G(%ARG("END")) Q:$G(%ARG("VZ"))'="SUM" .W "

    ",! ; END W "
    ",! Q ; ; CRTMPSHOW ; N N,VZ,A,VL,NM,CD S VZ="SHOWTMP" K @$$^W4MAIN("TMPSHOW") S N="" F S N=$O(^[$$^W3MAIN]W4ASK(VP,VZ,N)) Q:N="" D .S A=$G(^(N)) .S CD=$P(A,";") Q:CD="" .I '$D(@$$^W4TMPANS@(VP,CD)) Q .N OK S OK=1 .I $L($G(%ARG("VZ"))) D ..N N1 S N1="" F S N1=$O(@$$^W4ASK@(VP,%ARG("VZ"),N1)) Q:N1="" D Q:'OK ...I $P($G(^(N1)),";")=CD S OK=0 .Q:'OK .S VL=$$GET^W4TMPANS(VP,CD) .I VL["::" S VL=$$^%W1DICT($P(VL,"::",2)) .S @$$^W4MAIN("TMPSHOW")@(N)=$P(A,";")_";"_VL Q ; ; VWTBL(VP,VZ,GLZ,GLTMP) W "
    ",! W "",! ; N J S J=0 N GL D @("GL^"_GLZ) ; GL=TMPZ N NP S NP="" F S NP=$O(@GL@(VP,VZ,NP)) Q:NP="" D .S J=J+1 .N CD X "S CD=$$NM^"_GLZ_"(VP,VZ,NP)" .I CD="" D TH W " " W "",! Q .D TH W $$^%W1DICT(CD)_"",! N MAXJ S MAXJ=J W "",! ; W "" S NS=1 S NP="" F S NP=$O(@GL@(VP,VZ,NP)) Q:NP="" D .N NM,VL .X "S CD=$$NM^"_GLZ_"(VP,VZ,NP)" .X "S VL=$$GET^"_GLTMP_"(VP,CD)" .I VL["::" S VL=$$^%W1DICT($P(VL,"::",2)) .W "" W "",! W "
    " .W $$RKV(VL)_"
    ",! Q ; TH W "" Q ; STYLEBOLD(STAM) ; Q "style=""text-align:center;font-weight:bold;"_$$FONTFM^W3CSS_"""" ; RKV(VL) ; I VL="" Q " " Q $$H2U^%L1FRM(VL) ; ORDNMB ; Q:'$L(VL) ;;D NOZERO Q ; FROMTABLE ; Q:'$L(VL) D NOZERO Q ; UNTILTABLE ; Q:'$L(VL) D NOZERO I VL<$$GET^W4TMPANS(VP,"FROMTABLE") D .S %SC("ER")=1 .S %SC("ER","MSG")="TABLERANGEWRONG" Q ; FROMDATE ; Q:'$L(VL) D VLDAT Q:$G(%SC("ER")) Q ; UNTILDATE ; Q:'$L(VL) D NOZERO Q:$G(%SC("ER")) D VLDAT Q:$G(%SC("ER")) I $$^%L1DC(VL,3)<$$^%L1DC($$GET^W4TMPANS(VP,"MEDATE"),3) D .S %SC("ER")=1 .S %SC("ER","MSG")="DATETOOSMALL" Q ; FROMSUM ; Q:'$L(VL) D VLDNMB Q:$G(%SC("ER")) Q ; UNTILSUM ; Q:'$L(VL) D VLDNMB I VL<$$GET^W4TMPANS(VP,"FROMTABLE") D .S %SC("ER")=1 .S %SC("ER","MSG")="SUMTOOSMALL" Q ; VLDAT ; I VL'?6N D Q .S %SC("ER")=1 .S %SC("ER","MSG")="NDIGITSONLY;6" I $E(VL,1,2)<1!($E(1,2)>31)!($E(VL,3,4)<1)!($E(VL,3,4)>12) D Q .S %SC("ER")=1 .S %SC("ER","MSG")="DATENOTVALID" Q ; CRCARD ; Q:'$L(VL) D VLDNMB Q ; NOZERO ; D VLDNMB Q:$D(%SC("ER")) I 'VL D Q .S %SC("ER")=1 .S %SC("ER","MSG")="NOZERO" Q ; VLDNMB ; I VL'?."-"1N.N.".".N D Q .S %SC("ER")=1 .S %SC("ER","MSG")="NUMBERONLY" Q ; DIR(VL) I $TR(VL,".-","")?1N.N Q " dir=""LTR"" " Q "" W4FNDPLG W4FNDPLG(IR,STREET,HOME) ; [ 25.08.17 16:40 ] [ 24.08.17 10:21 ] [ Q 0 W4FNDSET W4FNDSET ; [ 27.03.23 12:14 ] [ 26.03.23 13:23 ] [ N (JB,%ARG,%REM) W "
    ",! I $G(%ARG("SET")) D SHOWSET(%ARG("SET")) G BCK ; S GL=$$^W4GL("P1SET") W "

    " W $$^%W1DICT("ITEMSSETLIST") W "

    ",! W "

    ",! ; S ID=$G(%ARG("ID")) Q:ID="" ; W "",! S N="" F S N=$O(@GL@(N)) Q:N="" D .S A=$G(^(N)) Q:A="" .W "" . W "",! . W "",! .W "",! W "
    "_$$H2U^%L1FRM(A)_"
    ",! BCK ; W "

     

    ",! S W4BCK("SZ")=12 D ^W4BCK W "
    ",! Q ; SHOWSET(SET) ; N N,GL,NM,MH,A W "

    " W $$H2U^%L1FRM($G(@$$^W4GL("P1SET")@(SET))) W "

    ",! W "

    ",! S GL=$$^W4GL("P1SET")_"("""_SET_""")" ; W "",! S N="" F S N=$O(@GL@(N)) Q:N="" D .S NM=$$SHEM^W4P(N) .S MH=$$MH^W4P(N) .W "" . W "",! . W "",! . W "",! .W "",! W "
    "_N_""_$$H2U^%L1FRM(NM)_""_$J(MH,2,2)_"
    ",! Q W4FRSMLG W4FRSMLG(STAM) ; [ 07.02.14 21:44 ] [ 29.12.13 09:23 ] [ 24.02.12 19:06 ] [ N GLSUG S GLSUG=$$GLSUGP^W4MLPRTB Q $O(@GLSUG@("")) W4FZ W4FZ(P1DZ) ; [ 05.05.09 07:52 ] [ 04.02.01 10:20 AM ] [ 05/23/98 1:24 PM ] Q $G(@$$^W4GL("Z"))+1 W4GAP W4GAP(JB,DT1,DT2,SND) ; [ 13.03.24 10:57 ] [ 12.05.23 06:47 ] [ 07.12.21 11:45 ] D ^W4GAPN(JB,DT1,$G(DT2),$G(SND)) Q N (JB,%ARG,%REM,DT1,DT2,SND) I '$G(DT2) S DT2=DT1 I $G(SND)="" S SND=1 I DT2'=DT1 S SND=0 K @$$^W4MAIN("S111") ; D SCOMP^W4TOT(DT1,DT2) ; S MHIROT=0 F DT=DT1:1:DT2 D .S MHIROT=MHIROT+$$MHIROT^W4GAPNET(DT) ; S MHIROT0=MHIROT S SDLV=MHIROT-SREST ; S DT=DT2 S TKF=$ZD(DT,"YYYYMMDD") S ST=TKF ; -- 1 I DT2'=DT1 S TKF=$ZD(DT1,"YYYYMMDD")_" - "_$ZD(DT2,"YYYYMMDD") I DT2'=DT1 S TKF=$ZD(DT1,"YYYYMMDD")_" - "_$ZD(DT2,"YYYYMMDD") I 'SND D .N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 .S @$$^W4MAIN("S111")@(SH)=$$TV^%W1DICT("H","DATABEFORETAX") . .S TKF=$E(TKF,7,8)_"."_$E(TKF,5,6)_"."_$E(TKF,1,2)_" - "_$E(TKF,18,19)_"."_$E(TKF,16,17)_"."_$E(TKF,14,15) .D S1(TKF,"PERIOD") . .N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 .S @$$^W4MAIN("S111")@(SH)=$TR($J("",39)," ","-") ; S TIM=$ZD($H,"YYYYMMDD:246060") S ST=ST_","_TIM ; -- 2 ;;D S1(TIM,"SENDINGTIME") ; -- 01/07/21 ; S UFC="+0200" S ST=ST_","_UFC ;;_$G(@$$^W4PRM@("GAP","UFC")) ; -- 3 ;;D S1(UFC,"UFC") ; -- 01/07/21 ; S COUNTRYCD=376 S ST=ST_","_COUNTRYCD ; -- 4 ;;D S1(COUNTRYCD,"COUNTRYCD") ; -- 01.07.21 ; S COUNTRYNM="ISR" S ST=ST_","_COUNTRYNM ; -- 5 ;;D S1(COUNTRYNM,"COUNTRYNM") ; -- 01.07.21 ; S SID=$G(@$$^W4PRM@("GAP","ID")) S ST=ST_","_SID ; -- 6 ;;D S1(SID,"STORYID") ; -- 01.07.21 ; S DIR=$G(@$$^W4PRM@("GAP","DIR")) S OK=0 F I=1:1 D Q:OK .S FLNM=DIR_$ZD(DT,"YYYYMMDD")_"_"_SID_"_DPJI_BI_"_I_".POL" .I '$$EXIST^%L1ZOS(FLNM) S OK=1 ; S VER=I_".00" S ST=ST_","_VER ; -- 7 ;;D S1(VER,"FILEVERSION") ; -- 01.07.21 ; S ST=ST_",ELPOS"; -- 8 ;;D S1("ELPOS","BOSOFTNAME") ; -- 01.07.21 ; S VERBO="2.00" S ST=ST_","_VERBO ; -- 9 ;;D S1(VERBO,"VERBO") ; -- 01.07.21 ; S ST=ST_",ELPOS" ; -- 10 S ST=ST_",2.00"; -- 11 S ST=ST_",Normal" ; -- 12 ; ;;S MHIROT=$$LMAM(SDLV+SREST) ; S MHIROT=$$LMAM(MHIROT) S ST=ST_","_$$INT(MHIROT) ; -- 13 D S1(MHIROT,"TOTSALES") ; S SWEB=$$LMAM(SWEB) S ST=ST_","_$$INT(SWEB) ; -- 14 D S1(SWEB,"WEBSALES") ; S SWEBDLV=$$LMAM(SWEBDLV) S ST=ST_","_$$INT(SWEBDLV) ; -- 15 D S1(SWEBDLV,"DLVWEBSALES") ; S SDLV=$$LMAM(SDLV) S STAW=$$LMAM(STAW) S ST=ST_","_$$INT(SDLV) ; -- 16 D S1(SDLV-STAW,"DLVSALES") ; S SREST=$$LMAM(SREST) S ST=ST_","_$$INT(SREST) ; -- 17 D S1(SREST,"RESTSALES") ; S ST=ST_","_$$INT(SMAM) ; -- 18 D S1(SMAM,"TAXES") ; S ST=ST_",0,0,0" ; -- 19,20,21 ; S ST=ST_","_$$INT($$LMAM(SBIT)) ; -- 22 D S1(SBIT,"CANCELLATIONS") 11 ; S ST=ST_","_ORDQ ; -- 23 D S1(ORDQ,"ORDERSNUMBER") ; S ST=ST_","_WEBQ ; -- 24 D S1(WEBQ,"WEBORDERSNUMBER") ; S ST=ST_","_(DLVQ-TAWQ) ; -- 25 D S1(DLVQ-TAWQ,"DLVORDERSNUMBER") ; S ST=ST_","_RESTQ ; -- 26 D S1(RESTQ,"RESTORDERSNUMBER") ; S ST=ST_",000" ; -- 27 - ?? S ST=ST_","_SMIN_".00" ; -- 28 - ?? D S1(SMIN,"ORDERSDLVTIME") ; S TIMWARM="0.00" ; ? S ST=ST_","_TIMWARM ; -- 29 ;;D S1(TIMWARM,"AVRWARMTIME") ; -- 01/07/21 ; S ST=ST_","_(DLVQ-TAWQ-DLVDLYQ) ; -- 30 ; S BRUTTO=MHIROT0+SDISC S BRUTTO=$$LMAM(BRUTTO) S ST=ST_","_$$INT(BRUTTO) ; -- 31 D S1(BRUTTO,"BRUTTO") ; S SDISC=$$LMAM(SDISC) S ST=ST_","_$$INT(SDISC) ; -- 32 D S1(SDISC,"DISCOUNTS") ; ;;S STAW=$$LMAM(STAW) S ST=ST_","_$$INT(STAW) ; -- 33 D S1(STAW,"T.A.W TOTAL") ; S SWEBTAW=$$LMAM(SWEBTAW) S ST=ST_","_$$INT(SWEBTAW) ; -- 34 D S1(SWEBTAW,"WEB T.A.W TOTAL") ; S ST=ST_","_TAWQ ; -- 35 D S1(TAWQ,"T.A.W ORDERS") ; S ST=ST_","_WEBDLVQ ; -- 36 D S1(WEBDLVQ,"WEB ORDERS") ; S ST=ST_","_WEBTAWQ ; -- 37 D S1(WEBTAWQ,"WEB TAW ORDERS") ; S ST=ST_",0,0,0,0,0,0,0,0,0,0,0,0" ; I SND D .S DIR=$G(@$$^W4PRM@("GAP","DIR")) .S FILE=DIR_$ZD(DT,"YYYYMMDD")_"_"_SID_"_DPJI_BI_"_+VER_".POL" .C FILE:(DELETE) .O FILE:(NEWVERSION:REWIND:WRITE) .U FILE . W ST,! .C FILE .; .S USRPW="Israel1PJFTP:3bNwb7faya&L_5YaL4vY=" .S URL="https://files.papajohns.com" .S CMD="curl -k -s -T "_FILE_" -u """_USRPW_""" "_URL .; .ZSY CMD ; I 'SND D .N N S N="" F S N=$O(SMKR(N)) Q:N="" D ..D S1($J(SMKR(N),2,2),$$MKR1^W3MKR(N)_" k""dq") ..D S1($G(MKRQN(N)),$$MKR1^W3MKR(N)_" zepnfd 'qn") Q ; INT(SUM) ; I +SUM=0 Q "000" Q $P(SUM*100,".") ; S1(VL,TXCD) N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 S @$$^W4MAIN("S111")@(SH)=VL_" : "_$$TV^%W1DICT($$^%W1LNG,TXCD) Q ; LMAM(SUM) ; ;;I '$G(SND) Q $G(SUM) N MAMAH S MAMAH=$$MAMD^W4L(DT1) Q $J(SUM*100/(100+MAMAH),2,2) ; INTQ(VL) ; Q $P(VL,".") W4GAPN W4GAPN(JB,DT1,DT2,SND) ; [ 10.07.24 12:41 ] [ 05.05.24 07:15 ] [ 03.05.24 14:18 ] N (JB,%ARG,%REM,DT1,DT2,SND) I '$G(DT2) S DT2=DT1 I $G(SND)="" S SND=1 I DT2'=DT1 S SND=0 K @$$^W4MAIN("S111") ; D SCOMP^W4TOT(DT1,DT2) ; S MHIROT=0 S SH=0,SDIF=0 ; I '$$NOMAM^W4PRM S SMAM=0 F DT=DT1:1:DT2 D .I $$PAPJ^W4PRM D DEFMSD^W4GAPNET(DT) .N MHRDT S MHRDT=$$MHIROT^W4GAPNET(DT) .S MHIROT=MHIROT+MHRDT .S MAMAH=$$MAMD^W4L(DT) .I '$$NOMAM^W4PRM S SMAM=SMAM+(MHRDT*MAMAH/(100+MAMAH)) .S PRN="" F S PRN=$O(@$$^W4GL("W4BONA")@(DT,PRN)) Q:PRN="" D ..S DTTM="" F S DTTM=$O(@$$^W4GL("W4BONA")@(DT,PRN,DTTM)) Q:DTTM="" D ...S HZ="" F S HZ=$O(@$$^W4GL("W4BONA")@(DT,PRN,DTTM,HZ)) Q:HZ="" D ....S TIME=$G(^(HZ)) ....S TIME0=$E(DTTM,1,5)_","_+$E(DTTM,6,10) ....S DIF=$$DIF^%L1TIME(TIME,TIME0) ....S SDIF=SDIF+DIF ....S SH=SH+1 ; S MKTIME=0 I SDIF S MKTIME=$J(SDIF/SH,2,2) ; S MHIROT0=MHIROT S SDLV=MHIROT-SREST ; S DT=DT2 S TKF=$ZD(DT,"YYYYMMDD") S ST=TKF ; -- 1 I DT2'=DT1 S TKF=$ZD(DT1,"DD.MM.YY")_" - "_$ZD(DT2,"DD.MM.YY") ; I SND<1 D .N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 .S @$$^W4MAIN("S111")@(SH)=$$TV^%W1DICT("H","DATABEFORETAX") . .D S1(TKF,"PERIOD") . .N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 .S @$$^W4MAIN("S111")@(SH)=$TR($J("",39)," ","-") ; S TIM=$ZD($H,"YYYYMMDD:2460SS") S ST=ST_","_TIM ; -- 2 I $$SHOW D S1(TIM,"ISSUETIME") ; S UFC="+0200" S ST=ST_","_UFC ;;_$G(@$$^W4PRM@("GAP","UFC")) ; -- 3 I $$SHOW D S1(UFC,"UFC") ; S COUNTRYCD=376 S ST=ST_","_COUNTRYCD ; -- 4 I $$SHOW D S1(COUNTRYCD,"COUNTRY_CODE") ; S COUNTRYNM="ISR" S ST=ST_","_COUNTRYNM ; -- 5 I $$SHOW D S1(COUNTRYNM,"COUNTRY_NAME") ; S SID=$G(@$$^W4PRM@("GAP","ID")) S ST=ST_","_SID ; -- 6 I $$SHOW D S1(SID,"STORE_ID") ; S DIR=$G(@$$^W4PRM@("GAP","DIR")) S OK=0 F I=1:1 D Q:OK .S FLNM=DIR_$ZD(DT,"YYYYMMDD")_"_"_SID_"_DPJI_BI_"_I_".POL" .I '$$EXIST^%L1ZOS(FLNM) S OK=1 ; S VER=I_".00" S ST=ST_","_VER ; -- 7 I $$SHOW D S1(VER,"FILE_VERSION") ; -- 01.07.21 ; S ST=ST_",ELPOS"; -- 8 I $$SHOW D S1("ELPOS","BO_SOFTNAME") ; -- 01.07.21 ; S VERBO="2.00" S ST=ST_","_VERBO ; -- 9 I $$SHOW D S1(VERBO,"BO_VERSION") ; -- 01.07.21 ; S ST=ST_",ELPOS" ; -- 10 I $$SHOW D S1("ELPOS","POS_NAME") ; -- 01.07.21 ; S ST=ST_",2.00"; -- 11 I $$SHOW D S1("2.00","POS_VERSION") ; -- 01.07.21 ; S INFO=$S(VER>1:"UPDATE",1:"NORMAL") S ST=ST_","_INFO I $$SHOW D S1(INFO,"INFO") ; S ST=ST_","_$$INT(MHIROT) ; -- 13 D S1($$NUM(MHIROT),"TOTSALES") ; S SWEB=$$LMAM(SWEB) S ST=ST_","_$$INT(SWEB) ; -- 14 D S1($$NUM(SWEB),"WEBSALES") ; S SWEBDLV=$$LMAM(SWEBDLV) S ST=ST_","_$$INT(SWEBDLV) ; -- 15 D S1($$NUM(SWEBDLV),"DLVWEBSALES") ; S SDLV=$$LMAM(SDLV) S STAW=$$LMAM(STAW) S ST=ST_","_$$INT(SDLV-STAW) ; -- 16 D S1($$NUM(SDLV-STAW),"DLVSALES") ; S SREST=$$LMAM(SREST) S ST=ST_","_$$INT(SREST) ; -- 17 D S1($$NUM(SREST),"RESTSALES") ; S ST=ST_","_$$INT(SMAM) ; -- 18 D S1($$NUM(SMAM),"TAXES") ; S ST=ST_",0,0,0" ; -- 19,20,21 ; S ST=ST_","_$$INT($$LMAM(SBIT)) ; -- 22 D S1($$NUM(SBIT),"REFUNDS") 11 ; S ST=ST_","_ORDQ ; -- 23 D S1(ORDQ,"ORDERSNUMBER") ; S ST=ST_","_WEBQ ; -- 24 D S1(WEBQ,"WEBORDERSNUMBER") ; S ST=ST_","_(DLVQ-TAWQ) ; -- 25 D S1(DLVQ-TAWQ,"DLVORDERSNUMBER") ; S ST=ST_","_RESTQ ; -- 26 D S1(RESTQ,"RESTORDERSNUMBER") ; S ST=ST_",000" ; -- 27 - ACTUAL FOOD COST I $$SHOW D S1("000","FOODCOST") ; S ST=ST_","_SMIN_".00" ; -- 28 - ?? D S1(SMIN,"ORDERSDLVTIME") ; -- LIVDOK ; S TIMWARM="0.00" ; ? S ST=ST_","_TIMWARM ; -- 29 I $$SHOW D S1(TIMWARM,"AVRWARMTIME") ; S DLVOTDQ=DLVQ-TAWQ-DLVDLYQ S ST=ST_","_DLVOTDQ ; -- 30 ; -- LIVDOK D S1(DLVOTDQ,"OTDORDERSNUMBER") ; S BRUTTO=MHIROT0+SDISC S BRUTTO=$$LMAM(BRUTTO) S ST=ST_","_$$INT(BRUTTO) ; -- 31 D S1($$NUM(BRUTTO),"BRUTTO") ; S SDISC=$$LMAM(SDISC) S ST=ST_","_$$INT(SDISC) ; -- 32 D S1($$NUM(SDISC),"DISCOUNTS") ; ;;S STAW=$$LMAM(STAW) S ST=ST_","_$$INT(STAW) ; -- 33 D S1($$NUM(STAW),"T.A.W TOTAL") ; S SWEBTAW=$$LMAM(SWEBTAW) ; -- ??? S ST=ST_","_$$INT(SWEBTAW) ; -- 34 D S1($$NUM(SWEBTAW),"WEB T.A.W TOTAL") ; S ST=ST_","_TAWQ ; -- 35 D S1(TAWQ,"T.A.W ORDERS") ; S ST=ST_","_WEBDLVQ ; -- 36 D S1(WEBDLVQ,"WEB ORDERS") ; S ST=ST_","_WEBTAWQ ; -- 37 D S1(WEBTAWQ,"WEB TAW ORDERS") ; S ST=ST_",0" ; -- TOTAL RUNS ; -- 38 I $$SHOW D S1("0","TOTALRUNS") ; S ST=ST_","_MKTIME ; -- 39 D S1(MKTIME,"MAKETIME") ; S ST=ST_","_SDMS ; -- 40 D S1(SDMS,"DLVCHARGE") ; S ST=ST_",0,0,0,0,0,0,0,0,0,0" ; -- 41-50 I $$SHOW D .D S1(0,"TARGET_FOOD_COST") .D S1(0,"MOBILE_APP_SALES") .D S1(0,"MOBILE_DELIVERY_ORDERS") .D S1(0,"TARGET_DELIVERY_SALES") .D S1(0,"MOBILE_CARRYOUT_ORDERS") .D S1(0,"MOBILE_CARRYOUT_SALES") .D S1(0,"AGGREGATOR_ORDERS") .D S1(0,"AGGREGATOR_SALES") .D S1(0,"OVEN") ; S TTDT="0.00" S UND30="0.00" S OVR40="0.00" ; S DRVTIM=0 I $G(DLVQSUPPL) D .S TTDT=$J(STIMSUPPL/DLVQSUPPL,2,2) .I DLVQ-TAWQ S DRVTIM=TTDT-$J(SMIN/(DLVQ-TAWQ),2,2) .S UND30=$J($G(DLVQ30)/DLVQSUPPL*100,2,2) .S OVR40=$J($G(DLVQ40)/DLVQSUPPL*100,2,2) ; S ST=ST_","_$J(DRVTIM,2,2) ; -- 51 D S1(DRVTIM,"DRIVETIME") ; S ST=ST_","_$J(TTDT,2,2) ; -- 52 D S1(TTDT,"ORDERWAITTIME") ; S ST=ST_","_$J(UND30,2,2) ; -- 53 D S1(UND30,"UNDER30TIME") ; S ST=ST_","_$J(OVR40,2,2) ; -- 54 D S1(OVR40,"OVER40TIME") ; S NETSALES=$$LMAM(MHIROT) S ST=ST_","_$$INT(NETSALES) ; -- 55 D S1($$NUM(NETSALES),"NETSALES") ; I SND=1 D .S DIR=$G(@$$^W4PRM@("GAP","DIR")) .S FILE=DIR_$ZD(DT,"YYYYMMDD")_"_"_SID_"_DPJI_BI_"_+VER_".POL" .C FILE:(DELETE) .O FILE:(NEWVERSION:REWIND:WRITE) .U FILE . W ST,! .C FILE .; .S USRPW="Israel1PJFTP:3bNwb7faya&L_5YaL4vY=" .S URL="https://files.papajohns.com" .S CMD="curl -k -s -T "_FILE_" -u """_USRPW_""" "_URL .; .ZSY CMD ; I 'SND,$$^%W1LNG="E" D .N N S N="" F S N=$O(SMKR(N)) Q:N="" D ..D S1($J(SMKR(N),2,2),$$MKR1^W3MKR(N)_" k""dq") ..D S1($G(MKRQN(N)),$$MKR1^W3MKR(N)_" zepnfd 'qn") Q ; INT(SUM) ; I +SUM=0 Q "000" Q $P(SUM*100,".") ; NUM(VL) ; I +$G(SND)=.5 Q $$INT(VL) Q $J(VL,2,2) ; S1(VL,TXCD) N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 S @$$^W4MAIN("S111")@(SH)=VL_" : "_$$TV^%W1DICT($$^%W1LNG,TXCD) Q ; LMAM(SUM) ; N MAMAH S MAMAH=$$MAMD^W4L(DT1) Q $J(SUM*100/(100+MAMAH),2,2) ; INTQ(VL) ; Q $P(VL,".") ; SHOW() ; Q (+$G(SND)=.5) W4GAPNET W4GAPNET(JB,DT,NOPRT) ; [ 06.03.25 10:22 ] [ 04.01.25 11:31 ] [ 03.01.25 20:34 ] N (JB,%ARG,%REM,DT,SND,NOPRT) ; S MSD0=$$GETP^%W1PRM("MSD") I $$PAPJ^W4PRM D DEFMSD(DT) ; D SCOMP^W4TOT(DT,DT) ; D DEFMSDPRM ; S ST=MSDR_","_MSD_","_DT ; -- 1,2,3 ; ;;S MHIROT=SDLV+SREST ; S MHIROT=$$MHIROT(DT) S SDLV=MHIROT-SREST ; S ST=ST_","_MHIROT; -- 4 ; S SWEB=$$LMAM(SWEB) S ST=ST_","_SWEB ; -- 5 ; S SWEBDLV=$$LMAM(SWEBDLV) S ST=ST_","_SWEBDLV ; -- 6 ; S SDLV=$$LMAM(SDLV) S ST=ST_","_SDLV ; -- 7 ; S SREST=$$LMAM(SREST) S ST=ST_","_SREST ; -- 8 ; S ST=ST_","_SMAM ; -- 9 ; S ST=ST_","_SBIT ; -- 10 ; S ST=ST_","_ORDQ ; -- 11 ; S ST=ST_","_DLVQ ; -- 12 ; S ST=ST_","_WEBQ ; -- 13 ; S ST=ST_","_(DLVQ-WEBQ) ; -- 14 ; S ST=ST_","_RESTQ ; -- 15 ; S ST=ST_","_SMIN ; -- 16 ; S ST=ST_","_(DLVQ-TAWQ-DLVDLYQ) ; -- 17 ; S BRUTTO=MHIROT+SDISC S BRRUTTO=$$LMAM(BRUTTO) S ST=ST_","_BRUTTO ; -- 18 ; S ST=ST_","_SDISC ; -- 19 ; S STAW=$$LMAM(STAW) S ST=ST_","_STAW ; -- 20 ; S STAW=$$LMAM(SWEBTAW) S ST=ST_","_SWEBTAW ; -- 21 ; S ST=ST_","_TAWQ ; -- 22 ; S ST=ST_","_WEBDLVQ ; -- 23 ; S ST=ST_","_WEBTAWQ ; -- 24 ; S ST=ST_","_$G(SZIC) ; -- 25 ; S ST=ST_",,,,," ; N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S ST=ST_","_N_"~"_MKRQN(N)_"~"_SMKR(N) S ST=ST_",.5"_"~"_$G(RESTQ)_"~"_SREST ; S DIR=$$DIR S FLNM=DIR_"GAPN"_"-"_MSDR_"-"_MSD_"-"_$ZD(DT,"YYMMDD") S PRM="MSD="_MSD_"&PSW="_PSW ; D SEND^W3ASKFD1(FLNM,URL,PRM,ST) ; I '$G(NOPRT) D SENDPRT(DT) I $G(MSD0) D PUT^%W1PRM("MSD",MSD0) Q ; ; LMAM(SUM) ; Q SUM ; PREPOLD(DT) ; S PLUTOT=$$^W4GL("PLUTOT") D .N DAT,MRK,N,A,QN,SUM,HNP .S DAT=$ZD(DT,"YYMMDD") .S MRK="" F S MRK=$O(@PLUTOT@(DAT,MRK)) Q:MRK="" D ..S N="" F S N=$O(@PLUTOT@(DAT,MRK,N)) Q:N="" D ...S A=$G(^(N)) ...S QN=$P(A,"*",1) ...S SUM=$P(A,"*",2) ...S HNP=$P(A,"*",4) ...S @VRM@(N,"QN")=$G(@VRM@(N,"QN"))+QN ...S @VRM@(N,"SUM")=$G(@VRM@(N,"SUM"))+SUM-HNP ; S ST="" S N="" F S N=$O(@VRM@(N)) Q:N="" D .S ST=ST_N_"*"_$G(@VRM@(N,"QN"))_"*"_$G(@VRM@(N,"SUM"))_"|" Q ; MHIROT(DT) ; N (JB,%ARG,DT) D PREP^W4Z(DT,DT) ; ; Q $G(ZZ("A"))+$G(ZZ("H")) ; TV(JB,DAT1,DAT2) ; I '$G(JB) Q I $G(DAT1)=""!($G(DAT2)="") Q ; N DT,DT1,DT2 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) F DT=DT1:1:DT2 D .D W4GAPNET(JB,DT) D ^W4MNYSN(JB,DT1,DT2) Q ; ; SENDPRT(DT) N (JB,DT,%ARG,%REM) D DEFMSDPRM S VRM=$$^W4MAIN("VRM") K @VRM S FILEIN=$$DIR_"GAPIT"_"-"_MSDR_"-"_MSD_"-"_$ZD(DT,"YYMMDD") ; S URL=$$OU^W3ASKURL_"w3ansitrep.jsp?MSDR="_MSDR ; D ^W4RSTGP1(DT) ; S ST="DT="_DT_"&MSD="_MSD_"&FDB=" S N="" F S N=$O(@VRM@("PAR",N)) Q:N="" D .S CDT="" F S CDT=$O(@VRM@("PAR",N,CDT)) Q:CDT="" D ..N CD S CD=N_"-"_CDT ..S ST=ST_CD_"*"_$G(@VRM@("PAR",N,CDT,"QN"))_"*"_$G(@VRM@("PAR",N,CDT,"SUM"))_"|" .I $L(ST)>2000 D ZAP H 2 ; D ZAP ;;ZSY "curl -s -m 15 -K "_FILEIN Q ; DEFMSDPRM ; S DIR=$$DIR S URL=$$OU^W3ASKURL_"w3ansgap.jsp?" S MSDR=+$G(@$$^W4PRM@("WEB","MSDR")) I 'MSDR S MSDR=+$G(@$$^W4PRM@("IT4WEB","MSDR")) S MSD=+$G(@$$^W4PRM@("WEB","MSD")) I 'MSD S MSD=+$G(@$$^W4PRM@("IT4WEB","MSD")) S PSW=$G(@$$^W4PRM@("WEB","PSW")) I 'PSW S PSW=$G(@$$^W4PRM@("IT4WEB","PSW")) Q ; DIR(STAM) ; Q "/tmp/" ; ; ZAP ; S SH=$G(SH)+1 C FILEIN:(DELETE) O FILEIN:(WRITE:REWIND:NEWVERSION) U FILEIN W ST,! C FILEIN S CMD="curl -k -s -d@'"_FILEIN_"' '"_URL_"' > /dev/null" ZSY CMD I $ZSY H 3 ZSY CMD I $ZSY H 3 ZSY CMD S ST="DT="_DT_"&MSD="_MSD_"&SH="_SH_"&FDB=" Q ; DEFMSD(DT) ; I '$$GETP^%W1PRM("MSD") D PUT^%W1PRM("MSD",1) D GETMSD(DT) Q ; GETMSD(DT) ; N MSD S MSD=$G(@$$^W4PRM@("IT4WEB","MSD")) I MSD=10209,DT'<$$^%L1DC("011122",3),DT'>$$^%L1DC("260624",3) D PUT^%W1PRM("MSD",4) I MSD=10219,DT'<$$^%L1DC("090622",3),DT'>$$^%L1DC("300524",3) D PUT^%W1PRM("MSD",4) I MSD=10218,DT'<$$^%L1DC("071123",3),DT'>$$^%L1DC("060724",3) D PUT^%W1PRM("MSD",4) I MSD=10212,DT<$$^%L1DC("201124",3) D PUT^%W1PRM("MSD",4) I MSD=10215,DT<$$^%L1DC("010125",3) D PUT^%W1PRM("MSD",4) I MSD=10211,DT<$$^%L1DC("020225",3) D PUT^%W1PRM("MSD",4) Q W4GAPNIT W4GAPNIT ; [ 31.10.21 16:21 ] [ PREP(DT) ; S MSDR=$G(@$$^W4PRM@("WEB","MSDR")) S MSD=$G(@$$^W4PRM@("WEB","MSD")) S PLUTOT=$$^W4GL("PLUTOT") D .N DAT,MRK,N,A,QN,SUM,HNP .S DAT=$ZD(DT,"YYMMDD") .S MRK="" F S MRK=$O(@PLUTOT@(DAT,MRK)) Q:MRK="" D ..S N="" F S N=$O(@PLUTOT@(DAT,MRK,N)) Q:N="" D ...S A=$G(^(N)) ...S QN=$P(A,"*",1) ...S SUM=$P(A,"*",2) ...S HNP=$P(A,"*",4) ...S @VRM@(N,"QN")=$G(@VRM@(N,"QN"))+QN ...S @VRM@(N,"SUM")=$G(@VRM@(N,"SUM"))+SUM-HNP ; S ST=DT_"~"_MSDR_"~"_MSD_"~" S N="" F S N=$O(@VRM@(N)) Q:N="" D .S ST=ST_N_"*"_$G(@VRM@(N,"QN"))_"*"_$G(@VRM@(N,"SUM"))_"~" Q W4GAPNT0 W4GAPNTD ; [ 18.08.21 15:04 ] [ 17.08.21 14:49 ] [ N (JB,%ARG,%REM,MEDAT,ADDAT) S DT1=$$^%L1DC(MEDAT,3) S DT2=$$^%L1DC(ADDAT,3) S MSDR=$G(%ARG("MSDR")) Q:'MSDR D MRKV ; W "
    ",! D KOT ; 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 GMSDR D GLNET F DT=DT1:1:DT2 D .S MSD="" F S MSD=$O(@GMSDR@(MSD)) Q:MSD="" D ..S ST=$G(@GLNET@(MSDR,DT,MSD)) ..D PRS^%L1FRM(ST,MKT,",") ..; ..S MST(DT,MSD)=ST ..F J=23:1:$L(ST,",") D ...S MKR=$P(ST,",",J) ...S M=$P(MKR,"~") Q:'M ...S MQ(DT,MSD,M)=$P(MKR,"~",2) ...S MS(DT,MSD,M)=$P(MKR,"~",3) ... ; W "",! F DT=DT1:1:DT2 D LINE(DT) W "
    ",! Q ; ; KOT ; W "",! W $$^%W1DICT("GAPNETREP",MEDAT_"<>"_ADDAT) W "",! Q ; MRKV ; S MRKV(3)=$$^%W1DICT("TOTSALES") S MRKV(4)=$$^%W1DICT("WEBSALES") S MRKV(5)=$$^%W1DICT("DLVWEBSALES") S MRKV(6)=$$^%W1DICT("DLVSALES") S MRKV(7)=$$^%W1DICT("RESTSALES") S MRKV(8)=$$^%W1DICT("TAXES") S MRKV(9)=$$^%W1DICT("CANCELLATIONS") S MRKV(10)=$$^%W1DICT("ORDERSNUMBER") S MRKV(11)=$$^%W1DICT("WEBSORDERSNUMBER") S MRKV(12)=$$^%W1DICT("DLVORDERSNUMBER") S MRKV(13)=$$^%W1DICT("RESTORDERSNUMBER") S MRKV(14)=$$^%W1DICT("ORDERSDLVTIME") S MRKV(16)=$$^%W1DICT("BRUTTO") S MRKV(17)=$$^%W1DICT("DISCOUNTS") S MRKV(18)=$$^%W1DICT("T.A.W TOTALS") S MRKV(19)=$$^%W1DICT("WEB T.A.W TOTAL") S MRKV(20)=$$^%W1DICT("T.A.W ORDERS") S MRKV(21)=$$^%W1DICT("WEB ORDERS") S MRKV(22)=$$^%W1DICT("WEB TAW ORDERS") Q ; GMSDR ; S GMSDR="^|"""_$$^W3MAIN_"""|W3MSDR" Q ; GLNET ; S GLNET="^|"""_$$^W3MAIN_"""|W4GAPNET" Q ; LINE(DT) ; W "" W "" D AMUD1(DT) W "" ; W "" D AMUD2(DT) W "" ; W "" D AMUD3(DT) W "" W "",! Q ; ; AMUD1(DT) ; W "",! W "",! N N S N="" F S N=$O(MRKV(N)) Q:N="" D .W "",! W "
    " W $ZD(DT,"DD.MM.YY") W "
    "_$$H2U^%L1FRM(MRKV(N))_"
    ",! Q ; AMUD2(DT) ; W "",! W "" S MSD="" F S MSD=$O(@GMSDR@(MSD)) Q:MSD="" D .W "" W "",! W "
    "_$G(@GMSDR(MSD))_"
    ",! Q ; AMUD3(DT) ; W "",! W "
    ",! Q W4GAPNTD W4GAPNTD ; [ 01.05.24 07:00 ] [ 25.04.24 17:19 ] [ 13.06.23 16:55 ] I $G(JB)="" W "JB NOT DEFINED !" Q N MSDR,W3MSDR,TMP,TMPSN S MSDR=$G(%ARG("MSDR")) S W3MSDR="^|$$^W3MAIN|W3MSDR" I MSDR="" W "MSDR NOT DEFINED !" Q K %L1PC D ^%W1ARG S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" S %REPN="W4GAPNTD" S %REPN("PRTN")=$$^%W1JB S %REPN("MSDR")=MSDR S TMPSN="^|$$^W3MAIN|TMPSN" K @TMPSN ; S N="" F S N=$O(@W3MSDR@(MSDR,N)) Q:N="" D .S @TMPSN@(N)=$$MSD^W3R(N) ; K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN ; S MSDR=+$G(MSDR) S TMP=$$^W4MAIN("TMP") K @TMP M @TMP=^|$$^W3MAIN|W4GAPNET(MSDR) Q ; DAT ; S DAT=$ZD(DT,"DD.MM.YY") I DT<$G(MEDAT) S OK=0 Q I DT>$G(ADDAT) S OK=2 Q N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) S OK=0 Q ; D PUT^%W1PRM("PCPDAT",DAT) ; D .S TMP=$$^W4MAIN("TMP") .N N S N="" F S N=$O(^|$$^W3MAIN|W3MSDR(MSDR,N)) Q:N="" D ..I '$D(@TMP@(DT,N)) S @TMP@(DT,N)="" Q ; MSD ; I $G(MSD),'$D(^|$$^W3MAIN|W3MSDR(MSDR,MSD)) S OK=0 Q ;;N MSG S MSG=$ZD(DT,"DD.MM.YY")_" "_MSD ;;D PUT^%W1PRM("PCPDAT",MSG) N GAPNET S GAPNET=$$GAPNET^W4MNYALL(DT,MSD) N MNYALL S MNYALL=$G(^|$$^W3MAIN|W4MNYALL(DT,MSD)) N PD1 S PD1=$P(MNYALL,"\") N CR1 S CR1=$P(MNYALL,"\",2) N TOT S TOT=PD1+CR1 ; ;;S ^AA("W4GAPNTD","TOT",DT,+MSD)=TOT_"\"_$H ;;S ^AA("W4GAPNTD","GAPNET",DT,+MSD)=GAPNET I +GAPNET'=+TOT!'TOT D .;;S ^AA("W4GAPNTD","DT",DT,+MSD)=$H .D ^W4NETUPD(MSDR,DT,DT,MSD) .N TMP S TMP=$$^W4MAIN("TMP") .K @TMP@(DT,MSD) .M @TMP@(DT,MSD)=^|$$^W3MAIN|W4GAPNET(MSDR,DT,MSD) ; N MSD1 S MSD1=$G(^|$$^W3MAIN|W3MSD(MSD)) ;;S ^AA("W4GAPNTD","GLOB",DT,MSD)=GLOB ;;S ^AA("W4GAPNTD","GLOB",DT,MSD,"@GLOB")=$G(@GLOB) N A,DLM S A=$G(@GLOB) S DLM="," S x1=$$RKV($P(A,DLM,18)) ; -- BRUTTO S x2=$$RKV($P(A,DLM,4)) ; -- MHIROT S x3=$$RKV($P(A,DLM,5)) ; -- WEB SUM S x4=$$RKV($P(A,DLM,7)-$P(A,DLM,20));-- DLV SUM S x5=$$RKV($P(A,DLM,8)) ; -- REST SUM S x6=$$RKV($P(A,DLM,20)) ; -- TAW SUM S x7=$P(A,DLM,11) ; -- ORDQ S x8=$P(A,DLM,13); -- WEBQ S x9=$P(A,DLM,12)-$P(A,DLM,22) ; -- DLVQ S x10=$P(A,DLM,15) ; -- RESTQ S x11=$P(A,DLM,22) ; -- TAWQ S x12=$$RKV($P(A,DLM,10)) ; -- BIT S x13=$$RKV($P(A,DLM,19)) ; -- HNH S x14=$$RKV($P(A,DLM,25)) ; -- ZIC Q ; RKV(VL) ; Q VL ; --- 04/10/22 ; N DT S DT=$G(@$$^%W1GLPRM@("VAL","MEDAT")) I DT,$$LMAM D .N MAM S MAM=$$MAMD^W4L(DT) .S VL=VL*100/(100+MAM) Q VL ; LMAM(STAM) Q $$GETP^%W1PRM("PCLMAM") W4GAPNTM W4GAPNTM ; [ 19.05.24 11:01 ] [ 05.10.21 16:56 ] [ 24.08.21 17:32 ] I $G(JB)="" W "JB NOT DEFINED !" Q N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N MSDR,W3MSDR,TMP,TMPSN K %L1PC D ^%W1ARG I $G(MSDR)="" W "MSDR NOT DEFINED !" Q S W3MSDR="^|$$^W3MAIN|W3MSDR" ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" S %REPN="W4GAPNTM" S %REPN("PRTN")=$$^%W1JB ; S TMPSN="^|$$^W3MAIN|TMPSN" K @TMPSN N N S N="" F S N=$O(@W3MSDR@(MSDR,N)) Q:N="" D .S @TMPSN@(N)=$$MSD^W3R(N) ; K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN ; S MSDR=+$G(MSDR) S TMP=$$^W4MAIN("TMP") K @TMP ; N MEDT,ADDT S MEDT=$O(^|$$^W3MAIN|W4GAPNET(MSDR,"")) S ADDT=+$H ; N DT F DT=MEDT:1:ADDT D .N MSD S MSD="" F S MSD=$O(^|$$^W3MAIN|W4GAPNET(MSDR,DT,MSD)) Q:MSD="" D ..S A=$G(^(MSD)) ..N J,B,MKR,QN,SUM ..F J=25:1:$L(A,",") D ...S B=$P(A,",",J) ...S MKR=$P(B,"~") Q:'MKR ...S QN=$P(B,"~",2) ...S SUM=$P(B,"~",3) ...S @TMP@(DT,MSD,MKR)=QN_"*"_SUM Q ; ; DAT ; S DAT=$ZD(DT,"DD.MM.YY") I DT<$G(MEDAT) S OK=0 Q I DT>$G(ADDAT) S OK=2 Q Q ; MSD ; N MSD1 S MSD1=$G(^|$$^W3MAIN|W3MSD(MSD)) Q ; MKR ; S MKR1=$G(^|$$^W3MAIN|W3MKR(MKR)) S x1=$P($G(@GLOB),"*") S x2=$P($G(@GLOB),"*",2) Q ; RKV(VL) Q $$RKV^W4GAPNTD(VL) W4GAPPRM W4GAPPRM ; [ 02.07.20 13:21 ] [ 28.06.20 09:39 ] [ 25.06.20 18:48 ] GET ; Q ; SAVE(PRM) ; D ^%W1GETPR(PRM) ; I '$G(STORYID) S %SC("ER")=1 S @$$^W4PRM@("GAP")=PRM S @$$^W4PRM@("GAP","ID")=STORYID S @$$^W4PRM@("GAP","DIR")=DIR Q 1 ; END Q W4GAPREP W4GAPREP ; [ 29.09.23 06:54 ] [ 08.12.21 11:03 ] [ 30.09.21 20:21 ] N (JB,%ARG,%REM,DISP) ; S DAT1=$G(%ARG("MEDATE")) I DAT1="" S DAT1=$ZD($$^W4DZ,"DD.MM.YY") S DAT2=$G(%ARG("ADDATE")) I DAT2="" S DAT2=DAT1 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) S LNG=$$^%W1LNG ; K @$$^W4MAIN("S111") ; D SCOMP^W4TOT(DT1,DT2) ; S MHIROT=0 F DT=DT1:1:DT2 D .S MHIROT=MHIROT+$$MHIROT^W4GAPNET(DT) ; S SDLV=MHIROT-SREST ; S TKF=$ZD(DT,"YYYYMMDD") S ST=TKF ; -- 1 I DT2'=DT1 S TKF=DAT1_" - "_DAT2 I DT2=DT1 S TKF=DAT1 ; W "
    ",! D S1(TKF,"SHORTMANYPERIOD") D S2("DATABEFORETAX") D PCKAV W "" W $$^%W1DICT("SHORTMANYPERIOD",TKF) W "" W "
    ",! W "" W $$^%W1DICT("DATABEFORETAX") W "" ; W "

    " W "",! ;;S MHIROT=SREST+SDLV D TR($$LMAM(MHIROT),"SALESNETTO",1) D TR($$LMAM(SDLV-STAW),"DLVNETTO",1) D TR($$LMAM(STAW),"TAWNETTO",1) D TR($$LMAM(SREST),"RESTNETTO",1) D TR("","") D TR(DLVQ+RESTQ,"ORDQN") D TR(DLVQ-TAWQ,"DLVQN") D TR(TAWQ,"TAWQN") D TR(RESTQ,"RESQN") W "
    ",! D PCKAV I $G(DISP) D .W "

    ",! .S W4BCK("SZ")=12 .D ^W4BCK W "
    ",! ; ; N S111 S S111=$$^W4MAIN("S111") ; I '$G(DISP) D .D ^W4MDPPC Q:$G(PRINT)="" .N SM1 S SM1=2 .N N S N="" F S N=$O(@S111@(N)) Q:N="" I N S TXT=$G(^(N)) D S1^W4PCST .D ^W4CUT(PRINT,$G(%MDP("CUT"))) ; K @S111 Q ; ; TR(VL,NM,DR) ; S VL=$S($G(DR):$J(VL,2,2),1:VL) W "" W ""_$$^%W1DICT(NM)_"" W ""_VL_"" W "",! ; D S1(VL,NM) Q ; S1(VL,NM) ; N NM1 S NM1=$$TV^%W1DICT(LNG,NM) N ST S ST=$J(VL,10)_" : "_$$HBR^%L1FRM(NM1,19) N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 S @$$^W4MAIN("S111")@(SH)=ST Q ; S2(NM) ; N NM1 S NM1=$$TV^%W1DICT(LNG,NM) N SM S SM=(40-$L(NM1))\2 N ST S ST=$J("",SM)_NM1 N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 S @$$^W4MAIN("S111")@(SH)=ST Q ; PCKAV ; N SM,DL S SM=1 S DL=34 N ST S ST=$J("",SM)_$TR($J("",DL)," ","-") N SH S SH=$O(@$$^W4MAIN("S111")@(99999),-1)+1 S @$$^W4MAIN("S111")@(SH)=ST Q ; LMAM(VL) ; N MAMAH S MAMAH=$$MAMD^W4L(DT1) Q $J(VL*100/(100+MAMAH),2,2) W4GAPZ W4GAPZ(DT1,DT2) ; [ 06.03.25 13:32 ] [ 28.05.24 11:23 ] [ 07.05.24 07:30 ] N (JB,%ARG,%REM,DT1,DT2) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $G(%ARG("SHOW"))=0 Q ; D SETIN ; W "
    ",! ; D .S W4BCK("SZ")=12 .D ^W4BCK .W "

    ",! ; ---------------------------- MANY REPORT PER PAYMENT KINDS D MANYREP ; W "

    ",! D PCST("") D PCST("") ; ;------------------------- MANY REPORT PER AUTHORITIES D REP2MAS ; W "

    ",! D PCST("") D PCST("") D KAV ; ; -------------------------- DISCOUNTS AMD CANCELATIONS D DISCCNCREP ; W "

    ",! D PCST("") D PCST("") D KAV ; ; ------------------------- STATISTIKA DLV,TAKEAWAY, IN LOCAL D STATREP ; W "

    ",! D PCST("") D PCST("") ; D MKRREP ; W "

    ",! D PCST("") D PCST("") ; ; ------------------- STATISTIKA CAJ PER SITES ; D CAJMKRREP ; W "

    ",! D PCST("") D PCST("") ; D ASRREP ; W "

    ",! D PCST("") D PCST("") D .W "

    ",! .S W4BCK("SZ")=12 .D ^W4BCK W "
    ",! ; N PRMS S PRM="GAPZ;"_$ZD(DT1,"DD.MM.YY")_";"_$ZD(DT2,"DD.MM.YY") N PROG S PROG="PRINT1^W4TELREP("""_PRM_""")" ;;D PUT^%W1PRM("CSRPRINT",PROG) D PUT^%W1PRM("CSRPRINT","S1PC^W4TELREP") Q ; ; KOT(DT1,DT2,KOT1,KOT2) N DAT1,DAT2,TX S DAT1=$ZD(DT1,"DD.MM.YY") S DAT2=$ZD(DT2,"DD.MM.YY") I DT1=DT2 D .W $$^%W1DICT(KOT1,DAT1) .S TX=$$TV^%W1DICT($$^%W1LNG,KOT1,DAT1) I DT1'=DT2 D .W $$^%W1DICT(KOT2,DAT1_"<>"_DAT2) .S TX=$$TV^%W1DICT($$^%W1LNG,KOT2,DAT1_"<>"_DAT2) ; D PCST(TX) ;;D KAV($L(TX)) Q ; ; SUMZ(DT1,DT2,IND) ; N GL N SUM S SUM=0 N DT,DAT F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .S GL=$$^W4GL("Z1") . .I '$D(@GL@(DAT)) D Q ..D ^W4SUMZRO ..D ^W4SUM ..S GL=$$^W4GL("TOT") ..N VL S VL=$G(@GL@(DAT,IND,1)) ..D SUMZVL(VL,DT,IND) . .N N S N="" F S N=$O(@GL@(DAT,N)) Q:N="" D ..N VL S VL=$G(^(N,IND,1)) ..D SUMZVL(VL,DT,IND) ; Q SUM ; ; SUMZVL(VL,DT,IND) ; I $$LMAM,IND'["#" D .N AHMAM S AHMAM=$$MAMD^W4L(DT) .S VL=$J(VL*100/(100+AHMAM),5,5) S SUM=SUM+VL Q ; HB(DT1,DT2) ; N SUM,QN,SMAM S SUM=0,QN=0,SMAM=0 N CODDOC N GL S GL=$$^W4GL("KLIN") ; F CODDOC="H","TZ" D .N N S N="" F S N=$O(@GL@(CODDOC,N)) Q:N="" D ..D ^W4HSBGET(N,CODDOC) ..N DAT S DAT=$G(W4HSB("TODATE")) ..N DT S DT=$$^%L1DC(DAT,3) ..I DTDT2) Q ..S QN=QN+1 ..;;N KF S KF=1 I CODDOC="TZ" S KF=-1 ..N VL S VL=$S($$LMAM:$G(W4HSB("LMAM")),1:W4HSB("TOT")) ..S SMAM=SMAM+$G(W4HSB("MAM")) ..S SUM=SUM+VL ..S SUM(CODDOC)=$G(SUM(CODDOC))+VL Q SUM_"\"_QN_"\"_SMAM ; ; TR(NM,QN,VL,VLP,PR) ; S QN=$G(QN) S VL=$G(VL) S VLP=$G(VLP) ; N TX S TX="" ; I NM'["<>" D .S TX=$$TV^%W1DICT($$^%W1LNG,NM) ; I NM["<>" D .S TX=$P(NM,"<>",2) .S NM=$P(NM,"<>") ; S TX=$$HBR^%L1FRM(TX,WD01) ; W "" W "" D .I $E(NM)="!" W $E(NM,2,255) Q .W $$^%W1DICT(NM) W "",! ; I $G(PR)'="-" D .D TDLTR . W $$STYLE(QN) .W ">" . W QN . S TX=$J(QN,WD02)_" "_TX .W "",! ; D TDLTR W $$STYLE(VL) W ">" W $S(VL="":" ",1:$J(VL,DR,DR)) N VL1 S VL1=$S(VL="":"",1:$J(VL,DR,DR)) S TX=$J(VL1,WD03)_" "_TX W "",! ; I $G(PR)'="-" D .I $E($G(VLP))="%" D ..N TOT S TOT=$E(VLP,2,20) ..I 'TOT S VLP="" Q ..S VLP=$J(VL*100/TOT,DR,DR) .; .D TDLTR . W $$STYLE(VLP) .W ">" . W $S(VLP="":" ",1:$J(VLP,DR,DR)) . S TX=$J(VLP,WD04)_" "_TX .W "",! W "",! ; D PCST(TX) Q ; ; TR1(NM,QN,VL,TOT,PR) ; S QN=$G(QN) S VL=$G(VL) ; N TX S TX="" ; I NM'["<>" D .S TX=$$TV^%W1DICT($$^%W1LNG,NM) ; I NM["<>" D .S TX=$P(NM,"<>",2) .S NM=$P(NM,"<>") ; S TX=$$HBR^%L1FRM(TX,WD11) ; W "" W "" D .I $E(NM)="!" W $E(NM,2,255) Q .W $$^%W1DICT(NM) W "",! ; D TDLTR W $$STYLE(QN) W ">" N QN1 D .I NM="SUPPLIEDTIME" S QN1=" " Q .S QN1=QN W QN1 S TX=$J(QN1,WD12)_" "_TX W "",! ; D TDLTR W $$STYLE(VL) W ">" N VL1 D .I NM="SUPPLIEDTIME" S VL1=" " W VL1 Q .S VL1=$J(VL,DR,DR) W VL1 S TX=$J(VL1,WD13,2)_" "_TX W "",! ; D TDLTR W ">" D .N RKV .D ..I 'TOT S RKV=" " Q ..S RKV=$J(VL*100/TOT,DR,DR) .W RKV .S TX=$J(RKV,WD14)_" "_TX W "",! ; D TDLTR W ">" D .N RKV .I 'QN S RKV=" " .E S RKV=$J(VL/QN,DR,DR) .W RKV .S TX=$J(RKV,WD15)_" "_TX W "" W "",! ; D PCST(TX) Q ; ; TDLTR ; W "",! W "" W "" W $$^%W1DICT("AFTERTAX")_"  " W "" W "" W "" W $$^%W1DICT("BEFORETAX")_"  " W "" W "" W "",! W "",! Q ; ; LMAM() ; Q $G(%ARG("LMAM")) ; ; SUMMAM(DT1,DT2,LST) ; N GL S GL=$$^W4GL("Z1") N SUM S SUM=0 N IND ; N DT,DAT F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .N N S N="" F S N=$O(@GL@(DAT,N)) Q:N="" D ..N IND S IND="" F S IND=$O(@GL@(DAT,N,IND)) Q:IND="" D ...I ","_LST_","'[(","_IND_",") Q ...N VL S VL=$G(^(IND,1)) ...N AHMAM S AHMAM=$$MAMD^W4L(DT) ...S VL=$J(VL*AHMAM/(100+AHMAM),5,5) ...S SUM=SUM+VL Q SUM ; RKV(VL,DT) ; I '$G(DR) S DR=2 I '$$LMAM Q $J(VL,DR,DR) N AHMAM S AHMAM=$$MAMD^W4L(DT) S VL=$J(VL*100/(100+AHMAM),5,5) Q $J(VL,DR,DR) ; STYLE(VL) ; I VL<0 Q "style=""color:red"" " I +VL=0 Q "style=""color:grey"" " Q "" ; OPNTBL(WD) ; W "",! Q ; WD() ; Q 60 ; KAV(LN) ; N TX S TX=$TR($J("",39)," ","-") D PCST(TX) Q ; PCST(TX) N SM1 S SM1=0 D ^W4PCST($G(TX),1) Q ; ; SETIN ; S GLS=$$^W4MAIN("S111") K @GLS S DLM="|",DR=1 ; S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) ; S WD01=14,WD02=5,WD03=9,WD04=9 S WD11=12,WD12=5,WD13=7,WD14=5,WD15=6 ; S OPN=0 I DT2'<$$^W4DZ S OPN=1 D SCOMP^W4TOT(DT1,DT2,OPN) ; --> VKIOSK,WOLT,TB,GUDIS,CIB,HNS,HNP,OTH,BIT,QNMSL,QNMSD S SDLV=SDLV-STAW ; S MZ=$$SUMZ(DT1,DT2,"F") S QMZ=$$SUMZ(DT1,DT2,"F#") S CHK=$$SUMZ(DT1,DT2,"GO") S QCHK=$$SUMZ(DT1,DT2,"GO#") S MVB=$$SUMZ(DT1,DT2,"GB") S QMVB=$$SUMZ(DT1,DT2,"GB#") S ISR=$$SUMZ(DT1,DT2,"V1") S QISR=$$SUMZ(DT1,DT2,"V1#") S VIZ=$$SUMZ(DT1,DT2,"V2") S QVIZ=$$SUMZ(DT1,DT2,"V2#") S DNR=$$SUMZ(DT1,DT2,"V3") S QDNR=$$SUMZ(DT1,DT2,"V3#") S AEX=$$SUMZ(DT1,DT2,"V4") S QAEX=$$SUMZ(DT1,DT2,"V4#") S LEUM=$$SUMZ(DT1,DT2,"V6") S QLEUM=$$SUMZ(DT1,DT2,"V6#") S ASR=$$SUMZ(DT1,DT2,"H") S QASR=$$SUMZ(DT1,DT2,"H#") ; S HBTAX=$$HB(DT1,DT2) S QHBTAX=$P(HBTAX,"\",2),HBTAX=+HBTAX Q ; ; MANYREP ; W "

    " S TX=$$TV^%W1DICT($$^%W1LNG,"ISSUEREPTIME",$ZD($H,"DD.MM.YY 24-60")) D PCST(TX) D KOT(DT1,DT2,"MANYREP2DAT","MANYREP2PERIOD") W "

    ",! ; D TBLMAM ; I $$LMAM D .S TX=$$TV^%W1DICT($$^%W1LNG,"DATABEFORETAX") .D PCST(TX) W "

    ",! ; D OPNTBL($$WD) W "" W "" W "" W "" W "" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"KINDOFPAYMENT"),WD01) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"ISKAOT"),WD02)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD03-1)_" "_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"OFPDYON"),WD04-1)_" "_DLM_TX D KAV($L(TX)) D PCST(TX) D KAV($L(TX)) ; D TR("CASH",QMZ,MZ,MZ) D TR("CHECK",QCHK,CHK,CHK) D TR("MVBANK",QMVB,MVB,MVB) D TR("ISR",QISR,ISR,ISR) D TR("VISA",QVIZ,VIZ,VIZ) D TR("DINERS",QDNR,DNR,DNR) D TR("AEX",QAEX,AEX,AEX) D TR("LEUMI",QLEUM,LEUM,LEUM) ; S SMAM=$$SUMMAM(DT1,DT2,"F,G,V,H") S PDYON=MZ+CHK+MVB+ISR+VIZ+DNR+AEX+LEUM S QPDYON=QMZ+QCHK+QMVB+QISR+QVIZ+QDNR+QAEX+QLEUM ; S TOT=PDYON+ASR D TR("ASRORD",QASR,ASR,0) ; D KAV ; D TR("TOTSALES",QPDYON+QASR,TOT,"","B") ; I '$$LMAM D .D TR("MAM","",SMAM,"","B") .D TR("BEFORETAX","",TOT-SMAM,"","B") ; W "
    "_$$^%W1DICT("KINDOFPAYMENT")_""_$$^%W1DICT("ISKAOT")_""_$$^%W1DICT("TOTAL")_""_$$^%W1DICT("OFPDYON")_"
    ",! Q ; ; REP2MAS ; D KOT(DT1,DT2,"REPAUTHOR2DAT","REPAUTHOR2PERIOD") D KAV ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("PROFITKIND")_"" W ""_$$^%W1DICT("TOTAL")_"" ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"PROFITKIND"),WD01) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD03-1)_" "_DLM_TX D PCST(TX) D KAV ; D TR("PDYON",QPDYON,PDYON,"","-") D TR("TOTALINVOICESTX",QHBTAX,HBTAX,0,"-") S TOTM=PDYON+HBTAX D TR("TOTM",QPDYON+QHBTAX,TOTM,0,"-") ; S HBMAM=$P($$HB(DT1,DT2),"\",3) S SMAM=$$SUMMAM(DT1,DT2,"F,G,V")+HBMAM I '$$LMAM D .D TR("MAM","",SMAM,"","-") .D TR("BEFORETAX","",TOTM-SMAM,"","-") ; W "",! Q ; ; DISCCNCREP ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("DISCANDDEL")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"DISCANDDEL"),WD01) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"QUANT"),WD02)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD03-1)_" "_DLM_TX S TX=" % "_DLM_TX D PCST(TX) D KAV($L(TX)) ; S TOTHNH=0 S TOTHNH=$$RKV(SDISC,DT2)+$$RKV(SHNHP,DT2)+$$RKV(SOTH,DT2)+$$RKV(SBIT,DT2)+$$RKV(SZIC,DT2) D TR("DISCOUNTS",SDISCQ,$$RKV(SDISC,DT2),"%"_TOTHNH) D TR("DISCITTOT",SHNHPQ,$$RKV(SHNHP,DT2),"%"_TOTHNH) D TR("DISCOTH",SOTHQ,$$RKV(SOTH,DT2),"%"_TOTHNH) D TR("CANCELLATIONS",SBITQ,$$RKV(SBIT,DT2),"%"_TOTHNH) D TR("ZIC",SZICQ,$$RKV(SZIC,DT2),"%"_TOTHNH) W "",! Q ; ; STATREP ; ; ------------------------- STATISTIKA DLV,TAKEAWAY, IN LOCAL D OPNTBL($$WD) W "" W ""_$$^%W1DICT("STATISTIKA")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W ""_$$^%W1DICT("AVRGORD")_"" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"STATISTIKA"),WD11) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"QUANT"),WD12)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD13-1)_" "_DLM_TX S TX=" % "_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"AVRGORD"),WD15)_DLM_TX D PCST(TX) D KAV($L(TX)) ; S TOT=$$RKV(SDLV,DT2)+$$RKV(STAW,DT2)+$$RKV(SREST,DT2) D TR1("DELIVERY",DLVQ,$$RKV(SDLV,DT2),TOT,DT2) ; I DLVQ D .D TR1("SUPPLIEDTIME",DLVQ,SMIN,"","") ; D TR1("TAKEAWAYORDERS",TAWQ,$$RKV(STAW,DT2),TOT) ; D TR1("SITINLOCAL",RESTQ,$$RKV(SREST,DT2),TOT) S TOTQ=DLVQ+TAWQ+RESTQ ; D KAV(38) D TR1("TOTAL",TOTQ,$J(TOT,DR,DR),"","B") Q ; ; MKRREP ; D KOT(DT1,DT2,"SITEREP2DAT","SITEREP2PERIOD") D KAV ; ; ------------------------ STATISTIKA PER SITES D OPNTBL($$WD) W "" W ""_$$^%W1DICT("SITE")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W ""_$$^%W1DICT("AVRGORD")_"" W "",! N TOTSITE,TOTQSITE S TOTSITE=0,TOTQSITE=0 N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S TOTSITE=TOTSITE+$G(SMKR(N)) .S TOTQSITE=TOTQSITE+$G(MKRQN(N)) ; S TOTSITE=TOTSITE+SREST S TOTQSITE=TOTQSITE+RESTQ ; N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S NM0=$G(@$$^W4GL("W3MKR")@(N)) .S NM=$$H2U^%L1FRM(NM0) .I NM="" S NM="*** "_N,NM0=NM .D TR1("!"_NM_"<>"_NM0,$G(MKRQN(N)),$$RKV($G(SMKR(N)),DT2),$$RKV(TOTSITE,DT2)) ; D TR1("SITINLOCAL",RESTQ,$$RKV(SREST,DT2),$$RKV(TOTSITE,DT2)) ; D KAV D TR1("TOTAL<>",TOTQSITE,$$RKV(TOTSITE,DT2),$$RKV(TOTSITE,DT2),"B") W "",! Q ; ; CAJMKRREP ; D KOT(DT1,DT2,"CAJREP2DAT","CAJREP2PERIOD") D KAV ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("SITE")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W ""_$$^%W1DICT("AVRGORD")_"" W "",! N TOTCAJ,TOTQCAJ S TOTCAJ=SPAIDCA,TOTQCAJ=QPAIDCA N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S TOTCAJ=TOTCAJ+$G(SMKR(N,"CAJ")) .S TOTQCAJ=TOTQCAJ+$G(MKRQN(N,"CAJ")) ; D TR1("SKIOSKCA",QPAIDCA,$$RKV(SPAIDCA,DT2),$$RKV(TOTCAJ,DT2)) ; N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S NM0=$G(@$$^W4GL("W3MKR")@(N)) .S NM=$$H2U^%L1FRM(NM0) .I NM="" S NM="*** "_N,NM0=NM .D TR1("!"_NM_"<>"_NM0,$G(MKRQN(N,"CAJ")),$$RKV($G(SMKR(N,"CAJ")),DT2),$$RKV(TOTCAJ,DT2)) W "",! ; D KAV D TR1("TOTAL<>",TOTQCAJ,$$RKV(TOTCAJ,DT2),$$RKV(TOTCAJ,DT2),"B") ; W "",! Q ; ; ASRREP ; ; ------------------------ DOCH LAKOHOT HAKAFA D KOT(DT1,DT2,"CUSTREP2DAT","CUSTREP2PERIOD") D KAV D OPNTBL($$WD) W "" W ""_$$^%W1DICT("CUSTOMER")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W ""_$$^%W1DICT("AVRGORD")_"" W "",! ; N TOTLK,TOTQLK S TOTLK=0,TOTQLK=0 N N,N1 S N="" F S N=$O(SASR(N)) Q:N="" D .S N1="" F S N1=$O(SASR(N,N1)) Q:N1="" D ..S TOTLK=TOTLK+$G(SASR(N,N1)) ..S TOTQLK=TOTQLK+$G(SASR(N,N1,"Q")) ; N N S N="" F S N=$O(SASR(N)) Q:N="" D .S N1="" F S N1=$O(SASR(N,N1)) Q:N1="" D ..S NM0=$$LKH^W4L(N1) ..S NM=$$H2U^%L1FRM(NM0) ..I NM="" S NM="*** "_N,NM0=NM ..D TR1("!"_NM_"<>"_NM0,$G(SASR(N,N1,"Q")),$$RKV($G(SASR(N,N1)),DT2),$$RKV(TOTLK,DT2)) W "",! D KAV D TR1("TOTAL<>",TOTQLK,$$RKV(TOTLK,DT2),$$RKV(TOTLK,DT2),"B") W "",! Q ; W4GAPZ0 W4GAPZ(DT1,DT2) ; [ 24.07.22 14:06 ] [ 18.07.22 15:32 ] [ 17.07.22 15:14 ] N (JB,%ARG,%REM,DT1,DT2) I $G(%ARG("SHOW"))=0 Q ; N GLS S GLS=$$^W4MAIN("S111") K @GLS S DLM="|",DR=1 ; S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) ; S WD01=14,WD02=5,WD03=9,WD04=9 S WD11=12,WD12=5,WD13=7,WD14=5,WD15=6 ; D SCOMP^W4TOT(DT1,DT2) ; --> VKIOSK,WOLT,TB,GUDIS,CIB,HNS,HNP,OTH,BIT,QNMSL,QNMSD ; S MZ=$$SUMZ(DT1,DT2,"F") S QMZ=$$SUMZ(DT1,DT2,"F#") S CHK=$$SUMZ(DT1,DT2,"GO") S QCHK=$$SUMZ(DT1,DT2,"GO#") S MVB=$$SUMZ(DT1,DT2,"GB") S QMVB=$$SUMZ(DT1,DT2,"GB#") S ISR=$$SUMZ(DT1,DT2,"V1") S QISR=$$SUMZ(DT1,DT2,"V1#") S VIZ=$$SUMZ(DT1,DT2,"V2") S QVIZ=$$SUMZ(DT1,DT2,"V2#") S DNR=$$SUMZ(DT1,DT2,"V3") S QDNR=$$SUMZ(DT1,DT2,"V3#") S AEX=$$SUMZ(DT1,DT2,"V4") S QAEX=$$SUMZ(DT1,DT2,"V4#") S LEUM=$$SUMZ(DT1,DT2,"V6") S QLEUM=$$SUMZ(DT1,DT2,"V6#") S ASR=$$SUMZ(DT1,DT2,"H") S QASR=$$SUMZ(DT1,DT2,"H#") ; S HBMAS=$$HB(DT1,DT2) S QHBMAS=$P(HBMAS,"\",2),HBMAS=+HBMAS ; W "
    ",! W "

    " D KOT(DT1,DT2) W "

    ",! ; D TBLMAM ; I $$LMAM D .S TX=$$TV^%W1DICT($$^%W1LNG,"DATABEFORETAX") .D ^W4PCST(TX,1) W "

    ",! ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("KINDOFPAYMENT")_"" W ""_$$^%W1DICT("ISKAOT")_"" W ""_$$^%W1DICT("TOTAL")_"" W ""_$$^%W1DICT("OFPDYON")_"" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"KINDOFPAYMENT"),WD01) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"ISKAOT"),WD02)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD03-1)_" "_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"OFPDYON"),WD04-1)_" "_DLM_TX D KAV($L(TX)) D ^W4PCST(TX,1) D KAV($L(TX)) ; D TR("CASH",QMZ,MZ,MZ) D TR("CHECK",QCHK,CHK,CHK) D TR("MVBANK",QMVB,MVB,MVB) D TR("ISR",QISR,ISR,ISR) D TR("VISA",QVIZ,VIZ,VIZ) D TR("DINERS",QDNR,DNR,DNR) D TR("AEX",QAEX,AEX,AEX) D TR("LEUMI",QLEUM,LEUM,LEUM) ; D TR("SKIOSKCA",QPAIDCA,$$RKV(SPAIDCA,DT2),0) ; N N S N="" F S N=$O(SMKR(N)) Q:N="" D .S NM0=$G(@$$^W4GL("W3MKR")@(N)) .S NM=$$H2U^%L1FRM(NM0) .I NM="" S NM="*** "_N,NM0=NM .D TR("!"_NM_"<>"_NM0,$G(MKRQN(N)),$$RKV(SMKR(N),DT2),0) ; D TR("CAJ",SCAOUTQ,$$RKV(SCAOUT,DT2),0) ; S SMAM=$$SUMMAM(DT1,DT2) S PDYON=MZ+CHK+MVB+ISR+VIZ+DNR+AEX+LEUM S QPDYON=QMZ+QCHK+QMVB+QISR+QVIZ+QDNR+QAEX+QLEUM D KAV(38) D TR("TOTPD",QPDYON,PDYON,PDYON,"B") ; I '$$LMAM D .D TR("MAM","",SMAM,"","B") .D TR("BEFORETAX","",PDYON-SMAM,"","B") ; S TOT=PDYON+ASR D TR("ASRORD",QASR,ASR,0) D TR("TOTSALES",QPDYON+QASR,TOT,"","B") D TR("TOTALINVOICESTX",QHBMAS,HBMAS,0,"") S TOTM=PDYON+HBMAS D TR("TOTM",QPDYON+QHBMAS,TOTM,0,"B") W "",! ; W "

    ",! ; D ^W4PCST("",1) D ^W4PCST("",1) D KAV ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("DISCANDDEL")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"DISCANDDEL"),WD01) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"QUANT"),WD02)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD03-1)_" "_DLM_TX S TX=" % "_DLM_TX D ^W4PCST(TX,1) D KAV($L(TX)) ; S TOTHNH=0 S TOTHNH=$$RKV(SDISC,DT2)+$$RKV(SHNHP,DT2)+$$RKV(SOTH,DT2)+$$RKV(SBIT,DT2)+$$RKV(SZIC,DT2) D TR("DISCOUNTS",SDISCQ,$$RKV(SDISC,DT2),"%"_TOTHNH) D TR("DISCITTOT",SHNHPQ,$$RKV(SHNHP,DT2),"%"_TOTHNH) D TR("DISCOTH",SOTHQ,$$RKV(SOTH,DT2),"%"_TOTHNH) D TR("CANCELLATIONS",SBITQ,$$RKV(SBIT,DT2),"%"_TOTHNH) D TR("ZIC",SZICQ,$$RKV(SZIC,DT2),"%"_TOTHNH) W "",! ; W "

    ",! D ^W4PCST("",1) D ^W4PCST("",1) D KAV ; D OPNTBL($$WD) W "" W ""_$$^%W1DICT("STATISTIKA")_"" W ""_$$^%W1DICT("QUANT")_"" W ""_$$^%W1DICT("TOTAL")_"" W "%" W ""_$$^%W1DICT("AVRGORD")_"" W "",! ; S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"STATISTIKA"),WD11) S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"QUANT"),WD12)_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"TOTAL"),WD13-1)_" "_DLM_TX S TX=" % "_DLM_TX S TX=$$HBR^%L1FRM($$TV^%W1DICT($$^%W1LNG,"AVRGORD"),WD15)_DLM_TX D ^W4PCST(TX,1) D KAV($L(TX)) ; S TOT=$$RKV(SDLV,DT2)+$$RKV(STAW,DT2)+$$RKV(SREST,DT2) D TR1("DELIVERY",DLVQ,$$RKV(SDLV,DT2),TOT,DT2) ; I DLVQ D .D TR1("SUPPLIEDTIME",DLVQ,SMIN,"","") ; D TR1("TAKEAWAYORDERS",TAWQ,$$RKV(STAW,DT2),TOT) D TR1("SITINLOCAL",RESTQ,$$RKV(SREST,DT2),TOT) S TOTQ=DLVQ+TAWQ+RESTQ D KAV(38) D TR1("TOTAL",TOTQ,$J(TOT,DR,DR),"","B") ; W "",! W "
    ",! Q ; ; KOT(DT1,DT2) N DAT1,DAT2,TX S DAT1=$ZD(DT1,"DD.MM.YY") S DAT2=$ZD(DT2,"DD.MM.YY") I DT1=DT2 D .W $$^%W1DICT("MANYREP2DAT",DAT1) .S TX=$$TV^%W1DICT($$^%W1LNG,"MANYREP2DAT",DAT1) I DT1'=DT2 D .W $$^%W1DICT("MANYREP2PERIOD",DAT1_"<>"_DAT2) .S TX=$$TV^%W1DICT($$^%W1LNG,"MANYREP2PERIOD",DAT1_"<>"_DAT2) ; D ^W4PCST(TX,1) ;;D KAV($L(TX)) Q ; SUMZ(DT1,DT2,IND) ; N GL N SUM S SUM=0 N DT,DAT F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .S GL=$$^W4GL("Z1") . .I '$D(@GL@(DAT)) D Q ..D ^W4SUMZRO ..D ^W4SUM ..S GL=$$^W4GL("TOT") ..N VL S VL=$G(@GL@(DAT,IND,1)) ..D SUMZVL(VL,DT,IND) . .N N S N="" F S N=$O(@GL@(DAT,N)) Q:N="" D ..N VL S VL=$G(^(N,IND,1)) ..D SUMZVL(VL,DT,IND) ; Q SUM ; ; SUMZVL(VL,DT,IND) ; I $$LMAM,IND'["#" D .N AHMAM S AHMAM=$$MAMD^W4L(DT) .S VL=$J(VL*100/(100+AHMAM),5,5) S SUM=SUM+VL Q ; HB(DT1,DT2) ; N SUM,QN S SUM=0,QN=0 N CODDOC N GL S GL=$$^W4GL("KLIN") ; F CODDOC="H","TZ" D .N N S N="" F S N=$O(@GL@(CODDOC,N)) Q:N="" D ..D ^W4HSBGET(N,CODDOC) ..N DAT S DAT=$G(W4HSB("TODATE")) ..N DT S DT=$$^%L1DC(DAT,3) ..I DTDT2) Q ..S QN=QN+1 ..N VL S VL=$S($$LMAM:$G(W4HSB("LMAM")),1:W4HSB("TOT")) ..S SUM=SUM+VL ..S SUM(CODDOC)=$G(SUM(CODDOC))+VL Q SUM_"\"_QN ; ; TR(NM,QN,VL,VLP,PR) ; S QN=$G(QN) S VL=$G(VL) S VLP=$G(VLP) ; N TX S TX="" ; I NM'["<>" D .S TX=$$TV^%W1DICT($$^%W1LNG,NM) ; I NM["<>" D .S TX=$P(NM,"<>",2) .S NM=$P(NM,"<>") ; S TX=$$HBR^%L1FRM(TX,WD01) ; W "" W "" D .I $E(NM)="!" W $E(NM,2,255) Q .W $$^%W1DICT(NM) W "",! ; D TDLTR W $$STYLE(QN) W ">" W QN S TX=$J(QN,WD02)_" "_TX W "",! ; D TDLTR W $$STYLE(VL) W ">" W $S(VL="":" ",1:$J(VL,DR,DR)) N VL1 S VL1=$S(VL="":"",1:$J(VL,DR,DR)) S TX=$J(VL1,WD03)_" "_TX W "",! ; I $E($G(VLP))="%" D .N TOT S TOT=$E(VLP,2,20) .I 'TOT S VLP="" Q .S VLP=$J(VL*100/TOT,DR,DR) ; D TDLTR W $$STYLE(VLP) W ">" W $S(VLP="":" ",1:$J(VLP,DR,DR)) S TX=$J(VLP,WD04)_" "_TX W "",! W "",! ; D ^W4PCST(TX,1) Q ; ; TR1(NM,QN,VL,TOT,PR) ; S QN=$G(QN) S VL=$G(VL) ; N TX S TX="" ; I NM'["<>" D .S TX=$$TV^%W1DICT($$^%W1LNG,NM) ; I NM["<>" D .S TX=$P(NM,"<>",2) .S NM=$P(NM,"<>") ; S TX=$$HBR^%L1FRM(TX,WD11) ; W "" W "" D .I $E(NM)="!" W $E(NM,2,255) Q .W $$^%W1DICT(NM) W "",! ; D TDLTR W $$STYLE(QN) W ">" N QN1 D .I NM="SUPPLIEDTIME" S QN1=" " Q .S QN1=QN W QN1 S TX=$J(QN1,WD12)_" "_TX W "",! ; D TDLTR W $$STYLE(VL) W ">" N VL1 D .I NM="SUPPLIEDTIME" S VL1=" " W VL1 Q .S VL1=$J(VL,DR,DR) W VL1 S TX=$J(VL1,WD13,2)_" "_TX W "",! ; D TDLTR W ">" D .N RKV .D ..I 'TOT S RKV=" " Q ..S RKV=$J(VL*100/TOT,DR,DR) .W RKV .S TX=$J(RKV,WD14)_" "_TX W "",! ; D TDLTR W ">" D .N RKV .I 'QN S RKV=" " .E S RKV=$J(VL/QN,DR,DR) .W RKV .S TX=$J(RKV,WD15)_" "_TX W "" ; D ^W4PCST(TX,1) Q ; ; TDLTR ; W "",! W "" W "" W $$^%W1DICT("AFTERTAX")_"  " W "" W "" W "" W $$^%W1DICT("BEFORETAX")_"  " W "" W "" W "",! W "",! Q ; ; LMAM() ; Q $G(%ARG("LMAM")) ; ; SUMMAM(DT1,DT2) ; N GL S GL=$$^W4GL("Z1") N SUM S SUM=0 N IND ; N DT,DAT F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .N N S N="" F S N=$O(@GL@(DAT,N)) Q:N="" D ..N IND S IND="" F S IND=$O(@GL@(DAT,N,IND)) Q:IND="" D ...I ",F,G,V,"'[(","_IND_",") Q ...N VL S VL=$G(^(IND,1)) ...N AHMAM S AHMAM=$$MAMD^W4L(DT) ...S VL=$J(VL*AHMAM/(100+AHMAM),5,5) ...S SUM=SUM+VL Q SUM ; RKV(VL,DT) ; I '$$LMAM Q $J(VL,DR,DR) N AHMAM S AHMAM=$$MAMD^W4L(DT) S VL=$J(VL*100/(100+AHMAM),5,5) Q $J(VL,DR,DR) ; STYLE(VL) ; I VL<0 Q "style=""color:red"" " I +VL=0 Q "style=""color:grey"" " Q "" ; OPNTBL(WD) ; W "",! Q ; WD() ; Q 60 ; KAV(LN) ; N TX S TX=$TR($J("",39)," ","-") D ^W4PCST(TX,1) Q W4GCOUP W4GCOUP ; [ 08.10.21 15:00 ] [ 29.09.21 09:20 ] [ 22.09.21 17:26 ] START ; I +$$GCOUPIT^W4PRM=0 D Q .W "
    " . W "GIFT COUPON PARAMETERS NOT DEFINED !" .W "
    ",! ; S:$G(%ARG("W4OPT"))="POP" %ARG("NOBACK")=1 D ^W4SCASK Q ; W(STAM) ; N HZM,NAME,LL S NAMEP=$$GET^W4TMPANS($$VP,"PAYERNAME") I $L(NAMEP)<2 Q "CUSTOMNAMEWRONG" S NAMER=$$GET^W4TMPANS($$VP,"RECIPIENTNAME") I $L(NAMER)<2 Q "CUSTOMNAMEWRONG" Q 1 ; INIT ; D CLEAR^W4SCASK N VP S VP=$$VP D KILL^%W1PRM("W4OPT") D PUT^%W1PRM("W4OPT",$G(%ARG("W4OPT"))) ; I $$GETP^%W1PRM("TLDFLT"),$$TLDFLT^W4PRM D .K @$$^W4MAIN("TMPSCANS")@(VP) .S @$$^W4MAIN("TMPSCANS")@(VP,"SUM")=$$TLDFLT^W4PRM .S @$$^W4MAIN("TMPSCANS")@(VP,"RECIPIENTNAME")="PAYER" ; D PUT^%W1PRM("VP",VP) D CREATE^W4ASK(VP,"PAY") D PUT^%W3DEB("W4GCOUP","VP=VP") N HZM S HZM=$$GETP^%W1PRM("HZM") I HZM<1 Q ;;Q:'HZM D PUT^W4TMPANS(VP,"SUM",$$GCOUPSUM^W4HZMST(HZM)) I $$GCOUPC^W4PRM D PUT^W4TMPANS(VP,"COUPNUMBER",$$GCOUPTLM^W4HZMST(HZM)) D PUT^W4TMPANS(VP,"PAYERNAME",$$GCOUPPAYER^W4HZMST(HZM)) D PUT^W4TMPANS(VP,"PAYERTEL",$$GCOUPTEL^W4HZMST(HZM)) D PUT^W4TMPANS(VP,"RECIPIENTNAME",$$GCOUPRCP^W4HZMST(HZM)) Q ; SUM ; I VL<1 D .S %SC("ER")=1 .S %SC("ER","MSG")="NOZERO" Q ; COUPNUMBER ; I VL<1 D Q .S %SC("ER")=1 .S %SC("ER","MSG")="FILLCOUPNUMBER" ; I $D(@$$^W4GL("W4TLMTN")@(VL)) D .N HZM S HZM=$$HZM^W4TLMTN(VL) Q:HZM=$$GETP^%W1PRM("HZM") .S %SC("ER")=1 .S %SC("ER","MSG")="COUPSOLD;"_HZM Q ; TEL ; I $$GETP^%W1PRM("TLDFLT"),$L(VL)<4!(VL'?1N.N) D Q .S %SC("ER")=1 .S %SC("ER","MSG")="MINLENN;4" I $$GETP^%W1PRM("TLDFLT") Q ; I $L(VL)<7 D Q .S %SC("ER")=1 .S %SC("ER","MSG")="MINLENN;7" ; I '$$GCOUPASR^W4PRM D .N LKHNAME S LKHNAME=$$GET^W4TMPANS($$VP,"PAYERNAME") .I LKHNAME?.P S LKHNAME=$$LKH^W4L(VL) .D PUT^W4TMPANS($$VP,"PAYERNAME",LKHNAME) Q ; PAYER ; I $L(VL)<2 D .S %SC("ER")=1 .S %SC("ER","MSG")="MINLENN;2" Q ; VP(STAM) ; I $$GETP^%W1PRM("TLDFLT"),$$TLDFLT^W4PRM Q "GCOUPT" I $$GCOUPC^W4PRM,$$GCOUPIT^W4PRM Q "GCOUPC" I $$GCOUPASR^W4PRM&'$$GCOUPIT^W4PRM Q "GCOUPA" Q "GCOUP" ; CUST ; N LKH K %SC("ER") S LKH=VL I $TR(LKH,"-","")'?1N.N D Q .S %SC("ER")=1 .S %SC("ER","MSG")="FINDCUST" ; I VL'=$$GET^W4TMPANS($$VP,"CUSTOMNUMBER") D .D PUT^W4TMPANS($$VP,"PAYERTEL","") .D PUT^W4TMPANS($$VP,"PAYERNAME","") ; N LKHNAME S LKHNAME=$$GET^W4TMPANS($$VP,"PAYERNAME") I LKHNAME?.P S LKHNAME=$$LKH^W4L(LKH) D PUT^W4TMPANS($$VP,"PAYERNAME",LKHNAME) ; N TEL S TEL=$$GET^W4TMPANS($$VP,"PAYERTEL") I TEL?.P S TEL=$$TEL^W4L(VL) D PUT^W4TMPANS($$VP,"PAYERTEL",TEL) Q W4GETHZ W4GETHZ(HZM,TMPORD,PRMDB) ; [ 09.04.24 16:22 ] [ 02.01.24 15:46 ] [ 17.12.23 11:32 ] ; -- $$^W4ORD --> ^TMPORD N (HZM,JB,%ARG,%REM,TMPORD,PRMDB) ; N OK S OK=0 I $G(HZM)["M" D I OK Q OK .K @$$^W4TMPORD .M @$$^W4TMPORD=@$$^W4GL("W4TMP")@(+HZM) .S OK=1 ; I $G(%ARG("MSDFROM")) S MSDFROM=%ARG("MSDFROM") I $G(%ARG("MSDTO")) S MSDTO=%ARG("MSDTO") I $G(%ARG("MSD")) S MSD=%ARG("MSD") ; I '$$HZAFTPAY^W4PRM D CHKORD(HZM) ; D TMPORD,W4HZM I '$G(HZM) Q "00000" I '$D(@W4HZM) Q -1 I $D(@W4HZM)'=11 Q -2 K @TMPORD D ^W4IN ; I $$MM^W4PRM,$G(@$$^W4ORD@(HZM,"MSD")) D .D PUT^%W1PRM("CURREST",@$$^W4ORD@(HZM,"MSD")) ; D ^W4CALC(HZM) ; *** LEV 08/07/2016 ( COMMENT ) ; S ER=0 ; ;;D ^W4SETHN1(HZM) ; -- FOR OLD ^P1HZ ; *** LEV 08/07/2016 ; D KOT ; N N2I S I=0,I0=0 S (CD,CDT,CDTO,NM)="" N TMPSET D TMPSET K @TMPSET ; D MN^W4MANA N QN1,CMT1,PRMVC2 S PRMVC2=0 S N="" F S:N N0=N S N=$O(@W4HZM@(N)) Q:N="" I N?1N.E D .S C=$G(^(N)),CMT1="",PRHDST=0 .I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET .S CD=$P(C,"\",1),NM=$$SPA^%L1FRM($P(C,"\",3)) .S CD=$$CLRCD(CD) .S MH=$P(C,"\",4),CM=$P(C,"\",5) .I CM["." S CM=$J(CM,3,3) .S CMNT=$P(C,"\",8) .;;S CMNT=$$^W4CLRCMN(CMNT) ; -- 11/12/22 .S GLIST=$P(C,"\",9) .S PRN=$P(C,"\",11) .S NOTSFMVC=$P(C,"\",12) . .S MVC2=$P(C,"\",14) .S TSF=0,SUM=MH*CM . .I CD?1"-"1N.N.".".N1"%",I0 D Q ..N CD0 S CD0=$P($G(@TMPORD@(I0)),"~",2) ..I '$$CLOSE^W4HZMST(HZM),$$^W4PRTBH(CD0) S CD="-0%" ..S $P(@TMPORD@(I0),"~",6)=+$E(CD,2,20) ..S $P(@TMPORD@(I0),"~",7)=CMNT ..S $P(@TMPORD@(I0),"~",8)=NOTSFMVC ..S $P(@TMPORD@(I0),"~",13)="HZ" . .S I=$$TMPI .S I0=I .S @TMPORD@(I)="0~"_CD_"~"_NM_"~"_MH_"~"_CM D NOMOD(C) .S $P(@TMPORD@(I),"~",14)=PRN .I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST . .I $L(MVC2) D ..S $P(@TMPORD@(I),"~",17)=MVC2,PRMVC2=1 ..I '$D(@W4HZM@("MVC2")) S @TMPORD@("MVC2")=1 Q ..M @TMPORD@("MVC2")=@W4HZM@("MVC2") .; .S CMNT=$$CLMANA(CMNT) .D SETMANA("CMNT",I) .S N2I(N)=I . .I $$LENCMNT(CMNT) D ..I CMNT["{",CMNT'["{{" D Q:CMNT?.P ; -- ??? ...S CMNT=$P(CMNT,"{",2) ...S $P(@TMPORD@(I),"~",7)=CMNT ...S $P(@TMPORD@(I),"~",13)="HZ" ...S CMNT=$P(CMNT,"{")_" "_$P(CMNT,"}",2) .. ..S I=$$TMPI ..S @TMPORD@(I)="1~"_CD_"-C"_$$CDCMNT(CD,CMNT)_"~"_$$CLR(CMNT) ..D NOMOD(C) . .D ^W4N2V(HZM,N) . .N VRMHZ S VRMHZ=$$^W4MAIN("VRMHZ") . .S N2V="" F S N2V=$O(@VRMHZ@(N2V)) Q:N2V="" I N2V?1N.E D ..S N1=$G(^(N2V)) Q:N1="" ..N NPSET,NP ..N T S T=$G(@W4HZM@(N,N1)) ..N HDST S HDST=$P(T,"\",18) ..; ..I HDST>999 S PRHDST=1 D ...N STT S STT="1~A"_$P(HDST,"^")_"~"_$P(HDST,"^",2) ...D SETNOMODT("STT",T) ...N IND S IND=$O(@TMPORD@(99999),-1)+1 ...S @TMPORD@(IND)=STT ...S STT="" ; .. ..N CDT,NMT,CMNT ..S NMT=$$SPA^%L1FRM($P(T,"\")) ..S CDT=N1 I $E(CDT,1,2)'="0-" S CDT=$P(CDT,"-") ..S CDT=$$CLRCD(CDT) ..S MHT=$P(T,"\",2) ..N SUGPZ S SUGPZ=$$SUG^W4PIZZA(NM) ..S CMT=$P(T,"\",3) ..S CMNTT=$P(T,"\",4) .. ..I SUGPZ D ...I CMT?1N.N1"|".E,CMT["+" Q ...I CMT?1N.N1":".E,CMT["+" Q ...I $$^W4QNR(CMT)<0 Q ...N COL,J,SMB S COL="" F J=3:1:6 S SMB=$P(T,"\",J) S:SMB="" SMB="-" S:SMB="+"!(SMB="-") COL=COL_SMB ...S CMT=$L(COL,"+")-1_$S(SUGPZ=4:":",1:"|")_COL ...S CMNTT=$P(T,"\",8) ..; ..S CMT=$$STQ(HZM,CD,CM,CMT,1) ..S CMT1=$P(CMT,":"),CMT1=$P(CMT,"|") ..; ..N STT S STT="1~"_CDT_"~"_NMT_"~"_MHT_"~"_$P(CMT,"|",1,2) ..D SETNOMODT("STT",T) ..; ..I $L(CD) S SET=$$SET(CD,CDT) I SET D G LV2 ...D SBORKA(CD,SET,STT_"~~"_CMNTT) ..; ..I $D(@W4HZM@(N,N1))>9 G LV2 ; --- NEW !!! 13/02/13 .. ..S I=$$TMPI ..S @TMPORD@(I)=STT D NOMOD(T) ..S N2I(N_"-"_CDT)=I .. ..I $L(CMNTT) D ...S CMNTT=$$CLMANA(CMNTT) ...D SETMANA("CMNTT",I) .. ..I $$LENCMNT(CMNTT) D ...N STT ...N LVO S LVO=$P($G(@TMPORD@(I-1)),"~") S:'LVO LVO=1 ...S STT=LVO_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) ...S $P(STT,"~",12)=$P(T,"\",10) ...S $P(STT,"~",13)="HZ" ...S I=$$TMPI ...S @TMPORD@(I)=STT ...S N2I(N_"-C"_CDT)=I ...D NOMOD(T) .. LV2 ..N GLIST,ITM S ITM="",QN1="" ..S N2="" F S N2=$O(@W4HZM@(N,N1,N2)) Q:N2="" I N2 D ...N T2,LV S T2=$G(^(N2)) ...N CDT2,NMT2,CMNT2,CDT21,NMT21 ...S CDT21=$P(T2,"\") ...I $E(CDT21,1,2)'="0-" S CDT21=$P(CDT21,"-") ...S CDT21=$$CLRCD(CDT21) ...S NMT21=$P(T2,"\",2) ...S CDT2=$P($P(T2,"\",4),"-") ...I $E(CDT2,1,2)'="0-" S CDT2=$P(CDT2,"-") ...S CDT2=$$CLRCD(CDT2) ...S NMT2=$$SPA^%L1FRM($P(T2,"\",5)) ...S MHT2=+$P(T2,"\",7),QN2=$P(T2,"\",3) ...S CMNT2=$P(T2,"\",6),MANA="" ...; ...I $L(CDT21) D Q ....S LV=1 ....S QN1=$$STQ(HZM,CD,CM,QN2,LV) ....S CMT1=$P(QN1,":"),CMT1=$P(QN1,"|") ....N STT2 S STT2=LV_"~"_CDT21_"~"_NMT21_"~"_MHT2_"~"_$P(QN1,"|",1,2) .... ....I $D(@W4HZM@(N,N1,N2,"HNT")) D .....N HNT S HNT=$G(^("HNT")) .....S $P(STT2,"~",4)=$P(HNT,";",2) .....S $P(STT2,"~",6)=+HNT .... ....S ITM=$$^W4ITM(STT2) ....I $L($G(CMNT2)) S $P(ITM,"^",7)=CMNT2 ....D SETNOMODT("STT2",T2) ....S GLIST=$$SPA^%L1FRM($P(T2,"\",9)) ....D SETORD2(LV,STT2,N2) ....;;S CMT=QN2 ....D SETCMNT2(CDT21,CMNT2) ... ...I CDT2 D Q ....S LV=2 ....; ....I $G(CMT) S QN2=$$STQ(HZM,CD,CMT1,QN2,LV) .... ....N STT2 S STT2=LV_"~"_CDT2_"~"_NMT2_"~"_MHT2_"~"_$P(QN2,"|",1,2) ....I $L($G(ITM)) D SET^W4ITM("STT2",ITM) ....D SETNOMODT("STT2",T2) ....D SETORD2(LV,STT2,N2) ....D SETCMNT2(CDT2,CMNT2) . .K @$$^W4MAIN("VRMHZ") ; ; I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET ; -- ? ; N I,I1,A,CDT ; ; S SRV="" F S SRV=$O(@W4HZM@(SRV)) Q:SRV="" I SRV?1U.E D ; -- SERVIS INFORMATION .I $D(@W4HZM@(SRV))#2 S @TMPORD@(SRV)=@W4HZM@(SRV) .N N1 S N1="" F S N1=$O(@W4HZM@(SRV,N1)) Q:N1="" D ..I $D(N2I(N1)),SRV'="PART",SRV'="TB",SRV'="CB" D Q ...N IND S IND=N2I(N1) ...M @TMPORD@(SRV,IND)=@W4HZM@(SRV,N1) ...I IND,IND?1N.N D ....N A S A=$G(@TMPORD@(IND)) ...K @TMPORD@(SRV,IND,"O2T") ..M @TMPORD@(SRV,N1)=@W4HZM@(SRV,N1) Q ; M @TMPORD@("FIRE")=@W4HZM@("FIRE") K @TMPORD@("DEL") K @TMPORD@("DELT") K @TMPORD@("KINDORD") K @TMPORD@("MKRDLV") K @TMPORD@("MKRDLV1") ; I '$G(PRMVC2) K @TMPORD@("MVC2") ; D ^W4TMPHD K @TMPORD@("SDSAK") Q 1 ; ; ; CLRCD(CD) ; I $G(CD)[">" S CD=$P(CD,">",2) Q CD ; ; CMT2(CM,CMR,CMTR,CMT2) N CMT2 D .I $G(CMR),CMTR\CMR*CMR=+CMTR D Q ..S CMT2=CMTR\CMR I CMT2<0,CM<0 S CMT2=-CMT2 Q $G(CMT2) ; STQ(HZM,CD,CM,CMT,LV) ; N CMT2,STQ S CMT2=CMT,STQ="" I CMT["*" S CMT2=$P(CMT,"*",$L(CMT,"*")) N DOP S DOP=$$DOP^W4PIZZA(CMT2) I CMT2<0,CM<0 S CMT2=-CMT2 ; N CMR S CMR=$$^W4QNR(CM) N CMTR S CMTR=$$^W4QNR(CMT) N QN S QN=CM ; I $G(LV)=1,'$$^W4EZAT(CD) D Q STQ ; -- TOSAFOT RAGILOT .I CMT["*" S STQ=CM_"*"_CMT2_DOP Q .S CMT2=$$CMT2(CM,CMR,CMTR,CMT2) .S STQ=CM_"*"_CMT2_DOP ; I '$G(CM)!($G(CM)=1),'$$MULTY(HZM) Q CMT_DOP ; I $G(LV)=1,$$MULTY(HZM),CMT'["*" D .S CMT2=$$CMT2(CM,CMR,CMTR,CMT2) .S CMT=CM_"*"_CMT2 ; I $G(LV)=2 D .S CMT2=$$CMT2(CM,CMR,CMTR,CMT2) .I CMT2 S CMT=CM_"*"_CMT2 ; Q CMT_DOP ; ; TMPI(STAM) ; D TMPORD Q ($O(@TMPORD@(99999),-1)+1) ; ; SETCMNT2(CDT2,CMNT2) ; N MANA ; I $L(CMNT2) D .S CMNT2=$$CLMANA(CMNT2) ; S MANA=$P(CMNT2,"\",2) S CMNT2=$P(CMNT2,"\") ; I MANA,'$G(NPSET) D .N I S I=$O(@TMPORD@(99999),-1) .S MANA=$$MANA($G(CD),MANA) .S @TMPORD@(I,"MANA")=MANA ; I $$LENCMNT(CMNT2),$G(LV) D .S STT2=LV_"~"_CDT2_"-C"_+$$CDCMNT(CDT2,CMNT2)_"~"_$$CLR(CMNT2) .D SETNOMODT("STT2",T2) .S CMNT2="" D SETORD2(LV,STT2,N2) Q ; ; KOT ; D W4HZM N A,B,C,I S A=$G(@W4HZM) ; ------- !!! S $P(A,"\",60)=$P(A,"\",30) S $P(A,"\",77)=$P(A,"\",33) ; I $P(A,"\") D .N LK S LK=$$SPA^%L1FRM($P(A,"\")) .S $P(A,"\")=$TR(LK,"-","") ; S TIME=$P(A,"\",6) S $P(A,"\",42)=$P(TIME,":") S $P(A,"\",43)=$P(TIME,":",2) I $P(A,"\",21)=8 S $P(A,"\",21)=5 S $P(A,"\",27)=$TR($P(A,"\",27),"-!","") S $P(A,"\",38)=$P(A,"\",22) I $P(A,"\",38),$P(A,"\",38)'["%" S $P(A,"\",38)=$P(A,"\",38)_"%" N HN S HN=$P(A,"\",8) ; I $$ONLINE^W4DLVCSR,HN,HN'["%" D .S $P(A,"\",38)="" ; I $P(A,"\",8)["%" D .N AH S AH=$P(A,"\",8) .I AH["=" S AH=$P(AH,"=",2) .S $P(A,"\",38)=AH .I $P(A,"\",8)'["=" S $P(A,"\",8)="" .I $P(A,"\",8)["=" S $P(A,"\",8)=+$P(A,"\",8) ; S COMP="" S B=$G(@W4HZM@("HR2")) I $L($P(A,"\",2)),$$COMP^W3PRM!$L($P(B,"\\",5)) D ; *** 10/08/20 .S COMP=$P(A,"\",2) .S $P(A,"\",47)=COMP ; S $P(A,"\",34)=$P(B,"\\",6) ; -- HEARA S $P(A,"\",31)=$P(B,"\\",4) ; IR I $L($P(B,"\\",5)) S $P(A,"\",2)=$P(B,"\\",5) ; *** 10/08/20 S $P(A,"\",32)=$P(B,"\\",7) ; PELE ; S CIBCARD=$G(@W4HZM@("CIBCARD")) I $L(CIBCARD) D .S $P(A,"\",46)=$$^W3ENCR(HZM_";"_CIBCARD) ; S CREDCARD=$G(@W4HZM@("CREDCARD")) I $L(CREDCARD) D .S $P(A,"\",48)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~")) .S $P(A,"\",49)=$P(CREDCARD,"~",2) .S $P(A,"\",50)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~",3)) ; S $P(A,"\",51)=$$MKRDLV^W4HZMST(HZM) S $P(A,"\",55)=$$PSL^W4HZMST(HZM) ; S $P(A,"\",56)=$$EMAIL^W4HZMST(HZM) S $P(A,"\",57)=$$MIKUD^W4HZMST(HZM) S $P(A,"\",58)=$$FAX^W4HZMST(HZM) S $P(A,"\",59)=$$TELB^W4HZMST(HZM) S $P(A,"\",63)=$$ADSHAA^W4HZMST(HZM) S $P(A,"\",70)=$$POOLED^W4HZMST(HZM) S $P(A,"\",74)=$$KINDORD^W4HZMST(HZM) S $P(A,"\",75)=$G(@W4HZM@("COORD")) S $P(A,"\",76)=$$MKRDLV1^W4HZMST(HZM) ; ; S @TMPORD=$TR(A,"\","~") ; I $P(A,"\",6)?2N1":"2N S $P(@TMPORD,"~",35)=$P(A,"\",6) ; - ZMAN MEUSHAR Q ; ; SETORD2(LV,STT2,N2) ; I $L($G(CMNT2)) S $P(STT2,"~",7)=CMNT2 I $L($G(GLIST)) S $P(STT2,"~",9)=GLIST I $G(NPSET),$G(NP) D SBORKA2(NPSET,NP,STT2,N2) Q ; S I=$$TMPI S @TMPORD@(I)=STT2 D NOMOD(T2) ; I $L($G(GLIST)) D .S @TMPORD@(I,"GLIST")=GLIST ; S N2I(N_"-"_CDT_"-"_N2)=$$IND(I) Q ; ; W4HZM I $D(%ARG("GLORD")) S W4HZM=%ARG("GLORD") Q N GLORD D GLORD^W4HZMST S W4HZM=GLORD Q ; TMPORD I $G(TMPORD)="" S TMPORD="^[$$^W3MAIN]TMPORD(JB)" Q ; NOMOD(ST0) S $P(@TMPORD@(I),"~",12)=$P(ST0,"\",10) S $P(@TMPORD@(I),"~",13)="HZ" S $P(@TMPORD@(I),"~",16)=$P(ST0,"\",13) Q ; CDCMNT(CD,CMNT) ; CMNT --> CD I $G(CD)=""!($G(CMNT)="") Q "" S CMNT=$$SPA^%L1FRM(CMNT) N CDCMNT S CDCMNT="" N P1CODH S P1CODH=$$^W4GL("P1CODH") ; N N S N="" F S N=$O(@P1CODH@(N)) Q:N="" D Q:$L(CDCMNT) .I $$SPA^%L1FRM($G(^(N)))=CMNT S CDCMNT=N I CDCMNT,'$D(@$$^W4GL("P1EZH")@(CD,CDCMNT)) D .N SUG S SUG=$$SUG^W4P(CD) I 'SUG S CDCMNT=0 Q .I '$D(@$$^W4GL("P1EZHK")@(SUG,CDCMNT)) S CDCMNT=0 I CDCMNT="" S CDCMNT=0 Q CDCMNT ; ; CLMANA(CMNT) ; I '$L($G(CMNT)) Q "" N N,MANA S MANA="" I '$D(MN) D MN^W4MANA ; S N="" F S N=$O(MN(N)) Q:N="" I $L(MN(N)) D Q:MANA .I CMNT[MN(N) D ..S MANA=N ; ..S CMNT=$$RPL^%L1FRM(CMNT,MN(N),"") Q CMNT_"\"_MANA ; ; SET(CD,CDT) ; I $G(CD)=""!($G(CDT)="") Q 0 I $G(PRHDST) Q 0 N SET,OK S OK=0 ;-- SET="A"+NSET N GL S GL=$$GLEZ(CD) I GL="" Q 0 S SET="" F S SET=$O(@GL@(CD,SET)) Q:SET="" D Q:OK .Q:$E(SET)'="A" .N NSET S NSET=$E(SET,2,6) Q:NSET="" .I $D(@$$^W4GLSET(HZM)@(NSET,CDT)) S OK=NSET Q OK ; SETNAME(SET) ; Q $P($G(@$$^W4GLSET(HZM)@(SET)),"\") ; SETEXIST(I,SET) ; I $G(PRHDST) Q 0 N TMPORD D TMPORD N A,OK S OK=0 N I1 F I1=I:-1:1 S A=$G(@TMPORD@(I1)) Q:$P(A,"~")=0 D Q:OK .I $P(A,"~",2)=("A"_SET) S OK=1 Q OK ; TMPSET S TMPSET="^[$$^W3MAIN]TMPSET($$^%W1JB)" Q ; SBORKA(CD,SET,STT) ; --> NPSET,NP I $G(PRHDST) Q N TMPSET,CDT,CMNTT D TMPSET S CDT=$P(STT,"~",2) Q:CDT="" S NPSET=$$NPSET(CD,SET) Q:NPSET="" S NP=$G(@$$^W4GLSET(HZM)@(SET,CDT)) Q:NP="" I '$D(@TMPSET@(NPSET)) S @TMPSET@(NPSET)=SET S @TMPSET@(NPSET,NP)=STT S @TMPSET@(NPSET,NP,"IND")=N_"-"_$P(STT,"~",2) Q ; NPSET(CD,SET) ; I $G(PRHDST) Q 0 N GL S GL=$$GLEZ(CD) I GL="" Q "" I '$D(@GL@(CD,"A"_SET)) Q "" N NPSET S NPSET=$G(@GL@(CD,"A"_SET)) I $G(PRMDB),$P(NPSET,">",2) Q $P(NPSET,">",2) Q +NPSET ; SBORKA2(NPSET,NP,STT2,N2) I $G(PRHDST) Q N IND S IND=$O(@TMPSET@(NPSET,NP,9999),-1)+1 S @TMPSET@(NPSET,NP,IND)=STT2 S @TMPSET@(NPSET,NP,IND,"IND")=N_"-"_$P($G(@TMPSET@(NPSET,NP)),"~",2)_"-"_N2 Q ; ; SETSET ; N SET,NP,NP2,STT,STT2,CDT,NPSET D TMPSET,TMPORD I $G(PRHDST) K @TMPSET Q N LAST,IND ; S NPSET="" F S NPSET=$O(@TMPSET@(NPSET)) Q:NPSET="" D .S SET=$G(^(NPSET)) Q:SET="" .S I=$$TMPI,@TMPORD@(I)="1~A"_SET_"~"_$$SETNAME(SET) D SETNOMOD(I) . .S NP="" F S NP=$O(@TMPSET@(NPSET,NP)) Q:NP="" D ..N STT S STT=$G(^(NP)) .. ..I '$O(@TMPSET@(NPSET,NP,"")) D SETST(STT,1) D Q ...S IND=$G(@TMPSET@(NPSET,NP,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) .. ..S NP2="" F S NP2=$O(@TMPSET@(NPSET,NP,NP2)) Q:NP2="" I NP2 D ...N STT2 S STT2=$G(^(NP2)) D SETST(STT2,2) ...S IND=$G(@TMPSET@(NPSET,NP,NP2,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) ; K @TMPSET Q ; ; SETST(STT,UR) ; N GLIST S I=$$TMPI ; N ST S ST=$P(STT,"~",1,6)_"~~"_$P(STT,"~",8,20) S GLIST=$$SPA^%L1FRM($P(ST,"~",9)) S $P(ST,"~",9)="" S $P(ST,"~",13)="HZ" ; I $P(ST,"~",2)["-C",$P($G(@TMPORD@(I-1)),"~",2)["-C" Q ; S @TMPORD@(I)=ST I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST ; N CMNTT S CMNTT=$P(STT,"~",7) S CMNTT=$$CLMANA(CMNTT) ; D SETMANA("CMNTT",I) ; I $$LENCMNT(CMNTT) D .N CDT S CDT=$P(STT,"~",2) .I $P($G(@TMPORD@(I)),"~",2)[(CDT_"-C") Q .S I=$$TMPI .S @TMPORD@(I)=$P(STT,"~")_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) .S $P(^(I),"~",12)=$P(STT,"~",12) .S $P(^(I),"~",13)="HZ" ; Q ; ; GLEZ(CD) ; N GL S GL="" I $D(@$$^W4GL("P1EZA")@(CD)) S GL=$$^W4GL("P1EZA") I $D(@$$^W4GL("P1EZT")@(CD)) S GL=$$^W4GL("P1EZT") Q GL ; SETNOMOD(I) ; S $P(@TMPORD@(I),"~",12)="@@@+" S $P(@TMPORD@(I),"~",13)="HZ" Q ; SETNOMODT(STR,T) ; S $P(@STR,"~",12)=$P(T,"\",10) ;;W "STR="_STR,! S $P(@STR,"~",13)="HZ" S $P(@STR,"~",16)=$P(T,"\",13) S $P(@STR,"~",18)=$P(T,"\",18) Q ; CLR(TXT) ; -- DEL ; MEUTARIM N I,TXT1,FL S TXT1="",FL=0 F I=1:1:$L(TXT) D .S FL=$S($E(TXT,I)=";":FL+1,1:0) .Q:FL>1 .S TXT1=TXT1_$E(TXT,I) Q TXT1 ; ; CHKORD(HZM) ; N LAST,LAST0 Q:$G(HZM)<1 ; N NMB S NMB=$$NMB^W4HZMST(HZM) I $$^W4MSL(NMB),$D(@$$^W4GL("LKH")@(NMB))'=11 D .D HZ2LKH^W4REST(HZM) ; I $$^W4HZMH(HZM) D Q ; !!!!!!!!!!!!! .I $D(@$$^W4ORD@(HZM,"BIT")) D ..N IND S IND=$O(@$$^W4ORD@(HZM,"BIT","")) Q:'IND ..S @$$^W4ORD@(HZM,"DELBID")=$G(@$$^W4ORD@(HZM,"BIT",IND)) .K @$$^W4ORD@(HZM,"BIT"),@$$^W4ORD@(HZM,"MRG") ; Q:$$HZM^W4MSL(HZM) ; D ^W4CLRDBL(HZM) ; I $D(@$$^W4GL("DBLORD")@(HZM)) Q I $D(@$$^W4GL("P1HZDBL")@(HZM)) Q I $D(@$$^W4ORD@(HZM,"W4TIKHZ")) Q ; S LAST=$$COLSH0^W4HZMST(HZM) S LAST0=$$COLSH0^W4HZMST(HZM,$$^W4GL("P1HZ0")) ; I $G(@$$^W4PRM@("RESTHZ0")),LAST<(LAST0-1) D ; -- 18/11/21 --> COMMENT .K @$$^W4GL("P1HZER")@(HZM) .M @$$^W4GL("P1HZER")@(HZM)=@$$^W4ORD@(HZM) .S @$$^W4GL("P1HZER")@(HZM,"W4GETHZ")=$ZD($H,"DD.MM.YY 24:60") .K @$$^W4ORD@(HZM) .M @$$^W4ORD@(HZM)=@$$^W4GL("P1HZ0")@(HZM) .K @$$^W4ORD@(HZM,"S") ; Q ; ; SETMANA(%AAA,I) ; N MANA I $G(@%AAA)="" Q S MANA=$P(@%AAA,"\",2),@%AAA=$P(@%AAA,"\") S MANA=$$MANA($G(CD),MANA) S @TMPORD@(I,"MANA")=MANA Q ; MANA(CD,MANA) ; ; I MANA D .I $$NOROMA^W4PRM,$G(CD),$$DD^W4EZT(CD),MANA,MANA'["T" S MANA=MANA_"T" Q MANA ; LENCMNT(CMNT) ; Q $L($TR($G(CMNT)," ","")) ; IND(I) ; I $$CDSTC^W3HZMST(JB,I,TMPORD) S I=I-1 Q I ; MULTY(HZM,CD) ; I $$^W4MULTY Q 1 ;;I $G(CD),'$$^W4EZAT(CD) Q 1 I $$^W4HZMH(HZM) Q 1 I $$NODLVORD^W4PRM,$$HZM^W4MSL(HZM) Q 1 Q 0 ; W4GETHZ0 W4GETHZ(HZM,TMPORD) ; [ 08.07.16 13:32 ] [ 25.05.16 19:31 ] [ 16.05.16 12:54 ] ; -- $$^W4ORD --> ^TMPORD I $G(@$$^W4PRM@("NEWGETHZ")) D ^W4GETHZN N (HZM,JB,%ARG,%REM,TMPORD) ; I $G(%ARG("MSDFROM")) S MSDFROM=%ARG("MSDFROM") I $G(%ARG("MSDTO")) S MSDTO=%ARG("MSDTO") I $G(%ARG("MSD")) S MSD=%ARG("MSD") ; D CHKORD(HZM) ; D TMPORD,W4HZM I '$G(HZM) Q "00000" I '$D(@W4HZM) Q -1 I $D(@W4HZM)'=11 Q -2 K @TMPORD D ^W4IN D ^W4CALC(HZM) S ER=0 ; D ^W4SETHN1(HZM) ; -- FOR OLD ^P1HZ ; D KOT ; N N2I S I=0,I0=0 S (CD,CDT,CDTO,NM)="" N TMPSET D TMPSET K @TMPSET ; D MN^W4MANA ; S N="" F S:N N0=N S N=$O(@W4HZM@(N)) Q:N="" I N?1N.E D .S C=$G(^(N)) .I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET . .S CD=$P(C,"\",1),NM=$$SPA^%L1FRM($P(C,"\",3)) .S MH=$P(C,"\",4),CM=$P(C,"\",5) .S CMNT=$P(C,"\",8) .S CMNT=$$^W4CLRCMN(CMNT) .S GLIST=$P(C,"\",9) .S NOTSFMVC=$P(C,"\",12) .S TSF=0,SUM=MH*CM .I CD?1"-"1N.N.".".N1"%",I0 D Q ..S $P(@TMPORD@(I0),"~",6)=+$E(CD,2,20) ..S $P(@TMPORD@(I0),"~",7)=CMNT ..S $P(@TMPORD@(I0),"~",8)=NOTSFMVC ..S $P(@TMPORD@(I0),"~",13)="HZ" . .S I=$$TMPI .S I0=I .S @TMPORD@(I)="0~"_CD_"~"_NM_"~"_MH_"~"_CM D NOMOD(C) .I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST .; .S CMNT=$$CLMANA(CMNT) .D SETMANA("CMNT",I) .S N2I(N)=I . .I $$LENCMNT(CMNT) D ..I CMNT["{" D Q:CMNT?.P ; -- ??? ...S CMNT=$P(CMNT,"{",2) ...S $P(@TMPORD@(I),"~",7)=CMNT ...S $P(@TMPORD@(I),"~",13)="HZ" ...S CMNT=$P(CMNT,"{")_" "_$P(CMNT,"}",2) ..S I=$$TMPI ..S @TMPORD@(I)="1~"_CD_"-C"_$$CDCMNT(CD,CMNT)_"~"_$$CLR(CMNT) ..D NOMOD(C) . .D ^W4N2V(HZM,N) .;;S N1="" F S N1=$O(@W4HZM@(N,N1)) Q:N1="" I N1?1N.E D .S N2V="" F S N2V=$O(@$$^W4MAIN("VRMHZ")@(N2V)) Q:N2V="" I N2V?1N.E D ..S N1=$G(^(N2V)) Q:N1="" ..N NPSET,NP ..N T S T=$G(@W4HZM@(N,N1)) ..N CDT,NMT,CMNT ..S NMT=$$SPA^%L1FRM($P(T,"\")) ..S CDT=N1 I $E(CDT,1,2)'="0-" S CDT=$P(CDT,"-") ..S MHT=$P(T,"\",2),CMT=$P(T,"\",3) ..S CMNTT=$P(T,"\",4) .. ..I $G(CM)>1!($G(CM)<-1),CMT'["*",CMT\CM*CM=+CMT,$$^W4MULTY!'$$^W4EZAT(CD) D ...S CMT=CM_"*"_(CMT\CM)_$$DOP^W4PIZZA(CMT) .. ..N STT S STT="1~"_CDT_"~"_NMT_"~"_MHT_"~"_CMT ..D SETNOMODT("STT",T) .. ..I $L(CD) S SET=$$SET(CD,CDT) I SET D G LV2 ...D SBORKA(CD,SET,STT_"~~"_CMNTT) .. ..I $D(@W4HZM@(N,N1))>9 G LV2 ; --- NEW !!! 13/02/13 .. ..S I=$$TMPI ..S @TMPORD@(I)=STT D NOMOD(T) ..S N2I(N_"-"_CDT)=I .. ..I $L(CMNTT) D ...S CMNTT=$$CLMANA(CMNTT) ...D SETMANA("CMNTT",I) .. ..I $$LENCMNT(CMNTT) D ...N STT ...N LVO S LVO=$P($G(@TMPORD@(I-1)),"~") S:'LVO LVO=1 ...S STT=LVO_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) ...S $P(STT,"~",12)=$P(T,"\",10) ...S $P(STT,"~",13)="HZ" ...S I=$$TMPI ...S @TMPORD@(I)=STT ...S N2I(N_"-C"_CDT)=I ...D NOMOD(T) .. LV2 ..N CMT,GLIST,ITM S ITM="" ..S N2="" F S N2=$O(@W4HZM@(N,N1,N2)) Q:N2="" D ...N T2,LV S T2=$G(^(N2)) ...N CDT2,NMT2,CMNT2,CDT21,NMT21 ...S CDT21=$P(T2,"\") ...I $E(CDT21,1,2)'="0-" S CDT21=$P(CDT21,"-") ...S NMT21=$P(T2,"\",2) ...S CDT2=$P($P(T2,"\",4),"-") ...I $E(CDT2,1,2)'="0-" S CDT2=$P(CDT2,"-") ...S NMT2=$$SPA^%L1FRM($P(T2,"\",5)) ...S MHT2=+$P(T2,"\",7),QN2=$P(T2,"\",3) ...S CMNT2=$P(T2,"\",6),MANA="" ... ...I $L(CDT21) D Q ....S LV=1 ....N STT2 S STT2=LV_"~"_CDT21_"~"_NMT21_"~"_MHT2_"~"_QN2 ....I $D(@W4HZM@(N,N1,N2,"HNT")) D .....N HNT S HNT=$G(^("HNT")) .....S $P(STT2,"~",4)=$P(HNT,";",2) .....S $P(STT2,"~",6)=+HNT ....S ITM=$$^W4ITM(STT2) ....I $L($G(CMNT2)) S $P(ITM,"^",7)=CMNT2 ....D SETNOMODT("STT2",T2) ....S GLIST=$$SPA^%L1FRM($P(T2,"\",9)) ....D SETORD2(LV,STT2,N2) ....S CMT=QN2 ....D SETCMNT2(CDT21,CMNT2) ... ...I CDT2 D Q ....S LV=2 ....I QN2["*" S QN2=$P(QN2,"*",2) ....I $G(CMT) D .....N QN22 S QN22=QN2\CMT I QN22<0 S QN22=-QN22 .....I QN22<1 S QN22=1 .....S QN2=CMT_"*"_QN22_$$DOP^W4PIZZA(QN2) ....N STT2 S STT2=LV_"~"_CDT2_"~"_NMT2_"~"_MHT2_"~"_QN2 ....I $L($G(ITM)) D SET^W4ITM("STT2",ITM) ....D SETNOMODT("STT2",T2) ....D SETORD2(LV,STT2,N2) ....D SETCMNT2(CDT2,CMNT2) .K @$$^W4MAIN("VRMHZ") ; I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET ; -- ? ; N I,I1,A,CDT ; ; S SRV="" F S SRV=$O(@W4HZM@(SRV)) Q:SRV="" I SRV?1U.E D ; -- SERVIS INFORMATION .I $D(@W4HZM@(SRV))#2 S @TMPORD@(SRV)=@W4HZM@(SRV) .N N1 S N1="" F S N1=$O(@W4HZM@(SRV,N1)) Q:N1="" D ..I $D(N2I(N1)),SRV'="PART",SRV'="TB",SRV'="CB" D Q ...M @TMPORD@(SRV,N2I(N1))=@W4HZM@(SRV,N1) ...K @TMPORD@(SRV,N2I(N1),"O2T") ..M @TMPORD@(SRV,N1)=@W4HZM@(SRV,N1) Q ; D ^W4TMPHD Q 1 ; ; ; TMPI(STAM) ; D TMPORD Q ($O(@TMPORD@(99999),-1)+1) ; SETCMNT2(CDT2,CMNT2) ; N MANA ; I $L(CMNT2) D .S CMNT2=$$CLMANA(CMNT2) ; S MANA=$P(CMNT2,"\",2) S CMNT2=$P(CMNT2,"\") ; I MANA,'$G(NPSET) D .N I S I=$O(@TMPORD@(99999),-1) .S MANA=$$MANA($G(CD),MANA) .S @TMPORD@(I,"MANA")=MANA ; I $$LENCMNT(CMNT2),$G(LV) D .S STT2=LV_"~"_CDT2_"-C"_+$$CDCMNT(CDT2,CMNT2)_"~"_$$CLR(CMNT2) .D SETNOMODT("STT2",T2) .S CMNT2="" D SETORD2(LV,STT2,N2) Q ; ; KOT ; D W4HZM N A,B,C,I S A=@W4HZM ; ------- !!! S $P(A,"\",60)=$P(A,"\",30) ; I $P(A,"\") D .N LK S LK=$$SPA^%L1FRM($P(A,"\")) .S $P(A,"\")=$TR(LK,"-","") ; S TIME=$P(A,"\",6) S $P(A,"\",42)=$P(TIME,":") S $P(A,"\",43)=$P(TIME,":",2) I $P(A,"\",21)=8 S $P(A,"\",21)=5 S $P(A,"\",27)=$TR($P(A,"\",27),"-!","") S $P(A,"\",38)=$P(A,"\",22) I $P(A,"\",38),$P(A,"\",38)'["%" S $P(A,"\",38)=$P(A,"\",38)_"%" N HN S HN=$P(A,"\",8) ; ;;I $$ONLINE^W4DLVCSR,HN,HN'["%" D .S $P(A,"\",38)=$J(100*HN/($P(A,"\",11)-$P(A,"\",9)+HN),2,2) .S $P(A,"\",8)="" ; I $$ONLINE^W4DLVCSR,HN,HN'["%" D .S $P(A,"\",38)="" ; I $P(A,"\",8)["%" D .N AH S AH=$P(A,"\",8) .I AH["=" S AH=$P(AH,"=",2) .S $P(A,"\",38)=AH .I $P(A,"\",8)'["=" S $P(A,"\",8)="" .I $P(A,"\",8)["=" S $P(A,"\",8)=+$P(A,"\",8) ; ; S COMP="" I $L($P(A,"\",2)) D .S COMP=$P(A,"\",2) .S $P(A,"\",47)=COMP ; S B=$G(@W4HZM@("HR2")) S $P(A,"\",34)=$P(B,"\\",6) ; -- HEARA S $P(A,"\",31)=$P(B,"\\",4) ; IR S $P(A,"\",2)=$P(B,"\\",5) S $P(A,"\",32)=$P(B,"\\",7) ; PELE ; S CIBCARD=$G(@W4HZM@("CIBCARD")) I $L(CIBCARD) D .S $P(A,"\",46)=$$^W3ENCR(HZM_";"_CIBCARD) ; S CREDCARD=$G(@W4HZM@("CREDCARD")) I $L(CREDCARD) D .S $P(A,"\",48)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~")) .S $P(A,"\",49)=$P(CREDCARD,"~",2) .S $P(A,"\",50)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~",3)) ; S $P(A,"\",55)=$$PSL^W4HZMST(HZM) ; S $P(A,"\",56)=$$EMAIL^W4HZMST(HZM) S $P(A,"\",57)=$$MIKUD^W4HZMST(HZM) S $P(A,"\",58)=$$FAX^W4HZMST(HZM) S $P(A,"\",59)=$$TELB^W4HZMST(HZM) ; ; S @TMPORD=$TR(A,"\","~") ; I $P(A,"\",6)?2N1":"2N S $P(@TMPORD,"~",35)=$P(A,"\",6) ; - ZMAN MEUSHAR Q ; ; SETORD2(LV,STT2,N2) ; I $L($G(CMNT2)) S $P(STT2,"~",7)=CMNT2 I $L($G(GLIST)) S $P(STT2,"~",9)=GLIST I $G(NPSET),$G(NP) D SBORKA2(NPSET,NP,STT2,N2) Q ; S I=$$TMPI S @TMPORD@(I)=STT2 D NOMOD(T2) ; I $L($G(GLIST)) D .S @TMPORD@(I,"GLIST")=GLIST ; S N2I(N_"-"_CDT_"-"_N2)=$$IND(I) Q ; ; W4HZM I $D(%ARG("GLORD")) S W4HZM=%ARG("GLORD") Q N GLORD D GLORD^W4HZMST S W4HZM=GLORD Q TMPORD I $G(TMPORD)="" S TMPORD="^[$$^W3MAIN]TMPORD(JB)" Q NOMOD(ST0) S $P(@TMPORD@(I),"~",12)=$P(ST0,"\",10) S $P(@TMPORD@(I),"~",13)="HZ" Q ; CDCMNT(CD,CMNT) ; CMNT --> CD I $G(CD)=""!($G(CMNT)="") Q "" N CDCMNT S CDCMNT="" N N S N="" F S N=$O(@$$^W4GL("P1CODH")@(N)) Q:N="" D Q:$L(CDCMNT) .I $$SPA^%L1FRM($G(^(N)))=$$SPA^%L1FRM(CMNT) S CDCMNT=N I CDCMNT,'$D(@$$^W4GL("P1EZH")@(CD,CDCMNT)) D .N SUG S SUG=$$SUG^W4P(CD) I 'SUG S CDCMNT=0 Q .I '$D(@$$^W4GL("P1EZHK")@(SUG,CDCMNT)) S CDCMNT=0 I CDCMNT="" S CDCMNT=0 Q CDCMNT ; ; CLMANA(CMNT) ; I '$L($G(CMNT)) Q "" N N,MANA S MANA="" I '$D(MN) D MN^W4MANA ; S N="" F S N=$O(MN(N)) Q:N="" I $L(MN(N)) D Q:MANA .I CMNT[MN(N) D ..S MANA=N ; ..S CMNT=$$RPL^%L1FRM(CMNT,MN(N),"") Q CMNT_"\"_MANA ; ; SET(CD,CDT) ; I $G(CD)=""!($G(CDT)="") Q 0 N GL S GL=$$GLEZ(CD) I GL="" Q 0 N SET,OK S OK=0 ;-- SET="A"+NSET S SET="" F S SET=$O(@GL@(CD,SET)) Q:SET="" D Q:OK .Q:$E(SET)'="A" .N NSET S NSET=$E(SET,2,6) Q:NSET="" .I $D(@$$^W4GL("P1SETA")@(NSET,CDT)) S OK=NSET Q OK ; SETNAME(SET) ; Q $P($G(@$$^W4GL("P1SETA")@(SET)),"\") ; SETEXIST(I,SET) ; N TMPORD D TMPORD N A,OK S OK=0 N I1 F I1=I:-1:1 S A=$G(@TMPORD@(I1)) Q:$P(A,"~")=0 D Q:OK .I $P(A,"~",2)=("A"_SET) S OK=1 Q OK ; TMPSET S TMPSET="^[$$^W3MAIN]TMPSET($$^%W1JB)" Q ; SBORKA(CD,SET,STT) ; --> NPSET,NP N TMPSET,CDT,CMNTT D TMPSET S CDT=$P(STT,"~",2) Q:CDT="" S NPSET=$$NPSET(CD,SET) Q:NPSET="" S NP=$G(@$$^W4GL("P1SETA")@(SET,CDT)) Q:NP="" I '$D(@TMPSET@(NPSET)) S @TMPSET@(NPSET)=SET S @TMPSET@(NPSET,NP)=STT S @TMPSET@(NPSET,NP,"IND")=N_"-"_$P(STT,"~",2) Q ; NPSET(CD,SET) ; N GL S GL=$$GLEZ(CD) I GL="" Q "" I '$D(@GL@(CD,"A"_SET)) Q "" Q +$G(@GL@(CD,"A"_SET)) ; SBORKA2(NPSET,NP,STT2,N2) N IND S IND=$O(@TMPSET@(NPSET,NP,9999),-1)+1 S @TMPSET@(NPSET,NP,IND)=STT2 S @TMPSET@(NPSET,NP,IND,"IND")=N_"-"_$P($G(@TMPSET@(NPSET,NP)),"~",2)_"-"_N2 Q ; ; SETSET ; N SET,NP,NP2,STT,STT2,CDT,NPSET D TMPSET,TMPORD N LAST,IND S NPSET="" F S NPSET=$O(@TMPSET@(NPSET)) Q:NPSET="" D .S SET=$G(^(NPSET)) Q:SET="" .S I=$$TMPI,@TMPORD@(I)="1~A"_SET_"~"_$$SETNAME(SET) D SETNOMOD(I) .S NP="" F S NP=$O(@TMPSET@(NPSET,NP)) Q:NP="" D ..N STT S STT=$G(^(NP)) ..I '$O(@TMPSET@(NPSET,NP,"")) D SETST(STT,1) D Q ...S IND=$G(@TMPSET@(NPSET,NP,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) ..S NP2="" F S NP2=$O(@TMPSET@(NPSET,NP,NP2)) Q:NP2="" I NP2 D ...N STT2 S STT2=$G(^(NP2)) D SETST(STT2,2) ...S IND=$G(@TMPSET@(NPSET,NP,NP2,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) ; K @TMPSET Q ; ; SETST(STT,UR) ; N GLIST S I=$$TMPI ; N ST S ST=$P(STT,"~",1,6)_"~~"_$P(STT,"~",8,13) S GLIST=$$SPA^%L1FRM($P(ST,"~",9)) S $P(ST,"~",9)="" S $P(ST,"~",13)="HZ" ; I $P(ST,"~",2)["-C",$P($G(@TMPORD@(I-1)),"~",2)["-C" Q ; S @TMPORD@(I)=ST I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST ; N CMNTT S CMNTT=$P(STT,"~",7) S CMNTT=$$CLMANA(CMNTT) ; D SETMANA("CMNTT",I) ; I $$LENCMNT(CMNTT) D .N CDT S CDT=$P(STT,"~",2) .I $P($G(@TMPORD@(I)),"~",2)[(CDT_"-C") Q .S I=$$TMPI .S @TMPORD@(I)=$P(STT,"~")_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) .S $P(^(I),"~",12)=$P(STT,"~",12) .S $P(^(I),"~",13)="HZ" ; Q ; ; GLEZ(CD) ; N GL S GL="" I $D(@$$^W4GL("P1EZA")@(CD)) S GL=$$^W4GL("P1EZA") I $D(@$$^W4GL("P1EZT")@(CD)) S GL=$$^W4GL("P1EZT") Q GL ; SETNOMOD(I) ; S $P(@TMPORD@(I),"~",12)="@@@+" S $P(@TMPORD@(I),"~",13)="HZ" Q ; SETNOMODT(STR,T) ; S $P(@STR,"~",12)=$P(T,"\",10) ;;W "STR="_STR,! S $P(@STR,"~",13)="HZ" Q ; CLR(TXT) ; -- DEL ; MEUTARIM N I,TXT1,FL S TXT1="",FL=0 F I=1:1:$L(TXT) D .S FL=$S($E(TXT,I)=";":FL+1,1:0) .Q:FL>1 .S TXT1=TXT1_$E(TXT,I) Q TXT1 ; ; CHKORD(HZM) ; N LAST,LAST0 Q:$G(HZM)<1 S LAST=$$COLSH0^W4HZMST(HZM) S LAST0=$$COLSH0^W4HZMST(HZM,$$^W4GL("P1HZ0")) I LAST<(LAST0-1) D .M @$$^W4GL("P1HZER")@(HZM)=@$$^W4ORD@(HZM) .S @$$^W4GL("P1HZER")@(HZM,"W4GETHZ")=$ZD($H,"DD.MM.YY 24:60") .M @$$^W4ORD@(HZM)=@$$^W4GL("P1HZ0")@(HZM) .K @$$^W4ORD@(HZM,"S") Q ; SETMANA(%AAA,I) ; N MANA I $G(@%AAA)="" Q S MANA=$P(@%AAA,"\",2),@%AAA=$P(@%AAA,"\") S MANA=$$MANA($G(CD),MANA) S @TMPORD@(I,"MANA")=MANA Q ; MANA(CD,MANA) ; ; I MANA D .I $$NOROMA^W4PRM,$G(CD),$$D^W4EZT(CD),MANA,MANA'["T" S MANA=MANA_"T" Q MANA ; LENCMNT(CMNT) ; Q $L($TR($G(CMNT)," ","")) ; IND(I) ; I $$CDSTC^W3HZMST(JB,I,TMPORD) S I=I-1 Q I W4GETHZN W4GETHZN(HZM,TMPORD) ; [ 08.07.16 13:21 ] [ 25.05.16 19:31 ] [ 16.05.16 12:54 ] ; -- $$^W4ORD --> ^TMPORD N (HZM,JB,%ARG,%REM,TMPORD) ; I $G(%ARG("MSDFROM")) S MSDFROM=%ARG("MSDFROM") I $G(%ARG("MSDTO")) S MSDTO=%ARG("MSDTO") I $G(%ARG("MSD")) S MSD=%ARG("MSD") ; D CHKORD(HZM) ; D TMPORD,W4HZM I '$G(HZM) Q "00000" I '$D(@W4HZM) Q -1 I $D(@W4HZM)'=11 Q -2 K @TMPORD D ^W4IN ;;D ^W4CALC(HZM) S ER=0 ; ;;D ^W4SETHN1(HZM) ; -- FOR OLD ^P1HZ ; D KOT ; N N2I S I=0,I0=0 S (CD,CDT,CDTO,NM)="" N TMPSET D TMPSET K @TMPSET ; D MN^W4MANA ; S N="" F S:N N0=N S N=$O(@W4HZM@(N)) Q:N="" I N?1N.E D .S C=$G(^(N)) .I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET . .S CD=$P(C,"\",1),NM=$$SPA^%L1FRM($P(C,"\",3)) .S MH=$P(C,"\",4),CM=$P(C,"\",5) .S CMNT=$P(C,"\",8) .S CMNT=$$^W4CLRCMN(CMNT) .S GLIST=$P(C,"\",9) .S NOTSFMVC=$P(C,"\",12) .S TSF=0,SUM=MH*CM .I CD?1"-"1N.N.".".N1"%",I0 D Q ..S $P(@TMPORD@(I0),"~",6)=+$E(CD,2,20) ..S $P(@TMPORD@(I0),"~",7)=CMNT ..S $P(@TMPORD@(I0),"~",8)=NOTSFMVC ..S $P(@TMPORD@(I0),"~",13)="HZ" . .S I=$$TMPI .S I0=I .S @TMPORD@(I)="0~"_CD_"~"_NM_"~"_MH_"~"_CM D NOMOD(C) .I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST .; .S CMNT=$$CLMANA(CMNT) .D SETMANA("CMNT",I) .S N2I(N)=I . .I $$LENCMNT(CMNT) D ..I CMNT["{" D Q:CMNT?.P ; -- ??? ...S CMNT=$P(CMNT,"{",2) ...S $P(@TMPORD@(I),"~",7)=CMNT ...S $P(@TMPORD@(I),"~",13)="HZ" ...S CMNT=$P(CMNT,"{")_" "_$P(CMNT,"}",2) ..S I=$$TMPI ..S @TMPORD@(I)="1~"_CD_"-C"_$$CDCMNT(CD,CMNT)_"~"_$$CLR(CMNT) ..D NOMOD(C) . .D ^W4N2V(HZM,N) .S N2V="" F S N2V=$O(@$$^W4MAIN("VRMHZ")@(N2V)) Q:N2V="" I N2V?1N.E D ..S N1=$G(^(N2V)) Q:N1="" ..N NPSET,NP ..N T S T=$G(@W4HZM@(N,N1)) ..N CDT,NMT,CMNT ..S NMT=$$SPA^%L1FRM($P(T,"\")) ..S CDT=N1 I $E(CDT,1,2)'="0-" S CDT=$P(CDT,"-") ..S MHT=$P(T,"\",2),CMT=$P(T,"\",3) ..S CMNTT=$P(T,"\",4) .. ..I $G(CM)>1!($G(CM)<-1),CMT'["*",CMT\CM*CM=+CMT,$$^W4MULTY!'$$^W4EZAT(CD) D ...S CMT=CM_"*"_(CMT\CM)_$$DOP^W4PIZZA(CMT) .. ..N STT S STT="1~"_CDT_"~"_NMT_"~"_MHT_"~"_CMT ..D SETNOMODT("STT",T) .. ..I $L(CD) S SET=$$SET(CD,CDT) I SET D G LV2 ...D SBORKA(CD,SET,STT_"~~"_CMNTT) .. ..I $D(@W4HZM@(N,N1))>9 G LV2 ; --- NEW !!! 13/02/13 .. ..S I=$$TMPI ..S @TMPORD@(I)=STT D NOMOD(T) ..S N2I(N_"-"_CDT)=I .. ..I $L(CMNTT) D ...S CMNTT=$$CLMANA(CMNTT) ...D SETMANA("CMNTT",I) .. ..I $$LENCMNT(CMNTT) D ...N STT ...N LVO S LVO=$P($G(@TMPORD@(I-1)),"~") S:'LVO LVO=1 ...S STT=LVO_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) ...S $P(STT,"~",12)=$P(T,"\",10) ...S $P(STT,"~",13)="HZ" ...S I=$$TMPI ...S @TMPORD@(I)=STT ...S N2I(N_"-C"_CDT)=I ...D NOMOD(T) .. LV2 ..N CMT,GLIST,ITM S ITM="" ..S N2="" F S N2=$O(@W4HZM@(N,N1,N2)) Q:N2="" D ...N T2,LV S T2=$G(^(N2)) ...N CDT2,NMT2,CMNT2,CDT21,NMT21 ...S CDT21=$P(T2,"\") ...I $E(CDT21,1,2)'="0-" S CDT21=$P(CDT21,"-") ...S NMT21=$P(T2,"\",2) ...S CDT2=$P($P(T2,"\",4),"-") ...I $E(CDT2,1,2)'="0-" S CDT2=$P(CDT2,"-") ...S NMT2=$$SPA^%L1FRM($P(T2,"\",5)) ...S MHT2=+$P(T2,"\",7),QN2=$P(T2,"\",3) ...S CMNT2=$P(T2,"\",6),MANA="" ... ...I $L(CDT21) D Q ....S LV=1 ....N STT2 S STT2=LV_"~"_CDT21_"~"_NMT21_"~"_MHT2_"~"_QN2 ....I $D(@W4HZM@(N,N1,N2,"HNT")) D .....N HNT S HNT=$G(^("HNT")) .....S $P(STT2,"~",4)=$P(HNT,";",2) .....S $P(STT2,"~",6)=+HNT ....S ITM=$$^W4ITM(STT2) ....I $L($G(CMNT2)) S $P(ITM,"^",7)=CMNT2 ....D SETNOMODT("STT2",T2) ....S GLIST=$$SPA^%L1FRM($P(T2,"\",9)) ....D SETORD2(LV,STT2,N2) ....S CMT=QN2 ....D SETCMNT2(CDT21,CMNT2) ... ...I CDT2 D Q ....S LV=2 ....I QN2["*" S QN2=$P(QN2,"*",2) ....I $G(CMT) D .....N QN22 S QN22=QN2\CMT I QN22<0 S QN22=-QN22 .....I QN22<1 S QN22=1 .....S QN2=CMT_"*"_QN22_$$DOP^W4PIZZA(QN2) ....N STT2 S STT2=LV_"~"_CDT2_"~"_NMT2_"~"_MHT2_"~"_QN2 ....I $L($G(ITM)) D SET^W4ITM("STT2",ITM) ....D SETNOMODT("STT2",T2) ....D SETORD2(LV,STT2,N2) ....D SETCMNT2(CDT2,CMNT2) .K @$$^W4MAIN("VRMHZ") ; I $D(@TMPSET)>9,I>0 D SETSET K @TMPSET ; -- ? ; N I,I1,A,CDT ; ; S SRV="" F S SRV=$O(@W4HZM@(SRV)) Q:SRV="" I SRV?1U.E D ; -- SERVIS INFORMATION .I $D(@W4HZM@(SRV))#2 S @TMPORD@(SRV)=@W4HZM@(SRV) .N N1 S N1="" F S N1=$O(@W4HZM@(SRV,N1)) Q:N1="" D ..I $D(N2I(N1)),SRV'="PART",SRV'="TB",SRV'="CB" D Q ...M @TMPORD@(SRV,N2I(N1))=@W4HZM@(SRV,N1) ...K @TMPORD@(SRV,N2I(N1),"O2T") ..M @TMPORD@(SRV,N1)=@W4HZM@(SRV,N1) Q ; D ^W4TMPHD Q 1 ; ; ; TMPI(STAM) ; D TMPORD Q ($O(@TMPORD@(99999),-1)+1) ; SETCMNT2(CDT2,CMNT2) ; N MANA ; I $L(CMNT2) D .S CMNT2=$$CLMANA(CMNT2) ; S MANA=$P(CMNT2,"\",2) S CMNT2=$P(CMNT2,"\") ; I MANA,'$G(NPSET) D .N I S I=$O(@TMPORD@(99999),-1) .S MANA=$$MANA($G(CD),MANA) .S @TMPORD@(I,"MANA")=MANA ; I $$LENCMNT(CMNT2),$G(LV) D .S STT2=LV_"~"_CDT2_"-C"_+$$CDCMNT(CDT2,CMNT2)_"~"_$$CLR(CMNT2) .D SETNOMODT("STT2",T2) .S CMNT2="" D SETORD2(LV,STT2,N2) Q ; ; KOT ; D W4HZM N A,B,C,I S A=@W4HZM ; ------- !!! S $P(A,"\",60)=$P(A,"\",30) ; I $P(A,"\") D .N LK S LK=$$SPA^%L1FRM($P(A,"\")) .S $P(A,"\")=$TR(LK,"-","") ; S TIME=$P(A,"\",6) S $P(A,"\",42)=$P(TIME,":") S $P(A,"\",43)=$P(TIME,":",2) I $P(A,"\",21)=8 S $P(A,"\",21)=5 S $P(A,"\",27)=$TR($P(A,"\",27),"-!","") S $P(A,"\",38)=$P(A,"\",22) I $P(A,"\",38),$P(A,"\",38)'["%" S $P(A,"\",38)=$P(A,"\",38)_"%" N HN S HN=$P(A,"\",8) ; ;;I $$ONLINE^W4DLVCSR,HN,HN'["%" D .S $P(A,"\",38)=$J(100*HN/($P(A,"\",11)-$P(A,"\",9)+HN),2,2) .S $P(A,"\",8)="" ; I $$ONLINE^W4DLVCSR,HN,HN'["%" D .S $P(A,"\",38)="" ; I $P(A,"\",8)["%" D .N AH S AH=$P(A,"\",8) .I AH["=" S AH=$P(AH,"=",2) .S $P(A,"\",38)=AH .I $P(A,"\",8)'["=" S $P(A,"\",8)="" .I $P(A,"\",8)["=" S $P(A,"\",8)=+$P(A,"\",8) ; ; S COMP="" I $L($P(A,"\",2)) D .S COMP=$P(A,"\",2) .S $P(A,"\",47)=COMP ; S B=$G(@W4HZM@("HR2")) S $P(A,"\",34)=$P(B,"\\",6) ; -- HEARA S $P(A,"\",31)=$P(B,"\\",4) ; IR S $P(A,"\",2)=$P(B,"\\",5) S $P(A,"\",32)=$P(B,"\\",7) ; PELE ; S CIBCARD=$G(@W4HZM@("CIBCARD")) I $L(CIBCARD) D .S $P(A,"\",46)=$$^W3ENCR(HZM_";"_CIBCARD) ; S CREDCARD=$G(@W4HZM@("CREDCARD")) I $L(CREDCARD) D .S $P(A,"\",48)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~")) .S $P(A,"\",49)=$P(CREDCARD,"~",2) .S $P(A,"\",50)=$$^W3ENCR(HZM_";"_$P(CREDCARD,"~",3)) ; S $P(A,"\",55)=$$PSL^W4HZMST(HZM) ; S $P(A,"\",56)=$$EMAIL^W4HZMST(HZM) S $P(A,"\",57)=$$MIKUD^W4HZMST(HZM) S $P(A,"\",58)=$$FAX^W4HZMST(HZM) S $P(A,"\",59)=$$TELB^W4HZMST(HZM) ; ; S @TMPORD=$TR(A,"\","~") ; I $P(A,"\",6)?2N1":"2N S $P(@TMPORD,"~",35)=$P(A,"\",6) ; - ZMAN MEUSHAR Q ; ; SETORD2(LV,STT2,N2) ; I $L($G(CMNT2)) S $P(STT2,"~",7)=CMNT2 I $L($G(GLIST)) S $P(STT2,"~",9)=GLIST I $G(NPSET),$G(NP) D SBORKA2(NPSET,NP,STT2,N2) Q ; S I=$$TMPI S @TMPORD@(I)=STT2 D NOMOD(T2) ; I $L($G(GLIST)) D .S @TMPORD@(I,"GLIST")=GLIST ; S N2I(N_"-"_CDT_"-"_N2)=$$IND(I) Q ; ; W4HZM I $D(%ARG("GLORD")) S W4HZM=%ARG("GLORD") Q N GLORD D GLORD^W4HZMST S W4HZM=GLORD Q TMPORD I $G(TMPORD)="" S TMPORD="^[$$^W3MAIN]TMPORD(JB)" Q NOMOD(ST0) S $P(@TMPORD@(I),"~",12)=$P(ST0,"\",10) S $P(@TMPORD@(I),"~",13)="HZ" Q ; CDCMNT(CD,CMNT) ; CMNT --> CD I $G(CD)=""!($G(CMNT)="") Q "" N CDCMNT S CDCMNT="" S CMNT=$$SPA^%L1FRM(CMNT) N GLH S GLH=$$^W4GL("P1CODH") N N S N="" F S N=$O(@GLH@(N)) Q:N="" D Q:$L(CDCMNT) .I $$SPA^%L1FRM($G(^(N)))=CMNT S CDCMNT=N I CDCMNT,'$D(@$$^W4GL("P1EZH")@(CD,CDCMNT)) D .N SUG S SUG=$$SUG^W4P(CD) I 'SUG S CDCMNT=0 Q .I '$D(@$$^W4GL("P1EZHK")@(SUG,CDCMNT)) S CDCMNT=0 I CDCMNT="" S CDCMNT=0 Q CDCMNT ; ; CLMANA(CMNT) ; I '$L($G(CMNT)) Q "" N N,MANA S MANA="" I '$D(MN) D MN^W4MANA ; S N="" F S N=$O(MN(N)) Q:N="" I $L(MN(N)) D Q:MANA .I CMNT[MN(N) D ..S MANA=N ; ..S CMNT=$$RPL^%L1FRM(CMNT,MN(N),"") Q CMNT_"\"_MANA ; ; SET(CD,CDT) ; I $G(CD)=""!($G(CDT)="") Q 0 N GL S GL=$$GLEZ(CD) I GL="" Q 0 N SET,OK S OK=0 ;-- SET="A"+NSET S SET="" F S SET=$O(@GL@(CD,SET)) Q:SET="" D Q:OK .Q:$E(SET)'="A" .N NSET S NSET=$E(SET,2,6) Q:NSET="" .I $D(@$$^W4GL("P1SETA")@(NSET,CDT)) S OK=NSET Q OK ; SETNAME(SET) ; Q $P($G(@$$^W4GL("P1SETA")@(SET)),"\") ; SETEXIST(I,SET) ; N TMPORD D TMPORD N A,OK S OK=0 N I1 F I1=I:-1:1 S A=$G(@TMPORD@(I1)) Q:$P(A,"~")=0 D Q:OK .I $P(A,"~",2)=("A"_SET) S OK=1 Q OK ; TMPSET S TMPSET="^[$$^W3MAIN]TMPSET($$^%W1JB)" Q ; SBORKA(CD,SET,STT) ; --> NPSET,NP N TMPSET,CDT,CMNTT D TMPSET S CDT=$P(STT,"~",2) Q:CDT="" S NPSET=$$NPSET(CD,SET) Q:NPSET="" S NP=$G(@$$^W4GL("P1SETA")@(SET,CDT)) Q:NP="" I '$D(@TMPSET@(NPSET)) S @TMPSET@(NPSET)=SET S @TMPSET@(NPSET,NP)=STT S @TMPSET@(NPSET,NP,"IND")=N_"-"_$P(STT,"~",2) Q ; NPSET(CD,SET) ; N GL S GL=$$GLEZ(CD) I GL="" Q "" I '$D(@GL@(CD,"A"_SET)) Q "" Q +$G(@GL@(CD,"A"_SET)) ; SBORKA2(NPSET,NP,STT2,N2) N IND S IND=$O(@TMPSET@(NPSET,NP,9999),-1)+1 S @TMPSET@(NPSET,NP,IND)=STT2 S @TMPSET@(NPSET,NP,IND,"IND")=N_"-"_$P($G(@TMPSET@(NPSET,NP)),"~",2)_"-"_N2 Q ; ; SETSET ; N SET,NP,NP2,STT,STT2,CDT,NPSET D TMPSET,TMPORD N LAST,IND S NPSET="" F S NPSET=$O(@TMPSET@(NPSET)) Q:NPSET="" D .S SET=$G(^(NPSET)) Q:SET="" .S I=$$TMPI,@TMPORD@(I)="1~A"_SET_"~"_$$SETNAME(SET) D SETNOMOD(I) .S NP="" F S NP=$O(@TMPSET@(NPSET,NP)) Q:NP="" D ..N STT S STT=$G(^(NP)) ..I '$O(@TMPSET@(NPSET,NP,"")) D SETST(STT,1) D Q ...S IND=$G(@TMPSET@(NPSET,NP,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) ..S NP2="" F S NP2=$O(@TMPSET@(NPSET,NP,NP2)) Q:NP2="" I NP2 D ...N STT2 S STT2=$G(^(NP2)) D SETST(STT2,2) ...S IND=$G(@TMPSET@(NPSET,NP,NP2,"IND")) ...I IND D ....S LAST=$O(@TMPORD@(9999),-1) ....S N2I(IND)=$$IND(LAST) ; K @TMPSET Q ; ; SETST(STT,UR) ; N GLIST S I=$$TMPI ; N ST S ST=$P(STT,"~",1,6)_"~~"_$P(STT,"~",8,13) S GLIST=$$SPA^%L1FRM($P(ST,"~",9)) S $P(ST,"~",9)="" S $P(ST,"~",13)="HZ" ; I $P(ST,"~",2)["-C",$P($G(@TMPORD@(I-1)),"~",2)["-C" Q ; S @TMPORD@(I)=ST I $L(GLIST) S @TMPORD@(I,"GLIST")=GLIST ; N CMNTT S CMNTT=$P(STT,"~",7) S CMNTT=$$CLMANA(CMNTT) ; D SETMANA("CMNTT",I) ; I $$LENCMNT(CMNTT) D .N CDT S CDT=$P(STT,"~",2) .I $P($G(@TMPORD@(I)),"~",2)[(CDT_"-C") Q .S I=$$TMPI .S @TMPORD@(I)=$P(STT,"~")_"~"_CDT_"-C"_$$CDCMNT(CDT,CMNTT)_"~"_$$CLR(CMNTT) .S $P(^(I),"~",12)=$P(STT,"~",12) .S $P(^(I),"~",13)="HZ" ; Q ; ; GLEZ(CD) ; N GL S GL="" I $D(@$$^W4GL("P1EZA")@(CD)) S GL=$$^W4GL("P1EZA") I $D(@$$^W4GL("P1EZT")@(CD)) S GL=$$^W4GL("P1EZT") Q GL ; SETNOMOD(I) ; S $P(@TMPORD@(I),"~",12)="@@@+" S $P(@TMPORD@(I),"~",13)="HZ" Q ; SETNOMODT(STR,T) ; S $P(@STR,"~",12)=$P(T,"\",10) ;;W "STR="_STR,! S $P(@STR,"~",13)="HZ" Q ; CLR(TXT) ; -- DEL ; MEUTARIM N I,TXT1,FL S TXT1="",FL=0 F I=1:1:$L(TXT) D .S FL=$S($E(TXT,I)=";":FL+1,1:0) .Q:FL>1 .S TXT1=TXT1_$E(TXT,I) Q TXT1 ; ; CHKORD(HZM) ; N LAST,LAST0 Q:$G(HZM)<1 S LAST=$$COLSH0^W4HZMST(HZM) S LAST0=$$COLSH0^W4HZMST(HZM,$$^W4GL("P1HZ0")) I LAST<(LAST0-1) D .M @$$^W4GL("P1HZER")@(HZM)=@$$^W4ORD@(HZM) .S @$$^W4GL("P1HZER")@(HZM,"W4GETHZ")=$ZD($H,"DD.MM.YY 24:60") .M @$$^W4ORD@(HZM)=@$$^W4GL("P1HZ0")@(HZM) .K @$$^W4ORD@(HZM,"S") Q ; SETMANA(%AAA,I) ; N MANA I $G(@%AAA)="" Q S MANA=$P(@%AAA,"\",2),@%AAA=$P(@%AAA,"\") S MANA=$$MANA($G(CD),MANA) S @TMPORD@(I,"MANA")=MANA Q ; MANA(CD,MANA) ; ; I MANA D .I $$NOROMA^W4PRM,$G(CD),$$D^W4EZT(CD),MANA,MANA'["T" S MANA=MANA_"T" Q MANA ; LENCMNT(CMNT) ; Q $L($TR($G(CMNT)," ","")) ; IND(I) ; I $$CDSTC^W3HZMST(JB,I,TMPORD) S I=I-1 Q I W4GETMLY W4GETMLY(PAR,DTIT,PR) ; ITRA ; [ 27.10.23 05:27 ] [ 13.10.16 08:20 ] [ 31.01.14 15:48 ] N (JB,%ARG,PAR,DTIT,PR) S DTIT=$G(DTIT) I DTIT="" S DTIT=+$H I $L(DTIT)>5,DTIT["."!(DTIT["/") S DTIT=$$^%L1DC(DTIT,3) S PR=$G(PR) I PR="I" S PR=1 I PR="O" S PR=2 I PR="Z" S PR=3 I PR="U" S PR=4 ; N IT I $G(PAR)="" Q "" ; I '$G(DTIT) D Q IT .N A S A=$G(@$$^W4GL("W4ML")@(PAR)) .S IT=$$IT(A,PR) ; N SIT,GLMLY S SIT=0 S GLMLY=$$^W4GL("W4MLY") S DT="" F S DT=$O(@GLMLY@(DT)) Q:DT="" Q:DT>DTIT D .S SIT=SIT+$$IT($G(@GLMLY@(DT,PAR)),PR) Q SIT ; ; IT(A,PR) ; I '$G(PR) Q $P(A,"*")+$P(A,"*",4)-$P(A,"*",2)-$P(A,"*",3) Q $P(A,"*",PR) W4GETMSD W4GETMSD(STAM) ; [ 26.01.11 17:07 ] [ I $G(%ARG("MSD")) Q %ARG("MSD") Q $$GET^%W1PRM("MSD") W4GETORD W4GETORD(ORD) ; [ 28.03.10 09:45 ] [ I '$D(@$$^W4ORD@(ORD)) Q N HZSCR I $$^W4MSL($$NMB^W4HZMST(ORD)) S HZSCR="P1HZ" I $$^W4MSD($$NMB^W4HZMST(ORD)) S HZSCR="P1HZMS" D GA^W4SCREF(HZSCR,$$^W4ORD_"("_ORD_")") Q W4GETPRN W4GETPRN ; [ 30.04.23 10:06 ] [ 01.01.17 00:19 ] [ 26.10.16 13:37 ] K MPRN N PLUK,N,PORT S PLUK=$$^W4GL("PLUK") ; S N="" F S N=$O(@PLUK@(N)) Q:N="" D .I $G(@PLUK@(N,"LP")) D ..S PORT=^("LP") ..S MPRN(PORT)=$$TV^%W1DICT($$^%W1LNG,"POSPRN",N) ..S MPRN(PORT,"SUG")=$G(@PLUK@(N,"LP","SUG")) ; I $$MDPMSL^W4PRM>2 D .N MDPMSL S MDPMSL=$$MDPMSL^W4PRM .N I F I=1:1:$L(MDPMSL,",") D ..S PORT=$P(MDPMSL,",",I) ..S:PORT<-1 PORT=-PORT ..S MPRN(PORT)=$$TV^%W1DICT($$^%W1LNG,"DSPHPRN") ..S MPRN(PORT,"SUG")=$$MDPS^W4MDP(PORT) ; S N="" F S N=$O(@$$^W4PRM@("MDP",N)) Q:N="" D .N A S A=$G(^(N)) .S PORT=$P(A,"\",3) Q:PORT="" .S PRNAME=$P(A,"\",4) .S MPRN(PORT)=PRNAME .S MPRN(PORT,"SUG")=$P(A,"\") ; I $G(@$$^W4GL("LEV")@("LP")) D .S PORT=$G(^("LP")) .S MPRN(PORT)=$$TV^%W1DICT($$^%W1LNG,"PRESENTWATCH") .S MPRN(PORT,"SUG")=$$MDPS^W4MDP(PORT) Q W4GETSUM W4GETSUM(JB,PRM,GL) ; [ 12.11.24 18:43 ] [ 11.02.24 11:32 ] [ 31.12.23 12:18 ] D GL(JB) ; N TOT S TOT=$$TOTORD(JB,"",GL) N HNH S HNH=$$HNH(JB) N DMSH S DMSH=$$DMSH(JB,TOT) ; I $G(PRM) D .D PUT(JB,"TSHL",$J(TOT-HNH+DMSH,2,2),GL) .D PUT(JB,"DMSH",DMSH,GL) .D PUT(JB,"HNH",$J(HNH,2,2),GL) ; Q $J(TOT,2,2)_";"_HNH_";"_DMSH_";"_$$TOTQN(JB,GL,0)_";"_$J(TOT-HNH+DMSH,2,2) ; ; TOTORD(JB,PR,GL) ; -- PR="D" - SUM TO DISCOUNT D GL(JB) N I,SUM,AHST,AHST1,SUMST,NOTSFMVC,QN,MH,NOTSF,MSMB,KDISC0,KDISC1 S SUM=0,AHST=0,AHST1="",NOTSF=0,KDISC0=1 N QN0 S QN0=1 ; F I=1:1 Q:'$D(@GL@(I)) D .N A,CD S A=$G(^(I)),CD=$$CD(A) . .I $$LV(A)=0 D ..S AHST=$P(A,"~",6),NOTSFMVC=$P(A,"~",8),AHST1=0,NOTSF=0 ..S KDISC0=(100-AHST)*.01 ..I $$^W4PRTBH(CD) S KDISC0=1 ..S KDISC1=1 . .I $$LV(A)=1 S AHST1=$P(A,"~",6) . .I CD["-C" Q .I CD["-H" Q .I $E(CD)="A" Q . .N SMB I $G(PR)="D",'$D(MSMB(CD)) S MSMB(CD)=$$SMB^W4BLNMVC(CD) . .I $G(PR)="D",$$ISNUM^%L1FRM(CD),$L($G(MSMB(CD))) D Q ..I $$LV(A)=0,$$TSFBHNH^W4PRM S NOTSF=1 . .I $G(PR)="D",$$LV(A),$$ISNUM^%L1FRM(CD),NOTSF Q .I $G(PR)="D",$$^W4PRTBH(CD) Q . .S QN=$$QNMH(A) I $$LV(A)=0 S QN0=QN .I $$^W4AIN S QN=$$ITRAST^W3HZMST(JB,I) .S MH=$$MHP(A) .S SUMST=MH*QN .;;W "A="_A,! ; *** .;;W "QN="_QN_" MH="_MH_" SUMST="_SUMST,!! ; *** . .I '$$LV(A) S KDISC=KDISC0 . .I $$LV(A) D ..I $$^W4PRTBH(CD) S KDISC=1 Q ..I $G(NOTSFMVC) S KDISC0=1 ..S KDISC1=(100-AHST1)*.01 ..S KDISC=KDISC0*KDISC1 . .S SUMST=SUMST*KDISC . .S SUM=SUM+SUMST .;;W "SUMST="_SUMST_" SUM="_SUM,! Q $J(SUM,2,2) ; ; GL(JB) ; I $G(GL)'="",$G(GL)'["(" S GL=GL_"(JB)" Q ; S JB=+JB I $G(GL)="" D .S GL=$$^W4TMPORD Q:$$CSR^W4DLVCSR .I '$D(@GL),$D(@$$^W3ORD(JB)@(+JB)) S GL=$$^W3ORD_"(JB)" Q ; ; LV(A) Q $P(A,"~") ; ; HNH(JB) ; D GL(JB) N HZM S HZM=$$GET^%W1PRM("HZM") I HZM>0,$$CLOSE^W4HZMST(HZM)!'$G(@$$^W4TMPORD) Q $P($G(@$$^W4ORD@(HZM)),"\",8) ; N HNHAH,HNH,HNH0 S HNHAH=$$AHUZ(JB) S HNH=0 ; I HNHAH?1N.E S HNH=$J($$TOTHN(JB)*HNHAH*.01,2,2) ; I $$D^W3TMPORD(JB)=11 D Q HNH .S HNH=HNH+$$SHNH1T .I $$^W4ISORD(HZM) S HNH=HNH+$$SLKHNH(HZM) ; I $$^W4ISORD(HZM) D .S HNH=HNH+$$SLKHNH(HZM)+$$SHNH1(HZM) ; Q $J(HNH,2,2) ; ; TOTHN(JB) ; Q $$TOTORD(JB,"D") ; DMSH(JB,TOT) ; D GL(JB) N HZM S HZM=$$GET^%W1PRM("HZM") I HZM>0,$$CLOSE^W4HZMST(HZM)!'$G(@$$^W4TMPORD) Q $P($G(@$$^W4ORD@(HZM)),"\",9) I $$DMSHMSD^W3HZMST(JB)["!" Q $$DMSHMSD^W3HZMST(JB) N NMB S NMB=$$GETP^%W1PRM("NMB") N DMSAH S DMSAH=$$DMSAH^W3HZMST(JB) I NMB,$$^W4MSD(NMB),DMSAH'?1N.E Q $$DMSHMSD^W3HZMST(JB) ; S DMSH=$$DMSH^W3HZMST(JB,GL) ; Q DMSH ; ; ; CD(A) ; Q $P(A,"~",2) ; MHP(A) ; Q $P(A,"~",4) ; AHUZ(JB,GL) ; D GL(JB) Q $P($G(@GL),"~",38) ; SLKHNH(HZM) ; N SHNH,LKHNH S SHNH=0 N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","ASR",N)) Q:N="" D .S LKHNH=$$GET^W4GTVCH(HZM,N,"ASR","LKHNH") .S SHNH=SHNH+LKHNH Q SHNH ; SHNH1(HZM) ; N SHNH1,HNH1 S SHNH1=0 N N S N="" F S N=$O(@$$^W4ORD@(HZM,"CB","HNH1",N)) Q:N="" D .S HNH1=+$G(^(N)) .S SHNH1=SHNH1+HNH1 Q SHNH1 ; SHNH1T(HZM) ; N SHNH1,HNH1 S SHNH1=0 N N S N="" F S N=$O(@$$^W4TMPORD@("CB","HNH1",N)) Q:N="" D .S HNH1=+$G(^(N)) .S SHNH1=SHNH1+HNH1 Q SHNH1 ; ; PUT(JB,RKV,VL,GL) ; D PUT^W3HZMST(JB,RKV,VL,GL) Q ; TOTQN(JB,GL,PR) ; Q $$TOTQN^W3HZMST(JB,$G(GL),$G(PR)) ; D GL(JB) N I,SUM S SUM=0 F I=1:1 Q:'$D(@GL@(I)) D .N A S A=$G(^(I)) .I $G(PR)=0,$$LV(A) Q .N QN S QN=$$QNMH(A) .N CD S CD=$$CD(A) .;;I $$MSK^W4P(CD) S QN=$S(QN>0:1,+QN=0:0,1:-1) .I $P(QN,".",2) S QN=$S(QN>0:1,+QN=0:0,1:-1) .S SUM=SUM+QN Q SUM ; QNMH(A) ; N QN S QN=$P(A,"~",5) I QN["*" S QN=$$QNMULTY(QN) Q $$QNPIZZA(QN) ; QNPIZZA(QN) ; I QN'["+" Q +QN N QNMH S QNMH=0 I QN["+" D .N J F J=1:1:10 I $E(QN,J)="+" S QNMH=QNMH+1 Q QNMH ; QNMULTY(QN) ; I $G(QN)'["*" Q $$QNPIZZA(QN) N QN1,QN2,QN3 S QN1=$P(QN,"*"),QN2=$P(QN,"*",2) S QN3=$P(QN,"*",3) I 'QN3 S QN3=1 I QN1["+" S QN1=$$QNPIZZA(QN1) I QN2["+" S QN2=$$QNPIZZA(QN2) I QN1<0,QN2<0 S QN2=-QN2 Q QN1*QN2*QN3 ; W4GFILTR W4GFILTR ; [ 30.06.13 15:24 ] [ 29.06.13 17:51 ] [ N (JB,%ARG,%REM) D MMRKZ^W4MRKG("") W "
    ",! I '$G(%ARG("NOMRK")) D .W "
    " . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . .S K=K+1 . .W "",! . ; . W "",! .W "
    "_N_" "_$$H2U^%L1FRM(MMRKZ(N))_" " . . S CHECKED=$$CHECKED(K) . . W "" . .W "
    " ; I '$G(%ARG("RKZ")) D .W "" . W "" . F I=1:1:7 D . .W "" . ; . W "",! .W "
    " . . W $$^%W1DICT("DAY")_" "_$$^%W1DICT("DAY"_I) . . W "" . .W "
    ",! ; W "",! W "",! I '$G(%ARG("NOSIK")) D SIK D RIKUZ D SHOW W "",! W "
    ",! W "
    ",! Q ; CHECKED(K) ; I $G(%ARG("MRKZ"))="" Q "checked=""checked"" " I ("-"_$G(%ARG("MRKZ"))_"-")[("-"_K_"-") Q "checked=""checked"" " Q "" ; CHECKED1(I) ; I $G(%ARG("DAYS"))="" Q " checked=""checked"" " I $G(%ARG("DAYS"))[I Q " checked=""checked"" " Q "" ; CHECKED2(STAM) ; I $G(%ARG("RKZ")) Q " checked=""checked"" " Q "" ; CHECKED3(STAM) ; I $G(%ARG("SIK")) Q " checked=""checked"" " Q "" ; SIK ; W "" W $$^%W1DICT("TOTALSONLY") W "" W "",! Q RIKUZ ; W "" W $$^%W1DICT("CONCPERDATE") W "" W "",! Q SHOW ; W "" D ROUNDBUT^%W1JS("SHOW",$$^%W1DICT("SHOW"),"ShowGFltr()","color:green","wh,22,,,11") W "",! Q W4GFPREP W4GFPREP ; [ 29.05.13 13:33 ] [ 26.05.13 21:38 ] [ N (JB,%ARG,%REP) D ^%L1C S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D INIT,ZR ; S MRKZ=1000 F S MRKZ=$O(@MSDR@(MAINMRKZ,MRKZ)) Q:MRKZ="" I MRKZ?4N D .S UCI=$G(@GUCI@(MRKZ)) Q:UCI="" .S $ZGBLDIR=UCI .S DIRGIB=$$DIRGIB(MRKZ) .S LASTDT=$O(^Z($H+1),-1) .F DT=LASTDT:1:+$H D ..W "MRKZ="_MRKZ_" "_$ZD(DT,"DD.MM.YY"),! ..D RESTZ^P1DBREST(DT,DT) ..D CRDOCH(MRKZ,DT) Q ; CRDOCH(MRKZ,DT) ; N (MRKZ,DT,NEWCRDOCH) D INIT,ZR ; K KAMSUM I $D(NEWCRDOCH) K ^DOHMRK(DT,MRKZ),@MAINREP@(DT,MRKZ) S DAT=$$^%L1DC(DT,2) ; I '$D(^Z1(DAT)) Q I $D(@MAINREP@(DT,MRKZ)) Q D ^P1SUM1 M ^DOHMRK(DT,MRKZ)=KAMSUM M @MAINREP@(DT,MRKZ)=^DOHMRK(DT,MRKZ) Q ; INIT ; S MSDR="^|$$^W3MAIN|W3MSDR" S GUCI="^|$$^W3MAIN|UCI" S MAINMRKZ=1000 S MAINDIR=$G(@GUCI@(MAINMRKZ)) Q:MAINDIR="" S MAINREP="^|"""_MAINDIR_"""|MRK2WEB" Q ; ZR ; S $ZROUTINES="/usr/local/mumps/grf1000" Q ; DIRGIB(MRKZ) ; Q "/usr/local/mumps/"_MRKZ_"/jour/" W4GFRCV W4GFRCV ; [ 27.06.13 10:36 ] [ 07.06.13 14:31 ] [ 06.06.13 18:16 ] BG ; N FLIN,MSD,UCI,OKP,OKL S $ZT="ZG "_$ZL_":ER^W4GFRCV" ; S $ZGBLDIR=$$^W4GFUCI CYC I $G(^[$$^W3MAIN]STLOOP("W4GFRCV")) H ; D RCV("MRK2WEB","MRK2WEB") D RCV("Z2WEB","Z2WEB") ; END S ^[$$^W3MAIN]W4GFUCI=$ZD($H,"DD.MM.YY 24:60")_"\"_$J H 2 G CYC ; ; RCV(NMFL,IND) N FLIN,MSD,UCI ; S FLIN=$G(^[$$^W3MAIN]PL("SND","DIRCV"))_NMFL_"_*" S FLIN=$ZSEARCH(FLIN) I FLIN'[(NMFL_"_") G RCVE ; ZSY "rm -f "_$G(^[$$^W3MAIN]PL("SND","DIRCV"))_NMFL_"A_*" ZSY "rm -f "_$G(^[$$^W3MAIN]PL("SND","DIRCV"))_NMFL_"E_*" ; S UCI=$$^W4GFUCI ; S OKP=$$PRIEM^W3RCVRSD(FLIN,UCI) ; I 'OKP D ERR(-2,IND,FLIN) G RCVE ; RCVE ; Q ; ; ER D SVER^%L1X H ; ERR(CDER,IND,FL) ; S ^[$$^W3MAIN]W4GFRCVER(+$H,$P($H,",",2))=$G(CDER)_"\"_IND_"\"_FL Q W4GFUCI W4GFUCI(STAM) ; [ 31.05.13 18:27 ] [ Q $G(^[$$^W3MAIN]UCI(1000)) NAME(STAM) ; Q $G(^[$$W4GFUCI]MRKZ(1000)) W4GGLKEY W4GGLKEY(CALLBACK) ; [ 04.09.22 14:29 ] [ 27.03.22 18:47 ] [ 22.03.21 19:14 ] N KEY S KEY=$G(@$$^W4PRM@("GGLKEY")) I $G(CALLBACK)="" S CALLBACK="myMap" I $L(KEY),$E(KEY,1,6)'="https:" D .S KEY="https://maps.googleapis.com/maps/api/js?key="_KEY_"&language=iw&libraries=geometry,places&callback="_CALLBACK ; I KEY="" S KEY="https://maps.googleapis.com/maps/api/js?key=AIzaSyApyJhT6NQb5Iv-llf5ACH1-LjXmzpov_0&language=iw&libraries=geometry,places&callback="_CALLBACK Q KEY W4GIB W4GIB(ACT,GL,IND) ; [ 20.02.25 13:27 ] [ 24.04.24 05:35 ] [ 26.03.24 12:02 ] N GLGB I $E(GL,$L(GL))'[")" S GLGB=GL_"(" E S GLGB=$E(GL,1,$L(GL)-1)_"," N J F J=1:1:$L(IND,";") D .S GLGB=GLGB_""""_$P(IND,";",J)_"""," S GLGB=$E(GLGB,1,$L(GLGB)-1)_")" ; I ACT="K" D ^%S2GLSV(GLGB,$$^W4FGIB,"K") Q D ^%S2GLSV(GLGB,$$^W4FGIB) Q ; ; RCVGIB(JB,GL) ; N $ZT S $ZT="K @$$^W4flag(""RCVGIB"") S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $G(GL)="" S GL=$$^W4GL("RCVGIB") N RCVGIB,TM,SEC,OLDTIME,PR,glflag S glflag=$$^W4flag_"(""RCVGIB"")" N SHR S SHR=0 RCVGIBCYC ; I $$^%L1FLAG(glflag) Q I '$G(@glflag) S @glflag=$J I $D(@$$^W4GL("STLOOP")@("PC")) K @glflag Q ; S SHR=SHR+1 S ^SHR=SHR I '(SHR#100) D .ZSY "/home/gtmuser/igib/scp4iash" .ZSY "/home/gtmuser/gib/scp4padash" .ZSY "/home/gtmuser/gib/scp4yaash" .ZSY "/home/gtmuser/gib/scp4ash" ; S RCVGIB=$G(@GL) I RCVGIB=""!(RCVGIB="00:00") G RCVGIBEND ; S PR=0 RCVGIBCYC1 ; S TM=RCVGIB*3600+($P(RCVGIB,":",2)*60) S SEC=$P($H,",",2) ; I SEC(TM+300) G RCVGIBEND ; S OLDTIME=$G(@GL@("LAST")) I $$DIF^%L1TIME($H,OLDTIME)<30 G RCVGIBEND ZSY "/home/gtmuser/igib/scp4iall" ZSY "/home/gtmuser/gib/scp4padgib" ZSY "/home/gtmuser/gib/scp4yagib" ZSY "/home/gtmuser/gib/scp4all" S @GL@($ZD($H,"YYMMDD 24:60"))=$ZSY S @GL@("LAST")=$H RCVGIBEND H 20 G RCVGIBCYC ; ; GIB(JB,GL) ; N $ZT S $ZT="K @$$^W4flag(""W4GIB"") S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N GIB,TM,SEC,OLDTIME,glflag I $G(GL)="" S GL=$$^W4GL("W4GIB") S glflag=$$^W4flag_"(""W4GIB"")" F Q:$$^%L1FLAG(glflag) Q:$G(@$$^W4GL("STLOOP")@("PC")) D GIBCYC H 60 K @glflag Q ; GIBCYC ; ZSY "cp /opt/Modularity/SPI/bin/AshraitDB.db /home/gtmuser/ash.db" N PATH S PATH=$$PATHGB^W4FGIB N YYMMDD S YYMMDD=$ZD($H,"YYMMDD") ZSY "cp "_PATH_"\#J"_YYMMDD_" /home/gtmuser/GIBJ" ; S GIB=$G(@GL) I GIB=""!(GIB="00:00") S GIB="02:00" GIBCYC1 S TM=GIB*3600+($P(GIB,":",2)*60) S SEC=$P($H,",",2) ; I SEC(TM+500) G GIBEND ; S OLDTIME=$G(@GL@("LAST")) I $$DIF^%L1TIME($H,OLDTIME)<30 G GIBEND D ^W4BCKUP(JB) S @GL@($ZD($H,"YYMMDD 24:60"))=$ZSY S @GL@("LAST")=$H GIBEND Q W4GIBHZ W4GIBHZ(HZM) ; [ 31.01.19 09:48 ] [ 07.11.16 18:50 ] [ 02.07.16 15:30 ] J JGIB(JB,HZM) Q ; JGIB(JB,HZM) ; N (JB,%ARG,HZM) Q:$G(HZM)<1 N GLORD D GLORD^W4HZMST Q:$D(@GLORD)'=11 ; L +^TMPJGIB(JB):3 ; I '$D(P1DZ) D ^W4IN N FJ S FJ=$$^W4FGIB D ^%S2GLSV($$^W4GL("P1HZ")_"("_HZM_")",$$^W4FGIB) D ^%S2GLSV($$^W4GL("P1MLZ")_"("_HZM_")",$$^W4FGIB) ; D ^%S2GLSV($$^W4GL("P1H")_"("_P1DZ_","_HZM_")",$$^W4FGIB) D ^%S2GLSV($$^W4GL("P1HI")_"("_HZM_","_P1DZ_")",$$^W4FGIB) D ^%S2GLSV($$^W4GL("P1MOVE")_"("_P1DZ_","_HZM_")",$$^W4FGIB) ; N NMB S NMB=$$NMB^W4HZMST(HZM) I $G(NMB) D ^%S2GLSV($$^W4GL("P1HL")_"("""_NMB_""","""_HZM_""")",$$^W4FGIB) ; N HB S HB=$G(@$$^W4GL("P1HZ")@(HZM,"ETHB")) I HB D .D ^%S2GLSV($$^W4GL("P1HB")_"("_HB_")",FJ) .D ^%S2GLSV($$^W4GL("P1HBI")_"("_P1DZ_","_HB_")",FJ) ; N HB2A S HB2A=$G(@$$^W4GL("P1HZ")@(HZM,"ETHB2")) I HB2A D .N HB2 F II=1:1:$L(HB2A,",") D ..S HB2=$P(HB2A,",",II) Q:'HB2 ..D ^%S2GLSV($$^W4GL("P1HB2")_"("_HB2_")",FJ) ..D ^%S2GLSV($$^W4GL("P1HB2I")_"("_P1DZ_","_HB2_")",FJ) ; S HB5=+$G(@$$^W4GL("P1HZ")@(HZM,"ETHB5")) I HB5 D .D ^%S2GLSV($$^W4GL("P1HB5")_"("_HB5_")",FJ) .D ^%S2GLSV($$^W4GL("P1HB5I")_"("_P1DZ_","_HB5_")",FJ) ; S TM=$G(@$$^W4GL("P1HZ")@(HZM,"ETTM")) I TM D .D ^%S2GLSV($$^W4GL("P1MSH")_"("_HZM_")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1TM")_"("_TM_")",FJ) .D ^%S2GLSV($$^W4GL("P1TMI")_"("_P1DZ_","_TM_")",FJ) .S PSL=+$P($G(@$$^W4GL("P1HZ")@(HZM,"TM")),"\") Q:'PSL .D ^%S2GLSV($$^W4GL("P1MSL")_"("_P1DZ_","_PSL_","_HZM_")",FJ) ; N LKHN S LKHN="" F S LKHN=$O(@$$^W4GL("P1HL1I")@(HZM,LKHN)) Q:LKHN="" D .D ^%S2GLSV($$^W4GL("P1HL2I")_"("""_HZM_""","""_LKHN_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL1")_"("""_LKHN_""","""_HZM_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL2")_"("""_LKHN_""","""_HZM_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL3")_"("""_LKHN_""","""_HZM_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL4")_"("""_LKHN_""","""_HZM_""")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("P1HL30")_"("""_LKHN_""","""_HZM_""")",$$^W4FGIB) ; S LKHN="" F S LKHN=$O(@$$^W4GL("P1LIMI")@(HZM,LKHN)) Q:LKHN="" D .N YYMM S YYMM="" F S YYMM=$O(@$$^W4GL("P1LIMI")@(HZM,LKH,YYMM)) Q:YYMM="" D ..D ^%S2GLSV($$^W4GL("P1LIM")_"("""_LKHN_""","""_YYMM_""","""_HZM_""")",$$^W4FGIB) ; I $G(@$$^W4GL("P1HHI")@(HZM)) D .N A S A=$G(^(HZM)) Q:A="" .D ^%S2GLSV($$^W4GL("P1HH")_"("""_A_""","_HZM_")",$$^W4FGIB) ; I $G(@$$^W4GL("P1HTI")@(HZM)) D .N A S A=$G(^(HZM)) Q:A="" .D ^%S2GLSV($$^W4GL("P1HT")_"("""_A_""","_HZM_")",$$^W4FGIB) ; I $G(@$$^W4GL("M1HLI")@(HZM)) D .N LK S LK=$G(^(HZM)) Q:LK="" .D ^%S2GLSV($$^W4GL("M1HL")_"("""_LK_""","_HZM_")",$$^W4FGIB) .D ^%S2GLSV($$^W4GL("M1HLI")_"("_HZM_")",$$^W4FGIB) ; M @$$^W4GL("P1HZ0")@(HZM)=@$$^W4GL("P1HZ")@(HZM) S @$$^W4GL("P1HZ0")=$G(@$$^W4GL("P1HZ")) L -^TMPJGIB(JB) Q W4GIO W4GIO(STAM) ; [ 02.09.11 08:02 ] [ 25.11.08 06:49 ] [ ;;Q "^[$$^W3MAIN]W4INOUT" Q "^[$$^W3MAIN]W4INOUT($$^W4DZ)" W4GL W4GL(GL,JBB) ; [ 05.12.21 09:06 ] [ 14.02.21 05:28 ] [ 24.01.21 16:11 ] I $$^W4GLLIN Q $S($E(GL)="^":GL,1:"^"_GL) I GL["$$^W3MAIN" Q $S($E(GL)="^":GL,1:"^"_GL) I $E(GL,1,2)="^|" Q GL I $E(GL,1,2)="^[" Q GL S:$E(GL)="^" GL=$E(GL,2,200) I $G(JBB)="M" Q "^|"""_$$^W3MAIN_"""|"_GL I $G(JBB) N JB S JB=JBB N JB0 S JB0=+$G(JB) N JB S JB=$P(JB0,".") I '$G(JB) Q "^|"""_$$^W3MAIN_"""|"_GL N UCI S UCI=$$^%W1UCI(+JB) N MAIN S MAIN=$$^W3MAIN I $G(^[MAIN]P1PRM("MM"))'=1 G END ; N UCI S UCI=$$UCIMM(GL) ; END Q "^|"""_UCI_"""|"_GL ; ; UCIMM(GL) N NMGL S NMGL=GL I GL["|" S NMGL=$P(GL,"|",3) I GL["(" S NMGL=$P(GL,"(") N UCI S UCI=$$^W3MAIN ; G:NMGL="" EUCIMM N CURREST S CURREST=$$GETP^%W1PRM("CURREST") G:'CURREST EUCIMM ; I $D(^[UCI]W4MMGL(NMGL)) S UCI=$$TV^%W1UCI(CURREST) EUCIMM Q UCI W4GLIST W4GLIST ; [ 31.07.15 14:01 ] [ 20.05.15 10:00 ] [ 19.05.15 19:12 ] N (JB,%ARG,%REM) W "",! W "",! N I ; S PRALL=0 S NST=$$GETNST($G(%ARG("STID"))) Q:'NST S ST=$G(@$$^W4TMPORD@(NST,"GLIST")) I ST="*" S PRALL=1 S ISALL=0 I $G(%ARG("SOAD"))=$G(%ARG("MAX"))!$$GLISTALL^W4PRM S ISALL=1 ; W "" S CLR="white" I PRALL S CLR="yellow" W "" W "",! ; I '$$GLIST D .F I=1:1:$G(%ARG("SOAD")) D ..W "" .. S CLR="white" .. I ","_ST_","[(","_I_",")!PRALL S CLR="yellow" .. W "" ..W "",! ; I $$GLIST D .N P1GLIST S P1GLIST=$$GLIST .F II=1:1:$L(P1GLIST,",") D ;Q:II>$G(%ARG("SOAD")) D ..S I=$P(P1GLIST,",",II) ..W "" .. S CLR="white" .. I ","_ST_","[(","_I_",")!PRALL S CLR="yellow" .. W "" ..W "",! ; W "
    "_$$^%W1DICT("SIGNGUESTNUMBERS")_"
    " W $$^%W1DICT("ALL") W "
    " .. W I .. W "
    " .. W I .. W "
    ",! W "
    " W "",! W "
    ",! Q ; ; SUBMIT(PRM) ; D PUT^%W3DEB("W4GLIST-SUBMIT","PRM=PRM") N SH,LIST,STID,GLIST,GLIST1 S STID=$P(PRM,";") I STID="" Q 0 S SH=$$GETNST(STID) I 'SH Q 0 S GLIST=$P(PRM,";",2,200) I $E(GLIST,$L(GLIST))=";" S GLIST=$E(GLIST,1,$L(GLIST)-1) S GLIST=$TR(GLIST,";",",") I GLIST?.P,GLIST'="*" S GLIST="" I GLIST="*" S GLIST1="*" G SUBME N P1GLIST S P1GLIST=$$GLIST N GLIST1 S GLIST1="" I P1GLIST="" S GLIST1=GLIST ; N J F J=1:1:$L(GLIST,",") D .N IND S IND=$P(GLIST,",",J) Q:IND="" .I $P(P1GLIST,",",IND)="" Q .S GLIST1=GLIST1_$P(P1GLIST,",",IND)_"," I $E(GLIST1,$L(GLIST1))="," S GLIST1=$E(GLIST1,1,$L(GLIST1)-1) ; N ER S ER=0 I $$LVST^W3HZMST(JB,SH) D I ER Q ER .N SH0,GLIST0 S GLIST0="" .S SH0=$$SH0^W3HZMST(JB,SH) .I SH0 S GLIST0=$$GLIST^W3HZMST(JB,SH0) .; .I GLIST0'="" D ..N J F J=1:1:$L(GLIST1,",") D Q:ER ...N IND S IND=$P(GLIST1,",",J) Q:IND="" ...I (","_GLIST0_",")'[(","_IND_",") S ER=-1 ; SUBME ; S @$$^W4TMPORD@(SH,"GLIST")=GLIST1 Q GLIST1 ; GLIST(STAM) ; Q $G(@$$^W4PRM@("GLIST")) ; GETNST(STID) ; N SH S SH=$$FINDSH^W4HZORD(STID) I 'SH Q 0 Q SH W4GLLIN W4GLLIN(STAM) ; [ 16.04.12 12:42 ] [ Q 0 W4GLM W4GLM(GL) ; [ 16.04.09 15:13 ] [ 08.04.09 18:51 ] [ 09.09.08 15:41 ] Q $$UCI_GL UCI(STAM) ; Q "^[^UCI(""MLG"")]" W4GLS W4GLS(PRDEL,VD) ; [ 11.02.13 20:35 ] [ 14.10.12 10:04 ] [ 22.02.11 12:23 ] S VD=$G(VD) N GLS S GLS="" S PRDEL=$G(PRDEL) ; I VD'="IPY" D .I $$DEL(PRDEL) S GLS=$$^W4GL("W4INPDEL") Q .S GLS=$$^W4GL("W4INP") ; I VD="IPY" D .I $$DEL(PRDEL) S GLS=$$^W4GL("W4TSDEL") Q .S GLS=$$^W4GL("W4TSHL") Q GLS ; DEL(PRDEL) ; I $G(PRDEL)="DEL" Q 1 Q 0 W4GLSET W4GLSET(HZM) ; [ 14.07.23 04:52 ] [ 13.07.23 16:38 ] [ Q $$^W4GL("P1SETA") ; ORDSET(HZM) I $G(HZM)>0,$D(@$$^W4ORD@(HZM,"SETA")) Q 1 Q 0 W4GNAME W4GNAME(STAM) ; [ 06.04.22 14:30 ] [ 23.05.09 10:40 ] [ N GL S GL=$$^W4GL("NAME") ; I $$MMCC^W4PRM D .N UCI,MSD S MSD=$$GETP^%W1PRM("MSD0") .I MSD="",$$GETP^%W1PRM("MSDR0") S MSD=$$GETP^%W1PRM("MSDR0") .I MSD="",MSDCUR=8004!(MSDCUR=10080) S MSD=8005 .Q:'MSD .S UCI=^[$$^W3MAIN]UCI(MSD) Q:UCI="" .S GL="^|"""_UCI_"""|NAME" ; Q GL W4GNAME0 W4GNAME(STAM) ; [ 06.11.09 12:01 ] [ 23.05.09 10:40 ] [ Q $$^W4GL("NAME") W4GPNTM0 W4GAPNTM ; [ 19.05.24 09:25 ] [ 05.10.21 16:56 ] [ 24.08.21 17:32 ] I $G(JB)="" W "JB NOT DEFINED !" Q N MSDR,W3MSDR,TMP,TMPSN K %L1PC D ^%W1ARG I $G(MSDR)="" W "MSDR NOT DEFINED !" Q S W3MSDR="^|$$^W3MAIN|W3MSDR" ; S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" S %REPN="W4GAPNTM" S %REPN("PRTN")=$$^%W1JB ; S TMPSN="^|$$^W3MAIN|TMPSN" K @TMPSN N N S N="" F S N=$O(@W3MSDR@(MSDR,N)) Q:N="" D .S @TMPSN@(N)=$$MSD^W3R(N) ; K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 M @$$^%W1GLPRM@("REPN")=%REPN ; S MSDR=+$G(MSDR) I 'MSDR S TMP=$$^W4MAIN("TMP") K @TMP M @TMP=^|$$^W3MAIN|W4GAPNET(MSDR) Q ; ; DAT ; S DAT=$ZD(DT,"DD.MM.YY") I DT<$G(MEDAT) S OK=0 Q I DT>$G(ADDAT) S OK=2 Q Q ; MSD ; N MSD1 S MSD1=$G(^|$$^W3MAIN|W3MSD(MSD)) ;;S ^AA("W4GAPNTM","GLOB",DT,MSD)=GLOB ;;S ^AA("W4GAPNTM","GLOB",DT,MSD,"@GLOB")=$G(@GLOB) N A S A=$G(@GLOB) N DLM S DLM="," N J,SETMKR,QN,SUM ; S M(12)=1 S M(18)=3 S M(10)=5 ; F J=25:1:$L(A,",") D .S SETMKR=$P(A,",",J) .S MKR=$P(SETMKR,"~") .S QN=$P(SETMKR,"~",2) .S SUM=$P(SETMKR,"~",3) Q:'MKR Q:'$D(M(MKR)) .S @("x"_M(MKR))=QN .S @("x"_(M(MKR)+1))=$$RKV(SUM) Q ; RKV(VL) Q $$RKV^W4GAPNTD(VL) W4GR W4GR ; [ 05.08.23 18:43 ] [ 10.08.21 12:37 ] [ 08.01.19 11:04 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q I $G(%ARG("SHOW"))=0 Q ; D GL ; W "
    ",! ; D SORTSUG^W4SPIDK(GL) W "

    ",! ; W "",! W "" W "" W "" W "" W "",! ; N N,I,TMP S TMP=$$^W4MAIN("TMPGR") S GLOBT=$$CRGLOBT^W4SPIDK(GL) S N="",N0="",I=0 F S N0=$O(@GLOBT@(N0)) Q:N0="" D .S N=N0 I '$$^W4VWGR(N) Q .I $G(%ARG("SORT"))>1 S N=$G(@GLOBT@(N0)) Q:N="" .I $D(@TMP@(N)) Q .W "" S I=I+1 . .W "" . .W "" . .N ID,PROC S ID="chgr"_N .S PROC="OnClickTbl('"_N_"','TblGr','trgr','chgr')" .D ^W4TDCHBX(ID,PROC) . .W "",! W "
    "_$$^%W1DICT("GROUPCODE")_""_$$^%W1DICT("GROUPNAME")_""_$$^%W1DICT("SIGN")_"
     "_N_"  "_$$H2U^%L1FRM($G(@$$^W4GL("PARSUG")@(N)))_" 
    ",! W "
    ",! ; K @$$^W4MAIN("VRMT") Q ; GL ; S GL=$$^W4GL("PARSUG") Q W4GRAPH W4GRAPH ; [ 20.03.25 18:42 ] [ 08.10.17 21:13 ] [ W "",! W "",! W " ",! W "",! ; W ! W "",! W "
    ",! W " ",! W "
    ",! W ! W " ",! W " ",! Q W4GRAPHM W4GRPHMP ; [ 10.10.17 11:23 ] [ N (JB,%ARG,%REM) W4GRDLM W4GRDLM ; [ 31.12.20 10:17 ] [ 26.10.16 13:15 ] [ 12.01.15 12:51 ] N (JB,%ARG,%REM) S GRDLM=$G(@$$^W4PRM@($$IND)) S NMGR="" I GRDLM D .S NMGR=$G(@$$^W4GL("PARSUG")@(GRDLM)) ; W "
    ",! W "

    ",! W "",! W "" W "",! W "" W "" ; W " ",! ; W " ",! W "",! W "
    " W $$^%W1DICT("GROUPNUMBER") W $$NBSP^%L1FRM(3) W "",! W "" W $$H2U^%L1FRM(NMGR) W " ",! D ROUNDBUT^%W1JS("submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") W " ",! D ROUNDBUT^%W1JS("back",$$^%W1DICT("BACK"),"Back()","color:red","wh,22") W "
    ",! ; W "

    " ; W "
    ",! W "",! S N="" F S N=$O(@$$^W4GL("PARSUG")@(N)) Q:N="" D .N A S A=$G(^(N)) .W "",! . W "" . W "" .W "",! W "
    " . W N . W "" . W $$H2U^%L1FRM(A) . W "
    " W "
    ",! Q ; SUBMIT(PRM) ; N PIZUL S PIZUL=$P(PRM,";",2) N GR S GR=$P(PRM,";") Q:GR="" S @$$^W4PRM@($S(PIZUL:"DELIMGR",1:"DLMGR"))=GR Q ; IND(STAM) I $G(%ARG("PIZUL")) Q "DELIMGR" Q "DLMGR" W4GREMP W4GREMP ; [ 02.12.21 10:33 ] [ 01.08.21 14:31 ] [ 22.06.20 16:23 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q D PUT^%W3DEB("W4GREMP","%ARG=[%ARG") D GL I '$D(%ARG("MSD")) W " Restaurant number is not defined ! " Q ; I $D(%ARG("NOSHOW")) Q I $D(%ARG("CDKV")) D PUT^%W1PRM("CDKV",%ARG("CDKV")) ; W "
    ",! ;;W ""_$$^%W1DICT("GROUPEMPTABLE")_"",! W "",! W "",! W "" W "" W "" W "" W "",! ; N N,I S N="",I=0 F S N=$O(@GL@(N)) Q:N="" D .N SUG S SUG=$$SUG(N) .I $G(%ARG("CDKV")),%ARG("CDKV")'=SUG Q .I $G(%ARG("PAIL")),'$$GET1^W4LEVPR(N,"PAIL") Q .W "" S I=I+1 .W "" . .W "" . .W "" .W "",! W "",! Q ; GL S GL=$$^W4MAIN("TMPEMP") Q ; FIRSTGR(STAM) ; N N S N=$O(@$$^W4GL("LEVKVZ")@("")) Q N ; SAVE(PRM) ; N CD,NM,MH,DESC,GR,SHOW D GL M @$$^W4GNAME=@GL D ^%S2GLSV($$^W4GNAME,$$^W4FGIB) Q ; MVPR2GRE(PRM) ; S PRM=$$CLEAR^%L1FRM(PRM) D GL S PRM=$E(PRM,1,$L(PRM)-1) N KV S KV=$P(PRM,";") S PRM=$P(PRM,";",2,$L(PRM,";")) N OK S OK=0 I KV="" Q 0 I PRM="" Q 0 N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .Q:'$D(@GL@(CD)) .D SETSUG(CD,KV) S OK=1 Q OK ; MVKV2EMP(PRM) ; ;;S ^AA("MVKV2EMP","PRM")=PRM S PRM=$$CLEAR^%L1FRM(PRM) D GL S PRM=$E(PRM,1,$L(PRM)-1) N OK S OK=0 I PRM="" Q 0 N I,CD F I=1:1:$L(PRM,";") D .S CD=$P(PRM,";",I) Q:CD="" .Q:'$D(@GL@(CD)) .D SETSUG(CD,"") S OK=1 Q OK ; ; GROUP ; W "",! Q ; EMP2TMP ; D GL K @GL M @GL=@$$^W4GNAME Q ; SUG(OV) ; D GL Q $P($G(@GL@(OV)),"\") ; SETSUG(OV,SUG) ; D GL S $P(@GL@(OV),"\")=SUG Q ; ACTIVE ; W $$^%W1DICT("SHOWACTWORKERSONLY") W "  " Q W4GRIT W4GRIT ; [ 25.01.18 12:13 ] [ Q INIT ; D ^%W1ARG,^W3CSS,^W4CSS D KILL^%W1PRM("OPNWND") D INITUR^W4MENU(2) Q W4GRPHDD W4GRPHDD ; [ 27.05.18 15:40 ] [ 26.05.18 17:16 ] [ 02.02.18 18:16 ] N (JB,%ARG,%REM) I $G(%ARG("SHOW"))=0 Q D ^%W1ARG D VRM ; N I N GLGR S GLGR=$$GLGR K @GLGR ; K MDAY S K=0 F J=1:1:$$LMM^%L1DC($$^%L1DC("01"_MM1_YY1,3)) D .S DAT=$TR($J(J,2)," ",0)_"."_MM1_"."_YY1 .I $$^%L1DC(DAT,8)=D S K=K+1,MDAY(K)=DAT ; S TYPE=$G(%ARG("TYPE")) I TYPE="" S TYPE="bar" ; S DOP=$G(%ARG("DOP")) ; S MM1=$G(%ARG("MM1")) I 'MM1 W "A FIRST MONTH NOT DEFINED !" Q S YY1=$G(%ARG("YY1")) I 'YY1 W "A FIRST YEARM NOT DEFINED !" Q I $L(YY1)=4 S YY1=$E(YY1,3,4) ; S MM2=$G(%ARG("MM2")) I 'MM2 W "A SECOND MONTH NOT DEFINED !" Q S YY2=$G(%ARG("YY2")) I 'YY2 W "A SECOND YEARM NOT DEFINED !" Q I $L(YY2)=4 S YY2=$E(YY2,3,4) ; S TKF1=MM2_".20"_YY2 S TKF2=MM1_".20"_YY1 ; S COLX=5 S @GLGR@("COLX")=COLX ; S I1=0 F I=1:1:COLX D .S I1=I1+1 .S @GLGR@("LAB",I1)=$G(MDAY(I)) ; D PREP(D,IND) ; S COLG=2 ; S @GLGR@("COLG")=COLG S @GLGR@("TYPE")="bar" ; S COLX=I1 S @GLGR@("COLX")=COLX ; S @GLGR@("LB",2)=TKF2 S @GLGR@("BGC",2)="rgba(255,99,132,.4)" S @GLGR@("BRDC",2)="rgba(255,99,132,1)" ; ; S @$$GLGR@("LB",1)=TKF1 S @$$GLGR@("BGC",1)="rgba(54, 162, 235, .4)" S @$$GLGR@("BRDC",1)="rgba(54, 162, 235, 1)" ; D SHOW ; Q ; ; GLGR(STAM) ; Q $$GLGR^W1GRAPH ; ; PREP(D,IND) ; N (JB,%ARG,D,IND,MM1,MM2,YY1,YY2) D VRM ; S GLGR=$$GLGR ; F K=1:1:5 D .S @GLGR@("VL",2,K)=$G(@VRM@(D,1,K,IND)) .S @GLGR@("VL",1,K)=$G(@VRM@(D,2,K,IND)) ; Q ; ; PREPIN ; Q ; ; SHOW ; N HG,WD,TOP,LEFT,NG S HG=65,WD=90,TOP=4,LEFT=6 I $$1024^W4WDSCR S HG=60 S NG=1 N SM0 S SM0=60 ; W "
    ",! S SMLEFT=30 I $$1024^W4WDSCR S SMLEFT=22 W "

    ",! W $$^%W1DICT("COMPAREDD",$$IND(IND)_"<>"_$$^%W1DICT("DAY"_D)_"<>"_MM1_"<>"_YY1_"<>"_MM2_"<>"_YY2) ; I $G(MESHAA)!$D(ADSHAA) D .W "
    " .W " ",! . W $$^%W1DICT("HOURSRNG",MESHAA_"<>"_ADSHAA) .W "",! W "

    ",! ; D NIS^W4GRPHMP(LEFT,TOP+2) ; D GRAPHKIND^W4GRPHMP(TOP+3,TYPE) ; N SM1,SM2 S SM1=22 ; D TOTBOT(TOP+HG+7) ; D DIVBUT ; W "",! . W "",! .W "",! ; W "" W "",! ; W "" ; I '$$VIEW D .W "",! ; W "",! ; W "" W "",! W "",! ; Q ; ; ITEM2TREE(CODE,PRMLY) ; N ID S ID="treekup" I $G(PRMLY) S ID="treemly" N GLEZMI,QN,CD S GLEZMI=$$GLEZMI^W4EZM W "",! Q ; HIST(NMD,VD) D KOTDOC(NMD,VD) ; W "" W "",! W "",! Q ; ; KOTDOC(NMDOC,CODDOC) ; W "" W "",! N COLDOC S COLDOC=5 W "" W "",! Q ; FULLSHOW(VD,CODE) ; N SHOW S SHOW="" D ROUNDBUT^%W1JS("fullshow",$$^%W1DICT("SHOWFULLLIST"),"FullShow('"_VD_"','"_$G(CODE)_"')","color:green","wh,22") Q ; MLYMIN ; D TD W $$^%W1DICT("MLYMINIMUM") W "" I $$VIEW D Q .D TDBOLD . W $$MLMIN(CODE) .;;W "",! ; N NOTD S NOTD="" D MLYMINTD($G(CODE),"MIN",$$^%W1ALIGN) Q ; MLYMINTD(CODE,ID,ALGN) ; W $$MLYMINTD1(CODE,$G(ID),$G(ALGN)) Q MLYMINTD1(CODE,ID,ALGN) ; N ST S ST="" ; D MLYRAMATD($G(CODE),"RAMA") W "" Q ; MLYRAMATD(CODE,ID) ; W $$MLYRAMATD1(CODE,$G(ID)) Q MLYRAMATD1(CODE,ID) ; Q $$INP1($G(CODE),"RAMA",50,7,"LTR",$G(ID)) ; NKHZM ; D TD W $$^%W1DICT("NKHZM") W "" I $$VIEW D Q .D TDBOLD . W $$MLNKHZM(CODE) .W "",! ; D NKHZMTD($G(CODE),"NKHZM",$$^%W1ALIGN) Q ; ; NKHZMTD(CODE,ID,ALGN) ; W $$NKHZMTD1(CODE,$G(ID),$G(ALGN)) Q NKHZMTD1(CODE,ID,ALGN) ; N ST S ST="" Q ST ; ; MAM ; D TD W $$^%W1DICT("MAM") W "" D TDB W " id=""mamyn"" " W ">" D .N MAM S MAM=$$MLMAM(CODE) .W $$H2U^%L1FRM($$MAM1(MAM)) W "",! Q ; MAM1(MAM) I MAM=0 Q "`l" Q "ok" ; COMMENT D TD W $$^%W1DICT("COMMENT")_"" W "" Q ; MAZAV ; D TD W $$^%W1DICT("ITEMCLOSED")_"",! Q ; ITRA ; N ITRA S ITRA=" " D TD W $$^%W1DICT("ITRA")_"" D ITRATD($G(CODE)) Q ; ITRATD(CODE) ; W "",! Q ; LASTSPK(SPK) ; D TD N LASTSPK S LASTSPK=" " W $$^%W1DICT("LASTSPK")_"" D TDBOLD D .I '$G(SPK) W " " Q .W SPK_" "_$$H2U^%L1FRM($$NAME^W4SPK(SPK)) W "",! Q ; LASTMHL(MHL) ; D TD N LASTMHL S LASTMHL=" " W $$^%W1DICT("LASTMHL")_"" D TDB W " align=""right"" id=""mhal"">" D .I '$G(MHL) W " " Q .W $J(MHL,2,2) W "",! ; W "",! ; D TDB W " align=""right"" id=""mhhz"">" W $J(MHL*$$KF(CODE),2,2) W "",! Q ; ZW(STAM) Q "*" ; TD ; W "" Q ST ; ; INPC(RKV,WD,SIZE) ; I '$$VIEW D .N CD S CD=$$GET^%W1PRM("CODE") .W "" ; I $$VIEW W ""_$$RKV($G(CODE),0) ; NOM Q ; ; RKV(CODE,FLD,DIR) N A I $G(FLD)=0 Q "" I $$P(FLD)'="",$$D(CODE) Q $$P(FLD) I $$P(FLD)'="" Q $$P(FLD) Q "" ; ; P(FLD) I $G(FLD)="" Q "" N OK S OK=0 I $G(CODE)="" Q "" I CODE["^" S CODE=$P(CODE,"^") I '$$D(CODE) Q "" P1 I FLD="CODE" Q $G(CODE) ;;W "FLD="_FLD,! I $T(@("ML"_FLD))="" Q "" N A,P S A="S P=$$ML"_FLD_"(CODE)" X A Q P ; ; SAVE(PRM) ; N (JB,%ARG,PRM) D KILL^%W3DEB("W4MLPRT") D PUT^%W3DEB("W4MLPRT","PRM=PRM") S MC="CODE~NAME!H~GROUP~EMHZM~EMSFR~MIN~NKHZM~RAMA~MAZAV~MHMHIRA~WEIGHT~MHAL~CMNT" ; D ^%W1SV(MC,PRM) ; ;;S CODE=$TR(CODE," -","") S CODE=$TR(CODE," ","") I CODE=""!(CODE=0) Q "CODE!D" I $$NOCODE(CODE) Q "CODE!D" ; S CODE=$$FUNC^%UCASE(CODE) ; I $G(EMHZM)="" Q "EMHZM!D" I $G(EMSFR)="" Q "EMSFR!D" ; N KF S KF=$$NEWKF^W4PRT(EMHZM,EMSFR,1) I KF="" Q "NOKFMD;"_$G(@$$^W4GL("MLMIDA")@(EMHZM))_";"_$G(@$$^W4GL("MLMIDA")@(EMSFR)) I '$L(GROUP) Q "GROUP!D" ; S NAME=$TR(NAME,"\*","/X") I NAME?.P Q "NAME!D" ; ;;I '$$ONEGLPAR D D .S @$$GLMLPAR@(CODE)=NAME .S $P(@$$GLMLPAR@(CODE,1),"\",1)=GROUP .S $P(@$$GLMLPAR@(CODE,1),"\",2)=EMHZM .S $P(@$$GLMLPAR@(CODE,1),"\",3)=EMSFR .S $P(@$$GLMLPAR@(CODE,1),"\",4)=MIN .S $P(@$$GLMLPAR@(CODE,1),"\",5)=NKHZM .S $P(@$$GLMLPAR@(CODE,1),"\",6)=MAZAV .S $P(@$$GLMLPAR@(CODE,1),"\",8)=RAMA ; -- W4SETMLY .S $P(@$$GLMLPAR@(CODE,1),"\",10)=MHAL .S $P(@$$GLMLPAR@(CODE,1),"\",12)=$$INVH^%L1FRM(CMNT) . .I $$ONEGLPAR D ..D PUT^W4P(CODE,"WEIGHT",WEIGHT) ..D PUT^W4P(CODE,"MH",MHMHIRA) ..D PUT^W4P(CODE,"SUG",GROUP) ; D ^%S2GLSV($$GLMLPAR_"("""_CODE_""")",$$^W4FGIB) ; I $$ONEGLPAR D ^W4SETNMH(CODE,NAME,MHMHIRA) ; N TMPPRT S TMPPRT=$$^W4MAIN("TMPPRT") ; N SP,SPPRC S SP="" F S SP=$O(@TMPPRT@(CODE,SP)) Q:SP="" D .S SPPRC=$G(^(SP)) Q:SPPRC="" .N VL S VL=$J(SPPRC,$$DR,$$DR) .S DISCSP=$P(SPPRC,"\",3) .S $P(VL,"\",3)=DISCSP ; K @TMPPRT ; Q 1 ; N(RKV,PR) ; I $G(PR)="M"!$L(RKV),RKV'?1N.N Q 0 Q 1 ; FREE(CD) ; S CD=$G(CD) N N F N=CD+1:1 Q:'$D(@$$GLMLPAR@($$^W4CDSUPR(N))) Q $$^W4CDSUPR(N) ; VIEW(STAM) ; I $G(%ARG("VIEW")) Q 1 I $G(%ARG("MODE"))="VW" Q 1 Q 0 ; GLMLPAR(STAM) ; ;;I $$ONEGLPAR Q $$^W4GL("PAR") Q $$^W4GL("MLPAR") ; D(CODE) ; Q $D(@$$GLMLPAR@(CODE)) ; MLNAME(CODE) ; I $G(CODE)="" Q 0 I $$ONEGLPAR Q $P($G(@$$^W4GL("PAR")@(CODE)),"**") N ST S ST=$P($G(@$$GLMLPAR@(CODE)),"**") Q $TR(ST,"\*","/X") ; MLSUGP(CODE) ; I $G(CODE)="" Q "" I $$ONEGLPAR Q $$SUG^W4P(CODE) N SUGP S SUGP=$P($G(@$$GLMLPAR@(CODE,1)),"\",1) Q SUGP ; ; MLDEP(CODE) ; I $G(CODE)="" Q "" N SUGP S SUGP=$$MLSUGP(CODE) I 'SUGP Q "" Q $$MLDEPG(SUGP) ; MLDEPG(SUGP) ; I $G(SUGP)="" Q "" N DEP S DEP=$P($G(@$$GLSUGP@(SUGP,1)),"\") I DEP="",$$ONEGLPAR!$$SUPER^W3PRM S DEP=$$DEPG^W4P(SUGP) N DEP1 S DEP1="" I 'DEP Q "" Q DEP ; ; MLDEP1(DEP) ; I $G(DEP)="" Q "" Q $G(@$$GLMLDEP@(DEP)) ; GLMLDEP(STAM) ; Q $$^W4GL("MLDEP") ; PRMAM(MLDEP) I '$G(MLDEP) Q 1 N PRMAM S PRMAM=$P($G(@$$GLMLDEP@(MLDEP,1)),"\") S:PRMAM="" PRMAM=0 Q PRMAM ; MLMAM(CODE) ; I $G(CODE)?.P!($G(CODE)?1"0"."0") Q 1 I $D(@$$^W4GL("W4NOMAM")@(CODE)) Q 0 N MLDEP S MLDEP=$$MLDEP(CODE) I 'MLDEP Q 1 N PRMAM S PRMAM=$$PRMAM(MLDEP) Q PRMAM ; AHMAM(CODE) ; I $$MLMAM(CODE) Q $$MAM^W4PRM Q 0 ; MLITRA(CODE) ; Q $$^W4GETMLY(CODE) ; ; SELMIDA(PRM,ID) ; W $$SELMIDA1($G(PRM),$G(ID)) Q SELMIDA1(PRM,ID) ; N ST S ST="" Q ST ; SELEM(PRM) ; I $G(CODE)="" S CODE=$$GETP^%W1PRM("CODE") N OPT S OPT="" N N,A S N="" F S N=$O(@$$^W4GL("MLMIDA")@(N)) Q:N="" D .S A=$G(^(N)) .S OPT=OPT_"" Q OPT ; MLEMHZM(CODE) ; I $G(CODE)="" Q "" N EMHZM S EMHZM=$$EMHZ^W4PRT(CODE) S:EMHZM="" EMHZM=1 Q EMHZM ; MLEMSFR(CODE) ; I $G(CODE)="" Q "" N EMSFR S EMSFR=$$EMSFR^W4PRT(CODE) S:EMSFR="" EMSFR=1 Q EMSFR ; MLMIN(CODE) ; I $G(CODE)="" Q "" S MLMIN=$P($G(@$$GLMLPAR@(CODE,1)),"\",4) Q MLMIN ; MLRAMA(CODE) ; I $G(CODE)="" Q "" S MLRAMA=$P($G(@$$GLMLPAR@(CODE,1)),"\",8) Q MLRAMA ; MLNKHZM(CODE) ; I $G(CODE)="" Q "" Q $P($G(@$$GLMLPAR@(CODE,1)),"\",5) ; MLMAZAV(CODE) ; I $G(CODE)="" Q 0 Q $P($G(@$$GLMLPAR@(CODE,1)),"\",6) ; MLMHER(CODE) ; I $G(CODE)="" Q 0 N MHER S MHER=$P($G(@$$GLMLPAR@(CODE,1)),"\",7) I MHER'>0 S MHER=$$MHAL(CODE) Q $J(MHER,$$DR,$$DR) ; INPMHAL(CODE) ; I $G(CODE)="" Q 0 S MHAL=$$MHAL(CODE) Q $J(MHAL,$$DR,$$DR) ; MLCMNT(CODE) ; I $G(CODE)="" Q "" Q $P($G(@$$GLMLPAR@(CODE,1)),"\",12) ; TDB ; W "",! D TDB W " id=""AH"" >" D .I $G(CODE)="" W " " Q .W $$AHREVAH(CODE) W "",! Q ; ; SHOWMHEREH(CODE) ; D TD W $$^%W1DICT("VALUEPRICE") W "",! D TDBOLD I $G(CODE)="" W " " E W $$MLMHER(CODE) W "",! Q ; MHMUMLAZ(CODE) ; I $G(CODE)="" Q "" N MHAL S MHAL=$$MHAL(CODE) N AHRV S AHRV=$$AHREVAH(CODE) N AHMAM S AHMAM=$$MAMD^W4L(+$H) I '$$MLMAM(CODE) S AHMAM=0 N MHMUML S MHMUML=$J(MHAL*(100+AHRV)*(100+AHMAM)*.0001,$$DR,$$DR) Q MHMUML ; SHOWMHMUMLAZ(CODE) ; D TD W $$^%W1DICT("RECOMMENDEDPRICE") W "",! ; D TDB W ">" N VL S VL="" I $G(CODE)'="" S VL=$$MHMUMLAZ(CODE) W "" W "",! Q ; MLMHMHIRA(CODE) ; I $G(CODE)="" Q "" Q $$MH^W4P(CODE) ; SHOWMHMHIRA(CODE) ; S TDSTYLE="font-weight:bold" D TD W $$^%W1DICT("CLIENTPRICE") W "",! ; W "",! Q ; ; CHGR(GR) ; N MHAL S MHAL="" I GR[";" S MHAL=$P(GR,";",2),GR=$P(GR,";") N CODE S CODE=$$GETP^%W1PRM("CODE") I MHAL="" S MHAL=$$MHAL(CODE) N AH,MUML N MLDEP S MLDEP=$$MLDEPG(GR) N MAMYN S MAMYN=$$PRMAM(MLDEP) N MAM S MAM=0 I MAMYN S MAM=$$MAM^W4PRM ; S AH=$$AHRVG(GR) S MUML=$J(MHAL*(100+AH)*(100+MAM)*.0001,$$DR,$$DR) Q AH_";"_MUML_";"_$S(MLDEP="":"",1:$$CLWEB^%L1FRM($$MLDEP1(MLDEP)))_";"_$$MAM1(MAMYN) ; DR() ; Q 4 W4MLPRTB W4MLPRTB ; [ 29.07.18 17:54 ] [ 11.06.17 19:20 ] [ 04.07.16 17:31 ] N (JB,%ARG,SRCH) I '$D(JB) W " JB number is not defined ! " Q ; I $L($G(SRCH)) D .I $E(SRCH,1,2)="&#" D ..S SRCH=$$U2H^%L1FRM(SRCH) ; W "
    ",! W "
    "_$$^%W1DICT("GROUPEMPTABLE")_"
    "_$$^%W1DICT("EMPID")_""_$$^%W1DICT("EMPNAME")_""_$$^%W1DICT("SIGN")_"
     "_N_"  "_$$H2U^%L1FRM($$^W4NAME(N))_" 
    " W $$^%W1DICT("SUPPLIERPRICES") W "" W $$^%W1DICT("LASTPRICE") W " " W " " ; W "  " ; W $$^%W1DICT("SHOWHISTORY") W " " W " " W "" . D ROUNDBUT^%W1JS("newpricelist",$$^%W1DICT("NEWPRICELIST"),"NewPriceList()","color:blue","wh,22") .W "
    ",! S TO="w4mhspk.jsp?JB="_JB_"&PRT="_$G(CODE) I '$$VIEW S TO=TO_"&UPDATE=1" W "",! W "
    " D SELDOC(VD) W "
    " W $$^%W1DICT(NMDOC) W "" W $$^%W1DICT("SHOWLASTDOCUMENTS",COLDOC) W " " W " " ; W $$^%W1DICT("SHOWALLDOCS") W " " W " " W "
    " S ST=ST_$$INP1($G(CODE),"MIN",50,7,"LTR",$G(ID)) Q ST ; NBSP(SP) Q $$NBSP^%L1FRM(SP) ; ; MLYRAMA ; ;;W "" W $$NBSP(5) W $$^%W1DICT("MLYRAMA") W $$NBSP(3) ; I $$VIEW D Q . W "" . W $$MLRAMA(CODE) . W "",! .W "" S ST=ST_$$INP1($G(CODE),"NKHZM",50,7,"LTR",$G(ID)) S ST=ST_"" W "",! W "" W "" W "" I $G(CODE) D .I $$CHNITRA^W3PRM D ..W "",! ..W $$NBSP^%L1FRM(3) .W "" .W $J($$MLITRA(CODE),2,2)_"" W "" W $$^%W1DICT("LASTMHZ") W "",! K TDSPAN,TDWIDTH,TDALIGN,TDDIR,TDSTYLE Q ; INP(CODE,RKV,WD,SIZE,DIR,ID,FSZ) ; I $G(ID)="" S ID=RKV W $$INP1(CODE,$G(RKV),$G(WD),$G(SIZE),$G(DIR),$G(ID),$G(FSZ)) ; Q ; INP1(CODE,RKV,WD,SIZE,DIR,ID,FSZ) ; N ST S ST="" ; I '$$VIEW,DIR'="D" D .S ST="" ; I $$VIEW S ST=ST_""_$$RKV($G(CODE),0)_"" I '$D(NOTD) S ST=ST_"" Q ; SELDOC(VD) ; S TO="w4mlhist.jsp?JB="_JB_"&CODE="_$G(CODE)_"&VD="_VD W "",! Q ; TEST(CODE) ; I $TR(CODE,"`","")?.A Q "FIND" I $$NOCODE(CODE) Q "FIND" S CODE=$$FUNC^%UCASE(CODE) I $D(@$$GLMLPAR@(CODE)) Q 1 Q 0 ; NOCODE(CODE) ; N J,STP,OK S STP="!@#$%^&*()_+=\?'""/>< ",OK=1 ; -- WAS "-" TOO F J=1:1:$L(STP) I CODE[$E(STP,J) S OK=0 Q Q 'OK ; LIST ; N DT,SUG,ORG,NOM,N,A I VD="IHB" S DOC="INVOICE" I VD="ITM" S DOC="DLVDOC" D DEFGLM^W4SETMLY S SUG="I" ; S DT="" F S DT=$O(@GLML@(CODE,DT),-1) Q:DT="" D .S ORG="" F S ORG=$O(@GLML@(CODE,DT,SUG,ORG)) Q:ORG="" D ..S NOM="" F S NOM=$O(@GLML@(CODE,DT,SUG,ORG,VD,NOM),-1) Q:NOM="" D ...S N="" F S N=$O(@$$^W4GL("W4INP")@(ORG,VD,NOM,N)) Q:N="" D ....S A=$G(^(N)) I $P(A,"\")=CODE D .....W "",! W "",! Q ; VWEM(CODE,PRM) ; N EM S EM=$$P(PRM) N EM1 S EM1="" I EM S EM1=$G(@$$^W4GL("MLMIDA")@(EM)) W EM," ",$$H2U^%L1FRM(EM1) Q ; GLSUGP(STAM) ; I $$ONEGLPAR Q $$^W4GL("PARSUG") Q $$^W4GL("MLSUGP") ; ONEGLPAR(STAM) ; I $$ONEGLPAR^W3PRM Q 1 Q 0 ; MHAL(CODE) ; I $G(CODE)="" Q "" N MHAL I $$MHAL^W3PRM S MHAL=$P($G(@$$GLMLPAR@(CODE,1)),"\",10) Q MHAL S MHAL=$J($$MHL(CODE)*(100-$$DISC(CODE))*.01,$$DR,$$DR) S $P(@$$GLMLPAR@(CODE,1),"\",10)=MHAL Q MHAL ; MHL(CODE) ; I $G(CODE)="" Q "" N MHAL I $D(@$$GLEZM^W4EZM@(CODE))>9,$$MANOT^W4EZM(CODE) D Q $J(MHAL,$$DR,$$DR) .S MHAL=$$TOTALUT^W4EZMIDK(CODE)/$$MANOT^W4EZM(CODE) ; N A S A=$$^W4MLLAST(CODE,+$H) Q $J($P(A,"\"),$$DR,$$DR) ; ; DISC(CODE) ; N A S A=$$^W4MLLAST(CODE,+$H) Q $J($P(A,"\",6),2,2) ; SPK(CODE) ; I $G(CODE)="" Q "" N A S A=$$^W4MLLAST(CODE,+$H) Q $P(A,"\",2) ; AHREVAH(CODE) ; I $G(CODE)="" Q "" N SUGP S SUGP=$$MLSUGP(CODE) I SUGP="" Q "" Q $$AHRVG(SUGP) ; AHRVG(SUGP) ; I $G(SUGP)="" Q "" N GLSUGP S GLSUGP=$$GLSUGP N AHRV I '$$ONEGLPAR S AHRV=$P($G(@GLSUGP@(SUGP,1)),"\",2) I $$ONEGLPAR S AHRV=$P($G(@GLSUGP@(SUGP,1)),"\",10) Q $J(AHRV,2,2) ; SHOWAHREVAH(CODE) D TD I $$MHAL^W3PRM D . W $$^%W1DICT("COSTINGPRICE") .W $$NBSP^%L1FRM(5) .D ..N VL S VL="" I $G(CODE)'="" S VL=$$INPMHAL(CODE) ..W "" ; W $$NBSP^%L1FRM(5) W $$^%W1DICT("PROFITPERCENT") W "" I $$ONEGLPAR D .N FSZ S FSZ=12 I $$SUPER^W3PRM S FSZ=18 .N NOTD S NOTD="" D INP($G(CODE),"MHMHIRA",160,8,"LTR","",FSZ) .W $$NBSP^%L1FRM(5) .W "" ; I '$$ONEGLPAR D .I $L($G(CODE)) W $J($$MH^W4P(CODE),2,2) .I '$L($G(CODE)) W " " W "
    ",! W "" ; W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "",! ; D CRTMPPAR ; S K="",I=0 F S K=$O(@$$^W4MAIN("TMPPAR")@(K)) Q:K="" D .S N=$G(^(K)) Q:N="" .W "" S I=I+1 . W $$STPAR(N) .W "",! W "
     "_$$^%W1DICT("ITEMCODE")_""_$$^%W1DICT("ITEMNAME")_""_$$^%W1DICT("GROUP")_""_$$^%W1DICT("EMHZM")_""_$$^%W1DICT("EMSFR")_""_$$^%W1DICT("SPLAST")_""_$$^%W1DICT("MHALAST")_""_$$^%W1DICT("MLYMINIMUM")_""_$$^%W1DICT("NKHZM")_""_$$^%W1DICT("MLYRAMA")_""_$$^%W1DICT("PAIL")_""_$$^%W1DICT("CHANGED")_"
    ",! W "
    ",! Q ; ; GROUP ; W $$GROUP1($G(N)) Q ; GROUP1(N) ; N ST S ST="" Q ST ; SELSORT ; W "",! Q ; SRCH(SRCH,PAR) ; Q $$^W1SRCH(SRCH,PAR,"","ML") ; FIRSTGR(STAM) ; Q $$^W4FRSMLG ; SAVE(PRM) ; N CD,NM,NML,MH,DESC,GR,SHOW,CLR,WEIGHT,CHN,PRINTER S PRM=$$CLEAR^%L1FRM(PRM) S CD=$P(PRM,"~") I CD="" Q 0 S CD=$$FUNC^%UCASE(CD) ; I $D(^[$$^W3MAIN]TMPDEL(JB,CD)) D Q 1 .K ^[$$^W3MAIN]TMPDEL(JB,CD) .;;D ^W3DEL(CD) .K @$$GLMLPAR@(CD) ; Q $$SAVE^W4MLPRT(PRM) ; ; SAVEND K ^[$$^W3MAIN]TMPLAST(JB) K ^[$$^W3MAIN]TMPDEL(JB) Q ; DELROW(CD) ; Q:'$G(JB) I $D(^[$$^W3MAIN]TMPDEL(JB,CD)) K ^(CD) Q S ^[$$^W3MAIN]TMPDEL(JB,CD)=$G(@$$GLMLPAR@(CD)) Q ; ; NEWCOD(KV) ; N A S A=$O(@$$GLMLPAR@(9999999),-1)+1 N LCD S LCD="" I $G(KV) D .N N S N="" F S N=$O(@$$GLMLPAR@(N)) Q:N="" D ..I $$MLSUGP^W4MLPRT(N)=KV S LCD=N ; I LCD,'$D(@$$GLMLPAR@(LCD+1)) S A=LCD+1 ; I A'>$G(^[$$^W3MAIN]TMPLAST(JB)) D .S A=^[$$^W3MAIN]TMPLAST(JB)+1 S ^[$$^W3MAIN]TMPLAST(JB)=A Q A ; ; CRTMPPAR ; N N,I,K,KV,IND S KV=$G(%ARG("CDKV")) S K=0 K @$$^W4MAIN("TMPPAR") ; I $G(%ARG("SORT"))=1 D Q .K @$$^W4MAIN("VRM") .N N,I .S N="",I=0 F I=1:1 S N=$O(@$$GLMLPAR@(N)) Q:N="" S NM=$G(^(N)) D ..S IND=$$INVH^%L1FRM(NM) ..S IND=$$ENG^%L1FRM(IND,10)_$TR($J(I,5)," ",0) ..S @$$^W4MAIN("VRM")@(IND)=N .; .S IND="",I=0 F S IND=$O(@$$^W4MAIN("VRM")@(IND)) Q:IND="" D ..S N=$G(^(IND)) Q:N="" ..D SETTMPPAR(N) ; S N="" F S N=$O(@$$GLMLPAR@(N)) Q:N="" D SETTMPPAR(N) Q ; SETTMPPAR(PAR) ; N SUG S SUG=$$MLSUGP^W4MLPRT(PAR) I KV,KV'=SUG Q I KV="NO",SUG'?.P,SUG'="NO",SUG'="ALL",SUG'=0 Q I $L($G(SRCH)),'$$SRCH(SRCH,PAR) Q S K=K+1 S @$$^W4MAIN("TMPPAR")@(K)=PAR Q ; ITEMNAME(PAR) ; N ST S ST="" S ST=ST_"
    " S ST=ST_"" S ST=ST_"
    " Q ST ; CLOSEPAR(PAR) ; Q $$MLMAZAV^W4MLPRT(PAR) ; GLMLPAR(STAM) ; Q $$GLMLPAR^W4MLPRT ; GLSUGP(STAM) ; Q $$GLSUGP^W4MLPRT ; ; STPAR(N) ; N CDKV S CDKV=$G(%ARG("CDKV")) I N[";" S CDKV=$P(N,";",2),N=$P(N,";") N ST S ST="" ; -------- [ + - ] S ST=ST_" +
    " S ST=ST_" - " S ST=ST_"" S ST=ST_"" S ST=ST_" "_N_" 
    " S ST=ST_$$BTN^W4BUTTON("showcard"_N,$$^%W1DICT("SHOWITEMCARD"),"ShowItemCard('"_N_"')","color:green",",22,,120") S ST=ST_"
    " S ST=ST_"" S ST=ST_"" S ST=ST_$$ITEMNAME(N) S ST=ST_"" S ST=ST_"" N GRSEL,GRSELPAR S GRSEL=$$MLSUGP^W4MLPRT(N),GRSELPAR="" I GRSEL="",CDKV S GRSEL=CDKV S ST=ST_$$GROUP1(N) S ST=ST_"" ; N MLPRTB S MLPRTB="" ; N EMHZ,EMSF S EMHZ=$$EMTD1^W4MLPRT(N,"EMHZM","emhzm-"_N) S EMSF=$$EMTD1^W4MLPRT(N,"EMSFR","emsfr-"_N) S ST=ST_EMHZ S ST=ST_EMSF ; S ST=ST_"" N SPK,SPK1 S (SPK,SPK1)="" S SPK=$$SPK^W4MLPRT(N) I SPK'?.P S SPK1=$$H2U^%L1FRM($$NAME^W4SPK(SPK)) S ST=ST_SPK_" "_SPK1 S ST=ST_"" S ST=ST_"" S ST=ST_$J($$MHAL^W4MLPRT(N),2,2) S ST=ST_"" S ST=ST_$$MLYMINTD1^W4MLPRT(N,"mlmin-"_N," align=""center"" ") S ST=ST_$$NKHZMTD1^W4MLPRT(N,"nkhzm-"_N," align=""center"" ") S ST=ST_"" S ST=ST_$$MLYRAMATD1^W4MLPRT(N,"rama-"_N) N CHECKED S CHECKED=1 I $$CLOSEPAR(N)=1 S CHECKED=0 S ST=ST_"" S ST=ST_" " S ST=ST_"" S ST=ST_"" S ST=ST_" " S ST=ST_"" ; Q ST W4MLQNMH W4MLQNMH(STAM) ; [ 21.05.17 12:40 ] [ Q +$G(@$$^W4PRM@("MLQNMH")) W4MLRES0 W4MLREST ; [ 19.12.19 11:17 ] [ 27.11.16 14:55 ] [ 13.10.16 03:46 ] Q ; FREEDOC ;-- TM LELO HSB ? N GLINP S GLINP=$$^W4GL("W4INP") N N,N1,OK,DT,VD,VD1 S N="" K @$$^W4GL("W4FREEDOC") S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .F VD="ITM","ITZ" D ..F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...S DT=$$^%L1DC($P($G(^(N)),"\",4),3) ...S OK=0 ... ...S N1="" F S N1=$O(@GLINP@(SPK,"IHB",N1)) Q:N1="" D Q:OK ....S VD1=VD ....I $D(@GLINP@(SPK,"IHB",N1,VD,N)) S OK=N1 ....I $D(@GLINP@(SPK,"IHB",N1,VD,-N)) S OK=N1,VD1="ITZ" ... ...I OK S @GLINP@(SPK,VD1,N,"IHB")=OK ... ...I VD="ITZ" D ....S N1="" F S N1=$O(@GLINP@(SPK,"IHBZ",N1)) Q:N1="" D Q:OK .....I $D(@GLINP@(SPK,"IHBZ",N1,VD,N)) S OK=N1 ....I OK S @GLINP@(SPK,VD,N,"IHBZ")=OK ... ...I 'OK S @$$^W4GL("W4FREEDOC")@(SPK,VD,N)=DT_"\"_$ZD($H,"DD.MM.YY 24:60")_"\R" Q ; ; DIR ; N GLDIR S GLDIR=$$^W4INPDIR N GLDIRI S GLDIRI=$$I^W4INPDIR N GLINP S GLINP=$$^W4GL("W4INP") N N,VD,SPK,DT K @GLDIR,@GLDIRI S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .S VD="" F S VD=$O(@GLINP@(SPK,VD)) Q:VD="" D ..S N="" F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...S DT=$$^%L1DC($P($G(^(N)),"\",4),3) ...D SET^W4INPDIR(DT,SPK,VD,N) Q ; ; DIROU ; N N,N1,DTI,HD,DIR,DIRD S DIR=$$^W4GL("W4DIR") S DIRD=$$^W4GL("W4DIRD") K @DIR,@DIRD S N="" F S N=$O(@$$^W4GL("W4DOC")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S DATI=$P(HD,"\",8) .S TIME=$P(DATI," ",2),DATI=$P(DATI," ") .S DTI=$$^%L1DC(DATI,3) .S N1=9999999 F S N1=$O(@$$^W4GL("W4DOC")@(N,N1)) Q:N1="" D ..I N1?1U.E D ...S ND=$G(^(N1)) Q:'ND ...S @DIR@(N1,ND)=N ...S @DIRD@(DT,N)=DTI_","_(TIME*3600+($P(TIME,":",2)*60)) Q ; ; MLY ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N VD,SPK,LKH,DT,N,GLML,GLMLY,GLSP,GLINP,HZM,DAT D DEFGLM^W4SETMLY N GLINP S GLINP=$$^W4GL("W4INP") K @GLML,@GLSP ; I '$D(W4RESTML) K @GLMLY ; I $G(DISP) W !,"^W4INP",!! S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .I $G(DISP) W "SPK="_SPK,! .S VD="" F S VD=$O(@GLINP@(SPK,VD)) Q:VD="" I VD'="IHZ",VD'="IHBI" D ..S N="" F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...N A S A=$G(^(N)) ...I VD="IHB",$D(^(N,"ITM")) Q ...S DT=$$^%L1DC($P(A,"\",4),3) ...D ^W4SETMLY(DT,VD,SPK,N) ; D DIR ; I $G(DISP) W !!,"^W4DOC",!! S N="" F S N=$O(@$$^W4GL("W4DOC")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S VD="OUT",LKH=$P(HD,"\") Q:'$$^W4ISCDLK(LKH) .D ^W4SETMLY(DT,VD,LKH,N) ; I $G(DISP) W !!,"^P1HZ",!! N DAT,DTHZ S HZM="" F S HZM=$O(@$$^W4GL("P1HZ")@(HZM)) Q:HZM="" I HZM>0 D .I $G(DISP) I '(HZM#500) W HZM,! .S DAT=$$^%L1DC($$DATK^W4HZMST(HZM),2) Q:DAT="" .S DTHZ=$$^%L1DC(DAT,4) Q:'DTHZ .N W4MLREST S W4MLREST="" .D PLU1^W4HZMPC ; I $G(DISP) W !!,"^W4IDK",!! S N="" F S N=$O(@$$^W4GL("W4IDK")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S VD="ITK",SPK=$P(HD,"\") S:SPK="" SPK=0 .D ^W4SETMLY(DT,VD,SPK,N) ; D PUT^%W1PRM("MLMLREST",1) Q ; MLJ(JB) ; D MLY Q ; ; ML ; W4MLY --> W4ML,W4MLS,W4MLSP D PUT^%W1PRM("MLMLREST",0) N DT,PAR,SUG,ORG,VD,NOM,GLMLY,GLML,GLMLS,GLSP,A,J D DEFGLM^W4SETMLY K @GLML,@GLMLS,@GLSP ; S DT="" F S DT=$O(@GLMLY@(DT)) Q:DT="" D .S PAR="" F S PAR=$O(@GLMLY@(DT,PAR)) Q:PAR="" D ..S SUG="" F S SUG=$O(@GLMLY@(DT,PAR,SUG)) Q:SUG="" D ...S ORG="" F S ORG=$O(@GLMLY@(DT,PAR,SUG,ORG)) Q:ORG="" D ....S VD="" F S VD=$O(@GLMLY@(DT,PAR,SUG,ORG,VD)) Q:VD="" D .....S NOM="" F S NOM=$O(@GLMLY@(DT,PAR,SUG,ORG,VD,NOM)) Q:NOM="" D ......S QNM=+$G(^(NOM)),NR=$$NR^W4SETMLY(VD) ......D SETML^W4SETMLY(NR,DT,PAR,SUG,ORG,VD,NOM,QNM) ; D PUT^%W1PRM("MLMLREST",1) Q ; ; KF(PAR,EM2) Q 1 ; INP(VDOC) ; I $E(VDOC)="I" Q 1 Q 0 W4MLREST W4MLREST ; [ 19.12.19 10:46 ] [ 27.11.16 14:55 ] [ 13.10.16 03:46 ] Q ; FREEDOC ;-- TM LELO HSB ? N GLINP S GLINP=$$^W4GL("W4INP") N N,N1,OK,DT,VD,VD1 S N="" K @$$^W4GL("W4FREEDOC") S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .F VD="ITM","ITZ" D ..F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...S DT=$$^%L1DC($P($G(^(N)),"\",4),3) ...S OK=0 ... ...S N1="" F S N1=$O(@GLINP@(SPK,"IHB",N1)) Q:N1="" D Q:OK ....S VD1=VD ....I $D(@GLINP@(SPK,"IHB",N1,VD,N)) S OK=N1 ....I $D(@GLINP@(SPK,"IHB",N1,VD,-N)) S OK=N1,VD1="ITZ" ... ...I OK S @GLINP@(SPK,VD1,N,"IHB")=OK ... ...I VD="ITZ" D ....S N1="" F S N1=$O(@GLINP@(SPK,"IHBZ",N1)) Q:N1="" D Q:OK .....I $D(@GLINP@(SPK,"IHBZ",N1,VD,N)) S OK=N1 ....I OK S @GLINP@(SPK,VD,N,"IHBZ")=OK ... ...I 'OK S @$$^W4GL("W4FREEDOC")@(SPK,VD,N)=DT_"\"_$ZD($H,"DD.MM.YY 24:60")_"\R" Q ; ; DIR ; N GLDIR S GLDIR=$$^W4INPDIR N GLDIRI S GLDIRI=$$I^W4INPDIR N GLINP S GLINP=$$^W4GL("W4INP") N N,VD,SPK,DT K @GLDIR,@GLDIRI S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .S VD="" F S VD=$O(@GLINP@(SPK,VD)) Q:VD="" D ..S N="" F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...S DT=$$^%L1DC($P($G(^(N)),"\",4),3) ...D SET^W4INPDIR(DT,SPK,VD,N) Q ; ; DIROU ; N N,N1,DTI,HD,DIR,DIRD S DIR=$$^W4GL("W4DIR") S DIRD=$$^W4GL("W4DIRD") K @DIR,@DIRD S N="" F S N=$O(@$$^W4GL("W4DOC")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S DATI=$P(HD,"\",8) .S TIME=$P(DATI," ",2),DATI=$P(DATI," ") .S DTI=$$^%L1DC(DATI,3) .S N1=9999999 F S N1=$O(@$$^W4GL("W4DOC")@(N,N1)) Q:N1="" D ..I N1?1U.E D ...S ND=$G(^(N1)) Q:'ND ...S @DIR@(N1,ND)=N ...S @DIRD@(DT,N)=DTI_","_(TIME*3600+($P(TIME,":",2)*60)) Q ; ; MLY ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N VD,SPK,LKH,DT,N,GLML,GLMLY,GLSP,GLINP,HZM,DAT D DEFGLM^W4SETMLY N GLINP S GLINP=$$^W4GL("W4INP") K @GLML,@GLSP ; I '$D(W4RESTML) K @GLMLY ; I $G(DISP) W !,"^W4INP",!! S SPK="" F S SPK=$O(@GLINP@(SPK)) Q:SPK="" D .I $G(DISP) W "SPK="_SPK,! .S VD="" F S VD=$O(@GLINP@(SPK,VD)) Q:VD="" I VD'="IHZ",VD'="IHBI" D ..S N="" F S N=$O(@GLINP@(SPK,VD,N)) Q:N="" D ...N A S A=$G(^(N)) ...I VD="IHB",$D(^(N,"ITM")) Q ...S DT=$$^%L1DC($P(A,"\",4),3) ...D ^W4SETMLY(DT,VD,SPK,N) ; D DIR ; I $G(DISP) W !!,"^W4DOC",!! S N="" F S N=$O(@$$^W4GL("W4DOC")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S VD="OUT",LKH=$P(HD,"\") Q:'$$^W4ISCDLK(LKH) .D ^W4SETMLY(DT,VD,LKH,N) ; I $G(DISP) W !!,"^P1HZ",!! N DAT,DTHZ S HZM="" F S HZM=$O(@$$^W4GL("P1HZ")@(HZM)) Q:HZM="" I HZM>0 D .I $G(DISP) I '(HZM#500) W HZM,! .S DAT=$$^%L1DC($$DATK^W4HZMST(HZM),2) Q:DAT="" .S DTHZ=$$^%L1DC(DAT,4) Q:'DTHZ .N W4MLREST S W4MLREST="" .D PLU1^W4HZMPC ; I $G(DISP) W !!,"^W4IDK",!! S N="" F S N=$O(@$$^W4GL("W4IDK")@(N)) Q:N="" D .N HD S HD=$G(^(N)) .S DT=$$^%L1DC($P(HD,"\",4),3) .S VD="ITK",SPK=$P(HD,"\") S:SPK="" SPK=0 .D ^W4SETMLY(DT,VD,SPK,N) ; D PUT^%W1PRM("MLMLREST",1) Q ; MLJ(JB) ; D MLY Q ; ; ML ; W4MLY --> W4ML,W4MLS,W4MLSP D PUT^%W1PRM("MLMLREST",0) N DT,PAR,SUG,ORG,VD,NOM,GLMLY,GLML,GLMLS,GLSP,A,J D DEFGLM^W4SETMLY K @GLML,@GLMLS,@GLSP ; S DT="" F S DT=$O(@GLMLY@(DT)) Q:DT="" D .S PAR="" F S PAR=$O(@GLMLY@(DT,PAR)) Q:PAR="" D ..S SUG="" F S SUG=$O(@GLMLY@(DT,PAR,SUG)) Q:SUG="" D ...S ORG="" F S ORG=$O(@GLMLY@(DT,PAR,SUG,ORG)) Q:ORG="" D ....S VD="" F S VD=$O(@GLMLY@(DT,PAR,SUG,ORG,VD)) Q:VD="" D .....S NOM="" F S NOM=$O(@GLMLY@(DT,PAR,SUG,ORG,VD,NOM)) Q:NOM="" D ......S QNM=+$G(^(NOM)),NR=$$NR^W4SETMLY(VD) ......D SETML^W4SETMLY(NR,DT,PAR,SUG,ORG,VD,NOM,QNM) ; D RESTMH ; D PUT^%W1PRM("MLMLREST",1) Q ; ; RESTMH ; N GLSP S GLSP=$$^W4GL("W4MLSP") N ORG,PAR,DT,GLSPKMH S GLSPKMH=$$^W4GL("MLSPKMH") S ORG="" F S ORG=$O(@GLSPKMH@(ORG)) Q:ORG="" D .S PAR="" F S PAR=$O(@GLSPKMH@(ORG,PAR)) Q:PAR="" D ..S DT="" F S DT=$O(@GLSPKMH@(ORG,PAR,DT)) Q:DT="" D ...S VL=$G(^(DT)) ...S $P(@GLSP@(ORG,"MH",PAR,DT),"\")=+VL ...S $P(@GLSP@(ORG,"MH",PAR,DT),"\",4)=$P(VL,"\",3) Q ; KF(PAR,EM2) Q 1 ; INP(VDOC) ; I $E(VDOC)="I" Q 1 Q 0 W4MLSUGP W4MLSUGP(PRM) ; [ 05.08.14 07:23 ] [ I $P(PRM,";",3)="" Q "NODEP" I $P(PRM,";",4)="" Q "NONAME" Q 1 W4MLTNIN W4MLTNIN ; DOCH HACHNASOT MLAY [ 23.03.16 09:03 ] [ 22.03.16 19:02 ] [ 21.03.16 13:12 ] N (JB,%ARG,%REM) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" ; K %L1PC S %REPN="MLTNIN" S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN S @$$^%W1GLREP@("MIUN","PROG")="GET^W4MLTNIN" Q ; ; GET ; N VD,SPK,LKH,DT,N,GLML,GLMLY,GLSP,GLINP,HZM,DAT,SP D DEFGLM^W4SETMLY N GLINP S GLINP=$$^W4GL("W4INP") K @GLML,@GLSP ; N VRM S VRM=$$^W4MAIN("VRM") K @VRM S PRTN=$$^%W1JB ; S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) ; I '$G(ADKVZ) S ADKVZ=9999999 I '$G(ADDEP) S ADDEP=9999999 ; I $G(SPK) D FRMVRM(SPK) Q S SP="" F S SP=$O(@GLINP@(SP)) Q:SP="" D FRMVRM(SP) Q ; SHEM(PAR) I $G(PAR)="" Q "" N SHEM S SHEM=$$MLNAME^W4MLPRT(PAR) Q SHEM ; ; CHKPRM(STAM) ; D PUT^%W3DEB("W4MLTNQ-CHKPRM","MEDEP=MEDEP & ADDEP=ADDEP & MEDAT=MEDAT & ADDAT=ADDAT") I '$$DATVLD(MEDAT) Q "0;DATENOTVALID;;MEDATID"_$$DATVLD(MEDAT) I '$$DATVLD(ADDAT) Q "0;DATENOTVALID;;ADDATID"_$$DATVLD(ADDAT) I $$^%L1DC(ADDAT,3)<$$^%L1DC(MEDAT,3) Q "0;RANGENOTVALID;;MEDATIDdd" I MEDEP>ADDEP Q "0;RANGENOTVALID;;MEDEP" I MEKVZ>ADKVZ Q "0;RANGENOTVALID;;MEKVZ" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4MLTNIN" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N PAR S PAR=$P(A,"\",1) W " style=""cursor:pointer;color:black;font-size:"_$$^W3FSZ(11) W """" W " onClick=""ShowItemReport('"_PAR_"','"_$G(%ARG("MEDAT"))_"','"_$G(%ARG("ADDAT"))_"','ifr')""" Q ; TD ; Q ; SPK(PAR,SPK) ; I '$D(@$$^W4GL("W4MLSP")@(SPK)) Q 1 I $D(@$$^W4GL("W4MLSP")@(SPK,"P",PAR)) Q 1 Q 0 ; DEP(PAR) ; Q $$MLDEP^W4MLPRT(PAR) ; KVZ(PAR) ; Q $$MLSUGP^W4MLPRT(PAR) ; EM(PAR) ; N EM S EM=$$MLEMSFR^W4MLPRT(PAR) I EM="" S EM=1 Q EM ; EM1(PAR) ; N EM S EM=$$EM(PAR) N EM1 S EM1=$G(@$$^W4GL("MLMIDA")@(EM)) I EM1="" S EM1="dcigi" Q EM1 ; VIB(PAR,SPK) ; N KVZ,DEP I $G(MEPAR),PARADPAR Q 0 I $G(SPK),'$$SPK(PAR,SPK) Q 0 S DEP=$$DEP(PAR) I $G(MEDEP),DEPADDEP Q 0 S KVZ=$$KVZ(PAR) I $G(MEKVZ),KVZADKVZ Q 0 Q 1 ; ; FRMVRM(SP) ; N VD,N,A,VD,DT,NP,PRT,ST,STVRM ; S VD="" F S VD=$O(@GLINP@(SP,VD)) Q:VD="" I VD'="IHZ",VD'="IHBI" D .S N="" F S N=$O(@GLINP@(SP,VD,N)) Q:N="" D ..S A=$G(^(N)) ..I VD="IHB",$D(^(N,"ITM")) Q ..S DT=$$^%L1DC($P(A,"\",4),3) ..; ..I DTADDT) Q ..S NP="" F S NP=$O(@GLINP@(SP,VD,N,NP)) Q:NP="" D ...S ST=$G(^(NP)) ...S PRT=$P(ST,"\") Q:PRT="" ...I '$$VIB(PRT,SP) Q ...; ...S STVRM=$G(@VRM@(SP,DT,PRT)) ...I VD'="ITZ" D ....S $P(STVRM,"*")=$P(STVRM,"*")+$$QNST(ST) ....S $P(STVRM,"*",2)=$P(STVRM,"*",2)+$$SUMST(ST) ...I VD="ITZ" D ....S $P(STVRM,"*",3)=$P(STVRM,"*",3)+$$QNST(ST) ....S $P(STVRM,"*",4)=$P(STVRM,"*",4)+$$SUMST(ST) ...S @VRM@(SP,DT,PRT)=STVRM ; S %L1PC("CONTINUE")="" Q ; QNST(ST) ; Q $P(ST,"\",4)*$$KF^W4SETMLY($P(ST,"\"),$P(ST,"\",7)) ; SUMST(ST) ; Q $J($P(ST,"\",3)*$P(ST,"\",4)*(100-$P(ST,"\",5)*.01),2,2) ; SP ; S SP1="" Q:$G(SP)="" S SP1=$G(@$$^W4GL("W4SPK")@(SP)) Q ; DT ; S DAT=$ZD(DT,"DD.MM.YY") Q ; PRT ; S PRT1="" Q:$G(PRT)="" S PRT1=$$MLNAME^W4MLPRT(PRT) S KVZ=$$KVZ(PRT),KVZ1="" I $L(KVZ) S KVZ1=$G(@$$^W4GL("MLSUGP")@(KVZ)) S DEP=$$DEP(PRT),DEP1="" I $L(DEP) S DEP1=$G(@$$^W4GL("MLDEP")@(DEP)) S x1=$$EM1(PRT) N ST S ST=$G(@GLOB) N J F J=2:1:5 S @("x"_J)=$P(ST,"*",J-1) S x6=x2-x4 S x7=x3-x5 Q W4MLTNQ W4MLTNQ(MEDAT,ADDAT) ; DOCH HESBONIOT [ 16.11.23 16:31 ] [ 17.09.23 10:46 ] [ 14.09.23 11:13 ] N (JB,%ARG,%REM,MEDAT,ADDAT) S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) D ^W4IN K %L1PC S SHL="" D ^%W1ARG K %L1PC ; D GET(MEDAT,ADDAT) ; S %REPN("PRTN")=$$^%W1JB S %REPN("MEDAT")=MEDAT,%REPN("ADDAT")=ADDAT S %REPN("MEDT")=$$^%L1DC(MEDAT,3),%REPN("ADDT")=$$^%L1DC(ADDAT,3) S %REPN("DAT","NM")=$$TV^%W1DICT($$^%W1LNG,"DATE") S %REPN("PRTN")=$$^%W1JB S %REPN="W4MLTNQ" ; K @$$^%W1GLPRM M @$$^%W1GLPRM@("REPN")=%REPN D PUT^%W1PRM("HRFREP","w4mltnq.jsp?JB="_JB_"&REPN="_%REPN) Q ; ; GET(MEDAT,ADDAT) ; N MLY S MLY=$$^W4GL("W4MLY") N MLSP S MLSP=$$^W4GL("W4MLSP") S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) ; N DT,PAR,DEP,A N VRM S VRM=$$^W4MAIN("VRM") K @VRM ; I '$G(SPK) D .S DT=MEDT-1 F S DT=$O(@MLY@(DT)) Q:DT="" Q:DT>ADDT D ..S PAR="" F S PAR=$O(@MLY@(DT,PAR)) Q:PAR="" D ...S A=$G(^(PAR)) ...I '$$VIB(PAR,"") Q ...D FRM(PAR,A) ; I $G(SPK) D .S DT=MEDT-1 F S DT=$O(@MLSP@(SPK,"D",DT)) Q:DT="" Q:DT>ADDT D ..S PAR="" F S PAR=$O(@MLSP@(SPK,"D",DT,PAR)) Q:PAR="" D ...I '$$VIB(PAR,SPK) Q ...S A=$$GETMLY^W4SETMLY(DT,PAR,"","I",SPK) ...D FRM(PAR,A) Q ; ; PAR ; S PAR1=$$SHEM(PAR) S x1=$$EM1(PAR) S x2=$$MH^W4P(PAR) S MEDT=$$^%L1DC(MEDAT,3) S x3=$$^W4GETMLY(PAR,MEDT-1) N A S A=$G(@GLOB) S DEP=$$DEP(PAR) I DEPADDEP) S OK=0 Q S DEP1=$$MLDEP^W4MLPRT(PAR) ; S SUG=$$KVZ(PAR) S SUG1="" I SUG S SUG1=$G(@$$GLSUGP^W4MLPRT@(SUG)) ; S x4=$P(A,"*")+$P(A,"*",4) S x5=$P(A,"*",3) S x6=$P(A,"*",2) S x7=x3+x4+x5-x6 Q ; ; SHEM(PAR) I $G(PAR)="" Q "" N SHEM,SHEMOU I $$KP^W4PK(PAR) Q $$SHEM^W4P($E(PAR,2,20)) I $G(OU) Q $$SHEM^W4P(PAR) S SHEM=$$MLNAME^W4MLPRT(PAR) Q SHEM ; FRM(PAR,A) ; N J I '$$VL(A) Q F J=1:1:4 D .S $P(@VRM@(PAR),"*",J)=$P($G(@VRM@(PAR)),"*",J)+$P(A,"*",J) Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4MLTNQ-CHKPRM","MEDEP=MEDEP & ADDEP=ADDEP & MEDAT=MEDAT & ADDAT=ADDAT") I '$$DATVLD(MEDAT) Q "0;DATENOTVALID;;MEDATID"_$$DATVLD(MEDAT) I '$$DATVLD(ADDAT) Q "0;DATENOTVALID;;ADDATID"_$$DATVLD(ADDAT) I $$^%L1DC(ADDAT,3)<$$^%L1DC(MEDAT,3) Q "0;RANGENOTVALID;;MEDATIDdd" I MEDEP>ADDEP Q "0;RANGENOTVALID;;MEDEP" I MEKVZ>ADKVZ Q "0;RANGENOTVALID;;MEKVZ" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4MLTNQ" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N PAR S PAR=$P(A,"\",1) W " style=""cursor:pointer;color:black;font-size:"_$$^W3FSZ(11) W """" W " onClick=""ShowItemReport('"_PAR_"','"_$G(%ARG("MEDAT"))_"','"_$G(%ARG("ADDAT"))_"','ifr')""" Q ; TD ; Q ; SPK(PAR,SPK) ; I $D(@$$^W4GL("W4MLSP")@(SPK,"P",PAR)) Q 1 Q 0 ; DEP(PAR) ; Q $$MLDEP^W4MLPRT(PAR) ; KVZ(PAR) ; Q $$MLSUGP^W4MLPRT(PAR) ; EM(PAR) ; N EM S EM=$$MLEMSFR^W4MLPRT(PAR) I EM="" S EM=1 Q EM ; EM1(PAR) ; N EM S EM=$$EM(PAR) N EM1 S EM1=$G(@$$^W4GL("MLMIDA")@(EM)) I EM1="" S EM1="dcigi" Q EM1 ; SUM(A) ; Q $P(A,"*")+$P(A,"*",4)-$P(A,"*",2)-$P(A,"*",3) ; VL(A) ; N OK S OK=0 N J F J=1:1:4 I $P(A,"*",J) S OK=1 Q OK ; VIB(PAR,SPK) ; N KVZ,DEP I $G(MEPAR),PARADPAR Q 0 I '$$PRKUP,$$KP^W4PK(PAR) Q 0 Q 1 ; PRKUP(STAM) ; I $G(%ARG("PRKUP")) Q 1 Q 0 W4MLTNQ0 W4MLTNQ ; DOCH HESBONIOT [ 14.09.23 08:40 ] [ 23.10.14 10:01 ] [ 27.07.14 10:32 ] N (JB,%ARG,%REM) D ^W4IN D ^%W1ARG I '$D(MEDAT)!'$D(ADDAT) Q I '$G(MEDEP) S MEDEP="" I '$G(ADDEP) S ADDEP=999999 I '$G(MEKVZ) S MEKVZ="" I '$G(ADKVZ) S ADKVZ=99999 I '$G(MEPAR) S MEPAR="" I '$G(ADPAR) S ADPAR=99999999 S SPK=$G(%ARG("SPK")) I '$G(SPK) S SPK="",SPK1="miwtqd lk" S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) ; D GET ; S %SCRN=$$SCRN D PCPRM^W4DMANY(%SCRN) Q ; ; GET ; N MLY S MLY=$$^W4GL("W4MLY") N MLSP S MLSP=$$^W4GL("W4MLSP") ; N DT,PAR,DEP,A N VRM S VRM=$$^W4MAIN("VRM") K @VRM ; ;;S DT="" F S DT=$O(@MLY@(DT)) Q:DT="" Q:DT'ADDT D ..S PAR="" F S PAR=$O(@MLY@(DT,PAR)) Q:PAR="" D ...S A=$G(^(PAR)) ...I '$$VIB(PAR,"") Q ...D FRM(PAR,A) ; I $G(SPK) D .S DT=MEDT-1 F S DT=$O(@MLSP@(SPK,"D",DT)) Q:DT="" Q:DT>ADDT D ..S PAR="" F S PAR=$O(@MLSP@(SPK,"D",DT,PAR)) Q:PAR="" D ...I '$$VIB(PAR,SPK) Q ...S A=$$GETMLY^W4SETMLY(DT,PAR,"","I",SPK) ...D FRM(PAR,A) ; N TMPREP S TMPREP=$$^W4MAIN("TMPREP") K @TMPREP K @$$^W4MAIN("TMPREPB") N I,IT,TN,IN,ZC,OU,ST S I=0 ; S PAR="" F S PAR=$O(@VRM@(PAR)) Q:PAR="" D .;;S IT=$G(^(PAR,"IT")) .S IT=$$^W4GETMLY(PAR,MEDT-1) .S TN=$G(@VRM@(PAR,"TN")) .S IN=$P(TN,"*")+$P(TN,"*",4),ZC=$P(TN,"*",3),OU=$P(TN,"*",2) .S ST=PAR_"\"_$$SHEM(PAR)_"\"_$$EM1(PAR)_"\"_IT .S ST=ST_"\"_IN_"\"_ZC_"\"_OU_"\"_(IT+$$SUM(TN)) .S I=I+1,@TMPREP@("G",I)=ST ; Q ; ; SHEM(PAR) I $G(PAR)="" Q "" N SHEM,SHEMOU I $$KP^W4PK(PAR) Q $$SHEM^W4P($E(PAR,2,20)) I $G(OU) Q $$SHEM^W4P(PAR) S SHEM=$$MLNAME^W4MLPRT(PAR) Q SHEM ; FRM(PAR,A) ; N J I '$$VL(A) Q F J=1:1:4 D .S $P(@VRM@(PAR,"TN"),"*",J)=$P($G(@VRM@(PAR,"TN")),"*",J)+$P(A,"*",J) Q ; CHKPRM(STAM) ; D PUT^%W3DEB("W4MLTNQ-CHKPRM","MEDEP=MEDEP & ADDEP=ADDEP & MEDAT=MEDAT & ADDAT=ADDAT") I '$$DATVLD(MEDAT) Q "0;DATENOTVALID;;MEDATID"_$$DATVLD(MEDAT) I '$$DATVLD(ADDAT) Q "0;DATENOTVALID;;ADDATID"_$$DATVLD(ADDAT) I $$^%L1DC(ADDAT,3)<$$^%L1DC(MEDAT,3) Q "0;RANGENOTVALID;;MEDATIDdd" I MEDEP>ADDEP Q "0;RANGENOTVALID;;MEDEP" I MEKVZ>ADKVZ Q "0;RANGENOTVALID;;MEKVZ" Q 1 ; DATVLD(DAT) ; Q $$DATVLD^W4REPSCR(DAT) ; SCRN(STAM) Q "W4MLTNQ" ; TR ; N A S A=$G(@$$^W4MAIN("TMPREP")@("G",BG)) N PAR S PAR=$P(A,"\",1) W " style=""cursor:pointer;color:black;font-size:"_$$^W3FSZ(11) W """" W " onClick=""ShowItemReport('"_PAR_"','"_$G(%ARG("MEDAT"))_"','"_$G(%ARG("ADDAT"))_"','ifr')""" Q ; TD ; Q ; SPK(PAR,SPK) ; I $D(@$$^W4GL("W4MLSP")@(SPK,"P",PAR)) Q 1 Q 0 ; DEP(PAR) ; Q $$MLDEP^W4MLPRT(PAR) ; KVZ(PAR) ; Q $$MLSUGP^W4MLPRT(PAR) ; EM(PAR) ; N EM S EM=$$MLEMSFR^W4MLPRT(PAR) I EM="" S EM=1 Q EM ; EM1(PAR) ; N EM S EM=$$EM(PAR) N EM1 S EM1=$G(@$$^W4GL("MLMIDA")@(EM)) I EM1="" S EM1="dcigi" Q EM1 ; SUM(A) ; Q $P(A,"*")+$P(A,"*",4)-$P(A,"*",2)-$P(A,"*",3) ; VL(A) ; N OK S OK=0 N J F J=1:1:4 I $P(A,"*",J) S OK=1 Q OK ; VIB(PAR,SPK) ; N KVZ,DEP I $G(MEPAR),PARADPAR Q 0 I $G(SPK),'$$SPK(PAR,SPK) Q 0 S DEP=$$DEP(PAR) I DEPADDEP) Q 0 S KVZ=$$KVZ(PAR) I KVZADKVZ) Q 0 I '$$PRKUP,$$KP^W4PK(PAR) Q 0 Q 1 ; PRKUP(STAM) ; I $G(%ARG("PRKUP")) Q 1 Q 0 W4MLY W4MLY(MRKZ,DAT,PLN,PLCOL,PRCC,PLA) ; [ 15.11.08 11:55 ] [ 10.11.08 17:50 ] [ 03.01.06 10:39 ] ;INPUT: DAT (YYMMDD) ; PLN - CODE PARIT ; PLCOL - KAMUT PARIT ; PRCC - MAHIR ; PLA - HANAHA ; MRK - MISPAR MERKAZ ; $D(PLSER) ; $D(KUPLTM) - KNISA MI T.M. (MAARECHET HASPAKA) ;OUTPUT: OK N (JB,%REM,DAT,PLN,PLCOL,PRCC,PLA,MRKZ,PLSER,NODET,OK) S OK=1 Q:@$$^W4GL("PLUK")'["MLY" Q:$D(PLSER) N PLU S PLU=PLN S:$E(PLN,1,2)="A-" PLU=$P(PLN,"-",2) Q:PLU="" ; I '$D(MRKZ) S MRKZ=0 I MRKZ[">" S MRKZ2=$P(MRKZ,">",2),TM=$P(MRKZ,">",3),KF=$P(MRKZ,">",4),MRKZ=$P(MRKZ,">") S ZT=$ZT N MLY,MLYP,SHANA,SUG,TK,STR,TSTR,M3,INDT,REM,I,J I 'MRKZ S MRKZ=@$$^W4GLM("STAT")@("MLY","EM","MRKZ") I $D(@$$^W4GLM("YZM")@(PLU))#2 S A=$G(^(PLU)) I $P(A,"\",2),MRKZ=@$$^W4GLM("STAT")@("MLY","EM","MRKZ") D .S MRKZ=$P(A,"\",2) Q:MRKZ="" S STR=$P($G(@$$^W4GLM("YZRN")@(MRKZ,10)),"*",3),TSTR=$P($G(^(10)),"*",4) Q:STR=""!(TSTR="") ; S SHANA=$E(DAT,1,2),SUG=2 S TK=$E(DAT,3,6)_"-009" I '$D(@$$^W4GLM("MLY")@(SHANA,STR,TSTR,SUG,TK)) D .D TEUDA S @$$^W4GLM("OPENKUP")@(DAT)=$H S FRST=0 ;--- T. HOZAA ; I $G(MRKZ2),$D(@$$^W4GLM("YZM")@(PLU)) D ;-- EZIRAT T.HAHNASA .S STR2=$P($G(@$$^W4GLM("YZRN")@(MRKZ2,10)),"*",3) .S TSTR2=$P($G(^(10)),"*",4) .I STR2=""!(TSTR2="") Q .S TK20=$G(@$$^W4GLM("MLY")@(SHANA,STR2,1))+1 .F TK21=TK20:1 S TK2=TK21_"-000" Q:'$D(@$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2)) .I '$D(@$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2)) D TEUDA2 ; D MLYSUM(PLU,PLCOL,PRCC,PLA) L S OK=1 Q ; ERM ;I $G(PLDEB) ZU 0 W !,$ZE S OK=0 Q ; TEUDA ; PREP TEUDA HOZAA S REM="zetewn zihnehe` d`ved zcerz",M3=99999 S INDT=$$^%L1DC(DAT,1) S @$$^W4GLM("MLY")@(SHANA,STR,TSTR,SUG,TK)=INDT_"*"_M3_"*********"_REM_"*"_$ZD($H,"YYMMDD")_"***"_SUG_"***0**"_INDT_"*"_INDT_"*"_INDT S @$$^W4GLM("MLY")@(SHANA,STR,SUG)=$G(@$$^W4GLM("MLY")@(SHANA,STR,SUG))+1 Q TEUDA2 ; PREPARE TEUDAT HACHNASA N REM,INDT,SPK S SPK=@$$^W4GLM("STAT")@("MLY","EM","MRKZ") S REM="zetewdn zihnehe` dqpkd zcerz" S INDT=$$^%L1DC(DAT,1) S @$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2)=INDT_"*"_SPK_"**"_(-1)_"*"_TM_"******"_REM_"*"_$ZD($H,"YYMMDD")_"***1***0**"_INDT_"*"_INDT_"*"_INDT S @$$^W4GLM("MLY")@(SHANA,STR2,1)=TK2 S @$$^W4GLM("MTM")@(SPK,TM)="^MLY("""_SHANA_""","""_STR2_""","""_TSTR2_""","_1_","""_TK2_""")"_"^"_TK2 S @$$^W4GLM("SPTH")@(SPK,+TK2)="^MLY("""_SHANA_""","_STR2_","_TSTR2_",1,"""_TK2_""")" Q ; MLYSUM(PLU,PLCOL,PRCC,PLA) ; Q:$G(PLU)="" I $D(@$$^W4GLM("PARIT")@(PLU)) D WRITE(PLU,PLCOL,PRCC,PLA) S (PRCC,PLA)=0 I $D(@$$^W4GLM("YZM")@(PLU))>9 D .N N S N="" F S N=$O(@$$^W4GLM("YZM")@(PLU,N)) Q:N="" I PLU'=N D ..Q:'$G(^(N)) N COL S COL=$G(^(N))*PLCOL ..I $P(^(N),"\",2) S COL=$J(COL*100/$P(^(N),"\",2),4,4) ..I $G(@$$^W4GLM("STAT")@("YEZUR"))!$D(NODET),COL D WRITE(N,COL,PRCC,PLA) Q ..I COL D MLYSUM(N,COL,PRCC,PLA) Q ; WRITE(PLU,PLCOL,PRCC,PLA) ; N MLY,MLYP,COL,SUM L @$$^W4GLM("MLYP")@(SHANA,STR,TSTR,PLU):1 S MLYP=$G(@$$^W4GLM("MLYP")@(SHANA,STR,TSTR,PLU)) L @$$^W4GLM("MLY")@(SHANA,STR,TSTR,SUG,TK,PLU):1 S MLY=$G(@$$^W4GLM("MLY")@(SHANA,STR,TSTR,SUG,TK,PLU)) S $P(MLYP,"*",4)=$P(MLYP,"*",4)-PLCOL S $P(MLYP,"*",3)=$P(MLYP,"*",3)+PLCOL S @$$^W4GLM("MLYP")@(SHANA,STR,TSTR,PLU)=MLYP S SUM1=PLCOL*PRCC-PLA S COL=PLCOL+$P(MLY,"*",1) S SUM=$J(SUM1+$P(MLY,"*",5),2,2) S MD=$P($G(@$$^W4GLM("PARIT")@(PLU,1)),"*",3) S:MD="" MD=1 S @$$^W4GLM("MLY")@(SHANA,STR,TSTR,SUG,TK,PLU)=COL_"****"_SUM_"**"_MD_"*"_COL ; I $D(STR2),$D(TSTR2),$D(TK2) D .L @$$^W4GLM("MLYP")@(SHANA,STR2,TSTR2,PLU):1 .S MLYP2=$G(@$$^W4GLM("MLYP")@(SHANA,STR2,TSTR2,PLU)) .L @$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2,PLU):1 .S MLY2=$G(@$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2,PLU)) .S $P(MLYP2,"*",4)=$P(MLYP2,"*",4)+PLCOL .S $P(MLYP2,"*",3)=$P(MLYP2,"*",2)+PLCOL .S @$$^W4GLM("MLYP")@(SHANA,STR2,TSTR2,PLU)=MLYP2 .S SUM1=SUM1*$G(KF,1) .N SUMNM,SUM10 S SUM10=SUM1 .I $P($G(@$$^W4GLM("PARIT")@(PLU,3)),"*",7)'="l" D ..S SUM10=SUM1*100/(100+@$$^W4GLM("STAT")@("MAM")) .S SUMNM=$J(SUM10+$P(MLY2,"*",4),2,2) .S SUMM=$J(SUM1+$P(MLY2,"*",5),2,2) .S COL2=PLCOL+$P(MLY2,"*",1) .N PRC S PRC=0 I COL2 S PRC=$J(SUMNM/COL2,3,3) .S @$$^W4GLM("MLY")@(SHANA,STR2,TSTR2,1,TK2,PLU)=COL2_"*"_PRC_"*"_PRC_"*"_SUMNM_"*"_SUMM_"**"_MD_"*"_COL2 L S OK=1 Q W4MLYHUZ W4MLYHUZ(JB,DT1,DT2) ; [ 06.11.16 15:16 ] [ 11.06.14 19:24 ] [ 17.04.14 07:05 ] N (JB,%ARG,%REM,DT1,DT2) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; S DIR="/tmp/" S ADR=$$MLYADR^W4PRM S MRK=$$MLYMRK^W4PRM ; F DT=DT1:1:DT2 D .I ADR="" S @$$^W4GL("W4MLYHUZ")@(DT)="NOADR\"_$ZD($H,"DD.MM.YY 24:60") Q .I MRK="" S @$$^W4GL("W4MLYHUZ")@(DT)="NOMRK\"_$ZD($H,"DD.MM.YY 24:60") Q .S DAT=$ZD(DT,"YYMMDD") .K @$$^W4GL("PLUMRK")@(DAT,MRK) .M @$$^W4GL("PLUMRK")@(DAT,MRK)=@$$^W4GL("PLUTOT")@(DAT,$$^%L1MRK) .S FL=DIR_"P2M"_DAT_"_"_MRK .I '$$^%L1G2F($$^W4GL("PLUMRK")_"("""_DAT_""","""_MRK_""")",FL) Q .;;O FL:(REWIND:NEWVERSION:WRITE:SYSTEM="rwx":GROUP="rx":WORLD="rx") .;;U FL .;;S PRT="" F S PRT=$O(@$$^W4GL("PLUMRK")@(DAT,MRK,PRT)) Q:PRT="" D ..;;W $R,! ..;;W $G(^(PRT)),! .;;C FL .D ^%L1FTP(ADR,FL) .I '$ZSY D Q ..N ENDFL S ENDFL=FL_".END" ..C ENDFL O ENDFL:(WRITE:REWIND:NEWVERSION) U ENDFL W "1",! C ENDFL ..H 1 D ^%L1FTP(ADR,ENDFL) ..S @$$^W4GL("W4MLYHUZ")@(DT)="OK\"_$ZD($H,"DD.MM.YY 24:60") ..C FL:(DELETE) ..C ENDFL:(DELETE) .S @$$^W4GL("W4MLYHUZ")@(DT)="ER"_$ZSY_"\"_$ZD($H,"DD.MM.YY 24:60") ; Q W4MLYTNP W4MLYTNP(PARIT) ; [ 09.01.13 20:18 ] [ W4MLZCRD W4MLZCRD(STAM) ; [ 09.12.20 08:46 ] [ 19.02.12 11:26 ] [ 23.11.08 14:22 ] N MYDVN S MYDVN=$$^W4MYDVN I MYDVN,$D(@$$^W4PRM@("MLZCARD",MYDVN)) Q @$$^W4PRM@("MLZCARD",MYDVN) I $D(@$$^W4PRM@("MLZCARD"))#2 Q @$$^W4PRM@("MLZCARD") Q "" W4MLZR W4MLZR(HZM) ; [ 07.11.08 15:54 ] [ 11.04.02 11:17 AM ] [ N MLZ S MLZ=$P($G(@$$^W4ORD@(HZM)),"\",18) I $G(@$$^W4PRM@("LAST")),$G(@$$^W4PRM@("MLZ")),$G(@$$^W4GL("P1MLZ")@(HZM)) S MLZ=@$$^W4GL("P1MLZ")@(HZM) Q MLZ W4MM W4MM(STAM) ; [ 09.01.14 17:58 ] [ 08.01.14 18:59 ] [ I $$CALLCENTER^W4PRM=2 Q 1 Q 0 W4MMDIF W4MMDIF(T1,T2) ; [ 13.11.18 16:29 ] [ N (T1,T2) D .I T1["," S T1=+T1*24*3600+$P(T1,",",2) Q .I T2["," S T2=+T2*24*3600+$P(T2,",",2) Q .I T1?6N.N S T1=$E(T1,1,5)*24*3600+$TR($E(T1,6,10)," ",0) Q .I T2?6N.N S T1=$E(T2,1,5)*24*3600+$TR($E(T2,6,10)," ",0) Q .I T1[".",T1[":" S T1=$$T2S(T1) .I T2[".",T2[":" S T2=$$T2S(T2) ; S DIF=T2-T1 Q DIF\60 ; T2S(T) ; S T1=$$SP1^%L1FRM(T) N DT,SHAA S DT=$$^%L1DC($P(T," "),3) S SHAA=$P(T," ",2) S T=DT_(SHAA*3600+($P(SHAA,":",2)*60)) Q R W4MMDLV W4MMDLV ; [ 16.01.22 11:13 ] [ 14.01.22 08:25 ] [ 01.08.21 14:34 ] ;------------------------------------------------------- N (JB,CODE,OPT,HOME,PHONE,%ARG,LKH,LKHR,SUGT,%REM) I '$G(JB) Q ; N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" ; I $D(@$$^W4GL("W4LINKDR"))<10 D CRLINKDR ; D CLRCOPY^W4MENU ; I $G(%ARG("TODAY")) D .S %ARG("MEDAT")=$ZD($$^W4DZ,"DD.MM.YY") .S %ARG("ADDAT")=$ZD($H,"DD.MM.YY") ; I $$TOMORROW D .S %ARG("MEDAT")=$ZD($H+1,"DD.MM.YY") .N DT0 S DT0=$H+1 .I $$^%L1DC(%ARG("MEDAT"),8)=6,$$SF^W4PRM S DT0=$H+2 .N DT F DT=DT0:1:$H+100 Q:$$^W3VLDDT(DT)=1 .S %ARG("ADDAT")=$ZD(DT,"DD.MM.YY") ; D INIT ; W "
    ",! ; I $$CUSTLASTORDS D G TOTLAB .D INITVIB .N N,I,LK S LK=$$CUSTLASTORDS .S TXTMRQ="" .S FIRSTLINE=1 .W "
    " . N STYLE S STYLE="font-size:"_$$^W3FSZ(16) . I $$CUSTALL D . .D ^W4BUTTON("lastords","SHOWLASTORDS","CustLastOrders1('"_LK_"','0')",STYLE) . I '$$CUSTALL D . .D ^W4BUTTON("allords","SHOWALLORDS","CustLastOrders1('"_LK_"','1')",STYLE) .W "

    " .D TBORD .D PUT^%W1PRM("CUSTLASTORDS",LK) .S N="",I=0 F S N=$O(@$$^W4GL("W4LINKI")@(LK,MSD,N),-1) Q:N="" I N D ..S I=I+1 I '$$CUSTALL,I>9 Q ..S W4DLVORD=N ..D SHOWORD(MSD,N,0) ; I $$MIKUM D .S %ARG("TIMESORT")=1 .S %ARG("SHORTSHOW")=1 .S %ARG("NOSENDEDORDS")=0 .S %ARG("SENDEDORDS")=1 .S %ARG("DELETEDORDS")=0 .S %ARG("NOPAIDORDS")=1 .S %ARG("PAIDORDS")=1 .S %ARG("SHOWTAW")=0 .S %ARG("ASCENDING")=0 .S %ARG("FUTUREORDS")=0 .S %ARG("SIK")=0 ; I $$DISPATH D .D ..I $$ALLORDS D Q ...S %ARG("NOSENDEDORDS")=1 ...S %ARG("SENDEDORDS")=1 ...S %ARG("NOTSUPPLORDS")=0 .. ..I $$NOSENDEDORDS D Q ...S %ARG("NOSENDEDORDS")=1 ...S %ARG("SENDEDORDS")=0 .. ..I '$$ALLORDS D ...S %ARG("NOSENDEDORDS")=1 ...S %ARG("SENDEDORDS")=1 ...S %ARG("NOTSUPPLORDS")=1 . .I $G(%ARG("TIMESORT"))'=0 S %ARG("TIMESORT")=1 .I $G(%ARG("ASCENDING"))'=0 S %ARG("ASCENDING")=1 .I $G(%ARG("SHORTSHOW"))'=0 S %ARG("SHORTSHOW")=1 .I $G(%ARG("DELETEDORDS"))="" S %ARG("DELETEDORDS")=1 .I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 .I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 .I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")=1 ; I '$$DISPATH D SETARG ; I $$VIEWRCV G DIR ; I $$SHOW4COPY D ; -- SHOW FOR COPY .W "

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

    ",! ; DIR ; S DRC=$S($G(%ARG("ASCENDING")):1,1:-1) ; S TXTMRQ="" S FIRSTLINE=1 ; K @$$^W4MAIN("VIB") K @$$^W4MAIN("TMP") ; D CRVIB(1) ; -- PROYTI VES CYCL NE POKAZYVAYA ; I $$MY D .W "" .W " " . W " " .W " ",! .W "
    " . W $$SHOW^W4KOTMLZ($$MY,"12B") . W "
    ",! .W "
    ",! ; I $$REPTRH D KOTREPTRH ; I '$$VIEWRCV,'$$REPTRH D KOT ; I '$$REPTRH,'$$MIKUM D DIVPSL ; K @$$^W4MAIN("TMPIRTM") ; D TBORD ; I $E($G(%ARG("ORDER")))="W"!($E($G(%ARG("ORDER")))="w") D .N ORD S ORD=+$E(%ARG("ORDER"),2,20) .I $G(@$$^W4GL("HZLINKI")@(ORD)) S %ARG("ORDER")=$P(^(ORD),"\") Q .S HZMLAK=$E($G(%ARG("ORDER")),2,12) .K %ARG("ORDER") ; I $G(%ARG("ORDER")) D G TOTLAB ; -- SHOW ONE ORDER .N MSDHZ S MSDHZ=$P($G(@$$^W4GL("W4LINK")@(%ARG("ORDER"))),"~") Q:'MSDHZ .I $G(MSD),MSDHZ'=MSD Q .I $G(%ARG("MSDR")),'$D(^[$$^W3MAIN]W3MSDR(%ARG("MSDR"),MSDHZ)) Q .N JB S W4DLVORD=%ARG("ORDER"),JB=W4DLVORD .D SHOWORD(MSDHZ,%ARG("ORDER"),0) ; I '$G(%ARG("SIK")) D CRVIB(0) ; -- PROYTI VES CYCL & POKAZAT ; TOTLAB ; I '$$DISPATH!$$ALLORDS,'$$VIEWRCV D TOT W "",! ; W "
    ",! ; I '$$VIEWRCV,'$$REPTRH D BUTTONS ; W "
    ",! ; W "


    ",! ; END Q ; ; GLLINK(STAM) ; N GLLINK S GLLINK=$$^W4GL("W4LINKD") I $L($G(%ARG("GLLINK"))) S GLLINK=$$^W4GL(%ARG("GLLINK")) Q GLLINK ; ; TBORD ; W "",! D KOTTB Q ; INITVIB ; K SPAY,SHZ,SDMS,SNEW,SMKR,SHNH S (SPAY,SHZ,SDMS,SHNH,SNEW,SNEWDM,SNEWHN,SNEWPAY,SDEL,SSBM,SNOSHUD,SNOSBM,SNOSHUL,SNODLV)=0 S (SPAYM,SHZM,SDMSM)=0 K SMSD,SCODTS Q ; ; CRVIB(NOPC) ; D INITVIB I '$G(NOPC) G CRVIB1 ; N SHAAGV S SHAAGV=$$SHAAGV ; N DT I $G(MEDT),$G(ADDT) F DT=MEDT:1:ADDT+1 D .N DTTO,SHAA,SL,N .S N="" F S N=$O(@$$GLLINK@(DT,N)) Q:N="" D ..I '$$MSL^W4MSL(N) Q ..S DTTO=$$^%L1DC($$TRH^W4HZMST(N),3) ..S SHAA=$$SHAA^W4HZMST(N) .. ..I $G(%ARG("GLLINK"))="W4LINKDR" D ...S DTTO=$$^%L1DC($P($$DATCB^W4HZMST(N)," "),3) ...S SHAA=$P($$DATCB^W4HZMST(N)," ",2) .. ..I DTTO>ADDT,$$SHAA^W4HZMST(N)'<$$SHAAGV Q ..I 'DTTO S DTTO=$$^%L1DC($P($$DATCB^W4HZMST(N)," "),3) ..I $$DISPATH,DTTO($H+$S($$ALLORDS:180,1:1))) Q ..I $$DISPATH,'$$ALLORDS,DTTOADSUM Q D D(14) ; ;;N HZMLAKHZ S HZMLAKHZ=$$HZMLAK^W4HZMST(N) S:$E(HZMLAKHZ)="W" HZMLAKHZ=$E(HZMLAKHZ,2,10) ;;I $G(HZMLAK)'="",HZMLAK'=HZMLAKHZ,HZMLAK'=+$$HRAED^W4HZMST(N),HZMLAK'=$$INVH^%L1FRM(HZMLAKHZ) Q ;;D D(15) ; I $TR(CUSTOM,"-","")?1N.N,CUSTOM'=$$NMB^W4HZMST(N) Q I $L(CUSTOM),$TR(CUSTOM,"-","")'?1N.N,'$$SRCH^W1SRCH($$NAME^W4HZMST(N),CUSTOM),'$$SRCH^W1SRCH($$MAZMIN^W4HZMST(N),CUSTOM) Q ; I $G(NCA),'$$CMPR(N,NCA) Q D D(16) ; I $G(%ARG("SUGTS")),%ARG("SUGTS")'=$$CODTS^W4HZMST(N) D D(16.5) Q ; I $$DISPATH,$$TAW,'$$TAKEAWAY^W4HZMST(N) Q D D(16.7) I '$$TAW,'$G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N) Q D D(16.9) ; I $$KNDO="NSND",$$SENDEDORD(N) Q D D(17.1) I $$KNDO="SND",'$$SENDEDORD(N) Q D D(17.2) I $$KNDO="NSPL",$$SUPPLIED^W4HZMST(N) Q D D(17.25) I $$KNDO="FTR",'$$FUTURE(N) Q D D(17.3) I $$KNDO="DEL",'$$DELORD(N) Q D D(17.4) I $$KNDO="TAW",'$$TAKEAWAY^W4HZMST(N) Q D D(17.5) I $$KNDO="PD",$$NOSHUL(N) Q D D(17.6) I $$KNDO="NPD",'$$NOSHUL(N) Q D D(17.7) ; I $G(%ARG("LATEDORDS")),'$$LATED(N) D D(19.1) Q I $G(%ARG("READYORDS")),'$$READY^W4HZMST(N) D D(19.2) Q I $G(%ARG("TAKEDORDS")),'$$TAKED^W4HZMST(N) D D(19.3) Q I $G(%ARG("SUPPLIEDORDS")),'$$SUPPLIED^W4HZMST(N) D D(19.4) Q I $$NOTSUPPLORDS,$$SUPPLIED^W4HZMST(N) D D(19.45) Q ; I '$G(%ARG("DELETEDORDS")),$$DELORD(N),'$G(%ARG("NCA")) D D(19.5) Q ; I $G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N) D D(19.51) G VIBSHOW ; ;;I $G(%ARG("SHOWTAW")),$$TAKEAWAY^W4HZMST(N),'$$DELORD(N),'$$DISPATH G VIBSHOW ; I $G(%ARG("DELETEDORDS")),$$DELORD(N) D D(19.52) G VIBSHOW ; ; I '$G(%ARG("SENDEDORDS")),'$$ALLORDS,$$SENDEDORD(N),'$$DELORD(N) D D(19.55) Q I '$$NOSENDEDORDS,'$$SENDEDORD(N),'$$DELORD(N) D D(19.57) Q ; D D(19.6) ; I '$G(%ARG("NOPAIDORDS")),$$NOSHUL(N),'$$DELORD(N) Q D D(19.62) I '$G(%ARG("PAIDORDS")),'$$NOSHUL(N),'$$DELORD(N) Q ; D D(21) ; N DATHZ S DATHZ=$$DTHZ(N) ;;W "N="_N_" MEDT="_MEDT_" ADDT="_ADDT_" DATHZ="_DATHZ_" CODEHZ="_CODEHZ_"
    ",! I $G(MEDT),DATHZADDT Q D D(24) ; I '$G(%ARG("FUTUREORDS")),$$FUTURE(N),'$$DELORD(N) Q ; D D(26) VIBSHOW ; N DATHZ S DATHZ=$$DTHZ(N) I $G(MEDT),DATHZADDT Q N PSL D D(27) I $$MIKUM S PSL=+$P(FULLIND,"^",2) I $D(MPSL(PSL)) D D(28) Q VIBSHOW1 ; D SHOWORD(MSDHZ,N,NOPC) ; N SHAA,MN S SHAA=$$SHAA^W4HZMST(N) S MN=10000+$TR($J(SHAA*60+$P(SHAA,":",2),4)," ",0) S @$$^W4MAIN("VIB")@(FULLIND)="" I $G(PSL) S MPSL(PSL)="" ; Q ; ; SENDEDORD(HZ) ; I $$PSL^W4HZMST(HZ) Q 1 Q 0 ; DELORD(HZ) ; I $$DEL^W4DEL(HZ) Q 1 I $$TSHL^W4HZMST(HZ)<0 Q 1 I $D(@$$^W4ORD@(HZ))'=11 Q 3 Q 0 ; FUTURE(N) ; N DATHZ S DATHZ=$$DTHZ(N) I DATHZ>$H Q 1 Q 0 ; SHAAGV(STAM) Q $$SHAAZ^W4PRM ; FAXORD(HZ) ; I $D(@$$^W3ORD(HZ)@(HZ,"F")) Q 1 Q 0 ; MOUSEOVER ; N PRMHZ S PRMHZ=N_"~"_$G(MEDT)_"~"_$G(ADDT)_"~"_$G(LKH) W " onMouseOver=""ChangeCursor(this)"" onClick=""ShowOrd('"_N_"','"_PRMHZ_"',1)""",! Q ; LATED(N) ; N IND,ENDTIME,CURTIME S IND=0 S ENDTIME=$$TIME("SUPPLIED",N) S CURTIME=$$CURTIME("SUPPLIED",N) S IND=$$INDLATE(ENDTIME,CURTIME) I IND'<1 Q 4 I $$SUPPLIED^W4HZMST(N) Q 0 ; S ENDTIME=$$TIME("TAKED",N) S CURTIME=$$CURTIME("TAKED",N) S IND=$$INDLATE(ENDTIME,CURTIME) I IND'<1 Q 3 I $$TAKED^W4HZMST(N) Q 0 ; S ENDTIME=$$TIME("READY",N) S CURTIME=$$CURTIME("READY",N) S IND=$$INDLATE(ENDTIME,CURTIME) I IND'<1 Q 2 I $$READY^W4HZMST(N) Q 0 ; S ENDTIME=$$TIME("FAXTIME",N) S CURTIME=$$CURTIME("FAXTIME",N) S IND=$$INDLATE(ENDTIME,CURTIME) I IND'<1 Q 1 Q 0 ; ; DTIME(TIME) ; Q $$DTIME^W4MMTIME(TIME) ; SHOWORD(MSD,N,NOPC) ; D D(30) D GL I $D(@GL@(N))<11 Q S N=$TR(N," ","") N DAT,SHAA,IR S DAT=$$TRH^W4HZMST(N) S SHAA=$$SHAA^W4HZMST(N) S IR=$$IR^W4HZMST(N) N CMHD S CMHD=$$HRA2^W4HZMST(N) ; ; --------- ORDER NUMBER --------- ; D COMPTOT(N) ; I $G(NOPC) Q ; W "    " W "" ; W "" ; I '$$NOFUTDAT^W4PRM D .W "" ; W "" ; W "" ; W "" ; W "" ; W "" ; W "" ; W "" ; W "" ; N PSL S PSL=$$PSL^W4HZMST(N) ; W "" ; W "" ; W "" ; W "" ; W "" ; W "",! Q ; ; CHKSND(N) ; W "" W "" Q ; IMG(PROC) ; Q $$IMG^W4MMTIME(PROC) ; FAXBGCOLOR(ORD) ; N IND S IND=+$$FAXLATE^W4FAXHTM(ORD) I IND>0 Q "background-color:"_$S(IND=1:"lightgreen",IND=2:"yellow",1:"red") Q "" ; NEW(HZ,MSD) ; I $G(HZ)="" Q 0 N LKH S LKH=$$NMB^W4HZMST(HZ) I $G(LKH)="" Q 0 I $G(MSD)="" Q 0 I $O(@$$^W4GL("W4LINKI")@(LKH,MSD,HZ),-1)="" Q 1 Q 0 ; MSGTM(DAT,SHAA,IR,ORD) ; N PER S PER=$$PERIOD(DAT,SHAA,IR,ORD) I PER=0,'$$SENDEDORD(ORD) W ""_$$^%W1DICT("NOW!")_"" I PER=1 W $$^%W1DICT("TODAY") I PER=-1 Q I PER>1 W $$^%W1DICT("FUTURE") Q ; PERIOD(DAT,SHAA,IR,ORD) N TVAH S TVAH=$$THZ^W3TIME(IR) I 'TVAH S TVAH=60 I $$^%L1DC(DAT,3)=+$H,$$MIN(SHAA)-($P($H,",",2)\60)TVAH Q 1 I $$^%L1DC(DAT,3)<+$H Q -1 I $$^%L1DC(DAT,3)>+$H Q 2 I $G(ORD),$$DAHUY^W4HZPCHD(ORD) Q 1.5 Q "" ; MIN(SHAA) ; Q $P(SHAA,":")*60+$P(SHAA,":",2) ; ; SELNAME(GR) ; K ^[$$^W3MAIN]TMP(JB) ; D SEDER(GR) N NXT S NXT=$O(^[$$^W3MAIN]TMP(JB,"")) I NXT="" Q N PR1 S PR1=0 S NXT=$O(^[$$^W3MAIN]TMP(JB,NXT)) I NXT="" S PR1=1 ; W "",! K ^[$$^W3MAIN]TMP(JB) Q ; SELNAME1(INVMSD,MSD) ; Q:$G(INVMSD)="" N VL S VL=$$H2U^%L1FRM($$INV^%L1FRM(INVMSD)) W "",! Q ; SEDER(GR) ; K ^[$$^W3MAIN]TMP(JB) N N,NS D .S N="" F NS=1:1 S N=$O(^[$$^W3MAIN]W3MSDR(GR,N)) Q:N="" D ..I $G(^(N)) D CRTMP(N) Q ; DTHZ(ORD) ; N DTHZ S DTHZ=$$^%L1DC($$TRH^W4HZMST(ORD),3) N SHAA S SHAA=$$SHAA^W4HZMST(ORD) I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 ; I $G(%ARG("GLLINK"))="W4LINKDR" D .S DTHZ=$$^%L1DC($P($$DATCB^W4HZMST(ORD)," "),3) .I '$$NIGHT^W4PRM,SHAA<$$SHAAGV S DTHZ=DTHZ-1 .S SHAA=$P($$DATCB^W4HZMST(ORD)," ",2) ; I DTHZ Q DTHZ Q $$^W4DZ ; ; CRTMP(MSD) ; N INV,NM S NM=$G(^[$$^W3MAIN]W3MSD(MSD)) S INV=$$INV^%L1FRM(NM) Q:INV="" S ^[$$^W3MAIN]TMP(JB,INV)=MSD Q ; ; STAT(KOT,VL,PR) I 'VL W "" Q ; W "" Q ; D(C) ; S ^D(N)=C ;;W "N="_N_" C="_C_" "_$H_" ",! Q ; INIT ; K ^D D KILL^%W3DEB("W4DLVORD") D KILL^%W1PRM("PSL") S MSD=$$GETP^%W1PRM("MSD") D ^%W1ARG I $$MSDR^W4PRM,'$G(%ARG("MSDR")) S %ARG("MSDR")=$$MSDR^W4PRM I $G(%ARG("MSDR")) K MSD S MKBL=$G(MKBL) I $$MY S MKBL=$G(%ARG("MY")) I $$DISPATH D PUT^%W1PRM("DISPATH",$$DISPATH) D ^W4IN ; --> P1DZ ; I $G(%ARG("MEDAT")) S MEDT=$$^%L1DC(%ARG("MEDAT"),3) I $G(%ARG("ADDAT")) S ADDT=$$^%L1DC(%ARG("ADDAT"),3) ; I '$G(MEDT) S MEDT=P1DZ I $$DISPATH S MEDT=P1DZ-60 I '$G(ADDT) S ADDT=P1DZ+180 ; D PUT^%W3DEB("W4DLVORD","MEDT=MEDT & ADDT=ADDT & MSD=MSD & CODE=CODE & LKHR=LKHR & ARG=[%ARG") ; S W4DLVORD("JB")=JB ; S GL=$$^W4ORD ; I $G(%REM) D PUT^%W1PRM("REM",%REM) S PRMDB=0 N N S N="" F S N=$O(@$$^W4GL("PAR")@(N)) Q:N="" I $$PRINTIG^W3PRMDP(N)[">" S PRMDB=1 Q ; I $G(%ARG("KNDO"))="DEL" S %ARG("DELETEDORDS")=1 Q ; KOT ; W "
    " W N W "" W $$DATCB(N) W "" . W $$TRH^W4HZMST(N) .W "" W $$SHAA^W4HZMST(N) W "" W $$NMB^W4HZMST(N) W "" W "  "_$$H2U^%L1FRM($$NAME^W4HZMST(N)) W "" W $$STATFAX(N) W "" ; -- FAXKIND D .I $L($$VIDU^W4HZMST(N)) D Q ..W $$CHN^W4MMTIME("VIDU",N,$$2460(N,"VIDU")) .I $$DISPATH W ""_$$CHKBOX^W4MMTIME("VIDU",N,"tdvidu"_N)_"" Q .W " " W "" ; -- makor D .N HZMLAK S HZMLAK=$$HZMLAKNOM^W4HZMST(N) .N IMG S IMG="w4intr.png" .I $P(HZMLAK,"/",3) S IMG="w4tel.png" .W "" W "" D .N MSDHZ S MSDHZ=$$MSDHZM^W4HZMST(N) I 'MSDHZ W " " Q .W $$IMG("ShowRestTel('"_MSDHZ_"')") .W " "_$$H2U^%L1FRM($$MSDN^W3R(MSDHZ)) W "" ; W $$IMG("ShowAddressDetails('"_N_"')") W " "_$$H2U^%L1FRM($$KTV^W4HZMST(N)_" "_$$BAIT^W4HZMST(N)_","_$$IR^W4HZMST(N)) W "" D .I 'PSL,$$DISPATH D PSLCH(N) Q .I 'PSL W " " Q .W $$IMG("ShowCourierTel('"_PSL_"')")_" " .W $$NMH2U^W4SL(PSL) W "" D .I $L($$READY^W4HZMST(N)) D Q ..W $$CHN^W4MMTIME("READY",N,$$2460(N,"READY")) W "" D .I '$$PSL^W4HZMST(N) W " " Q .I $L($$TAKED^W4HZMST(N)) D Q ..W $$CHN^W4MMTIME("TAKED",N,$$2460(N,"TAKED")) .I $$DISPATH W $$CHKBOX^W4MMTIME("TAKED",N,"tdtaked"_N) W "" D .I '$$PSL^W4HZMST(N) W " " Q .I $L($$SUPPLIED^W4HZMST(N)) D Q ..W $$CHN^W4MMTIME("SUPPLIED",N,$$2460(N,"SUPPLIED")) .I $$DISPATH W $$CHKBOX^W4MMTIME("SUPPLIED",N,"tdsuppl"_N) W "" W $$IMG("ShowPaym('"_N_"')")_" " W $J($$TSHL^W4HZMST(N),2,2) W "
     " W $$^%W1DICT(KOT)_" : " W " " W VL_"" W "
    ",! W "" W "",! D STAT("ORDERQN",SHZ,1) D STAT("NEWCLIENTS",SNEW,1) D STAT("WAITING",SNOSBM,1) D STAT("NOSENDED",SNOSHUD,1) D STAT("NOPAID",SNOSHUL,1) D STAT("NODLV",SNODLV,1) D STAT("TOPAY",$J($G(SPAY),2,2),1) W "",! W "
    "_$$^%W1DICT("TOTAL")_"
    ",! Q ; KOTTB ; W "",! W ""_$$^%W1DICT("ORDER")_"" W ""_$$^%W1DICT("RECEIVED")_"" I '$$NOFUTDAT^W4PRM D .W ""_$$^%W1DICT("TODATE")_"" W ""_$$^%W1DICT("TOTIME")_"" W ""_$$^%W1DICT("CUSTCODE")_"" W ""_$$^%W1DICT("CUSTOMNAME")_"" W ""_$$^%W1DICT("FAX")_"" W ""_$$^%W1DICT("VIDU")_"" W ""_$$^%W1DICT("MAKOR")_"" W ""_$$^%W1DICT("RESTAURANT")_"" W ""_$$^%W1DICT("ADDRESS")_"" W ""_$$^%W1DICT("COURIER")_"" W ""_$$^%W1DICT("READY")_"" W ""_$$^%W1DICT("TAKED")_"" W ""_$$^%W1DICT("SUPPLIED")_"" W ""_$$^%W1DICT("SUM")_"" W "",! Q ; TOT ; W "" W " " W $$^%W1DICT("TOTAL") W "",! ; W "",! W "" W "",! W "",! W "",! W "" W "
    ",! W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SHZ) W "" W ""_$$^%W1DICT("DISCOUNTS")_" : "_$J(SHNH,2,2)_""_$$NBSP^%L1FRM(5) W ""_$$^%W1DICT("DLVPAY")_" : "_$J(SDMS,2,2)_"" W "
    " W "",! ; W "",! W " "_$J($G(SPAY),2,2)_" " W "",! ; W "",! ; I $G(SNEW),'$$REPTRH D .W " " .W $$^%W1DICT("NEWCLIENTS") .W "",! .W "",! .W " " . W "",! . W "" . W "",! . W "",! . W "" . W "
    ",! . W "  "_$$^%W1DICT("ORDERQN")_" : "_SNEW . W "" . W $$^%W1DICT("DISCOUNTS")_" : "_$J(SNEWHN,2,2) . W "" . W $$^%W1DICT("DLVPAY")_" : "_$J(SNEWDM,2,2) . W "
    ",! .W "",! .W "",! .W " "_$J(SNEWPAY,2,2)_" " .W "",! .W "",! ; I $O(SMSD($O(SMSD(""))))'="" N RST S RST="" F S RST=$O(SMSD(RST)) Q:RST="" D .W " " . W $$NAME^W3MSD(RST) .W "",! .W "",! .W " " . W " ",! . W "" . W "",! . W "" . W "
    ",! . W "  "_$$^%W1DICT("ORDERQN")_" : "_$G(SMSD(RST,"Q")) . W "" . W $$^%W1DICT("DLVPAY")_" : "_$J($G(SMSD(RST,"D")),2,2) . W "
    " .W "",! .W "",! .W " "_$J($G(SMSD(RST,"S")),2,2)_" " .W "",! .W "",! ; I '$$REPTRH N SUGT S SUGT="" F S SUGT=$O(SCODTS(SUGT)) Q:SUGT="" D .W "" .W "  " . N W3SHOWTS S W3SHOWTS("CA")="" . W $$^W3SHOWTS(SUGT) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SCODTS(SUGT,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SCODTS(SUGT,"S")),2,2)_" " .W " ",! .W "",! ; N MKR I '$$REPTRH S MKR="" F S MKR=$O(SMKR(MKR)) Q:MKR="" D .W "" .W "  " .W $$^W3MKR(MKR) .W " ",! .W " ",! .W " " .W " ",! .W " ",! .W " ",! .W " ",! .W "
    ",! .W "   "_$$^%W1DICT("ORDERQN")_" : "_$G(SMKR(MKR,"Q")) .W " " .W "
    ",! .W " ",! .W " ",! .W "  "_$J($G(SMKR(MKR,"S")),2,2)_" " .W " ",! .W "",! EN ; Q ; COLSPAN(STAM) Q " colspan="""_$S($$NOFUTDAT^W4PRM:12,1:13)_""" " ; BUTTONS ; W "",! I '$$DISPATH D .W " ",! ; D BACK W "
    " D BUTTON("rbtprint",$$^%W1DICT("PRINTORDERLIST"),"Print('4','"_$G(MEDT)_"','"_$G(ADDT)_"','"_$G(CODE)_"')","font-size:"_$$^W3FSZ(16)) W "
    ",! Q ; BACK ; W " " D BUTTON("rbtback",$$^%W1DICT("BACK"),"Back()","color:red;font-size:"_$$^W3FSZ(16)) W "",! Q ; GL S GL=$$^W4ORD Q ; DISPATH(STAM) ; Q $G(%ARG("DISPATH")) ; TAW(STAM) ; Q $G(%ARG("TAW")) ; ; COMPTOT(N) ; N TS S TS=$$TSHL^W4HZMST(N) N DMS S DMS=$$DMSH^W4HZMST(N) N HNH S HNH=$$HNH^W4HZMST(N) ; S SPAY=$G(SPAY)+TS S SDMS=SDMS+DMS S SHNH=SHNH+HNH S SHZ=SHZ+1 ; I $$DELORD(N) S SDEL=SDEL+1 I $$SENDEDORD(N) S SSBM=SSBM+1 ; I '$$SENDEDORD(N),'$$DELORD(N) D .S SNOSBM=SNOSBM+1 ; I $$NOSHUL(N) S SNOSHUL=SNOSHUL+1 ; I '$$SEND2CUST(N) S SNODLV=SNODLV+1 ; D .N CODTS,SUM,ITRA,MZM,CHK,CA,ASR .S CODTS=$$CODTS^W4HZMST(N) .S SUM=TS .I CODTS<2 S CODTS=1 .S ITRA=$$ITRA^W4HZMST(N) .S MZM=$$MZM^W4HZMST(N) .S CHK=$$CHK^W4HZMST(N) .S CA=$$CA^W4HZMST(N) .S ASR=$$ASR^W4HZMST(N) .S SCODTS(1,"S")=$G(SCODTS(1,"S"))+ITRA .I MZM S SCODTS(1,"S")=$G(SCODTS(1,"S"))+MZM .I CHK S SCODTS(2,"S")=$G(SCODTS(2,"S"))+CHK .I CA S SCODTS(3,"S")=$G(SCODTS(3,"S"))+CA .I ASR S SCODTS(4,"S")=$G(SCODTS(4,"S"))+ASR .S SCODTS(CODTS,"Q")=$G(SCODTS(CODTS,"Q"))+1 ; D .N RST S RST=$P($G(@$$GLLINK@(N)),"~") Q:'RST .S SMSD(RST,"Q")=$G(SMSD(RST,"Q"))+1 .S SMSD(RST,"S")=$G(SMSD(RST,"S"))+TS .S SMSD(RST,"D")=$G(SMSD(RST,"D"))+DMS .S SMSD(RST,"HN")=$G(SMSD(RST,"HN"))+$G(HNH) ; I $G(MSD),$$NEW(N,MSD) D .S SNEW=SNEW+1 .S SNEWPAY=SNEWPAY+TS .S SNEWDM=SNEWDM+$$DMSH^W4HZMST(N) .S SNEWHN=SNEWHN+$$HNH^W4HZMST(N) ; N MKR S MKR=$$MKRDLV^W4HZMST(N) I MKR="" S MKR=99 S SMKR(MKR,"Q")=$G(SMKR(MKR,"Q"))+1 S SMKR(MKR,"S")=$G(SMKR(MKR,"S"))+TS Q ; SEND2CUST(ORD) ; I $$PSL^W4HZMST(ORD) Q 1 Q 0 ; NOSHUL(ORD) ; I $$TSHL^W4HZMST(ORD)>($$SHUL^W4HZMST(ORD)+$$SHULA^W4HZMST(ORD)) Q 1 Q 0 ; SHOW4COPY(STAM) ; Q +$G(%ARG("SHOW4COPY")) ; DIVPSL ; W "
    ",! W " ",! ; W " ",! I $G(%ARG("MKBL")) D PSLRCV ; I $$DISPATH D .D PSLCHOICE ; W " ",! ; W "" D PSLRADIO ; I $$DISPATH D Q .D PSLSHOW W "",! .W "" . W "" . W "" . I $$ALLORDS D . .W "" . .W "" . .W "" . .W "" . .W "" .W "" ; I $$1024^W4WDSCR D . D TDSP . D PSLSHOW . N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN . D BACK .W "",! . .W "" . D ORDSOURCE . D PAYMKIND ; I '$$1024^W4WDSCR D .D TDSP ; W "" ; ;;D .W "" ; W "" ; I '$$DISPATH,'$$1024^W4WDSCR D .D PSLSHOW .I $$DISPATH W "",! .N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN .D BACK W "",! ; I '$$DISPATH D .W "" . D PSLCHK .W "",! ; ; W "
    "_$$CHKBOX("LATEDORDS","lated")_""_$$CHKBOX("READYORDS","ready")_""_$$CHKBOX("TAKEDORDS","taked")_""_$$CHKBOX("SUPPLIEDORDS","supplied")_" "_$$CHKBOX("FUTUREORDS","futureords")_""_$$CHKBOX("DELETEDORDS","deletedords")_"
    "_$$^%W1DICT("ORDER")_$$REVAH W "" W ""_$$^%W1DICT("AUTHNO")_$$REVAH . W "",! .W ""_$$^%W1DICT("CUSTOMNUMBERORNAME")_$$REVAH D .N CUST S CUST=$$INVH^%L1FRM($G(%ARG("CUSTOM"))) .W "",! W " 
    ",! Q ; ; HB(PRM) I $G(PRM)="" Q "" S PRM=$$INVH^%L1FRM(PRM) Q $$H2U^%L1FRM(PRM) ; PSLRCV ; W "" W " "_$$^%W1DICT("RECEIVER")_" : "_$$H2U^%L1FRM($$^W4NAME(%ARG("MKBL")))_"" W "",! W " " Q ; ; PSLCHOICE ; D PSLSBM ; D TDSP ; W "" D BUTTON("rbtpsl",$$^%W1DICT("COURMG"),"CourMg()","color:blue;font-size:"_$$^W3FSZ(16)) W "" ; W "" D BUTTON("findord",$$^%W1DICT("FINDORDERS"),"FindOrds()","background-color:lightblue;color:black;font-size:"_$$^W3FSZ(16)) W "" ; D TDSP ; ;W "" ; W $$^%W1DICT("ORDER")_$$NBSP^%L1FRM(2) ; W "",! ; D BUTTON("showord",$$^%W1DICT("SHOW"),"ShowOrd()","color:green;font-size:"_$$^W3FSZ(16)) ;W "" D TDSP ; D TDSP ; W "" D BUTTON("misc",$$^%W1DICT("MISC"),"Misc()","background-color:orange;color:black;font-size:"_$$^W3FSZ(16)) W "",! ; W " " N BACKALIGN S BACKALIGN=$$INV^%W1ALIGN D BACK Q ; ; PSLCH(ORD) ; W " ",! D .W "",! . .N N S N="" F S N=$O(^[$$^W3MAIN]W3MKR(N)) Q:N="" D ..N A S A=$G(^(N)) ..W "",! W "",! W "" Q ; PAYMKIND ; W "" W $$^%W1DICT("PAYMENTKIND")_$$REVAH W "",! W "" Q ; SHOWSNDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOSENDEDORDS")_" " W "" ; D SPACE W $$^%W1DICT("SHOWSENDEDORDS")_" " W "" W "" Q ; SHOWPAIDORNOORDERS ; W "" W $$^%W1DICT("SHOWNOPAIDORDS")_" " W "" ; I '$$1024^W4WDSCR D SPACE I $$1024^W4WDSCR W "" ; W $$^%W1DICT("SHOWPAIDORDS")_" " W "" W "" Q ; SHOWDELORDERS ; W "" W $$^%W1DICT("SHOWDELETEDORDS")_" " W "" W "" Q ; SHOWFUTORDERS ; W "" W $$^%W1DICT("SHOWFUTUREORDS")_" " W "" W "" Q ; SHOWTAW ; W "" W $$^%W1DICT("SHOWTAW")_" " W "" W "" Q ; ; PSLRADIO ; I '$$DISPATH D .W "" . D KINDORDS .W "",! ; I $$DISPATH D .W "" . W $$^%W1DICT("SHOWALLORDS") . W "" . D SPACE . W $$^%W1DICT("SHOWNOTDLVORDS") . W "" . D SPACE . W $$^%W1DICT("SHOWNOTSUPPLORDS") . W "" .W "" .; .W " " ; D TIMESORT ; D ASCENDING ; I $$DISPATH D .D TDSP .D SHOWTAW .I '$$1024^W4WDSCR D TDSP,TDSP,TDSP Q ; ; TIMESORT ; W "" W $$^%W1DICT("RESTSORT") W "" D SPACE W $$^%W1DICT("TIMESORT") W "" D SPACE W $$^%W1DICT("ORDERSORT") W "" W "" Q ; ASCENDING ; W "" W $$^%W1DICT("FROMOLD2NEW") W "" I '$$1024^W4WDSCR D SPACE I $$1024^W4WDSCR W "" W $$^%W1DICT("FROMNEW2OLD") W "" W "" Q ; PSLSHOW ; W "" D BUTTON("show",$$^%W1DICT("SHOW")_" ","ShowOrds()","color:brown;font-size:"_$$^W3FSZ(16)) W "",! Q ; ; PSLSBM ; W "" N TXT S TXT=$$NBSP^%L1FRM(3)_$$^%W1DICT("SENDDLV")_$$NBSP^%L1FRM(3) D BUTTON("submpsl",TXT,"SubmPsl()","color:green;font-size:"_$$^W3FSZ(16)) W "" Q ; ; SETDLV(PRM) ; D PUT^%W3DEB("W4DLVORD-SETDLV","PRM=PRM") N HZ,PSL S HZ=$P(PRM,";") Q:'HZ 0 S PSL=$P(PRM,";",2) ; N ER S ER=0 ; N ISHUR S ISHUR=$P(PRM,";",3) N ITRA S ITRA=$$ITRA^W4HZMST(HZ) N CODTS S CODTS=$$CODTS^W4HZMST(HZ) I PSL,ITRA>.5,'ISHUR,$D(@$$^W4ORD@(HZ,"CB","V"))>9!(CODTS>4)!(CODTS=3),'$G(@$$^W4PRM@("NOCHKDLV")) Q "ITRA" SETDLV1 ; I PSL S @$$^W4MAIN("TMPDLV")@(HZ)=PSL Q 1 K @$$^W4MAIN("TMPDLV")@(HZ) Q 1 ; ; KILLDLV ; K @$$^W4MAIN("TMPDLV") Q ; SETREADY(PRM) ; D PUT^%W3DEB("W4DLVORD-SETREADY","PRM=PRM") N HZ S HZ=$P(PRM,";",2) Q:HZ'>0 0 I '$$^W4HZFULL(HZ) Q 0 N ER S ER=0 I PRM S @$$^W4ORD@(HZ,"READY")=$H Q $S($$TAKEAWAY^W4HZMST(HZ):3,1:2) K @$$^W4ORD@(HZ,"READY") Q 1 ; ; SNDORD ; N (JB,%ARG,%REM,PRM) D ^W4IN S ZMANS=$$T^%L1TIME($P($H,",",2)) ; S HZ="" F S HZ=$O(@$$^W4MAIN("TMPDLV")@(HZ)) Q:HZ="" D SGPSL(HZ) D KILLDLV Q ; ; PUTTM(HZM,PSL) ; N (JB,%ARG,%REM,HZM,PSL) I $$TM^W4HZMST(HZM) Q N TM S P1DZ=$$^W4DZ L +@$$^W4GL("P1TM"):1 S TM=$O(@$$^W4GL("P1TM")@(9999999),-1)+1 S @$$^W4GL("P1TM")@(TM)=HZM_"\"_P1DZ_"\"_$H D ^%S2GLSV($$^W4GL("P1TM")_"("_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TM") ; L +@$$^W4GL("P1TMI"):1 S @$$^W4GL("P1TMI")@(P1DZ,TM)=$H D ^%S2GLSV($$^W4GL("P1TMI")_"("_P1DZ_","_TM_")",$$^W4FGIB) L -@$$^W4GL("P1TMI") ; D PUT^W4HZMST(HZM,"TM",TM) D ^%S2GLSV($$^W4ORD_"("_HZM_")",$$^W4FGIB) ; L +@$$^W4GL("P1MSL"):1 S @$$^W4GL("P1MSL")@(P1DZ,PSL,HZM)=$H D ^%S2GLSV($$^W4GL("P1MSL")_"("_P1DZ_","""_PSL_""","""_HZM_""")",$$^W4FGIB) L -@$$^W4GL("P1MSL") ; D ^W4HZGT(HZM) ; I $$HZM^W4MSL(HZM) D .I PSL<1 Q .D PRNDLVDOC(HZM) .I $G(@$$^W4PRM@("2TM")) D ..D PRNDLVDOC(HZM) ; PUTTME K @$$^W4TMPORD Q ; ; KHM(HZM) N N S N="" F S N=$O(@$$^W4GL("P1HM")@(N)) Q:N="" D .K @$$^W4GL("P1HM")@(N,HZM) .D ^%S2GLSV($$^W4GL("P1HM")_"("""_N_""","""_HZM_""")",$$^W4FGIB,"K") Q ; VIEWRCV(STAM) ; I $G(%ARG("VW"))=1 Q 1 Q 0 ; BGCOLOR(ORD) ; I $$DELORD(ORD) Q "background-color:black;color:red" I $$SENDEDORD(ORD) Q "background-color:white" I $$TAKEAWAY^W4HZMST(ORD) Q "background-color:orange" I $$DTHZ(ORD)>$H Q "background-color:c0d2ec" I $$^%L1DC(DAT,3)=+$H Q "background-color:eaeaea" Q "" ; KINDORD(STAM) ; I $G(%ARG("ORDKIND"))="" Q "NOSENDED" Q $G(%ARG("ORDKIND")) ; KNDO(STAM) Q $G(%ARG("KNDO")) ; SETPSL(PSL) ; D PUT^%W1PRM("PSL",PSL) Q ; MY(STAM) Q $G(%ARG("MY")) ; CMPR(HZ,NCA) ; Q $$^W4SRCCA(HZ,NCA) ; ; SGPSL(HZ) ; I $G(HZ)'>0 Q I '$$^W4HZFULL(HZ) Q ; S PSL=$G(@$$^W4MAIN("TMPDLV")@(HZ)) Q:'PSL ; I $$CODTS^W4HZMST(HZ)=4,'$D(@$$^W4ORD@(HZ,"CB","ASR")) D .N P1TNOPR S P1TNOPR="" .D SGASR(HZ) ; I '($$CLOSE^W4HZMST(HZ)#2) S @$$^W4ORD@(HZ,"S")=$G(@$$^W4ORD@(HZ,"S"))+1 ; I '$$^W4CLOSE(HZ),'$$ITRA^W4HZMST(HZ),PSL<0 D ; -- HADP HESH TAW .N P1TNOPR,BLIPR .I $$SHUL^W4HZMST(HZ) D ^W4PCHB(HZ,1) .I $$SHULA^W4HZMST(HZ),'$$SHUL^W4HZMST(HZ) D ^W4PCHB2(HZ) .D SETCLOSE^W4HZMST(HZ) ; I '$$PSL^W4HZMST(HZ) D PUT^W4HZMST(HZ,"PSL",PSL) ; I $$ZMANS^W4HZMST(HZ)="" D PUT^W4HZMST(HZ,"ZMANS",$$T^%L1TIME($P($H,",",2))) ; I PSL>0 D .D PUTTM(HZ,PSL) .I '$$^W4CLOSE(HZ),'$$ITRA^W4HZMST(HZ) D SETCLOSE^W4HZMST(HZ) .I $$SND2EMAIL^W4PRM J SNDMAIL(JB,HZ) Q ; ; SGASR(HZM) ; N (JB,%ARG,HZM,P1TNOPR,BLIPR) S ASRL=$$ITRA^W4HZMST(HZM) S (LKHN,CUSN)=$$NMB^W4HZMST(HZM) S LKAH="" ;$$AH^W4L(LKHN) S LKHNH="" S (HRA,LKHR)="" S HZMLK=$$HZMLAK^W4HZMST(HZM) S ASR=ASRL ; S TIPAS="" D ^W4ASR ;;D ^W4T(HZM,1) ; 06/06/18 ; I $$HBNOW^W4L(LKHN),'$$HBNOWMONTH^W4PRM,$$NOW2EMAIL^W4PRM D .J SNDMAIL(JB,HZM,1) ; Q ; ; SNDMAIL(JB,ORD,NOW) N (JB,%ARG,ORD,NOW) Q:'$G(ORD) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" N RES,EMAIL,LKHN,NOM S EMAIL=$$EMAIL^W4HZMST(ORD) Q:EMAIL'["@"!(EMAIL'[".") S LKHN=$$NMB^W4HZMST(ORD) Q:'LKHN ; D Q:'NOM .I $G(NOW) S NOM=+$G(@$$^W4ORD@(ORD,"HBNOW")),VD="HB",ND=NOM Q .S NOM=$$NCAB^W4HZMST(ORD) .S VD="HZ",ND=ORD ; S PRM=ND_";Invoice "_NOM_";"_EMAIL_";"_VD_";0;1;"_$G(@$$^W4PRM@("HOWSEND"),3) ; I VD="HZ" S RES=$$EMAILCONT^W4EMAIL(PRM) I VD="HB" D .S RES=$$EMAILHB^W4EMAIL(PRM) Q:RES .S @$$^W4ORD@(ORD,"SENT2MAIL",EMAIL)=$H_";"_$P(PRM,";",2,1000) ; ;;S @$$^W4GL("W4EMPROT")@($$^W4DZ,ORD,EMAIL)=$H_";"_RES_";INVOICEIMD "_NOM_";"_LKHN Q ; ; PRNDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB ; I $$^W4MSL(NMB),$$BIGTM^W4L(NMB) D Q .S @$$^W4MAIN("TMPBIGTM")@(HZM)=$H ; D PRINTDLVDOC(HZM) Q ; ; PRINTDLVDOC(HZM) ; N NMB S NMB=$$NMB^W4HZMST(HZM) Q:'NMB N IET,ITS,SHM,P1HZTM,P1TNOPR,BLIPR,P1HZHB,P1HZHB1,P1HZHB2,P1HZHB3 S IET="ETTM",ITS=1,SHM="TM",P1HZTM="" I $G(@$$^W4PRM@("NOTM")) S P1TNOPR="" I $G(@$$^W4PRM@("MM")),'$G(@$$^W4PRM@("MMTM")) S P1TNOPR="" D P1^W4HZTM Q ; NOPRES(SL) ; I '$G(@$$^W4PRM@("BDNOCHSL")) Q 0 I '$$PRES^W4SL(SL) Q 1 Q 0 ; HD(STAM) ; I $$CUSTLASTORDS Q "CUSTLASTORDS<>"_$$CUSTLASTORDS_"<>"_$$LKH^W4L($$CUSTLASTORDS) I $$MY,'$$DISPATH Q "MYORDERS" I '$$MY,'$$DISPATH,$$TOMORROW Q "TOMORROWORDERS" I '$$MY,'$$DISPATH,$G(%ARG("MEDAT"))="" Q "DAYORDERS" I $$DISPATH,$$TAW Q "TAKEAWAYORDERS" I $$DISPATH,'$$TAW Q "SENDORDERS" Q "ORDLIST" ; PAYCASH(HZM) ; N IND,VL I '$$^W4HZFULL(HZM) Q "0;ORDERERROR" I $$^W4CLOSE(HZM) Q "0;ORDERCLOSED" S VL=$$ITRA^W4HZMST(HZM) I 'VL G EPAYCASH S IND=$O(@$$^W4ORD@(HZM,"CB","MZ",999),-1)+1 S @$$^W4ORD@(HZM,"CB","MZ",IND)=$J(VL,2,2)_"*"_$H_"*"_$$LASTMLZ^W4HZMST(HZM)_"*"_$$^W4MYDVN D PAYCASH^W4PAYKB(HZM) D ^W4T(HZM,0) EPAYCASH Q "1;"_$$SHOWPAID(HZM) ; SHOWPAID(N) ; Q $$^%W1DICT("PAID")_" "_$J($$SHUL^W4HZMST(N)+$$SHULA^W4HZMST(N),2,2) ; IFREADY(N) ; I $D(@$$^W4ORD@(N,"READY")) Q 1 Q 0 ; TIMEREADY(N) ; N TIME S TIME=$G(@$$^W4ORD@(N,"READY")) I 'TIME Q "" Q $$T^%L1TIME(TIME) ; SGYOM(STAM) ; Q $G(%ARG("SGYOM")) ; SPACE ; W "   " Q ; TDSP ; W " " Q ; PRINTDOC ; W "",! W "" W "" ; W "" W "
    " W "" W "
    ",! Q ; ; KINDORDS ; W "",! Q ; SELECTED(IND) ; I $G(%ARG("KNDO"))=""&(IND="ALL") Q " selected=""selected"" " I $G(%ARG("KNDO"))=IND Q " selected=""selected"" " Q "" ; ALLORDS(STAM) Q $G(%ARG("ALLORDS")) ; NOSENDEDORDS(STAM) Q $G(%ARG("NOSENDEDORDS")) ; NOTSUPPLORDS(STAM) Q $G(%ARG("NOTSUPPLORDS")) ; SETARG ; I $G(%ARG("ASCENDING"))="" S %ARG("ASCENDING")=$S($$MY:0,1:1) I $G(%ARG("TIMESORT"))="" S %ARG("TIMESORT")=$S($$MY:0,1:1) ; I $$NOTSUPPLORDS S %ARG("SUPPLIEDORDS")=0 I $$NOSENDEDORDS="" S %ARG("NOSENDEDORDS")=1 I $G(%ARG("SENDEDORDS"))="" S %ARG("SENDEDORDS")=1 I $G(%ARG("NOPAIDORDS"))="" S %ARG("NOPAIDORDS")=1 I $G(%ARG("PAIDORDS"))="" S %ARG("PAIDORDS")=1 ; I $G(%ARG("FUTUREORDS"))="" D .S %ARG("FUTUREORDS")=$S($$HD="DAYORDERS":0,1:1) ; I $G(%ARG("SHOWTAW"))="" S %ARG("SHOWTAW")=1 ; I $$TOMORROW D .I $G(%ARG("DELETEDORDS"))="" S %ARG("DELETEDORDS")=1 ; 0 .S %ARG("FUTUREORDS")=1 ; I $G(%ARG("DELETEDORDS"))="" S %ARG("DELETEDORDS")=1 ;;$S($G(%ARG("MY")):1,1:0) ; Q ; ; ONCHANGE(STAM) ; Q " onChange=""OnChangePrm()"" " ; BUTTON(ID,VL,PROC,STYLE) D ^W4BUTTON($G(ID),VL,$G(PROC),$G(STYLE)) Q ; REVAH(STAM) ; I $$1024^W4WDSCR Q "
    " Q "  " ; SHORTSHOW(STAM) ; Q $G(%ARG("SHORTSHOW")) ; TOMORROW(STAM) ; Q $G(%ARG("TOMORROW")) ; CUSTLASTORDS(STAM) ; Q $G(%ARG("CUSTLASTORDS")) ; PRINTALLORDS(MDB) ; N N,HZ S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#10) H 1 .S HZ=$$HZ(N) .S A=$$PRINTBON^W4MENUBT(HZ_";;;"_MDB) Q ; PRINTALLKOTMDB ; N PRN S PRN=$G(@$$^W4PRM@("MDBKOT")) Q:'PRN N N,HZ S N="",I=0 F S N=$O(@$$^W4MAIN("VIB")@(N)) Q:N="" D .S I=I+1 I '(I#10) H 1 .S HZ=$$HZ(N) .D MDBKOT^W4MDBPC(HZ,PRN) Q ; CUSTALL(STAM) ; Q $G(%ARG("CSALL")) ; REPTRH(STAM) ; Q $G(%ARG("REPTRH")) ; ; KOTREPTRH ; N HD W "" S HD="REPDEPTRHMEAD" I $G(%ARG("ITEMS")) S HD="REPITEMSTRHMEAD" W $$^%W1DICT(HD,$G(%ARG("MEDAT"))_"<>"_$G(%ARG("ADDAT"))) W "

    ",! ; N REPTRH S REPTRH=$$REPTRH W "",! W "" W "" ; W "" ; W "" W "",! W "
    " W "",! W " " W $$^%W1DICT("SHOWORDERS")_" " W "" W "
    ",! Q ; SELORD(REPTRH,OPT) ; I REPTRH=OPT W " selected=""selected"" " Q "" ; CRLINKDR ; N A,N,DCB,DTR,SHAAR S N="" F S N=$O(@$$^W4ORD@(N)) Q:N="" I N'<1 D .S A=$G(^(N)),DCB=$P(A,"\",4) Q:'DCB .I $L($P(A,"\"))<4 Q .S DTR=$$^%L1DC($P(DCB," "),3) Q:DTR<50000 .S SHAAR=$P(DCB," ",2) .I SHAAR<6 S DTR=DTR-1 .S @$$^W4GL("W4LINKDR")@(DTR,N)=$$GETP^%W1PRM("MSD") Q ; STATFAX(N) Q $$STATFAX^W4FAXHTM(N) ; READY(N) ; N TM S TM=$$READY^W4HZMST(N) I TM["," S TM=$ZD(TM,"24:60") Q TM ; TAKED(N) ; N TM S TM=$$TAKED^W4HZMST(N) I TM["," S TM=$ZD(TM,"24:60") Q TM ; SUPPLIED(N) ; Q $$SUPPLIED^W4HZMST(N) ; DOPADR(N) ; N DIRA,KOMA,CNISA,CMNT S DIRA=$$SPA^%L1FRM($$DIRA^W4HZMST(N)) S KOMA=$$SPA^%L1FRM($$KOMA^W4HZMST(N)) S CNISA=$$SPA^%L1FRM($$CNISA^W4HZMST(N)) S CMNT=$$SPA^%L1FRM($$CMNT^W4HZMST(N)) N ST S ST="" I $L(DIRA) S ST=ST_$$^%W1DICT("FLAT")_":"_$$H2U^%L1FRM(DIRA) I $L(KOMA) S ST=ST_" "_$$^%W1DICT("FLOOR")_":"_$$H2U^%L1FRM(KOMA) I $L(CNISA) S ST=ST_" "_$$^%W1DICT("ENTRANCE")_":"_$$H2U^%L1FRM(CNISA) I $L(CMNT) S ST=ST_" "_$$H2U^%L1FRM(CMNT) Q ST ; TELPSL(PSL) ; Q $$TEL^W4SL(PSL) ; BGCTIME(N,KIND) ; ; N BGC,ENDTIME,CURTIME S BGC="" ; S ENDTIME=$$TIME(KIND,N) S CURTIME=$$CURTIME(KIND,N) ; S BGC=$$BGCT(ENDTIME,CURTIME) Q "background-color:"_BGC ; ; GW1(STAM) Q $G(@$$^W4PRM@("GWTIME1")) GW2(STAM) Q $G(@$$^W4PRM@("GWTIME2")) GW3(STAM) Q $G(@$$^W4PRM@("GWTIME3")) ; INDLATE(TIME,CT) ; I '$G(TIME) Q 0 N BGC S BGC="" N GW1 S GW1=$$GW1 N GW2 S GW2=$$GW2 N GW3 S GW3=$$GW3 N IND S IND=0 D .N DIF S DIF=$$DIF^%L1TIME(CT,TIME) .I DIF>GW3 S IND=3 Q .I DIF>GW2 S IND=2 Q .I DIF>GW1 S IND=1 Q .I DIF>0,DIF'>GW1 S IND=.5 Q Q IND ; BGCT(TIME,CT) ; N BGC S BGC="" N BGCT S BGCT(.5)="lightgreen" S BGCT(1)="yellow" S BGCT(2)="orange" S BGCT(3)="red" Q $G(BGCT($$INDLATE(TIME,CT))) ; ; PAYM(ORD) ; N ST,SHUL S SHUL=$$SHUL^W4HZMST(ORD) S ST="" N MZM S MZM=$$MZM^W4HZMST(ORD) N CHK S CHK=$$CHK^W4HZMST(ORD) N CA S CA=$$CA^W4HZMST(ORD) N ASR S ASR=$$ASR^W4HZMST(ORD) I 'SHUL&'ASR S ST=$$^%W1DICT("NOPAYED") Q ST ; N SP S SP=$$NBSP^%L1FRM(2) I MZM S ST=ST_$$^%W1DICT("SHORTCASH")_": "_$J(MZM,2,2) I CHK S ST=ST_SP_$$^%W1DICT("SHORTCHECK")_": "_$J(CHK,2,2) I CA S ST=ST_SP_$$^%W1DICT("SHORTCA")_": "_$J(CA,2,2) I ASR S ST=ST_SP_$$^%W1DICT("SHORTASR")_": "_$J(ASR,2,2) Q ST ; CURTIME(KIND,ORD) ; Q $$CURTIME^W4MMTIME(KIND,ORD) ; ; TIME(KIND,ORD) ; Q $$TIME^W4MMTIME(KIND,ORD) ; 2460(ORD,KIND) ; N TIME X "S TIME=$$"_KIND_"^W4HZMST(ORD)" I TIME[":" Q TIME Q $ZD(TIME,"24:60") ; CHKBOX(TX,ID) ; N ST S ST=$$^%W1DICT(TX)_" " S ST=ST_"" Q ST ; SHOWMSD(MSD) ; N ST S ST="" N TEL S TEL=$$TEL^W3R(MSD) N PELE S PELE=$$PELE^W3R(MSD) N FAX S FAX=$$FAX^W3R(MSD) N EMAIL S EMAIL=$$EMAIL^W3R(MSD) N FAXKIND S FAXKIND=$$FAXKIND^W3R(MSD) ; S ST=MSD_"
    " I TEL S ST=ST_$$^%W1DICT("TEL")_" : "_TEL_"
    " I PELE S ST=ST_$$^%W1DICT("PELE")_" : "_PELE_"
    " I FAX S ST=ST_$$^%W1DICT("FAX")_" : "_FAX_"
    " I $L(EMAIL) S ST=ST_EMAIL_"
    " N M ;;S M(0)=$$^%W1DICT("NOVIDU") S M(1)=$$^%W1DICT("FAXAUTO") S M(2)=$$^%W1DICT("FAXYAD") S ST=ST_$G(M(+FAXKIND))_"
    " Q ST ; DATCB(N) N DATCB S DATCB=$$DATCB^W4HZMST(N) I $$DISPATH S DATCB=$P(DATCB," ",2) Q DATCB W4MMIT W4MMMN(MENU) ; [ 06.11.18 13:12 ] [ 20.10.18 06:10 ] [ 19.10.18 15:16 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D CHOICEREST Q:'MSD D ^%W1WEBMN(MENU) Q ; CHOICEREST ; S MSDR=$G(^[$$^W3MAIN]P1PRM("MSDR")) Q:'MSDR S MSD=$G(%ARG("MSD")) I (MSD="") S MSD=$$GETP^%W1PRM("CURREST") W "
    ",! W "

    ",! W "",! W "" W "" I 'MSD D .W "" W "",! W "
    " W "",! W "" . D BUT^W4BCK .W "
    ",! W "
    ",! ; D PUT^%W1PRM("CURREST",+MSD) Q W4MMMN W4MMMN(MENU) ; [ 06.11.18 13:12 ] [ 20.10.18 06:26 ] [ 19.10.18 15:16 ] N (JB,%ARG,%REM,MENU) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" D CHOICEREST Q:'MSD D ^%W1WEBMN(MENU) Q ; CHOICEREST ; S MSDR=$G(^[$$^W3MAIN]P1PRM("MSDR")) Q:'MSDR S MSD=$G(%ARG("MSD")) I (MSD="") S MSD=$$GETP^%W1PRM("CURREST") W "
    ",! W "

    ",! W "",! W "" W "" I 'MSD D .W "" W "",! W "
    " W "",! W "" . D BUT^W4BCK .W "
    ",! W "
    ",! ; D PUT^%W1PRM("CURREST",+MSD) Q W4MMPSL W4MMPSL ; [ 20.07.20 16:57 ] [ 03.05.20 14:25 ] [ 18.12.18 18:38 ] N (JB,%ARG,%REM) S DT=$$^W4DZ N TMP S TMP=$$^W4MAIN("TMP") K @TMP N TMP1 S TMP1=$$^W4MAIN("TMP1") K @TMP1 ; S N="" F S N=$O(@$$^W4REF@(DT,N)) Q:N="" D .S PSL=$P($G(@$$^W4ORD@(N,"TM")),"\") Q:'PSL .S TIMEHZ=$$TIMEHZ(N) .S @TMP@(PSL,TIMEHZ_$J(N,10))=N ; ; --- FORM-E SPISKA SHLIHIM S PSL="" F S PSL=$O(@TMP@(PSL)) Q:PSL="" D .S IND="" F S IND=$O(@TMP@(PSL,IND)) Q:IND="" D ..N HZ S HZ=$G(^(IND)) Q:HZ<1 ..I $O(@TMP@(PSL,IND))'="",$D(@$$^W4ORD@(HZ,"SUPPLIED")) K @TMP@(PSL,IND) ; S PSL="" F S PSL=$O(@TMP@(PSL)) Q:PSL="" D ; .S IND="" F I=1:1 S IND=$O(@TMP@(PSL,IND)) Q:IND="" D ..S HZ=$G(^(IND)) I I=1 S HZ0=HZ .. ..I $D(@$$^W4ORD@(HZ,"SUPPLIED")) D Q ...S SUPPLIED=$P($G(^("SUPPLIED")),"\") ...N A1 S A1=$G(@TMP1@(PSL)) I A1,$P(A1,"\",3)'=HZ Q ...S @TMP1@(PSL)="0\"_SUPPLIED_"\"_HZ ; -- COURIER FREE ..;--- WHEN WILL FREE ..S @TMP1@(PSL)="1\"_$$PLUS^%L1TIME($$TIMEHZ(HZ),$$LATE(HZ)*60)_"\"_HZ0 ; S OV="" F S OV=$O(@$$^W4GL("NAME")@(OV)) Q:OV="" D .I $G(@$$^W4GL("FILE")@(OV,"CIO"))'="I" Q .S PSL=$$PSL(OV) .I '$D(@$$^W4GL("P1SL")@(PSL)) Q .I $D(@TMP1@(PSL)) Q .S TIMEIN=$$TIMEIN(OV) Q:TIMEIN="" .S @TMP1@(PSL)="0\"_TIMEIN ; W "
    ",! W "",! W "" W "" W "" W "",! W "" W "",! ; W "",! W "" W "
    "_$$^%W1DICT("FREECOURIERS")_""_$$^%W1DICT("WILLFREECOURIERS")_"
    " D FREECOUR W "" D WILLFREECOUR W "
    ",! ; W "

    " D ^W4BTN("CLOSE","Close()","red",,16) W "
    ",! Q ; TIMEHZ(N) ; Q $$TIMEHZ^W4MMTIME(N) ; ; TIMEIN(OV) ; N FILE S FILE=$$^W4GL("FILE") N DAT,SEC,TIMEIN S DAT=$ZD($$^W4DZ-1,"YYMMDD") ; F S DAT=$O(@FILE@(OV,DAT)) Q:DAT="" D .S SEC="" F S SEC=$O(@FILE@(OV,DAT,SEC)) Q:SEC="" D ..I $G(^(SEC))="I" S TIMEIN=DAT_"\"_SEC ..I $G(^(SEC))'="I" K TIMEIN ; I '$D(TIMEIN) Q "" ; S SEC=$P(TIMEIN,"\",2) S TIMEIN=$$^%L1DC($P(TIMEIN,"\"),4)_","_SEC Q TIMEIN ; ; LATE(N) ; ; LATE=FAX LATE OR TAKED LATE N (JB,%ARG,%REM,N) S (DIF1,DIF2,DIF3,DIF4)=0 ; S ENDTIME=$$TIME("FAXTIME",N) S CURTIME=$$CURTIME("FAXTIME",N) ; I ENDTIME'<1 S DIF1=$$DIF^%L1TIME(CURTIME,ENDTIME) I DIF1>0,'$$TAKED^W4HZMST(N) Q DIF1 ; S ENDTIME=$$TIME("TAKED",N) S CURTIME=$$CURTIME("TAKED",N) I ENDTIME'<1 S DIF2=$$DIF^%L1TIME(CURTIME,ENDTIME) S:DIF2<0 DIF2=0 Q DIF2 ; I DIF1<0 S DIF1=0 Q DIF1 ; ; TIME(KIND,N) Q $$TIME^W4MMTIME(KIND,N) ; ; CURTIME(KIND,N) Q $$CURTIME^W4MMTIME(KIND,N) ; ; FREECOUR ; N A,PSL,DIF,HZ D COURTB S PSL="" F S PSL=$O(@TMP1@(PSL)) Q:PSL="" D .S A=$G(^(PSL)) .Q:A .W "" . D COURNM(PSL) . D SHOWDIF(1) .W "",! W "",! Q ; ; WILLFREECOUR ; N A,PSL,DIF,HZ D COURTB S PSL="" F S PSL=$O(@TMP1@(PSL)) Q:PSL="" D .S A=$G(^(PSL)) .Q:'A .W "" . D COURNM(PSL) . . D SHOWDIF(2) . . S HZ=$P(A,"\",3) . D COURADR(HZ) .W "",! W "",! Q ; ; COURTB ; W "",! Q ; COURNM(PSL) ; W "" Q ; SHOWDIF(PR) ; N DIF W "" Q ; ; COURADR(HZ) ; W "" Q ; DTIME(H) ; Q $$DTIME^W4MMTIME(H) ; PSL(OV) ; N CDOV,OK S OK=0 N N S N="" F S N=$O(@$$^W4GL("P1SL")@(N)) Q:N="" D Q:OK .S CDOV=$$OV^W4SL(N) .I CDOV,CDOV=OV S OK=N I OK Q OK Q +OV W4MMSND W4MMSND ; [ 01.08.21 14:34 ] [ 02.03.21 18:00 ] [ 28.02.21 16:51 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" S HZ=$G(%ARG("ORD")) S MSD=$$MSDHZM^W4HZMST(HZ) S FAX=$$FAX^W4HZMST(HZ) I 'FAX S FAX=$$FAX^W3R(MSD) S EMAIL=$$EMAIL^W4HZMST(HZ) I '$L(EMAIL) S EMAIL=$$EMAIL^W3R(MSD) W "
    ",! ; W ""_$$^%W1DICT("CHOICEKINDOFSENDING")_"",! W "

    ",! ; W "
    " W $$NMH2U^W4SL(PSL) W "" I $G(PR)=2 S DIF=$$DIF^%L1TIME($P(A,"\",2),$H) I $G(PR)=1 S DIF=$$DIF^%L1TIME($H,$P(A,"\",2)) I DIF'>1 S DIF=1 W " ~ "_DIF_" "_$$^%W1DICT("MINUT") W "" W $$H2U^%L1FRM($$KTVM^W4HZMST(HZ)) W "
    ",! W " " W " ",! W " ",! W " " W " " W " ",! W " ",! W " " W " " W " ",! W " " W " ",! W " ",! W " " W " " W " ",! W " " W " ",! W " ",! W " ",! ; W "
    "_$$^%W1DICT("FAX")_"
    " W " "_$$NBSP^%L1FRM(10)_$$^%W1DICT("QNFAX")_$$NBSP^%L1FRM(5)_"
    "_$$^%W1DICT("EMAIL") ; I $$SNDY^W4PRM D .W " "_$$NBSP^%L1FRM(15)_""_$$^%W1DICT("SENDY") ; W "
    " W $$^%W1DICT("COMMENTS"),"
    ",! W "" W "
     
    "_$$^%W1DICT("NOSEND")_"
    ",! W "
    ",! W " ",! W "",! W "",! W "
    " D ROUNDBUT^%W1JS("submit",$$^%W1DICT("SUBMIT"),"Submit()","color:green","wh,22") W "
    ",! W "
    ",! Q ; SND(PRM) ; ;;S ^AA("W4MMSND","PRM")=PRM N A,HZ,MAILFAX,CMNT,ER,MKR S MAILFAX=$P(PRM,"~",1) S HZ=$P(PRM,"~",2) I HZ<1 Q "ORDERNUMBERISWRONG" S QNFAX=$P(PRM,"~",3) S SNDY=$P(PRM,"~",4) S CMNT=$$CNWEB^%L1FRM($P(PRM,"~",5)) S CMNT=$$INVH^%L1FRM(CMNT) S MKR=1 S ER=0 I MAILFAX["@" S QNFAX=1 ; I SNDY D CR^WQDLV(HZ) ; F J=1:1:QNFAX D .D SENDTRY^W4FAXHTM(HZ,MKR,MAILFAX,CMNT) ; Q 1 ; ; CMNT(TXT) ; N ST S ST="
    " S ST=ST_$$H2U^%L1FRM(TXT)_"" Q ST W4MMTIME W4MMTIME(ORD) ; [ 21.01.20 07:45 ] [ 16.01.20 09:25 ] [ 18.12.18 13:09 ] N (JB,%ARG,ORD) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" X "S TM=$$"_$$KIND_"^W4HZMST(ORD)" I TM'[":" S TM=$ZD(TM,"24:60") X "S HRA=$$"_$$KIND_"HRA^W4HZMST(ORD)" S HRA=$$H2U^%L1FRM(HRA) ; W "
    ",! W "
    " W "" W $$^%W1DICT("TYPE"_$$KIND_"TIME") W "

    ",! ; D SHAA ; W "

    ",! W "" W "

    ",! ; W "" W "" W "" W "" W "" W "",! W "
    " D ^W4BTN("SUBMIT","Submit('"_ORD_"')","green") W "" D ^W4BTN("CLEAR","Clear('"_ORD_"')","blue") W "" D ^W4BTN("CLOSE","Close('"_ORD_"')","red") W "
    ",! ; W "

    ",! W "
    ",! Q ; SHAA W "",! ; W "",! ; Q ; ; SET(PRM) ; D PUT^%W3DEB("W4MMTIME-SET","PRM=PRM") N HZ,ST,TIME,KIND ; S KIND=$P(PRM,"~") Q:KIND="" 0 S HZ=$P(PRM,"~",2) Q:HZ'>0 0 S TIME=$P(PRM,"~",3) S TIME=+$H_","_($P(TIME,":")*3600+($P(TIME,":",2)*60)) S HRA=$$INVH^%L1FRM($P(PRM,"~",4)) ; I TIME?1N.E D Q ST .S @$$^W4ORD@(HZ,KIND)=TIME_"\"_HRA .S ST=$$CHN(KIND,HZ,$ZD(TIME,"24:60")) ; Q 0 ; ; KILL(PRM) ; D PUT^%W3DEB("W4MMTINE-KILL","PRM=PRM") N HZ,KIND,ST,TIME ; S KIND=$P(PRM,"~") Q:KIND="" 0 S HZ=$P(PRM,"~",2) Q:HZ'>0 0 S ID=$P(PRM,"~",3) Q:ID="" 0 K @$$^W4ORD@(HZ,KIND) S ST=$$CHKBOX(KIND,HZ,ID) Q ST ; ; CHKBOX(KIND,N,ID) ; N ST S ST="" Q ST ; CHN(KIND,HZ,TIME) ; I TIME?5N1","1N.N S TIME=$ZD(TIME,"24:60") N ST,IMG,CMNT X "S CMNT=$$"_KIND_"HRA^W4HZMST(HZ)" D .I CMNT="" S IMG="  " Q .S IMG=$$IMG("ShowTimeComment('"_KIND_"','"_HZ_"')") S ST=IMG_" 180 Q .S ST=ST_"onClick=""Change"_KIND_"('"_HZ_"')"" style=""cursor:pointer"" " S ST=ST_">"_TIME_" "_$$DIF(KIND,HZ)_"" Q ST ; KIND(STAM) ; Q $G(%ARG("KIND")) ; IMG(PROC,IMG) N ST I $G(IMG)="" S IMG="w4mmimg.png" S ST="" Q ST ; COMMENT(PRM) ; N KIND,HZ,CMNT S KIND=$P(PRM,";") S HZ=$P(PRM,";",2) X "S CMNT=$$"_KIND_"HRA^W4HZMST(HZ)" Q CMNT ; DIF(KIND,N) ; N GW1 S GW1=$G(@$$^W4PRM@("GWTIME1")) N ENDTIME,CURTIME ; S ENDTIME=$$TIME(KIND,N) S CURTIME=$$CURTIME(KIND,N) ; I ENDTIME'>0!(CURTIME'>0) Q "" ; S DIF=$$DIF^%L1TIME(CURTIME,ENDTIME) I DIF>0,CURTIME,ENDTIME Q " [+"_DIF_"]" Q "" ; ; CURTIME(KIND,ORD) ; N CURTIME X "S CURTIME=$$"_KIND_"^W4HZMST(ORD)" I 'CURTIME Q +$H_$TR($J($P($H,",",2),5)," ",0) Q +CURTIME_$TR($J($P(CURTIME,",",2),5)," ",0) ; ; TIME(KIND,N) ; I $G(N)="" Q "" N ENDTIME S ENDTIME="" N GW1 S GW1=$G(@$$^W4PRM@("GWTIME1")) ; I KIND="FAXTIME" D .N FAXTIME S FAXTIME=$$FAXTIME^W4HZMST(N) .I FAXTIME="" D ..N DATCB,SHAACB,A S A=$$DATCB^W4HZMST(N) ..S DATCB=$P(A," ") ..S SHAA=$P(A," ",2) ..S FAXTIME=$$^%L1DC(DATCB,3)_","_(SHAA*3600+($P(SHAA,":",2)*60)) .S ENDTIME=$$DTIME(FAXTIME)+$$GWFAX^W4PRM ; I KIND="VIDU" S ENDTIME=$$VIDU(N) ; I KIND="READY" S ENDTIME=$$READY(N) ; I KIND="TAKED" D .N READY S READY=$$READY(N) I 'READY Q .N PLUS S PLUS=$$PLUS^%L1TIME(READY,300) .N TAKEDTIME S TAKEDTIME=$$DTIME(PLUS) I TAKEDTIME="" Q .S ENDTIME=TAKEDTIME ;;-GW1 ; I KIND="SUPPLIED" D .S ENDTIME=$$TIMEHZ(N) ; Q ENDTIME ; ; DTIME(H) ; Q +H_$TR($J($P(H,",",2),5)," ",0) ; TIMEHZ(N) ; N DATHZ,SHAA,SEC,TIMEHZ S DATHZ=$$TRH^W4HZMST(N) I DATHZ?.P Q "" S SHAA=$$SHAA^W4HZMST(N) S SEC=SHAA*3600+($P(SHAA,":",2)*60) S TIMEHZ=$$^%L1DC(DATHZ,3)_$TR($J(SEC,5)," ",0) Q TIMEHZ ; READY(N) ; N ENDTIME S ENDTIME=$$READY^W4HZMST(N) I ENDTIME Q ENDTIME N FAXTIME S FAXTIME=$$FAXTIME^W4HZMST(N) I FAXTIME="" Q "" ; -- FAX NOT PAST N HACHANA N MSD S MSD=$$MSDHZM^W4HZMST(N) I MSD S HACHANA=$$HACHANA^W3R(MSD) I 'HACHANA S HACHANA=30 N TIME S TIME=$$PLUS^%L1TIME(FAXTIME,HACHANA*60) S ENDTIME=$$DTIME(TIME) Q ENDTIME ; VIDU(N) ; N ENDTIME S ENDTIME=$$VIDU^W4HZMST(N) Q ENDTIME W4MNLNET W4MNLNET ; [ 05.07.23 15:39 ] [ 04.07.23 10:35 ] [ 30.05.23 04:53 ] N (JB,%ARG,%REM) S JB=+$G(JB) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $G(JB)="" W " JB number is not defined ! " Q S MSDR=$G(%ARG("MSDR")) ; W "
    ",! ; W "",! W " " W " " W " " ; W " " W " " W " " W " " ; W " ",! N N,NN,I D GLTMP K @GLTMP ; S GLTB=$$GL ; M @GLTMP=@GLTB ; S I=0 I $D(@GLTMP)<10 D .N PRM S PRM=1_";"_$G(%ARG("MSDR"))_";" .W "" W $$LINE(PRM) W "",! . S N="" F S N=$O(@GLTMP@(N)) Q:N="" D .N A S A=$G(^(N)) .S I=I+1 .N PRM S PRM=I_";"_$G(%ARG("MSDR"))_";"_N_";"_$P(A,"\")_";"_$P(A,"\",2)_";"_$P(A,"\",3)_";"_$P(A,"\",4) .W "" W $$LINE(PRM) W "",! ; W "
    "_$$^%W1DICT("MANAGERCODE")_""_$$^%W1DICT("MANAGERNAME")_""_$$^%W1DICT("TEL")_""_$$^%W1DICT("EMAIL")_""_$$^%W1DICT("PASSWORD")_""_$$^%W1DICT("BRANCH")_"
    ",! W "
    ",! Q ; ; SAVEND(PRM) ; N I,GLTMP,CD,TEL,MAIL,PSW,SNIF,MSDR D GLTMP ; S MSDR=$P(PRM,";") M @$$GLGIB=@$$GL K @$$GL ; F I=2:1:$L(PRM,";") D .N VL S VL=$P(PRM,";",I) .S CD=$P(VL,"~") Q:'CD .I CD'?5N S CD=$$DOP^%L1FRM(CD,5) .S TEL=$P(VL,"~",2) .S MAIL=$P(VL,"~",3) .S PSW=$P(VL,"~",4) .S SNIF=$P(VL,"~",5) .S @$$GL@(CD)=TEL_"\"_MAIL_"\"_PSW_"\"_SNIF ; K @GLTMP Q 0 ; ; GLTMP S GLTMP=$$^W4MAIN("TMP") Q ; ; LINE(PRM) ; N MGCD,TEL,MAIL,SH,PSW,SNIF,MSDR S SH=$P(PRM,";",1) S MSDR=$P(PRM,";",2) S MGCD=$P(PRM,";",3) S TEL=$P(PRM,";",4) S MAIL=$P(PRM,";",5) S PSW=$P(PRM,";",6) S SNIF=$P(PRM,";",7) ; N ST S ST="" ; S ST=ST_" " S ST=ST_$$VVCD(MGCD) S ST=ST_" " ; N MGNM S MGNM=$$^W4NAME(MGCD) S ST=ST_" " S ST=ST_"  "_$$H2U^%L1FRM(MGNM) S ST=ST_" " ; D .S ST=ST_"" .S ST=ST_" " .S ST=ST_"" . .S ST=ST_"" .S ST=ST_" " .S ST=ST_"" . .S ST=ST_"" .S ST=ST_" " .S ST=ST_"" . .S ST=ST_"" .S ST=ST_" " .S ST=ST_"" ; Q ST ; ; GETVL(PRM) N MGCD,MSDR,I,VL,BC S MGCD=$P(PRM,";") S MSDR=$P(PRM,";",2) I MGCD="" Q "CODENOTEXIST" N GL S GL=$$GL N A S A=$G(@GL@(MGCD)) S TEL=$P(A,"\",1) S EMAIL=$P(A,"\",2) S PSW=$P(A,"\",3) S SNIF=$P(A,"\",4) ; N NAME1 S NAME1=$$^W4NAME(MGCD) Q $$DOP^%L1FRM(MGCD,5)_"~"_$$CLWEB^%L1FRM($$H2U^%L1FRM(NAME1))_"~"_TEL_"~"_EMAIL_"~"_PSW_"~"_SNIF ; ; GL() Q "^|$$^W3MAIN|W4MNLNET(MSDR)" ; GLGIB() Q "^|$$^W3MAIN|W4MNLNET0(MSDR)" ; VVCD(VL) ; N I,IDCD,IDNM N FIND S FIND="Find(this)" N A S A="
    " S A=A_" " S A=A_" " S A=A_" " S A=A_"
    " Q A ; ; HD() ; Q "MNLNETTABLE" ; OPTIONS(SNIF,MSDR) ; I $G(MSDR)="" W "" N ST1 S ST1="" N GLMSDR S GLMSDR="^|$$^W3MAIN|W3MSDR" S ST1="" N N S N="" F S N=$O(@GLMSDR@(N)) Q:N="" D .S ST1=ST1_"" Q ST1 ; CHN() ; Q "onChange=""Chn()"" " W4MNSIS W4MNSIS ; [ 14.11.24 19:53 ] [ 10.11.24 14:12 ] [ 18.07.15 07:00 ] Q ; GET ; N GLOB D GLOB^W4SPIDK K @GLOB N N,A,I S N="",I=0 F S N=$O(@$$GLOPT@("BO",N)) Q:N="" D .S A=$G(^(N)) .N NMIND S NMIND=$TR($P(A,";",2),"<>","") .X "I "_$P(A,";") Q:'$T .I N=0 S NMIND="BACKOFFICEPASSWORD" .N NAME S NAME=$$TV^%W1DICT($$^%W1LNG,NMIND) .S @GLOB@(N)=NAME .S $P(@GLOB@(N,1),"\",1)=$G(@$$^W4GL("W4OPT")@("BO",N,"PSWLVL")) ; I $$PAPJ^W4PRM D .S @GLOB@("LVLDEL")=$$TV^%W1DICT($$^%W1LNG,"DELETING") .S $P(@GLOB@("LVLDEL",1),"\")=$G(@$$^W4PRM@("BITLVL"),2) .S @GLOB@("LVLDPS")=$$TV^%W1DICT($$^%W1LNG,"DPSREPORT") .S $P(@GLOB@("LVLDPS",1),"\")=$G(@$$^W4PRM@("LVDMN"),3) Q ; ; PUT ; N GLOB D GLOB^W4SPIDK N N,A N PSW0 S PSW0=$G(@GLOB@(0,1)) I 'PSW0 S PSW0=2 ; S N="" F S N=$O(@GLOB@(N)) Q:N="" D .S A=$G(^(N,1)) .I N="LVLDEL" D Q ..S @$$^W4PRM@("BITLVL")=$P(A,"\") .I N="LVLDPS" D Q ..S @$$^W4PRM@("LVDMN")=$P(A,"\") . .I N K @$$GLOPT@("BO",N,"PSWLVL") .I A!'N S @$$GLOPT@("BO",N,"PSWLVL")=A ; K @$$^W4PRM@("BOPSW3") I $G(@$$GLOPT@("BO",0,"PSWLVL"))=3 S @$$^W4PRM@("BOPSW3")=1 Q ; ; GLOPT(STAM) ; Q $$^W4GL("W4OPT") W4MNTR W4MNTR(DUMP) ; [ 17.11.11 19:00 ] [ 25.07.02 11:03 AM ] [ 22.07.02 9:46 AM ] [ N A S A=$E($G(@$$^W4GL("START")),1,7) I A=2520260 Q 1 I A=2520196 Q 2 Q 0 W4MNYA W4MNYA ; -- DOH BDIKA KASPIT LEFI SNIFIM [ 11.04.24 05:24 ] [ 13.06.23 17:00 ] [ 19.07.22 21:15 ] S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" Q:'$G(JB) K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("REPN")="W4MNYA" ; N GLMSDR S GLMSDR=$$^W4MAIN("TMPMSDR") K @GLMSDR N GLMSD S GLMSD=$$^W4MAIN("TMPMSD") K @GLMSD ; S GL="^|"""_$$^W3MAIN_"""|W4MNYALL" S DT="" F S DT=$O(@GL@(DT)) Q:DT="" D .N MSD S MSD="" F S MSD=$O(@GL@(DT,MSD)) Q:MSD="" D ..S @GLMSD@(MSD)="" ; N MSD S MSD="" F S MSD=$O(@GLMSD@(MSD)) Q:MSD="" D .N MSDR S MSDR=$$MSDR^W4MNYA(MSD) .I MSDR S @GLMSDR@(MSDR)=$$NAME^W3MSDR(MSDR) K @GLMSD Q ; ; DT I DTADTRH) S OK=0 Q N REPDAYS S REPDAYS=$$GETP^%W1PRM("REPDAYS") I REPDAYS,'$E(REPDAYS,$$^%L1DC(DT,8)) S OK=0 Q ; S TRH=$$^%L1DC(DT,1) Q ; ; MSD ; I '$G(MSD) S OK=0 Q S MSDR=$$MSDR(MSD) I $G(MEMSDR),MSDRADMSDR S OK=0 Q S MSDR1="" I MSDR S MSDR1=$$NAME^W3MSDR(MSD) ; S MSD1=$$MSD^W3R(MSD) I $D(^[$$^W3MAIN]W4MNYNO(MSD)) S OK=0 Q ; N A S A=$G(@GLOB) ;;S ^AA("W4MNY-MSD","A")=A ;;S ^AA("W4MNY-MSD","MSD")=MSD ;;S ^AA("W4MNY-MSD","MSDR")=MSDR ; D PRS^%L1FRM(A,"PD1\CR1\PD2\CR2\PD3\CR3\CA\CAS\CAJ","\") S CR4=$$GAPNET(DT,MSD) ;;S ^AA("W4MNY-MSD","CR4")=CR4 N DR S DR=1 S ER=0 D I 'ER S OK=0 Q .I $$RZN(PD2,PD1) S ER=1 Q .I $$RZN(CR2,CR1) S ER=1 Q .I $$RSTG,$$RZN(PD3,PD1) S ER=1 Q .I $$RSTG,$$RZN(CR3,CR1) S ER=1 Q .I $$RSTG,CR4'="?",$$RZN(PD1+CR1,CR4) S ER=1 Q .I $$RZN(CA,CAS+CAJ) S ER=1 Q ; S x1=$J(PD1,DR,DR) S x2=$J(PD2,DR,DR) S x3=$J(x2-x1,DR,DR) S x4=$J(CR1,DR,DR) S x5=$J(CR2,DR,DR) S x6=$J(x5-x4,DR,DR) s x7=$J(PD1+CR1,DR,DR) S x8=$J(PD2+CR2-PD1-CR1,DR,DR) S x9=$J(CA,DR,DR) S x10=$J(CAS,DR,DR) S x11=$J(CAJ,DR,DR) S x12=x10+x11-x9 ;;S ^AA("W4MNY-MSD","OK")=OK Q ; GAPNET(DT,MSD) ; N MSDR,SUM S SUM=0 S MSDR="" F S MSDR=$O(^|$$^W3MAIN|W4GAPNET(MSDR)) Q:MSDR="" D Q:SUM .I $D(^(MSDR,DT,MSD)) D ..S SUM=$P($G(^(MSD)),",",4) ; I 'SUM D .N OK S OK=0 .S MSDR="" F S MSDR=$O(^|$$^W3MAIN|W4GAPNET(MSDR)) Q:MSDR="" D Q:SUM ..I $G(DT1),$G(DT2) D ...N D F D=DT1:1:DT2 I $D(^|$$^W3MAIN|W4GAPNET(MSDR,D,MSD)) S OK=1 Q .I 'OK S SUM="?" Q SUM ; ; RZN(VL1,VL2) ; I VL1-VL2>.4 Q 1 I VL1-VL2<-.4 Q 1 Q 0 ; MSDR(MSD) N OK S OK="" N GL S GL="^|$$^W3MAIN|W3MSDR" N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .I $D(@GL@(N,MSD)),$O(@GL@(N,MSD))'=""!($O(@GL@(N,MSD),-1)'="") S OK=N Q OK ; RSTG() ; Q 0 W4MNYALL W4MNYALL ; [ 21.06.23 05:00 ] [ 19.07.22 11:14 ] [ 05.07.22 11:31 ] N (JB,%ARG,%REM) N $ZT S $ZT="S zr=$R X ^ZT ZG "_$ZL_":SVER^%L1X" I $G(%ARG("SHOW"))=0 Q ; D ^%W1ARG ; S DT1=$$^%L1DC(MEDAT,3) S DT2=$$^%L1DC(ADDAT,3) ; W "
    ",! W "" W $$^%W1DICT("MNYALLREP",MEDAT_"<>"_ADDAT) W "",! W "

    ",! ; W "",! W "",! I '$G(%ARG("SORT")) D .W "",! .W "",! I $G(%ARG("SORT")) D .W "",! .W "",! ; W "",! W "",! W "",! W "",! W "",! W "",! ; W "",! W "",! ; W "",! W "",! W "",! W "",! ; I $G(%ARG("RSTG")) D .W "",! .W "",! .W "",! .W "",! ; W "",! ; S GL="^[$$^W3MAIN]W4MNYALL" ; S (SPD1,SCR1,SPD2,SCR2,SPD3,SCR3,SCR4,SCA,SCAS,SCAJ)=0 S I=0 ; S DTOLD="" I '$G(%ARG("SORT")) D .F DT=DT1:1:DT2 D ..S MSD="" F S MSD=$O(@GL@(DT,MSD)) Q:MSD="" D ...I $G(%ARG("MSD")),MSD'=%ARG("MSD") Q ...D REPMSD(DT,MSD) ; I $G(%ARG("SORT")) D .N VRM .D GL2VRM .S MSD="" F S MSD=$O(@VRM@(MSD)) Q:MSD="" D ..I $G(%ARG("MSD")),MSD'=%ARG("MSD") Q ..F DT=DT1:1:DT2 D REPMSD(DT,MSD) ; W "",! D . W "" . W "" . W "" . W "" . W "" . W "" . W "" . W "" . . W "" . W "" . .W "" . .W "" . .W "" . .W "" . .I $G(%ARG("RSTG")) D .. W "" .. W "" ..;; W "" ..;; W "" ; W "'",! W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("ESEK")_""_$$^%W1DICT("ESEK")_""_$$^%W1DICT("DATE")_""_$$^%W1DICT("MANYREPPD")_""_$$^%W1DICT("ZREPPD")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("MANYREPCR")_""_$$^%W1DICT("ZREPCR")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("NETSALES")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("CA")_""_$$^%W1DICT("SENDED")_""_$$^%W1DICT("CAJ")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("RSTGPD")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("RSTGCR")_""_$$^%W1DICT("DIF")_"
    " . W " " . W "" . W " " . W "" . W $J(SPD1,2,2) . W "" . W $J(SPD2,2,2) . W "" . W $$DIF(SPD2-SPD1) . W "" . W $J(SCR1,2,2) . W "" . W $J(SCR2,2,2) . W "" . W $$DIF(SCR2-SCR1) . W "" . W $J(SCR4,2,2) . W "" . W $$DIF(SCR4-SCR1) . W "" . W $J(SCA,2,2) .W "" . W $J(SCAS,2,2) .W "" . W $J(SCAJ,2,2) .W "" . W $$DIF(SCAS+SCAJ-SCA) .W "" .. W $J(SPD3,2,2) .. W "" .. W $$DIF(SPD3-SPD1) .. W "" ..;; W $J(SCR3,2,2) ..;; W "" ..;; W $$DIF(SCR3-SCR1) ..;; W "
    ",! W "
    ",! Q ; ; DIF(VL) ; N ST S ST="0:"green",VL<0:"red",1:"grey")_""">" S ST=ST_$J(VL,1,1) S ST=ST_"" Q ST ; MEDAT(DT) ; N DD S DD=+$ZD(DT,"DD") N MM S MM=+$ZD(DT,"MM") N YY S YY=$ZD(DT,"YY") I DD=1 Q "01."_$S(MM=1:12,1:$$DOP^%L1FRM(MM-1))_"."_$S(MM=1:$$DOP^%L1FRM(YY-1),1:YY) Q "01."_$$DOP^%L1FRM(MM)_"."_YY ; ADDAT(DT) ; Q $ZD(DT-1,"DD.MM.YY") ; GAPNET(DT,MSD) ; N MSDR,SUM S SUM=0 S MSDR="" F S MSDR=$O(^|$$^W3MAIN|W4GAPNET(MSDR)) Q:MSDR="" D Q:SUM .I $D(^(MSDR,DT,MSD)) D ..S SUM=$P($G(^(MSD)),",",4) ; I 'SUM D .N OK S OK=0 .S MSDR="" F S MSDR=$O(^|$$^W3MAIN|W4GAPNET(MSDR)) Q:MSDR="" D Q:SUM ..I $G(DT1),$G(DT2) D ...N D F D=DT1:1:DT2 I $D(^|$$^W3MAIN|W4GAPNET(MSDR,D,MSD)) S OK=1 Q .I 'OK S SUM="?" Q SUM ; ; RZN(VL1,VL2) ; I VL1-VL2>.4 Q 1 I VL1-VL2<-.4 Q 1 Q 0 ; MSDRREP(MSD) N OK S OK="" N GL S GL="^|$$^W3MAIN|W3MSDR" N N S N="" F S N=$O(@GL@(N)) Q:N="" D Q:OK .I $D(@GL@(N,MSD)),$O(@GL@(N,MSD))'=""!($O(@GL@(N,MSD),-1)'="") S OK=N Q OK ; ; REPMSD(DT,MSD) ; N MSDRREP,A S MSDRREP=$$MSDRREP(MSD) I $G(%ARG("MSDR")),MSDRREP'=%ARG("MSDR") Q I $D(^[$$^W3MAIN]W4MNYNO(MSD)),$$^%L1DC($G(^[$$^W3MAIN]W4MNYNO(MSD)),3)
    " I '$G(%ARG("SORT")) D TDDAT,TDMSD I $G(%ARG("SORT")) D TDMSD,TDDAT ; W "" W $J(PD1,2,2) S SPD1=SPD1+PD1 W "" W "" W $J(PD2,2,2) S SPD2=SPD2+PD2 W "" W "" W $$DIF(PD2-PD1) W "" W "" W $J(CR1,2,2) S SCR1=SCR1+CR1 W "" W "" W $J(CR2,2,2) S SCR2=SCR2+CR2 W "" W "" W $$DIF(CR2-CR1) W "" W "" W $J(CR4,2,2) S SCR4=SCR4+CR4 W "" W "" W $$DIF(CR4-PD1-CR1) W "" ;;W "" ;; W $J(CR3,2,2) S SCR3=SCR3+CR3 ;;W "" ;;W "" ;; W $$DIF(CR3-CR1) ;;W "" W "" W $J(CA,2,2) S SCA=SCA+CA W "" W "" W $J(CAS,2,2) S SCAS=SCAS+CAS W "" W "" W $J(CAJ,2,2) S SCAJ=SCAJ+CAJ W "" W "" W $$DIF(CAS+CAJ-CA) W "" Q ; GL2VRM ; S VRM=$$^W4MAIN("VRM") N GL S GL="^[$$^W3MAIN]W4MNYALL" N DT,MSD K @VRM F DT=DT1:1:DT2 Q:DT="" D .S MSD="" F S MSD=$O(@GL@(DT,MSD)) Q:MSD="" D ..S @VRM@(MSD,DT)="" Q ; TDDAT ; W "" I '$G(%ARG("SORT")) D .I DT'=DTOLD W $ZD(DT,"DD.MM.YY") S DTOLD=DT .I DT=DTOLD W " " ; I $G(%ARG("SORT")) D .W $ZD(DT,"DD.MM.YY") W "" Q ; ; TDMSD ; W "" W MSD_" "_$$H2U^%L1FRM($$MSD^W3R(MSD)) W "" W4MNYHSV W4MNYHSV(DAT) ; [ 08.07.24 08:14 ] [ 03.07.22 09:10 ] [ 01.07.22 15:37 ] N (JB,%ARG,%REM,DAT) S DT=$$^%L1DC(DAT,3) S DAT1=$ZD(DT,"DD.MM.YY") S DAT=$ZD(DT,"YYMMDD") ; D ^W4SUMZRO D ^W4SUM ; S RESTSUM=$G(SUMMSD) S DLVSUM=$G(SUMMSL) S TAWSUM=$G(SUMDLP)+$G(SUMTAW) ; S CREDSUM=$G(SUMAMSD)+$G(SUMAMSL)+$G(SUMADLP)+$G(SUMATAW) ; S PD1=$$PD($$^W4GL("TOT")_"("""_DAT_""")") S CR1=$G(@$$^W4GL("TOT")@(DAT,"H",1)) S CA=$G(@$$^W4GL("TOT")@(DAT,"V",1)) ; S PD2=0,CR2=0 S NZ="" F S NZ=$O(@$$^W4GL("Z1")@(DAT,NZ)) Q:NZ="" D .S PD2=PD2+$$PD($$^W4GL("Z1")_"("""_DAT_""","""_NZ_""")") .S CR2=CR2+$G(@$$^W4GL("Z1")@(DAT,NZ,"H",1)) ; S FILE=$$FILEIN^W4RSTGSN(DT,"deps") S PD3=0,CD3=0 ; I $$^%L1ZOS(10,FILE)>-1 D .O FILE:(REWIND:READONLY) U FILE . .I '$$RSTGNEW D ..N A F R A Q:$ZEOF D ...I A["register" S PD3=+$$SPA^%L1FRM($P(A,":",2)) ...I A["credit" S CR3=+$$SPA^%L1FRM($P(A,":",2)) . .I $$RSTGNEW D ..N A F U FILE R A Q:$ZEOF D ...I $TR(A," ","")["shiftType"":""shiftID" D ....N A1 F U FILE R A1 Q:$ZEOF Q:A1["{" Q:A1["}" D .....;;U 0 W A1,! .....I A1["totalCharged" S PD3=PD3+$$SPA^%L1FRM($P(A1,":",2)) .....I A1["totalRefunded" S PD3=PD3+$$SPA^%L1FRM($P(A1,":",2)) .....;;U 0 W "PD3="_PD3,! . .C FILE ; S CAS=$$^W4SUMV(DT,DT) S CAJ=$$^W4SUMVJ(DT,DT) S @$$^W4GL("W4MNYPR")@($$IND,DT)=PD1_"\"_CR1_"\"_PD2_"\"_CR2_"\"_$G(PD3)_"\"_$G(CR3)_"\"_CA_"\"_CAS_"\"_CAJ Q ; ; PD(GL) ; N N,Z S N="" F S N=$O(@GL@(N)) Q:N="" D .S Z(N)=$G(^(N,1)) ; S Z("V")=0 F J=1:1:9 S Z("V")=Z("V")+$G(@("Z(""V"_J_""")")) S Z("A")=$G(Z("F"))+$G(Z("G"))+$G(Z("V"))+$G(Z("MP")) ; I '$$^W4TIPPD(N) D .S Z("A")=Z("A")-$G(Z("T")) Q Z("A") ; IND(STAM) ; N IND S IND=$G(@$$^W4PRM@("WEB","MSD")) I 'IND,$$BRANCH^W4RSTGSN S IND="R"_$$BRANCH^W4RSTGSN I IND="" S IND=0 Q IND ; RSTGNEW() ; I $G(@$$^W4PRM@("RSTGNEW")) Q 1 Q 0 W4MNYNEW W4MNYNEW(JB,DT1,DT2) ; [ 24.01.22 16:11 ] [ 22.11.21 13:21 ] [ 24.01.21 11:40 ] N (JB,%ARG,%REM,DT1,DT2) S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) ; F DT=DT1:1:DT2 D .D MNY(DT) Q ; W4MNYREP W4MNYREP ; [ 08.07.24 11:21 ] [ 29.12.22 09:14 ] [ 03.07.22 09:45 ] N (JB,%ARG,%REM) D ^%W1ARG ; I $G(%ARG("SHOW"))'=1 Q ; S DT1=$$^%L1DC(MEDAT,3) S DT2=$$^%L1DC(ADDAT,3) ; W "
    ",! W "" W $$^%W1DICT("MNYREPORT",MEDAT_"<>"_ADDAT) W "",! W "

    ",! ; W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! W "",! ; W "",! W "",! ; W "",! W "",! I '$$RSTGNEW D .W "",! .W "",! ; W "",! W "",! W "",! W "",! W "",! ; S GL=$$^W4GL("W4MNYPR")_"("""_$$IND^W4MNYHSV_""")" ; S (SPD1,SCR1,SPD2,SCR2,SPD3,SCR3,SCA,SCAS,SCAJ)=0 ; F DT=DT1:1:DT2 D .W "" . S A=$G(@GL@(DT)) . D PRS^%L1FRM(A,"PD1\CR1\PD2\CR2\PD3\CR3\CA\CAS\CAJ","\") . W "" . W "" . W "" . W "" . . W "" . W "" . W "" . . W "" . W "" . . W "" . W "" .I '$$RSTGNEW D .. W "" .. W "" . .W "" . .W "" . .W "" . .W "" .W "",! ; W "",! D . W "" . W "" . W "" . W "" . . W "" . W "" . W "" . . W "" . W "" . . W "" . W "" .. W "" .. W "" . .W "" . .W "" . .W "" . .W "" .W "",! ; W "'",! Q ; ; SHOWZ(DT) ; N ST S ST="onClick=""ShowZ('"_$ZD(DT,"DD.MM.YY")_"')"" " Q ST ; DIF(VL) ; N ST S ST="0:"green",VL<0:"red",1:"grey")_""">" S ST=ST_$J(VL,1,1) S ST=ST_"" Q ST ; RSTGNEW() ; Q $$RSTGNEW^W4MNYHSV ; ; COMP(DAT1,DAT2,JB) ; N DT,DT1,DT2 S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) ; F DT=DT1:1:DT2 D .D ^W4MNYHSV(DT) .D PUT^%W1PRM("COMPDAT",$ZD(DT,"DD.MM.YY")) ; D PUT^%W1PRM("W4MNYREP",1) Q W4MNYSN W4MNYSN(JB,DT1,DT2) ; [ 23.06.23 14:46 ] [ 22.11.21 13:21 ] [ 24.01.21 11:40 ] N (JB,%ARG,%REM,DT1,DT2) S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) ; N FL,GLOB,ADDR,ZSY S ZSY=0 S WEBMSD=$G(@$$^W4PRM@("WEB","MSD")) Q:'WEBMSD S DIR="/tmp/" S URL=$$OU^W3ASKURL_"w3ansmny.jsp?" S PRM="MSD="_WEBMSD ; F DT=DT1:1:DT2 D .D ^W4MNYHSV(DT) .S FL=DIR_"tmpmny" .I $D(@$$^W4GL("W4MNYPR")@(WEBMSD,DT))#2 D ..S CONT=DT_"\"_@$$^W4GL("W4MNYPR")@(WEBMSD,DT) ..D SEND^W3ASKFD1(FL,URL,PRM,CONT) ; .; Q W4MNYZ W4MNYZ ; [ 05.10.23 09:46 ] [ 23.06.23 14:00 ] [ 14.05.23 14:48 ] I $G(JB)="" W "JB NOT DEFINED !" Q N MSDR,W3MSDR,TMP,TMPSN S MSDR=$G(%ARG("MSDR")) S W3MSDR="^|$$^W3MAIN|W3MSDR" I MSDR="" W "MSDR NOT DEFINED !" Q K %L1PC D ^%W1ARG S $ZT="S zr=$R X ^ZT ZG "_$ZL_":ERWB^%L1X" S %REPN="W4MNYZ" S %REPN("PRTN")=$$^%W1JB S %REPN("MSDR")=MSDR S TMPSN="^|$$^W3MAIN|TMPSN" K @TMPSN ; S N="" F S N=$O(@W3MSDR@(MSDR,N)) Q:N="" D .S @TMPSN@(N)=$$MSD^W3R(N) ; K @$$^%W1GLPRM S @$$^%W1GLPRM@("BEGIN")=1 S @$$^%W1GLPRM@("MSDR")=MSDR M @$$^%W1GLPRM@("REPN")=%REPN ; S MSDR=+$G(MSDR) ;;S TMP=$$^W4MAIN("TMP") K @TMP ;;M @TMP=^|$$^W3MAIN|W4MNYZ(MSDR) Q ; ; DAT ; S DAT=$ZD(DT,"DD.MM.YY") I DT<$G(MEDAT) S OK=0 Q I DT>$G(ADDAT) S OK=2 Q Q ; MSD ; N MSD1 S MSD1=$G(^|$$^W3MAIN|W3MSD(MSD)) N MSDR S MSDR=$G(@$$^%W1GLPRM@("MSDR")) I MSDR,'$D(^|$$^W3MAIN|W3MSDR(MSDR,MSD)) S OK=0 Q N A,DLM,PD S A=$G(@GLOB) S DLM="~",PD=0 N J F J=1:2:15 S PD=PD+$P(A,DLM,J) S x1=$J(PD,2,2) S x2=$$RKV($P(A,DLM,1)) ; -- CASH KUPA S x3=$$RKV($P(A,DLM,2)) ; -- CASH KABALOT S x4=$J(x2+x3,2,2) Q ; RKV(VL) ; Q VL ; --- 04/10/22 W4MOTH W4MOTH ; [ 11.08.15 12:48 ] [ W "
    ",! W "


    ",! W $$^%W1DICT("SIGNITEMS4OTH") W "


    ",! D ^W4SBMBCK("") W "
    ",! Q ; PUTDISC ; N TMPOTH S TMPOTH=$$^W4MAIN("TMPOTH") N N S N="" F S N=$O(@TMPOTH@(N)) Q:N="" I N D SETDISC(N) Q ; SETDISC(N) ; N VL S VL="100" S $P(@$$^W3TMPORD@(JB,N),"~",6)=VL D GETCAUSE^W4SCASK("DISCOTH","CAUSEDISC") S @$$^W4TMPORD@("HNH",N)=VL_"*"_WHO_"*"_SIBA_"*"_SIBA1_"*"_$H_"**"_$$^W4MYDVN Q ; W4MPCA W4MPCA(SUM) ; [ 29.04.16 12:42 ] [ 13.10.15 14:19 ] [ 12.10.15 17:17 ] [ N (JB,%ARG,SUM) ;;Q 1 ; S HZM=$$GETP^%W1PRM("HZM") I '$$^W4ISORD(HZM) Q 0 I $$ITRA^W4HZMST(HZM)'>0 Q 0 S VIZ=$$GET^W4TMPPAY(3,"CREDITCARDNUMBER") I 'VIZ Q 0 I '$G(@$$^WMG@("ONESWIPE")) Q 0 S OK=0 N N S N="" F S N=$O(@$$^WMCA@(N)) Q:N="" D Q:OK .I $E(VIZ,1,$L(N))=N S OK=1 Q OK W4MPCHZ W4MPCHZ ; [ 04.06.24 18:18 ] [ 11.01.24 13:08 ] [ 10.01.24 12:40 ] N (JB,%ARG,%REM) S DZ=$$^W4DZ S HZW=$$^%W1SsID("W4MPCHZ") K @$$^W3TMPORD@(HZW) S TMPORD1="^|$$^W3MAIN|TMPORD1(JB)" K @TMPORD1 S TMPORD2="^|$$^W3MAIN|TMPORD2(JB)" K @TMPORD2 ; N NZ S NZ=$G(@$$^W4GL("Z"))+1 I $G(@$$^W4GL("W4MPZ")@(DZ,NZ)) Q ; S N="" F S N=$O(@$$^W4REF@(DZ,N)) Q:N="" D .S A=$G(^(N)) .I A[",^" K @TMPORD1,@TMPORD2 .I $$HZM^W4MSD(N) Q .S N1="" F S N1=$O(@$$^W4ORD@(N,N1)) Q:N1="" I N1 D ..S ST=$G(^(N1)) Q:ST="" ..S CD=$P(ST,"\") Q:'CD ..S MH=$P(ST,"\",4) ..S QN=$P(ST,"\",5) ..I $$MP(CD) D CRCD(CD,0,QN,N,1) ..I $$COUP(CD) D CRCD(CD,0,QN,N,2) .. ..S N2="" S N2=$O(@$$^W4ORD@(N,N1,N2)) Q:N2="" I N2 D ...S STT=$G(^(N2)) ...I $$MP(N2)!$$COUP(N2) D ....S MHT=$P(STT,"\",2) ....S QNT=$P(STT,"\",3) ....I $$MP(N2) D CRCD(N2,1,QNT,N,1) ....I $$COUP(N2) D CRCD(N2,1,QNT,N,2) ; ; I $D(@TMPORD1)>9 D .K @$$^W3TMPORD@(HZW) .M @$$^W3TMPORD@(HZW)=@TMPORD1 K @TMPORD1 .S HZMS=$$^W4NEWHZ(HZW,-1,1) .I HZMS<1 Q .S @$$^W4GL("W4MPCHZ")@($$^W4DZ,"MP",HZMS)=$H .W "MP: "_HZMS,! ; *** . .S @$$^W4ORD@(HZMS,"ASR")=$$TSHL^W4HZMST(HZMS) .D ASR^W4TSAUTO(HZMS) ; I $D(@TMPORD2)>9 D .K @$$^W3TMPORD@(HZW) .M @$$^W3TMPORD@(HZW)=@TMPORD2 K @TMPORD2 .S HZMS=$$^W4NEWHZ(HZW,-1,1) .I HZMS<1 Q .S @$$^W4GL("W4MPCHZ")@($$^W4DZ,"CP",HZMS)=$H .W "CP: "_HZMS,! ; *** . .S @$$^W4ORD@(HZMS,"ASR")=$$TSHL^W4HZMST(HZMS) .D ASR^W4TSAUTO(HZMS) ; S @$$^W4GL("W4MPZ")@(DZ,NZ)=$H END K @$$^W3TMPORD@(HZW),@TMPORD1,@TMPORD2 Q ; ; CRCD(CD,LV,QN,HZMKR,PR) ; N (JB,CD,LV,MH,QN,HZMKR,PR,TMPORD1,TMPORD2) I PR=1 S TMPORD=TMPORD1 E S TMPORD=TMPORD2 ; I '$D(@TMPORD) D .S HD=$S(PR=1:$$MPTBL,1:$$COUPTBL) .S $P(HD,"~",4)=$ZD($H,"DD.MM.YY 24:60") .S $P(HD,"~",27)=$S(PR=1:$$MPLK,1:$$COUPLK) .S $P(HD,"~",18)=$G(@$$^W4PRM@("WEB","MKBL")) .S $P(HD,"~",21)=4 .S @TMPORD=HD ; S NM=$$SHEM^W4P(CD) S MH=$$MH^W4P(CD) S ST="0~"_CD_"~"_NM_"~"_MH_"~"_QN S CMST="" I $G(HZMKR) S CMST="FROM "_HZMKR I LV S CMST=CMST_" ["_LV_"]" S $P(ST,"~",7)=CMST S SH=$O(@TMPORD@(99999),-1)+1 S @TMPORD@(SH)=ST Q ; ; MP(CD) N SUG S SUG=$$SUG^W4P(CD) Q:SUG="" I SUG'=$$MPSUG Q 0 Q 1 ; MPSUG() ; Q 23 ; MPTBL() ; Q 999 ; MPLK() ; Q 9999 ; COUP(CD) N SUG S SUG=$$SUG^W4P(CD) Q:SUG="" I SUG'=$$COUPSUG Q 0 Q 1 ; COUPSUG() ; Q 52 ; COUPTBL() ; Q 998 ; COUPLK() ; Q 20015 W4MRK W4MRK ; [ 10.02.18 16:30 ] [ 07.02.18 12:29 ] [ 11.10.13 17:33 ] GET N GLOB,GLOB0 D GLOB^W4SPIDK N GLMRK D GLMRK N I S I=0 ; N N S N="" F S N=$O(@GLMRK@(N)) Q:N="" D .S @GLOB@(N)=$G(@GLMRK@(N)) .S $P(@GLOB@(N,1),"\",1)=$G(@GLMRK@(N,"MAIN")) .S $P(@GLOB@(N,1),"\",2)=$G(@GLMRK@(N,"IT")) .S $P(@GLOB@(N,1),"\",3)=$G(@GLMRK@(N,"GEO")) .S $P(@GLOB@(N,1),"\",4)=$G(@GLMRK@(N,"LKH")) Q ; ; SAVE ; N (JB,%ARG,PRM,%REM) D GLOB^W4SPIDK N GLMRK D GLMRK K @GLMRK N I S I=0 N N S N="" F S N=$O(@GLOB@(N)) Q:N="" D .S @GLMRK@(N)=$G(@GLOB@(N)) .S @GLMRK@(N,"MAIN")=$P($G(@GLOB@(N,1)),"\") .S @GLMRK@(N,"IT")=$P($G(@GLOB@(N,1)),"\",2) .S @GLMRK@(N,"GEO")=$P($G(@GLOB@(N,1)),"\",3) .S @GLMRK@(N,"LKH")=$P($G(@GLOB@(N,1)),"\",4) Q ; ; GL ; S GL=$$^W4MAIN("TMP") Q ; GLMRK ; S GLMRK=$$^W4GL("W4MRK") Q W4MRKDOH W4MRKDOH(DT1,DT2) ; [ 23.03.14 10:09 ] [ 22.03.14 14:38 ] [ 17.06.13 09:46 ] N (JB,%ARG,%REM,DT1,DT2) K @$$^W4MAIN("TMPMRK") ; F DT=DT1:1:DT2 D .K KAMSUM .S DAT=$$^%L1DC(DT,2) D ^W4SUM1O .;;W ?35,$$^%L1DC(DAT,1),! .M @$$^W4MAIN("TMPMRK")@(DT)=KAMSUM ; ; N MSD,VRM S VRM=$$^W4MAIN("VRM") ; I $$TOWEB D .L +@$$^W4GL("MRK2WEB"):2 .K @$$^W4GL("MRK2WEB") .K @VRM .S MSD=+@$$^W4PRM@("WEB","MSD") .S @VRM@("FL")="MRK2WEB" .S @VRM@("GLOB")=$$^W4GL("MRK2WEB") ; ; S MRK=$$^%L1MRK ; F DT=DT1:1:DT2 D .S DAT=$ZD(DT,"YYMMDD") .K @$$^W4GL("DOHMRK")@(DT,MRK) .M @$$^W4GL("DOHMRK")@(DT,MRK)=@$$^W4MAIN("TMPMRK")@(DT) .I $$TOWEB M @$$^W4GL("MRK2WEB")@(DT,MRK)=@$$^W4MAIN("TMPMRK")@(DT) ; I $$TOWEB D .L -@$$^W4GL("MRK2WEB") .S @VRM@("DOP")=MRK_"_"_$ZD(DT2,"YYMMDD") .K ^[$$^W3MAIN]P1WEB(MSD,"MRK2WEB") .M ^[$$^W3MAIN]P1WEB(MSD,"MRK2WEB")=@VRM .K @VRM ; Q ; TOWEB(STAM) ; Q $G(@$$^W4PRM@("TOWEB")) W4MRKEX W4MRKEX(%REPN,FMT) ; [ 14.06.16 07:09 ] [ 01.06.13 17:01 ] [ N (JB,%ARG,%REM,%REPN,FMT,TOT) D ^%L1TS S FMT=+$G(FMT) N DIR S DIR=$$DIRL^%W1PCEX N FL S FL=DIR_%REPN_$$^W4MYDVN I $G(TOT) S FL=FL_"S" S FLCSV=FL_"."_$$FMT^%W1PCEX(FMT) N A,B,I,J,RZD S RZD="*" C FLCSV:(DELETE) zsy "rm -f "_FLCSV O FLCSV:(REWIND:NEWVERSION:WRITE) U FLCSV ; S VRMEX=$$^W4MAIN("VRMEX") S N="" F S N=$O(@VRMEX@(N)) Q:N="" D W ! .S LAST=$O(@VRMEX@(N,9999),-1) .F J=1:1:LAST D ..S A=$G(^(J)) W $TR(A,TS0,TS1) I $O(@VRMEX@(N,J))'="" W "," ; C FLCSV ; Q W4MRKG W4MRKG ; [ 01.01.24 12:42 ] [ 09.06.22 07:45 ] [ 23.04.21 15:06 ] N (JB,%ARG,%REM) I $G(%ARG("MEDAT"))="" Q N $ZT S $ZT="S $ZGBLDIR=$$^W3MAIN ZG "_$ZL_":SVER^%L1X" S UCI=$$^W4GFUCI Q:UCI="" S $ZGBLDIR=UCI ; D ^W4GFILTR ; S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) I 'MEDT,'ADDT Q ; S SP="  " S RKZ=$G(%ARG("RKZ")) ; D FRMRKZ(MEDT,ADDT,RKZ) ; D MMRKZ($G(%ARG("MRKZ"))) S VRMEX=$$^W4MAIN("VRMEX") K @VRMEX ; S GLREP=$$GLREP W "
    ",! D PROT(MEDAT,ADDAT) W "
    ",! W "
    ",! ; S SH=0 W "
    ",! D DIVEXC($$GLOB) S SH=SH+1,COL=0 D W("") S COL=1 W "" D W($$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT) I RKZ D W(" ( "_$$^%W1DICT("CONCENTRATEDPERDATE")_" )") W "",! W "

    ",! W "
    "_$$^%W1DICT("DATE")_""_$$^%W1DICT("MANYREPPD")_""_$$^%W1DICT("ZREPPD")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("MANYREPCR")_""_$$^%W1DICT("ZREPCR")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("ALLSALES")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("RSTGPD")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("RSTGCR")_""_$$^%W1DICT("DIF")_""_$$^%W1DICT("CA")_""_$$^%W1DICT("SENDED")_""_$$^%W1DICT("CAJ")_""_$$^%W1DICT("DIF")_"
    " . W $ZD(DT,"DD.MM.YY") . W "" . W $J(PD1,2,2) S SPD1=SPD1+PD1 . W "" . W $J(PD2,2,2) S SPD2=SPD2+PD2 . W "" . W $$DIF(PD2-PD1) . W "" . W $J(CR1,2,2) S SCR1=SCR1+CR1 . W "" . W $J(CR2,2,2) S SCR2=SCR2+CR2 . W "" . W $$DIF(CR2-CR1) . W "" . W $J(PD1+CR1,2,2) . W "" . W $$DIF(PD2+CR2-PD1-CR1) . W "" . W $J(PD3,2,2) S SPD3=SPD3+PD3 . W "" . D . .I '$$RSTGNEW W $$DIF(PD3-PD1) Q . .I $$RSTGNEW W $$DIF(PD3+CR3-PD1-CR1) Q . W "" .. W $J(CR3,2,2) S SCR3=SCR3+CR3 .. W "" .. W $$DIF(CR3-CR1) .. W "" . W $J(CA,2,2) S SCA=SCA+CA .W "" . W $J(CAS,2,2) S SCAS=SCAS+CAS .W "" . W $J(CAJ,2,2) S SCAJ=SCAJ+CAJ .W "" . W $$DIF(CAS+CAJ-CA) .W "
    " . W " " . W "" . W $J(SPD1,2,2) . W "" . W $J(SPD2,2,2) . W "" . W $$DIF(SPD2-SPD1) . W "" . W $J(SCR1,2,2) . W "" . W $J(SCR2,2,2) . W "" . W $$DIF(SCR2-SCR1) . W "" . W $J(SPD1+SCR1,2,2) . W "" . W $$DIF(SPD2+SCR2-SPD1-SCR1) . W "" . W $J(SPD3,2,2) . W "" . D . .I '$$RSTGNEW W $$DIF(SPD3-SPD1) Q . .W $$DIF(SPD3-SPD1-SCR1) Q . .I '$$RSTGNEW D .. W "" .. W $J(SCR3,2,2) .. W "" .. W $$DIF(SCR3-SCR1) .. W "" . W $J(SCA,2,2) .W "" . W $J(SCAS,2,2) .W "" . W $J(SCAJ,2,2) .W "" . W $$DIF(SCAS+SCAJ-SCA) .W "
    ",! W "" S COL=0,SH=SH+1 I 'RKZ D .W "" ; W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" W "" ; S SH0=SH K TOT I 'RKZ D .F DT=MEDT:1:ADDT I $$IFDAY(DT) D LINE(DT) ; I RKZ D .D LINE("RKZ") ; I 'RKZ D PCLINE("TOTALL","TOT") ; W "
    " . D W($$^%W1DICT("DATE")) .W "" D W($$^%W1DICT("SNIF")) W "" D W($$^%W1DICT("TOTINCLUDETIPS")) W "" D W($$^%W1DICT("TOTWITHOUTTIPS")) W "" D W($$^%W1DICT("TOTRESTMORNING")) W "" D W($$^%W1DICT("TOTRESTEVENING")) W "" D W($$^%W1DICT("TOTREST")) W "" D W($$^%W1DICT("GUESTSMORNING")) W "" D W($$^%W1DICT("GUESTSEVENING")) W "" D W($$^%W1DICT("GUESTSTOTAL")) W "" D W($$^%W1DICT("AVMSDMORNING")) W "" D W($$^%W1DICT("AVMSDEVENING")) W "" D W($$^%W1DICT("AVRGREST")) W "" D W($$^%W1DICT("TOTDLVRY")) W "" D W($$^%W1DICT("DLVRYMORNING")) W "" D W($$^%W1DICT("DLVRYEVENING")) W "" D W($$^%W1DICT("TOTDLVRYWITHOUTTIPS")) W "" D W($$^%W1DICT("QNDLVRYMORNING")) W "" D W($$^%W1DICT("QNDLVRYEVENING")) W "" D W($$^%W1DICT("QNDLVRY")) W "" D W($$^%W1DICT("AVMSLMORNING")) W "" D W($$^%W1DICT("AVMSLEVENING")) W "" D W($$^%W1DICT("AVRGDLVRY")) W "" D W($$^%W1DICT("TOTTAWMORNING")) W "" D W($$^%W1DICT("TOTTAWEVENING")) W "" D W($$^%W1DICT("TOTTAW")) W "" D W($$^%W1DICT("AVRGTAWMORNING")) W "" D W($$^%W1DICT("AVRGTAWEVENING")) W "" D W($$^%W1DICT("AVRGTAW")) W "" D W($$^%W1DICT("QNTAMORNING")) W "" D W($$^%W1DICT("QNTAEVENING")) W "" D W($$^%W1DICT("QNTA")) W "
    ",! W "
    ",! ; D ^W4MRKEX($$GLOB) ; ;K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMEX") K @$$^W4MAIN("VRMPROT") ; END S $ZGBLDIR=$$^W3MAIN Q ; ; LINE(DT) ; I '$G(%ARG("SIK")) S N="" F S N=$O(MMRKZ(N)) Q:N="" D PCLINE(DT,N) D PCLINE(DT,"TOT") Q ; ; PCLINE(DT,N) ; N STR ;S STR="SUMALLT,SUMALL,SUMMSD,SUMMSD-1,SUMMSD-2," ;S STR=STR_"SSOAD,SSOAD-1,SSOAD-2,AVMSD,AVMSD-1,AVMSD-2," ;S STR=STR_"SUMMSLT,SUMMSL,SUMMSL-1,SUMMSL-2,KAMMSL,KAMMSL-1,KAMMSL-2,AVMSL,AVMSL-1,AVMSL-2," ;S STR=STR_"SUMDLP,SUMDLP-1,SUMDLP-2,AVDLP,AVDLP-1,AVDLP-2,KAMDLP,KAMDLP-1,KAMDLP-2" ; S STR="SUMALLT,SUMALL,SUMMSD-1,SUMMSD-2,SUMMSD," S STR=STR_"SSOAD-1,SSOAD-2,SSOAD,AVMSD-1,AVMSD-2,AVMSD," S STR=STR_"SUMMSLT,SUMMSL-1,SUMMSL-2,SUMMSL,KAMMSL-1,KAMMSL-2,KAMMSL,AVMSL-1,AVMSL-2,AVMSL," S STR=STR_"SUMDLP-1,SUMDLP-2,SUMDLP,AVDLP-1,AVDLP-2,AVDLP,KAMDLP-1,KAMDLP-2,KAMDLP" ; W "" S COL=0,SH=SH+1 I DT D WDAT(DT) ; I DT="TOTALL" D . W "" . W " " . W "" ; W "" D .I N'["TOT" D W(N_" "_$$H2U^%L1FRM(MMRKZ(N))) Q .I DT="TOTALL" D W($$^%W1DICT("TOTALL")) Q .D W($$^%W1DICT("TOTAL")) W "" I DT'="TOTALL" D .F JJ=1:1:$L(STR,",") S PKIND=$P(STR,",",JJ) D .. S IND=0 I PKIND["-" S IND=$P(PKIND,"-",2),PKIND=$P(PKIND,"-") .. W "" .. N SUM S SUM=$$J($$SUM(PKIND,N,DT,IND),PKIND) .. D W(SUM) .. I N="TOT" D .. .S TOT(PKIND,IND)=$G(TOT(PKIND,IND))+SUM .. W "" .W "" ; I DT="TOTALL" D .N A .F JJ=1:1:$L(STR,",") S PKIND=$P(STR,",",JJ) D .. S IND=0 I PKIND["-" S IND=$P(PKIND,"-",2),PKIND=$P(PKIND,"-") .. W "" .. S A=$G(TOT(PKIND,IND)) .. I PKIND="AVMSD" D ... N SSOAD S SSOAD=$G(TOT("SSOAD",IND)) Q:'SSOAD ... S A=$J($G(TOT("SUMMSD",IND))/SSOAD,2,2) .. .. I PKIND="AVMSL" D ... N SSOAD S SSOAD=$G(TOT("KAMMSL",IND)) Q:'SSOAD ... S A=$J($G(TOT("SUMMSL",IND))/SSOAD,2,2) .. .. I PKIND="AVDLP" D ... N SSOAD S SSOAD=$G(TOT("KAMDLP",IND)) Q:'SSOAD ... S A=$J($G(TOT("SUMDLP",IND))/SSOAD,2,2) .. .. I A="" S A=" " .. I A'="" S A=$$J(A,PKIND) .. W A,! .. W "" .W "" ; Q ; SUM(PKIND,N,DT,J) ; S:'$G(J) J=3 N A,VRM S VRM=$$^W4MAIN("VRM") I DT'="RKZ" S VRM=$E(VRM,1,$L(VRM)-1)_",DT)" S A=$G(@VRM@(N,PKIND,J)) ; I N="TOT",PKIND="AVMSD" D .N SSOAD S SSOAD=$G(@VRM@(N,"SSOAD",J)) Q:'SSOAD .S A=$J($G(@VRM@(N,"SUMMSD",J))/SSOAD,2,2) I N="TOT",PKIND="AVMSL" D .N SSOAD S SSOAD=$G(@VRM@(N,"KAMMSL",J)) Q:'SSOAD .S A=$J($G(@VRM@(N,"SUMMSL",J))/SSOAD,2,2) I N="TOT",PKIND="AVDLP" D .N SSOAD S SSOAD=$G(@VRM@(N,"KAMDLP",J)) Q:'SSOAD .S A=$J($G(@VRM@(N,"SUMDLP",J))/SSOAD,2,2) I A="" S A=" " I A=0!A,$E(PKIND,1,3)'="KAM",PKIND'["SSOAD" S A=$J(A,2,2) Q A ; MMRKZ(ARGM) ; K MMRKZ N MSDR N MSDR S MSDR=$G(ARGM) I 'MSDR,$G(%ARG("MSDR")) S MSDR=%ARG("MSDR") I 'MSDR S MSDR=$$GETP^%W1PRM("MSDR") ; N GL S GL="^|$$^W3MAIN|W3MSDR" ; I MSDR,$D(@GL@(MSDR)) D Q .N N,K S N="",K=0 F S N=$O(@GL@(MSDR,N)) Q:N="" I $G(^(N)) D ..I $D(NETSEND),$G(^(N,"NOSEND")) Q ..S MMRKZ(N)=$$NAME^W3MSD(N) ; S MMRKZ(+$$^%L1MRK)=$$^%L1HEAD Q ; ; COLMRK(MSDR) N GL S GL="^|$$^W3MAIN|W3MSDR" N K S K=0 I $G(MSDR),$D(@GL@(MSDR)) D .N N S N="" F S N=$O(@GL@(MSDR,N)) Q:N="" I $G(^(N)) S K=K+1 Q K ; FRMRKZ(MEDT,ADDT,RKZ) ; N DT,MRKZ N VRM S VRM=$$^W4MAIN("VRM") K @VRM N DOCH S DOCH=$$GLREP I '$G(RKZ) S VRM=$$BG^W4MAIN("VRM")_"DT)" ; F DT=MEDT:1:ADDT D .I '$$IFDAY(DT) Q .S MRKZ="" F S MRKZ=$O(@DOCH@(DT,MRKZ)) Q:MRKZ="" I MRKZ?1N.N D ..S VD="" F S VD=$O(@DOCH@(DT,MRKZ,VD)) Q:VD="" I VD'="SUMALL" D ...D VRMADD(DT,MRKZ,VD) .. ..D SETVRM(MRKZ) . D MMRKZ($G(%ARG("MRKZ"))) I $G(RKZ) S MRKZ="" F S MRKZ=$O(MMRKZ(MRKZ)) Q:MRKZ="" I MRKZ?1N.N D TOT(MRKZ) ; D SETVRM("TOT") Q ; VRMADD(DT,MRKZ,VD) ; Q:'DT I VD["SUMALL"!(VD="SUMMSLT")!($E(VD,1,2)="AV") Q S @VRM@(MRKZ,VD,1)=$G(@VRM@(MRKZ,VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) S @VRM@(MRKZ,VD,2)=$G(@VRM@(MRKZ,VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) S @VRM@(MRKZ,VD,3)=$G(@VRM@(MRKZ,VD,1))+$G(@VRM@(MRKZ,VD,2)) ; S @VRM@("TOT",VD,1)=$G(@VRM@("TOT",VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) S @VRM@("TOT",VD,2)=$G(@VRM@("TOT",VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) S @VRM@("TOT",VD,3)=$G(@VRM@("TOT",VD,1))+$G(@VRM@("TOT",VD,2)) Q ; ; SETVRM(MRKZ) ; S SSOAD1=$G(@VRM@(MRKZ,"SSOAD",1)) S SSOAD2=$G(@VRM@(MRKZ,"SSOAD",2)) S SSOAD3=SSOAD1+SSOAD2 ; I MRKZ'="TOT" D .S @VRM@(MRKZ,"SUMALL",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))+$G(@VRM@(MRKZ,"SUMMSL",1))+$G(@VRM@(MRKZ,"SUMDLP",1)),2,2) .S @VRM@(MRKZ,"SUMALL",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))+$G(@VRM@(MRKZ,"SUMMSL",2))+$G(@VRM@(MRKZ,"SUMDLP",2)),2,2) .S @VRM@(MRKZ,"SUMALL",3)=$J(@VRM@(MRKZ,"SUMALL",1)+@VRM@(MRKZ,"SUMALL",2),2,2) . .S @VRM@(MRKZ,"SUMALLT",1)=$G(@VRM@(MRKZ,"SUMALL",1))+$$TIP(MRKZ,1)+$$DMSH(MRKZ,1) .S @VRM@(MRKZ,"SUMALLT",2)=$G(@VRM@(MRKZ,"SUMALL",2))+$$TIP(MRKZ,2)+$$DMSH(MRKZ,2) .S @VRM@(MRKZ,"SUMALLT",3)=$G(@VRM@(MRKZ,"SUMALLT",1))+$G(@VRM@(MRKZ,"SUMALLT",2)) . .S @VRM@(MRKZ,"SUMMSLT",1)=$G(@VRM@(MRKZ,"SUMMSL",1))+$$DMSH(MRKZ,1)+$$TIPMSL(MRKZ,1) .S @VRM@(MRKZ,"SUMMSLT",2)=$G(@VRM@(MRKZ,"SUMMSL",2))+$$DMSH(MRKZ,2)+$$TIPMSL(MRKZ,2) .S @VRM@(MRKZ,"SUMMSLT",3)=$G(@VRM@(MRKZ,"SUMMSLT",1))+$G(@VRM@(MRKZ,"SUMMSLT",2)) .; .I '$G(RKZ) D TOT(MRKZ) ; S @VRM@(MRKZ,"AVMSD",1)=" " S @VRM@(MRKZ,"AVMSD",2)=" " S @VRM@(MRKZ,"AVMSD",3)=" " I SSOAD1 D .S @VRM@(MRKZ,"AVMSD",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))/SSOAD1,2,2) I SSOAD2 D .S @VRM@(MRKZ,"AVMSD",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))/SSOAD2,2,2) I SSOAD3 D .S @VRM@(MRKZ,"AVMSD",3)=$J($G(@VRM@(MRKZ,"SUMMSD",3))/SSOAD3,2,2) ; S MSL1=$G(@VRM@(MRKZ,"KAMMSL",1)) S MSL2=$G(@VRM@(MRKZ,"KAMMSL",2)) S MSL3=MSL1+MSL2 ; S @VRM@(MRKZ,"AVMSL",1)=" " S @VRM@(MRKZ,"AVMSL",2)=" " S @VRM@(MRKZ,"AVMSL",3)=" " ; I MSL1 D .S @VRM@(MRKZ,"AVMSL",1)=$J($G(@VRM@(MRKZ,"SUMMSL",1))/MSL1,2,2) I MSL2 D .S @VRM@(MRKZ,"AVMSL",2)=$J($G(@VRM@(MRKZ,"SUMMSL",2))/MSL2,2,2) I MSL3 D .S @VRM@(MRKZ,"AVMSL",3)=$J($G(@VRM@(MRKZ,"SUMMSL",3))/MSL3,2,2) ; S DLP1=$G(@VRM@(MRKZ,"KAMDLP",1)) S DLP2=$G(@VRM@(MRKZ,"KAMDLP",2)) S DLP3=DLP1+DLP2 ; S @VRM@(MRKZ,"AVDLP",1)=" " S @VRM@(MRKZ,"AVDLP",2)=" " S @VRM@(MRKZ,"AVDLP",3)=" " ; I DLP1 D .S @VRM@(MRKZ,"AVDLP",1)=$J($G(@VRM@(MRKZ,"SUMDLP",1))/DLP1,2,2) I DLP2 D .S @VRM@(MRKZ,"AVDLP",2)=$J($G(@VRM@(MRKZ,"SUMDLP",2))/DLP2,2,2) I DLP3 D .S @VRM@(MRKZ,"AVDLP",3)=$J($G(@VRM@(MRKZ,"SUMDLP",3))/DLP3,2,2) Q ; ; INIT ; D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) Q ; W(TXT,DR) ; I TXT="" S TXT=" " I TXT,$G(DR) S TXT=$J(TXT,DR,DR) I '$$NUM(TXT,$G(DR)) W TXT,! S COL=$G(COL)+1 N TXT1 S TXT1=$$RPL^%L1FRM(TXT," "," ") I '$$NUM(TXT,$G(DR)) S TXT1=$$U2H^%L1FRM(TXT1) S @VRMEX@(SH,COL)=TXT1 I $$NUM(TXT,$G(DR)) D .I +TXT=0 W ""_TXT_"",! Q .I TXT<0 W ""_TXT_"",! Q .W TXT Q ; NUM(TXT,DR) ; I TXT?."-"1N.N.".".N Q 1 I $G(DR) Q 1 Q 0 ; SHCOL(IND) ; S SH=SH0+J-1 S COL='RKZ+IND+1 Q ; DIVEXC(COD) ; W "
    ",! N FLCSV,FLTXT,DIR,FL S DIR=$$DIRWEB^%W1PCEX S FL=COD_$$^W4MYDVN S FLCSV=DIR_FL_".csv" ; W "" W "" W "" W "",! W "
    ",! W " "_FL_".csv",! W "
    ",! ; W "
    ",! Q ; GLOB(STAM) ; I $$^W4NETM Q "MRK2WEB" Q "DOHMRK" ; GLREP(STAM) ; Q "^"_$$GLOB ; PROT(MEDAT,ADDAT) ; N N,DT,MEDT,ADDT S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) S VRMPROT=$$^W4MAIN("VRMPROT") K @VRMPROT D MMRKZ($G(%ARG("MRKZ"))) ; F DT=MEDT:1:ADDT I $$IFDAY(DT) D .S N="" F S N=$O(MMRKZ(N)) Q:N="" D ..I '$D(@$$GLREP@(DT,N)) D ...S @VRMPROT@(DT,N)="" ; I $D(@VRMPROT) D .W "
    ",! . W "" . W $$^%W1DICT("NODATAPROTOCOL")_" "_$$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT . W "" . W "

    ",! . W "",! . W "",! . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . .W "",! . S DT="" F S DT=$O(@VRMPROT@(DT)) Q:DT="" D . .W "" . . W "",! . . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . .W "" . .W "",! . W "
    "_$$^%W1DICT("DATE")_""_N_" "_$$H2U^%L1FRM(MMRKZ(N))_"
    "_$$^%L1DC(DT,1)_" " . . . D . . ..I $D(@VRMPROT@(DT,N)) W "-",! Q . . ..W "+",! Q . . .W "
    ",! .W "
    ",! Q ; TIP(MRKZ,IND) ; Q $$TIPMSD(MRKZ,IND)+$$TIPMSL(MRKZ,IND)+$$TIPDLP(MRKZ,IND) ; TIPMSD(MRKZ,IND) ; Q $G(@VRM@(MRKZ,"TIPMSD",IND)) ; TIPMSL(MRKZ,IND) ; Q $G(@VRM@(MRKZ,"TIPMSL",IND)) ; TIPDLP(MRKZ,IND) ; Q $G(@VRM@(MRKZ,"TIPDLP",IND)) ; DMSH(MRKZ,IND) ; Q $G(@VRM@(MRKZ,"DMSH",IND)) ; ; TOT(MRKZ) ; ;W "MRKZ="_MRKZ_" SUMALL1="_$G(@VRM@(MRKZ,"SUMALL",1)),! S @VRM@("TOT","SUMALL",1)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@(MRKZ,"SUMALL",1)) ;W "TOT1="_@VRM@("TOT","SUMALL",1),! ;W "MRKZ="_MRKZ_" SUMALL2="_$G(@VRM@(MRKZ,"SUMALL",2)),! S @VRM@("TOT","SUMALL",2)=$G(@VRM@("TOT","SUMALL",2))+$G(@VRM@(MRKZ,"SUMALL",2)) ;W "TOT2="_@VRM@("TOT","SUMALL",2),! S @VRM@("TOT","SUMALL",3)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@("TOT","SUMALL",2)) ; S @VRM@("TOT","SUMALLT",1)=$G(@VRM@("TOT","SUMALLT",1))+$G(@VRM@(MRKZ,"SUMALLT",1)) S @VRM@("TOT","SUMALLT",2)=$G(@VRM@("TOT","SUMALLT",2))+$G(@VRM@(MRKZ,"SUMALLT",2)) S @VRM@("TOT","SUMALLT",3)=$G(@VRM@("TOT","SUMALLT",1))+$G(@VRM@("TOT","SUMALLT",2)) ; S @VRM@("TOT","SUMMSLT",1)=$G(@VRM@("TOT","SUMMSLT",1))+$G(@VRM@(MRKZ,"SUMMSLT",1)) S @VRM@("TOT","SUMMSLT",2)=$G(@VRM@("TOT","SUMMSLT",2))+$G(@VRM@(MRKZ,"SUMMSLT",2)) S @VRM@("TOT","SUMMSLT",3)=$G(@VRM@("TOT","SUMMSLT",1))+$G(@VRM@("TOT","SUMMSLT",2)) Q ; IFDAY(DT) N DD S DD=$$^%L1DC(DT,8) I $G(%ARG("DAYS")),%ARG("DAYS")'[DD Q 0 Q 1 ; J(RKV,PKIND) ; Q $J(RKV,$S(PKIND["SSOAD"!(PKIND["KAM"):"",1:2)) ; WDAT(DT) ; W "" D W($$^%L1DC(DT,1)_" "_$$H2U^%L1FRM($$^%L1DC(DT,9))) W "" Q ; TDLTR ; W "" Q W4MRKM W4MRKM ; [ 05.02.19 04:13 ] [ 31.05.17 04:50 ] [ 23.03.14 14:09 ] N (JB,%ARG,%REM) N $ZT S $ZT="S $ZGBLDIR=$$^W3MAIN ZG "_$ZL_":SVER^%L1X" ; I $$^W4NETM D .S UCI=$$^W4GFUCI Q:UCI="" .S $ZGBLDIR=UCI ; S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) S MEDT=$$^%L1DC(MEDAT,3) Q:'MEDT S ADDT=$$^%L1DC(ADDAT,3) I 'MEDT,'ADDT Q ; I '$$^W4NETM D ^W4MRKDOH(MEDT,ADDT) ; S %ARG("NOSIK")=1 S %ARG("NOMRK")=1 ;;D ^W4GFILTR ; S SP="  " S RKZ=$G(%ARG("RKZ")) ; D FRMRKZ(MEDT,ADDT,RKZ) ; D MMRKZ("") S VRMEX=$$^W4MAIN("VRMEX") K @VRMEX ; S GLREP=$$GLREP D PROT(MEDAT,ADDAT) ;;W "
    ",! ; S SH=0 W "
    ",! D DIVEXC($$GLOB) S SH=SH+1,COL=0 D W("") S COL=1 W "" D W($$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT) I RKZ D W(" ( "_$$^%W1DICT("CONCENTRATEDPERDATE")_" )") W "",! W "

    " D ^W4GFILTR W "
    ",! W "",! W "" S COL=0,SH=SH+1 I 'RKZ D .W "" W "" D W("") W "" S N="" F S N=$O(MMRKZ(N)) Q:N="" D .S MRKZ1=MMRKZ(N) .W "",! W "",! W "" ; S SH0=SH I 'RKZ F DT=MEDT:1:ADDT D .I '$$IFDAY(DT) Q .D LINE(DT) ; I RKZ D .D LINE("RKZ") W "
    " . D W($$^%W1DICT("DATE")) .W "" D W("") W "" W "" . D W($S(N:N_" ",1:"")_$$H2U^%L1FRM(MRKZ1)) .W "" D W($$^%W1DICT("TOTAL")) W "
    ",! W "
    ",! ; K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMEX") K @$$^W4MAIN("VRMPROT") ; END I $$^W4NETM S $ZGBLDIR=$$^W3MAIN Q ; ; LINE(DT) ; F PKIND="SUMMSD","SUMDLP","SUMMSL","SUMALL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$PROFITKIND(PKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . W "" . . S K=K+1 . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . D TDLTR . . . D W($J($$SUM(PKIND,N,DT,J),2,2)) . . . W "" . . .W "",! . . W "
    ",! . . W "",! . . . W "" . S K=K+1 . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . D TDLTR . . D W($J($$SUM(PKIND,"TOT",DT,J),2,2)) . . W "" . .W "",! . W "
    ",! . W "",! ; ; F QKIND="SSOAD","KAMDLP","KAMMSL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$^%W1DICT(QKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . S K=K+1 . . W "" . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . D W($J($$SUM(QKIND,N,DT,J),0,0)) . . . W "
    ",! . . W "",! . S K=K+1 . W "" . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . W "" . .W "",! . W "
    " . . D W($J($$SUM(QKIND,"TOT",DT,J),0,0)) . . W "
    ",! . W "",! .W "",! ; F AKIND="AVMSD","AVDLP","AVMSL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$^%W1DICT(AKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . S K=K+1 . . W "" . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . S SUM=$$SUM(AKIND,N,DT,J) S:SUM="" SUM=" " . . . D TD(SUM) . . . D W(SUM) . . . W "" . . .W "",! . . W "
    ",! . . W "" . . S K=K+1 . W "" . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . S SUM=$$SUM(AKIND,"TOT",DT,J) . . D TD(SUM) . . D W(SUM) . . W "" . .W "",! . W "
    ",! . W "" . W "",! ; D ^W4MRKEX($$GLOB) ; Q ; ; PROFITKIND(KIND) ; Q $$^%W1DICT(KIND_"PROFIT") ; DAYTIME(J) ; I J=1 Q $$^%W1DICT("MORNING") I J=2 Q $$^%W1DICT("EVENING") I J=3 Q $$^%W1DICT("TOTAL") Q " " ; SUM(PKIND,N,DT,J) ; N A S A=$G(@$$^W4MAIN("VRM")@(DT,N,PKIND,J)) ;;I A W A,! H 1 I DT="RKZ" S A=$G(@$$^W4MAIN("VRM")@(N,PKIND,J)) Q A ; MMRKZ(MRKZ) D MMRKZ^W4MRKG($G(MRKZ)) Q ; FRMRKZ(MEDT,ADDT,RKZ) ; D FRMRKZ^W4MRKG(MEDT,ADDT,RKZ) Q ; INIT ; D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) Q ; W(TXT) ; D W^W4MRKG(TXT) Q ; SHCOL(IND) ; S SH=SH0+J-1 S COL='RKZ+IND+1 Q ; DIVEXC(COD) ; D DIVEXC^W4MRKG(COD) Q ; GLOB(STAM) ; I $$^W4NETM Q "MRK2WEB" Q "DOCH" ; GLREP(STAM) ; Q "^"_$$GLOB ; PROT(MEDAT,ADDAT) ; D PROT^W4MRKG(MEDAT,ADDAT) Q ; IFDAY(DT) ; Q $$IFDAY^W4MRKG(DT) ; WDAT(DT) ; D WDAT^W4MRKG(DT) Q ; TD(SUM) ; I $$NUM(SUM) D TDLTR Q W "" Q ; TDLTR ; W "" Q ; NUM(SUM) ; Q $$NUM^W4MRKG(SUM) W4MRKM0 W4MRKM ; [ 30.06.13 16:26 ] [ 26.06.13 14:51 ] [ 09.06.13 12:26 ] N (JB,%ARG,%REM) N $ZT S $ZT="S $ZGBLDIR=$$^W3MAIN ZG "_$ZL_":SVER^%L1X" S UCI=$$^W4GFUCI Q:UCI="" S $ZGBLDIR=UCI S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) S MEDT=$$^%L1DC(MEDAT,3) Q:'MEDT S ADDT=$$^%L1DC(ADDAT,3) I 'MEDT,'ADDT Q ; S %ARG("NOSIK")=1 S %ARG("NOMRK")=1 D ^W4GFILTR ; S SP="  " S RKZ=$G(%ARG("RKZ")) ; D FRMRKZ(MEDT,ADDT,RKZ) ; D MMRKZ("") S VRMEX=$$^W4MAIN("VRMEX") K @VRMEX ; S GLREP=$$GLREP D PROT(MEDAT,ADDAT) W "
    ",! ; S SH=0 W "
    ",! D DIVEXC("MRK2WEB") S SH=SH+1,COL=0 D W("") S COL=1 W "" D W($$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT) I RKZ D W(" ( "_$$^%W1DICT("CONCENTRATEDPERDATE")_" )") W "",! W "

    ",! W "",! W "" S COL=0,SH=SH+1 I 'RKZ D .W "" W "" D W("") W "" S N="" F S N=$O(MMRKZ(N)) Q:N="" D .S MRKZ1=MMRKZ(N) .W "",! W "",! W "" ; S SH0=SH I 'RKZ F DT=MEDT:1:ADDT D .I '$$IFDAY(DT) Q .D LINE(DT) ; I RKZ D .D LINE("RKZ") W "
    " . D W($$^%W1DICT("DATE")) .W "" D W("") W "" W "" . D W(N_" "_$$H2U^%L1FRM(MRKZ1)) .W "" D W($$^%W1DICT("TOTAL")) W "
    ",! W "
    ",! ; K @$$^W4MAIN("VRM") K @$$^W4MAIN("VRMEX") K @$$^W4MAIN("VRMPROT") ; END S $ZGBLDIR=$$^W3MAIN Q ; ; LINE(DT) ; F PKIND="SUMMSD","SUMDLP","SUMMSL","SUMALL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$PROFITKIND(PKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . W "" . . S K=K+1 . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . D W($J($$SUM(PKIND,N,DT,J),2,2)) . . . W "
    ",! . . W "",! . . . W "" . S K=K+1 . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . W "" . .W "",! . W "
    " . . D W($J($$SUM(PKIND,"TOT",DT,J),2,2)) . . W "
    ",! . W "",! ; ; F QKIND="SSOAD","KAMDLP","KAMMSL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$^%W1DICT(QKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . S K=K+1 . . W "" . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . D W($J($$SUM(QKIND,N,DT,J),0,0)) . . . W "
    ",! . . W "",! . S K=K+1 . W "" . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . W "" . .W "",! . W "
    " . . D W($J($$SUM(QKIND,"TOT",DT,J),0,0)) . . W "
    ",! . W "",! .W "",! ; F AKIND="AVMSD","AVDLP","AVMSL" D .S SH0=SH0+4,COL=0 .S SH=SH0 .W "" . I 'RKZ D WDAT(DT) . . W "" . D W($$^%W1DICT(AKIND)) . W "" . . W "" . W "",! . F J=1:1:3 D . .D SHCOL(0) . .W "",! . . W "" . .W "",! . W "
    " . . D W($$DAYTIME(J)) . . W "
    ",! . W "" . S K=0 . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . S K=K+1 . . W "" . . W "",! . . F J=1:1:3 D . . .D SHCOL(K) . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . S SUM=$$SUM(AKIND,N,DT,J) S:SUM="" SUM=" " . . . D W(SUM) . . . W "
    ",! . . W "" . . S K=K+1 . W "" . W "",! . F J=1:1:3 D . .D SHCOL(K) . .W "",! . . W "" . .W "",! . W "
    " . . S SUM=$$SUM(AKIND,"TOT",DT,J) . . D W(SUM) . . W "
    ",! . W "" . W "",! ; D ^W4MRKEX("MRK2WEB") ; Q ; ; PROFITKIND(KIND) ; Q $$^%W1DICT(KIND_"PROFIT") ; DAYTIME(J) ; I J=1 Q $$^%W1DICT("MORNING") I J=2 Q $$^%W1DICT("EVENING") I J=3 Q $$^%W1DICT("DAY") Q " " ; SUM(PKIND,N,DT,J) ; N A S A=$G(@$$^W4MAIN("VRM")@(DT,N,PKIND,J)) I DT="RKZ" S A=$G(@$$^W4MAIN("VRM")@(N,PKIND,J)) Q A ; MMRKZ(MRKZ) D MMRKZ^W4MRKG($G(MRKZ)) Q ; FRMRKZ(MEDT,ADDT,RKZ) ; D FRMRKZ^W4MRKG(MEDT,ADDT,RKZ) Q N DT,MRKZ N VRM S VRM=$$^W4MAIN("VRM") K @VRM N DOCH S DOCH=$$GLREP ;;M @VRM=@DOCH I '$G(RKZ) S VRM=$$BG^W4MAIN("VRM")_"DT)" ; F DT=MEDT:1:ADDT D .I '$$IFDAY(DT) Q .S MRKZ="" F S MRKZ=$O(@DOCH@(DT,MRKZ)) Q:MRKZ="" I MRKZ D ..S VD="" F S VD=$O(@DOCH@(DT,MRKZ,VD)) Q:VD="" I VD'="SUMALL" D ...S @VRM@(MRKZ,VD,1)=$G(@VRM@(MRKZ,VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) ...S @VRM@(MRKZ,VD,2)=$G(@VRM@(MRKZ,VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) ...S @VRM@(MRKZ,VD,3)=$G(@VRM@(MRKZ,VD,1))+$G(@VRM@(MRKZ,VD,2)) ...S @VRM@("TOT",VD,1)=$G(@VRM@("TOT",VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) ...S @VRM@("TOT",VD,2)=$G(@VRM@("TOT",VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) ...S @VRM@("TOT",VD,3)=$G(@VRM@("TOT",VD,1))+$G(@VRM@("TOT",VD,2)) .. ..D SETVRM(MRKZ) . D SETVRM("TOT") Q ; SETVRM(MRKZ) ; S SSOAD1=$G(@VRM@(MRKZ,"SSOAD",1)) S SSOAD2=$G(@VRM@(MRKZ,"SSOAD",2)) S SSOAD3=SSOAD1+SSOAD2 ; I MRKZ'="TOT" D .S @VRM@(MRKZ,"SUMALL",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))+$G(@VRM@(MRKZ,"SUMMSL",1))+$G(@VRM@(MRKZ,"SUMDLP",1)),2,2) .S @VRM@(MRKZ,"SUMALL",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))+$G(@VRM@(MRKZ,"SUMMSL",2))+$G(@VRM@(MRKZ,"SUMDLP",2)),2,2) .S @VRM@(MRKZ,"SUMALL",3)=$J(@VRM@(MRKZ,"SUMALL",1)+@VRM@(MRKZ,"SUMALL",2),2,2) .; .S @VRM@("TOT","SUMALL",1)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@(MRKZ,"SUMALL",1)) .S @VRM@("TOT","SUMALL",2)=$G(@VRM@("TOT","SUMALL",2))+$G(@VRM@(MRKZ,"SUMALL",2)) .S @VRM@("TOT","SUMALL",3)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@("TOT","SUMALL",2)) ; S @VRM@(MRKZ,"AVMSD",1)=" " S @VRM@(MRKZ,"AVMSD",2)=" " S @VRM@(MRKZ,"AVMSD",3)=" " I SSOAD1 D .S @VRM@(MRKZ,"AVMSD",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))/SSOAD1,2,2) I SSOAD2 D .S @VRM@(MRKZ,"AVMSD",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))/SSOAD2,2,2) I SSOAD3 D .S @VRM@(MRKZ,"AVMSD",3)=$J($G(@VRM@(MRKZ,"SUMMSD",3))/SSOAD3,2,2) ; S MSL1=$G(@VRM@(MRKZ,"KAMMSL",1)) S MSL2=$G(@VRM@(MRKZ,"KAMMSL",2)) S MSL3=MSL1+MSL2 S @VRM@(MRKZ,"AVMSL",1)=" " S @VRM@(MRKZ,"AVMSL",2)=" " S @VRM@(MRKZ,"AVMSL",3)=" " I MSL1 D .S @VRM@(MRKZ,"AVMSL",1)=$J($G(@VRM@(MRKZ,"SUMMSL",1))/MSL1,2,2) I MSL2 D .S @VRM@(MRKZ,"AVMSL",2)=$J($G(@VRM@(MRKZ,"SUMMSL",2))/MSL2,2,2) I MSL3 D .S @VRM@(MRKZ,"AVMSL",3)=$J($G(@VRM@(MRKZ,"SUMMSL",3))/MSL3,2,2) ; S DLP1=$G(@VRM@(MRKZ,"KAMDLP",1)) S DLP2=$G(@VRM@(MRKZ,"KAMDLP",2)) S DLP3=DLP1+DLP2 S @VRM@(MRKZ,"AVDLP",1)=" " S @VRM@(MRKZ,"AVDLP",2)=" " S @VRM@(MRKZ,"AVDLP",3)=" " I DLP1 D .S @VRM@(MRKZ,"AVDLP",1)=$J($G(@VRM@(MRKZ,"SUMDLP",1))/DLP1,2,2) I DLP2 D .S @VRM@(MRKZ,"AVDLP",2)=$J($G(@VRM@(MRKZ,"SUMDLP",2))/DLP2,2,2) I DLP3 D .S @VRM@(MRKZ,"AVDLP",3)=$J($G(@VRM@(MRKZ,"SUMDLP",3))/DLP3,2,2) Q ; INIT ; D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) Q ; W(TXT) ; D W^W4MRKG(TXT) Q ; W TXT,! S COL=$G(COL)+1 N TXT1 S TXT1=$$RPL^%L1FRM(TXT," "," ") S TXT1=$$U2H^%L1FRM(TXT1) S @VRMEX@(SH,COL)=TXT1 Q ; SHCOL(IND) ; S SH=SH0+J-1 S COL='RKZ+IND+1 Q ; DIVEXC(COD) ; D DIVEXC^W4MRKG(COD) Q ; W "
    ",! N FLCSV,FLTXT,DIR,FL S DIR=$$DIRWEB^%W1PCEX S FL=COD_$$^W4MYDVN S FLCSV=DIR_FL_".csv" ; W "" W "" W "" W "",! W "
    ",! W " "_FL_".csv",! W "
    ",! ; W "
    ",! Q ; GLREP(STAM) ; Q "^MRK2WEB" ; PROT(MEDAT,ADDAT) ; D PROT^W4MRKG(MEDAT,ADDAT) Q ; N N,DT,MEDT,ADDT S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) S VRMPROT=$$^W4MAIN("VRMPROT") K @VRMPROT F DT=MEDT:1:ADDT D .I '$$IFDAY(DT) Q .S N="" F S N=$O(MMRKZ(N)) Q:N="" D ..I '$D(@GLREP@(DT,N)) D ...S @VRMPROT@(DT,N)="" ; I $D(@VRMPROT) D .W "
    ",! . W "" . W $$^%W1DICT("NODATAPROTOCOL")_" "_$$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT . W "" . W "

    ",! . W "",! . W "",! . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . .W "",! . S DT="" F S DT=$O(@VRMPROT@(DT)) Q:DT="" D . .W "" . . D WDAT(DT) . . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . .W "" . .W "",! . W "
    "_$$^%W1DICT("DATE")_""_N_" "_$$H2U^%L1FRM(MMRKZ(N))_"
    " . . . D . . ..I $D(@VRMPROT@(DT,N)) W "-",! Q . . ..W "+",! Q . . .W "
    ",! .W "
    ",! Q ; IFDAY(DT) ; Q $$IFDAY^W4MRKG(DT) ; WDAT(DT) ; D WDAT^W4MRKG(DT) Q W4MRKM1 W4MRKM ; [ 29.05.13 14:58 ] [ 26.05.13 17:07 ] [ 23.04.11 09:42 ] N (JB,%ARG,%REM) S MEDAT=$G(%ARG("MEDAT")) S ADDAT=$G(%ARG("ADDAT")) S MEDT=$$^%L1DC(MEDAT,3) S ADDT=$$^%L1DC(ADDAT,3) I 'MEDT,'ADDT Q ; S SP="  " S RKZ=$G(%ARG("RKZ")) D FRMRKZ(MEDT,ADDT,RKZ) ; D MMRKZ ; W "
    ",! W ""_$$^%W1DICT("MEDAT")_" "_MEDAT_" "_$$^%W1DICT("ADDAT")_" "_ADDAT I RKZ W " ( "_$$^%W1DICT("CONCENTRATEDPERDATE")_" )" W "",! W "

    ",! W "",! W "" I 'RKZ D .W "" W "" W "" S N="" F S N=$O(MMRKZ(N)) Q:N="" D .S MRKZ1=MMRKZ(N) .W "",! W "",! W "" ; I 'RKZ F DT=MEDT:1:ADDT D .D LINE(DT) ; I RKZ D .D LINE("RKZ") W "
    " . W $$^%W1DICT("DATE") .W "" W "" W "" . W SP_N_" "_$$H2U^%L1FRM(MRKZ1)_SP,! .W "" W SP_$$^%W1DICT("TOTAL")_SP W "
    ",! W "
    ",! Q ; LINE(DT) ; F PKIND="SUMMSD","SUMDLP","SUMMSL","SUMALL" D .W "" . I 'RKZ D .. W "" .. W $$^%L1DC(DT,1) .. W "" . . W "" . W $$PROFITKIND(PKIND) . W "" . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . W $$DAYTIME(J) . . W "
    ",! . W "" . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . W "" . . W "",! . . F J=1:1:3 D . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . W $J($$SUM(PKIND,N,DT,J),2,2) . . . W "
    ",! . . W "",! . . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . W $J($$SUM(PKIND,"TOT",DT,J),2,2) . . W "
    ",! . W "",! ; F QKIND="SSOAD","KAMDLP","KAMMSL" D .W "" . I 'RKZ D .. W "" .. W $$^%L1DC(DT,1) .. W "" . . W "" . W $$^%W1DICT(QKIND) . W "" . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . W $$DAYTIME(J) . . W "
    ",! . W "" . . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . W "" . . W "",! . . F J=1:1:3 D . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . W $J($$SUM(QKIND,N,DT,J),0,0) . . . W "
    ",! . . W "",! . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . W $J($$SUM(QKIND,"TOT",DT,J),0,0) . . W "
    ",! . W "",! .W "",! ; F AKIND="AVMSD","AVDLP","AVMSL" D .W "" . I 'RKZ D .. W "" .. W $$^%L1DC(DT,1) .. W "" . . W "" . W $$^%W1DICT(AKIND) . W "" . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . W $$DAYTIME(J) . . W "
    ",! . W "" . . S N="" F S N=$O(MMRKZ(N)) Q:N="" D . . W "" . . W "",! . . F J=1:1:3 D . . .W "",! . . . W "" . . .W "",! . . W "
    " . . . S SUM=$$SUM(AKIND,N,DT,J) S:SUM="" SUM=" " . . . W SUM . . . W "
    ",! . . W "" . . . W "" . W "",! . F J=1:1:3 D . .W "",! . . W "" . .W "",! . W "
    " . . S SUM=$$SUM(AKIND,"TOT",DT,J) . . W SUM . . W "
    ",! . W "" . W "",! ; Q ; PROFITKIND(KIND) ; Q $$^%W1DICT(KIND_"PROFIT") ; DAYTIME(J) ; I J=1 Q $$^%W1DICT("MORNING") I J=2 Q $$^%W1DICT("EVENING") I J=3 Q $$^%W1DICT("DAY") Q " " ; SUM(PKIND,N,DT,J) ; N A S A=$G(@$$^W4MAIN("VRM")@(DT,N,PKIND,J)) I DT="RKZ" S A=$G(@$$^W4MAIN("VRM")@(N,PKIND,J)) Q A ; MMRKZ ; K MMRKZ N N S N="" F S N=$O(@$$^W4GL("MRKZ")@(N)) Q:N="" D .S MMRKZ(N)=$G(^(N)) Q ; FRMRKZ(MEDT,ADDT,RKZ) ; N DT,MRKZ N VRM S VRM=$$^W4MAIN("VRM") K @VRM N DOCH S DOCH=$$^W4GL("MRK2WEB") ;;M @VRM=@DOCH I '$G(RKZ) S VRM=$$BG^W4MAIN("VRM")_"DT)" ; F DT=MEDT:1:ADDT D .;;D ^W4CRDOCH(DT) .S MRKZ="" F S MRKZ=$O(@DOCH@(DT,MRKZ)) Q:MRKZ="" I MRKZ D ..S VD="" F S VD=$O(@DOCH@(DT,MRKZ,VD)) Q:VD="" I VD'="SUMALL" D ...S @VRM@(MRKZ,VD,1)=$G(@VRM@(MRKZ,VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) ...S @VRM@(MRKZ,VD,2)=$G(@VRM@(MRKZ,VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) ...S @VRM@(MRKZ,VD,3)=$G(@VRM@(MRKZ,VD,1))+$G(@VRM@(MRKZ,VD,2)) ...S @VRM@("TOT",VD,1)=$G(@VRM@("TOT",VD,1))+$G(@DOCH@(DT,MRKZ,VD,1)) ...S @VRM@("TOT",VD,2)=$G(@VRM@("TOT",VD,2))+$G(@DOCH@(DT,MRKZ,VD,2)) ...S @VRM@("TOT",VD,3)=$G(@VRM@("TOT",VD,1))+$G(@VRM@("TOT",VD,2)) .. ..D SETVRM(MRKZ) . D SETVRM("TOT") Q ; SETVRM(MRKZ) ; S SSOAD1=$G(@VRM@(MRKZ,"SSOAD",1)) S SSOAD2=$G(@VRM@(MRKZ,"SSOAD",2)) S SSOAD3=SSOAD1+SSOAD2 ; I MRKZ'="TOT" D .S @VRM@(MRKZ,"SUMALL",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))+$G(@VRM@(MRKZ,"SUMMSL",1))+$G(@VRM@(MRKZ,"SUMDLP",1)),2,2) .S @VRM@(MRKZ,"SUMALL",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))+$G(@VRM@(MRKZ,"SUMMSL",2))+$G(@VRM@(MRKZ,"SUMDLP",2)),2,2) .S @VRM@(MRKZ,"SUMALL",3)=$J(@VRM@(MRKZ,"SUMALL",1)+@VRM@(MRKZ,"SUMALL",2),2,2) .; .S @VRM@("TOT","SUMALL",1)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@(MRKZ,"SUMALL",1)) .S @VRM@("TOT","SUMALL",2)=$G(@VRM@("TOT","SUMALL",2))+$G(@VRM@(MRKZ,"SUMALL",2)) .S @VRM@("TOT","SUMALL",3)=$G(@VRM@("TOT","SUMALL",1))+$G(@VRM@("TOT","SUMALL",2)) ; S @VRM@(MRKZ,"AVMSD",1)=" " S @VRM@(MRKZ,"AVMSD",2)=" " S @VRM@(MRKZ,"AVMSD",3)=" " I SSOAD1 D .S @VRM@(MRKZ,"AVMSD",1)=$J($G(@VRM@(MRKZ,"SUMMSD",1))/SSOAD1,2,2) I SSOAD2 D .S @VRM@(MRKZ,"AVMSD",2)=$J($G(@VRM@(MRKZ,"SUMMSD",2))/SSOAD2,2,2) I SSOAD3 D .S @VRM@(MRKZ,"AVMSD",3)=$J($G(@VRM@(MRKZ,"SUMMSD",3))/SSOAD3,2,2) ; S MSL1=$G(@VRM@(MRKZ,"KAMMSL",1)) S MSL2=$G(@VRM@(MRKZ,"KAMMSL",2)) S MSL3=MSL1+MSL2 S @VRM@(MRKZ,"AVMSL",1)=" " S @VRM@(MRKZ,"AVMSL",2)=" " S @VRM@(MRKZ,"AVMSL",3)=" " I MSL1 D .S @VRM@(MRKZ,"AVMSL",1)=$J($G(@VRM@(MRKZ,"SUMMSL",1))/MSL1,2,2) I MSL2 D .S @VRM@(MRKZ,"AVMSL",2)=$J($G(@VRM@(MRKZ,"SUMMSL",2))/MSL2,2,2) I MSL3 D .S @VRM@(MRKZ,"AVMSL",3)=$J($G(@VRM@(MRKZ,"SUMMSL",3))/MSL3,2,2) ; S DLP1=$G(@VRM@(MRKZ,"KAMDLP",1)) S DLP2=$G(@VRM@(MRKZ,"KAMDLP",2)) S DLP3=DLP1+DLP2 S @VRM@(MRKZ,"AVDLP",1)=" " S @VRM@(MRKZ,"AVDLP",2)=" " S @VRM@(MRKZ,"AVDLP",3)=" " I DLP1 D .S @VRM@(MRKZ,"AVDLP",1)=$J($G(@VRM@(MRKZ,"SUMDLP",1))/DLP1,2,2) I DLP2 D .S @VRM@(MRKZ,"AVDLP",2)=$J($G(@VRM@(MRKZ,"SUMDLP",2))/DLP2,2,2) I DLP3 D .S @VRM@(MRKZ,"AVDLP",3)=$J($G(@VRM@(MRKZ,"SUMDLP",3))/DLP3,2,2) Q ; INIT ; D ^W3CSS D:$G(%ARG("MSD")) PUT^%W1PRM("MSD",%ARG("MSD")) I +$G(MSD)=0 S MSD=$$GET^%W1PRM("MSD") D PUT^%W1PRM("REM",$G(%REM,"UNKNOWN")) Q W4MRKMA0 W4MRKMAN(JB,DT1,DT2) ; [ 16.08.17 11:39 ] [ 10.11.16 15:44 ] [ 08.11.16 14:30 ] N (JB,%ARG,%REM,DT1,DT2) ; S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) ; F DT=DT1:1:DT2 D .D REP(DT) ; D TV2^%L1FTP(FLIN) Q ; REP(DT) D ^%L1TS D HEADER(DT) ; --> FLIN,BID,FS ( O FLIN U FLIN ) D REPINFO(DT) D MENU() D SALES(DT) D FOOTER() Q ; HEADER(DT) ; --> FLIN,BID,FS : O FLIN U FLIN S FLIN="/tmp/mrkfile"_$$DAT(DT)_"_"_$G(@$$^W4PRM@("ASH","MASOF"))_".txt" C FLIN:DELETE O FLIN:(WRITE:NEWVERSION:REWIND) U FLIN W "{" Q ; REPINFO(DT) S MASOF=$E($G(@$$^W4PRM@("ASH","MASOF")),1,7) S Z1=$$^W4GL("Z1") S DAT=$$DAT(DT) S BNAME=$$HEB($$^%L1HEAD) S NOM=$O(@Z1@(DAT,99999),-1) Q:'NOM S TOTAL=$$SAH^W4MAILZ(DT) ; S STRIN="""BuyerName"":"""_BNAME_"""," S STRIN=STRIN_"""DateTimeFrom"":"""_$ZD(DT,"DD/MM/YYYY")_"""," S STRIN=STRIN_"""DateTimeTo"":"""_$ZD(DT,"DD/MM/YYYY")_"""," S STRIN=STRIN_"""BuyerCode"":"""_MASOF_"""," S STRIN=STRIN_"""Znumber"":"""_NOM_"""," S STRIN=STRIN_"""TotalRevenueWithVAT"":"""_TOTAL_"""," S STRIN=STRIN_"""TotalRevenueWithoutVAT"":"""_$$NOVAT(TOTAL,DT)_"""," W STRIN,! Q ; ; MENU() ; N STRIN,ITMCOD,ITMNAME,ITMPRC,ITMGRP S STRIN="""Dishes"""_":[" W STRIN S REC=0 ; S ITMCOD="" F S ITMCOD=$O(@$$^W4GL("PAR")@(ITMCOD)) Q:ITMCOD="" D .S REC=REC+1 .S ITMNAME=$$HEB($$SHEM(ITMCOD)) .S ITMPRC=$$MH(ITMCOD) .S ITMGRP=$$HEB($$KVZ(ITMCOD)) .S STRIN=$$JSONITEM(ITMCOD,ITMNAME,ITMPRC,ITMGRP) .I REC>1 W ",",! .W STRIN,! W "],",! Q ; ; JSONITEM(ITMCOD,ITMNAME,ITMPRC,ITMGRP) N STRIN S STRIN="{" S STRIN=STRIN_"""SKU"":"""_ITMCOD_"""," S STRIN=STRIN_"""Name"":"""_ITMNAME_"""," S STRIN=STRIN_"""PriceWithVAT"":"""_ITMPRC_"""," S STRIN=STRIN_"""PriceWithoutVAT"":"""_$$NOVAT(ITMPRC,DT)_"""," S STRIN=STRIN_"""Category"":"""_ITMGRP_"""}" Q STRIN ; ; SHEM(ITMCOD); Q $$SHEM^W4P(ITMCOD) ; MH(ITMCOD); Q $$MH^W4P(ITMCOD) ; KVZ(ITMCOD) Q $$SUG1^W4P(ITMCOD) ; NOVAT(TOT,DT) ; N AHMAM,KMAM S AHMAM=$$MAMD^W4L(DT) Q $J(TOT*100/(100+AHMAM),2,2) ; ; FOOTER(); W "}" C FLIN Q ; ; SALES(DT); W """Sales"":[" S REC=0 ; -- ????? N HZ S HZ="" F S HZ=$O(@$$^W4GL("P1H")@(DT,HZ)) Q:HZ="" D .D HZMITEMS(HZ) W "]" Q ; ; HZMITEMS(HZM) N (JB,%ARG,HZM,REC,DT) D ^%L1TS S SUM=0 ; F I=1:1 Q:'$D(@$$^W4ORD@(HZM,I)) D .S A=$G(^(I)) .S CD=$P(A,"\") .I $$ISHNHP^W4HZMST(CD) S CD=0,ITEMNAME=$$HEB("hixtl dgpd") G C1 .I CD'?1N.N S CD=0 .S ITEMNAME=$$HEB($$ITEMNAME(A)) C1 .N QNT,ITEMPRC .S QNT=$$QNT(A) S:'QNT QNT=1 .S ITEMPRC=$$ITEMPRC(A) .I 'ITEMPRC,QNT S ITEMPRC=$J(($$ITEMSUM(A)-$$ADDONPRC(A))/QNT,2,2) .D BILLITEM(CD,ITEMNAME,QNT,ITEMPRC) .S SUM=SUM+(QNT*ITEMPRC) . .N ADDON .S ADDONPRC=$$ADDONPRC(A) . .I $G(ADDONPRC) D ..D BILLITEM("0",$$HEB("zetqez"),"1",ADDONPRC) ..S SUM=SUM+ADDONPRC ; N HNH S HNH=-$$HNH^W4HZMST(HZM) I HNH D BILLITEM("0",$$HEB("oeaygl dgpd"),"1",HNH) ; N DMSH S DMSH=$$DMSH^W4HZMST(HZM) I DMSH D BILLITEM("0",$$HEB("zexiy inc"),"1",DMSH) Q ; ; BILLITEM(CD,ITEMNAMEM,QNT,ITEMPRC); N (DT,REC,CD,ITEMNAME,ITEMPRC,QNT) D ^%L1TS S ITEMPRC=$J(ITEMPRC,2,2) S BILLITEM="""SKU"":"""_CD_"""" S BILLITEM=BILLITEM_",""Name"":"""_ITEMNAME_"""" S BILLITEM=BILLITEM_",""TotalPriceWithVAT"":"""_ITEMPRC_"""" S BILLITEM=BILLITEM_",""TotalPriceWithoutVAT"":"""_$$NOVAT(ITEMPRC,DT)_"""" S BILLITEM=BILLITEM_",""Quantity"":"""_QNT_"""" S BILLITEM="{"_BILLITEM_"}" ;; --- {}=JSON OBJECT VAR:VALUE "," -SEPARATOR I REC'<1 S BILLITEM=","_BILLITEM W BILLITEM,! S REC=REC+1 Q ; ; QNT(A) ; Q $P(A,"\",5) ; ADDONPRC(A) Q $J($P(A,"\",6),2,2) ; ITEMPRC(A) ; Q $J($P(A,"\",4),2,2) ; ITEMSUM(A) ; Q $J($P(A,"\",7),2,2) ; ITEMNAME(A) N NM S NM=$P(A,"\",3) Q NM ; HEB(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,","," ") S ST=$$INVH^%L1FRM(ST) S ST=$TR(ST,TS0,TS1) Q ST ; DAT(DT) ; Q $ZD(DT,"YYMMDD") W4MRKMAN W4MRKMAN(JB,DT1,DT2) ; [ 18.12.18 06:38 ] [ 23.10.17 18:46 ] [ 22.10.17 11:48 ] N (JB,%ARG,%REM,DT1,DT2) ; D GLP K @GLP ; D W("") ; D GETTOKEN ; I OKTKN'="true" D G END .D W("") .D W("
    Error Get Token Parameters - "_ERRTKN_"
    ") ; S DT1=$$^%L1DC(DT1,3) S DT2=$$^%L1DC(DT2,3) S Z1=$$^W4GL("Z1") ; F DT=DT1:1:DT2 D .S DAT=$$DAT(DT) .S NOM=$O(@Z1@(DAT,99999),-1) Q:'NOM .K @$$^W4GL("W4MRKMAN")@(DT,"P") .D REP(DT) .D SEND(DT) ; D W(" ") D W("Data sending completed") D W(" ") D W("") END ; D PUT^%W1PRM("MRKMANEND",1) ; Q ; ; REP(DT) D ^%L1TS D HEADER(DT) ; --> FLIN,BID,FS ( O FLIN U FLIN ) D REPINFO(DT) D MENU D MOD D SALES(DT) D FOOTER() Q ; ; MASOF(STAM) Q $G(@$$^W4PRM@("ASH","MASOF")) ; FILENM(DT) ; Q "mrkfile"_$$DAT(DT)_"_"_$$MASOF_".txt" ; HEADER(DT) ; --> FLIN,BID,FS : O FLIN U FLIN S FLIN="/tmp/"_$$FILENM(DT) C FLIN:(DELETE) O FLIN:(WRITE:NEWVERSION:REWIND) U FLIN W "{" Q ; ; REPINFO(DT) S MASOF=$E($$MASOF,1,7) S Z1=$$^W4GL("Z1") S DAT=$$DAT(DT) S BNAME=$$HEB($$^%L1HEAD) S NOM=$O(@Z1@(DAT,99999),-1) Q:'NOM S TOTAL=$$SAH(DT) ; S FIRSTORD=$O(@$$^W4REF@(DT,"")) D .I FIRSTORD="" S STARTDATE=$ZD($H,"YYYY-MM-DD")_"T06:00:00" Q .I $P($$DATCB^W4HZMST(FIRSTORD)," ")'?2N1"."2N1"."2N S STARTDATE=$ZD($H,"YYYY-MM-DD")_"T06:00:00" Q .S STARTDATE=$$DATUICHZ(FIRSTORD) ; S FINDATE=STARTDATE N IND S IND=$O(@Z1@(DAT,999),-1) I IND,$D(@Z1@(DAT,IND)) D .N ZMAN S ZMAN=$G(^(IND)) .; .S FINDATE=$$DATUIC($P(ZMAN,"\"),$E($P(ZMAN,"\",2),1,5)) ; S STRIN="""Token"":"""_TOKEN_"""," ;;--DIMA MAKE PROBLEMS S STRIN=STRIN_"""BuyerGUID"":"""_MASOF_"""," S STRIN=STRIN_"""UniqueID"":"""_DT_"""," S STRIN=STRIN_"""FromDateUTC"":"""_STARTDATE_"""," S STRIN=STRIN_"""ToDateUTC"":"""_FINDATE_"""," S STRIN=STRIN_"""TotalPriceWithVAT"":"""_TOTAL_"""," S STRIN=STRIN_"""TotalPriceWithoutVAT"":"""_$$NOVAT(TOTAL,DT)_"""," W STRIN,! Q ; ; SAH(DT) ; N DAT,SAH S SAH=0 S DAT=$$DAT(DT) ; N NOM S NOM="" F S NOM=$O(@Z1@(DAT,NOM)) Q:NOM="" D .S SAH=SAH+$G(@Z1@(DAT,NOM,"F",1))+$G(@Z1@(DAT,NOM,"G",1))+$G(@Z1@(DAT,NOM,"V",1))+$G(@Z1@(DAT,NOM,"H",1)) .I '$$^W4TIPPD(DT) S SAH=SAH-$G(@Z1@(DAT,NOM,"T",1)) Q SAH ; DATUICHZ(HZ) ; N DAT,DAT1,TM S DAT=$$DATCB^W4HZMST(HZ) N A S A=$G(@$$^W4ORD@(HZ)) S DAT1=$P(DAT," "),TM=$P(DAT," ",2) I DAT1?.P S DAT1=$P(A,"\",29),TM=$P(A,"\",25) I DAT1?.P,FINDATE Q FINDATE I DAT1?.P,STARTDATE Q STARTDATE Q $$DATUIC(DAT1,TM) ; DATUIC(DAT,TM) S DAT=$$^%L1DC(DAT,2) S DAT="20"_$E(DAT,1,2)_"-"_$E(DAT,3,4)_"-"_$E(DAT,5,6) Q DAT_"T"_$$TM(TM) ; TM(TM) S TM=$TR($J($P(TM,":"),2)," ",0)_":"_$E($P(TM,":",2),1,2)_":00" Q TM ; MENU ; N STRIN,ITMCOD,ITMNAME,ITMPRC,ITMGRP S STRIN="""Dishes"":[" W STRIN S REC=0 ; S ITMCOD="" F S ITMCOD=$O(@$$^W4GL("PAR")@(ITMCOD)) Q:ITMCOD="" D .S REC=REC+1 .S ITMNAME=$$HEB($$SHEM(ITMCOD)) .S ITMPRC=$$MH(ITMCOD) .S ITMGRP=$$HEB($$KVZ(ITMCOD)) .S STRIN=$$JSONITEM(ITMCOD,ITMNAME,ITMPRC,ITMGRP) .I REC>1 W ",",! .W STRIN,! W "],",! Q ; ; JSONITEM(ITMCOD,ITMNAME,ITMPRC,ITMGRP) N STRIN S STRIN="{" S STRIN=STRIN_"""Name"":"""_ITMNAME_"""," S STRIN=STRIN_"""ID"":"""_ITMCOD_"""," S STRIN=STRIN_"""PriceWithVAT"":"""_ITMPRC_"""," S STRIN=STRIN_"""PriceWithoutVAT"":"""_$$NOVAT(ITMPRC,DT)_"""," S STRIN=STRIN_"""Code"":"""_ITMCOD_"""," S STRIN=STRIN_"""Category"":"""_ITMGRP_"""}" Q STRIN ; ; SHEM(ITMCOD); Q $$SHEM^W4P(ITMCOD) ; MH(ITMCOD); Q $$MH^W4P(ITMCOD) ; KVZ(ITMCOD) Q $$SUG1^W4P(ITMCOD) ; NOVAT(TOT,DT) ; N AHMAM,KMAM S AHMAM=$$MAMD^W4L(DT) Q $J(TOT*100/(100+AHMAM),2,2) ; ; MOD ; Q N STRIN S STRIN="{" S STRIN=STRIN_"[" S STRIN=STRIN_"]" S STRIN=STRIN_"}" W STRIN,! Q ; FOOTER(); W "}" C FLIN Q ; ; SALES(DT); W """Transactions"":[" S REC=0 N HZ S HZ="" F S HZ=$O(@$$^W4GL("P1H")@(DT,HZ)) Q:HZ="" I HZ D .D HZMITEMS(HZ) W "]" Q ; ; HZMITEMS(HZM) N (JB,%ARG,HZM,REC,DT,STARTDATE,FINDATE) D ^%L1TS S SUM=0 S DATST0=STARTDATE ;$$DATUICHZ(HZM) ; S I="" F S I=$O(@$$^W4ORD@(HZM,I)) Q:I="" I I D .S A=$G(^(I)) .S CD=$P(A,"\") Q:'$L(CD) .I $$ISHNHP^W4HZMST(CD) S ITEMNAME=$$HEB("DISCOUNT TO ITEM "_CD),CD=-1 G C1 .I CD'?1N.N S CD=0 .S ITEMNAME=$$HEB($$ITEMNAME(A)) C1 .N QN,ITEMPRC .S QN=$$QN(A) S:'QN QN=1 .S ITEMPRC=$$ITEMPRC(A) .I 'ITEMPRC,QN S ITEMPRC=$J(($$ITEMSUM(A)-$$ADDONPRC(A))/QN,2,2) .N ST S ST=$P($G(@$$^W4ORD@(HZM,"ST",I)),"\",2) .;;I ST?.P S DATST=DATST0 .;;E D ..N DT1,TM S DT1=DT ..S TM=$TR(ST," ","") ..I $TR(TM," ","")<6 S DT1=DT+1 ..S DATST=$ZD(DT1,"YYYY-MM-DD")_"T"_$$TM(TM) .S DATST=DATST0 .D BILLITEM(CD,ITEMNAME,QN,ITEMPRC,DATST) . .S SUM=SUM+(QN*ITEMPRC) .S N2="" F S N2=$O(@$$^W4ORD@(HZM,I,N2)) Q:N2="" I N2 D ..S B=$G(^(N2)) ..I '$O(^(N2)) D Q ...S CDT=N2,ITNMT=$$HEB($P(B,"\")),MHT=$P(B,"\",2),QNT=$P(B,"\",3) ...I QNT["*" S QNT=QNT*$P(QNT,"*",2) ...D BILLITEM(CDT,ITNMT,QNT,MHT,DATST) .. ..S N3="" F S N3=$O(@$$^W4ORD@(HZM,I,N2,N3)) Q:N3="" I N3 D ...S C=$G(^(N3)) ...I $L($P(C,"\")) D Q ....S CDT=$P(C,"\"),ITNMT=$$HEB($P(C,"\",2)),MHT=$P(C,"\",7),QNT=$P(C,"\",3) ....I QNT["*" S QNT=QNT*$P(QNT,"*",2) ....D BILLITEM(CDT,ITNMT,QNT,MHT,DATST) ... ...S CDT=$P(C,"\",4) Q:'$L(CDT) ...S ITNMT=$$HEB($P(C,"\",5)),MHT=$P(C,"\",7),QNT=$P(C,"\",3) ...I QNT["*" S QNT=QNT*$P(QNT,"*",2) ...D BILLITEM(CDT,ITNMT,QNT,MHT,DATST) ; N HNH S HNH=-$$HNH^W4HZMST(HZM) I HNH D BILLITEM("-2","BILL DISCOUNT","1",HNH,DATST0) ; N DMSH S DMSH=$$DMSH^W4HZMST(HZM) I DMSH D BILLITEM("-3","DLVFEE","1",DMSH,DATST0) Q ; ; BILLITEM(CD,ITEMNAME,QNT,ITEMPRC,DATST); N (JB,DT,REC,CD,ITEMNAME,ITEMPRC,QNT,DATST,HZM,DATST0) I $G(DATST)'?1"20"2N1"-"2N1"-"2N1"T"2N1":"2N.E D .S @$$^W4GL("AA")@("W4MRKMAN",HZM,CD)=DATST .S DATST=DATST0 D ^%L1TS S ITEMPRC=$J(ITEMPRC,2,2) S BILLITEM="""DishCode"":"""_CD_"""" S BILLITEM=BILLITEM_",""DishID"":"""_CD_"""" S BILLITEM=BILLITEM_",""DishName"":"""_ITEMNAME_"""" S BILLITEM=BILLITEM_",""PriceTotalWithVAT"":"""_$J(ITEMPRC,2,2)_"""" S BILLITEM=BILLITEM_",""PriceTotalWithoutVAT"":"""_$$NOVAT(ITEMPRC,DT)_"""" S BILLITEM=BILLITEM_",""DateUTC"":"""_DATST_"""" S BILLITEM=BILLITEM_",""Quantity"":"""_QNT_"""" S BILLITEM="{"_BILLITEM_"}" ;; --- {}=JSON OBJECT VAR:VALUE "," -SEPARATOR I REC'<1 S BILLITEM=","_BILLITEM ; N GL S GL=$$^W4GL("W4MRKMAN")_"("_DT_",""P"")" ; I $L(CD) D .S @GL@(CD,"Q")=$G(@GL@(CD,"Q"))+QNT .S @GL@(CD,"S")=$G(@GL@(CD,"S"))+(QNT*ITEMPRC) .I $G(HZM) D ..S @GL@(CD,"Q",HZM)=$G(@GL@(CD,"Q",HZM))+QNT ..S @GL@(CD,"S",HZM)=$G(@GL@(CD,"S",HZM))+(QNT*ITEMPRC) ; W BILLITEM,! S REC=REC+1 Q ; ; QN(A) ; Q $P(A,"\",5) ; ADDONPRC(A) Q $J($P(A,"\",6),2,2) ; ITEMPRC(A) ; Q $J($P(A,"\",4),2,2) ; ITEMSUM(A) ; Q $J($P(A,"\",7),2,2) ; ITEMNAME(A) N NM S NM=$P(A,"\",3) Q NM ; HEB(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,","," ") S ST=$$INVH^%L1FRM(ST) S ST=$TR(ST,TS0,TS1) Q ST ; DAT(DT) ; Q $ZD(DT,"YYMMDD") ; GETTOKEN ; N FL S FL="/tmp/mrkman.prm" C FL:(DELETE) O FL:(WRITE) U FL W "{",! W """APIKey"":"""_$G(@$$^W4PRM@("MRKMAN","APIKEY"))_""",",! W """APIPassword"":"""_$G(@$$^W4PRM@("MRKMAN","APIPSW"))_"""",! W "}",! C FL ; N CMD,CON,A S HEADER="""Content-Type:application/json""" S URL="https://api.marketman.co.il/v1/buyers/auth/GetToken" S CMD="curl -s -m 120 -H "_HEADER_" -d @"_FL_" "_URL S CON="MRKPRM" O CON:(COMMAND=CMD:READONLY)::"PIPE" U CON S (TOKEN,EXPDAT,OKTKN,ERRTKN)="" F R A Q:$ZEOF D .I A["Token" S TOKEN=$$GETVL(A,"""Token""") .I A["ExpireDate" S EXPDAT=$$GETVL(A,"""ExpireDate""") .I A["IsSuccess" S OKTKN=$$GETVL(A,"""IsSuccess""") .I A["ErrorMessage" S ERRTKN=$$GETVL(A,"""ErrorMessage""") C CON Q ; ; GETVL(A,TX) ; S VL=$P($P(A,TX,2),",") S VL=$P(VL,"}") S VL=$P(VL,":",2) S VL=$$SPA^%L1FRM(VL) I $E(VL)="""" S VL=$E(VL,2,$L(VL)-1) Q VL ; SEND(DT) ; N CMD,CON,A S HEADER="""Content-Type:application/json""" S URL="https://api.marketman.co.il/v1/buyers/sales/SetSales" ; ZSY "iconv -c -f cp1255 -t utf-8 "_FLIN_" -o "_FLIN_"utf-8" S CMD="curl -s -m 120 -H "_HEADER_" -d @"_FLIN_"utf-8 "_URL S CON="MRKMAN" O CON:(COMMAND=CMD:READONLY)::"PIPE" U CON S (OKM,ERM)="" F R A Q:$ZEOF D .I A["IsSuccess" S OKM=$$GETVL(A,"""IsSuccess""") .I A["ErrorMessage" S ERM=$$GETVL(A,"""ErrorMessage""") C CON ; N IND S IND=$O(@$$^W4GL("W4MRKMAN")@(DT,99999),-1)+1 S @$$^W4GL("W4MRKMAN")@(DT,IND)=OKM_"\"_ERM_"\"_$ZD($H,"DD.MM.YY 24:60") ; I OKM="true" D W(""_$ZD(DT,"DD.MM.YY")_" - OK") E D W(""_$ZD(DT,"DD.MM.YY")_" - "_ERM_"") Q ; ; W(TX) ; D GLP N IND S IND=$O(@GLP@(999999),-1)+1 S @GLP@(IND)=TX Q ; GETPRM ; N I F I="APIKEY","APIPSW" D .S @I=$G(@$$^W4PRM@("MRKMAN",I)) Q ; SAVE(PRM) ; D ^%W1GETPR(PRM) N VL,RES,I S RES=1 F I="APIKEY","APIPSW" D Q:RES'=1 .S VL=$G(@I) .S @$$^W4PRM@("MRKMAN",I)=VL ; Q RES ; GLP ; S GLP=$$^W4MAIN("S111") Q ; GETPROT(STAM) ; D GLP N ST S ST="" F I=1:1 Q:'$D(@GLP@(I)) D .S ST=ST_$G(^(I)) Q ST W4MRKMIT W4MRKMIT(DT) ; [ 17.09.18 11:38 ] [ 22.08.17 07:49 ] [ 21.08.17 19:41 ] N (JB,%ARG,DT) I $G(DT)="" W "A DATE NOT DEFINED !" Q ; S DAT=$ZD(DT,"DD.MM.YY") S GLP=$$^W4GL("W4MRKMAN") ; W "
    ",! W "
    ",! W "",! W $$^%W1DICT("MRKMANPROTIT",DAT) W "",! W "
    ",! ; W "",! W " " W " " ; W " " ; W " " ; W " " W " ",! ; S (SQN,SSUM,DISCIT,DISCITQ,DISCOUNT,DISCOUNTQ,DLVFEE,DLVFEEQ)=0 S CD="" F S CD=$O(@GLP@(DT,"P",CD)) Q:CD="" D .S QN=$G(^(CD,"Q")) .S SUM=$G(^("S")) .I CD=-1 S DISCIT=DISCIT+SUM,DISCITQ=DISCITQ+1 Q .I CD=-2 S DISCOUNT=DISCOUNT+SUM,DISCOUNTQ=DISCOUNTQ+1 Q .I CD=-3 S DLVFEE=DLVFEE+SUM,DLVFEEQ=DLVFEEQ+1 Q .S SQN=SQN+QN .S SSUM=SSUM+SUM .W "" . W " " . N NM . W " " .. I $D(@$$^W4GL("PAR")@(CD)) S NM=$$SHEM^W4P(CD) Q .. I CD=0 S NM="zepey" Q . W " " . W " " .W "",! ; D TOT ; W "
    " W $$^%W1DICT("CODE") W " " W $$^%W1DICT("ITEMNAME") W " " W $$^%W1DICT("QUANTITY") W " " W $$^%W1DICT("SUM") W "
    "_CD_"" D W $$H2U^%L1FRM(NM) W ""_QN_""_$J(SUM,2,2)_"
    ",! W "

    ",! D ^W4BUTTON("print","PRINT","Print()","color:blue;font-size:"_$$^W3FSZ(14)) W $$NBSP^%L1FRM(7) D ^W4BUTTON("close","CLOSE","Close()","color:red;font-size:"_$$^W3FSZ(14)) W "

    ",! W "
    ",! Q ; ; TOT ; W "" W " " W ""_$$^%W1DICT("ITEMDISCOUNTS")_"" W ""_DISCITQ_"" W ""_$J(DISCIT,2,2)_"" W "",! ; W "" W " " W ""_$$^%W1DICT("TOTAL")_"" W ""_SQN_"" W ""_$J(SSUM+DISCIT,2,2)_"" W "",! ; W "" W " " W ""_$$^%W1DICT("BILLDISCOUNTS")_"" W ""_DISCOUNTQ_"" W ""_$J(DISCOUNT,2,2)_"" W "",! ; I DLVFEE D .W "" . W " " . W ""_$$^%W1DICT("TOTDLVFEE")_"" . W ""_DLVFEEQ_"" . W ""_$J(DLVFEE,2,2)_"" .W "",! ; W "" W " " W ""_$$^%W1DICT("TOTAL")_"" W ""_SQN_"" W ""_$J(SSUM+DISCIT+DISCOUNT+DLVFEE,2,2)_"" W "",! Q W4MRKMPR W4MRKMPR(DAT1,DAT2) ; [ 21.08.17 19:18 ] [ 20.08.17 09:00 ] [ 19.08.17 19:32 ] N (JB,%ARG,DAT1,DAT2) ; S DT1=$$^%L1DC(DAT1,3) S DT2=$$^%L1DC(DAT2,3) S GLP=$$^W4GL("W4MRKMAN") ; W "
    ",! W "",! W $$^%W1DICT("MRKMANPROT",DAT1_" - "_DAT2) W "",! ; W "",! W " " W " " ; W " " ; W " " ; W " " W " ",! ; F DT=DT1:1:DT2 D .S IND="" F S IND=$O(@GLP@(DT,IND)) Q:IND="" I IND D ..S A=$G(^(IND)) ..W "" .. W " " .. W " " .. W " " .. S TXP="" I $P(A,"\")="true" S TXP="OK" .. E S TXP=$P(A,"\",2) .. W " " ..W "",! ; W "
    " W $$^%W1DICT("DATE") W " " W $$^%W1DICT("SENDNMB") W " " W $$^%W1DICT("SENDTIME") W " " W $$^%W1DICT("RESULT") W "
    "_$ZD(DT,"DD.MM.YY")_""_IND_""_$P(A,"\",3)_""_TXP_"
    ",! W "

    ",! D ^W4BUTTON("print","PRINT","Print()","color:blue;font-size:"_$$^W3FSZ(14)) W $$NBSP^%L1FRM(7) D ^W4BUTTON("close","CLOSE","Close()","color:red;font-size:"_$$^W3FSZ(14)) W "

    ",! W "
    ",! Q W4MSD W4MSD(NMB) ; [ 23.10.13 18:24 ] [ 16.03.12 22:10 ] [ 08.04.09 10:25 ] I $L($G(NMB))<4 Q 1 Q 0 ; TAW(NMB) ; I '$G(NMB) Q 0 I '$$W4MSD(NMB) Q 0 I $$TAW^W4DLPK(NMB) Q 1 I $$MTAW^W4MTAW Q 1 Q 0 ; HZM(HZM) I '$G(HZM) Q 0 N NMB S NMB=$$NMB^W4HZMST(HZM) Q $$W4MSD(NMB) W4MSDGRP W4MSDGRP ; [ 28.08.18 18:50 ] [ 17.08.18 22:27 ] [ 27.05.18 15:40 ] N (JB,%ARG,%REM) I $G(%ARG("SHOW"))=0 Q D VRM D ^%W1ARG ; N I N GLGR S GLGR=$$GLGR K @GLGR ; S COLX=2 ; S @GLGR@("COLX")=COLX ; S I=0 S N="" F S N=$O(@VRM@(N)) Q:N="" S I=I+1 ; S COLG=I ; S @GLGR@("COLG")=COLG S TYPE=$G(%ARG("TYPE")) I TYPE="" S TYPE="bar" S @GLGR@("TYPE")=TYPE ; S @GLGR@("COLX")=COLX ; S I=0 S N="" F S N=$O(@VRM@(N)) Q:N="" D .S I=I+1 .S @$$GLGR@("LB",I)=$G(@VRM@(N)) .S @$$GLGR@("BGC",I)=$G(@VRM@(N,"CV"))_" .6)" .S @$$GLGR@("BRDC",I)=$G(@VRM@(N,"CV"))_" 1)" .S @GLGR@("VL",I,1)=$G(@VRM@(N,"VL")) ; S @$$GLGR@("LAB",1)=$$H2UG^%L1FRM("zecrqn") ; D SHOW ; Q ; ; GLGR(STAM) ; Q $$GLGR^W1GRAPH ; SHOW ; N HG,WD,TOP,LEFT,NG S HG=65,WD=90,TOP=4,LEFT=6 I $$1024^W4WDSCR S HG=60 S NG=1 N SM0 S SM0=60 ; W "
    ",! S SMLEFT=45 I $$1024^W4WDSCR S SMLEFT=40 ; W "

    ",! W $$^%W1DICT("RESTSSTATUS",DAT) ; D NIS^W4GRPHMP(LEFT,TOP+2) ; S TYPE=$G(@GLGR@("TYPE")) I TYPE="" S TYPE="bar" ; D GRAPHKIND^W4GRPHMP(TOP+3,TYPE) ; N SM1,SM2 S SM1=22 ; D TOTBOT(TOP+HG+7) ; D DIVBUT ; W "