Spolocna trieda pre rozne konverzne programy a globalne vymeny (symboliky). Sem patria aj jednoucelove programy, ak je aspon aka taka pravdepodobnost za sa budu dat vyuzit aspon ako vzor. 12.10.12 mk; globalka na harminizaciu hesiel NA podla autorit NK cez Z39.50 28.07.11 jj; zmena zpusobu zpracovani isoUNtoMarcSPU 02.06.11 lp; do gw/set pridane volitelne zpracovani opakovatelnych tagu 19.08.10 mk; nova konverzia z UN ISO2709 do riadkoveho formatu pre SPU 08.07.10 lp; globalka pro naplneni tiskove fronty ^ChangeLog("print-RD") daty z otevrenych trx RD 12.02.10 mk; nova konverzia US citatelia z xls riadkoveho formatu, zo suboru do suboru 11.02.10 lp; pridane zapocitani Txx tagu podle nadrazeneho parametru "eval_txx" 10.02.10 mj; oprava formatu vystupu a pocetni chyby v listTagCount 09.02.10 mj; pridana funkce listTagCount/spocita pocet vyskytu tagu a subtagu / pridane i do helpu 21.12.09 mk; do exportu do PDA pridane triedenie podla signatury 19.11.09 mk; pridany export do PDA v 3 variantach 29.05.09 mk; pridane generovanie vydavatelov SNG 14.05.09 mk; pridana konverzia SNG 22.01.09 lp; zruseny 1 nekorektni radek kodu v symDeleteClaim 06.01.09 jr; pridany symbolik 'tagval' - selekt podle podpoli daneho tagu 16.12.08 jk; oprava log. chyby kdy se pro tridu IctxTrxQ vynechal index "uk" 15.12.08 jk; do convTrxDebts2Euro doplnen prevod zustatku na fin. konte na euro 09.12.08 jk; nova metoda na konverzy dluhu na euro convTrxDebts2Euro 02.12.08 pb; InventuraHolRuz: globalka na import ciarovych kodov holdingov pre dislokaciu 01=Mileticova 13.11.07 lp; symDeleteClaim: odkazovane trx s pausalni platbou za upominku ulozit do savelistu "upo" pro pozdejsi vymazani 05.11.07 pb; XGenAuth6xx: pridany parameter nazov indexu v autoritach 18.09.07 pb; XGenAuth6xx: rozsirenie generovania o tagy 600,601,605,606,607,608 09.08.07 pb; XGenAuth6xx: oprava chyby swapovania linku v celom multitagu 07.08.07 pb; nova metoda XGenAuth6xx: generovanie autorit na zaklade 6XX z katalogu 17.07.07 mk; globalka na doplnenie ocakavanych cisiel v kalendari zzo suboru z RL 03.04.07 pb; listTagValues: upravy pre vypis tagu 001 aj ked nie je v datach v riadku MARC 02.04.07 pb; listTagValues: pridany parameter "-case-" s hodnotami 'u/l/a/o', par3 nahradeny s -itemlen- 31.03.07 pb; listTagValues: osetreny pripad '200a,4xx/200a' v tags_to_display a '200' v tag_to_select; doplnena moznost mat aj v zozname "tagView" cele tagy bez subtagov 29.03.07 pb; listTagValues: uprava pre vlozeny tag 001 28.03.07 pb; listTagValues: doplnenie parametrov "filter" a "pagelen", zmena poradia parametrov "tagSel" s "tagView", zmena vystupu 27.03.07 pb; listTagValues: rozsirena moznost pouzitia par1 ak je par2 prazdne, algoritmus na pouzivanie skratenej formy zapisu tagov v par1,2, oprava drobnych chyb 26.03.07 pb; listTagValues: prerobene na verziu bez pov.par1 (class)a par4(savelist), ostali 3 parametre, metoda pracuje s aktivnym select listom, popisky 26.03.07 pb; listTagValues: osetrena max.dlzka 1 uzlu, a max.dlzka 1 polozky (subtagu), pridany par5, popisky 25.03.07 pb; listTagValues: upravy v par3 pre zlozeny vs. jednoduchy tag podla obsahu par2 24.03.07 pb; listTagValues: doladenie logiky, kodu, nastavenie 'eval_txx', ucesanie vystupu 22.03.07 pb; metoda viewTagContent premenovana na listTagValues, vyvolanie prikazom "ltv", zmena parametrov na "par", rozsirenie moznosti, zmena logiky, popisky 13.03.07 pb; convertRoleCodeVFtoUnimarc: nova verzia podla js 10.03.07 pb; nova metoda viewTagContent: prehlad vyskytov tagu/tagu+subtagu a ich pocetnosti; nova metoda viewRoleContent: prehlad vyskytov kodovanych a nekodovanych roli autorov vo VF a ich pocetnosti; nova metoda convertRoleCodeVFtoUnimarc: prekodovanie kodovanych roli autorov VF do kodovanych roli Unimarc; nova metoda genCat200fg: generovanie XxUnCat 200fg v nekodovanom tvare: - z nekodovanych roli Vymenneho formatu ulozenych v pomocnom Unimarc tagu 70xu - alebo z kodovanych roli Unimarc tagu 70x4 27.07.06 mk; inventarizacia zo suboru
14.07.06 pb; konverzia dat z excelu pre pocet uzivatelov pripojenych pocas dna zo statistiky pstat 04.05.06 mk; urobena globalka na generovanie holdingov pre databazu IZPE 04.05.06 mk; dokoncena globalka na spajanie viacerych opakovani 200 tagu 04.05.06 mk; nova konverzia z UN ISO2709 do riadkoveho formatu zo suboru do suboru pre konverziu IZPE IPVZ 28.02.06 jr; 2 globalky na upravu roku vyd.v 463 (sym463,sym463rok) globalka na doplneni $3 do 70x (symGen7xx3) 31.01.06 pb; ostra konverzia UHKT - UhktConv verzia 3 27.01.06 pb; ostra konverzia UHKT - UhktConv verzia 2 24.01.06 mk; oprava volania symboliku s sy="##class(SPIndexT).symGenVisit(.handle,"_dt1_","_dt2_")" 20.12.05 lp; symbolik na vyber holdingu, ktere byly presunuty pohybovou transakci ze zadane lokace_dislokace 15.12.05 pb; konverzia UHKT - UhktConv; import z csv suboru vyexportovaneho z dbf v RL 07.12.05 lp; oprava symboliku 'tagcnt' (chybelo tam $c(10)) 25.10.05 pb: globalka InventuraHolRuz na import ciarovych kodov holdingov zo vstupneho suboru vytvoreneho trackerom podla indexu "prirastkove cislo" 20.10.05 ja; symbolik na invetarizovanie exemplarov podla prirastkoveho cisla 12.08.05 jj; symbolik na zjisteni duplicit v indexu 11.08.05 jj; prenos convProjectCAVToMarc() do CavUnAuth, genAutProjektVfToUn() do CavUnEpca 11.08.05 jj; genAutProjektVfToUn() - oprava zprac. IF 11.08.05 mk; konverzia clankov CavUnEpca prenesene do CavVf 11.08.05 mk; uprava konverzie do UnEpca pre CAV 03.08.05 jj; convProjectCAVToMarc(), genAutProjektVfToUn() 07.06.05 mk; globalka na usporiadanie opakovani podpoli C05 07.06.05 mk; globalka na gen 928 upravena zmena indexu aucp 02.06.05 mk; globalka na gen 928 upravena, kvoli predtym upravenym 210 tagom 01.06.05 mk; novy symbolik pre generovanie 400c a d holdingu z 010 bib zaznamu 01.06.05 mk; globalka na usporiadanie opakovani podpoli 210 tagu po konverzii z RL 19.05.05 rs; symDelSubtag3Bodka: nerobit zmenu ak sa nic nemeni - toto zjednodusi select t.j. select zmenenych zaznamov je potom d ^X("s XxxYyy @"_sy) 20.04.05 mk; globalka na generovanie autority vydavatelov 210p z 210 a gen 928 19.04.05 mk; globalka na generovanie autority edicie 230e z 225 a gen 410 14.04.05 jj; XgWizard() - doplneni symboliku na zjisteni poctu opak tagu 07.04.05 mk; pridane ku generovaniu autorit z C20 aj z C20b 410a 01.04.05 mk; v generovani autorit swap znakov podla spindex 31.03.05 mk; riesenie upravy vyhl. kriteria spolocne pre 200 a 210 31.03.05 mk; riesenie tagu C20 do C16 24.03.05 mk; vlozit c06 tag y krajina ak je 23.03.05 mk; upravy konverzia z ISO2709 CAV do UNIMARCu 19.03.05 mk; doplnene generovanie autorit aj z C20 19.03.05 mk; generovanie C99e z citatalov CAV podla bc 100b 18.03.05 mk; konverzia citatelov riadkovy format z WORDU s pevnou dlzkou do UN 18.03.05 mk; konverzia z ISO2709 CAV autority do UNIMARCu 17.03.05 mk; konverzia z ISO2709 CAV do UNIMARCu dopracovanie 19.02.05 mk; pridana metoda na generovanie CavUnCat clanky z CavVf 17.02.05 mk; nova konverzia z VF ISO2709 do riadkoveho formatu 17.02.05 mk; nova konverzia na odstranenie znakov 13 a 10 zo zaznamu 07.02.05 jj; symFill463() - oprava situace pri pridavani sT200 26.01.05 rs; doplnenie symboliku na generovanie navstev 13.01.05 mk; novy symbolik pre generovanie kategorie citatelov do transakcii 12.01.05 pb; program na konverziu dat SCD - dodavatelia ScdConvVendor 11.01.05 pb; program na konverziu dat SCD z katalog.listkov ScdConvCatl 16.12.04 lp; presunuto nekolik glob. symboliku z SPBorrow sem 10.12.04 jj; glob. symMov606To610 - presun hesel z 606 do 610 09.12.04 jj; glob. symRepSign (doplneni signatury), symFillSigla (oprava sigly) 01.12.04 ja; pripojenie globalky XGenAuth generovanie autorit z 7xx 24.11.04 mk; pridana globalka na doplnenie 100c oddelenia do TRX opodla T04a z holdingu 23.11.04 pb; ntmConv:oprava drobnych chyb pri kontrole dat v klientovi 12.11.04 pb; ntmConv:konverzia NTM - Narodne Technicke Muzeum 28.10.04 rs; formalna uprava ParEV5, aby sla zobrazit dok.triedy 21.10.04 pb; pridane wizard symboliky updHist a del$3 14.10.04 rs; oprava neplatnych faktur, obj, predpl v holdingu a presun do 400$u poznamka k dodavatelovi 11.10.04 mk; konverzia Claviusa generovanie 999 parameter kniznica 11.10.04 mk; pridana metoda na generovanie holdingov zo zaznamu Clavius 05.10.04 rs; presunutie "gw" sem vyhodenie niektoreho nepotrebneho kodu a doplnenie zopar komentarov 04.10.04 mk; nova konverzia riadkoveho formatu clavius do nasho riadkoveho formatu, zo suboru do suboru 16.09.04 jj; symFill463() - symbolik na doplneni podpoli $h,$i pole 463 200 dle 463 001 27.07.04 jj; symFillIndex() - symbolik na nasypani obsahu UNA_610a z szp do indexu a250s ... ]]> Common 0 62742,39962.593468 59143,55625 prikaz "gw" - vstupny interface pre generovanie symbolikov 02.06.11 lp; do gw/set pridane volitelne zpracovani opakovatelnych tagu 06.01.09 jr; pridany symbolik 'tagval' 07.12.05 lp; oprava symboliku 'tagcnt' (chybelo tam $c(10)) 14.04.05 jj; XgWizard() - doplneni symboliku na zjisteni poctu opak tagu 26.01.05 rs; doplnenie symboliku na generovanie navstev 21.10.04 pb; pridane wizard symboliky updHist a del$3 21.04.04 rs; oprava chyby v symboliku na delete; strcnt 16.04.04 rs; "blank" added 20.02.04 rs; opravena chybka ak subtag bol literal a value bola expression 27.11.03 rs; prva verzia jednoducheho wizardu na symboliky globaliek ---]]> 1 cmd:%String 1 sy V/R/Z" w !," druhd - (trx) dogenerovania druhu d. do 100$d v transakciach" w !," hold1 - (hold) presun neplatnych odkazov na fakturu, obj., predpl. do" w !," poznamky, blizsie info viz. komentar k symboliku v UtilConv" w !," updHist - aktualizacia UnCatHist datami z UnCat (ak existuju)" w !," del$3 - vymaz $3 ak obsahuje iba bodku, ak nie je ani $a, vymaze tag" w !," oddelenie- (trx) dogenerovanie oddelenia 100$c v transakciach podla T04a" w !," z holdingu" w !," genAuth - generuje autority z 7xx, ak exisute doplni iba kod do 7xx$3" w !," kategoria- (trx) generuje kategorie 100k do transakcii z citatela 100k," w !," pozor spustit len ak nie je kategoria v transakcii !" w !," genvisit - generovanie transakcii navstev" w !," selectL - (trx) vyber zaznamov obsahujucich platby za dany den (volitelne" w !," len nesystemove)" w !," selectH - (hold) vyber holdingov, ktore boli presunute pohybovou" w !," transakciou zo zadanej lokacie_dislokacie" w ! w !," Zakladne symboliky:" w !," d - delete whole tag" w !," s - swap one string with another string" w !," set - setup subtag with value (blank value will delete the subtag)" w !," fix - fix not acceptable characters" w !," strcnt - select records with given tag containing repetitions of values" w !," tagcnt - select records containing repetitions of given tag" w !," tagval - select records containing subtags values of given tag" w !," blank - no action (read/write record - may be used to touch records)" w ! w !,"Your selection: " read cmd w ! } s sy="" ;n s1,s2,sLim if (cmd="swap") || (cmd="s") { w !,!,!,"String swap" w !,"-----------" w !,"Note: if the entered value contains '""' character - will be interpreted as Cache Object script expression (example '$c(31)_""s""')." w !," String1: " read s1 w !," String2: " read s2 w !," (Swap s1='"_s1_"' with s2='"_s2_"')" w !," Taglimit (may be blank or have form 71* or 7**): " read sLim s sy="##class(MARC).strswapX(.handle," s sy=sy_..XgwApostr(s1)_"," s sy=sy_..XgwApostr(s2) if sLim'="" s sy=sy_","_..XgwApostr(sLim) s sy=sy_")" } if (cmd="d") || (cmd="del") { w !,!,!,"Delete whole tag" w !,"-----------" w !,"Note: may use wildcars 71* or 7**" w !," Tagno: " read s1 s sy="##class(MARC).delTagX(.handle," ; 21.04.04 rs; oprava chyby s sy=sy_..XgwApostr(s1) s sy=sy_")" } if cmd="set" { w !,!,!,"Setup subtag or delete subtag" w !,"-----------" w !,"Note: may use wildcars 71* or 7**" w !," Tagno (3 characters): " read s1 if $l(s1)'=3 w !,"ERROR: tagnumber must be 3 characters long" q w !," Subtag (one character): " read s2 if $l(s2)'=1 w !,"ERROR: subtag must be 1 character long" q ;n sVal w !," Value (enter blank to delete the subtag; may be expression): " read sVal ;n sInd w !," Indicators (for newly created tags only - may be blank): " read sInd if sInd="" s sInd=" " if $l(sInd)'=2 w !,"ERROR: indicators must be 2 characters long" q ; 02.06.11 lp; pridane volitelne zpracovani opakovatelnych tagu - defaultne se ; zmena podpole udela pouze v prvnim opakovani zvoleneho tagu, lze vybrat moznost ; zmeny podpole ve vsech opakovanich zvoleneho tagu. ; Pred upravou byla funkcnost chybna - zmena se provedla v prvnim opakovani, ; vsechny ostatni opakovani tagu se ztratily. w !," If tag "_s1_" is repeated, do you want apply changes to all lines of tag (Y/N)?" w !," default is N (only first line of "_s1_" will be changed): " read sAllReps if sAllReps'="",$f("yY",sAllReps) {s sAllReps=1} else {s sAllReps=0} ;n s if sVal="" { w !,"Warning: you entered blank value, which means delete the subtag." w !,"Symbolic will fail, if removing of the subtag would cause removing of whole tag." w !,"In such case you need to use 'delete of whole tag' symbolic." w !,"(if the record would contain something like '"_s1_" $"_s2_"XXX')" w !,"Symbolic will also fail if the record doesn't contain tag '"_s1_"'." w !,"Press Enter to accept.." read s } s s=s1 if sInd'="" s s=s_" "_sInd_" " ; 20.02.04 rs; opravena chybka ak subtag bol literal a value bola expression s sy1="##class(MARC).getTagX(.handle,"_..XgwApostr(s1)_",-1)" s sy="##class(MARC).setTagX(.handle,##class(MARC).setSubTagStr(" if 'sAllReps {s sy=sy_"$p("_sy1_",$c(10),1)"} else {s sy=sy_sy1} s sy=sy_",$c(31)_"_..XgwApostr(s2)_"_"_..XgwApostr(sVal)_","_..XgwApostr(s)_")" if 'sAllReps { s sy=sy_"_$select($l("_sy1_",$c(10))>1:$c(10)_$p("_sy1_",$c(10),2,9999),1:"""")" } s sy=sy_")" } if cmd="fix" s sy="##class(MARC).fixupDATAX(.handle)" if cmd="blank" s sy="##class(MARC).recordSetupModifiedX(.handle,1)" if (cmd="strcnt") { w !,"info: symbolik select zaznamov, kde dany tag obsahuje dany pocet", "opakovani nejakeho sub-stringu - napr. dany pocet opakovani podpola" w !,"tag to check: " read tag s:tag="" tag="xxx" w !,"value to check (f.e. $c(31) or $c(31)_""a""): " read val w !,"expression and value (f.e. =2,'=1,>2,<14)" w !,": " read exp s:exp="" exp="=1" s val=..XgwApostr(val) s sy="ret1=(##class(MARC).symSubStrCnt(##class(MARC).getTagX(.handle,"""_tag_"""),"_val_")"_exp_")" } ; 07.12.05 lp; oprava symboliku (chybelo tam $c(10)) ; 14.04.05 jj; symbolik na zjisteni poctu opak. daneho tagu if (cmd="tagcnt") { w !,"info: symbolik na zjisteni poctu opak. tagu." w !,"tag to check: " read tag s:tag="" tag="xxx" w !,"expression and value (f.e. =2,'=1,>2,<14)" w !,": " read exp s:exp="" exp="=1" s sy="ret1=($l(##class(MARC).getTagX(.handle,"""_tag_""",-1),$c(10))"_exp_")" } ;jr.06.01.09 if (cmd="tagval") { w !," Symbolik vyhledá záznamy, mající v jednom opakování tágu souèasnì" w !," v uvedených podpolích a indikátorech uvedené hodnoty." w !," Napø. (i1 = 1) && (a [] ekonomie) && (2 '= eurovoc) " w !," Jako oddìlovaè seznamu podpolí,operátorù a hodnot uvádìj #" w !," Možno použít jen operátory ],[],[,= a jejich negace, tedy '],'[],'[,'=" w !," Pro testování i ind.použij oznaèení i1,i2" w !,"" w !,"--------------------------------------------------------------------" w !," Tág (napø. 650) : " read a q:a="" w !," Seznam testovaných podpolí èi ind. (napø. i1#a#2) : " read b q:b="" w !," Seznam operátorù (napø. =#[]#'=) : " read c q:c="" w !," Seznam hodnot testovaných podpolí(napø. 1#lidé#mesh) : " read d q:d="" ; testovani parametru if $l(a)'= 3 w !, "chybná délka tágu !!!" q ;pocet hodnot v b,c,d musi byt shodny s cntb = $l(b,"#"),cntc = $l(c,"#"),cntd = $l(d,"#") if (cntb '= cntc) || (cntc '= cntd) w !, "Rùzný poèet hodnot v seznamech !!!" q ;kontrola uzitych operatoru s notO=0 f h=1:1:cntc { s o1=$p(c,"#",h) if (o1 '= "[")&&(o1 '= "]")&&(o1 '= "[]")&&(o1 '= "=")&&(o1 '= "'[")&&(o1 '= "']")&&(o1 '= "'[]")&&(o1 '= "'=") { s notO=1 s h=cntc } } if notO=1 w !, "Nepovolený operátor !!!" q s sy="ret1=##class(UtilConv).symSelTagValue(.handle,"""_a_""","""_b_""","""_c_""","""_d_""")=1" } ; 30.09.04 rs; zapojenie globalky na vymaz upomienok if (cmd="upo") { w !,"info: symbolik na globalnu vymenu na vymaz cerstvo nagenerovanych", !,"upomienok (ak sa napr. pri prvom spusteni nevytvorili spravne).", !,"Ak existuju odkazovane trx pausalnych platieb za upomienky ($4),", !,"budu ulozene v pomenovanom saveliste 'upo'. Po ukonceni symboliku", !,"je potrebne nacitat savelist 'gl upo', skontrolovat transakcie", !,"a vymazat ich prikazom 'delete'." w !,"Datum generovania upomienok (Enter=dnesny datum): " read sDate if sDate="" s sDate=##class(Util).date() s sy="##class(UtilConv).symDeleteClaim(.handle,"""_sDate_""")" } ; 30.09.04 rs; zapojenie globalky konverziu stareho sposobu blokovania 'lock' if (cmd="hlock") { w !,"info: symbolik na globalnu vymenu stareho sposobu blokovania holdingu (RL)", !,"na novy sposob (aRL). Arl pouziva pismena V/R/Z v RL boli cisla 1,2,3.." s sy="##class(UtilConv).symHoldingLockFixup(.handle)" } ; 30.09.04 rs; zapojenie if (cmd="selectL") { w !,"Info: symbolik sluzi na vyber vsetkych zaznamov transakcii, ktore", !,"boli vytvorene dany den s volitelnym vypustenim systemom generovanych", !,"platieb. Da sa vyhodne pouzit napr. po nagenerovani upomienok na vyber", !,"zaznamov, kde uz bola rucne spravena platba." w !,"Datum pre select platieb (Enter=dnesny datum): " read sDate w !,"1-vypustit platby generovane systemom, 0-vsetky platby (dflt=1): " read nFiltSyst if sDate="" s sDate=##class(Util).date() s nFiltSyst=+nFiltSyst s sy="##class(UtilConv).symSelectL(.handle,"""_sDate_""","_nFiltSyst_")" } ; 20.12.05 lp; zapojeni if (cmd="selectH") { w !,"Info: symbolik sluzi na vyber vsetkych zaznamov holdingov, ktore", !,"boli presunute pohybovou transakciou zo zadanej lokacie_dislokacie", !,"na sucasnu lokaciu_dislokaciu, napr. vymenny fond.", !,"Pripadne je mozne aj obmedzenie na datum pohybovej trx." w !,"Povodna lokacia: " read sLoc w !,"Povodna dislokacia: " read sDisloc w !,"Datum pre select platieb (Enter=bez obmedzenia datumom): " read sDate s sy="##class(UtilConv).symSelHoldFromLoc(.handle,"""_sLoc_""","""_sDisloc_""","""_sDate_""")" } if (cmd="druhd") { w !,"info: symbolik na globalku na transakciami, ktore neobsahuju podpole 100$d", "dogeneruje sa dotiahnutim z titulu. Pozor - ak uz zaznam obsahuje 100$d", "nebude zmeneny (aj ak by titul mal iny obsah v 90$b ako je v 100$d)" s sy="##class(UtilConv).symTrxFixDruhDok(.handle)" } ; 24.11.04 mk doplnene volanie globalky na oddelenie v transakciach if (cmd="oddelenie") { w !,"info: symbolik na globalku na transakciami, ktore neobsahuju podpole 100$c", " dogeneruje sa dotiahnutim z titulu T04a. Pozor - ak uz zaznam obsahuje 100$c", " nesmie byt globalka spustana, 100c sa pridava ako dalsi subtag , nemeni obsah", " stavajuceho 100c" s sy="##class(UtilConv).symGenBranchTrx(.handle)" } if (cmd="hold1") { w !,"info: symbolik na opravu neplatnych faktur, obj, predpl", !, "v holdingu a presun do 400$u poznamka k dodavatelovi" w !,"jazyk instalacie pre prefixy textov do poznamky", !,"1-slovencina,2-cestina (dflt=1):" read lang s:lang="" lang=1 s sy="##class(UtilConv).symFixBadInvoiceInfo(.handle,"_lang_")" } if (cmd="updHist") { w !,"info: aktualizacia UnCatHist datami z UnCat (ak existuju)", !, "v UnCatHist ostanu bez zmeny tagy 005,HIS a 999,", !, "vsetky ostatne tagy sa prevezmu z UnCat", !, "selekcne kriterium: s XxUnCatHist @ALLOWSAVE" s sy="##class(UtilConv).symMergeUnCattoUnCatHist(.handle)" } if (cmd="del$3") { w !,"info: vymaz podpola '3' ak obsahuje iba bodku; ak nie je ani podpole 'a', vymaze cely tag" w !,"V ktorych tagoch mazat(oddelit ciarkou)? : " read sTag if sTag="" w !,"input tag '"_sTag_"' is invalid" q s sy="##class(UtilConv).symDelSubtag3Bodka(.handle,"""_sTag_""")" } if (cmd="genAuth") { w !,"info: symbolik na generovanie autorit z poli 7xx, treba pre kazdu 7stovku ", !,"spustat zvlast. Po vygenerovani autority do pola 7xx $3 doplni jej kod.", !,"Overuje ci uz taka autorita exisutje ak ano, tak doplni iba link do katalogu",!! w !,"Tag z ktoreho sa ma generovat autorita (700,701,702,710,711,712): " read tag if '((tag="700")||(tag="701")||(tag="702")||(tag="710")||(tag="711")||(tag="712")) w !,"input tag '"_tag_"' is invalid" q w !,"Prefix institucie (Pr.Umb) :" read ictx if ictx="" w !,"blank value" q w !,"Prefix l name (Pr.l alebo Umb ak je to hosting) :" read lname if lname="" w !,"blank value" q w !,"Katalogizujucia organizacia (naplna 801$b):" read katorg w !!,"!!! POZOR !!! Uz pri zadani prikazu ls sa generuju autority. ",!! s sy="##class(UtilConv).XGenAuth(.handle,"""_tag_""","""_ictx_""","""_lname_""","""_katorg_""")" } ; 13.01.05 mk doplnene volanie globalky na kategoriu v transakciach if (cmd="kategoria") { w !,"info: symbolik na globalku na transakcie, ktore neobsahuju podpole 100$k", " dogeneruje sa dotiahnutim z citatela 100k. Pozor - ak uz zaznam obsahuje 100$k", " nesmie byt globalka spustana, 100k sa pridava ako dalsi subtag , nemeni obsah", " stavajuceho 100k" s sy="##class(UtilConv).symGenKatTrx(.handle)" } ; 26.01.05 rs; doplnenie symboliku na generovanie navstev if (cmd="genvisit") { w !,"info: symbolik na globalku na generovanie navstevnostnych transakcii", !,"(typ S). Trx sa generuje pri: vypozicke/navrate/prolong./rez./ziad. alebo ", !,"platbe (generovana systemom (username<>sys))", !,"(neratame drzane rez.)", !,"Pred globalkou je treba spustit select a podla indexu dtt vybrat zaznamy,", !,"ktore maju aspon jednu operaciu v zadanom casovom intervale, pre kt.", !,"chceme generovat navstevy.", !,"Na triede trx je potreba povolit generovanie indexu 'udos' aspon tolko dni", !,"dozadu, aky interval spat od aktualneho datumu chceme pouzit (nastavuje", !,"sa modifikatorom udoidx - viz. dokuemntacia indexov).", !,"Pozor symbolik generuje trx uz pri prikaze 'ls' (podobne", !,"ako pri generovani autorit)" w !,"Datum zaciatku: " read dt1 w !,"Datum konca: " read dt2 s sy="##class(SPIndexT).symGenVisit(.handle,"_dt1_","_dt2_")" } if cmd="q" q if cmd="" q if sy="" w !,"invalid keyword: '"_cmd_"'" q w !,"Your new symbolic is:",!,!,sy,! w !,"Enter d ^X(""ls"") to test it first and d ^X(""g"") to run the change." if '$random(3) w !,"Harry Potter wishes good luck.",! q ]]> pomocna metoda pre"gw" [Previously private] 1 s 1 15.06.04 pb; konverzia SFU - spravodajske a dokum.filmy, faza 1: import z csv suborov vyexportovanych z MS Accessu, oddelovac stlpcov je ~, zaciatok a konec textu oznaceny s \ d ##class(Konverzie).SfuConv2() vyvolanie programu 1 0) d . . . . ;use ofiprot w !,"c2=",c2,". fc=",$l(li,"\") . . . . if $l(li,"\")<9 d . . . . . if $l(li,"~")=8 q ;pocet hlavnych oddelovacov suhlasi . . . . . n brk4,li0 s brk4="",li0="" . . . . . for q:brk4 d . . . . . . s li0=li . . . . . . ;use ofiprot w !,li . . . . . . use sFileName . . . . . . read li if $zeof'=0 s brk2=1 . . . . . . ;use ofiprot w !,li . . . . . . s li=li0_li . . . . . . if $l(li,"\")=9 s brk4=1 . . . . . . if brk2=1 s brk4=1 . . . if li="" q . . . s c2=c2+1,pg=pg+1 . . . if pg'<100 d use sOLDIO w "." s pg=0 . . . ;use sOLDIO w !,c2,"====",li . . . ;use ofiprot w !,li . . . n sTag s sTag=li . . . n brk3 s brk3="" . . . if c2=1 s brk3=1 ;1.veta je hlavicka . . . s NodeNum=0 . . . for q:brk3 d . . . . ;use ofiprot w !,"b.",li,"." . . . . s NodeNum=NodeNum+1 . . . . s sTag=$p(li,"~",NodeNum) . . . . s li=##class(User.Util).strswap(li,"\","") . . . . s sTag=##class(Util).trim(sTag) . . . . ;if DBName="DF" use ofiprot w !,"c.",$p(li,"~",NodeNum),"." . . . . if sTag'="" d . . . . . s DBKey="" . . . . . if DBName="VL" s DBKey=$p(li,"~",1) . . . . . if DBName="DF" d s DBKey=$p(li,"~",2) if DBKey'="" s sDBKey=sFileNum*1000+sTag . . . . . if DBName="AVL" s DBKey=$p(li,"~",2) . . . . . if DBName="AUTH" s DBKey=$p(li,"~",1) . . . . . s DBKeyMy=$p(li,"~",1) . . . . . . . . . . if DBKey'="" d . . . . . . s DBKey=sFileNum*1000+DBKey . . . . . . if DBName="AUTH" d . . . . . . . s ^TMP("AUTH",DBKey,DBName,NodeNum)=sTag . . . . . . else s ^TMP("VL",DBKey,DBName,DBKeyMy,NodeNum)=sTag . . . . . . . . if NodeNum>100 s brk3=1 . . . . close sFileName . . ;use sOLDIO . . use ofiprot . . w !,c2_" record processed - ok" . . close sListFiles . ; enable error . d $ZU(68,40,0) . use sOLDIO w !,c_" record processed - ok ",$zdt($h,4) . close ofi . . use ofiprot w !," ======================================" . w !!,c_" record processed - ok " . w !!,"Import SFU ukonceny ",$zdt($h,4) . close ofiprot q ]]> 15.06.04 pb; konverzia SFU - spravodajske a dokum.filmy, faza 2: export z ^TMP d ##class(Konverzie).Conv2Cat() vyvolanie programu 1 W") . if sX'="" d . . s sX=$zcvt(sX,"l") . . s sT606="606 1 "_$c(31)_"a"_sX_$c(31)_"3sfu_un_auth*"_sX3 . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,27)) ;druh . s sX3=##class(Util).leadingZero(sX+10200,7) . if sX'="" s sX=$zstrip(##class(Util).sXlate("SFU_DRUHY",sX),"<>W") . if sX'="" d . . s sX=$zcvt(sX,"l") . . if sT606'="" s sT606=sT606_"~" . . s sT606=sT606_"606 1 "_$c(31)_"a"_sX_$c(31)_"3sfu_un_auth*"_sX3 . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,28)) ;zaner . s sX3=##class(Util).leadingZero(sX+10300,7) . if sX'="" s sX=$zstrip(##class(Util).sXlate("SFU_ZANRE",sX),"<>W") . if sX'="" d . . s sX=$zcvt(sX,"l") . . if sT606'="" s sT606=sT606_"~" . . s sT606=sT606_"606 1 "_$c(31)_"a"_sX_$c(31)_"3sfu_un_auth*"_sX3 . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,29)) ;nosic . s sT215a="",sT215d="" . if sX'="" d . . if $p(sX,"-",2)="" s sX=sX_"-KK" . . s sT215d=$p(sX,"-",1) s sT215d=##class(Util).trim(sT215d) . . s sT215a=$p(sX,"-",2) s sT215a=##class(Util).trim(sT215a) . . s sT215a=##class(User.Util).strswap(sT215a,"KK","kombinovaná kópia") . . s sT215a=##class(User.Util).strswap(sT215a,"KO","kópia obrazu") . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,30)) ;obraz.format . if sX'="" d . . if sT215d'="" s sT215d=sT215d_"; " ;dam ; lebo , je v obsahu obraz.formatu . . s sT215d=sT215d_sX . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,12)) ;pov.metraz . s sX1=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,13)) ;cista metraz niekedy je; nezadefinovali, ktoru chcu, dam tam aj aj . s sY=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,14)) ;pov.minutaz . s sY1=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,15)) ;cista minutaz niekedy je; nezadefinovali, ktoru chcu, dam tam aj aj . . if (sX'="") || (sX1'="") || (sY'="") || (sY1'="") d . . if sT215a'="" s sT215a=sT215a_", " . . s sT215a=sT215a_"("_sX_"/"_sX1_","_sY_"/"_sY1_")" . . s sT101a="",sT101j="" . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,31)) ;jaz.verzia "nemá","slovenská", a rozne ine . s sY=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,32)) ;titulky "slovenské", "maïarské", a rozne ine . d . . if sX="nemá" d . . . if sT215c'="" s sT215c=sT215c_", " . . . s sT215c=sT215c_"bez zvuku" . . . if sY="slovenské" s sT101j="slo" q . . . if sY="èeské" s sT101j="cze" q . . . if sY="nemecké" s sT101j="ger" q . . . if sY="maïarské" s sT101j="hun" q . . . if sY="anglické" s sT101j="eng" q . . . s sT101j=sY . . . q . . else d . . . if sX'="" d . . . . if sT215c'="" s sT215c=sT215c_", " . . . . s sT215c=sT215c_"zvukový záznam" . . . . if sX="slovenská" s sT101a="slo" q . . . . if sX="èeská" s sT101a="cze" q . . . . if sX="nemecká" s sT101a="ger" q . . . . if sX="maïarská" s sT101a="hun" q . . . . if sX="anglická" s sT101a="eng" q . . . . s sT101a=sX . . s sT101="" . if (sT101a'="") || (sT101j'="") d . s sT101="101 0 " . if sT101a'="" s sT101=sT101_$c(31)_"a"_sT101a . if sT101j'="" s sT101=sT101_$c(31)_"j"_sT101j . if sT101="101 0 " s sT101="" . . . s sT215="215 " . if sT215a'="" s sT215=sT215_$c(31)_"a"_sT215a . if sT215c'="" s sT215=sT215_$c(31)_"c"_sT215c . if sT215d'="" s sT215=sT215_$c(31)_"d"_sT215d . if sT215="215 " s sT215="" . . . s sX=$g(^TMP("VL",idMSAT001,"VL",idMSAT001ori,34)) ;periodicita . s sT110="" . d . . if sX=1 s sT110=" c" q . . if sX=2 s sT110=" f" q . . if sX=3 s sT110=" u" q . if sT110'="" s sT110="110 "_$c(31)_"a"_sT110 . . ; AUTORI ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . s idMSAAuth="",sT702="" . for set idMSAAuth=$o(^TMP("VL",idMSAT001,"AVL",idMSAAuth)) quit:idMSAAuth="" do . . s idMSAAuth4=$g(^TMP("VL",idMSAT001,"AVL",idMSAAuth,3)) ;kod id autora . . s idMSAAuth4=idMSAAuth4+($e(idMSAT001,1,1)*1000) . . s sT702a=$g(^TMP("AUTH",idMSAAuth4,"AUTH",3)) ;priezvisko . . s sT702b=$g(^TMP("AUTH",idMSAAuth4,"AUTH",2)) ;krstne . . s sT7023=##class(Util).leadingZero(idMSAAuth4+10000,7) . . . . s idMSAFunkcia4=$g(^TMP("VL",idMSAT001,"AVL",idMSAAuth,4)) ;fcia autora . . s idMSAFunkcia4=idMSAFunkcia4+($e(idMSAT001,1,1)*1000) . . if sT702'="" s sT702=sT702_"~" . . s sT702=sT702_"702 1 "_$c(31)_"a"_sT702a_$c(31)_"b"_sT702b . . s sT702=sT702_$c(31)_"3sfu_un_auth*"_sT7023_$c(31)_"4"_idMSAFunkcia4 . . . ; DEATILY FILMU ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . s sT423="",iT423=0 . kill sT423G . s sT607="" . s idMSADF="" . for set idMSADF=$o(^TMP("VL",idMSAT001,"DF",idMSADF)) quit:idMSADF="" do . . s sSotNaz=$g(^TMP("VL",idMSAT001,"DF",idMSADF,4)) ;sot nazov . . s sSotObs=$g(^TMP("VL",idMSAT001,"DF",idMSADF,5)) ;sot obsah . . s sSotKom=$g(^TMP("VL",idMSAT001,"DF",idMSADF,6)) ;sot komentar . . s sSotObr=$g(^TMP("VL",idMSAT001,"DF",idMSADF,7)) ;sot obraz . . . . s sSotObsLackova=$p(sSotObs,"*****",1) . . s sSotObsLackova=##class(Util).trim(sSotObsLackova) . . s sSotObsIni=$p(sSotObs,"*****",2) . . s sSotObsIni=##class(Util).trim(sSotObsIni) . . if sSotObsIni="" d ;ak nie su ***** su to ini . . . s sSotObsIni=sSotObsLackova s sSotObsLackova="" . . . . s sSotCislo="" . . if $e($p(sSotObsLackova," ",$l(sSotObsLackova," ")),1,1)="(" d ;odd.zatvorka . . . s sSotCislo=$p(sSotObsLackova," ",$l(sSotObsLackova," ")) ;posledny field . . . s sSotObsLackova=$p(sSotObsLackova," ",1,$l(sSotObsLackova," ")-1) ;po posledny field . . if $e($p(sSotObsLackova," ",$l(sSotObsLackova," ")),1,1)="/" d ;odd lomitko . . . s sSotCislo=$p(sSotObsLackova," ",$l(sSotObsLackova," ")) ;posledny field . . . s sSotObsLackova=$p(sSotObsLackova," ",1,$l(sSotObsLackova," ")-1) ;po posledny field . . . . ;463 1 $12001 $aEkonom$vRoè. 37, è. 46 (1993), s. 25 . . if (sSotNaz'="") || (sSotCislo'="") || (sSotObs'="") || (sSotKom'="") || (sSotObr'="") d . . . s sT423=sT423_"423 " . . . s sT423=sT423_$c(31)_"1" ;tag001 . . . if (sSotNaz'="") || (sSotCislo'="") d . . . . s sT423=sT423_"2001 " ;tag200 . . . . if sSotNaz'="" s sT423=sT423_$c(31)_"a"_sSotNaz . . . . if sSotCislo'="" s sT423=sT423_$c(31)_"h"_sSotCislo . . . if (sSotObs'="") || (sSotKom'="") || (sSotObr'="") d . . . . if sSotObsLackova'="" s sT423=sT423_$c(31)_"1C2311"_$c(31)_"a"_sSotObsLackova . . . . if sSotObsIni'="" s sT423=sT423_$c(31)_"1C2310"_$c(31)_"a"_sSotObsIni . . . . if sSotKom'="" s sT423=sT423_$c(31)_"1C232 "_$c(31)_"a"_sSotKom . . . . if sSotObr'="" s sT423=sT423_$c(31)_"1C233 "_$c(31)_"a"_sSotObr . . . s iT423=iT423+1 . . . s sT423G(iT423)=sT423 . . . s sT423="" . . . . if sSotObs'="" d . . . ;***** O problémoch a novinkách turistického ruchu u nás hovorí riadite¾ n.p. Turista, vedúci Zochovej chaty, lyžiari v teréne a mnohí ïalší. . . . ;Kde: Poprad - stanica. Nízke Tatry - Chopok. Tále. Zochova chata. Vrátna. Martinské hole. Bumbálka. Horský hotel Bezovec. Vysoké Tatry - Štrbské Pleso. Ždiar. . . . ;Kto: Lyžiari. Riadite¾ TURISTU. Ivièiè - vedúci Zochovej chaty. . . . ;Kedy: Zima. . . . ;Èo: Problémy a epizódy z oblasti turistického ruchu. . . . . . . s sSotKde=$p(sSotObsIni,"Kde:",2) ;za "kde" pred kto . . . s sSotKde=$p(sSotKde,"Kto:",1) . . . . . . s sSotKto=$p(sSotObsIni,"Kto:",2) . . . s sSotKto=$p(sSotKto,"Kedy:",1) . . . . . . s sSotKedy=$p(sSotObsIni,"Kedy:",2) . . . s sSotKedy=$p(sSotKedy,"Èo:",1) . . . . . . s sSotCo=$p(sSotObsIni,"Èo:",2) . . . . . . n j . . . for j=1:1:..fc(sSotKto,".")-1 d . . . .;"kto" nebol v poziadavkach na konverziu,ale su tan zaujimave data. Ak,da sa zmazat. . . . . s sX=$zstrip($p(sSotKto,".",j),"<>W") . . . . if sX'="" d . . . . . if sT600'="" s sT600=sT600_"~" . . . . . s sT600=sT600_"600 1 "_$c(31)_"a"_sX . . . . . . for j=1:1:..fc(sSotCo,".")-1 d . . . . s sX=$zstrip($p(sSotCo,".",j),"<>W") . . . . if sX'="" d . . . . . if sT606'="" s sT606=sT606_"~" . . . . . s sT606=sT606_"606 1 "_$c(31)_"a"_sX . . . . . . s sMax=..fc(sSotKde,".") . . . if ..fc(sSotKedy,".")>sMax s sMax=..fc(sSotKedy,".") . . . for j=1:1:sMax-1 d . . . . s sX=$zstrip($p(sSotKde,".",j),"<>W") . . . . if sX'="" d . . . . . if sT607'="" s sT607=sT607_"~" . . . . . s sT607=sT607_"607 1 "_$c(31)_"a"_sX . . . . s sX=$zstrip($p(sSotKedy,".",j),"<>W") . . . . if sX'="" d . . . . . s sT607=sT607_$c(31)_"z"_sX . . . ; ZAPIS DO SUBORU CAT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . . if sT200a="" s cSum=cSum-1 q . . use ofi . w "# @id SfuUnCat new" . w !,"001 new" . w !,sT000 . w !,##class(MARC).genT005(1) . w !,sT100 . if sT101'="" w !,sT101 . w !,sT102 . if sT110'="" w !,sT110 . w !,sT150 . w !,sT152 . w !,sT200 . if sT210'="" w !,sT210 . if sT215'="" w !,sT215 . if sT330'="" w !,sT330 . . if iT423>0 d . . s sX="" . . for set sX=$o(sT423G(sX)) quit:sX="" do . . . w !,$g(sT423G(sX)) . . if sT600'="" d . . for jj=1:1:..fc(sT600,"~") w !,$p(sT600,"~",jj) . . if sT606'="" d . . for jj=1:1:..fc(sT606,"~") w !,$p(sT606,"~",jj) . . if sT607'="" d . . for jj=1:1:..fc(sT607,"~") w !,$p(sT607,"~",jj) . . if sT702'="" d . . for jj=1:1:..fc(sT702,"~") w !,$p(sT702,"~",jj) . w !,sT801 . w !,sT970 . if sTU01'="" w !,sTU01 . if sT977'="" w !,sT977 . w !,sTC99 . w !,sT999 . w !,"###",! close ofi use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov SfuUnCat = ",cSum w !,"------------------------------------------------------------------------" ; AUTORITY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; s ofi="d:\1\4\SFU_Exp"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi s sDatAkt=$e(##class(MARC).genT005(),1,8) s sT000="000 00198nx 22000973 450" s sT100="100 "_$c(31)_"a"_sDatAkt_"asloy0103 ba" s sT152="152 "_$c(31)_"a"_"AACR2" s sT801="801 0 "_$c(31)_"a"_"SK"_$c(31)_"b"_"BAC002"_$c(31)_"c"_sDatAkt s sT999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_"SFU"_$c(31)_"c"_"SFU"_$c(31)_"d"_"aRLU-"_sDatAkt s c=0,cSum=0 s idMSAAT001="" for set idMSAAT001=$o(^TMP("AUTH",idMSAAT001)) quit:idMSAAT001="" do . ;for set idMSAAT001=$o(^TMP("AUTH",idMSAAT001)) quit:idMSAAT001="1002" do . . s idARLT001=##class(Util).leadingZero(idMSAAT001+10000,7) . . s c=c+1,cSum=cSum+1 . . s sT200b=$g(^TMP("AUTH",idMSAAT001,"AUTH",2)) . s sT200a=$g(^TMP("AUTH",idMSAAT001,"AUTH",3)) . s sT200="" . if (sT200a'="") || (sT200b'="") d . . s sT200="200 1 " . . if sT200a'="" s sT200=sT200_$c(31)_"a"_sT200a . . if sT200b'="" s sT200=sT200_$c(31)_"b"_sT200b . . s sTC99="C99 "_$c(31)_"aMSA"_idMSAAT001 . . . ; ZAPIS DO SUBORU AUTH ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . use ofi . w "# @id SfuUnAuth "_idARLT001 . w !,"001 "_idARLT001 . w !,sT000 . w !,##class(MARC).genT005(1) . w !,sT100 . w !,sT152 . w !,sT200 . w !,sT801 . w !,sTC99 . w !,sT999 . w !,"###",! close ofi use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov SfuUnAuth = ",cSum w !,"------------------------------------------------------------------------" ; HESLA: RODY, DRUHY, ZANRE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; s ofi="d:\1\4\SFU_Exp"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi s sDatAkt=$e(##class(MARC).genT005(),1,8) s sT000="000 00198nx 22000973 450" s sT100="100 "_$c(31)_"a"_sDatAkt_"asloy0103 ba" s sT152="152 "_$c(31)_"a"_"AACR2" s sT801="801 0 "_$c(31)_"a"_"SK"_$c(31)_"b"_"BAC002"_$c(31)_"c"_sDatAkt s sT999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_"SFU"_$c(31)_"c"_"SFU"_$c(31)_"d"_"aRLU-"_sDatAkt s c=0,cSum=0 s sFileName="d:\1\sfu\9\2\ciselniky\rody.txt" ;w !,"otvaram subor: "_sFileName use ofiprot w !," ======================================" w !," Otvaram subor: "_sFileName w !," ======================================" open sFileName:(/READ):0 s te=$test if te=1 d w " ok" else d w " not ok" q use sFileName:/POSITION=0 d $ZU(68,40,1) n brk2,c2,li s brk2=0,c2=0,li="",id250T001="" for q:brk2 d . use sFileName . read li if $zeof'=0 s brk2=1 . if li="" q . s c=c+1,cSum=cSum+1 . if c>1 d ;1.riadok je hlavicka . . s sT250a=$zcvt($p(li,"~",2),"l") . . s sT250a=##class(Util).trim(sT250a) . . s sT250="250 "_$c(31)_"a"_sT250a . . s sT980="980 "_$c(31)_"xR" . . s id250T001=##class(Util).leadingZero($p(li,"~",1)+10100,7) . . s sTC99="C99 "_$c(31)_"aMSA-RODY"_##class(Util).leadingZero(c-1,4) . . . . ; ZAPIS DO SUBORU AUTH RODY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . . use ofi . . w "# @id SfuUnAuth "_id250T001 . . w !,"001 "_id250T001 . . w !,sT000 . . w !,##class(MARC).genT005(1) . . w !,sT100 . . w !,sT152 . . w !,sT250 . . w !,sT801 . . w !,sT980 . . w !,sTC99 . . w !,sT999 . . w !,"###",! close ofi close sFileName use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov SfuUnAuth RODY = ",cSum-1 w !,"------------------------------------------------------------------------" s ofi="d:\1\4\SFU_Exp"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi s sDatAkt=$e(##class(MARC).genT005(),1,8) s sT000="000 00198nx 22000973 450" s sT100="100 "_$c(31)_"a"_sDatAkt_"asloy0103 ba" s sT152="152 "_$c(31)_"a"_"AACR2" s sT801="801 0 "_$c(31)_"a"_"SK"_$c(31)_"b"_"BAC002"_$c(31)_"c"_sDatAkt s sT999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_"SFU"_$c(31)_"c"_"SFU"_$c(31)_"d"_"aRLU-"_sDatAkt s c=0,cSum=0 s sFileName="d:\1\sfu\9\2\ciselniky\druhy.txt" ;w !,"otvaram subor: "_sFileName use ofiprot w !," ======================================" w !," Otvaram subor: "_sFileName w !," ======================================" open sFileName:(/READ):0 s te=$test if te=1 d w " ok" else d w " not ok" q use sFileName:/POSITION=0 d $ZU(68,40,1) n brk2,c2,li s brk2=0,c2=0,li="",id250T001="" for q:brk2 d . use sFileName . read li if $zeof'=0 s brk2=1 . if li="" q . s c=c+1,cSum=cSum+1 . if c>1 d ;1.riadok je hlavicka . . s sT250a=$zcvt($p(li,"~",2),"l") . . s sT250a=##class(Util).trim(sT250a) . . s sT250="250 "_$c(31)_"a"_sT250a . . s sT980="980 "_$c(31)_"xK" . . s id250T001=##class(Util).leadingZero($p(li,"~",1)+10200,7) . . s sTC99="C99 "_$c(31)_"aMSA-DRUHY"_##class(Util).leadingZero(c-1,4) . . . . ; ZAPIS DO SUBORU AUTH DRUHY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . . use ofi . . w "# @id SfuUnAuth "_id250T001 . . w !,"001 "_id250T001 . . w !,sT000 . . w !,##class(MARC).genT005(1) . . w !,sT100 . . w !,sT152 . . w !,sT250 . . w !,sT801 . . w !,sT980 . . w !,sTC99 . . w !,sT999 . . w !,"###",! close ofi close sFileName use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov SfuUnAuth DRUHY = ",cSum-1 w !,"------------------------------------------------------------------------" s ofi="d:\1\4\SFU_Exp"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi s sDatAkt=$e(##class(MARC).genT005(),1,8) s sT000="000 00198nx 22000973 450" s sT100="100 "_$c(31)_"a"_sDatAkt_"asloy0103 ba" s sT152="152 "_$c(31)_"a"_"AACR2" s sT801="801 0 "_$c(31)_"a"_"SK"_$c(31)_"b"_"BAC002"_$c(31)_"c"_sDatAkt s sT999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_"SFU"_$c(31)_"c"_"SFU"_$c(31)_"d"_"aRLU-"_sDatAkt s c=0,cSum=0 s sFileName="d:\1\sfu\9\2\ciselniky\zanre.txt" ;w !,"otvaram subor: "_sFileName use ofiprot w !," ======================================" w !," Otvaram subor: "_sFileName w !," ======================================" open sFileName:(/READ):0 s te=$test if te=1 d w " ok" else d w " not ok" q use sFileName:/POSITION=0 d $ZU(68,40,1) n brk2,c2,li s brk2=0,c2=0,li="",id250T001="" for q:brk2 d . use sFileName . read li if $zeof'=0 s brk2=1 . if li="" q . s c=c+1,cSum=cSum+1 . if c>1 d ;1.riadok je hlavicka . . s sT250a=$zcvt($p(li,"~",2),"l") . . s sT250a=##class(Util).trim(sT250a) . . s sT250="250 "_$c(31)_"a"_sT250a . . s sT980="980 "_$c(31)_"xH" . . s id250T001=##class(Util).leadingZero($p(li,"~",1)+10300,7) . . s sTC99="C99 "_$c(31)_"aMSA-ZANRE"_##class(Util).leadingZero(c-1,4) . . . . ; ZAPIS DO SUBORU AUTH ZANRE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . . use ofi . . w "# @id SfuUnAuth "_id250T001 . . w !,"001 "_id250T001 . . w !,sT000 . . w !,##class(MARC).genT005(1) . . w !,sT100 . . w !,sT152 . . w !,sT250 . . w !,sT801 . . w !,sT980 . . w !,sTC99 . . w !,sT999 . . w !,"###",! close ofi close sFileName use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov SfuUnAuth ZANRE = ",cSum-1 w !,"------------------------------------------------------------------------" w !!,"Koniec protokolu ", $zdt($h,4) close ofiprot use sOLDIO w !,"Fáza 2: ukonèená OK" q ]]> --------------------------------------------- d ##class(UtilConv).IpvzConvCatl() vyvolanie programu 11.05.04 pb; program na konverziu dat IPVZ 1 error . d $ZU(68,40,0) . use sOLDIO w !,c_" record processed - ok ",$zdt($h,4) . close ofi . . use ofiprot w !," ======================================" . w !!,c_" record processed - ok " . w !!,"Import IPVZ ukonceny ",$zdt($h,4) . close ofiprot q ]]> Triedy pre konverziu Par Eurovoc - tu je to len na ukazku posledna verzia programov je v triede ParSEurovoc - viz. C:\Delphi\cache\cdl\par\ParSEurovoc.rar ##class(xx).EV() vyvolanie programu 17.12.03 pb; program na import dat Eurovocu a manipulaciu s TestUnAuth 1 ; ; ; ;1 ;Aarhus ; ; ;5075 ;Abruzzi ; ;w !,sFile ;w !,sLang d SetPDefIO^%NLS("UTF8",3) ;n nCi,nCj,ii,jj,bDataStatus s nCi=$l(sFile,",") s nCj=$l(sLang,",") ;w !,nCi,!,nCj f ii=1:1:nCi d . ;w nCi_".."_nCj_" ..."_ii . s sFileCurr=$p(sFile,",",ii) . ;w !,ii,"##",sFileCurr w !,$e(sFileCurr,$l(sFileCurr),$l(sFileCurr)) . if $e(sFileCurr,$l(sFileCurr),$l(sFileCurr))="_" d . . f jj=1:1:nCj d . . . ;w nCi_".."_nCj_" 2..."_ii_",,,"_jj . . . s sOsFile=sCesta_sFileCurr_$p(sLang,",",jj)_".xml" . . . s bDataStatus="" . . . d lProcess1(sOsFile) . else d . . s sOsFile=sCesta_sFileCurr_".xml" . . s jj=0 . . s bDataStatus="" . . d lProcess1(sOsFile) w !,"Faza 1: ukoncena OK" q lProcess1(sOsFile) w !,"otvaram subor: "_sOsFile d ImportOpenFile ;w "ss",$test,"ss " q ImportOpenFile ;if 'bUnicode { open sOsFile:(/READ):0 } else { open ifi:("RK\SAME\":/READ):0} ;w !,"otvaram2 subor: "_sOsFile open sOsFile:(/READ):0 n te s te=$test ;use sOLDIO w " ",te,"==",ii,"===",jj," " if te=1 d w " ok" else w " not ok" ;if ii=1,jj=1,te=0 ztrap "failed to open file 'desc_cz.xml'",sOsFile if te=1 d . use sOLDIO . ;n time1 s time1=$ztimestamp w !,$ztimestamp w " ??" . ;w " ",sOsFile . use sOsFile . use sOsFile:/POSITION=0 . ;use sOLDIO w " !!" . d $ZU(68,40,1) . ;use sOLDIO w ":",! . n brk,c,pg,li s brk=0,c=0,pg=0,li="" . for q:brk d . . use sOsFile . . read li if $zeof'=0 s brk=1 . . . . s li=##class(Util).diaTREscape(li) . . . . s c=c+1,pg=pg+1 . . ;use sOLDIO w !,li . . if c=1 d . . .; use sOLDIO w !,li . . . if $f(li,"UTF-8")>0 d . . . . s bDataStatus=1, sRow="", sRowOld="" . . . . use sOLDIO w ! . . . else s brk=1 . . if sVersion="" d . . . if $f(li,"DESCRIPTEUR LNG")>0 d ; . . . . s li=##class(User.Util).strswap(li,$c(34),"") . . . . if $f(li,"VERSION=3")>0 s sVersion=3 . . . . if $f(li,"VERSION=4")>0 s sVersion=4 . . . . use sOLDIO w "Eurovoc Version=",sVersion,! . . . . if bDataStatus=1 d . . . d lProcess1Row . . .;use sOLDIO w !,li . . . if pg'<500 d use sOLDIO w "." s pg=0 q . use sOLDIO close sOsFile . ; enable error . d $ZU(68,40,0) . w !,c_" record processed - ok " q lProcess1Row /*1Aarhus */ s sRow=sRow_li if $e(li,1,8)="") . d lProces1Init . n brk,i,j,nCi,nCj s nCi=$l(sRow,"<") . for i=1:1:nCi d . . s brk=0, nCj=0 . . for j=1:1:999 q:brk d . . . ;use sOLDIO w !,j,"..", $e($p(sRow,"<",i),1,$l(sParm(j))),"....",sParm(j) . . . if $e($p(sRow,"<",i),1,$l(sParm(j)))=sParm(j) d . . . . if $d(sParm(j,2))=1 s sParm(j,2)=sParm(j,2)_"**" d . . . . else s sParm(j,2)="" . . . . s nCj=nCj+1, sParm(j,2)=sParm(j,2)_##class(Util).trim($e($p(sRow,"<",i),$l(sParm(j))+1,9999)) . . . ;w "###",$d(sParm(j+1)) . . . . . . if ($d(sParm(j+1))=0) || ($d(sParm(j+1))=10) s brk=1 . s sRowOld=sRow . s sRow="", sId="" . if ii=1 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,11+0+(jj*3)-3)=$g(sParm(2,2)) ;*desc, poz.11 + 3 pre jazykovu mutaciu . if ii=2 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,jj)=$g(sParm(2,2)) ;*thes . if ii=3 d . . s sId=$g(sParm(2,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,1)=$g(sParm(1,2)) . . s ^tmpEurovoc(sDbName,sId,2)=$g(sParm(3,2)) ;*desc_thes . if ii=4 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,4)=$g(sParm(2,2)) ;*relation_bt . if ii=5 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,5)=$g(sParm(2,2)) ;*relation_rt . if ii=6 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,11+1+(jj*3)-3)=$g(sParm(2,2)) ;*sn,poz.12 + 3 pre jazykovu mutaciu . if ii=7 d . . s sId=$g(sParm(1,2)) . . ;if sId="" q . . s ^tmpEurovoc(sDbName,sId,11+2+(jj*3)-3)=$g(sParm(2,2)) ;*uf, poz.13 + 3 pre jazykovu mutaciu q lProces1Init if ii=2 d s sDbName="THES" else s sDbName="DESCR" kill sParm if ii=1 s sParm(1)="DESCRIPTEUR_ID", sParm(2)="LIBELLE" ; desc if ii=2 s sParm(1)="THESAURUS_ID", sParm(2)="LIBELLE" ; thes if ii=3 s sParm(1)="THESAURUS_ID", sParm(2)="DESCRIPTEUR_ID", sParm(3)="TOPTERM" ;* desc_thes if ii=4 s sParm(1)="SOURCE_ID", sParm(2)="CIBLE_ID" ;* relation_bt if ii=5 s sParm(1)="DESCRIPTEUR1_ID",sParm(2)="DESCRIPTEUR2_ID" ;* relation_rt if ii=6 s sParm(1)="DESCRIPTEUR_ID", sParm(2)="SN" ; sn if ii=7 s sParm(1)="DESCRIPTEUR_ID", sParm(2)="UF_EL" ; uf q xCommand2(Xcmd) w !,"Faza 2: tvorba vertikalnych a horizontalnych vazieb, tvorba prepojovacieho mostiku hesiel z Eurovocu" s brk="" s sId=$o(^tmpEurovoc("DESCR","")), sPos="" for q:brk d . use sOLDIO . if $d(^tmpEurovoc("DESCR",sId,4))=1 d . . for j=1:1:..fc(^tmpEurovoc("DESCR",sId,4),"**") d . . . s sIdCross=$p(^tmpEurovoc("DESCR",sId,4),"**",j) . . . ;w ".4.",sIdCross,",," . . . if $d(^tmpEurovoc("DESCR",sIdCross,3))=1 d . . . . if ##class(Util).locate(sId,^tmpEurovoc("DESCR",sIdCross,3),"**")=0 d . . . . . s ^tmpEurovoc("DESCR",sIdCross,3)=^tmpEurovoc("DESCR",sIdCross,3)_"**" . . . else s ^tmpEurovoc("DESCR",sIdCross,3)="" . . . if ##class(Util).locate(sId,^tmpEurovoc("DESCR",sIdCross,3),"**")=0 d . . . . s ^tmpEurovoc("DESCR",sIdCross,3)=^tmpEurovoc("DESCR",sIdCross,3)_sId . . if $d(^tmpEurovoc("DESCR",sId,5))=1 d . . for j=1:1:..fc(^tmpEurovoc("DESCR",sId,5),"**") d . . . s sIdCross=$p(^tmpEurovoc("DESCR",sId,5),"**",j) . . . ;w ".5.",sIdCross,",," . . . if $d(^tmpEurovoc("DESCR",sIdCross,5))=1 d . . . . if ##class(Util).locate(sId,^tmpEurovoc("DESCR",sIdCross,5),"**")=0 d . . . . . s ^tmpEurovoc("DESCR",sIdCross,5)=^tmpEurovoc("DESCR",sIdCross,5)_"**" . . . else s ^tmpEurovoc("DESCR",sIdCross,5)="" . . . if ##class(Util).locate(sId,^tmpEurovoc("DESCR",sIdCross,5),"**")=0 d . . . . s ^tmpEurovoc("DESCR",sIdCross,5)=^tmpEurovoc("DESCR",sIdCross,5)_sId . . for jj=1:1:5 d . . if $d(^tmpEurovoc("DESCR",sId,11+0+(jj*3)-3))=1 d . . . s sTitle=$g(^tmpEurovoc("DESCR",sId,11+0+(jj*3)-3))_"_"_$p(sLang,",",jj) . . . s sTitle=$zcvt(sTitle,"u") . . . s ^tmpEurovoc("MOSTT",sTitle,2)=sId . . ;* premostenie do mikrotezauru . if $g(^tmpEurovoc("DESCR",sId,2))="O" d . . s sIdCross=$g(^tmpEurovoc("DESCR",sId,1)) . . s sX=$g(^tmpEurovoc("DESCR",sId,4)) . . if sX'="" s sX=sX_"**" . . s sX=sX_sIdCross . . s ^tmpEurovoc("DESCR",sId,4)=sX . . s sIdCrossDole=$g(^tmpEurovoc("THES",sIdCross,13)) . . if ##class(Util).locate(sId,sIdCrossDole,"**")=0 d . . . if sIdCrossDole'="" s sIdCrossDole=sIdCrossDole_"**" . . . s sIdCrossDole=sIdCrossDole_sId . . . s ^tmpEurovoc("THES",sIdCross,13)=sIdCrossDole . . s sId=$o(^tmpEurovoc("DESCR",sId)) . if sId="" s brk=1 w !,"Faza 2: ukoncena OK" q xCommand3(Xcmd) w !,"Faza 3: tvorba prepojovacieho mostiku hesiel z TestUnAuth, zapis id Eurovoc do TestUnAuth (iba pre import Eurovoc 3)" d ##class(Util).XselIndex("TestUnAuth T001 < 0030000") n id s id="" w ! s c=0,cr=0 for set id=$o(^Lists("tmp",$j,id)) quit:id="" do . s idArlT001=##class(MARC).getT001(id) . if '##class(MARC).getDATAX(.handle,id) w !,"Error reading record by id="_id ztrap "EV1" q . s sT250=##class(MARC).getTagX(.handle,"250") . s sT250a=##class(MARC).getSubTagStr(sT250,"a") . s sT250y=##class(MARC).getSubTagStr(sT250,"y") . s sTC99=##class(MARC).getTagX(.handle,"C99") . s sTC99a=##class(MARC).getSubTagStr(sTC99,"a") . ;if sT250a'="", id=5332126 d . if sT250a'="" d . . ;w !,sT250a,!,sT250y . . s nMikroTez=$e(sT250a,1,4) . . ;w !,##class(Util).isInteger(nMikroTez) . . if '(nMikroTez?4N) d ;* bez mikrotezaura . . . if sT250y'="ID" d ;* bez lokalnych hesiel 10.02.04 pb; . . . if (sT250y'="ID") && (sT250y'="NE") && (sT250y'="QU") d ;* bez lokalnych hesiel . . . . s c=c+1,cr=cr+1 . . . . if c=200 d w "." s c=0 . . . . s sTitle=sT250a_"_cz" . . . . s sTitle=$zcvt(sTitle,"u") . . . . s ^tmpEurovoc("MOSTT",sTitle,1)=id . . . . ;if $g(^tmpEurovoc("MOSTT",sTitle,2))'="" s ^tmpEurovoc("MOSTT",sTitle,3)=id_" nasiel" . . . . . . . . if (sVersion=3) && (sT250'="") d . . . . . s sTC99a=$g(^tmpEurovoc("MOSTT",sTitle,2)) . . . . . if sTC99a'="" d . . . . . . if sTC99="" d . . . . . . . s sTC99="C99 "_$c(31)_"a"_sTC99a . . . . . . else . . . . . . . s sTC99=##class(MARC).setSubTagStr(sTC99,$c(31)_"a") ;vymaz, ak uz je . . . . . . . s sTC99=##class(MARC).setSubTagStr(sTC99,$c(31)_"a"_sTC99a) . . . . . . d ##class(MARC).setTagX(.handle,sTC99) . . . . . . d ##class(MARC).sortLinesX(.handle) . . . . . . d ##class(MARC).writeX(.handle) . . . . . . . . if sVersion=4 d . . . . . if sTC99a'="" d ;ak existuje kluc v TestUnAuth . . . . . . s ^tmpEurovoc("DESCR",sTC99a,99)=sTC99a . . . . . . s ^tmpEurovoc("DESCR",sTC99a,98)=id . . . . . . s ^tmpEurovoc("DESCR",sTC99a,97)=idArlT001 . . . . . . . . . . . . s ^tmpEurovoc("MOSTI","ID",id)=sTC99a . . . . . . s ^tmpEurovoc("MOSTI","T001",idArlT001)=sTC99a . . . . . . . . s sT450=##class(MARC).getTagX(.handle,"450",-1) ;deskriptory cudzojazycne . . . . s sLangEN="",sLangFR="",sLangDE="" . . . . for i=1:1:..fc(sT450,$c(10)) d . . . . . s sT450a=##class(MARC).getSubTagStr($p(sT450,$c(10),i),"a") . . . . . s sT450y=##class(MARC).getSubTagStr($p(sT450,$c(10),i),"y") . . . . . s sLangX=sT450y . . . . . ;w !,sLangX . . . . . if sLangX="EN" if sLangEN="" d . . . . . . s sLangEN="EN" . . . . . . s sDescrX=sT450a_"_en" . . . . . . s sDescrX=$zcvt(sDescrX,"u") . . . . . . s ^tmpEurovoc("MOSTT",sDescrX,1)=id q . . . . . if sLangX="FR" if sLangFR="" d . . . . . . . s sLangFR="FR" . . . . . . s sDescrX=sT450a_"_fr" . . . . . . s sDescrX=$zcvt(sDescrX,"u") . . . . . . s ^tmpEurovoc("MOSTT",sDescrX,1)=id q . . . . . if sLangX="DE" if sLangDE="" d . . . . . . . s sLangDE="DE" . . . . . . s sDescrX=sT450a_"_de" . . . . . . s sDescrX=$zcvt(sDescrX,"u") . . . . . . s ^tmpEurovoc("MOSTT",sDescrX,1)=id q if cr>0 d w !,cr," spracovanych viet obsahujucich hesla",!,"Faza 3: ukoncena OK" else w !,"Faza 3: ukoncena NOT OK" q ]]> Triedy pre konverziu Par Eurovoc - tu je to len na ukazku posledna verzia programov je v triede ParSEurovoc - viz. C:\Delphi\cache\cdl\par\ParSEurovoc.rar 1 0 d ;w !,id,sPos,$g(^tmpEurovoc("DESCR",id,sPos)),! if $g(^tmpEurovoc("DESCR",id,sPos))'="" d . s sDescrEV=$g(^tmpEurovoc("DESCR",id,sPos)) . s sDescrEV=$zcvt(sDescrEV,"L") .; w sDescrX,"," . s sDescrX=$zcvt(sDescrX,"L") . ;w !,sDescrX,".==" . ;w sDescrEV,".",sDescrX,";",$l(sDescrEV,"**"),"%" . for i=1:1:..fc(sDescrEV,"**") d . . s sDescrEV1=$p(sDescrEV,"**",i) . . ;w "#",sDescrEV1,"#" . . if ##class(Util).locate(sDescrEV1,sDescrX,"**")=0 d . . . s cErr=cErr+1 . . . if cErr=1 d . . . . w ! . . . else w !," " . . . w "Eurovoc id=",id,": nenajdeny ",sLangX," ",sTyp,"deskriptor=",$c(34),sDescrEV1,$c(34) . . . if sTyp=" " d w " (",$c(34),sDescrX,$c(34),")","=OLD" . . . if cErr=1 w "; TestUnAuth id=",idArlT001 q xCommand4Protokol2 ;if $j>0 d if $g(^tmpEurovoc("DESCR",sTC99a,sPos))'="" d . s sDescrEV=$g(^tmpEurovoc("DESCR",sTC99a,sPos)) . s sDescrEV=$zcvt(sDescrEV,"l") . s sDescrX=$zcvt(sDescrX,"l") . if ##class(Util).locate(sDescrX,sDescrEV,"**")=0 d . . s cErr=cErr+1 . . if cErr=1 d . . . w ! . . else w !," " . . w "TestUnAuth id=",idArlT001,": nenajdeny ",sLangX," ",sTyp,"deskriptor=",$c(34),sDescrX,$c(34) . . if sTyp=" " d w " (",$c(34),sDescrEV,$c(34),")","=NEW" q ]]> ]]> 1 [Previously private]]]> 1 0 d ;w !,id,sPos,$g(^tmpEurovoc("DESCR",id,sPos)),! if $g(^tmpEurovoc("DESCR",id,sPos))'="" d . s sDescrEVOri=$g(^tmpEurovoc("DESCR",id,sPos)) . s sDescrEV=$zcvt(sDescrEVOri,"L") .; w sDescrX,"," . s sDescrX=$zcvt(sDescrX,"L") . ;w !,sDescrX,".==" . ;w sDescrEV,".",sDescrX,";",$l(sDescrEV,"**"),"%" . for i=1:1:..fc(sDescrEV,"**") d . . s sDescrEV1=$p(sDescrEV,"**",i) . . s sDescrEV1Ori=$p(sDescrEVOri,"**",i) . . ;w "#",sDescrEV1,"#" . . . . if sPos=11 d . . . s sTx50x=sT250x . . else s sTx50x=sT450x . . s sPoznEV=$g(^tmpEurovoc("DESCR",id,sPos+1)) . . s bSN="" . . if (sTx50x'=sPoznEV) && (sTyp=" ") s bSN=1 . . s bNewDescr="" . . if ##class(Util).locate(sDescrEV1,sDescrX,"**")=0 s bNewDescr=1 . . . . if (bNewDescr=1) || (bSN=1) d . . . ;* nenasiel= novy descr/nedescr alebo zmena poznamky = status UPD . . . . . . s cErr=cErr+1 . . . if cErr=1 d . . . . w ! . . . else w !," " . . . if bNewDescr=1 d . . . . w "Eurovoc id=",id,": nenajdeny ",sLangX," ",sTyp,"deskriptor=",$c(34),sDescrEV1Ori,$c(34) . . . . if sTyp=" " d w " (",$c(34),sDescrX,$c(34),")","=OLD" . . . . if cErr=1 w "; TestUnAuth id=",idArlT001 . . . if bSN=1 d . . . . w "Eurovoc id=",id,": nenajdena ",sLangX," ","poznamka=",$c(34),sPoznEV,$c(34) . . . . if sTyp=" " d w " (",$c(34),sTx50x,$c(34),")","=OLD" . . . . if cErr=1 w "; TestUnAuth id=",idArlT001 . . . . s cNewPozn=cNewPozn+1 . . . d xCommand5Upd ;* novy retazec descr/nedescr; aktualizovat Uxx tagy, vytvorit nanovo t250,450 . . else d xCommand5Put ;* nezmeneny retazec descr/nedescr; vytvorit nanovo t250,450 q xCommand5Protokol2 ;if $j>0 d if $g(^tmpEurovoc("DESCR",sTC99a,sPos))'="" d . s sDescrEV=$g(^tmpEurovoc("DESCR",sTC99a,sPos)) . s sDescrEV=$zcvt(sDescrEV,"l") . s sDescrXOri=sDescrX . s sDescrX=$zcvt(sDescrX,"l") . . . ;w !!,sDescrX,"==",sDescrEV,";" . . if ##class(Util).locate(sDescrX,sDescrEV,"**")=0 d . . s cErr=cErr+1 . . if cErr=1 d . . . w ! . . else w !," " . . w "TestUnAuth id=",idArlT001,": nenajdeny ",sLangX," ",sTyp,"deskriptor=",$c(34),sDescrX,$c(34) . . if sTyp=" " d w " (",$c(34),sDescrEVOri,$c(34),")","=NEW" . . . . ;* ak je to deskriptor, je to uz vyriesene z porovnania EV do ARL . . ;* treba osetrit iba nenajdeny NEdeskriptor = vymazany NEdeskriptor . . d xCommand5DelU03 ;* aktualizovat Uxx tagy zapis vymazu do U03 . . ;d xCommand5Upd neuspesny pokus otocit poradie vypisu . ;else d xCommand5Put neuspesny pokus otocit poradie vypisu q xCommand5Upd ;w !!,"***********xCommand5Upd***********" s ^tmpEurovoc("REC",idArlT001,"FLAG")="UPD" ;***** zaznam bol aktualizovany n sX if sTyp=" " d ;* DESKRIPTOR . s sX="U02 "_$c(31)_"a"_sDescrX_$c(31)_"d"_sDatAkt_$c(31)_"s"_"U" ;* UPDATED . if sT250x'="" s sX=sX_$c(31)_"x"_sT250x ;* stara hodnota poznamky . s sX=sX_$c(31)_"y"_sLangX . ;* U02 nebude . ;s sUzol=$g(^tmpEurovoc("REC",idArlT001,"U02")) ;* aby neprepisal z minulych konverzii . ;if sUzol'="" s sUzol=sUzol_$c(10) . ;s sUzol=sUzol_sX . ;s ^tmpEurovoc("REC",idArlT001,"U02")=sUzol . s sX="" . if sLangX="CZ" d s sX="250 " . else s sX="450 " . s sX=sX_$c(31)_"a"_sDescrEV1Ori . if $g(^tmpEurovoc("DESCR",id,sPos+1))'="" s sX=sX_$c(31)_"x"_$g(^tmpEurovoc("DESCR",id,sPos+1)) ;*sn(poznamky) . s sX=sX_$c(31)_"y"_sLangX_$c(31)_"9"_"D" . if $e(sX,1,3)="250" s ^tmpEurovoc("REC",idArlT001,"250")=sX . . ;if $e(sX,1,3)="450" s sT450New=sT450New_$c(10)_sX . if $e(sX,1,3)="450" d . . s sUzol=$g(^tmpEurovoc("REC",idArlT001,"450")) . . if sUzol'="" s sUzol=sUzol_$c(10) . . s sUzol=sUzol_sX . . s ^tmpEurovoc("REC",idArlT001,"450")=sUzol . . q if sTyp="ne" d ;* NEDESKRIPTOR . s sX="U03 "_$c(31)_"a"_sDescrEV1Ori_$c(31)_"d"_sDatAkt_$c(31)_"s"_"N" ;* NEW . if sT450x'="" s sX=sX_$c(31)_"x"_sT450x ;* stara hodnota poznamky . s sX=sX_$c(31)_"y"_sLangX . ;* U03 nebude . ;s sUzol=$g(^tmpEurovoc("REC",idArlT001,"U03")) ;* aby neprepisal z minulych konverzii . ;if sUzol'="" s sUzol=sUzol_$c(10) . ;s sUzol=sUzol_sX . ;s ^tmpEurovoc("REC",idArlT001,"U03")=sUzol . s sX="450 " . s sX=sX_$c(31)_"a"_$zcvt(sDescrEV1Ori,"u") . s sX=sX_$c(31)_"y"_sLangX_$c(31)_"9"_"N" . . ;s sT450New=sT450New_$c(10)_sX . s sUzol=$g(^tmpEurovoc("REC",idArlT001,"450")) . if sUzol'="" s sUzol=sUzol_$c(10) . s sUzol=sUzol_sX . s ^tmpEurovoc("REC",idArlT001,"450")=sUzol q xCommand5Put ;w !!,"***********xCommand5Put***********","sTyp=",sTyp,"...",sLangX,",,,","sDescrEV1Ori=",sDescrEV1Ori,";;;" s sUzol=$g(^tmpEurovoc("REC",idArlT001,"FLAG")) if sUzol="" s ^tmpEurovoc("REC",idArlT001,"FLAG")="READ" ;**** ak este nie je oznaceny, bude oznaceny if sTyp=" " d ;* DESKRIPTOR . s sX="" . if sLangX="CZ" d s sX="250 " . else s sX="450 " . s sX=sX_$c(31)_"a"_sDescrEV1Ori . if $g(^tmpEurovoc("DESCR",id,sPos+1)) s sX=sX_$c(31)_"x"_$g(^tmpEurovoc("DESCR",id,sPos+1)) ;*sn(poznamky) . s sX=sX_$c(31)_"y"_sLangX_$c(31)_"9"_"D" . ;w !,$e(sX,1,3) . if $e(sX,1,3)="250" s ^tmpEurovoc("REC",idArlT001,"250")=sX . . ;if $e(sX,1,3)="450" s sT450New=sT450New_$c(10)_sX . if $e(sX,1,3)="450" d . . s sUzol=$g(^tmpEurovoc("REC",idArlT001,"450")) . . if sUzol'="" s sUzol=sUzol_$c(10) . . s sUzol=sUzol_sX . . s ^tmpEurovoc("REC",idArlT001,"450")=sUzol . q if sTyp="ne" d ;* NEDESKRIPTOR . s sX="450 " . s sX=sX_$c(31)_"a"_$zcvt(sDescrEV1Ori,"u") . if $g(^tmpEurovoc("DESCR",id,sPos+1)) s sX=sX_$c(31)_"x"_$g(^tmpEurovoc("DESCR",id,sPos+1)) ;*sn(poznamky) . s sX=sX_$c(31)_"y"_sLangX_$c(31)_"9"_"N" . . ;s sT450New=sT450New_$c(10)_sX . s sUzol=$g(^tmpEurovoc("REC",idArlT001,"450")) . if sUzol'="" s sUzol=sUzol_$c(10) . s sUzol=sUzol_sX . s ^tmpEurovoc("REC",idArlT001,"450")=sUzol q xCommand5DelU03 s ^tmpEurovoc("REC",idArlT001,"FLAG")="UPD" ;******* zaznam bol aktualizovany if sTyp="ne" d . s sX="U03 "_$c(31)_"a"_sDescrXOri_$c(31)_"d"_sDatAkt_$c(31)_"s"_"D" ;* DELETED . s sX=sX_$c(31)_"y"_sLangX . ;* U03 nebude . ;s sUzol=$g(^tmpEurovoc("REC",idArlT001,"U03")) ;* aby neprepisal z minulych konverzii . ;if sUzol'="" s sUzol=sUzol_$c(10) . ;s sUzol=sUzol_sX . ;s ^tmpEurovoc("REC",idArlT001,"U03")=sUzol q xCommand5Upd550 d . if sVazba="BT" s sT5505="g" q . if sVazba="NT" s sT5505="h" q . if sVazba="RT" s sT5505="z" q . s sT5505="" q if $g(^tmpEurovoc("DESCR",id,87))="" d ;* nie je to novy zaznam (ten nema U04 ani status UPD) . s ^tmpEurovoc("REC",idArlT001,"FLAG")="UPD" ;**** zaznam bol aktualizovany .;w !!,"***********xCommand5Upd550***********",idArlT001,"''",sPointerARL0,"....",sDescrX,",,,,",sVazba,";;;;",sStatus . s sX="U04 "_$c(31)_"a"_sDescrX_$c(31)_"d"_sDatAkt_$c(31)_"s"_sStatus ;* NEW/DELETE . s sX=sX_$c(31)_"v"_sVazba . s sX=sX_$c(31)_"y"_"CZ" . s sX=sX_$c(31)_"3"_"l_un_entry*"_sPointerARL0 . s sX=sX_$c(31)_"5"_sT5505 . ;* U04 nebude . ;s sUzol=$g(^tmpEurovoc("REC",idArlT001,"U04")) ;* aby neprepisal z minulych konverzii . ;if sUzol'="" s sUzol=sUzol_$c(10) . ;s sUzol=sUzol_sX . ;s ^tmpEurovoc("REC",idArlT001,"U04")=sUzol if sStatus="N" d . s sX="550 " . s sX=sX_$c(31)_"a"_sDescrX . s sX=sX_$c(31)_"y"_"CZ" . s sX=sX_$c(31)_"3"_"l_un_entry*"_sPointerARL0 . s sX=sX_$c(31)_"5"_sT5505 . s sUzol=$g(^tmpEurovoc("REC",idArlT001,"550")) ;* aby neprepisal z minulych konverzii . if sUzol'="" s sUzol=sUzol_$c(10) . s sUzol=sUzol_sX . s ^tmpEurovoc("REC",idArlT001,"550")=sUzol . ;w !,"Uzol=",sUzol q xCommand5Put550 s sUzol=$g(^tmpEurovoc("REC",idArlT001,"FLAG")) if sUzol="" s ^tmpEurovoc("REC",idArlT001,"FLAG")="READ" ;**** ak este nie je oznaceny, oznacit ako precitany ;w !!,"***********xCommand5Put550***********",idArlT001,"''",sPointerARL0,"....",sDescrX,",,,,",sVazba,";;;;",sStatus s sX="550 " s sX=sX_$c(31)_"a"_sDescrX s sX=sX_$c(31)_"y"_"CZ" s sX=sX_$c(31)_"3"_"l_un_entry*"_sPointerARL0 if sVazba="BT" s sX=sX_$c(31)_"5"_"g" if sVazba="NT" s sX=sX_$c(31)_"5"_"h" if sVazba="RT" s sX=sX_$c(31)_"5"_"z" s sUzol=$g(^tmpEurovoc("REC",idArlT001,"550")) ;* aby neprepisal z minulych konverzii if sUzol'="" s sUzol=sUzol_$c(10) s sUzol=sUzol_sX s ^tmpEurovoc("REC",idArlT001,"550")=sUzol ;w !,"Uzol=",sUzol q xCommand5DelU04 s ^tmpEurovoc("REC",idArlT001,"FLAG")="UPD" ;**** zaznam bol aktualizovany ;w !!,"***********xCommand5DelU04***********",idArlT001,"''",sPointerARL0,"....",sDescrX,",,,,",sVazba,";;;;",sStatus s sX="U04 "_$c(31)_"a"_sDescrX_$c(31)_"d"_sDatAkt_$c(31)_"s"_sStatus ;* NEW/DELETE s sX=sX_$c(31)_"v"_sVazba s sX=sX_$c(31)_"y"_"CZ" s sX=sX_$c(31)_"3"_"l_un_entry*"_sPointerARL0 d . if sVazba="BT" s sT5505="g" q . if sVazba="NT" s sT5505="h" q . if sVazba="RT" s sT5505="z" q . s sT5505="" q s sX=sX_$c(31)_"5"_sT5505 ;* U04 nebude ;s sUzol=$g(^tmpEurovoc("REC",idArlT001,"U04")) ;* aby neprepisal z minulych konverzii ;if sUzol'="" s sUzol=sUzol_$c(10) ;s sUzol=sUzol_sX ;s ^tmpEurovoc("REC",idArlT001,"U04")=sUzol ;w !,"Uzol=",sUzol q */ ]]> Triedy pre konverziu Par Eurovoc - tu je to len na ukazku posledna verzia programov je v triede ParSEurovoc - viz. C:\Delphi\cache\cdl\par\ParSEurovoc.rar 1 vytvorit prazdny . if '##class(MARC).readX(.handle,sClass,idArlT001) d . . d ##class(MARC).newX(.handle,sClass,idArlT001) . . d ##class(MARC).recordSetupT001X(.handle,3_$e(idArlT001,2,7)) ;* zapis od 3000001 . . s sTag="" . for set sTag=$o(^tmpEurovoc("REC",idArlT001,sTag)) quit:sTag="" do . . . . if sTag="000" s bT000=1 . . if sTag="100" s bT100=1 . . if sTag="150" s bT150=1 . . if sTag="152" s bT152=1 . . if sTag="801" s bT801=1 . . if sTag="999" s bT999=1 . . . . s sValue=$g(^tmpEurovoc("REC",idArlT001,sTag)) . . if sTag="FLAG" d . . . s sFlag=sValue . . else d . . . if sTag="999" d . . . . s sX999=sValue_"#aRLU-"_sDatAkt . . . else d . . . . d ##class(MARC).setTagX(.handle,sValue) . . . . ;use sOLDIO w !,sTag w "===",sValue use ofi . . if bT000="" d ##class(MARC).setTagX(.handle,sT000) . if bT100="" d ##class(MARC).setTagX(.handle,sT100) . if bT150="" d ##class(MARC).setTagX(.handle,sT150) . if bT152="" d ##class(MARC).setTagX(.handle,sT152) . if bT801="" d ##class(MARC).setTagX(.handle,sT801) . if bT999="" d . . d ##class(MARC).setTagX(.handle,sT999) . else d ##class(MARC).setTagX(.handle,sX999) . . s sTU01=##class(MARC).getTagX(.handle,"U01",-1) . s sTU01New="U01 "_$c(31)_"a"_sDatAkt . s sTU01New=sTU01New_$c(31)_"d"_sDatAkt . s sTU01New=sTU01New_$c(31)_"e"_$e(sFlag,1,1) . s sTU01New=sTU01New_$c(31)_"s"_$e(sFlag,1,1) . s sX=##class(MARC).getSubTagStr(sTU01,"t") . if sX'="" s sTU01New=sTU01New_$c(31)_"t"_sX . for i=1:1:..fc(sTU01,$c(10)) d . . s sTU01d=##class(MARC).getSubTagStr($p(sTU01,$c(10),i),"d") . . s sTU01e=##class(MARC).getSubTagStr($p(sTU01,$c(10),i),"e") . . if (sTU01d'="") || (sTU01e'="") d . . . s sTU01New=sTU01New_"U01 "_$c(31)_"d"_sTU01d_$c(31)_"e"_sTU01e . d ##class(MARC).setTagX(.handle,sTU01New) . . if sFlag'="READ" d ##class(MARC).setTagX(.handle,"005 "_##class(MARC).genT005()) . . if sFlag="READ" s cRead=cRead+1 . if sFlag="UPD" s cUpd=cUpd+1 . if sFlag="NEW" s cNew=cNew+1 . if sFlag="DEL" s cDel=cDel+1 . . . d ##class(MARC).sortLinesX(.handle) . n sc s sc=##class(MARC).writeX(.handle,1) . if sc '=1 w !,"write err id=",idArlT001 q xCommand6Sum w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov =",cNew w !,"Poèet vymazanych zaznamov =",cDel w !,"Poèet aktualizovanych zaznamov =",cUpd w !,"Poèet neaktualizovanych zaznamov =",cRead w ! w !,"Poèet zaznamov deskriptorov v TestUnAuth=",cNew+cUpd+cRead w !,"------------------------------------------------------------------------" w !!,"Koniec protokolu ", $zdt($h,4) close ofi use sOLDIO w !,"Fáza 6: ukonèená OK, protokol sa nachádza v súbore ",ofi q ]]> 04.10.04 mk nova konverzia riadkoveho formatu clavius do nasho
riadkoveho formatu, zo suboru do suboru
]]> 1 inf:%String,outf:%String="",kniznica:%String,trieda:%String error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,kod,kodold s brk=0,nkrec="",nkid="",nkid2="",li="",odd="",begin="1",hlavicka="",kod="",kodold="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . ; nacitany 1 riadok . s li=##class(Util).strswap(li,"$",$c(31)) . ;uprava jedneho riadku . if (li'="") d . . ; kontrola hlavicky 000 . . if $e(li,2,4)="LAB" d . . . s hlavicka = "" . . . ;if begin = "" s hlavicka=odd_"###" . . . if begin = "" d . . . . s hlavicka=odd_"999 "_$c(31)_"a1"_$c(31)_"b"_kniznica_$c(31)_"c"_kniznica_$c(31)_"d"_"arl-"_##class(Util).date()_odd_"###" . . . ; . . . ;"999 "_$c(31)_"a1"_$c(31)_"b"_kniznica_$c(31)_"c"_kniznica_$c(31)_"d"_spracovatel_"-"_##class(Util).date() . . . s hlavicka=hlavicka_odd_"# @id "_trieda_" new" . . . if (begin="1") s hlavicka=hlavicka_$c(10) . . . s li=##class(Util).strswap(li,"-"," ") . . . s li=##class(Util).strswap(li," LAB","000") . . . s hlavicka=hlavicka_odd_li,li="" . . ; je nacteny jeden zaznam, zpracovat . . if ($e(li,2,4)="001") d ;kod zaznamu . . . s kod = $e(li,10,$l(li)) . . . s kodold=kod . . . s kod=$zcvt(##class(Util).strswap(kod," ",""),"L") . . . s li=##class(Util).strswap(li,kodold,kod) . . . s hlavicka=##class(Util).strswap(hlavicka,"new",kod) . . . use outf w hlavicka use OU . . . s kod="" . . ; pokracuje dalsimi zaznamami . . ; . . ; . . s li=$e(li,2,$l(li)) . . ; riesenie zle zalomeneho riadku . . s odd=$c(10) . . if '##class(Util).isInteger($e(li,1,1)) s odd="" . . ; odseparovat stvrty znak ak nie je medzera . . if $e(li,4,4)'="" s li=$e(li,1,3)_$e(li,5,$l(li)) . . ; odseparovat spatne indikatory # za medzery . . if $e(li,5,5)="#" s li=$e(li,1,4)_" "_$e(li,6,$l(li)) . . if $e(li,6,6)="#" s li=$e(li,1,5)_" "_$e(li,7,$l(li)) . . ; . . if li'="" use outf w odd_li use OU . . s li="" . . s begin="" . q:$zeof'=0 . . ; zpracovat jeden radek . s li=$e(li,11,9999) s $e(li,7,8)="" . s li=##class(Util).strswap(li," "," ") if li="" q use outf w odd_"999 "_$c(31)_"a1"_$c(31)_"b"_kniznica_$c(31)_"c"_kniznica_$c(31)_"d"_"arl-"_##class(Util).date()_odd_"###" use OU close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> lg=ListGlobal 1 string:%Library.String,separator:%Library.String %Library.Integer fc=FieldCount 1 string:%Library.String,separator:%Library.String %Library.Integer 27.07.04 jj - symbolik na nasypani obsahu UNA_610a z szp do indexu a250s d ^X("s LiUnCat dk = xszp") s sy="##class(UtilConv).symFillIndex(.handle,""Li"",""a250s"",""S"",""LIA001"")" d ^X("ls") d ^X("gs") 1 1 in 463 200v 2004, roè. 4, è. 12, s. 45 out 463 200v Roè. 4, è. 12 (2004), s. 45 ]]> 1 1 in 463 200v roè. 4, è. 12, s. 45 463 210d 2004 out 463 200v Roè. 4, è. 12 (2004), s. 45 ]]> 1 1 in 700 ^aNovotny ^bJan out 700 ^aNovotny ^bJan ^3uhkt_un_auth*0000255 ]]> 1 1 14.09.04 jj; symFill463() - symbolik na doplneni podpoli $h,$i pole 463 200 dle 463 001 07.02.05 jj; oprava situace pri pridavani sT200 09.02.05 jj; doplneni "1" 1 1 ]]> 1 14.10.04 rs; Symbolik skontroluje, ci sa v zazname holdingu nachadza objednavka, faktura alebo predplatne s neplatnym odkazom. Ak ano toto bude presunute do pola 400u - poznamka k dodavatelovi s tym, ze ak pole pozn. uz nejake info predtym obsahovalo, nova info bude pripojena na koniec s oddelovacom ciarka. Priklad po vymene: "povodna pozn., faktura: XX, objednavka: YYY, predplatne: ZZZ" texty sa daju zvoli CZE (lang=2) alebo SLO (lang=1 default).
Symbolik spustime na zaznamoch holdingov, kt. obsahuju neplatne udaje v holdingu - volitelne obmedzime datumom prijmu podla dohovoru so zakaznikom.
]]> 1 (private) toto je len pomocna metoda pre symFixBadInvoiceInfo [Previously private] 1 15.10.04 pb;globalka vymaz $3 ak obsahuje iba bodku, ak nie je ani $a, vymaze tag
---]]> 1 1 %String 8 d . . . if sRiadokNew'="" s sRiadokNew=sRiadokNew_$c(10) . . . . . . s sRiadokNew=sRiadokNew_sRiadok . . ; 19.05.05 rs; nerobit zmenu ak sa nic nemeni - toto zjednodusi select . ; t.j. select zmenenych zaznamov je potom d ^X("s XxxYyy @"_sy) . if sTag=sRiadokNew q . . if sRiadokNew'="" d . . d ##class(MARC).setTagX(.handle,sRiadokNew) . else d ##class(MARC).delTagX(.handle,sTagx) ]]> ]]> 1 1 %String 11.11.04 pb; konverzia NTM - Narodne Technicke Muzeum
import z csv suboru vyexportovaneho z MS Excelu, oddelovac stlpcov je ";".
Jednym behom sa exportuje pre Uncat, vytvaraju sa pracovne globaly ^TMP, dalej sa exportuje pre UnCatH (ak je skartovane tak do UnCatHistH), a dalej exporty pre UnAuth - autority personalne, dodavatelia, vyrobcovia a hesla
d ##class(UtilConv).NtmConv() vyvolanie programu
]]> 1 1 error d $ZU(68,40,0) ]]> ]]> 1 1 31.03.05 mk; riesenie upravy vyhl. kriteria spolocne pre 200 a 210
31.03.05 mk; riesenie tagu C20 do C16
14.03.05 mk; vlozit c06 tag y krajina ak je
19.03.05 mk; doplnene generovanie aj z C20
01.12.04 ja; pripojenie globalky XGenAuth]]> 1 1 05.11.07 pb; pridany parameter nazov indexu v autoritach 18.09.09 pb; rozsirenie generovania o tagy 600,601,605,606,607,608 09.08.09 pb; oprava chyby swapovania linku v celom multitagu 07.08.07 pb; generovanie autorit na zaklade 6XX z katalogu, treba ju pre kazdu 6xx spustat zvlast ]]> 1 1 09.12.04 jj; globalecka na opravu sigly na PNP (vyloucit z ni znak ':') s sy="##class(UtilConv).symRepSign(.handle)" d ^X("s PnpUnCatH 100s [] :") d ^X("la") d ^X("ls") d ^X("gs") 1 1 09.12.04 jj; a jeste jedna na doplneni sigly na ZHL s sy="##class(UtilConv).symFillSigla(.handle)" d ^X("s ZhlUnCat") d ^X("la") d ^X("ls") d ^X("gs") 1 1 10.12.04 jj; glob. symMov606To610 - presun hesel z 606 do 610 vcetne hodnot ind. s sy="##class(UtilConv).symMov606To610(.handle)" d ^X("s PnpUnCat 606") d ^X("la") d ^X("ls") d ^X("gs") 1 1 toto je symbolik na vymaz chybne vygenerovanych upomienok pouzitie: 1, vymaz upomienok generovanych "dnes" s sy="##class(UtilConv).symDeleteClaim(.handle)" 2, vymaz upomienok generovanych v zadany datum s sy="##class(UtilConv).symDeleteClaim(.handle,20040228)" 22.01.09 lp; zruseny 1 nekorektni radek kodu v cyklu for 13.11.07 lp; odkazovane trx s pausalni platbou za upominku ulozit do savelistu "upo" pro pozdejsi vymazani 18.03.04 rs; dorobena dalsia poistka 28.02.04 rs; vylepsene a spresnene 18.09.03 rs; prva verzia ---]]> 1 1 vymena stareho blokovania (RL) za format aRL 19.09.03 rs; prva verzia 1
druhy parameter je volitelna podmienka na datum
18.03.04 rs; dorobena moznost vybrat vsetky (vcetne systemovych)
28.02.04 rs
]]> 1 1 19.12.05 lp
]]> 1 1 symbolik na doplnenie druhu dok.do transakcie 19.08.04 rs 1 1 --------------------------------------------- d ##class(UtilConv).ScdConvCatl() vyvolanie programu 11.01.05 pb; program na konverziu dat SCD 1 1) || (..fc(li," Sk. ")>1) s lii=lii_"#T010=" . . . . s lii=lii_li . . . ;use ofi . . . ;w !,lii . . . s ^lii(c3_"o")=lii . . . . . . s lii=##class(User.Util).strswap(lii,$c(10)_" "_$c(10,10),"#T200=") . . . s lii=##class(User.Util).strswap(lii,$c(10)_" "_$c(10), "#ZAHL=") . . . s lii=##class(User.Util).strswap(lii,$c(10)_" "_$c(10),"#PRC=") . . . s lii=##class(User.Util).strswap(lii,$c(10,10)_"----------","#END=") . . . s lii=##class(User.Util).strswap(lii,$c(10,10,10),"#T610=") . . . s lii=##class(User.Util).strswap(lii," / ","#T7xx=") . . . s lii=##class(User.Util).strswap(lii,". - ","#T2xx=") . . . s lii=##class(User.Util).strswap(lii," - ","#T3xx=") . . . s lii=##class(User.Util).strswap(lii,$c(10,10),$c(10)) . . . . . . s ^lii(c3_"x")=lii . . . . . . n sig,prc,acqm,b215,b610 s sig="",prc="",acqm="",b215="",b610="" . . . n sTag,sAuth s sAuth="" . . . for i=1:1:..fc(lii,"#") d . . . . s sX=$p(lii,"#",i) . . . . s sTag="",sT712="" . . . . if i=1 s sig=##class(Util).trim($p(sX,$c(10),..fc(sX,$c(10)))) q . . . . . . . . if $e(sX,1,$l("ZAHL="))="ZAHL=" d . . . . . s sX=##class(User.Util).strswap(sX,"ZAHL=","") . . . . . if (..fc($p(sX,$c(10),1),":")>1) || (..fc($p(sX,$c(10),1),"(")>1) d ; v zahlavi je nazov akcie . . . . . . ;nazov akcie je v 1. az n-tom riadku . . . . . . for j=1:1:999 d . . . . . . . if ..fc($p(sX,$c(10),j),")")>1 d ;posledny riadok . . . . . . . . s sT712=sT712_$p(sX,$c(10),j) . . . . . . . . s sTag=$p(sX,$c(10),j+1,999) . . . . . . . . s j=1000 . . . . . . . else d . . . . . . . . s sT712=sT712_$p(sX,$c(10),j) ;bezny riadok . . . . . . . . . . . else d ;bezne zahlavie s autormi od 2.riadku . . . . . . s sTag=$p(sX,$c(10),2,999) . . . . . . . . . . s sTag=##class(User.Util).strswap(sTag,$c(10)," ") . . . . . s sTag=##class(User.Util).trim(sTag) . . . . . if sTag'="" d . . . . . . s sTag=##class(User.Util).strswap(sTag," = ",$c(31)_"d") ; subezny nazov . . . . . . use ofi w !,"200 1 ",$c(31),"a"_sTag . . . . . . . . if $e(sX,1,$l("T200="))="T200=" d . . . . . s sX=##class(User.Util).strswap(sX,"T200=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . s sX=##class(User.Util).strswap(sX," = ",$c(31)_"d") ; subezny nazov . . . . . use ofi w !,"200 1 ",$c(31),"a"_sX . . . . . . . . if sT712'="" d . . . . . use ofi w !,"712 12 ",$c(31),"a"_sT712 . . . . . . . . if $e(sX,1,$l("T7xx="))="T7xx=" d . . . . . s sX=##class(User.Util).strswap(sX,"T7xx=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . s haut=1 . . . . . for j=1:1:..fc(sX,", ") d . . . . . . s sAuth=$p(sX,", ",j) . . . . . . if ..fc(sAuth," ")=2 d . . . . . . . s sTag=$c(31)_"a"_$p(sAuth," ",2)_$c(31)_"b"_$p(sAuth," ",1) . . . . . . . if haut=1 s sTag=sTag_$c(31)_"4"_"070" . . . . . . else d . . . . . . . s haut=0 . . . . . . . s sTag=$c(31)_"a"_sAuth ;davam cely retazec ako je, lebo sa to da tazko agoritmizovat . . . . . . use ofi . . . . . . if j=1 d . . . . . . . w !,"700 1 ",sTag . . . . . . else w !,"701 1 ",sTag . . . . . . . . if $e(sX,1,$l("T2xx="))="T2xx=" d . . . . . s sX=##class(User.Util).strswap(sX,"T2xx=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . if ..fc(sX," vyd")>1 d . . . . . . use ofi w !,"205 ",$c(31),"a"_sX . . . . . . if $e(sX,$l(sX)-2,$l(sX))="vyd" w "." . . . . . . . . . . if (..fc(sX," : ")>1) && (..fc(sX,", ")>1) d . . . . . . s sTag=$c(31)_"a"_$p(sX," : ",1)_$c(31)_"c"_$p($p(sX," : ",2),", ",1)_$c(31)_"d"_$p(sX,", ",2) . . . . . . use ofi w !,"210 ",sTag . . . . . . . . . . if b215=1 d ;ak uz bol T215, ostatne davam do poznamky . . . . . . if b610="" use ofi w !,"300 ",$c(31),"a"_sX . . . . . . . . . . if b610=1 d ;ak uz bol T610, dam do T610 (mala chyba pri swape - napr."stor. 20. - " ==> treba vratit bodku) . . . . . . use ofi w ".",!,"610 1 ",$c(31),"a"_sX . . . . . . . . . . if ..fc(sX," : obr")>1 d . . . . . . s b215=1 . . . . . . s sX=##class(User.Util).strswap(sX," : obr",$c(31)_"c"_"obr") . . . . . . use ofi w !,"215 ",$c(31),"a"_sX . . . . . . if $e(sX,$l(sX)-2,$l(sX))="obr" w "." . . . . . . . . . if $e(sX,1,$l("T3xx="))="T3xx=" d . . . . . s sX=##class(User.Util).strswap(sX,"T3xx=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . use ofi w !,"300 ",$c(31),"a"_sX . . . . . . . . if $e(sX,1,$l("T610="))="T610=" d . . . . . s b610=1 . . . . . s sX=##class(User.Util).strswap(sX,"T610=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . for j=1:1:..fc(sX," - ") d . . . . . . use ofi w !,"610 1 ",$c(31),"a"_$p(sX," - ",j) . . . . . . . . if $e(sX,1,$l("T010="))="T010=" d . . . . . s b610=1 . . . . . s sX=##class(User.Util).strswap(sX,"T010=","") . . . . . s sX=##class(User.Util).strswap(sX,$c(10),"") . . . . . use ofi w !,"010 ",$c(31),"a"_sX . . . . . . . . if $e(sX,1,$l("PRC="))="PRC=" d . . . . . s sX=##class(User.Util).strswap(sX,"PRC=","") . . . . . for j=1:1:..fc(sX,$c(10)) d . . . . . . s sTag=$p(sX,$c(10),j) . . . . . . s sTag=##class(User.Util).trim(sTag) . . . . . . if ..fc(sTag," ")=3 d . . . . . . . if prc'="" s prc=prc_$c(10) . . . . . . . if acqm'="" s acqm=acqm_$c(10) . . . . . . . s prc=prc_$p(sTag," ",1) . . . . . . . s acqm=acqm_$p(sTag," ",3) . . . . . . . . . use ofi . . . w !,"801 0 ",$c(31),"aSK",$c(31),"bSCD",$c(31),"c",$e(##class(MARC).genT005(),1,8),$c(31),"gAACR2" . . . w !,"970 ",$c(31),"bA" . . . w !,"999 ",$c(31),"a1",$c(31),"bSCD",$c(31),"cSCD",$c(31),"daRLconv-",$e(##class(MARC).genT005(),1,8) . . . w !,"###",! . . . . . . ; zapis do ScdUnCatH ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; . . . s nExp=0 ;pocet nezelanych exportov . . . s holdNum=..fc(prc,$c(10)) . . . if (holdNum=0) && (sig'="") s holdNum=1 . . . for i=1:1:holdNum d . . . . s holdNumNew=$e(i+10000,2,5) . . . . if ..fc(prc,$c(10))>0 d . . . . . s prc1=$p(prc,$c(10),i) . . . . . if ..fc(prcAll,$c(10)_prc1_$c(10))>1 d ;toto prc uz bolo exportovane . . . . . . s nExp=nExp+1 . . . . . . use ofidelhold w idNew_"_"_holdNumNew_" "_"ScdUnCatH",! . . . . . else d . . . . . . s prcAll=prcAll_$c(10)_prc1_$c(10) . . . . . . . . use ofi . . . . w "# @id ScdUnCatH "_idNew_"_"_holdNumNew . . . . w !,"001 "_idNew_"_"_holdNumNew . . . . w !,##class(MARC).genT005(1) . . . . w !,"100 " . . . . if $p(prc,$c(10),i)'="" w $c(31)_"t"_$p(prc,$c(10),i) . . . . if $p(prc,$c(10),i)'="" w $c(31)_"b"_$p(prc,$c(10),i) ;poziadavka od Nadi . . . . if sig'="" w $c(31)_"s"_sig . . . . w $c(31)_"r"_"SCD" . . . . w $c(31)_"l"_"SCD" . . . . . . . . w !,"200 "_$c(31)_"d"_"30" . . . . . . . . if $p(acqm,$c(10),i)'="" w !,"400 "_$c(31)_"k"_$p(acqm,$c(10),i) . . . . . . . . w !,"999 ",$c(31),"a1",$c(31),"bSCD",$c(31),"cSCD",$c(31),"daRLconv-",$e(##class(MARC).genT005(),1,8) . . . . w !,"###",! . . . . . . if ..fc(prc,$c(10))>0 d . . . . if nExp=..fc(prc,$c(10)) d ;vsetky holdingy su nezelane exporty . . . . . use ofidelcat w idNew_" "_"ScdUnCat",! . . . . . . close sFileName . . ;use sOLDIO . . ;w !,c2_" record processed - ok" . . close ofidelcat . . close ofidelhold . . close sListFiles . ; enable error . d $ZU(68,40,0) . use sOLDIO w !,c3_" record processed - ok ",$zdt($h,4) . close ofi . . use ofiprot w !," ======================================" . w !!,c3_" record processed - ok " . w !!,"Import SCD ukonceny ",$zdt($h,4) . close ofiprot q ]]> --------------------------------------------- d ##class(UtilConv).ScdConvVendor() vyvolanie programu 12.01.05 pb; program na konverziu dat SCD - dodavatelia 1 error . d $ZU(68,40,0) . use sOLDIO w !,c3_" VENDOR records writen ",$zdt($h,4) . close ofi . . use ofiprot w !," ======================================" . w !!,c3_" VENDOR records writen" . w !!,"Import SCD vendor ukonceny ",$zdt($h,4) . close ofiprot q ]]> ]]> 1 1 zo suboru do suboru
]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk s brk=0,li="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . s li=##class(Util).strswap(li,$c(13)_$c(10),"") . if li'="" use outf w li use OU . s li="" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> zo suboru do suboru
]]> 1 inf:%String,outf:%String="",trieda:%String="CavVf",odTag:%String="#",odSubTag:%String="^" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,tag,od,kolko,pocet n ciselna,datova,riadok s brk=0,li="",odd=$c(13)_$c(10) n poz,dlzka,j,zac s poz=0 ; pozicia na ktoru sa ma nastavit s dlzka=0 ;urcenie dlzky kazdeho zaznamu s j = 0, zac=1 for nLine=1:1 q:brk d . ; nacitam dlzku nasledujuceho zaznamu . use inf:poz read dlzka#5 if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . if (dlzka'="") && (poz'="") d . . ; podla dlzky zaznamu precitat jeden zaznam . . use inf:(poz+24) read li#(dlzka-24) if $zeof'=0 s brk=1 . . s poz = poz + dlzka ; posunutie pocitadla o cely predchadzajuci zaznam . . ; nacitany 1 zaznam . . if (li'="") d ; ak existuje zaznam rozdelime na casti . . . ; na zaciatku zapiseme zaciatok zaznamu . . . use outf w "# @id "_trieda_" new"_odd use OU . . . s ciselna = $p(li,odTag,1) ; prva ciselna cast . . . s datova = $e(li,$l(ciselna)+1,99999) ; datova cast nasleduje za ciselnou . . . s pocet=$l(ciselna)/12 ; pocet tagov . . . for j=1:1:pocet d . . . . s rada = $e(ciselna,zac,j*12) . . . . s zac = zac + 12 . . . . s tag=$e(rada,1,3) ; cislo tagu . . . . s kolko=$e(rada,4,7) ; kolko znakov nacitat . . . . s od=$e(rada,8,12) ; od ktoreho znaku citat . . . . ; vyber hodnot z datovej premennej . . . . s riadok=$e(datova,od+2,od+kolko) . . . . s riadok=##class(Util).strswap(riadok,odSubTag,$c(31)) . . . . ; mk 16.03.05 riesenie nepovoleneho znaku 32 neviditelna medzera . . . . s riadok=##class(Util).strswap(riadok,$c(32)," ") . . . . ; mk 16.03.05 ak nema tag ziadny subtag dat subtag x . . . . ; u tagu 002 nepridavat u tagu 001, 006 a 008 doplnit X01,X06 a X08 . . . . if tag'="002" d ; s tagom 002 sa nebude robit nic . . . . . if ($e(tag,1,2)="00") s tag=##class(Util).strswap(tag,"00","X0") . . . . . if $e(riadok,1,1)'=$c(31) s riadok=$c(31)_"x"_riadok . . . . if tag'="" use outf w tag_" "_riadok_odd use OU . . . ; na konci zapiseme ukoncenie zaznamu . . . use outf w "###"_odd use OU . . s li="",zac=1 . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> zo suboru do suboru
]]> 1 inf:%String,outf:%String="",trieda:%String="ZhlUnCat" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,tag,od,kolko,pocet n ciselna,datova,riadok s brk=0,li="",odd=$c(13)_$c(10) n poz,dlzka,j,zac s poz=0 ; pozicia na ktoru sa ma nastavit s dlzka=0 ;urcenie dlzky kazdeho zaznamu s j = 0, zac=1 for nLine=1:1 q:brk d . ; nacitam dlzku nasledujuceho zaznamu . use inf:poz read dlzka#5 if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . if (dlzka'="") && (poz'="") d . . ; podla dlzky zaznamu precitat jeden zaznam . . use inf:(poz+24) read li#(dlzka-24) if $zeof'=0 s brk=1 . . s poz = poz + dlzka ; posunutie pocitadla o cely predchadzajuci zaznam . . ; nacitany 1 zaznam . . if (li'="") d ; ak existuje zaznam rozdelime na casti . . . ; na zaciatku zapiseme zaciatok zaznamu . . . use outf w "# @id "_trieda_" new"_odd use OU . . . s ciselna = $p(li,odTag,1) ; prva ciselna cast . . . s datova = $e(li,$l(ciselna)+1,99999) ; datova cast nasleduje za ciselnou . . . s pocet=$l(ciselna)/12 ; pocet tagov . . . for j=1:1:pocet d . . . . s rada = $e(ciselna,zac,j*12) . . . . s zac = zac + 12 . . . . s tag=$e(rada,1,3) ; cislo tagu . . . . s kolko=$e(rada,4,7) ; kolko znakov nacitat . . . . s od=$e(rada,8,12) ; od ktoreho znaku citat . . . . ; vyber hodnot z datovej premennej . . . . s riadok=$e(datova,od+2,od+kolko) . . . . s riadok=##class(Util).strswap(riadok,odSubTag,$c(31)) . . . . if tag'="" d . . . . . if $e(tag,1,2)="00" d use outf w tag_" "_riadok_odd use OU . . . . . if $e(tag,1,2)'="00" d . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . use outf w tag_" "_riadok_odd use OU . . . ; na konci zapiseme ukoncenie zaznamu . . . use outf w "###"_odd use OU . . s li="",zac=1 . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,riadok s riadok = "" n sub1,sub2,sub3,sub4,sub5,sub6,sub7 s sub1="",sub2="",sub3="",sub4="",sub5="",sub6="",sub7="" n synonyma,all s synonyma="",all="" s brk=0,li="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 ;precita 1. riadok . ; v li vsetky data . if $e(li,1,3)="# @" d . . s li=##class(Util).strswap(li,"# @id CavVf","# @id CavUnAuth") . . s li=li_$c(13)_$c(10)_"000 00000nx 22 450" . . s li=li_$c(13)_$c(10)_"005 20050318000000.0" . . s li=li_$c(13)_$c(10)_"100 "_$c(31)_"a20050318cczea103 ba" . . s li=li_$c(13)_$c(10)_"150 "_$c(31)_"ay" . . s li=li_$c(13)_$c(10)_"152 "_$c(31)_"aAACR2" . if $e(li,1,3)="961" d ; pracovisko . . s li=##class(Util).strswap(li,"961 "_$c(31)_"x","") . . s sub1 = li, li = "" . if $e(li,1,3)="906" s li = "" ; vymazat . if $e(li,1,3)="960" d ; rodne cislo . . s li=##class(Util).strswap(li,"960 "_$c(31)_"x","") . . s sub2 = li, li = "" . if $e(li,1,3)="903" d ; priezvisko a meno . . s li=##class(Util).strswap(li,"903 "_$c(31)_"x","") . . s li=$p(li,":",1) . . s sub3="",sub4="" . . s sub3=$zstrip($p(li,",",1),"<>W") ; priezvisko . . s sub4=$zstrip($p(li,",",2),"<>W") ; meno . . s li="" . . if sub3'="" s li=$c(31)_"a"_sub3 . . if sub4'="" s li=li_$c(31)_"b"_sub4 . . if li'="" s li="200 1 "_li . ; . if $e(li,1,3)="962" d ; priezvisko a meno . . s li=##class(Util).strswap(li,"962 "_$c(31)_"x","") . . s li=$p(li,":",1) . . s sub5="",sub6="" . . s sub5=$zstrip($p(li,",",1),"<>W") ; priezvisko . . s sub6=$zstrip($p(li,",",2),"<>W") ; meno . . s li="",synonyma="" . . if sub5'="" s synonyma=$c(31)_"a"_sub5 . . if sub6'="" s synonyma=synonyma_$c(31)_"b"_sub6 . . if synonyma'="" d . . . if all'="" s all=all_$c(13)_$c(10)_"400 1 "_synonyma . . . if all="" s all="400 1 "_synonyma . ; . if $e(li,1,3)="###" d . . ; zapracovat 400 tagy z all . . s riadok = all . . if riadok'="" d . . . s sub7="" . . . if sub1'="" s sub7=$c(31)_"d"_sub1 . . . if sub2'="" s sub7=sub7_$c(31)_"e"_sub2 . . . if sub7'="" s sub7="C06 "_sub7 . . . s riadok=riadok_$c(13)_$c(10)_sub7 . . if riadok="" d . . . if sub1'="" s riadok=$c(31)_"d"_sub1 . . . if sub2'="" s riadok=riadok_$c(31)_"e"_sub2 . . . if riadok'="" s riadok="C06 "_riadok . . if riadok'="" s riadok=riadok_$c(13)_$c(10)_"C99 "_$c(31)_"dDFLT_UN_AUTH_200" . . if riadok="" s riadok="C99 "_$c(31)_"dDFLT_UN_AUTH_200" . . if riadok'="" s riadok=riadok_$c(13)_$c(10)_"999 "_$c(31)_"a1"_$c(31)_"bCAV"_$c(31)_"cCAV" . . if riadok="" s riadok="999 "_$c(31)_"a1"_$c(31)_"bCAV"_$c(31)_"cCAV" . . s sub1="",sub2="",sub5="",sub6="",all="",synonyma="",sub7="" . . s li=riadok_$c(13)_$c(10)_li . . ; . if li'="" use outf w li_$c(13)_$c(10) use OU . s li="" . s prva = "1" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,meno,barcod,heslo,t100,t400 s meno="",barcod="",heslo="",t100="",t400="" s brk=0,li="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 ;precita 1. riadok . ; v li vsetky data jeden riadok 1 zaznam . if li'="" d . . s meno=$zstrip($e(li,1,52),"<>W") ; nazov institucie . . s barcod=$zstrip($e(li,53,76),"<>W") ; skratka . . s heslo=$zstrip($e(li,77,79),"<>W") ; heslo . . s li="" . . s li="# @id CavIsUser new" . . s li=li_$c(13)_$c(10)_"005 20050318000000.0" . . s t100="100 " . . if meno'="" s t100=t100_$c(31)_"a"_meno . . if barcod'="" s t100=t100_$c(31)_"b"_barcod . . s t100=t100_$c(31)_"k1" . . s t100=t100_$c(31)_"tB" . . if t100'="" s li=li_$c(13)_$c(10)_t100 . . ; . . s t400="400 " . . s t400=t400_$c(31)_"d20050318" . . s t400=t400_$c(31)_"c9999" . . if heslo'="" s t400=t400_$c(31)_"w"_heslo . . s t400=t400_$c(31)_"z20050318" . . if t400'="" s li=li_$c(13)_$c(10)_t400 . . ; . . s li=li_$c(13)_$c(10)_"C99 "_$c(31)_"dDFLT_ISUSER" . . s li=li_$c(13)_$c(10)_"999 "_$c(31)_"a1"_$c(31)_"bCAV"_$c(31)_"cCAV" . . s li=li_$c(13)_$c(10)_"###" . if li'="" use outf w li_$c(13)_$c(10) use OU . s li="" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 1 ]]> 1 1 ]]> 1 1 ]]> 1 1 nPocetmax s nPocetmax=nPocet if nPocet>nPocetmax2 s nPocetmax2=nPocet ;w !,"ok2" s nPocet=$l(subc,$c(31)) if nPocet>nPocetmax s nPocetmax=nPocet if nPocet>nPocetmax2 s nPocetmax2=nPocet s nPocet=$l(subd,$c(31)) ;w !,"ok3" if nPocet>nPocetmax s nPocetmax=nPocet s nPocet=$l(sube,$c(31)) if nPocet>nPocetmax s nPocetmax=nPocet s nPocet=$l(subf,$c(31)) if nPocet>nPocetmax s nPocetmax=nPocet s nPocet=$l(subg,$c(31)) if nPocet>nPocetmax s nPocetmax=nPocet s nPocet=$l(subh,$c(31)) if nPocet>nPocetmax s nPocetmax=nPocet ;w !,"pocet ",nPocetmax," pocet2 ",nPocetmax2 s sa="",sb="",sc="",sd="",se="",sf="",sg="",sh="" ; uz nacitanie samotneho noveho tagu 210 f n=1:1:nPocetmax d ; podla max poctu opakovani jedneho zo subtagov . s sa=$p(suba,$c(31),n) . s sb=$p(subb,$c(31),n) . s sc=$p(subc,$c(31),n) . s sd=$p(subd,$c(31),n) . s se=$p(sube,$c(31),n) . s sf=$p(subf,$c(31),n) . s sg=$p(subg,$c(31),n) . s sh=$p(subh,$c(31),n) . ;w !, "o.k. ",sa,sc,sd . if sa'="" s T210new=T210new_$c(31)_"a"_sa . if sb'="" s T210new=T210new_$c(31)_"b"_sb . ;;;;;; . if $l(subc,$c(31))=1 d ; ak je len 1 vyskyt c . . if nPocetmax2=n s T210new=T210new_$c(31)_"c"_subc . if $l(subc,$c(31))>1 d . . if sc'="" s T210new=T210new_$c(31)_"c"_sc . ;if sc'="" s T210new=T210new_$c(31)_"c"_sc . ;w !,"210 ",T210new . ; vzdy az po poslednom vyskyte (abc) . if $l(subd,$c(31))=1 d ; ak je len 1 vyskyt . . if nPocetmax2=n s T210new=T210new_$c(31)_"d"_subd . if $l(subd,$c(31))>1 d . . if sd'="" s T210new=T210new_$c(31)_"d"_sd . if se'="" s T210new=T210new_$c(31)_"e"_se . if sf'="" s T210new=T210new_$c(31)_"f"_sf . if sg'="" s T210new=T210new_$c(31)_"g"_sg . if sh'="" s T210new=T210new_$c(31)_"h"_sh if T210new'="" s T210new="210 "_T210new d ##class(MARC).setTagX(.handle,T210new) ]]> ]]> 1 1 0 d ; len ak je v texte Sk ako cena . . ; . . if pocet > 0 d ; ak je v tvare isbn : cena . . . s la=$p(la,":",2) ; zobrat druhu cast . . . s la=$p(la," Sk",1) ; prva cast pred cenou . . . s la=##class(Util).trim(la) ; odseparovanie medzier . . if pocet < 1 d ; ak je v tvare cena . . . s la=$p(la," Sk",1) ; prva cast pred cenou . . . s la=##class(Util).trim(la) ; odseparovanie medzier if (la'="") d . if t400'="" s t400=t400_$c(31)_"c"_la_$c(31)_"d"_la . if t400="" s t400="400 "_$c(31)_"c"_la_$c(31)_"d"_la if t400'="" d ##class(MARC).setTagX(.handle,t400) q ]]> ]]> 1 1 ]]> 1 handle:%Library.Binary 1 1) && (flag=1)) q 1 q 0 /* ; varianta pro vypis poctu duplicit programem s trida="CavUnAuth", index="proj", poc=0 s id="" f { s id=$o(^ooDataTableI(trida,index,id)) q:id="" s idx="",num=0,flag=0 if id'="" { f { s idx=$o(^ooDataTableI(trida,index,id,idx)) q:idx="" s num=num+1 s sT001=##class(MARC).getT001(idx) if ##class(MARC).readX(.handle,trida,sT001) { s s230a=##class(MARC).getTagX(.handle,"230a") if s230a="-" s flag=1,idK=idx } } if num>1,flag s poc=poc+1 } } w !,"POCET: "_poc */ ]]> 1 1 error d $ZU(68,40,0) q "" ]]> cita sa vstupny subor, podla prir.cisla sa vyhlada holding, do neho sa doplni barcode zo vstupneho suboru, do 500-ky sa zapise status, lok, dislok
tag 500 nemusi byt nainicializovany cez "inicializaciu inventarizacie" v zclientovi
]]> 1 1 error d $ZU(68,40,0) q "" ]]> 31.01.06 pb; ostra konverzia verzia 3 - drobne upravy podla mailu p.Jilemnickej 27.01.06 pb; ostra konverzia verzia 2; uplne zmenena logika: SZP dodali z UHKT (v exceli, export s oddelovacom "ciarka", exportuje sa ale s bodkociarkou, co je fajn), treba naimportovat a pripojit do 463 cez ISSN; vela drobnych uprav 15.12.05 pb; konverzia UHKT - UhktConv; import z csv suboru vyexportovaneho z dbf v RL 08.12.05 pb; zalozene import z csv suboru vyexportovaneho z dbf v RL symbolikom s_export_csv, oddelovac stlpcov je "|". Jednym behom sa exportuje pre Uncat, vytvaraju sa pracovne globaly ^TMP, dalej sa exportuje pre UnAuth - autority personalne d ##class(UtilConv).UhktConv() vyvolanie programu /// ]]> 1 1 > .;000 00616nam$$2200169$$$450$ .;005 20041229155258.6 .;100 $a20041229d2003³³³³m y slo$03 $$$$ba .;101 $aslo$aeng .;102 $aSK .;200 1 $aPodnikate¾ské prostredie - problém stavu ekonomiky èi inštutucionálneho .; sysému?$fJaroslav Nìmec .;463 1 $1001 l_un_epca*045311$1011 $a0013-3035$12001 $aEkonomický èasopis$vRoè .;. 51, è. 2 (2003), s. 137-167$1210 $aBratislava$cVydavate¾stvo Slovenskej akadé .;mie vied$d1953- .;700 1 $aNìmec$bJaroslav$pSAVEKON$4070 .;801 0 $aSK$bSAV$c20041229$gAACR2 .;850 $aBA104 .;970 $aADD$bRBX .;985 $r2004 .;999 $a1$bSAVEKON$cSAVEKON$dekon-20041229 .;C99 $dDFLT_EPCA3 .;< . . . s sDatAkt=$e(##class(MARC).genT005(),1,8) . s s000="000 nam 22 450 " . s s100="100 "_$c(31)_"a"_sDatAkt_" m y czec0103 ba" . ;s s101="101 0 "_$c(31)_"a"_"cze" . ;s s102="102 "_$c(31)_"a"_"CZ" . s s101="" . s s102="" . s s801="801 0 "_$c(31)_"a"_"CZ"_$c(31)_"b"_sSigla_$c(31)_"c"_sDatAkt . s s850="850 "_$c(31)_"a"_sSigla . s s970="" . s s999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_sTriedaU_$c(31)_"c"_sTriedaU_$c(31)_"d"_"aRLConv-"_sDatAkt . . . s brk=0,c=0,pg=0 . for q:c=1 d ;zaciname az 2.riadkom . . use ifi . . read li if $zeof'=0 s brk=1 . . s c=c+1 . for q:((brk)||(c=99999)) d . . . . use ifi . . read li if $zeof'=0 s brk=1 . . if brk=1 q . . s c=c+1,pg=pg+1 . . if pg'<100 d use sOLDIO w "." s pg=0 . . . . . . s s001=10000000+c-1 . . s s001=$e(s001,2,8) . . . . s s010="" . . s s200="" . . s s210="" . . s s215="" . . s s461="" . . s s463="" . . s s700="" . . s s701="" . . s s856="" . . s s970="" . . s s985="" . . s sC11="" . . s sC99="" . . . . s sC99a=$p(li,"|",1) ;povodne id zaznamu . . s sRokVykaz=$p(li,"|",102) ;rok vykazovania . . s s985="985 "_$c(31)_"r"_sRokVykaz . . s sC99a=sC99a+1000 . . s sC99a=sRokVykaz_"_"_$e(sC99a,2,4) . . . . s sAbstrakt=$p(li,"|",2) ;priznak abstraktu . . s s970j=sAbstrakt ;uzivat.pole 1 . . s s970b=$p(li,"|",3) ;druh vysledku . . s s970b=$zcvt(s970b,"u") ;vykytuju sa kody B,C,D,J,L,M,N,P . . . . ;s sC99="C99 "_$c(31)_"a"_sC99a_$c(31)_"d"_"DFLT_EPCA4" . . ;s sC99="C99 "_$c(31)_"a"_sC99a_$c(31)_"d"_"DFLT_EPCA_"_s970b . . . . s s200a=$p(li,"|",4) ;nazov1 . . ;if $p(li,"|",5)'="" s s200a=s200a_" +("_$p(li,"|",5)_")" ;nazov2 . . if $p(li,"|",5)'="" s s200a=s200a_""_$p(li,"|",5)_"" ;nazov2 . . ;Banka pupeèníkové krve : www stránky projektu [online]. I. Fales, administrace . . ;200a=Banka pupeèníkové krve : www stránky projektu . . ;200b=online . . ;200f=I. Fales, administrace . . s sX=s200a . . s s200a=$p(sX,"[",1) . . s s200a=##class(Util).trim(s200a) . . . . s s200b=$p(sX,"[",2) . . s s200b=$p(s200b,"]",1) . . s s200b=##class(Util).trim(s200b) . . . . s s200fWeb=$p(sX,"]",2) . . if $e(s200fWeb,1,1)="." d . . . s s200fWeb=$e(s200fWeb,2,9999) . . . s s200fWeb=##class(Util).trim(s200fWeb) . . . . s s200="200 1 "_$c(31)_"a"_s200a . . if s200b'="" s s200=s200_$c(31)_"b"_s200b . . . . . . s sIn=$p(li,"|",6) ;nazov zdroja - In . . s sIn=##class(Util).trim(sIn) . . . . s s856u=$p(li,"|",7) ;Web adresa . . s s856e=$p(li,"|",8) ;citacia na Webe . . s s856="" . . if ((s856u'="")||(s856e'="")) d . . . s s856="856 " . . . if s856e'="" s s856=s856_$c(31)_"e"_s856e . . . if s856u'="" s s856=s856_$c(31)_"u"_s856u . . . . . . s sPriznakRecCas=$p(li,"|",9) ;priznak rep recenzovany casopis . . ;To bys mohl dat do 970a spolecne s oznacenim Druhu vysledku. Tedy v 970a bude napr. J, nebo JN, nebo JA. . . ;27.01.06: podla pripomienok ku konverzii (Jitka) dat do 970x . . ;s s970a=s970b_sPriznakRecCas_sAbstrakt . . s s970x=sPriznakRecCas . . . . . . s sSzp011a="" . . s sSzp001="" . . s sSzp517a="" . . s sSzp200a="" . . s sSzp102a="" . . s sSzp330a="" . . . . s sIssn=$p(li,"|",10) ;ISSN . . s sText=sIssn ;kluc je ISSN . . if sText'="" d . . . s sSzp011a=$g(^TMP($j,"SZP",sText)) . . . s sSzp001=$g(^TMP($j,"SZP_001",sText)) . . . s sSzp517a=$g(^TMP($j,"SZP_517a",sText)) . . . s sSzp200a=$g(^TMP($j,"SZP_200a",sText)) . . . s sSzp102a=$g(^TMP($j,"SZP_102a",sText)) . . . s sSzp330a=$g(^TMP($j,"SZP_330a",sText)) . . . . . . s s517a=$p(li,"|",11) ;skratka nazvu casopisu . . s s517a=##class(Util).trim(s517a) . . . . s sVol=$p(li,"|",12) ;volume . . s sNum=$p(li,"|",13) ;cislo . . s sPage=$p(li,"|",14) ;strany . . if $e(sPage,$l(sPage),$l(sPage))="s" s sPage=sPage_"." ;vo vst.subore na konci chyba bodka . . s s200v="" . . if ((sVol'="")||(sNum'="")||(sPage'="")) d . . . ;$vVol. 154, (1999), p. 89-94 . . . ;27.01.06 pb; texty si doplnili do vstupneho suboru aj s ohladom na jazyk . . . ;if sVol'="" s s200v=s200v_"Vol. " . . . s sVol=$zcvt($e(sVol,1,1),"u")_$e(sVol,2,999) . . . s s200v=s200v_sVol . . . . . . if sNum'="" d . . . .;27.01.06 pb; texty si doplnili do vstupneho suboru aj s ohladom na jazyk . . . . ;if s200v'="" s s200v=s200v_", num." . . . . if s200v'="" s s200v=s200v_", " . . . . s s200v=s200v_sNum . . . . . . if sPage'="" d . . . .;27.01.06 pb; texty si doplnili do vstupneho suboru aj s ohladom na jazyk . . . . ;if s200v'="" s s200v=s200v_", p." . . . . if s200v'="" s s200v=s200v_", " . . . . s s200v=s200v_sPage . . . . . . s sIf=$p(li,"|",16) ;impact faktor . . if $e(sIf,1,1)="." s sIf="0"_sIf . . s s978="" . . if sIf'="" s s978="978 "_$c(31)_"a"_sRokVykaz_$c(31)_"c"_sIf . . . . s s010="" . . s sIsbn=$p(li,"|",17) ;ISBN . . if sIsbn'="" s s010="010 "_$c(31)_"a"_sIsbn . . . . s s210a=$p(li,"|",18) ;210a . . s s210c=$p(li,"|",19) ;210c . . s s210d=$p(li,"|",20) ;210d . . s s210="" . . if ((s210a'="")||(s210c'="")||(s210d'="")) d . . . s s210="210 " . . . if s210a'="" s s210=s210_$c(31)_"a"_s210a . . . if s210c'="" s s210=s210_$c(31)_"c"_s210c . . . if s210d'="" s s210=s210_$c(31)_"d"_s210d . . . . . . s s700="", s701="", s200f="", s200g="", c70xz="" . . for ix=1:1:27 d . . . s s70xa=$p(li,"|",21+((ix-1)*3)+0) . . . s s70xb=$p(li,"|",21+((ix-1)*3)+1) . . . s s70xp=$p(li,"|",21+((ix-1)*3)+2) . . . if s70xp="A" d . . . . s s70xp="UHKT" . . . . s c70xz=c70xz+1 . . . else s s70xp="" . . . s s700z="", s701z="" . . . . . . . . . ;pracovne globaly pre generovanie autorit . . . s sX=s70xa_"*"_s70xb . . . if sX'="*" d . . . . s sKluc=$g(^TMP($j,"PERS",sX)) . . . . if sKluc="" d . . . . . s cPers=cPers+1 . . . . . s sKluc=cPers+10000000 . . . . . s sKluc=$e(sKluc,2,8) . . . . s ^TMP($j,"PERS",sX)=sKluc . . . . . . . . . . . . if s700= "" d . . . . . if c70xz=1 s s700z="G",c70xz=c70xz+1 . . . . . ;s s700=s700_"700 1 "_$c(31)_"3uhkt_un_auth*"_sKluc_$c(31)_"a"_s70xa_$c(31)_"b"_s70xb . . . . . s s700=s700_"700 1 "_$c(31)_"a"_s70xa_$c(31)_"b"_s70xb . . . . . if s70xp'="" s s700=s700_$c(31)_"p"_s70xp . . . . . if s700z'="" s s700=s700_$c(31)_"z"_s700z . . . . . s s700=s700_$c(31)_"4"_"070" . . . . . . . . . . s s200f="aut. "_s70xa_", "_s70xb . . . . . . . . . else d . . . . . if s701'="" s s701=s701_$c(10) . . . . . if c70xz=1 s s701z="G",c70xz=c70xz+1 . . . . . ;s s701=s701_"701 1 "_$c(31)_"3uhkt_un_auth*"_sKluc_$c(31)_"a"_s70xa_$c(31)_"b"_s70xb . . . . . s s701=s701_"701 1 "_$c(31)_"a"_s70xa_$c(31)_"b"_s70xb . . . . . if s70xp'="" s s701=s701_$c(31)_"p"_s70xp . . . . . if s701z'="" s s701=s701_$c(31)_"z"_s701z . . . . . s s701=s701_$c(31)_"4"_"070" . . . . . . . . . . if s200g'="" s s200g=s200g_"; " . . . . . s s200g=s200g_s70xa_", "_s70xb . . . . . . . . . . if s200f="" s s200f=s200fWeb . . if s200f'="" s s200=s200_$c(31)_"f"_s200f . . if s200g'="" s s200=s200_$c(31)_"g"_s200g . . . . . . s s461="", s463="" . . . . ;27.01.06 pb; B inak ako S a D . . ;if ((s970b="B")||(s970b="C")||(s970b="D")) d . . . . if s970b="B" d . . . s s200v="" . . . if s200v'="" d . . . . s s200=s200_$c(31)_"v"_s200v . . . . . . if sPage'="" s s215="215 "_$c(31)_"a"_sPage . . . . . . . if ((s970b="C")||(s970b="D")) d . . . ;463 1 $1011 $a0013-3035$12001 $aEkonomický èasopis$vRoè . . . ;. 51, è. 2 (2003), s. 137-167$1210 $aBratislava$cVydavate¾stvo Slovenskej akadé . . . ;mie vied$d1953- . . . . . . s s010="" ;ak je, bude v 463 . . . s s210="" ;ak je, bude v 463 . . . . . . s s463="463 1 " . . . . . . if sIsbn'="" d . . . . s s463=s463_$c(31)_"1010 "_$c(31)_"a"_sIsbn . . . . . . if sIssn'="" d . . . . s s463=s463_$c(31)_"1011 "_$c(31)_"a"_sIssn . . . . . . if ((sIn'="")||(s200v'="")) d . . . . s s463=s463_$c(31)_"12001 " . . . . if sIn'="" s s463=s463_$c(31)_"a"_sIn . . . . if s200v'="" s s463=s463_$c(31)_"v"_s200v . . . . . . if ((s210a'="")||(s210c'="")||(s210d'="")) d . . . . s s463=s463_$c(31)_"1210 " . . . . if s210a'="" s s463=s463_$c(31)_"a"_s210a . . . . if s210c'="" s s463=s463_$c(31)_"c"_s210c . . . . if s210d'="" s s463=s463_$c(31)_"d"_s210d . . . . . . if s970b="J" d ;vygenerovat SZP . . . ;463 1 $1001 l_un_epca*045311$1011 $a0013-3035$12001 $aEkonomický èasopis$vRoè . . . ;. 51, è. 2 (2003), s. 137-167$1210 $aBratislava$cVydavate¾stvo Slovenskej akadé . . . ;mie vied$d1953- . . . . . . ;;pracovne globaly pre generovanie SZP . . . ;if sIssn'="" s sX= "*"_sIssn . . . ;else s sX=s517a_"*" . . . ;;;;s sX=s517a_"*"_sIssn . . . ;if sX'="*" d . . . . ;s sKluc=$g(^TMP($j,"SZP",sX)) . . . . ;if sKluc="" d . . . . . ;s cSzp=cSzp+1 . . . . . ;s sKluc=cSzp+10000000 . . . . . ;s sKluc=$e(sKluc,2,8) . . . . ;s ^TMP($j,"SZP",sX)=sKluc . . . . ;s ^TMP($j,"SZP_200a",sX)=s517a . . . . ; . . . . ;s sImpFakt=$g(^TMP($j,"SZP_IF",sX)) . . . . ;if ($l(sIf)>0)&&($l(sImpFakt,s978)<=1) d . . . . . ;if sImpFakt'="" s sImpFakt=sImpFakt_";" . . . . . ;s sImpFakt=sImpFakt_s978 . . . . . ;s ^TMP($j,"SZP_IF",sX)=sImpFakt . . . . ; . . . ;else d . . . . ;use ofiprot . . . . ;w !,sC99a_" ISSN a Skratka nazvu casopisu su prazdne" . . . . ;s sKluc="???????" . . . . . . . . . . . . s s010="" ;ak je, bude v 463 . . . s s210="" ;ak je, bude v 463 . . . . . . s s463="463 1 " . . . . . . if sSzp001'="" s s463=s463_$c(31)_"1001 "_"uhkt_un_epca*"_sSzp001 . . . . . . if sIsbn'="" s s463=s463_$c(31)_"1010 "_$c(31)_"a"_sIsbn . . . . . . if sSzp011a'="" d . . . . s s463=s463_$c(31)_"1011 "_$c(31)_"a"_sSzp011a . . . . if sSzp102a'="" s s463=s463_$c(31)_"1102 "_$c(31)_"a"_sSzp102a . . . . if sSzp200a'="" s s463=s463_$c(31)_"12001 "_$c(31)_"a"_sSzp200a . . . . if s200v'="" s s463=s463_$c(31)_"v"_s200v . . . . s s463=s463_$c(31)_"1517 "_$c(31)_"a"_sSzp517a . . . . . . . else d . . . . if sIssn'="" s s463=s463_$c(31)_"1011 "_$c(31)_"a"_sIssn . . . . . . . . if ((s517a'="")||(s200v'="")) d . . . . . s s463=s463_$c(31)_"12001 " . . . . . if s517a'="" s s463=s463_$c(31)_"a"_s517a . . . . . if s200v'="" s s463=s463_$c(31)_"v"_s200v . . . . . . . if ((s210a'="")||(s210c'="")||(s210d'="")) d . . . . s s463=s463_$c(31)_"1210 " . . . . if s210a'="" s s463=s463_$c(31)_"a"_s210a . . . . if s210c'="" s s463=s463_$c(31)_"c"_s210c . . . . if s210d'="" s s463=s463_$c(31)_"d"_s210d . . . . . . . ;27.01.06 pb; nove . . if s970b="P" d . . . s s210="" ;ak je, bude v C11 . . . if sPage'="" s s215="215 "_$c(31)_"a"_sPage . . . if ((sIn'="")||(s856e'="")||(s210c'="")||(s210a'="")) d . . . . s sC11="C11 " . . . . if sIn'="" s sC11=sC11_$c(31)_"a"_sIn . . . . if s856e'="" s sC11=sC11_$c(31)_"b"_s856e . . . . if s210c'="" s sC11=sC11_$c(31)_"e"_s210c . . . . if s210a'="" s sC11=sC11_$c(31)_"f"_s210a . . . . . . s s856="", s856e="" . . . if s856u'="" d . . . . s s856="856 " . . . . if s856u'="" s s856=s856_$c(31)_"u"_s856u . . . . . . ;Druh vysledku: . . ; N => SXO (online sluzby) . . ; L,M => negeneruj nic (to jsou zombi) . . ; J => RBX (clanky z casopisu) . . ; D => RZB (clanky ze zborniky) . . ; C => RZA (kapitoly a knih) . . ; B => AMG (monografie) . . ; V,P,T,A,W,E > negeneruj nic . . ; . . ; tieto podmienky sa zmenili (icq s Jitkou 09.12.05)-netreba, a 970a dame do 970b . . ;if s970b="N" s s970b="SXO" . . ;if s970b="L" s s970b="" . . ;if s970b="M" s s970b="" . . ;if s970b="J" s s970b="RBX" . . ;if s970b="D" s s970b="RZB" . . ;if s970b="C" s s970b="RZA" . . ;if s970b="B" s s970b="AMG" . . ;if $l(s970b)=1 s s970b="" ;to su pripady V,P,T,A,W,E . . . . ;27.01.06 pb; novy prevod . . ;31.01.06 pb; este uprava . . s s970a=s970b . . s s970b="" . . ; v 970b v konverzii sa vykytuju kody B,C,D,J,L,M,N,P . . if s970a="D" s s970b="C" ;prevod do 970a podla Jitky . . if s970a="J" s s970b="J" . . if s970a="B" s s970b="B" . . if s970a="N" s s970b="E" . . if s970a="C" s s970b="M" . . if s970a="L" s s970b="C" . . if s970a="M" s s970b="U" . . if s970a="P" s s970b="P" . . . . s sC99d="DFLT_EPCA_"_s970b . . if s970a="L" s sC99d="DFLT_EPCA_"_s970a . . . . if ((s970a="D")&&(s970j="A")) d . . . s s970b="A" . . . s sC99d="DFLT_EPCA_"_"A2" . . . . . if ((s970a="J")&&(s970j="A")) d . . . s s970b="A" . . . s sC99d="DFLT_EPCA_"_"A1" . . s s970j="" . . . . . . s sC99="C99 "_$c(31)_"a"_sC99a_$c(31)_"d"_sC99d . . . . if ((s970a'="")||(s970b'="")||(s970j'="")||(s970x'="")) d . . . s s970="970 " . . . if s970a'="" s s970=s970_$c(31)_"a"_s970a . . . if s970b'="" s s970=s970_$c(31)_"b"_s970b . . . if s970j'="" s s970=s970_$c(31)_"j"_s970j . . . if s970x'="" s s970=s970_$c(31)_"x"_s970x . . . . . . . . use ofi . . . . w "# @id "_sTrieda_"UnEpca "_s001 . . w !,"001 "_s001 . . w !,s000 . . w !,##class(MARC).genT005(1) . . if s010'="" w !,s010 . . w !,s100 . . ;w !,s101 . . ;w !,s102 . . if s200'="" w !,s200 . . if s210'="" w !,s210 . . if s215'="" w !,s215 . . if s461'="" w !,s461 . . if s463'="" w !,s463 . . if s700'="" w !,s700 . . if s701'="" w !,s701 . . w !,s801 . . if s850'="" w !,s850 . . if s856'="" w !,s856 . . w !,s970 . . ;27.01.06 pb; netreba, postup je opacny, dodali SZP aj z imp.faktorom za 2004, viac robit netreba . . ;if s978'="" w !,s978 ;tu je to zatial iba pre istotu, spravne sa zapisuje do 978 sub.zaznamu . . if s985'="" w !,s985 . . if sC11'="" w !,sC11 . . w !,sC99 . . w !,s999 . . w !,"###",! . close ifi use sOLDIO w !,c_" records processed - ok ",$zdt($h,4) use ofiprot w !!,c_" records processed - ok " use ofiprot w !," ======================================" close ofi close ofiprot d $ZU(68,40,0) quit ; KONIEC UnEpca ;;;;;;;;;;;;;;;;;;;;;; ; nic dalsie netreba: ; - autority dodali zvlast (vo verzii 01/2006), vazby do EPCA budu robit rucne ; - SZP - suborne zaznamy dodali zvlast (vo verzii 01/2006 v Exceli), ; tie su naimportovane na zaciatku konverzie ; AUTORITY ;;;;;;;;;;;;;;;;;;;;;; s ofi="D:\aRL\_tmp\peter\uhkt\import\"_sTrieda_"_Auth"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi s s200="" s sDatAkt=$e(##class(MARC).genT005(),1,8) s s000="000 00198nx 22000973 450" s s100="100 "_$c(31)_"a"_sDatAkt_"aczey0103 ba" s s152="152 "_$c(31)_"a"_"AACR2" s s801="801 0 "_$c(31)_"a"_"CZ"_$c(31)_"b"_sSigla_$c(31)_"c"_sDatAkt s sC99 ="C99 "_$c(31)_"dDFLT_UN_AUTH_200" s s999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_sTriedaU_$c(31)_"c"_sTriedaU_$c(31)_"d"_"aRLConv-"_sDatAkt s c=0,cSum=0 s sText="" for set sText=$o(^TMP($j,"PERS",sText)) quit:sText="" do . ;use sOLDIO w !,sText . s c=c+1,cSum=cSum+1 . s s001=$g(^TMP($j,"PERS",sText)) . . s s200a=$p(sText,"*",1) . s s200b=$p(sText,"*",2) . if s200a'="" d . . s s200="200 1 " . . s s200=s200_$c(31)_"a"_s200a . . if s200b'="" d . . s s200=s200_$c(31)_"b"_s200b . . ; ZAPIS DO SUBORU AUTH PERS ;;;;;;;;;; . use ofi . w "# @id "_sTrieda_"UnAuth "_s001 . w !,"001 "_s001 . w !,s000 . w !,##class(MARC).genT005(1) . w !,s100 . w !,s152 . w !,s200 . w !,s801 . w !,sC99 . w !,s999 . w !,"###",! use sOLDIO w !,c_" PERS records writen ",$zdt($h,4) use ofiprot w !,c_" PERS records writen ",$zdt($h,4) use ofiprot w !," ======================================" close ofi use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov "_sTrieda_"UnAuth = ",cSum w !,"------------------------------------------------------------------------" ; SZP - Suborne zaznamy periodika ;;;;;;;;;;;;;;;;;;;;;; s ofi="D:\aRL\_tmp\peter\uhkt\import\"_sTrieda_"_SZP"_$r(999)_".txt" open ofi:("NWS":/CREATE):0 use ofi ;; zapis do zaznamu (pomocka pre zapis suborneho zaznamu) ;d ##class(MARC).newX(.handleSZP,trida,"new2") ;d ##class(MARC).setTagX(.handleSZP,"000 00240nx 22001213 450") ;if ISBN'="" d ##class(MARC).setTagX(.handleSZP,"010 "_$c(31)_"a"_ISBN) ;if ISSN'="" d ##class(MARC).setTagX(.handleSZP,"011 "_$c(31)_"a"_ISSN) ;d ##class(MARC).setTagX(.handleSZP,"100 "_$c(31)_"a"_##class(Util).date()_"aczey0103 ba") ;d ##class(MARC).setTagX(.handleSZP,"110 "_$c(31)_"aa") ;if Zeme'="" d ##class(MARC).setTagX(.handleSZP,"102 "_$c(31)_"a"_Zeme) ;d ##class(MARC).setTagX(.handleSZP,"200 1 "_$c(31)_"a"_Nazev) ;d ##class(MARC).setTagX(.handleSZP,"801 "_$c(31)_"aCZ"_$c(31)_"b"_knihovna_$c(31)_"c"_##class(Util).date()) ;d ##class(MARC).setTagX(.handleSZP,"970 "_$c(31)_"b"_"BXX") ;d ##class(MARC).setTagX(.handleSZP,"999 "_$c(31)_"a1"_$c(31)_"b"_knihovna_$c(31)_"d"_"arl-"_##class(Util).date()) ;d ##class(MARC).setTagX(.handleSZP,"c99 "_$c(31)_"dDFLT_EPCA3") ;s sc=##class(MARC).writeX(.handleSZP) s s200="" s sDatAkt=$e(##class(MARC).genT005(),1,8) s s000="000 00240nx 22001213 450" s s100="100 "_$c(31)_"a"_sDatAkt_"aczey0103 ba" s s110="110 "_$c(31)_"aa" s s801="801 0 "_$c(31)_"a"_"CZ"_$c(31)_"b"_sSigla_$c(31)_"c"_sDatAkt s s970="970 "_$c(31)_"b"_"BCA" s s999="999 "_$c(31)_"a"_"1"_$c(31)_"b"_sTriedaU_$c(31)_"c"_sTriedaU_$c(31)_"d"_"aRLConv-"_sDatAkt s sC99 ="C99 "_$c(31)_"dDFLT_EPCA3" s c=0,cSum=0 s sText="" for set sText=$o(^TMP($j,"SZP",sText)) quit:sText="" do . ;use sOLDIO w !,sText . s c=c+1,cSum=cSum+1 . s s001=$g(^TMP($j,"SZP",sText)) . . s s011a=$p(sText,"*",2) . s s200a=$g(^TMP($j,"SZP_200a",sText)) . . s s978=$g(^TMP($j,"SZP_IF",sText)) . s s978=##class(User.Util).strswap(s978,";",$c(10)) . use ofiprot w !,"s978=",s978 . . if s200a'="" d . . s s200="200 1 " . . s s200=s200_$c(31)_"a"_s200a . . if s011a'="" d . . s s011="011 " . . s s011=s011_$c(31)_"a"_s011a . . ; ZAPIS DO SUBORU SZP ;;;;;;;;;; . use ofi . w "# @id "_sTrieda_"UnEpca "_s001 . w !,"001 "_s001 . w !,s000 . w !,##class(MARC).genT005(1) . if s011'="" w !,s011 . w !,s100 . w !,s110 . if s200'="" w !,s200 . w !,s801 . w !,s970 . if s978'="" w !,s978 . w !,sC99 . w !,s999 . w !,"###",! use sOLDIO w !,c_" SZP records writen ",$zdt($h,4) use ofiprot w !,c_" SZP records writen ",$zdt($h,4) use ofiprot w !," ======================================" close ofi use ofiprot w ! w !,"------------------------------------------------------------------------" w !,"Poèet novych zaznamov "_sTrieda_"UnEpca = ",cSum w !,"------------------------------------------------------------------------" use sOLDIO w !!,"Import "_sTrieda_" ukonceny ",$zdt($h,4) use ofiprot w !!,"Import "_sTrieda_" ukonceny ",$zdt($h,4) close ofiprot ; enable error d $ZU(68,40,0) ]]> zo suboru do suboru pre konverziu IZPE IPVZ
]]> 1 inf:%String,outf:%String="",trieda:%String="IpvzUnCat" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,tag,od,kolko,pocet n ciselna,datova,riadok s brk=0,li="",odd=$c(13)_$c(10) n poz,dlzka,j,zac, ttt, t200, tt2, prvy, posledny s poz=0 ; pozicia na ktoru sa ma nastavit s dlzka=0 ;urcenie dlzky kazdeho zaznamu s j = 0, zac=1, ttt=0, t200="", ttt2=0, prvy="",posledny="", posledny2="" for nLine=1:1 q:brk d . ; nacitam dlzku nasledujuceho zaznamu . use inf:poz read dlzka#5 if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . if (dlzka'="") && (poz'="") d . . ; podla dlzky zaznamu precitat jeden zaznam . . use inf:(poz+24) read li#(dlzka-24) if $zeof'=0 s brk=1 . . s poz = poz + dlzka ; posunutie pocitadla o cely predchadzajuci zaznam . . ; nacitany 1 zaznam . . if (li'="") d ; ak existuje zaznam rozdelime na casti . . . s ttt=0, t200 = "" . . . ; na zaciatku zapiseme zaciatok zaznamu . . . s prvy="",posledny="", posledny2="" . . . use outf w "# @id "_trieda_" new"_odd_"000 00000nam 22 450"_odd use OU . . . s ciselna = $p(li,odTag,1) ; prva ciselna cast . . . s datova = $e(li,$l(ciselna)+1,99999) ; datova cast nasleduje za ciselnou . . . s pocet=$l(ciselna)/12 ; pocet tagov . . . for j=1:1:pocet d . . . . s rada = $e(ciselna,zac,j*12) . . . . s zac = zac + 12 . . . . s tag=$e(rada,1,3) ; cislo tagu . . . . s kolko=$e(rada,4,7) ; kolko znakov nacitat . . . . s od=$e(rada,8,12) ; od ktoreho znaku citat . . . . ; vyber hodnot z datovej premennej . . . . s riadok=$e(datova,od+2,od+kolko) . . . . s riadok=##class(Util).strswap(riadok,odSubTag,$c(31)) . . . . if tag'="" d . . . . . if tag="001" d . . . . . . s tag="C99" . . . . . . s riadok=" "_$c(31)_"a"_riadok . . . . . if tag="933" d . . . . . . s prvy=prvy+1 . . . . . . s ttt=ttt+1 . . . . . . s posledny2="" . . . . . . if ttt=1 d . . . . . . . s odd="" . . . . . . . s riadok=" "_$c(31)_"a"_$e(riadok,3,9999) . . . . . . if ttt=2 d . . . . . . . ;s ttt=0 . . . . . . . s riadok=" "_$c(31)_"b"_$e(riadok,3,9999) . . . . . . . s odd=$c(13)_$c(10) . . . . . . . s ttt2=1 ; skoncil pracu na 933 . . . . . . . . . . . if tag="000" d ; ak je ttt>0 tak predtym . . . . . . s tag="934" . . . . . . ; rozdelenie na subtagy . . . . . . ; datumova - dve bodky a posledna cast je 4 cisla . . . . . . s ret=$e(riadok,3,9999) ; skutocna hodnota subtagu . . . . . . s zsub="e" . . . . . . s tretia=$p(ret,".",3) . . . . . . if ($l(tretia)=4) d ; datum prijmu . . . . . . . if ($e(tretia,1,2)="19") || ($e(tretia,1,2)="20") s zsub="d" . . . . . . . . . . . . s druha=$p(ret,".",2) . . . . . . if ($l(druha)=2) && (tretia="") s zsub="c" . . . . . . . . . . . . if (ret="A") || (ret="P") s zsub="a" . . . . . . if (ret="K") || (ret="D") s zsub="b" . . . . . . . . . . . . s riadok=" "_$c(31)_zsub_$e(riadok,3,9999) . . . . . . ;treba zlucit vsetky tagy 934 do jedneho v ramci jedneho opakovania . . . . . . s posledny=posledny+1 . . . . . . s posledny2=posledny2+1 . . . . . . s odd="" . . . . . . ;s riadok="***"_tretia_"*#"_ret_"#" . . . . . . . . . . . . . . . . . . . . . . . if tag="955" d . . . . . . s tag="610" . . . . . . s riadok="1 "_$e(riadok,3,9999) . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"k",$c(31)_"a") . . . . . if tag="964" d . . . . . . s tag="610" . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"n",$c(31)_"a") . . . . . if (tag="910") && ($l(riadok)=4) s tag = "" . . . . . if tag'="" d . . . . . . if $e(tag,1,2)="00" d use outf w tag_" "_riadok_odd use OU . . . . . . if $e(tag,1,2)'="00" d . . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . . s zapis=tag_" "_riadok_odd . . . . . . . if (tag="933") && (ttt=2) s zapis=##class(Util).strswap(zapis,"933 ",""),ttt=0 . . . . . . . if (tag="933") && (ttt=1) d . . . . . . . . if (prvy>1) s zapis=$c(13)_$c(10)_zapis . . . . . . . if (tag="801") && (posledny) s zapis=$c(13)_$c(10)_zapis . . . . . . . . . . . . . . if (tag="934") && (posledny2>1) s zapis=##class(Util).strswap(zapis,"934 ","") . . . . . . . use outf w zapis use OU . . . . s odd=$c(13)_$c(10) . . . ; na konci zapiseme ukoncenie zaznamu . . . use outf w "###"_odd use OU . . s li="",zac=1 . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 1 ]]> 1 1 14.07.06 pb; konverzia dat z excelu pre pocet uzivatelov pripojenych pocas dna zo statistiky pstat, podrobny popis je v programe, Crep si treba vytvorit podla potreby d ##class(UtilConv).arlStatUser() vyvolanie programu /// ]]> 1 1 1 d . . . . ; ZAPIS DO SUBORU txt ;;;;;;;;;; . . . . use ofi . . . . w !,uvo_"arlStat"_uvoCuvo_sId_uvoCuvo_sDt_uvoCuvo_sDtMM_uvoCuvo_sDtOdbc_uvoCuvo_sUsr_uvoCuvo_sUsrCnt_uvo . . . . s c2=c2+1 use sOLDIO w !,c_" records read" w !,c2_" records writen ",$zdt($h,4) use ofiprot w !,c_" records read" w !,c2_" records writen ",$zdt($h,4) use ofiprot w !," ======================================" close ifi close ofi close ofiprot ]]> ]]> 1 inf:%String,outf:%String="",trieda:%String="",trieda2:%String="",nazov:%String="" 1 error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" s brk=0,li="",odd=$c(13)_$c(10) s poc = 1 ; pocitadlo kodov zaznamov f nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . if li="" s li="99999999999,999999" . ; nacitany 1 riadok v li . s bar=##class(Util).trim($p(li,",",1)) . s prc=##class(Util).trim($p(li,",",2)) . s hladaj=bar . s hladaj=" "_##class(Util).trim(hladaj) . s s1="[]'"_$c(34) . s hladaj=$tr(hladaj,s1) . s hladaj=$zcvt(hladaj,"l") . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . ; . if $d(^ooDataTableI(trieda,"bc",hladaj)) d ; vyhlada podla ciaroveho kodu . . s idhol=$o(^ooDataTableI(trieda,"bc",hladaj,"")) . . if idhol'="" d . . . s t001=##class(MARC).getT001(idhol) . . . ; nacitat zaznam holdingu . . . s t500 = "" . . . s t100t="" . . . s t500sinnew="" . . . if ##class(MARC).readLX(.handleh,trieda2_"*"_t001) s t500=##class(MARC).getTagX(.handleh,"500",-1),t100t=##class(MARC).getTagX(.handleh,"100t") . . . if t500'="" d ; pozor vsetky opakovanie tagu 500 . . . . s pocet = $l(t500,$c(10)) ; pocet opakovani tagu 500 . . . . s t500sin = $p(t500,$c(10),pocet) ; zoberie posledne opakovanie tagu 500 . . . . s sb=##class(MARC).getSubTagStr(t500sin,"b") . . . . if sb="" d ; ak este subtag b neexistuje . . . . . ; len doplnime . . . . . s status="1" . . . . . if t100t'=prc d ; zhoda aj v pr. cisle . . . . . . use outf . . . . . . w odd_"nezhoduje sa prirastkove cislo - status 4 "_li . . . . . . s status="4" . . . . . s t500sinnew=t500sin . . . . . s t500sinnew=t500sinnew_$c(31)_"b"_status . . . . . s t500=##class(Util).strswap(t500,t500sin,t500sinnew) . . . . . d ##class(MARC).setTagX(.handleh,t500) . . . . . d ##class(MARC).writeX(.handleh,1,,1) . . . . else d ; . . . . . s status="1" . . . . . if t100t'=prc d ; zhoda aj v pr. cisle . . . . . . use outf . . . . . . w odd_"nezhoduje sa prirastkove cislo - status 4 "_li . . . . . . s status="4" . . . . . s t500sinnew=t500sin . . . . . s t500sinnew=##class(Util).strswap(t500sinnew,$c(31)_"b"_sb,$c(31)_"b"_status) . . . . . s t500=##class(Util).strswap(t500,t500sin,t500sinnew) . . . . . d ##class(MARC).setTagX(.handleh,t500) . . . . . d ##class(MARC).writeX(.handleh,1,,1) . . . else d ; ak nie je ziadna 500 . . . . ;doplnime standatny tag 500 . . . . ; este kontrola prc . . . . s status="1" . . . . if t100t'=prc d . . . . . use outf . . . . . w odd_"nezhoduje sa prirastkove cislo - status 4 "_li . . . . . s status="4" . . . . . s datum=##class(Util).date()_"000000.0" . . . . . s t500sinnew="500 "_$c(31)_"a"_nazov_$c(31)_"b"_status_$c(31)_"c"_datum_$c(31)_"esys" . . . . . d ##class(MARC).setTagX(.handleh,t500sinnew) . . . . . d ##class(MARC).writeX(.handleh,1,,1) . else d ; ak nenajde ciarovy kod . . use outf . . w odd_"nenajdeny ciarovy kod "_li . . . . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q ]]> do riadkoveho formatu autority
]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd s odd=$c(13)_$c(10) s brk=0,li="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . if (li'="") d ; nacitany jeden zaznam = jeden riadok . . use outf . . ; zapisa hlavicky . . s kod=$p(li,";",1) ; 001 . . s nazov=$p(li,";",2) ; 210a . . s ulica=$p(li,";",3) ; 980a . . s pobox=$p(li,";",4) ;980a druhe opakovanie . . s psc=$p(li,";",5) ; 980d . . s mesto=$p(li,";",6) ; 980b . . s tel=$p(li,";",7) ; 981c . . s tel2=$p(li,";",8) ; 981c . . s fax=$p(li,";",9) ; 981d . . s email=$p(li,";",10) ; 981e . . s www=$p(li,";",11) ; 981f . . s typ=$p(li,";",12) ;982f . . s idtyp=$p(li,";",13) ; . . s idautor=$p(li,";",14) ; neprevadzat len 2 a 0 . . ; . . w odd_"# @id CsUnAuth a"_kod . . w odd_"100 "_"20070228csloa0103 ba" . . if nazov'="" w odd_"210 02 "_$c(31)_"a"_nazov . . s t980="" . . ; na konci ulice je cislo to treba do 980y (ak posledne slovo je cislo tak ho tam preniest . . s cislo=$p(ulica," ",$l(ulica," ")) ; posledne slovo . . s test="" . . f j=0:1:9 d . . . if $e(cislo,1,1)=j s j=9,test="1" . . if test="1" d . . . s ulica=##class(User.Util).strswap(ulica," "_cislo,"") . . . if ulica'="" s t980=t980_$c(31)_"a"_ulica . . . if cislo'="" s t980=t980_$c(31)_"y"_cislo . . else d . . . if ulica'="" s t980=t980_$c(31)_"a"_ulica . . if pobox'="" s t980=t980_$c(31)_"a"_pobox . . if mesto'="" s t980=t980_$c(31)_"b"_mesto . . if psc'="" s t980=t980_$c(31)_"d"_psc . . if t980'="" w odd_"980 "_t980_$c(31)_"xO" . . s t981="" . . if tel'="" s t981=t981_$c(31)_"c"_tel . . if tel2'="" s t981=t981_$c(31)_"c"_tel2 . . if fax'="" s t981=t981_$c(31)_"d"_fax . . if email'="" s t981=t981_$c(31)_"e"_email . . if www'="" s t981=t981_$c(31)_"f"_www . . if t981'="" w odd_"981 "_t981 . . if typ'="" w odd_"982 "_$c(31)_"f"_typ . . ;s t983="" . . ;if idtyp'="" s t983=t983_$c(31)_"a"_idtyp . . ;if t983'="" w odd_"983 "_t983 . . . . w odd_"999 "_$c(31)_"a1"_$c(31)_"bCS001"_$c(31)_"cCS001"_$c(31)_"d"_"arl-"_##class(Util).date() . . w odd_"###" . . ;if li'="" use outf w odd_li use OU . q:$zeof'=0 ;use outf w odd_"999 "_$c(31)_"a1"_$c(31)_"bCS"_$c(31)_"cCS"_$c(31)_"d"_"arl-"_##class(Util).date()_odd_"###" use OU close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> 03.04.07 pb; upravy pre vypis tagu 001 aj ked nie je v datach v riadku MARC 02.04.07 pb; pridany parameter "-case-" s hodnotami 'u/l/a/o', par3 nahradeny s -itemlen- 31.03.07 pb; osetreny pripad '200a,4xx/200a' v tags_to_display a '200' v tag_to_select; doplnena moznost mat aj v zozname "tagView" cele tagy bez subtagov 29.03.07 pb; uprava pre vlozeny tag 001 28.03.07 pb; doplnenie parametrov "filter" a "pagelen", zmena poradia parametrov "tagSel" s "tagView", zmena vystupu 27.03.07 pb; rozsirena moznost pouzitia par1 ak je par2 prazdne, algoritmus na pouzivanie skratenej formy zapisu tagov v par1,2, oprava drobnych chyb 26.03.07 pb; prerobene na verziu bez pov.par1 (class)a par4(savelist), ostali 3 parametre, metoda pracuje s aktivnym select listom, popisky 26.03.07 pb; osetrena max.dlzka 1 uzlu, a max.dlzka 1 polozky (subtagu), pridany par5, popisky 25.03.07 pb; upravy v par3 pre zlozeny vs. jednoduchy tag podla obsahu par2 24.03.07 pb; doladenie logiky, kodu, nastavenie 'eval_txx', ucesanie vystupu 22.03.07 pb; metoda viewTagContent premenovana na listTagValues, vyvolanie prikazom "ltv", zmena parametrov na "par", rozsirenie moznosti, zmena logiky, popisky 10.03.07 pb; prehlad vyskytov obsahu tagu s pocetnostou vyskytov - kumulativny vypis ]]> 1 par="" 1 1 d ; pre zlozeny tag . s tagSelTag=$e(tagSel,1,7) else d ; pre jednoduchy tag . s tagSelTag=$e(tagSel,1,3) if (tagView="") d . if (($l(tagSel)=3)||(($l(tagSel)=7)&&($l(tagSel,"/")>1))) d ; existuje iba tagSel, tagView je prazdny . . s tagView0=tagView . . s tagView=tagSel ; tag na 3 alebo 7 znakov - vypis celeho tagu . else d . . ; znormalizovanie tagSel, kazdy prvok zoznamu musi byt na 4 alebo 8 znakov . . s tagView=$$toFullTag(tagSel) . . s tagView0=tagView ; tagView0 bude tagView po tejto uprave . . s tagSel=tagSelTag ; tag na 3 alebo 7 znakov, povodne mal inu dlzku . . else d . s tagSel=tagSelTag ; tag na 3 alebo 7 znakov, povodne mohol mat inu dlzku . ; znormalizovanie tagView, kazdy prvok zoznamu musi byt na 4 alebo 8 znakov . s tagView=$$toFullTag(tagView) . s tagView0=tagView s cTagView=..fc(tagView,",") ; AKTIVOVANIE/DEAKTIVOVANIE txx PODLA ZADANYCH PARAMETROV s Txx="0" if $l(tagSel, "T")>1 s Txx="1" if $l(tagView,"T")>1 s Txx="1" s sEvalTempTags=##class(Util).getParamQ("eval_txx") ; aktualna hodnota txx if sEvalTempTags="" s sEvalTempTags="0" if sEvalTempTags'=Txx w !! d ##class(Util).X("txx "_Txx) ; nastavim Txx na hodnotu potrebnu v tomto prg if Txx="1" d s Txx="T" ; SPRACOVANIE ZAZNAMOV s sClasses="" if ##class(Util).XcheckActiveList(0) d ; 26.03.07 pb; pouzijem aktivny select list . s idCnt=$i(^$$$MarcTempG) ; pracovny uzol . s id="",point=0,brk="",cntRecAll=0,cntCurrAll=0 . w ! . for s id=$o(^Lists("tmp",$j,id)) q:((id="") || brk) d . . . . s point=point+1, sX=$e(point,$l(point)-2,$l(point)) if sX="000" d w "." . . s sX=$e(point,$l(point)-4,$l(point)) if sX="00000" d w ! . . s idx=id if $f(idx,"*") s idx=$p(idx,"*",2) ; test na triedeny zoznam . . s sClass=##class(MARC).getCLASS(idx) . . s sT001=##class(MARC).getT001(idx) . . if $l(sClasses,sClass)<=1 d . . . if sClasses'="" s sClasses=sClasses_"," . . . s sClasses=sClasses_sClass . . . . if '##class(MARC).readX(.handle,sClass,sT001,Txx) s brk=1,err="ERRCLM002#"_class_"*"_t001 w !,prog_"record "_class_"*"_t001_" not FOUND!" q . . s cntRecAll=cntRecAll+1 . . s row=##class(MARC).getTagX(.handle,tagSel,-1) ; vsetky vyskyty tag_to_select . . . . s cnt = ..fc(row,$c(10)) . . for ix=1:1:cnt d . . . s rowDet=$p(row,$c(10),ix) . . . s subtagDet="" . . . . . . if tagView0 '="" d ; pre existujuci tags_to_display . . . . for iy=1:1:cTagView d ; spracovat cely zoznam zobrazovanych tagov . . . . . s tagViewCurr=$p(tagView,",",iy) . . . . . s tagViewCurr0=tagViewCurr . . . . . . . . . . if ($e(tagViewCurr,1,3)=$e(tagSel,1,3)),($l(tagViewCurr,"/")>1) d ; pre zlozeny tag v tagView zozname . . . . . . s tagViewCurr=$p(tagViewCurr,"/",2) . . . . . . . . . . if subtagDet'="" s subtagDet=subtagDet_"#" . . . . . . . . . . ; 31.03.07 pb; osetreny pripad '200a,4xx/200a' v tags_to_display a '200' v tag_to_select, . . . . . ; lebo '200' naslo v oboch pripadoch; + nova premenna tagSelIf . . . . . s tagSelIf=tagSel . . . . . if ($l(tagViewCurr0,"/")>1),($l(tagSel,"/")<=1) s tagSelIf="/"_tagSel . . . . . . . . . . if $l(tagViewCurr,"/")>1 d . . . . . . s subtag=$e(tagViewCurr,8,8) . . . . . else d . . . . . . s subtag=$e(tagViewCurr,4,4) . . . . . if $e(tagViewCurr0,$l(tagViewCurr0)-$l(tagSelIf),$l(tagSelIf)) = tagSelIf d ; pre tags_to_display obsiahnute v tag_to_select; hladam zhodu v poslednych znakoch . . . . . . . . . . . . if subtag="" d ; pre cely tag . . . . . . . if $l(tagSel,"/001")>1 d ; vynimka pre vlozeny tag 001, ten uz mam kompletny . . . . . . . . s sX=rowDet . . . . . . . else s sX=$e(rowDet,8,9999) . . . . . . . s sX=##class(Util).strswap(sX,$c(31)," $") ; pred znakmi subtagu bude $ . . . . . . . . . . . . else d . . . . . . . s sX=##class(MARC).getSubTagStr(rowDet,subtag) ; 1 subtag . . . . . . . . . . . . if $l(sX)>maxItemLen s sX=$e(sX,1,maxItemLen)_".." ; max.dlzka 1 subtagu, kvoli max.dlzke 1 uzlu . . . . . . . . . . . . if sX="" s sX="." . . . . . . s sX=$$ltvConvertString(sX) . . . . . . . . . . . else d ; pre tags_to_display NEobsiahnute v tag_to_select . . . . . . s sX=##class(MARC).getTagX(.handle,tagViewCurr0) ; iba 1.vyskyt, hodnota je pomocna pre vypis . . . . . . . . . . . . if subtag="" d . . . . . . . if $l(tagSel,"/001")>1 d ; vynimka pre vlozeny tag 001, ten uz mam kompletny . . . . . . . else s sX=$e(sX,8,9999) . . . . . . . s sX=##class(Util).strswap(sX,$c(31)," $") ; pred znakmi subtagu bude $ . . . . . . . . . . . . if $l(sX)>maxItemLen s sX=$e(sX,1,maxItemLen-2)_".." ; max.dlzka 1 subtagu, kvoli max.dlzke 1 uzlu . . . . . . . . . . . . if sX="" s sX="." . . . . . . s sX=$$ltvConvertString(sX) . . . . . . . . . . . else d ; pre NEexistujuci tags_to_display zoberiem 1 kompletny tag . . . . if $l(tagSel,"/001")>1 d ; vynimka pre vlozeny tag 001, ten uz mam kompletny . . . . . s sX=rowDet . . . . else s sX=$e(rowDet,8,9999) . . . . if $l(sX)>maxItemLen s sX=$e(sX,1,maxNodeLen) ; max.dlzka 1 subtagu=max.dlzke 1 uzlu, lebo ine v uzle uz nebude . . . . s sX=##class(Util).strswap(sX,$c(31)," $") ; pred znakmi subtagu bude $ . . . . . . . . if sX="" s sX="." . . . . s sX=$$ltvConvertString(sX) . . . . . . if (subtagDet'="") d . . . . s sX=$g(^$$$MarcTempG(idCnt,sClass,tagView,subtagDet)) . . . . s sX=sX+1, cntCurrAll=cntCurrAll+1 . . . . s ^$$$MarcTempG(idCnt,sClass,tagView,subtagDet)=sX . . . . . ; VYPIS PARAMETROV . w !,"list tag values and counts for class: '",sClasses,"'" . w !," tags to display='",tagView,"', tag to count='",tagSel,"'" . . w !," filter='",lsFilter,"', " . w "pagelen='",lnPageLen,"', " . w "itemlen='" . if maxItemLen<=maxNodeLen d . . w maxItemLen . else w maxNodeLen . w "', " . w "case='",sCase,"'" . ; VYPIS VYSLEDKOV . w !!,"RESULT tag values and counts:" . w ! . s id="", ix=-1, brk="" . for s id=$o(^$$$MarcTempG(idCnt,sClass,tagView,id)) q:(id="")||(brk=1) d . . s sX=$g(^$$$MarcTempG(idCnt,sClass,tagView,id)) . . if ix=-1 d . . . s ix=0 . . . for iy=1:1:40 w "+" ; hlavicka . . . . if lsFilter'="",$zcvt($e(id,1,$l(lsFilter)),"L")'=lsFilter q . . . . s ix=ix+1 . . . . ; zapis s poctom vyskytov s '()' . . w !," #",id,"# (",sX,")" ; tento sposob vypisu sa hodi napr. pre import do Excelu, oddelovac stlpcov je # . . . . if ix= lnPageLen d . . . w !,"--more press Enter, q to quit)--" read sMore if $e($zcvt(sMore,"L"),1)="q" s brk=1 q . . . s ix=0 . w ! . for iy=1:1:40 w "-" ; paticka . . w !!," all occurences: ",cntCurrAll, " in ",cntRecAll," rows"," ",$$$ShowDTime . . if Txx="T" d s Txx="1" . if sEvalTempTags'=Txx w !! d ##class(Util).X("txx "_sEvalTempTags) ; nastavim Txx na povodnu hodnotu . . k ^$$$MarcTempG(idCnt) . else d . w !!,"no active select detected" q toFullTag(ret) s tagViewPrev="" for i=1:1:..fc(ret,",") d . s sX=$p(ret,",",i) . if ($l(sX)=4) d s tagViewPrev=$e(sX,1,3) . if ($l(sX)=8)&&($l(sX,"/")>1) d s tagViewPrev=$e(sX,1,7) . if (($l(sX)=4)||(($l(sX)=8)&&($l(sX,"/")>1))) d . else d . . if ($l(sX)=3)||($l(sX)=7) d ; pre cely tag . . else d . . . s sX=tagViewPrev_sX . . s $p(ret,",",i)=sX q ret ltvConvertString(ret) if tagViewCurr0="001" s ret=sT001 q $$testMaxNodeLen(ret) for iz=1:1:cSCase d . s sCaseRow=$e(sCase,iz,iz) . if sCaseRow'="" d . . if sCaseRow="a" d . . . s ret=##class(Util).diaTR(ret) ; do ascii . . else d . . . s ret=$zcvt(ret,sCaseRow) ; do up/low if ret="." d . s ret="N/A" else s ret=##class(Util).strswap(ret,"#","~") ; ak tag obsahuje #, zamenit za ~ q $$testMaxNodeLen(ret) testMaxNodeLen(ret) s subtagDet=subtagDet_$e(ret,1,maxNodeLen) ; 242 je max.dlzka 1 uzlu if $l(subtagDet)>=maxNodeLen s subtagDet=$e(subtagDet,1,maxNodeLen-2)_"=>" q ret ]]> 10.03.07 pb; prehlad vyskytov kodovanych a nekodovanych roli autorov vo VF a ich pocetnosti ]]> 1 class="SpuVfCat" 1 13.04.07 pb; nova verzia podla js 10.03.07 pb; prekodovanie kodovanych roli autorov VF do kodovanych roli Unimarc ]]> 1 class="",sCode:%Library.String="" 1 10.03.07 pb; generovanie XxUnCat 200fg v nekodovanom tvare: - z nekodovanych roli Vymenneho formatu ulozenych v pomocnom Unimarc tagu 70xu - alebo z kodovanych roli Unimarc tagu 70x4 ]]> 1 sFormat:%Library.String="VF",t700:%Library.Binary="",t701:%Library.Binary="",t702:%Library.Binary="",tablesd:%Library.String="",sEvalLanguage:%Library.String="",aKol:%Library.String="",subtag:%Library.String="u" 1 ]]> 1 inf:%String,trieda:%String="",rok:%String="" 1 error d $ZU(68,40,1) s brk=0,li="",odd=$c(13)_$c(10) s C02new="" s poc = 1 ; pocitadlo kodov zaznamov f nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . s kods=##class(Util).trim($p(li,"#",2)) ; kod suborneho zaznamu . s pc=##class(Util).trim($p(li,"#",3)) ; poradove cislo dna . if ##class(MARC).readLX(.handle,trieda_"*"_kods) d . . s C02=##class(MARC).getTagX(.handle,"C02",-1) ; vsetky kalendare . . s pocet=$l(C02,$c(10)) ; pocet opakovani tagu C02 . . s C02new="" . . f j=1:1:pocet d . . . s C02s=$p(C02,$c(10),j) ; jedno opakovanie kalendara . . . s sa=##class(MARC).getSubTagStr(C02s,"a") ; obsah subtagu a . . . s sanew=sa . . . if $e(sanew,1,4)=rok d . . . . if $e(sanew,pc+5,pc+5)="0" s sanew=rok_"#"_$e(sanew,6,pc+4)_"1"_$e(sanew,pc+6,9999) . . . . s C02s=##class(User.Util).strswap(C02s,$c(31)_"a"_sa,$c(31)_"a"_sanew) . . . if C02new'="" s C02new=C02new_$c(10)_C02s . . . if C02new="" s C02new=C02s . . if C02new'="" d . . . d ##class(MARC).setTagX(.handle,C02new) . . . d ##class(MARC).writeX(.handle,1,,1) ; zapis . . q:$zeof'=0 close inf use OU ; enable error d $ZU(68,40,0) q ]]> ]]> 1 inf:%String,trieda:%String="",rok:%String="" 1 error d $ZU(68,40,1) s brk=0,li="",odd=$c(13)_$c(10) s C02new="" s poc = 1 ; pocitadlo kodov zaznamov f nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . s kods=##class(Util).trim($p(li,"#",1)) ; kod suborneho zaznamu . s pc=##class(Util).trim($p(li,"#",2)) ; hodnota . if ##class(MARC).readLX(.handle,trieda_"*"_kods) d . . s C02=##class(MARC).getTagX(.handle,"C02",-1) ; vsetky kalendare . . if ($f(C02,$c(31)_"v")<1) && ($f(C02,$c(31)_"i")<1) d . . . s pocet=$l(C02,$c(10)) ; pocet opakovani tagu C02 . . . s C02new="" . . . f j=1:1:pocet d . . . . s C02s=$p(C02,$c(10),j) ; jedno opakovanie kalendara . . . . s sa=##class(MARC).getSubTagStr(C02s,"a") ; obsah subtagu a . . . . if $e(sa,1,4)=rok d . . . . . if pc'="" s C02s=C02s_pc . . . . if C02new'="" s C02new=C02new_$c(10)_C02s . . . . if C02new="" s C02new=C02s . . . if C02new'="" d . . . . d ##class(MARC).setTagX(.handle,C02new) . . . . d ##class(MARC).writeX(.handle,1,,1) ; zapis . . q:$zeof'=0 close inf use OU ; enable error d $ZU(68,40,0) q ]]> ]]> 1 1 ]]> 1 1 ]]> 1 inf:%String,trieda:%String="" 1 error d $ZU(68,40,1) s brk=0,li="",odd=$c(13)_$c(10) s C02new="" s poc = 1 ; pocitadlo kodov zaznamov f nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . s kod=##class(Util).trim($p(li,"#",1)) ; kod aut zaznamu . s pc=##class(Util).trim($p(li,"#",2)) ; hodnota . if ##class(MARC).readLX(.handle,trieda_"*"_kod) d . . if pc'="" d . . . s t305="305 "_$c(31)_"b"_pc . . . d ##class(MARC).setTagX(.handle,t305) . . . d ##class(MARC).writeX(.handle,1,,1) ; zapis . . q:$zeof'=0 close inf use OU ; enable error d $ZU(68,40,0) q ]]> 24.11.08 jj; symbolik na spocitani 463/200v ]]> 1 1 Prevod dluhu a financniho konta ctenaru na novou menu podle kurzu. Parametry: Ictx - ictx instituce (napr. Cbvk) outFName - vystupni log soubor, soubor nebo cesta+soubor exRate - menovy kurz, default 30.1260 bLogOnly - 0/1 zmena se provede/neprovede, pro 1 se pouze vypise log co by se zmenilo default=0 bSortByUserName - 0/1 nesortovat/sortovat podle jmena a prijmeni ctenare, 1 je narocnejsi na cas default=0 16.12.08 jk; oprava log. chyby kdy se pro tridu IctxTrxQ vynechal index "uk" 09.12.08 jk; zalozeno 1 Ictx:%String,outFName:%String,exRate:%Float=30.1260,bLogOnly:%Boolean=0,bSortByUserName:%Boolean=0 1 Pomocna metoda pro convTrxDebts2Euro, zpracovava jednu transakci Parametry: sIdTrx - id transakce debts - promenna pro napocitavani dluhu file - vystupni log soubor dbTrx - databaze transakci (napr. CbvkTrx) bLogOnly - 0/1 zmena se provede/neprovede, pro 1 se pouze vypise log t001User - T001 ctenare na ktereho je transakce zapsana 09.12.08 jk; zalozeno [Previously private] 1 1 Pomocna metoda pro convTrxDebts2Euro, vytvori novou transakci na celkovy dluh prepocitany na euro. Do poznamky 100n se ulozi ze kterych stornovanych dluhu byl celkovy dluh vytvoren. Parametry: debts - promenna pro napocitavani dluhu file - vystupni log soubor exRate - menovy kurz (Sk-Eur) dbTrx - databaze transakci (napr. CbvkTrx) sLnameUser - lname db ctenaru bLogOnly - 0/1 zmena se provede/neprovede, pro 1 se pouze vypise log 09.12.08 jk; zalozeno [Previously private] 1 1 31900) s bMaxStr100n=1 ; maxstring je 32.767, uz se vlozi jen celkove udaje if 'bMaxStr100n s s100n=s100n_"Transakce T001="_sT001Trx ; cyklus pres typy operaci transakce s sTrxOp=$o(debts(sT001User,"TRX",sT001Trx,"")) ; druh platby s sDebtsOp=$g(debts(sT001User,"TRX",sT001Trx,sTrxOp)) ; format "dluh_char31_datum_char31_nazev" if 'bMaxStr100n s s100n=s100n_" "_$p(sDebtsOp,$c(31),3) ; prida se nazev knihy nebo operace f j=1:1 { if sTrxOp="" q s sDebtsOp=$g(debts(sT001User,"TRX",sT001Trx,sTrxOp)) s sDatum=$e($p(sDebtsOp,$c(31),2),1,8) ; datum z T01c transakce do formatu YYYYMMDD if 'bMaxStr100n s s100n=s100n_", druh platby "_sTrxOp_" dluh="_$p(sDebtsOp,$c(31),1)_" datum "_sDatum s sTrxOp=$o(debts(sT001User,"TRX",sT001Trx,sTrxOp)) ; dalsi cyklus } if 'bMaxStr100n s s100n=s100n_" # " ; visualni oddelovac transakci s sT001Trx=$o(debts(sT001User,"TRX",sT001Trx)) ; dalsi opakovani } ; vytvoreni nove transakce d ##class(User.MARC).newX(.handle,dbTrx,"new") s s005="005 "_##class(User.Util).date005() ; format "200 $aL $b20090101000000.2 $i0.66 $j0 $kJ $lE $csys $e." ; prevod celkoveho dluhu na euro a zaokrouhleni na 2 desetinne mista s s200i=##class(User.ReportCommon).swapFmtNum(nSumDebt/exRate,2) s s200="200 "_$c(31)_"aL"_$c(31)_"b"_##class(User.Util).date005()_$c(31)_"i"_s200i s s200=s200_$c(31)_"j0"_$c(31)_"kJ"_$c(31)_"lE"_$c(31)_"csys"_$c(31)_"e." ; format "100 $axx_is_user*0001655" s nSumDebt=##class(User.ReportCommon).swapFmtNum(nSumDebt,2) ; format na 2 desetinne mista ; poznamka do 100n s s100n=s100n_"Celkovy dluh="_nSumDebt_" "_sCurrOld_", konverzni kurz="_exRate_", dluh po konverzi="_s200i_" "_sCurrNew s s100="100 "_$c(31)_"a"_sLnameUser_"*"_sT001User s s100=s100_$c(31)_"n"_s100n d ##class(User.MARC).setTagX(.handle,s005) d ##class(User.MARC).setTagX(.handle,s100) d ##class(User.MARC).setTagX(.handle,s200) ; ulozit celou transakci nebo jen informovat s sSaveInfo="" ; info do logu o ulozeni handle transakce do db s sT001="new" ; obsah T001 handle transakce, pokud se neulozi, je "new" if 'bLogOnly { s sc=##class(User.MARC).writeX(.handle) if (sc) { s sT001=$g(handle("t001")) s sSaveInfo="zapis nove transakce do db byl uspesny" } else { s sSaveInfo="ERROR: chyba zapisu nove transakce do db "_sc } } else { s sSaveInfo="zmeny nebyly zapsany do db, spusteno v rezimu ""pouze zapis do logu""" } ; zapisy do logu s sDebtsUser=$g(debts(sT001User)) ; format "prijmenijmeno_char31_celkovydluh" d file.WriteLine("") d file.WriteLine("nova transakce T001="_dbTrx_"/"_sT001_", "_$p(sDebtsUser,$c(31),1)) s sDebtByOp=$e(sDebtByOp,1,$l(sDebtByOp)-2) d file.WriteLine(" dluhy podle druhu platby:"_sDebtByOp) d file.WriteLine(" celkovy dluh stornovany v transakcich:") d file.WriteLine(" - pred konverzi : "_nSumDebt_" "_sCurrOld) d file.WriteLine(" - po konverzi a zaokrouhleni: "_s200i_" "_sCurrNew) d file.WriteLine(" vytvoren novy dluh na castku : "_s200i_" "_sCurrNew) d file.WriteLine(" "_sSaveInfo) k debts ; vycisti se struktura plnena v convTrxDebts2EuroTrx ]]> Pomocna metoda pro convTrxDebts2Euro, prevadi zkratku druhu platby podle ciselniku IctxUnTablesd IS_KINDPAY nebo IctxUnTablesd IS_KINDOP Parametry: sOpType - zkratka druhu platby transakce ze subtagu 200$a sIctx - zkratka instituce 10.12.08 jk; zalozeno [Previously private] 1 sKindPay:%String,sIpref:%String 1 jr.06.01.09 symbolik na selekt zaznamu kdy dany tag obsahuje dane hodnoty podpoli par1 - tag (650) par2 - subtag (i1#a#2) par3 - operator (=#[]#'=) par4 - hodnota (2#politika#eurovoc) napr. ##class(UtilConv).symSelTagValue(.handle,""041"",""a#h"",""=#="",""cze#fre"") 1 1 %String 0) && (not=0)) {s isOk = 1, h = tcnt} ;w !,"hodnota nalezena OK konec" if ((a >0) && (not=1)) {s isOk = 0, h = tcnt} ;w !,"nasla se a nemela ERR konec" if ((a = 0) && (not=0)){s isOk = 0} ;w !,"mela se najit a nenasla ERR , mozna bude v dalsim opak." if ((a = 0) && (not=1)){s isOk = 1} ;w !,"nemela se najit a nenasla OK , musi vsak vyhovovat pro vsechna opak." } else { if ((a = val1) && (not=0)) {s isOk = 1, h = tcnt} ;w !,"hodnota nalezena OK konec" if ((a = val1) && (not=1)) {s isOk = 0, h = tcnt} ;w !,"nasla se a nemela ERR konec" if ((a '= val1) && (not=0)){s isOk = 0} ;w !,"mela se najit a nenasla ERR , mozna bude v dalsim opak." if ((a '= val1) && (not=1)){s isOk = 1} ;w !,"nemela se najit a nenasla OK , musi vsak vyhovovat pro vsechna opak." } } } ;if (isOk = 1) {s h = tcnt} } if (isOk = 0) {s j = cntV} } if isOk = 1 s i = cntTag } q isOk ]]> riadkoveho formatu, zo suboru do suboru
]]> 1 inf:%String,outf:%String="" 1 error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" s record="" s t245="",t245a="",t245b="",t245n="" s t970b="",t970c="",t970="" s t100="",t100a="",t1004="",t100e="" s t700="",t700a="",t7004="",t700e="" s t999d="" s t653="" s t650="" s tC36="" s t014="" s t250="" s t711="",t711a="",t711d="",t711c="" s t710="" s nazov="" s t260="",t260a="",t260b="",t260d="" s t300="",t300a="",t300b="" s t440="" s t500="",t500a="" s t520="",t520a="" s t506="",t506a="" s t980="",t980a="",t980b="",t980c="" s tC99a="" s t773="",t773t="",t773g="" s druh="A" s druh2="" ; A-knihy, RBX-clanky, V-katalogy vystav, E-elektronicke dokumenty s brk=0,li="" s odd=$c(13)_$c(10) s kod=1 s ex044="",ex046g="",ex046h="",ex040="" f nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . ; nacitany 1 riadok . ; uprava jedneho riadku . s sprac="" . if (li'="") d . . s tag=$e(li,1,3) . . if tag="X01" d ; nazvove udaje . . . s t245a=##class(MARC).getSubTagStr(li,"n") ; nazov dokumentu . . . ;if $e(t245a,1,2)=$c(34)_" " s t245a=$c(34)_$e(t245,3,9999) . . . ;if $e(t245a,1,1)=$c(0022) s t245a="XXX" . . . s nazov=t245a . . . ; test nazvu na vylucene znaky . . . s i2="0" . . . s sln=$p(t245a," ",1) ; prve slovo z nazvu . . . s sln=$zcvt(sln,"l") . . . if (sln="a") || (sln="i") || (sln="l") s i2="2" . . . if (sln="an") || (sln="da") || (sln="de") || (sln="el") s i2="3" . . . if (sln="il") || (sln="le") || (sln="la") || (sln="un") || ($e(t245a,1,2)="l'") s i2="3" . . . if (sln="the") || (sln="una") || (sln="une") || (sln="der") s i2="4" . . . if (sln="die") || (sln="das") || (sln="les") || (sln="ein") s i2="4" . . . if (sln="eine") s i2="5" . . . ;if ($e(t245a,3,6)="die ") || ($e(t245a,3,6)="der ") || ($e(t245a,3,6)="das ") s i2="5" . . . . . . s t245b=##class(MARC).getSubTagStr(li,"p") ; podnazov . . . if t245b="" s t245b=##class(MARC).getSubTagStr(li,"b") ; podnazov . . . s t245n=##class(MARC).getSubTagStr(li,"o") ; oznacenie a cislo casti . . . if (t245a'="") || (t245b'="") || (t245n'="") d . . . . s t245="245 1"_i2_" " . . . . if t245a'="" s t245=t245_$c(31)_"a"_t245a . . . . if t245b'="" s t245=t245_" :"_$c(31)_"b"_t245b . . . . if t245n'="" s t245=t245_"."_$c(31)_"n"_t245n . . if tag="002" d ; druh dokumentu . . . s t970c=$e(li,8,9999) . . . s t970c=$zcvt(t970c,"u") . . if tag="X06" d ; autori v zahlavi 100/700 . . . s rola=##class(MARC).getSubTagStr(li,"b") ; rolav nekodovanom stave . . . s rola=$zcvt(rola,"l") . . . s rola=$tr(rola,"()/") . . . s tk=##class(MARC).getSubTagStr(li,"k") ; meno . . . s tp=##class(MARC).getSubTagStr(li,"p") ; priezvisko . . . if tk'="" s tp=tp_", "_tk . . . if t100a="" d . . . . s t100a="100 1 " . . . else d . . . . s t100a="700 1 " . . . if $f(rola,"autor")>0 d ; autor do 100 . . . . s t1004="aut" . . . else d . . . . if rola="by" s t1004="aut" . . . . if rola="ed." s t1004="edt" . . . . if rola="edited" s t1004="edt" . . . . if rola="hrsg." s t1004="com" . . . . if rola="sest." s t1004="com" . . . . if rola="zost." s t1004="com" . . . . if t1004="" s t100e=rola . . . if tp'="" s t100a=t100a_$c(31)_"a"_tp . . . if t1004'="" s t100a=t100a_$c(31)_"4"_t1004 . . . s t100e=$tr(t100e,"()/") . . . if t100e'="" s t100a=t100a_$c(31)_"e"_t100e . . . if t100'="" s t100=t100_odd_t100a . . . if t100="" s t100=t100a . . if tag="011" d ; akcia . . . s tp=##class(MARC).getSubTagStr(li,"p") ; datum zahajenia . . . s tu=##class(MARC).getSubTagStr(li,"u") ; datum ukoncenia . . . s tm=##class(MARC).getSubTagStr(li,"m") ; miesto konania . . . s tz=##class(MARC).getSubTagStr(li,"z") ; krajina konania . . . if nazov'="" s t711a=$c(31)_"a"_nazov . . . s tp=$tr(tp,"()/") . . . s tu=$tr(tu,"()/") . . . s tm=$tr(tm,"()/") . . . if $e(tm,$l(tm),$l(tm))="," s tm=$e(tm,1,$l(tm)-1) . . . if tp'="" d . . . . s rok=$e(tp,1,4) . . . . s mesiac=$e(tp,5,6) . . . . s den=$e(tp,7,8) . . . . if den'="" s t711d=den . . . . if mesiac'="" d . . . . . if t711d'="" s t711d=t711d_"."_mesiac . . . . . if t711d="" s t711d=mesiac . . . . if rok'="" d . . . . . if t711d'="" s t711d=t711d_"."_rok . . . . . if t711d="" s t711d=rok . . . if tu'="" d . . . . s rok=$e(tu,1,4) . . . . s mesiac=$e(tu,5,6) . . . . s den=$e(tu,7,8) . . . . s xx="" . . . . if den'="" s xx=den . . . . if mesiac'="" d . . . . . if xx'="" s xx=xx_"."_mesiac . . . . . if xx="" s xx=mesiac . . . . if rok'="" d . . . . . if xx'="" s xx=xx_"."_rok . . . . . if xx="" s xx=rok . . . . if xx'="" s t711d=t711d_"-"_xx . . . if tm'="" s t711c=$c(31)_"c"_tm_")" . . . if t711d'="" s t711d=$c(31)_"d("_t711d . . . if (t711d'="") || (t711c'="") d . . . . if t711'="" s t711=t711_odd_"711 1 "_t711a_t711d_t711c . . . . if t711="" s t711="711 1 "_t711a_t711d_t711c . . . if tz'="" d . . . . if tm'="" s tm=" ("_tm_")" . . . . if t710'="" s t710=t710_odd_"710 2 "_$c(31)_"a"_tz_tm_$c(31)_"4orm" . . . . if t710="" s t710="710 2 "_$c(31)_"a"_tz_tm_$c(31)_"4orm" . . if tag="013" d ; zahlavie . . . s tc=##class(MARC).getSubTagStr(li,"x") . . . if tc="" s tc=$e(li,8,9999) . . . if tc'="" s tC36="C36 "_$c(31)_"a"_tc . . if tag="014" d ; udaje o vydani . . . s tv=##class(MARC).getSubTagStr(li,"v") . . . s td=##class(MARC).getSubTagStr(li,"d") . . . s t250="250 " . . . if tv'="" s t250=t250_$c(31)_"a"_tv . . . if td'="" s t250=t250_$c(31)_"a"_td . . if tag="X07" d ; dalsi autori 700 . . . s rola=##class(MARC).getSubTagStr(li,"b") ; rolav nekodovanom stave . . . s rola=$zcvt(rola,"l") . . . s rola=$tr(rola,"()/") . . . s tk=##class(MARC).getSubTagStr(li,"k") ; meno . . . s tk=##class(Util).trim(tk) . . . s tp=##class(MARC).getSubTagStr(li,"p") ; priezvisko . . . s tp=##class(Util).trim(tp) . . . if (tk'="") || (tp'="") d . . . . if tk'="" s tp=tp_", "_tk . . . . s t700a="700 1 " . . . . if $f(rola,"autor")>0 d ; autor do 700 . . . . . s t7004="aut" . . . . else d . . . . . if rola="by" s t7004="aut" . . . . . if rola="ed." s t7004="edt" . . . . . if rola="edited" s t7004="edt" . . . . . if rola="hrsg." s t7004="com" . . . . . if rola="sest." s t7004="com" . . . . . if rola="zost." s t7004="com" . . . . . if t7004="" s t700e=rola . . . . if tp'="" s t700a=t700a_$c(31)_"a"_tp . . . . if t7004'="" s t700a=t700a_$c(31)_"4"_t7004 . . . . s t100e=$tr(t100e,"()/") . . . . if t700e'="" s t700a=t700a_$c(31)_"e"_t700e . . . . if t700'="" s t700=t700_odd_t700a . . . . if t700="" s t700=t700a . . if tag="040" d ; vydavatelske udaje . . . s ta=##class(MARC).getSubTagStr(li,"m") ; miesto vydania . . . ; test na b.m. . . . s testa=ta . . . s testa=$zcvt(testa,"l") . . . if (ta="") || ($f(testa,"b.m.")>0) s ta="[s.l.]" . . . s tb=##class(MARC).getSubTagStr(li,"n") ; nazov nakladatela . . . ; test na b.n. . . . s testb=tb . . . s testb=$zcvt(testb,"l") . . . if (tb="") || ($f(testb,"b.n.")>0) s tb="[s.n.]" . . . s td=##class(MARC).getSubTagStr(li,"d") ; datum vydania . . . ; test na b.r. . . . s testd=td . . . s testd=$zcvt(testd,"l") . . . if ($f(testd,"b.r.")>0) s td="[s.a.]" . . . s t260="260 " . . . s in="" . . . if ta'="" s in=" :" . . . if ta'="" s t260=t260_$c(31)_"a"_ta . . . if tb'="" s t260=t260_in_$c(31)_"b"_tb . . . if (ta'="") || (tb'="") s in="," . . . if td'="" s t260=t260_in_$c(31)_"c"_td . . . if $l(t260)<8 s t260="" . . . s ex040="1" . . if tag="044" d ; rozsah . . . if $f(li," CD")>0 s druh2="E" . . . s ta=##class(MARC).getSubTagStr(li,"s") ; rozsah . . . s tb=##class(MARC).getSubTagStr(li,"v") ; vybavenie dokumentu . . . s t300="300 " . . . s in="" . . . if ta'="" s in=" :" . . . if ta'="" s t300=t300_$c(31)_"a"_ta . . . if tb'="" s t300=t300_in_$c(31)_"b"_tb . . . s ex044="1" . . if tag="045" d ; edicia . . . s ta=##class(MARC).getSubTagStr(li,"n") ; nazov . . . s tv=##class(MARC).getSubTagStr(li,"c") ; oznacenie . . . s t440="490 0 " . . . s in="" . . . if ta'="" s in=" :" . . . if ta'="" s t440=t440_$c(31)_"a"_ta . . . if tv'="" s t440=t440_in_$c(31)_"v"_tv . . if tag="046" d ; poznamky . . . if $f(li," CD")>0 s druh2="E" . . . if $f(li,"CD ")>0 s druh2="E" . . . s ts=##class(MARC).getSubTagStr(li,"s") ; poznamky . . . if ts'="" d . . . . s ret=$p(ts,". - ",2) . . . . s ret=##class(Util).trim(ret) . . . . if ret'="" d ; ak sa jedna o 506 . . . . . ;s ret=$e(ret,5,9999) . . . . . if t506'="" s t506=t506_odd_"506 "_$c(31)_"a"_ret . . . . . if t506="" s t506="506 "_$c(31)_"a"_ret . . . . . s ret="" . . . . . s ts=$p(ts,". - ",1) ; orezanie ts . . . . if ex040="" d ; ak neexistuje tag 040 tak je to clanok . . . . . if ($e(ret,1,3)="V :") || ($e(ret,1,2)="V:") || ($e(ret,1,4)="In :") || ($e(ret,1,3)="In:") d ; ak je to odkaz 773 . . . . . . s t773g=ret . . . . . if ($e(ts,1,3)="V :") || ($e(ts,1,2)="V:") || ($e(ts,1,4)="In :") || ($e(ts,1,3)="In:") d ; ak je to odkaz 773 . . . . . . s t773t=ts . . . . else d . . . . . if t500'="" s t500=t500_odd_"500 "_$c(31)_"a"_ts . . . . . if t500="" s t500="500 "_$c(31)_"a"_ts . . . . if (t773g'="") || (t773t'="") d . . . . . s tx="773 0 " . . . . . if t773t'="" s tx=tx_$c(31)_"t"_t773t . . . . . if t773g'="" s tx=tx_$c(31)_"g"_t773g . . . . . if t773'="" s t773=t773_odd_tx . . . . . if t773="" s t773=tx . . . . . s druh="RBX" . . . s tv=##class(MARC).getSubTagStr(li,"v") ; poznamka k udajom o vydani . . . s th=##class(MARC).getSubTagStr(li,"h") ; poznamka k nakladatelskym udajom . . . s ex046h=th . . . s tr=##class(MARC).getSubTagStr(li,"r") ; poznamka k udajom o rozsahu . . . s te=##class(MARC).getSubTagStr(li,"e") ; poznamka k udajom o edicii . . . if tv'="" d . . . . if t500'="" s t500=t500_odd_"500 "_$c(31)_"a"_tv . . . . if t500="" s t500="500 "_$c(31)_"a"_tv . . . if tr'="" d . . . . if t500'="" s t500=t500_odd_"500 "_$c(31)_"a"_tr . . . . if t500="" s t500="500 "_$c(31)_"a"_tr . . . if te'="" d . . . . if t500'="" s t500=t500_odd_"500 "_$c(31)_"a"_te . . . . if t500="" s t500="500 "_$c(31)_"a"_te . . . if th'="" d . . . . s ret=$p(th,". - ",2) . . . . s ret=##class(Util).trim(ret) . . . . if ret'="" d . . . . . ;s ret=$e(ret,5,9999) . . . . . if t506'="" s t506=t506_odd_"506 "_$c(31)_"a"_ret . . . . . if t506="" s t506="506 "_$c(31)_"a"_ret . . . . . s th=$e(th,". - ",1) . . . . . if t520'="" s t520=t520_odd_"520 "_$c(31)_"a"_th . . . . . if t520="" s t520="520 "_$c(31)_"a"_th . . . . else d . . . . . if t520'="" s t520=t520_odd_"520 "_$c(31)_"a"_th . . . . . if t520="" s t520="520 "_$c(31)_"a"_th . . if tag="054" d ; predmetove hesla . . . s tk=##class(MARC).getSubTagStr(li,"x") . . . if tk="" s tk=$e(li,8,9999) . . . if tk'="" d . . . . if t650'="" s t650=t650_odd_"650 04 "_$c(31)_"a"_tk . . . . if t650="" s t650="650 04 "_$c(31)_"a"_tk . . if tag="055" d ; klucove slova . . . s tk=##class(MARC).getSubTagStr(li,"k") ; klucove slovo . . . if tk'="" d . . . . if t653'="" s t653=t653_odd_"653 0 "_$c(31)_"a"_tk . . . . if t653="" s t653="653 0 "_$c(31)_"a"_tk . . if tag="080" d ; holdingove informacie - opakovatelne . . . s ta=##class(MARC).getSubTagStr(li,"c") ; prirastkove cislo a mfn . . . s tb=##class(MARC).getSubTagStr(li,"g") ; signatura . . . ; rozdelit a na pr cislo/cisla a mfn . . . s ta=##class(User.Util).strswap(ta," ","#") . . . if $f(ta,"#")>0 s tc=$p(ta,"#",$l(ta,"#")) ; posledny vyskyt . . . s tc=##class(Util).trim(tc) . . . if tc'="" s tC99a=tc . . . s ta=$p(ta,"#",1) ; prvy vyskyt . . . s ta=##class(Util).trim(ta) . . . s tx="" . . . if ta'="" s tx=$c(31)_"a"_ta ; prirastkove cislo/ cisla oddelene , ; . . . if tb'="" s tx=tx_$c(31)_"b"_tb ; signatura/y detto . . . if $f(ta,"CD")>0 s druh="E" . . . if $f(tb,"CD")>0 s druh="E" . . . . . . if ($f(ta,"/K")>0) || ($f(tb,"/K")>0) d ; katalogy z vystav . . . . s druh="V" . . . ;if tc'="" s tx=tx_$c(31)_"c"_tc ; mfn . . . if tx'="" d . . . . if t980'="" s t980=t980_odd_"980 "_tx . . . . if t980="" s t980="980 "_tx . . if tag="089" d ; spracovanie zaznamu . . . s td=##class(MARC).getSubTagStr(li,"d") ; datum . . . if td'="" s td=td_"0101" . . . s tz=##class(MARC).getSubTagStr(li,"z") ; zpracovatel . . . s tz=$zcvt(tz,"l") . . . if tz="" s tz="sng" . . . s t999d=tz_"-"_td . q:$zeof'=0 . ; zapis zaznamu az vtedy ked je koniec daneho zaznamu . if li="###" d ;vtedy zapisat . . ; urcenie druhu doklumentu . . if druh="" s druh="A" . . s rok=##class(MARC).getSubTagStr(t260,"d") ; rok vydania do 008 . . if $l(rok)'=4 s rok = " " . . if druh2="E" d . . . if (druh="") || (druh="A") s druh="E" . . ; . . s c99d="DFLT_US_CAT_BK_A" ; knihy . . s t00="000 00000nam-a22 3a-4500" . . s t08="008 "_$e(##class(Util).date(),3,9999)_"s"_rok_"----xo-----g---d--------slo-d" . . ; . . ;if t980="" d . . if druh="RBX" s c99d="DFLT_US_CAT_CLA_A" ; clanky . . if druh="RBX" s t00="000 00000naa-a22 3a-4500" . . if druh="RBX" s t08="008 "_$e(##class(Util).date(),3,9999)_"e"_rok_"----xo-||||g------000-0-slo-d" . . ; . . if druh="V" s c99d="DFLT_US_CAT2" ; katalogy z vystav . . if druh="V" s t00="000 00000nam-a22 3a-4500" . . if druh="V" s t08="008 "_$e(##class(Util).date(),3,9999)_"s"_rok_"----xo-||||g------000-0-slo-d" . . ; . . if druh="E" s c99d="DFLT_US_CAT_CF" ; elektronicke zdroje . . if druh="E" s t00="000 00000nmm-a22 3a-4500" . . if druh="E" s t08="008 "_$e(##class(Util).date(),3,9999)_"s"_rok_"----xo-||||g------000-0-slo-d" . . ; . . s t970b=druh . . s poc=kod . . s dlzka=$l(kod) ; pocet znakov kodu . . s dlzka=7-dlzka . . f i=1:1:dlzka d . . . s poc="0"_poc . . s record=odd_"# @id SngUsCat m"_poc . . s record=record_odd_t00 . . s record=record_odd_"003 SK-BrSNG" . . s record=record_odd_"005 "_##class(Util).date()_"0101.0" . . s record=record_odd_"007 ta" . . s record=record_odd_t08 . . s record=record_odd_"040 "_$c(31)_"aBA406"_$c(31)_"cBA406" . . . . if t100'="" s record=record_odd_t100 . . if t245'="" s record=record_odd_t245 . . if t250'="" s record=record_odd_t250 . . if t260'="" s record=record_odd_t260 . . if t300'="" s record=record_odd_t300 . . if t440'="" s record=record_odd_t440 . . if t500'="" s record=record_odd_t500 . . if t506'="" s record=record_odd_t506 . . if t520'="" s record=record_odd_t520 . . if t650'="" s record=record_odd_t650 . . if t653'="" s record=record_odd_t653 . . if t700'="" s record=record_odd_t700 . . if t710'="" s record=record_odd_t710 . . if t711'="" s record=record_odd_t711 . . if t773'="" s record=record_odd_t773 . . if tC36'="" s record=record_odd_tC36 . . if t980'="" s record=record_odd_t980 . . . . s record=record_odd_"C99 "_$c(31)_"d"_c99d . . if tC99a'="" s record=record_$c(31)_"c"_tC99a . . s record=record_odd_"970 "_$c(31)_"b"_t970b_$c(31)_"c"_t970c . . if t999d="" s t999d="arl-"_##class(Util).date() . . s record=record_odd_"999 "_$c(31)_"a1"_$c(31)_"bSNG"_$c(31)_"cSNG"_$c(31)_"d"_t999d . . s record=record_odd_"###" . . if (record'="") && (t245'="") use outf w record use OU . . s record="" . . s t245="",t245a="",t245b="",t245n="" . . s t100="",t100a="",t1004="",t100e="" . . s t700="",t700a="",t7004="",t700e="" . . s t999d="" . . s t970b="" . . s t653="" . . s t650="" . . s tC36="" . . s t250="" . . s t711="",t711a="",t711d="",t711c="" . . s t710="" . . s nazov="",druh="",druh2="" . . s t260="",t260a="",t260b="",t260d="" . . s t300="",t300a="",t300b="" . . s t980="",t980a="",t980b="",t980c="" . . s t440="" . . s t500="",t500a="" . . s t520="",t520a="" . . s t506="",t506a="" . . s tC99a="" . . s t773="",t773t="",t773g="" . . s ex044="",ex046g="",ex046h="",ex040="",druh="" . . s kod=kod+1 close inf close outf use OU d $ZU(68,40,0) q "" ]]> ]]> 1 1 ]]> 1 1 90 d . . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . . s slovo=$l($p(hladaj," ",$l(hladaj," "))) . . s hladaj=$e(hladaj,1,$l(hladaj)-slovo)_".." . if t7="" d ; ak nie je kod autority spracovat . . if '$d(^ooDataTableI("SngUsAuth","a100",hladaj)) d ; hladanie v osobnych autoritach . . . ; ak nie je v indexe tak ho zapis do autorit . . . d ##class(MARC).newX(.handlea,"SngUsAuth","new") . . . d ##class(MARC).setTagX(.handlea,"000 00000nz--a22 n--4500") . . . d ##class(MARC).setTagX(.handlea,"003 SK-BrSNG") . . . d ##class(MARC).setTagX(.handlea,"005 "_##class(Util).date()_"000000.0") . . . d ##class(MARC).setTagX(.handlea,"008 "_"090630-||abz||aa|n-----------b-an-----sd") . . . d ##class(MARC).setTagX(.handlea,"040 "_$c(31)_"aBA406"_$c(31)_"bslo"_$c(31)_"dBA406") . . . s t100="" . . . if ta'="" s t100=$c(31)_"a"_ta . . . d ##class(MARC).setTagX(.handlea,"100 1 "_t100) . . . d ##class(MARC).setTagX(.handlea,"999 "_$c(31)_"a1"_$c(31)_"bSNG"_$c(31)_"dSNG-"_##class(Util).date()) . . . d ##class(MARC).setTagX(.handlea,"C99 "_$c(31)_"dDFLT_US_AUTH_100") . . . s st=##class(MARC).writeX(.handlea,1,,,1) . . . ; testujem pripad ked sa nepodari zapisat autoritu . . . if $$$ISERR(st) w !,"FATAL ERROR:"_##class(Util).status2str(st) b ztrap "ERR" . . . s t001="" s t001=$$$HandleT001(handlea) . . . if t4'="" s t100=t100_$c(31)_"4"_t4 . . . if te'="" s t100=t100_$c(31)_"e"_te . . . if t100s'="" s t100s="100 1 "_t100_$c(31)_"7"_"sng_us_auth*"_t001 . . else d ; najdena autorita . . . s idauth="" . . . s idauth=$o(^ooDataTableI("SngUsAuth","a100",hladaj,"")) . . . s t001=##class(MARC).getT001(idauth) . . . if t001'="" d . . . . s t100snew="100 1 " . . . . if ##class(MARC).readLX(.handlea,"sng_us_auth*"_t001) d . . . . . s ta=##class(MARC).getTagX(.handlea,"100a") . . . . . if ta'="" s t100snew=t100snew_$c(31)_"a"_ta . . . . . if t4'="" s t100snew=t100snew_$c(31)_"4"_t4 . . . . . if te'="" s t100snew=t100snew_$c(31)_"e"_te . . . . if t100snew'="" s t100s=t100snew_$c(31)_"7"_"sng_us_auth*"_t001 . if t100new'="" s t100new=t100new_$c(10)_t100s . if t100new="" s t100new=t100s if t100new'="" d . if t100'=t100new d ##class(MARC).setTagX(.handle,t100new) q ]]> ]]> 1 1 90 d . . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . . s slovo=$l($p(hladaj," ",$l(hladaj," "))) . . s hladaj=$e(hladaj,1,$l(hladaj)-slovo)_".." . if t7="" d ; ak nie je kod autority spracovat . . if '$d(^ooDataTableI("SngUsAuth","a100",hladaj)) d ; hladanie v osobnych autoritach . . . ; ak nie je v indexe tak ho zapis do autorit . . . d ##class(MARC).newX(.handlea,"SngUsAuth","new") . . . d ##class(MARC).setTagX(.handlea,"000 00000nz--a22 n--4500") . . . d ##class(MARC).setTagX(.handlea,"003 SK-BrSNG") . . . d ##class(MARC).setTagX(.handlea,"005 "_##class(Util).date()_"000000.0") . . . d ##class(MARC).setTagX(.handlea,"008 "_"090630-||abz||aa|n-----------b-an-----sd") . . . d ##class(MARC).setTagX(.handlea,"040 "_$c(31)_"aBA406"_$c(31)_"bslo"_$c(31)_"dBA406") . . . s t100="" . . . if ta'="" s t100=$c(31)_"a"_ta . . . d ##class(MARC).setTagX(.handlea,"100 1 "_t100) . . . d ##class(MARC).setTagX(.handlea,"999 "_$c(31)_"a1"_$c(31)_"bSNG"_$c(31)_"dSNG-"_##class(Util).date()) . . . d ##class(MARC).setTagX(.handlea,"C99 "_$c(31)_"dDFLT_US_AUTH_100") . . . s st=##class(MARC).writeX(.handlea,1,,,1) . . . ; testujem pripad ked sa nepodari zapisat autoritu . . . if $$$ISERR(st) w !,"FATAL ERROR:"_##class(Util).status2str(st) b ztrap "ERR" . . . s t001="" s t001=$$$HandleT001(handlea) . . . if t4'="" s t100=t100_$c(31)_"4"_t4 . . . if te'="" s t100=t100_$c(31)_"e"_te . . . if t700s'="" s t700s="700 1 "_t100_$c(31)_"7"_"sng_us_auth*"_t001 . . else d ; najdena autorita . . . s idauth="" . . . s idauth=$o(^ooDataTableI("SngUsAuth","a100",hladaj,"")) . . . s t001=##class(MARC).getT001(idauth) . . . if t001'="" d . . . . s t700snew="700 1 " . . . . if ##class(MARC).readLX(.handlea,"sng_us_auth*"_t001) d . . . . . s ta=##class(MARC).getTagX(.handlea,"100a") . . . . . if ta'="" s t700snew=t700snew_$c(31)_"a"_ta . . . . . if t4'="" s t700snew=t700snew_$c(31)_"4"_t4 . . . . . if te'="" s t700snew=t700snew_$c(31)_"e"_te . . . . if t700snew'="" s t700s=t700snew_$c(31)_"7"_"sng_us_auth*"_t001 . if t700new'="" s t700new=t700new_$c(10)_t700s . if t700new="" s t700new=t700s if t700new'="" d . if t700'=t700new d ##class(MARC).setTagX(.handle,t700new) q ]]> ]]> 1 1 90 d . . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . . s slovo=$l($p(hladaj," ",$l(hladaj," "))) . . s hladaj=$e(hladaj,1,$l(hladaj)-slovo)_".." . if t7="" d ; ak nie je kod autority spracovat . . if '$d(^ooDataTableI("SngUsAuth","a110",hladaj)) d ; hladanie v osobnych autoritach . . . ; ak nie je v indexe tak ho zapis do autorit . . . d ##class(MARC).newX(.handlea,"SngUsAuth","new") . . . d ##class(MARC).setTagX(.handlea,"000 00000nz--a22 n--4500") . . . d ##class(MARC).setTagX(.handlea,"003 SK-BrSNG") . . . d ##class(MARC).setTagX(.handlea,"005 "_##class(Util).date()_"000000.0") . . . d ##class(MARC).setTagX(.handlea,"008 "_"090630-||abz||aa|n-----------b-an-----sd") . . . d ##class(MARC).setTagX(.handlea,"040 "_$c(31)_"aBA406"_$c(31)_"bslo"_$c(31)_"dBA406") . . . s t110="" . . . if ta'="" s t110=$c(31)_"a"_ta . . . d ##class(MARC).setTagX(.handlea,"110 2 "_t110) . . . d ##class(MARC).setTagX(.handlea,"999 "_$c(31)_"a1"_$c(31)_"bSNG"_$c(31)_"dSNG-"_##class(Util).date()) . . . d ##class(MARC).setTagX(.handlea,"C99 "_$c(31)_"dDFLT_US_AUTH_110") . . . s st=##class(MARC).writeX(.handlea,1,,,1) . . . ; testujem pripad ked sa nepodari zapisat autoritu . . . if $$$ISERR(st) w !,"FATAL ERROR:"_##class(Util).status2str(st) b ztrap "ERR" . . . s t001="" s t001=$$$HandleT001(handlea) . . . if t4'="" s t110=t110_$c(31)_"4"_t4 . . . if t710s'="" s t710s="710 2 "_t110_$c(31)_"7"_"sng_us_auth*"_t001 . . else d ; najdena autorita . . . s idauth="" . . . s idauth=$o(^ooDataTableI("SngUsAuth","a110",hladaj,"")) . . . s t001=##class(MARC).getT001(idauth) . . . if t001'="" d . . . . s t710snew="710 2 " . . . . if ##class(MARC).readLX(.handlea,"sng_us_auth*"_t001) d . . . . . s ta=##class(MARC).getTagX(.handlea,"110a") . . . . . if ta'="" s t710snew=t710snew_$c(31)_"a"_ta . . . . . if t4'="" s t710snew=t710snew_$c(31)_"4"_t4 . . . . if t710snew'="" s t710s=t710snew_$c(31)_"7"_"sng_us_auth*"_t001 . if t710new'="" s t710new=t710new_$c(10)_t710s . if t710new="" s t710new=t710s if t710new'="" d . if t710'=t710new d ##class(MARC).setTagX(.handle,t710new) q ]]> ]]> 1 1 ]]> 1 1 ]]> 1 1 90 d . . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . . s slovo=$l($p(hladaj," ",$l(hladaj," "))) . . s hladaj=$e(hladaj,1,$l(hladaj)-slovo)_".." . if t7="" d ; ak nie je kod autority spracovat . . if '$d(^ooDataTableI("SngUsAuth","a150",hladaj)) d ; hladanie v osobnych autoritach . . . ; ak nie je v indexe tak ho zapis do autorit . . . d ##class(MARC).newX(.handlea,"SngUsAuth","new") . . . d ##class(MARC).setTagX(.handlea,"000 00000nz--a22 n--4500") . . . d ##class(MARC).setTagX(.handlea,"003 SK-BrSNG") . . . d ##class(MARC).setTagX(.handlea,"005 "_##class(Util).date()_"000000.0") . . . d ##class(MARC).setTagX(.handlea,"008 "_"090630-||abz||aa|n-----------b-an-----sd") . . . d ##class(MARC).setTagX(.handlea,"040 "_$c(31)_"aBA406"_$c(31)_"bslo"_$c(31)_"dBA406") . . . s t150="" . . . if ta'="" s t150=$c(31)_"a"_ta . . . d ##class(MARC).setTagX(.handlea,"150 "_t150) . . . d ##class(MARC).setTagX(.handlea,"999 "_$c(31)_"a1"_$c(31)_"bSNG"_$c(31)_"dSNG-"_##class(Util).date()) . . . d ##class(MARC).setTagX(.handlea,"C99 "_$c(31)_"dDFLT_US_AUTH_150") . . . s st=##class(MARC).writeX(.handlea,1,,,1) . . . ; testujem pripad ked sa nepodari zapisat autoritu . . . if $$$ISERR(st) w !,"FATAL ERROR:"_##class(Util).status2str(st) b ztrap "ERR" . . . s t001="" s t001=$$$HandleT001(handlea) . . . if t650s'="" s t650s="650 04 "_t150_$c(31)_"7"_"sng_us_auth*"_t001 . . else d ; najdena autorita . . . s idauth="" . . . s idauth=$o(^ooDataTableI("SngUsAuth","a150",hladaj,"")) . . . s t001=##class(MARC).getT001(idauth) . . . if t001'="" d . . . . s t650snew="650 04 " . . . . if ##class(MARC).readLX(.handlea,"sng_us_auth*"_t001) d . . . . . s ta=##class(MARC).getTagX(.handlea,"150a") . . . . . if ta'="" s t650snew=t650snew_$c(31)_"a"_ta . . . . if t650snew'="" s t650s=t650snew_$c(31)_"7"_"sng_us_auth*"_t001 . if t650new'="" s t650new=t650new_$c(10)_t650s . if t650new="" s t650new=t650s if t650new'="" d ##class(MARC).setTagX(.handle,t650new) q ]]> riadkoveho formatu, zo suboru do suboru
]]> 1 inf:%String,outf:%String="" 1 error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" ; otevrit vystupni soubor 2 s outf2="c:\fno\znaky.txt" open outf2:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf2_"')!!" s odd=$c(13)_$c(10) s kod=1 s brk=0,nkrec="",nkid="",nkid2="",li="",begin="1",hlavicka="",kodold="",t970="",t970a="",t970b="" s t970c="",t982="",c999da="",c999db="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . ; nacitany 1 riadok . s li=##class(Util).strswap(li,"$",$c(31)) . ;uprava jedneho riadku . if (li'="") d . . ; kontrola hlavicky 000 . . if ($e(li,1,3)="lab") || ($f(li,"lab ")) d . . . ;use outf w odd_"xxxxxxxxxxxx" use OU . . . s hlavicka = "" . . . . . . if begin = "" d . . . . if (t970a'="") || (t970b'="") || (t970c'="") d . . . . . s t970=odd_"970 " . . . . . if t970a'="" s t970=t970_$c(31)_"a"_t970a . . . . . if t970b'="" s t970=t970_$c(31)_"b"_t970b . . . . s c999="arl-"_##class(Util).date() . . . . if c999da'="" d . . . . . s c999=c999da . . . . if c999db'="" d . . . . . s c999=c999_"#"_c999db . . . . s hlavicka=t970_odd_"999 "_$c(31)_"a1"_$c(31)_"bFNO"_$c(31)_"cFNO"_$c(31)_"d"_c999_odd_"###" . . . . s t970="",t970a="",t970b="",t970c="",c999da="",c999db="" . . . . . . s poc=kod . . . s dlzka=$l(kod) ; pocet znakov kodu . . . s dlzka=7-dlzka . . . f i=1:1:dlzka d . . . . s poc="0"_poc . . . s kod=kod+1 . . . s hlavicka=hlavicka_odd_"# @id FnoUnEpca "_poc . . . ;if (begin="1") s hlavicka=hlavicka_$c(10) . . . if ($f(li,"lab ")) d . . . . s lix=$p(li,"lab ",1) . . . . if ($e(lix,1,3)'="Q00") && ($e(lix,1,3)'="ZAZ") d . . . . . use outf w odd_lix use OU . . . . s li="lab "_$p(li,"lab ",2) . . . s li=##class(Util).strswap(li,"lab","000") . . . s hlavicka=hlavicka_odd_li,li="" . . . use outf w hlavicka use OU . . if ($e(li,1,3)="DDR") d ; druh dokumentu . . . s tb=##class(MARC).getSubTagStr(li,"b") . . . if tb'="" s t970b=tb . . . s li="" . . if ($e(li,1,3)="KPC") d ; kategoria publikacnej cinnosti . . . s ta=##class(MARC).getSubTagStr(li,"a") . . . if ta'="" s t970a=ta . . . s tc=##class(MARC).getSubTagStr(li,"c") . . . if tc'="" s t970c=tc . . . s li="" . . if ($e(li,1,3)="LOK") d ; lokacia . . . s tl=##class(MARC).getSubTagStr(li,"l") . . . s t980="" . . . s t982="" . . . s tt=##class(MARC).getSubTagStr(li,"t") . . . if tt'="" s t982="982 "_$c(31)_"a"_tt . . . if tl'="" s t980="980 "_$c(31)_"a"_tl . . . s li=t980 . . . if t982'="" d . . . . if li'="" s li=li_odd_t982 . . . . if li="" s li=t982 . . if ($e(li,1,2)="70") || ($e(li,1,3)="600") d ; linky v autoritach fno... . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . s t3n=t3 . . . if $e(t3,1,3)="FNO" s t3n="fno_un_auth*p"_$e(t3,4,9999) . . . if $e(t3,1,3)'="FNO" s t3n="fno_un_auth*"_t3 . . . s li=##class(Util).strswap(li,$c(31)_"3"_t3,$c(31)_"3"_t3n) . . if ($e(li,1,3)="606") d ; linky na mesh . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . s t3n=t3 . . . if $e(t3,1,1)="D" d . . . . ; vyhodit z kodu cz . . . . s t3n="fno_un_auth*d"_$e(t3,2,9999) . . . . s t3n=##class(Util).strswap(t3n,"cz","") . . . if $e(t3,1,1)'="D" s t3n="fno_un_auth*"_t3 . . . s li=##class(Util).strswap(li,$c(31)_"3"_t3,$c(31)_"3"_t3n) . . if ($e(li,1,2)="71") || ($e(li,1,3)="610") d ; linky v autoritach fno... . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . s t3n=t3 . . . if $e(t3,1,3)="FNO" s t3n="fno_un_auth*k"_$e(t3,4,9999) . . . if $e(t3,1,3)'="FNO" s t3n="fno_un_auth*"_t3 . . . s li=##class(Util).strswap(li,$c(31)_"3"_t3,$c(31)_"3"_t3n) . . if ($e(li,1,3)="999") d . . . s li="" . . if ($e(li,1,3)="NOS") d ;nosic 345c . . . s ta=##class(MARC).getSubTagStr(li,"a") . . . if ta'="" s li="345 "_$c(31)_"c"_ta . . if ($e(li,1,3)="BIB") d ;rok v ktorom vysiel clanok . . . s ta=##class(MARC).getSubTagStr(li,"a") . . . if ta'="" s li="C26 "_$c(31)_"d"_ta . . if ($e(li,1,3)="974") d . . . s tf=##class(MARC).getSubTagStr(li,"f") . . . s tf=##class(Util).strswap(tf,"Knihy / monografie","A") . . . s tf=##class(Util).strswap(tf,"Èasopisy / periodika","B") . . . if (tf'="") && (t970b="") s t970b=tf . . . s li="" . . if ($e(li,1,3)="Q00") || ($e(li,1,3)="Q45") || ($e(li,1,3)="001") || ($e(li,1,3)="DIL") s li="" . . if ($e(li,1,3)="X00") || ($e(li,1,3)="IMP") || ($e(li,1,3)="Q 4") s li="" . . if ($e(li,1,1)="4") && ($f(li,$c(31)_"1")<1) d . . . if ($e(li,1,3)="461") || ($e(li,1,3)="463") d . . . . s t4xx="463"_$e(li,4,7) . . . else d . . . . s t4xx=$e(li,1,7) . . . ; vysvapovat . za medzery . . . s t4xx=##class(Util).strswap(t4xx,"."," ") . . . s tt=##class(MARC).getSubTagStr(li,"t") . . . if tt'="" s t4xx=t4xx_$c(31)_"12001 "_$c(31)_"a"_tt . . . s tb=##class(MARC).getSubTagStr(li,"b") . . . if tb'="" s t4xx=t4xx_$c(31)_"b"_tb . . . s th=##class(MARC).getSubTagStr(li,"h") . . . if th'="" s t4xx=t4xx_$c(31)_"h"_th . . . s ti=##class(MARC).getSubTagStr(li,"i") . . . if ti'="" s t4xx=t4xx_$c(31)_"i"_ti . . . s to=##class(MARC).getSubTagStr(li,"o") . . . if to'="" s t4xx=t4xx_$c(31)_"e"_to . . . s ta=##class(MARC).getSubTagStr(li,"a") . . . if ta'="" s t4xx=t4xx_$c(31)_"f"_ta . . . s tv=##class(MARC).getSubTagStr(li,"v") . . . if tv'="" s t4xx=t4xx_$c(31)_"v"_tv . . . s tc=##class(MARC).getSubTagStr(li,"c") . . . if tc'="" s t4xx=t4xx_$c(31)_"1210 "_$c(31)_"a"_tc . . . s tn=##class(MARC).getSubTagStr(li,"n") . . . if tn'="" s t4xx=t4xx_$c(31)_"c"_tn . . . s td=##class(MARC).getSubTagStr(li,"d") . . . if td'="" s t4xx=t4xx_$c(31)_"d"_td . . . s te=##class(MARC).getSubTagStr(li,"e") . . . if te'="" s t4xx=t4xx_$c(31)_"1205 "_$c(31)_"a"_te . . . s tf=##class(MARC).getSubTagStr(li,"f") . . . if tf'="" s t4xx=t4xx_$c(31)_"1700 1"_$c(31)_"a"_tf . . . s tg=##class(MARC).getSubTagStr(li,"g") . . . if tg'="" s t4xx=t4xx_$c(31)_"1701 1"_$c(31)_"a"_tg . . . s tl=##class(MARC).getSubTagStr(li,"l") . . . if tl'="" s t4xx=t4xx_$c(31)_"1510 1"_$c(31)_"a"_tl . . . s tp=##class(MARC).getSubTagStr(li,"p") . . . if tp'="" s t4xx=t4xx_$c(31)_"1215 "_$c(31)_"a"_tp . . . s ts=##class(MARC).getSubTagStr(li,"s") . . . if ts'="" s t4xx=t4xx_$c(31)_"12250 "_$c(31)_"a"_ts . . . s tu=##class(MARC).getSubTagStr(li,"u") . . . if tu'="" s t4xx=t4xx_$c(31)_"1856 "_$c(31)_"u"_tu . . . s tx=##class(MARC).getSubTagStr(li,"x") . . . if tx'="" s t4xx=t4xx_$c(31)_"1011 "_$c(31)_"a"_tx . . . s ty=##class(MARC).getSubTagStr(li,"y") . . . if ty'="" s t4xx=t4xx_$c(31)_"1010 "_$c(31)_"a"_ty . . . s tz=##class(MARC).getSubTagStr(li,"z") . . . if tz'="" s t4xx=t4xx_$c(31)_"1040 "_$c(31)_"a"_tz . . . s li=t4xx . . if ($e(li,1,3)="990") d . . . s ta=##class(MARC).getSubTagStr(li,"a") ; datum . . . s ta=$e(ta,1,8) . . . if ta="" s ta=##class(Util).date() . . . s tb=##class(MARC).getSubTagStr(li,"b") ; organizacia . . . s tc=##class(MARC).getSubTagStr(li,"c") ; autor . . . s c999da="" . . . if tc="" s tc="arl" . . . if tc'="" s c999da=tc . . . if tb'="" s c999da=c999da_"_"_tb . . . if ta'="" s c999da=c999da_"-"_ta . . . s li="" . . if ($e(li,1,3)="991") d . . . s ta=##class(MARC).getSubTagStr(li,"a") ; datum . . . s ta=$e(ta,1,8) . . . if ta="" s ta=##class(Util).date() . . . s tb=##class(MARC).getSubTagStr(li,"b") ; organizacia . . . s tc=##class(MARC).getSubTagStr(li,"c") ; autor . . . s c999db="" . . . if tc="" s tc="arl" . . . if tc'="" s c999db=tc . . . if tb'="" s c999db=c999db_"_"_tb . . . if ta'="" s c999db=c999db_"-"_ta . . . s li="" . . ; osetrenie vsetkych pismenkovych tagov . . s znakk=$e(li,1,1) . . s statn="" . . f i=0:1:9 d . . . if i=znakk s statn="1" . . if statn'="1" d . . . ; zapisat do specialneho suboru . . . if li'="" use outf2 w odd_li use OU . . . . if li'="" use outf w odd_li use OU . . s li="" . . s begin="" . q:$zeof'=0 . . ; zpracovat jeden radek . ;s li=$e(li,11,9999) s $e(li,7,8)="" . ;s li=##class(Util).strswap(li," "," ") if li="" q s c999="arl-"_##class(Util).date() if c999da'="" d . s c999=c999da if c999db'="" d . s c999=c999_"#"_c999db use outf w odd_"999 "_$c(31)_"a1"_$c(31)_"bFNO"_$c(31)_"cFNO"_$c(31)_"d"_c999_odd_"###" use OU close inf close outf close outf2 use OU ; enable error d $ZU(68,40,0) q "" ]]> riadkoveho formatu, zo suboru do suboru
]]> 1 inf:%String,outf:%String="" 1 error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" ; otevrit vystupni soubor 2 s outf2="c:\fno\znakya.txt" open outf2:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf2_"')!!" s odd=$c(13)_$c(10) s kod=1 s brk=0,nkrec="",nkid="",nkid2="",li="",begin="1",hlavicka="",kodold="",t3="",zaznam="",poc="",hesla="" s tag250="",pocold="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . ; nacitany 1 riadok . s li=##class(Util).strswap(li,"$",$c(31)) . ;uprava jedneho riadku . if (li'="") d . . if ($e(li,1,3)="lab") d . . . s hlavicka = "" . . . if t3'="" d . . . . s t3=$zcvt(t3,"l") . . . . if $e(t3,1,2)="d0" s t3=##class(Util).strswap(t3,"cz","") . . . . s zaznam=##class(Util).strswap(zaznam,"# @id FnoUnAuth "_poc,"# @id FnoUnAuth "_t3) . . . . if hesla'="" d . . . . . s zaznam=##class(Util).strswap(zaznam,tag250,tag250_hesla) . . . . s t3="" . . . use outf w zaznam . . . if begin = "" d . . . . s hlavicka=odd_"999 "_$c(31)_"a1"_$c(31)_"bFNO"_$c(31)_"cFNO"_$c(31)_"d"_"arl-"_##class(Util).date()_odd_"###" . . . s poc=kod . . . s dlzka=$l(kod) ; pocet znakov kodu . . . s dlzka=7-dlzka . . . f i=1:1:dlzka d . . . . s poc="0"_poc . . . s kod=kod+1 . . . s hlavicka=hlavicka_odd_"# @id FnoUnAuth "_poc . . . s li="000"_$e(li,4,9999) . . . ;s hlavicka=hlavicka_odd_li,li="" . . . s zaznam=hlavicka . . . s hesla="" . . . ;use outf w hlavicka use OU . . if ($e(li,1,3)="001") d . . . s t3="" . . . if $e(li,8,9)="D0" d . . . . s t3=$zcvt($e(li,8,9999),"l") . . . . s t3=##class(Util).strswap(t3,"cz","") . . . if t3'="" d . . . . s zaznam=##class(Util).strswap(zaznam,"# @id FnoUnAuth ","# @id FnoUnAuth "_t3_$c(31)_"4") . . . . s xz=$p(zaznam,odd,4) . . . . ;s li="xxx*"_zaznam_"*xxx" . . . . s t4=##class(MARC).getSubTagStr(xz,"4") . . . . s zaznam=##class(Util).strswap(zaznam,"# @id FnoUnAuth "_t3_$c(31)_"4"_t4,"# @id FnoUnAuth "_t3) . . . s li="" . . . s t3="" . . . ;use outf w hlavicka use OU . . if ($e(li,1,3)="200") || ($e(li,1,3)="210") || ($e(li,1,3)="215") || ($e(li,1,3)="211") || ($e(li,1,3)="250") || ($e(li,1,3)="290") d ; linky v autoritach fno... . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . s t3z=t3 . . . if ($e(t3,1,3)="FNO") && ($e(li,1,3)="200") s t3="p"_$e(t3,4,9999) . . . if ($e(t3,1,3)="FNO") && ($e(li,1,2)="21") s t3="k"_$e(t3,4,9999) . . . ; u tagu 250 vymaz subtagu 3 . . . s li=##class(Util).strswap(li,$c(31)_"3"_t3z,"") . . . if ($e(li,1,3)="250") s tag250=li . . . if ($e(li,1,3)="200") d . . . . if ($e(li,6,6)'="1") s li="200 1 "_$e(li,8,9999) . . if ($e(li,1,3)="750") || ($e(li,1,3)="450") || ($e(li,1,3)="415") || ($e(li,1,3)="485") d . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . s li=##class(Util).strswap(li,$c(31)_"3"_t3,"") . . if ($e(li,1,3)="TEZ") d . . . s lix="550 " . . . s t3=##class(MARC).getSubTagStr(li,"3") . . . if ($e(t3,1,2)="D0") s t3="fno_un_auth*d0"_$e(t3,3,9999) . . . if t3'="" s lix=lix_$c(31)_"3"_t3 . . . s tz=##class(MARC).getSubTagStr(li,"z") . . . if tz'="" s lix=lix_$c(31)_"5z"_$c(31)_"a"_tz . . . s tg=##class(MARC).getSubTagStr(li,"g") . . . if tg'="" s lix=lix_$c(31)_"5g"_$c(31)_"a"_tg . . . s th=##class(MARC).getSubTagStr(li,"h") . . . if th'="" s lix=lix_$c(31)_"5h"_$c(31)_"a"_th . . . s tp=##class(MARC).getSubTagStr(li,"p") . . . if tp'="" s lix=lix_$c(31)_"5p"_$c(31)_"a"_tp . . . s t3="" . . . s li=lix . . if ($e(li,1,3)="HSL") d ; podhesla . . . if $l(li)<10 s li="" . . . s li=##class(Util).strswap(li,"|",$c(31)_"x") . . . s hesla=$e(li,8,9999) . . . s li="" . . if ($e(li,1,3)="VIZ") d ; do 440 tagu . . . s lix="450"_$e(li,4,7) . . . s tz=##class(MARC).getSubTagStr(li,"z") . . . s tz=##class(Util).strswap(tz,", ",$c(31)_"b") . . . if tz'="" s lix=lix_$c(31)_"a"_tz_$c(31)_"5z" . . . s tk=##class(MARC).getSubTagStr(li,"k") . . . s tk=##class(Util).strswap(tk,", ",$c(31)_"b") . . . if tk'="" s lix=lix_$c(31)_"a"_tk_$c(31)_"5k" . . . s tp=##class(MARC).getSubTagStr(li,"p") . . . if tp'="" s lix=lix_$c(31)_"a"_tp_$c(31)_"5p" . . . s li=lix . . if ($e(li,1,3)="BAS") d . . . s li="" . . if ($e(li,1,3)="LOK") d ; pracovisko ? C06d . . . s tl=##class(MARC).getSubTagStr(li,"l") . . . s c06="" . . . if tl'="" s c06="C06 "_$c(31)_"d"_tl . . . if c06'="" s li=c06 . . if ($e(li,1,3)="MSH") d . . . s ta=##class(MARC).getSubTagStr(li,"a") . . . s td=##class(MARC).getSubTagStr(li,"d") . . . s ti=##class(MARC).getSubTagStr(li,"i") . . . s c27="" . . . if (ta'="") || (td'="") d . . . . s c27="C27 " . . . . if ta'="" s c27=c27_$c(31)_"a"_ta . . . . if td'="" s c27=c27_$c(31)_"b"_td . . . s t300="" . . . if ti'="" s t300="300 1 "_$c(31)_"a"_ti . . . if (c27'="") || (t300'="") d . . . . s li=c27 . . . . if t300'="" d . . . . . if li'="" s li=li_odd_t300 . . . . . if li="" s li=t300 . . . else d . . . . s li="" . . ; osetrenie vsetkych pismenkovych tagov . . s znakk=$e(li,1,1) . . s statn="" . . f i=0:1:9 d . . . if i=znakk s statn="1" . . if (statn'="1") && (znakk'="C") d . . . ; zapisat do specialneho suboru . . . if li'="" use outf2 w odd_li use OU . . . . . . ; na konci pridat len do zaznamu . . if li'="" s zaznam=zaznam_odd_li . . ;if li'="" use outf w odd_li use OU . . s li="" . . s begin="" . q:$zeof'=0 . . ; zpracovat jeden radek . ;s li=$e(li,11,9999) s $e(li,7,8)="" . ;s li=##class(Util).strswap(li," "," ") if li="" q use outf w zaznam use outf w odd_"999 "_$c(31)_"a1"_$c(31)_"bFNO"_$c(31)_"cFNO"_$c(31)_"d"_"arl-"_##class(Util).date()_odd_"###" use OU close inf close outf close outf2 use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 1 %Library.String 1 { use outf w $c(34)_hlavicka_$c(34)_"|",! } ;use outf w """Barcode""|""LocDisloc""|""Signature""|""Title""|",! s idx="",brk=0,ex=0,bc=0,zaciatok="" for { set idx=$o(^Lists($$$ListsActiveSel,$j,idx)), id=idx if $f(id,"*")>0 s id=$p(id,"*",2) ;use outf w !,"hlavicka" q:((id="")||(brk)) ; b if '##class(MARC).getDATAX(.handle,id,"T") { ;w !," zle id="_id s brk=1 } else { ;s ex=ex+1 ;use outf w !,"text" ;w !," dobre id="_id s t100b="",tT03a="",t100s="",t100ld="" s t100b=##class(MARC).getTagX(.handle,"100b") ; ciar. kod s tT03a=$e(##class(MARC).getTagX(.handle,"T03a"),1,30) ; Nazov 35 znakov ; odstranit diakritiku s s1="|"_$c(34) s tT03a=$tr(tT03a,s1) s tT03a=##class(User.Util).diaTRU(tT03a) s t100s=##class(MARC).getTagX(.handle,"100s") ; Signatura s t100ld=##class(MARC).getTagX(.handle,"100l") s t100ld=t100ld_" "_##class(MARC).getTagX(.handle,"100d") ; Lokacia+Dislokacia s t100ld=##class(User.Util).diaTRU(t100ld) s t100s=##class(User.Util).diaTRU(t100s) ;*** s tT02=##class(MARC).getTagX(.handle,"T02",-1) s t969f=##class(MARC).getTagX(.handle,"969f") s test2="" if tT02'="" s test2="1" if t969f'="" s test2="1" if t100b="" s test2="1" ;use outf w "xxx" ; if t100b="" {s bc=bc+1,t100b="xxxxxx"_bc} ; zapise sa len ak je vyplneny ciarovy kod ;if t100b'="" use outf w !,""""_t100b_""""_delim_""""_t100ld_""""_delim_""""_t100s_""""_delim_""""_tT03a_""""_delim if testh>1 { if testh>2 { if test2="" use outf w !,""""_t100b_""""_delim_""""_t100s_""""_delim_""""_t100ld_""""_delim_""""_tT03a_""""_delim } else { if test2="" use outf w !,""""_t100b_""""_delim_""""_t100s_""""_delim } } else { if zaciatok="" { if test2="" use outf w t100b } else { if test2="" use outf w !,t100b } } s zaciatok="1" } } close outf use OU ;w "Chybajuce ciarove kody: "_bc ;w "Exportovanych zaznamov: "_ex ;w "Subor s exportom najdes "_outf q "" ]]> ]]> 1 1 90 d . . s hladaj=$e(hladaj,1,90) ; orezanie na 90 znakov . . s slovo=$l($p(hladaj," ",$l(hladaj," "))) . . s hladaj=$e(hladaj,1,$l(hladaj)-slovo)_".." . . if $d(^ooDataTableI("FnoUnAuth",index,hladaj)) d . . s brk="",idaut="" . . s idaut=$o(^ooDataTableI("FnoUnAuth",index,hladaj,idaut)) . . s t001=##class(MARC).getT001(idaut) . . s prac="",kraj="" . . if ##class(MARC).readLX(.handlea,"fno_un_auth*"_t001) d . . . s prac=##class(MARC).getTagX(.handlea,"C06d") . . . s kraj=##class(MARC).getTagX(.handlea,"C06y") . . if t001'="" d . . . s t001=$c(31)_"3fno_un_auth*"_t001 . . . if prac'="" s t001=t001_$c(31)_"p"_prac . . . if kraj'="" s t001=t001_$c(31)_"y"_kraj . if t3'="" d . . s t001="" . . if ##class(MARC).readLX(.handlea,t3) d . . . s prac=##class(MARC).getTagX(.handlea,"C06d") . . . s kraj=##class(MARC).getTagX(.handlea,"C06y") . . . if prac'="" s t001=t001_$c(31)_"p"_prac . . . if kraj'="" s t001=t001_$c(31)_"y"_kraj . if tagnew'="" s tagnew=tagnew_$c(10)_tagt_t001 . if tagnew="" s tagnew=tagt_t001 if tagnew'="" d ##class(MARC).setTagX(.handle,tagnew) q ]]> ]]> 1 1 ]]> 1 1 ]]> 1 1 ]]> 1 1 ]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd s odd=$c(13)_$c(10) s brk=0,nkrec="",li="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . if (li'="") d . . if $f(li,"r?m?r")>0 d . . . ;s li=##class(Util).strswap(li,kodold,kod) . . . if li'="" use outf w odd_li use OU . . s li="" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> ]]> 1 inf:%String,outf:%String="" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd s odd=$c(13)_$c(10) s brk=0,nkrec="",li="" n cav,cbvk,eu,lix,lt,mkp,nfa,nsptn,pon,ruz,sfu,sldk,sllk,sng,spu,ujep,uhkt,umb,upol,us,vy,xy s cav="",cbvk="",eu="",lix="",lt="",mkp="",nfa="",nsptn="",pon="",ruz="",sfu="",sldk="",sllk="",sng="",spu="",ujep="",uhkt="",umb="",upol="",us="",vy="" s xy="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . if (li'="") d ; ak sa precital riadok . . ; skladanie jedneho noveho riadku . . if nLine=1 use outf w odd_"uloha;pocet;cav;cbvk;eu;li;lt;mkp;nfa;nsptn;pon;ruz;sfu;sldk;sllk;sng;spu;ujep;uhkt;umb;upol;us;vy;xy" . . if $e(li,1,2)="cs" d ; ak je uz riadok na zapis . . . s xxx=cav_";"_cbvk_";"_eu_";"_lix_";"_lt_";"_mkp_";"_nfa_";"_nsptn_";"_pon_";"_ruz_";"_sfu_";"_sldk_";"_sllk_";"_sng_";"_spu_";"_ujep_";"_uhkt_";"_umb_";"_upol_";"_us_";"_vy_";"_xy . . . s li=##class(Util).trim(li) . . . s li=##class(User.Util).strswap(li," ",";") . . . s li=##class(User.Util).strswap(li,$c(9),"") . . . s xxx=##class(User.Util).strswap(xxx,$c(9),"") . . . use outf w odd_li_";"_xxx use OU . . . s cav="",cbvk="",eu="",lix="",lt="",mkp="",nfa="",nsptn="",pon="",ruz="",sfu="",sldk="",sllk="",sng="",spu="",ujep="",uhkt="",umb="",upol="",us="",vy="",xy="" . . else d ; riadok na vyskladanie do test premennej . . . s li=##class(Util).trim(li) . . . s t1=$p(li," ",1) . . . s t1=$zcvt(t1,"l") . . . s t2=$p(li," ",2) . . . s sta="" . . . if t1="cav" s cav=t2,sta=1 . . . if t1="cbvk" s cbvk=t2,sta=1 . . . if t1="eu" s eu=t2,sta=1 . . . if t1="li" s lix=t2,sta=1 . . . if t1="lt" s lt=t2,sta=1 . . . if t1="mkp" s mkp=t2,sta=1 . . . if t1="nfa" s nfa=t2,sta=1 . . . if t1="nsptn" s nsptn=t2,sta=1 . . . if t1="pon" s pon=t2,sta=1 . . . if t1="ruz" s ruz=t2,sta=1 . . . if t1="sfu" s sfu=t2,sta=1 . . . if t1="sldk" s sldk=t2,sta=1 . . . if t1="sllk" s sllk=t2,sta=1 . . . if t1="sng" s sng=t2,sta=1 . . . if t1="spu" s spu=t2,sta=1 . . . if t1="ujep" s ujep=t2,sta=1 . . . if t1="uhkt" s uhkt=t2,sta=1 . . . if t1="umb" s umb=t2,sta=1 . . . if t1="upol" s upol=t2,sta=1 . . . if t1="us" s us=t2,sta=1 . . . if t1="vy" s vy=t2,sta=1 . . . if sta="" s xy=t2 . . s li="" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> 15.12.09 1 1 15.12.09 1 1 18.12.09 1 1 0) { s prva=$p(t100b,"/",1) s druha=$p(t100b,"/",2) s t100bnew="3287"_druha s prva=##class(Util).leadingZero(prva,4) s t100bnew=t100bnew_prva s t100=##class(User.Util).strswap(t100,$c(31)_"b"_t100b,,$c(31)_"b"_t100bnew) d ##class(MARC).setTagX(.handle,t100) } q ]]> ]]> 1 1 ]]> 1 1 Metoda vypisuje cetnost vyskytu tagu a subtagu v aktivnim select listu Parametre a ich popis: jeden parametr s hodnotou "tag" nebo "subtag" tag vypise cetnost tagu subtag vypise cetnost subtagu Metoda pracuje s aktivnym select listom. uplny format prikazu (pozri aj help; help sa vypise prikazom "ltc" bez parametrov): ltc [tag|subtag] -- list number of tags or subtags occurrences for active select 11.02.10 lp; pridane zapocitani Txx tagu podle nadrazeneho parametru "eval_txx" 10.02.10 mj; oprava formatu vystupu a pocetni chyby v listTagCount 08.02.10 mj; zalozeni nove funkce prehlad poctu vyskytov tagov a subtagov ]]> 1 par="" 1 12.02.10 mk; nova konverzia US citatelia z xls riadkoveho formatu, zo suboru do suboru ]]> 1 inf:%String,outf:%String="" 1 error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" s odd=$c(13)_$c(10) s kod=1 s li="",brk="" s x100="",x400="" s zaznam="" s x100ia="",x100ib="",x100aa="",x100ab="",x100v="",x100f="",x100g="",x100e="" for nLine=1:1 q:brk d . use inf read li if $zeof'=0 s brk=1 . ; nacitany 1 riadok . s li=##class(Util).strswap(li,$c(34),"") . ;uprava jedneho riadku . if (li'="") d ; spracovat jeden zaznam . . s zaznam="" . . s x100ia=$p(li,";",2) . . s x100ib=$p(li,";",3) . . s x100aa=$p(li,";",4) . . s x100ab=$p(li,";",5) . . s x100v=$p(li,";",6) . . s x100k=$p(li,";",7) . . s x100f=$p(li,";",8) . . s x100g=$p(li,";",9) . . s x100e=$p(li,";",10) . . ; zapis zaznamu . . s poc=kod . . s dlzka=$l(kod) ; pocet znakov kodu . . s dlzka=7-dlzka . . f i=1:1:dlzka d . . . s poc="0"_poc . . s kod=kod+1 . . s x100="" . . s x400="" . . s x100a="" . . if x100aa'="" s x100a=x100aa . . if x100ab'="" s x100a=x100a_" "_x100ab . . s x100i="" . . if x100ia'="" s x100i=x100ia . . if x100ib'="" s x100i=x100i_" "_x100ib . . if x100a'="" s x100=x100_$c(31)_"a"_x100a . . s x100i=##class(Util).trim(x100i) . . if x100i'="" s x100=x100_$c(31)_"i"_x100i . . if x100v'="" s x100=x100_$c(31)_"v"_x100v . . if x100k'="" s x100=x100_$c(31)_"k"_x100k . . s x100=x100_$c(31)_"tA" . . s x100=x100_$c(31)_"b." . . if x100g'="" d . . . if x100f'="" d . . . . s x100f=x100f_", "_x100g . . . else d . . . . s x100f=x100g . . if x100f'="" s x100=x100_$c(31)_"f"_x100f . . if x100e'="" s x100=x100_$c(31)_"e"_x100e . . s x400=$c(31)_"d"_##class(Util).date()_$c(31)_"c365"_$c(31)_"r1"_$c(31)_"yU1-,U2-P,U-P,R-P"_$c(31)_"z"_##class(Util).date() . . s zaznam=zaznam_odd_"# @id UsIsUser "_"c"_poc . . s zaznam=zaznam_odd_"100 "_x100 . . s zaznam=zaznam_odd_"400 "_x400 . . s zaznam=zaznam_odd_"C99 "_$c(31)_"dDFLT_ISUSER" . . s zaznam=zaznam_odd_"999 "_$c(31)_"a1"_$c(31)_"bUS"_$c(31)_"cUS"_$c(31)_"d"_"arl-"_##class(Util).date() . . s zaznam=zaznam_odd_"###" . . if li'="" use outf w zaznam use OU . . s zaznam="" . . s li="" . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> 08.07.10 lp; Globalka pro naplneni tiskove fronty ^ChangeLog("print-RD") daty z otevrenych trx RD vyselektovanych v ActivListu. Da se pouzit v pripade, ze z nejakeho duvodu selhal tisk listku a fronta byla mezitim vyprazdena. Funkce nema parametry, jako vstup bere vysledek predchoziho selektu, navratova hodnota je bud prazdny string (=OK) nebo chyba Postup: 1. vyselektovat vsechny trx drzenych rezervaci, ktere byly prideleny v danem dni, napr. > d ^X("txx") > d ^X("s CbvkTrx trxto = rd") > d ^X("s && T03o = 20100708") pripadne jeste omezit na konkretni pobocku > d ^X("s && 100c = JVK-RO") 2. spustit metodu trx2printRD() > s ret=##class(UtilConv).trx2printRD() ]]> 1 1 28.07.11 jj zmena zpusobu zpracovani - nebrat za bernou minci uvadenou delku zaznamu, nybrz znaky oddelujici jednotlive zaznamy 19.08.10 mk nova konverzia z UN ISO2709 do riadkoveho formatu zo suboru do suboru pre konverziu EZP SPU ]]> 1 inf:%String,outf:%String="",trieda:%String="SpuUnCat" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,tag,od,kolko,pocet n ciselna,datova,riadok s brk=0,li="",odd=$c(13)_$c(10) n poz,dlzka,j,zac, ttt, t200, tt2, prvy, posledny s poz=0 ; pozicia na ktoru sa ma nastavit s dlzka=0 ;urcenie dlzky kazdeho zaznamu s j = 0, zac=1, ttt=0, t200="", ttt2=0, prvy="",posledny="", posledny2="" n dlzkaOld,zaznam for nLine=1:1 q:brk d . ; nacitam dlzku nasledujuceho zaznamu . ; nacteni puvodni delky zaznamu - dlzkaOld - ponechano pro urceni rozsahu dat, . ; ktere se maji nacist . use inf:poz read dlzkaOld#5 if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . s dlzka=+dlzkaOld+100 . use inf:poz read zaznam#dlzka if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . ; 04.08.11 jj . ; if (poz=0) s brk=1 . s dlzka=$f(zaznam,$c(30)_$c(29))-1 . if (dlzka>0) && (poz'="") d . . ; podla dlzky zaznamu precitat jeden zaznam . . use inf:(poz+24) read li#(dlzka-24) if $zeof'=0 s brk=1 . . s poz = poz + dlzka ; posunutie pocitadla o cely predchadzajuci zaznam . . ; nacitany 1 zaznam . . if (li'="") d ; ak existuje zaznam rozdelime na casti . . . s ttt=0, t200 = "",lic="",t856="",fakulta="",zaznam="",rozpr="" . . . ; na zaciatku zapiseme zaciatok zaznamu . . . s prvy="",posledny="", posledny2="" . . . ;use outf w "# @id "_trieda_" new"_odd_"000 00000nam 22 450"_odd use OU . . . s hla="# @id "_trieda_" new"_odd_"000 00000nam 22 450" use OU . . . s ciselna = $p(li,odTag,1) ; prva ciselna cast . . . s datova = $e(li,$l(ciselna)+1,99999) ; datova cast nasleduje za ciselnou . . . s pocet=$l(ciselna)/12 ; pocet tagov . . . ; riesenie pre tag 856 . . . if $f(datova,"ulicencia1")>0 s lic="1" . . . if $f(datova,"ulicencia2")>0 s lic="2" . . . if $f(datova,"ulicencia3")>0 s lic="3" . . . if $f(datova,"ulicencia4")>0 s lic="4" . . . if $f(datova,"ulicencia5")>0 s lic="5" . . . for j=1:1:pocet d . . . . s rada = $e(ciselna,zac,j*12) . . . . s zac = zac + 12 . . . . s tag=$e(rada,1,3) ; cislo tagu . . . . s kolko=$e(rada,4,7) ; kolko znakov nacitat . . . . s od=$e(rada,8,12) ; od ktoreho znaku citat . . . . ; vyber hodnot z datovej premennej . . . . s riadok=$e(datova,od+2,od+kolko) . . . . s riadok=##class(Util).strswap(riadok,odSubTag,$c(31)) . . . . if tag'="" d . . . . . if tag="001" d . . . . . . s kod = $e(riadok,1,9999) . . . . . . s hla=##class(Util).strswap(hla,"SpuUnCat new","SpuUnCat e"_kod) . . . . . . ;use outf w hla . . . . . . s zaznam=odd_hla . . . . . . s riadok="e"_riadok . . . . . if tag="992" d . . . . . . s tag="970" . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a",$c(31)_"b") . . . . . if tag="856" d . . . . . . s riadok=##class(Util).strswap(riadok,"\","/") . . . . . . ;if lic="1" s riadok=##class(Util).strswap(riadok,$c(31)_"u",$c(31)_"u"_"http://crzp.uniag.sk") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"u",$c(31)_"u"_"http://crzp.uniag.sk") . . . . . . ; odstranit nepotrebne subtagy . . . . . . s ti="" . . . . . . if lic="2" s ti="ix" . . . . . . if lic="3" s ti="ix" . . . . . . if lic="4" s ti="ix" . . . . . . if lic="5" s ti="ix" . . . . . . if (ti'="") && ($l(ti)>1) s riadok=riadok_$c(31)_ti . . . . . if tag="210" d . . . . . . s ta=##class(MARC).getSubTagStr(riadok,"a") . . . . . . s td=##class(MARC).getSubTagStr(riadok,"d") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a"_ta,$c(31)_"a[S.l.") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"d"_td,"") . . . . . . s riadok=riadok_$c(31)_"cs.n.]" . . . . . . s riadok=riadok_$c(31)_"d"_td . . . . . if tag="330" d . . . . . . s ta=##class(MARC).getSubTagStr(riadok,"a") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a"_ta,$c(31)_"aAutorský abstrakt: "_ta) . . . . . if tag="610" d . . . . . . s tag="964" . . . . . . s riadok=$e(riadok,4,9999) . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a",odd_"964 "_$c(31)_"a") . . . . . . s riadok=" "_$c(31)_riadok . . . . . if tag="RID" d . . . . . . s tag="C99" . . . . . . s riadok=riadok_$c(31)_"dDFLT_UN_CAT8" . . . . . if tag="EZP" d ; neprenasat . . . . . . s ts=##class(MARC).getSubTagStr(riadok,"s") . . . . . . if $e(ts,1,11)="rozpracovan" s rozpr="1" . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="974" d ; neprenasat cislo studenta . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="004" d ; neprenasat . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="CHK" d ; neprenasat protokol . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="985" d . . . . . . s fakulta=##class(MARC).getSubTagStr(riadok,"f") ; cislo kfakulty / k - kod katedry . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="LIC" d ; neprenasat . . . . . . s datum=##class(MARC).getSubTagStr(riadok,"d") . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="200" d . . . . . . s riadok="1 "_$e(riadok,3,9999) . . . . . if tag="101" d . . . . . . s riadok="0 "_$e(riadok,3,9999) . . . . . if tag="541" d . . . . . . s riadok="1 "_$e(riadok,3,9999) . . . . . if $e(tag,1,2)="70" d . . . . . . s t3=##class(MARC).getSubTagStr(riadok,"3") . . . . . . s tx=##class(MARC).getSubTagStr(riadok,"x") . . . . . . ;use outf w "*"_riadok_"*" use OU . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"3"_t3,"") . . . . . . ;if tx'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"x") . . . . . . s riadok=" 1"_$e(riadok,3,9999) . . . . . if (tag="910") && ($l(riadok)=4) s tag = "" . . . . . if tag'="" d . . . . . . if $e(tag,1,2)="00" d . . . . . . . ;use outf w tag_" "_riadok_odd use OU . . . . . . . s zaznam=zaznam_odd_tag_" "_riadok . . . . . . if $e(tag,1,2)'="00" d . . . . . . . if tag="856" d . . . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . . . s riadok=tag_" "_riadok . . . . . . . . ; osetrit odstranenie niektorych subtagov . . . . . . . . ;s tr=##class(MARC).getSubTagStr(riadok,"r") . . . . . . . . ;if tr'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"r") . . . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"r",$c(31)_"z") . . . . . . . . s td=##class(MARC).getSubTagStr(riadok,"d") . . . . . . . . if td'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"d") . . . . . . . . s tv=##class(MARC).getSubTagStr(riadok,"v") . . . . . . . . if tv'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"v") . . . . . . . . ; riesenie ziskania len posledneho opakovania subtagu u . . . . . . . . s tu=##class(MARC).getSubTagStr(riadok,"u",-1) . . . . . . . . s tz=##class(MARC).getSubTagStr(riadok,"z",-1) . . . . . . . . s ti=##class(MARC).getSubTagStr(riadok,"i") . . . . . . . . s pocetu=$l(tu,$c(10)) . . . . . . . . s pocetz=$l(tz,$c(10)) . . . . . . . . if pocetu>1 d . . . . . . . . . s riadok="856 "_$c(31)_"u"_$p(tu,$c(10),pocetu) . . . . . . . . . if tz'="" s riadok=riadok_$c(31)_"z"_$p(tz,$c(10),pocetz) . . . . . . . . . if ti'="" s riadok=riadok_$c(31)_"i"_ti . . . . . . . . . ;;; . . . . . . . . s t856=t856_odd_riadok . . . . . . . . ;use outf w zapis use OU . . . . . . . else d . . . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . . . ;s zapis=tag_" "_riadok_odd . . . . . . . . s zapis=tag_" "_riadok . . . . . . . . if $e(tag,1,2)="70" d . . . . . . . . . s tx=##class(MARC).getSubTagStr(zapis,"x") . . . . . . . . . if tx'="" s zapis=##class(MARC).setSubTagStr(zapis,$c(31)_"x") . . . . . . . . ;use outf w zapis use OU . . . . . . . . s zaznam=zaznam_odd_zapis . . . . s odd=$c(13)_$c(10) . . . ; 2011 - prebiraji se vsechny fakulty . . . ; na konci zapiseme ukoncenie zaznamu . . . ; if ((fakulta="104000") || (fakulta="105000")) && (rozpr="") d . . . if (rozpr="") d . . . . use outf w zaznam use OU . . . . if t856'="" d . . . . . s ti="" . . . . . if lic="2" s ti="i"_datum . . . . . if lic="3" s ti="iO"_datum . . . . . if lic="4" s ti="iO" . . . . . if lic="5" s ti="iN" . . . . . s t856=##class(Util).strswap(t856,$c(31)_"ix",$c(31)_ti) . . . . . use outf w t856 use OU . . . . use outf w odd_"969 "_$c(31)_"fD" . . . . use outf w odd_"###" use OU . . s li="",zac=1 . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> 19.08.10 mk nova konverzia z UN ISO2709 do riadkoveho formatu zo suboru do suboru pre konverziu EZP SPU ]]> 1 inf:%String,outf:%String="",trieda:%String="SpuUnCat" error d $ZU(68,40,1) ; otevrit vystupni soubor open outf:("NWS":/CREATE):0 s te=$test if 'te q "failed to open the output file ('"_outf_"')!!" n li,nLine,brk,odd,begin,hlavicka,tag,od,kolko,pocet n ciselna,datova,riadok s brk=0,li="",odd=$c(13)_$c(10) n poz,dlzka,j,zac, ttt, t200, tt2, prvy, posledny s poz=0 ; pozicia na ktoru sa ma nastavit s dlzka=0 ;urcenie dlzky kazdeho zaznamu s j = 0, zac=1, ttt=0, t200="", ttt2=0, prvy="",posledny="", posledny2="" for nLine=1:1 q:brk d . ; nacitam dlzku nasledujuceho zaznamu . use inf:poz read dlzka#5 if $zeof'=0 s brk=1 ; precitat dlzku zaznamu . if (dlzka'="") && (poz'="") d . . ; podla dlzky zaznamu precitat jeden zaznam . . use inf:(poz+24) read li#(dlzka-24) if $zeof'=0 s brk=1 . . s poz = poz + dlzka ; posunutie pocitadla o cely predchadzajuci zaznam . . ; nacitany 1 zaznam . . if (li'="") d ; ak existuje zaznam rozdelime na casti . . . s ttt=0, t200 = "",lic="",t856="",fakulta="",zaznam="",rozpr="" . . . ; na zaciatku zapiseme zaciatok zaznamu . . . s prvy="",posledny="", posledny2="" . . . ;use outf w "# @id "_trieda_" new"_odd_"000 00000nam 22 450"_odd use OU . . . s hla="# @id "_trieda_" new"_odd_"000 00000nam 22 450" use OU . . . s ciselna = $p(li,odTag,1) ; prva ciselna cast . . . s datova = $e(li,$l(ciselna)+1,99999) ; datova cast nasleduje za ciselnou . . . s pocet=$l(ciselna)/12 ; pocet tagov . . . ; riesenie pre tag 856 . . . if $f(datova,"ulicencia1")>0 s lic="1" . . . if $f(datova,"ulicencia2")>0 s lic="2" . . . if $f(datova,"ulicencia3")>0 s lic="3" . . . if $f(datova,"ulicencia4")>0 s lic="4" . . . if $f(datova,"ulicencia5")>0 s lic="5" . . . for j=1:1:pocet d . . . . s rada = $e(ciselna,zac,j*12) . . . . s zac = zac + 12 . . . . s tag=$e(rada,1,3) ; cislo tagu . . . . s kolko=$e(rada,4,7) ; kolko znakov nacitat . . . . s od=$e(rada,8,12) ; od ktoreho znaku citat . . . . ; vyber hodnot z datovej premennej . . . . s riadok=$e(datova,od+2,od+kolko) . . . . s riadok=##class(Util).strswap(riadok,odSubTag,$c(31)) . . . . if tag'="" d . . . . . if tag="001" d . . . . . . s kod = $e(riadok,1,9999) . . . . . . s hla=##class(Util).strswap(hla,"SpuUnCat new","SpuUnCat e"_kod) . . . . . . ;use outf w hla . . . . . . s zaznam=odd_hla . . . . . . s riadok="e"_riadok . . . . . if tag="992" d . . . . . . s tag="970" . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a",$c(31)_"b") . . . . . if tag="856" d . . . . . . s riadok=##class(Util).strswap(riadok,"\","/") . . . . . . ;if lic="1" s riadok=##class(Util).strswap(riadok,$c(31)_"u",$c(31)_"u"_"http://crzp.uniag.sk") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"u",$c(31)_"u"_"http://crzp.uniag.sk") . . . . . . ; odstranit nepotrebne subtagy . . . . . . s ti="" . . . . . . if lic="2" s ti="ix" . . . . . . if lic="3" s ti="ix" . . . . . . if lic="4" s ti="ix" . . . . . . if lic="5" s ti="ix" . . . . . . if (ti'="") && ($l(ti)>1) s riadok=riadok_$c(31)_ti . . . . . if tag="210" d . . . . . . s ta=##class(MARC).getSubTagStr(riadok,"a") . . . . . . s td=##class(MARC).getSubTagStr(riadok,"d") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a"_ta,$c(31)_"a[S.l.") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"d"_td,"") . . . . . . s riadok=riadok_$c(31)_"cs.n.]" . . . . . . s riadok=riadok_$c(31)_"d"_td . . . . . if tag="330" d . . . . . . s ta=##class(MARC).getSubTagStr(riadok,"a") . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a"_ta,$c(31)_"aAutorský abstrakt: "_ta) . . . . . if tag="610" d . . . . . . s tag="964" . . . . . . s riadok=$e(riadok,4,9999) . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"a",odd_"964 "_$c(31)_"a") . . . . . . s riadok=" "_$c(31)_riadok . . . . . if tag="RID" d . . . . . . s tag="C99" . . . . . . s riadok=riadok_$c(31)_"dDFLT_UN_CAT8" . . . . . if tag="EZP" d ; neprenasat . . . . . . s ts=##class(MARC).getSubTagStr(riadok,"s") . . . . . . if $e(ts,1,11)="rozpracovan" s rozpr="1" . . . . . . ;s tag="" . . . . . . ;s riadok="" . . . . . if tag="974" d ; neprenasat cislo studenta . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="004" d ; neprenasat . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="CHK" d ; neprenasat protokol . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="985" d . . . . . . s fakulta=##class(MARC).getSubTagStr(riadok,"f") ; cislo kfakulty / k - kod katedry . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="LIC" d ; neprenasat . . . . . . s datum=##class(MARC).getSubTagStr(riadok,"d") . . . . . . s tag="" . . . . . . s riadok="" . . . . . if tag="200" d . . . . . . s riadok="1 "_$e(riadok,3,9999) . . . . . if tag="101" d . . . . . . s riadok="0 "_$e(riadok,3,9999) . . . . . if tag="541" d . . . . . . s riadok="1 "_$e(riadok,3,9999) . . . . . if $e(tag,1,2)="70" d . . . . . . s t3=##class(MARC).getSubTagStr(riadok,"3") . . . . . . s tx=##class(MARC).getSubTagStr(riadok,"x") . . . . . . ;use outf w "*"_riadok_"*" use OU . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"3"_t3,"") . . . . . . ;if tx'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"x") . . . . . . s riadok=" 1"_$e(riadok,3,9999) . . . . . if (tag="910") && ($l(riadok)=4) s tag = "" . . . . . if tag'="" d . . . . . . if $e(tag,1,2)="00" d . . . . . . . ;use outf w tag_" "_riadok_odd use OU . . . . . . . s zaznam=zaznam_odd_tag_" "_riadok . . . . . . if $e(tag,1,2)'="00" d . . . . . . . if tag="856" d . . . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . . . s riadok=tag_" "_riadok . . . . . . . . ; osetrit odstranenie niektorych subtagov . . . . . . . . ;s tr=##class(MARC).getSubTagStr(riadok,"r") . . . . . . . . ;if tr'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"r") . . . . . . . . s riadok=##class(Util).strswap(riadok,$c(31)_"r",$c(31)_"z") . . . . . . . . s td=##class(MARC).getSubTagStr(riadok,"d") . . . . . . . . if td'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"d") . . . . . . . . s tv=##class(MARC).getSubTagStr(riadok,"v") . . . . . . . . if tv'="" s riadok=##class(MARC).setSubTagStr(riadok,$c(31)_"v") . . . . . . . . ; riesenie ziskania len posledneho opakovania subtagu u . . . . . . . . s tu=##class(MARC).getSubTagStr(riadok,"u",-1) . . . . . . . . s tz=##class(MARC).getSubTagStr(riadok,"z",-1) . . . . . . . . s ti=##class(MARC).getSubTagStr(riadok,"i") . . . . . . . . s pocetu=$l(tu,$c(10)) . . . . . . . . s pocetz=$l(tz,$c(10)) . . . . . . . . if pocetu>1 d . . . . . . . . . s riadok="856 "_$c(31)_"u"_$p(tu,$c(10),pocetu) . . . . . . . . . if tz'="" s riadok=riadok_$c(31)_"z"_$p(tz,$c(10),pocetz) . . . . . . . . . if ti'="" s riadok=riadok_$c(31)_"i"_ti . . . . . . . . . ;;; . . . . . . . . s t856=t856_odd_riadok . . . . . . . . ;use outf w zapis use OU . . . . . . . else d . . . . . . . . s riadok=$e(riadok,1,2)_" "_$e(riadok,3,9999) . . . . . . . . ;s zapis=tag_" "_riadok_odd . . . . . . . . s zapis=tag_" "_riadok . . . . . . . . if $e(tag,1,2)="70" d . . . . . . . . . s tx=##class(MARC).getSubTagStr(zapis,"x") . . . . . . . . . if tx'="" s zapis=##class(MARC).setSubTagStr(zapis,$c(31)_"x") . . . . . . . . ;use outf w zapis use OU . . . . . . . . s zaznam=zaznam_odd_zapis . . . . s odd=$c(13)_$c(10) . . . ; na konci zapiseme ukoncenie zaznamu . . . if ((fakulta="104000") || (fakulta="105000")) && (rozpr="") d . . . . use outf w zaznam use OU . . . . if t856'="" d . . . . . s ti="" . . . . . if lic="2" s ti="i"_datum . . . . . if lic="3" s ti="iO"_datum . . . . . if lic="4" s ti="iO" . . . . . if lic="5" s ti="iN" . . . . . s t856=##class(Util).strswap(t856,$c(31)_"ix",$c(31)_ti) . . . . . use outf w t856 use OU . . . . use outf w odd_"969 "_$c(31)_"fD" . . . . use outf w odd_"###" use OU . . s li="",zac=1 . q:$zeof'=0 close inf close outf use OU ; enable error d $ZU(68,40,0) q "" ]]> 21.09.12 mk; globalka na spracovanie suboru csv do suboru csv s tym ze podla autortneho zaznamu z NK geograficke heslo zisti ID NK zaznamu a toto prida do suboru k lokalnemu heslo. 1 inf:%String,outf:%String="" 1 0 s heslo=$p(heslo,"@",2) . . . . s doplnok="",doplnok2="" . . . . s heslo=$p(heslo,"(",1) . . . . s prva=$p(heslo,",",1) ; prva cast terminu . . . . s druha=$p(heslo,",",2) . . . . s tretia=$p(heslo,",",3) . . . . s prva=##class(Util).trim(prva) . . . . s druha=##class(Util).trim(druha) . . . . s tretia=##class(Util).trim(tretia) . . . . if $e(druha,1,3)="ob." s doplnok=$e(druha,4,9999) . . . . if $e(druha,1,4)="obec" s doplnok=$e(druha,5,9999) . . . . if $e(druha,1,4)="okr." s doplnok=$e(druha,5,9999) . . . . if $e(druha,1,2)="o." s doplnok=$e(druha,3,9999) . . . . s doplnok=##class(Util).trim(doplnok) . . . . if $l(doplnok)<3 s doplnok="" . . . . if doplnok'="" s doplnok=prva_" "_doplnok . . . . if $e(druha,1,2)="o." && doplnok="" s doplnok=prva_" okres" . . . . ;;;;; . . . . if $e(tretia,1,3)="ob." s doplnok2=$e(tretia,4,9999) . . . . if $e(tretia,1,4)="obec" s doplnok2=$e(tretia,5,9999) . . . . if $e(tretia,1,4)="okr." s doplnok2=$e(tretia,5,9999) . . . . if $e(tretia,1,2)="o." s doplnok2=$e(tretia,3,9999) . . . . s doplnok=##class(Util).trim(doplnok) . . . . s doplnok2=##class(Util).trim(doplnok2) . . . . if $l(doplnok2)<3 s doplnok2="" . . . . if doplnok2'="" s doplnok2=prva_" "_doplnok2 . . . . if ($e(tretia,1,2)="o.") && (doplnok2="") s doplnok2=prva_" okres" . . . . s druha=##class(Util).trim(druha) . . . . s tretia=##class(Util).trim(tretia) . . . . ;;;;;;; . . . . s tag001NK="",ret="",retnew="",najdene="",tag151aNK="" . . . . ; samotne hladanie v prvej faze 3 varianty hladania . . . . if doplnok'="" d . . . . . s atr4=" @attr 4=1" . . . . . if ($f(doplnok,"okres")>0) || ($f(doplnok,"kraj")>0) s atr4="" . . . . . s heslo="@attr 1=58"_atr4_" '"_doplnok_"'" . . . . . s sc=##class(i2.ws).getHandleI2e(.handlenk,i2eDb,"",heslo,ictx,1,"151a",.ret) . . . . . ;if ret="" s tag001NK=##class(MARC).getTagX(.handlenk,"001") . . . . . ;if ret="" s tag151aNK = ##class(MARC).getTagX(.handlenk,"151a") . . . . . ; spracovanie celeho ret oddelovac jednotlivych zaznamov ? . . . . . s retnew="",najdene="" . . . . . s pocetr=$l(ret,$c(10)) ; pocet najdenych zaznamov . . . . . f k=1:1:pocetr d . . . . . . s ret1=$p(ret,$c(10),k) ; jeden vyskyt . . . . . . s ret12=$p(ret1,$c(31),2) ; kod NK . . . . . . s ret12=##class(Util).trim(ret12) . . . . . . s ret14=$p(ret1,$c(31),4) ; heslo NK . . . . . . ; porovnanie . . . . . . s h1=$zcvt($tr($p(ret14," ",1),s1),"l") . . . . . . s h2=$tr($p(doplnok," ",1),s1) . . . . . . s h1=$tr(h1,s1) . . . . . . s h2=$tr(h2,s1) . . . . . . if (h2=h1) && (najdene="") s tag001NK=ret12,tag151aNK=ret14,najdene=1 . . . . . . if ret14'="" s retnew=retnew_"#"_ret12_":"_ret14 . . . . . s ret=retnew . . . . ; ak sa nic nenaslo v druhej variante vola sa tretia . . . . s retnew="" . . . . if (doplnok2'="") && (tag001NK="") d . . . . . s atr4=" @attr 4=1" . . . . . if ($f(doplnok2,"okres")>0) || ($f(doplnok2,"kraj")>0) s atr4="" . . . . . s heslo="@attr 1=58"_atr4_" '"_doplnok2_"'" . . . . . s sc=##class(i2.ws).getHandleI2e(.handlenk,i2eDb,"",heslo,ictx,1,"151a",.ret) . . . . . ;if ret="" s tag001NK=##class(MARC).getTagX(.handlenk,"001") . . . . . ;if ret="" s tag151aNK = ##class(MARC).getTagX(.handlenk,"151a") . . . . . s retnew="",najdene="" . . . . . s pocetr=$l(ret,$c(10)) ; pocet najdenych zaznamov . . . . . f k=1:1:pocetr d . . . . . . s ret1=$p(ret,$c(10),k) ; jeden vyskyt . . . . . . s ret12=$p(ret1,$c(31),2) ; kod NK . . . . . . s ret12=##class(Util).trim(ret12) . . . . . . s ret14=$p(ret1,$c(31),4) ; heslo NK . . . . . . ; porovnanie . . . . . . s h1=$zcvt($tr($p(ret14," ",1),s1),"l") . . . . . . s h2=$tr($p(doplnok2," ",1),s1) . . . . . . s h1=$tr(h1,s1) . . . . . . s h2=$tr(h2,s1) . . . . . . if (h2=h1) && (najdene="") s tag001NK=ret12,tag151aNK=ret14,najdene=1 . . . . . . if ret14'="" s retnew=retnew_"#"_ret12_":"_ret14 . . . . . s ret=retnew . . . . ; ak sa nenajde ani v jednej z variant zavolame . . . . if (prva'="") && (tag001NK="") d . . . . . s atr4=" @attr 4=1" . . . . . s heslo="@attr 1=58"_atr4_" '"_prva_"'" . . . . . s sc=##class(i2.ws).getHandleI2e(.handlenk,i2eDb,"",heslo,ictx,1,"151a",.ret) . . . . . ;if ret="" s tag001NK = ##class(MARC).getTagX(.handlenk,"001") . . . . . ;if ret="" s tag151aNK = ##class(MARC).getTagX(.handlenk,"151a") . . . . . s retnew="",najdene="" . . . . . s pocetr=$l(ret,$c(10)) ; pocet najdenych zaznamov . . . . . f k=1:1:pocetr d . . . . . . s ret1=$p(ret,$c(10),k) ; jeden vyskyt . . . . . . s ret12=$p(ret1,$c(31),2) ; kod NK . . . . . . s ret12=##class(Util).trim(ret12) . . . . . . s ret14=$p(ret1,$c(31),4) ; heslo NK . . . . . . ; porovnanie . . . . . . s h1=$zcvt($tr($p(ret14," ",1),s1),"l") . . . . . . s h2=$tr($p(prva," ",1),s1) . . . . . . s h1=$tr(h1,s1) . . . . . . s h2=$tr(h2,s1) . . . . . . if (h2=h1) && (najdene="") s tag001NK=ret12,tag151aNK=ret14,najdene=1 . . . . . . if ret14'="" s retnew=retnew_"#"_ret12_":"_ret14 . . . . . s ret=retnew . . . . ; po vyhladani spracovanie . . . . s tag001NK=##class(Util).trim(tag001NK) . . . . s riadok=";"_$c(34)_tag001NK_$c(34)_";"_$c(34)_tag151aNK_$c(34)_";"_$c(34)_"*"_doplnok_"*"_doplnok2_"*"_prva_"*"_$c(34)_";"_$c(34)_"#"_ret_"#"_$c(34)_";"_$c(34)_heslo_$c(34) . . . if (typ="4") || (typ="5") d ; korporacie . . . . s tag11xaNK="",ret="",tag001NK="" . . . . s prva=$p(heslo,",",1) ; po ciarku je hlavny termin . . . . s prva=$p(prva,"(",1) . . . . s prva=##class(Util).trim(prva) . . . . s prva=$zcvt(prva,"l") . . . . s heslo="@attr 1=2 @attr 4=1 '"_prva_"'" . . . . s sc=##class(i2.ws).getHandleI2e(.handlenk,i2eDb,"",heslo,ictx,1,"11*a",.ret) . . . . s tag001NK = ##class(MARC).getTagX(.handlenk,"001") . . . . ;; po vyhladani spracovanie . . . . if tag001NK'="" d . . . . . s tag11xaNK = ##class(MARC).getTagX(.handlenk,"11*a") . . . . ;;; . . . . s h1=$zcvt($tr($p(tag11xaNK," ",1),s1),"l") . . . . s h2=$tr($p(prva," ",1),s1) . . . . if (h2'=h1) s tag11xaNK="",tag001NK="" . . . . ;;;;; . . . . s retnew="",najdene="" . . . . ; . . . . s pocetr=$l(ret,$c(10)) ; pocet najdenych zaznamov . . . . f k=1:1:pocetr d . . . . . s ret1=$p(ret,$c(10),k) ; jeden vyskyt . . . . . s ret12=$p(ret1,$c(31),2) ; kod NK . . . . . s ret12=##class(Util).trim(ret12) . . . . . s ret14=$p(ret1,$c(31),4) ; heslo NK . . . . . s h1=$zcvt($tr($p(ret14," ",1),s1),"l") . . . . . s h2=$tr($p(prva," ",1),s1) . . . . . if (h2=h1) && (najdene="") s tag001NK=ret12,tag11xaNK=ret14,najdene="1" . . . . . if ret14'="" s retnew=retnew_"#"_ret12_":"_ret14 . . . . . s retnew=retnew_"#"_ret12_":"_ret14 . . . . s ret=retnew . . . . s tag001NK=##class(Util).trim(tag001NK) . . . . s riadok=";"_$c(34)_tag001NK_$c(34)_";"_$c(34)_tag11xaNK_$c(34)_";"_$c(34)_"*"_prva_"*"_$c(34)_";"_$c(34)_ret_$c(34)_";"_$c(34)_heslo_$c(34) . . ; koniec podmienok . . if riadok'="" use outf w riadok use OU . q:$zeof'=0 close inf close outf use OU d $ZU(68,40,0) q "" ]]>