0 // Списание журналов по номерам // На входе отмеченные записи журналов // v991^A - номер КСУ списания v991^B - номер акта передачи // v992^D - место хранения, v992^M - новое место хранения // 992^A – шифр записи номера журнала // 992^4 – подполе год // 992^5 – подполе том // 992^6 – подполе номер // 992^B – подполе № комплекта PUTLOG 'Списаны номера:',(v992^a|; |) // НАЧАЛО SPNJ. Списание журналов по номерам IF if v920:'SPEC'then'1'fi REP 992^5 F if p(v992^5)then(if p(v992)then if p(v992^5)then if &uf('G2#'v992^6):' 'then &UF('G0 '&uf('G1#'v992^6))fi else # fi fi/)fi REP 992^6 F (if p(v992)then if p(v992^6)then if &uf('G2#'v992^6):' 'then &UF('G2 '&uf('G2 'v992^6))else &uf('G2 'v992^6)fi else # fi fi/) FI ADD 1992 (v992/) REPEAT ADD 9992 &uf('Av1992#1') PUTLOG v9992 IF if v903=v9992^a then'1'else'0'fi REP 910 F if v9992^d=''then(if p(v910) then if '2 7 ':v910^a or p(v910^v) then v910 else v910,'^V'&uf('Av991^a#1'),|^X|v910^1,if &uf('Av9992^m#1')<>''then |^Z|v910^1,'^M'&uf('Av9992^m#1'),'^W'&uf('Av991^b#1') fi, fi fi/)else (if p(v910) then v910,if '2 7 ':v910^a or p(v910^v) then else if v910^d=&uf('Av9992^d#1') then if &uf('Av9992^b#1')<>''and v910^b=&uf('Av9992^b#1')or &uf('Av9992^b#1')='' then '^V'&uf('Av991^a#1'),|^X|v910^1,if &uf('Av9992^m#1')<>''then |^Z|v910^1,'^M'&uf('Av9992^m#1'),'^W'&uf('Av991^b#1') fi, fi fi fi fi/)fi REP 910^A F (if p(v910)then if v910^v=&uf('Av991^A#1')and '0 P 5':v910^a then '6'else v910^a fi fi/) ADD 940 &uf('+7W940#'),&uf('+7U940#'(v940|; |)),(if p(v910)then if v910^v=&uf('Av991^A#1')then if &uf('Ag940#1'):v910 then else v910 fi fi fi/) DEL 910 F (if p(v910)then if 'C U':v910^a then if v910^v=&uf('Av991^A#1') and v910^1=v910^x and a(v910^w)then'1'else'0'fi else'0' fi fi/) REP 910 F (if p(v910) then if v910^v=&uf('Av991^A#1') and p(v910^w)and v910^w=&uf('Av991^B#1') then if v910^a:'6' then '^A0' else |^A|v910^a fi,|^1|v910^z,|^D|v910^m,|^B|v910^b,|^H|v910^h,|^K|v910^k,|^E|v910^e,|^U|v910^u,|^Y|v910^y,|^C|v910^c,|^F|v910^f,|^2|v910^2 else v910 fi fi/) //Если экземпляр входит в подшивку IF if s((if p(v940)then if v940^d=&uf('Av9992^d#1')and v940^b=&uf('Av9992^b#1') then v940^p fi fi))<>''then '1'else'0'fi CORREC '*' "^Q"v934,"^F"v935,"^H"v936,"^D"v9992^d,if v910^a:'7'then '^!7'fi,"^W"v933 (if p(v940)then if v940^d=&uf('Av9992^d#1')and v940^b=&uf('Av9992^b#1') then |I=|v940^p fi fi) IF if v933=v1001^w and v934=v1001^q then'1'else'0'fi //'подшивка:',v903 ADD 9931 if p(v931^c)then ',',&uf(|V|v931^c),','fi CHA 9931 1 ","v1001^h"," ',' REP 931^c 1 &uf("U"v9931) DEL 9931 FI IF if v933=v1001^w and v934=v1001^q and p(v481) then'0'else'1'fi ADD 9481 if v933=v1001^w then (if p(v481)then if (v481^w=''or v481^W=&uf('Av933#1'))and v481^q=&uf('Av1001^q#1')then v481^h fi fi)else (if p(v481)then if v481^w=&uf('Av1001^W#1')and v481^q=&uf('Av1001^q#1')then v481^h fi fi)fi CHA 9481 1 ","v1001^h"," ',' REP 9481 1 &uf("U"v9481) REP 481^H F if v933=v1001^w then (if p(v481)then if (v481^w=''or v481^W=&uf('Av933#1'))and v481^q=&uf('Av1001^q#1')then &uf('Av9481#1') else v481^hfi fi)else (if p(v481)then if v481^w=&uf('Av1001^W#1')and v481^q=&uf('Av1001^q#1')then &uf('Av9481#1') else v481^h fi fi) DEL 9481 DEL 481 F (if p(v481)then if v481^h=''then'1'else'0'fi/) ADD 910 if v481=''and v931^c=''then '^A7'fi FI END FI //конец корректировки подшивки ADD 5555 XXXXXXXXXXXXXXXXXXX if p(v910)then f(rsum((if p(v910)then if '2 6':v910^a then '0;' else '1;'fi fi/)),0,0)else if p(v940)then '0'else'1'fi fi XXXXXXXXXXXXXXXXXXX ADD 9555 XXXXXXXXXXXXXXXXXXX if p(v910)then f(rsum((if p(v910)then if a(v910^c) or v910^a='6'then '0;' else '1;'fi fi/)),0,0)fi XXXXXXXXXXXXXXXXXXX ADD 910 XXXXXXXXXXXXXXXXXXX if val(v5555)>0 then else if v940:'^k'then (if p(v940) then if p(v940^k)then|^A7^K|v940^k,|^D|v940^d fi fi/)else'^A7',fi fi XXXXXXXXXXXXXXXXXXX DEL 5555 * XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX //Списание аналитики, если списаны все экземпляры источника IF if v910:'^A7'then '1'else'0'fi CORREC '*' "II="v903 ADD 910 if v920.1='A'then '^A7'fi END FI //Конец списания аналитики // Списание 909,имеющих ^D CORREC '*' "^A"v991^a,"^W"v991^b,v9992,'^!'v9555 "I="v933 // Создание архивных полей REP 1909^W F (if p(v1909)then v1909^w,if &uf(|G0,|v1909^W)=&uf('Av1001^a#1')then if v1909^Q=&uf('Av1001^4#1') then if p(v1909^f) and v1909^f=&uf('Av1001^5#1')or a(v1909^f)and &uf('Av1001^5#1')=''then if v1909^d<>''then if v1909^d=&uf('Av1001^d#1')then if v1909^k<>''then if v1909^k=&uf('Av1001^b#1')then ','&uf('Av1001^6#1'),fi,else ','&uf('Av1001^6#1'),, fi fi else if v1909^k<>''then if v1909^k=&uf('Av1001^b#1')then ','&uf('Av1001^6#1'),,fi,else ','&uf('Av1001^6#1'), fi fi fi fi fi fi/) ADD 8909 (if p(v909)then v909,if v909^Q=&uf('Av1001^4#1') then if p(v909^f) and v909^f=&uf('Av1001^5#1')or a(v909^f)and &uf('Av1001^5#1')=''then if v909^d<>''then if v909^d=&uf('Av1001^d#1')then if v909^k<>''then if v909^k=&uf('Av1001^b#1')or &uf('Av1001^b#1')=''then '^W'&uf('Av1001^a#1'),','&uf('Av1001^6#1'),if &uf('Av1001^w#1')<>'' then '^P'&uf('Av1001^w#1')fi,if &uf('Av1001^m#1')<>'' then '^M'&uf('Av1001^m#1')fi fi else '^W'&uf('Av1001^a#1'),','&uf('Av1001^6#1'),if &uf('Av1001^w#1')<>'' then '^P'&uf('Av1001^w#1')fi,if &uf('Av1001^m#1')<>'' then '^M'&uf('Av1001^m#1')fi fi fi else,, if v909^k<>''then if v909^k=&uf('Av1001^b#1')or &uf('Av1001^b#1')=''then '^W'&uf('Av1001^a#1'),','&uf('Av1001^6#1'),if &uf('Av1001^w#1')<>'' then '^P'&uf('Av1001^w#1')fi,if &uf('Av1001^m#1')<>'' then '^M'&uf('Av1001^m#1')fi fi else ,,,'^W'&uf('Av1001^a#1'),','&uf('Av1001^6#1'),if &uf('Av1001^w#1')<>'' then '^P'&uf('Av1001^w#1') fi,if &uf('Av1001^m#1')<>'' then '^M'&uf('Av1001^m#1')fi fi fi fi fi fi/) ADD 9909 (if p(v8909)then if p(v8909^W)then v8909 fi fi/) IF if v9909<>''then'1'else'0'fi REPEAT ADD 9091 &uf('Av9909#1') ADD 1909 if rsum((if p(v1909)then if &uf(|G0,|v1909^w)=&uf('G0,'&uf('Av9091^w#1'))and v1909^q=&uf('Av9091^q#1')and (v1909^f=&uf('Av9091^f#1')or v1909^f=''and &uf('Av9091^f#1')='') and (v1909^k=&uf('Av9091^k#1')or v1909^k='')and (v1909^d=&uf('Av9091^d#1')or v1909^d='') then'1;' else '0;' fi fi/))=0 then v9091 fi, DEL 9091 DEL 9909 1 UNTIL if v9909<>''then'1'else'0'fi FI //Конец создания архивных полей //Корректировка 909^H (Удаление списываемых номеров из 909) REPEAT ADD 2909 &uf('Av8909#1') //Исключение номера из 909 с ^d,^k или если все поступившие экземпляры списаны IF if v2909:'^W'and (s(v2909^d,v2909^k)<>''or val(&uf('Av1001^!#1'))=0) then'1'else'0'fi ADD 3909 &uf('Av8909#1') ADD 4909 ','&uf("V"v3909^h)',' CHA 4909 * ","v1001^6"," ',' REP 4909 &uf("U"v4909) REP 3909^H 1 v4909 DEL 4909 DEL 3909^W 1 DEL 3909^P 1 FI ADD 5909 v3909,if a(v3909)then v2909 fi DEL 2909 1 DEL 3909 1 DEL 8909 1 UNTIL if v8909<>''then '1'else'0'fi DEL 909 ADD 909 (v5909/) DEL 909 F (if p(v909)then if v909^h=''then'1'else '0'fi fi/) DEL 5909 DEL 9909 // Создание 909 с новым местом хранения IF if v1001^W<>''then'1'else'0'fi ADD 1111 &uf('+7W1#0'),&uf('+7W2#0'),&uf('+7W3#0'),&uf('+7W4#0'),(if p(v909)then if v909^q=&uf('Av1001^4#1')then if p(v909^f)and v909^f=&uf('Av1001^5#1')or a(v909^f)and &uf('Av1001^5#1')='' then ,if v909^d<>'' and v909^d=&uf('Av1001^m#1')then if s(','&uf(|V|v909^h)','):s(','&uf('Av1001^6#1')',')then &uf('+7W1#'f(val(&uf('Ag1#1'))+1,0,0))else v909 BREAK fi else if v909^d=''then ,&uf('+7W4#1'),if v909^k=''or v909^k=&uf('Av1001^b#1')then v909 fi else if s(','&uf(|V|v909^h)','):s(','&uf('Av1001^6#1')',')then &uf('+7W2#'f(val(&uf('Ag2#1'))+1,0,0))fi fi fi fi fi fi/), &uf('+7W3#'f(rmax((if p(v909)then if v909^q=&uf('Av1001^4#1')then v909^k|;| fi fi))+1,0,0)) //1111=909, если комплект с местом хранения = новому уже имеется, но передаваемого номера номера он не содержит; g1= кол-ву компл. с местом хранения = новому,содержащих передаваемый номер; g2 =кол-ву компл. без места хранения,содержащих передаваемый номер; g3 - кол-во комплектов данного года ; g4=1, если в 909 нет места хранения REP 909 F (if p(v909)then if v909=&uf('Av1111#1')then |^Q|v909^Q,|^D|v909^d,|^K|v909^k,'^H'&uf('U'v909^h,','&uf('Av1001^6#1')) else v909 fi fi/) ADD 909 if v1111='' then '^Q'v1001^4,'^H'v1001^6,if g4<>'1'then'^D'v1001^m,"^K"g3 fi fi FI DEL 1001 DEL 1111 DEL 909^W * DEL 909^P * END //Конец списания 909 DEL 9555 FI DEL 1992 1 DEL 9992 UNTIL if v1992<>''then'1'else '0'fi // КОНЕЦ SPNJ. Списание журналов по номеру DEL 991 * DEL 992 *