diff options
Diffstat (limited to 'app/schulis/2.2.1/src/1.stat intern')
| -rw-r--r-- | app/schulis/2.2.1/src/1.stat intern | 337 |
1 files changed, 337 insertions, 0 deletions
diff --git a/app/schulis/2.2.1/src/1.stat intern b/app/schulis/2.2.1/src/1.stat intern new file mode 100644 index 0000000..a94ef21 --- /dev/null +++ b/app/schulis/2.2.1/src/1.stat intern @@ -0,0 +1,337 @@ +PACKET statinternDEFINES statinternstart,statistiklistezeigen, +erstellestatistik,zeigefertigestatistik,statblaettern:LET matrix= +"ms stat matrix",obli="mu objektliste",ueberschriftenfeld=2,fortsetzungsfeld= +3,spaltentitel=4,wertebereichanfang=5,spaltenzahl=6,zeilenzahl=11, +zeilenlaenge=8,maxfeld=100,laengezaehlfeld=5,laengewertefeld=8;LET mv=100,nv= +20;ROW nvTEXT VAR spaltenwert;INT VAR maxspaltenwert;ROW mvTEXT VAR +zeilenwert;INT VAR maxzeilenwert;INT VAR zeileleer;LET anhangzeilen=2;LET +maxbestaende=8,maxauswertungen=17;LET titelergaenz1="alle Klassen ", +titelergaenz2="alle Tutorenkurse ";ROW maxbestaendeTEXT CONST bestandtitel1:= +ROW maxbestaendeTEXT :("der Jahrgangsstufe ","Jahrgangsstufen der Sek. 1", +"Jahrgangsstufen der Sek. 2","alle Jahrgangsstufen", +"Neuangemeldete zur Jgst. 5","Neuangemeldete zur Jgst. 11", +"Neuangemeldete zu einer anderen Jgst.","Abgegangene aller Jahrgangsstufen"); +LET allejgstsek1=2,allejgstsek2=3,allejgst=4,neuan5=5,neuan11=6,neuansonst=7, +abgegangene=8;ROW maxauswertungenTEXT CONST bestandtitel2:=ROW +maxauswertungenTEXT :("Geschlecht","Alter","Schultyp der Herkunftsschule", +"Art des Zugangs zur Jgst.","Versetzungsergebnis", +"Teilnahme Religionsunterricht","Sprachenfolge","Kunst/Musik", +"Ortsteil des Wohnortes","Staatsangehörigkeit","Muttersprache", +"Einschulungsjahr Grundschule","Herkunftsschule","Religionszugehörigkeit", +"Spätaussiedler","Abgangsgrund","Abschluß");LET geschlecht=1,alter=2,schultyp +=3,zugang=4,versetzung=5,teilnahmereli=6,fremdsprachen=7,kunst=8,ort=9,staat= +10,sprache=11,einschulung=12,herkunft=13,religion=14,aussiedler=15,abgang=16, +abschluss=17;LET fortsetzungstitel=" Forts.",leertitel="leer", +leertitelplatzhalter="�",sonsttitel="sonst",summentitel="Summe";LET +neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso",archivbestand="abg", +gesamtbestand="ls";LET bestort="c02 ortsteil",beststaat="c02 staaten", +bestsprache="c02 sprachen",bestreligion="c02 relizugehoerigkeit",bestabgang= +"c02 abgang",bestabschluss="c02 abschluss",bestschulart="c02 schulart", +bestversetzung="c02 versetzung",bestzugang="c02 zugang",bestherkunft= +"Schulen";LET null="0",niltext="",blank=" ";LET allesek1= +" 05 06 07 08 09 10",allesek2=" 11 12 13";LET einenbestand= +2,einejgst=1,alleinsek1=4,alleinsek2=5;LET sjahr="Schuljahr",shj= +"Schulhalbjahr",trenner1=".",trenner2="/",trennpos1=2,trennpos2=3,stattext1= +"alle",stattext2="Werte",maxsek1=10,titeltrenner=", ",links=4,rechts=3,oben=2 +,unten=1,minjgst=5,maxjgst=13,abgkz="abg. ",maxkreuzzahl=1,basisohnebestand=1 +,laengespaltentitel=30,standardanfang=2;LET weiblich="w",maennlich="m",ja="j" +,nein="n";LET unzulaessigewahlnr=56,wartennr=69,fertignr=77,meldzuvielewerte= +87,nproc=1,standardabstand=2;LET maxoblizeile=18,listenauskunft=2018;LET +beginntag=1,endetag=2,beginnmonat=4,endemonat=5,beginnjahr=7;BOOL VAR +rechtsverschiebbar,variablezaehlung,neueintragnoetig,#20.01.88dr# +vergleichsstart,sprungvonunten,fehlerzuvielewerte;INT VAR xaktuell,yaktuell, +aktuellerbestand,statbestandnr,statjgst,statauswertungsnr,statbasisnr, +jahrdestagesdatums,monatdestagesdatums,tagdestagesdatums,waspruefen,#06.07.87 +dr#dateinummer,#01.02.88dr#schluesseldateinr,vglfeld,gewindex;#05.08.87dr# +TEXT VAR kuerzelbestand,gewbestand,#06.08.87dr#bestaendezeile,vergleichsjgst, +statgrundmaske,aktschuljahr,akthalbjahr,titelzeile;PROC statinternstart: +standardvproc(maske(vergleichsknoten));sprungvonunten:=FALSE END PROC +statinternstart;PROC statistiklistezeigen:IF eingangsbildschirmkorrektTHEN +standardstartproc(obli);auskunftstextergaenzen;fuellestatistikliste; +standardnprocELSE fehlerbehandlungFI .auskunftstextergaenzen:titelzeile:= +niltext;IF statbestandnr=einejgstTHEN titelzeile1ELSE einfachetitelzeileFI ; +ergaenzeauskunft(titelzeile+auskunftstextende,listenauskunft).titelzeile1:IF +insek1THEN titelzeileCAT titelergaenz1ELSE titelzeileCAT titelergaenz2FI ; +titelzeileCAT bestandtitel1(statbestandnr);titelzeileCAT aufberzweistellig( +text(statjgst)).insek1:statjgst<=maxsek1.einfachetitelzeile:titelzeileCAT +bestandtitel1(statbestandnr).fuellestatistikliste:INT VAR feldnr:= +standardabstand+1;FOR iFROM 1UPTO maxauswertungenREP standardmaskenfeld( +bestandtitel2(i),feldnr);feldnrINCR standardabstandPER ;feldnrDECR 1;FOR i +FROM maxauswertungen+1UPTO maxoblizeileREP feldschutz(feldnr);feldnrINCR +standardabstandPER .eingangsbildschirmkorrekt:IF sprungvonuntenTHEN TRUE +ELSE INT VAR i,kreuzzahl:=0;TEXT VAR ankreuzfeld;statbestandnr:= +standardanfang;FOR iFROM standardanfangUPTO maxbestaende+1REP ankreuzfeld:= +standardmaskenfeld(i);IF ankreuzfeld<>niltextTHEN IF (i=standardanfang)THEN +statjgst:=int(ankreuzfeld);IF (NOT lastconversionok)COR statjgstungueltig +THEN LEAVE eingangsbildschirmkorrektWITH FALSE FI FI ;kreuzzahlINCR 1; +statbestandnr:=iFI PER ;statbestandnrDECR 1;(kreuzzahl<=maxkreuzzahl)CAND ( +kreuzzahl>0)FI .statjgstungueltig:(statjgst<minjgst)COR (statjgst>maxjgst). +fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext);infeld( +statbestandnr+1);return(nproc).END PROC statistiklistezeigen;PROC +erstellestatistik:reinitparsing;IF listenwahlkorrektTHEN startestatistik( +statbestandnr,statjgst,statauswertungsnr);initialisiereblaettern; +zeigefertigestatistikELSE fehlerbehandlungFI .listenwahlkorrekt:INT VAR i, +kreuzzahl:=0;TEXT VAR ankreuzfeld;statauswertungsnr:=standardanfang;INT VAR +feldnr:=standardabstand;FOR iFROM 1UPTO maxauswertungenREP ankreuzfeld:= +standardmaskenfeld(feldnr);IF ankreuzfeld<>niltextTHEN kreuzzahlINCR 1; +statauswertungsnr:=iFI ;feldnrINCR standardabstandPER ;(kreuzzahl<= +maxkreuzzahl)CAND (kreuzzahl>0).initialisiereblaettern:sprungvonunten:=TRUE ; +IF NOT fehlerzuvielewerteTHEN standardmeldung(fertignr,niltext)FI ;xaktuell:= +1;yaktuell:=1.fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext); +infeld(statauswertungsnr*standardabstand);return(nproc).END PROC +erstellestatistik;PROC zeigefertigestatistik:infeld(fortsetzungsfeld); +standardnprocEND PROC zeigefertigestatistik;PROC startestatistik(INT CONST +bestandnr,jgst,auswertungsnr):initialisiere;maskeausgeben;titelausgeben; +indexbestimmen;bestaendeausgeben;werteverarbeitung(auswertungsnr). +initialisiere:fehlerzuvielewerte:=FALSE ;statbasisnr:=basisohnebestand; +statgrundmaske:=niltext.maskeausgeben:standardstartproc(matrix); +standardmeldung(wartennr,niltext).titelausgeben:titelzeileCAT titeltrenner; +IF auswertungsnr=versetzungTHEN versetzungsergaenzungFI ;titelzeilenrest; +titelzeileausgeben.versetzungsergaenzung:liesschuljahr;lieshalbjahr; +titelzeilenzusatz.liesschuljahr:aktschuljahr:=schulkenndatum(sjahr). +lieshalbjahr:akthalbjahr:=schulkenndatum(shj).titelzeilenzusatz:titelzeile +CAT (subtext(aktschuljahr,1,trennpos1));titelzeileCAT trenner2;titelzeileCAT +(subtext(aktschuljahr,trennpos2));titelzeileCAT trenner1;titelzeileCAT +akthalbjahr;titelzeileCAT titeltrenner.titelzeilenrest:titelzeileCAT +bestandtitel2(auswertungsnr);.titelzeileausgeben:titelzeileIN +ueberschriftenfeld.indexbestimmen:SELECT bestandnrOF CASE allejgst,neuan5, +neuan11,neuansonst,abgegangene:gewindex:=ixsustatfamrufgebCASE allejgstsek1, +allejgstsek2,einejgst:gewindex:=ixsustatjgstEND SELECT ;indexvorbelegen. +indexvorbelegen:inittupel(dnrschueler);waspruefen:=einenbestand;gewbestand:= +gesamtbestand;SELECT bestandnrOF CASE einejgst:putwert(fnrsustatuss, +gesamtbestand);putwert(fnrsusgrpjgst,jgstkonv(jgst));waspruefen:=einejgst; +CASE allejgstsek1:putwert(fnrsustatuss,gesamtbestand);putwert(fnrsusgrpjgst, +"05");waspruefen:=alleinsek1;CASE allejgstsek2:putwert(fnrsustatuss, +gesamtbestand);putwert(fnrsusgrpjgst,"11");waspruefen:=alleinsek2;CASE +allejgst:putwert(fnrsustatuss,gesamtbestand);CASE neuan5:putwert(fnrsustatuss +,neuanmeld5);gewbestand:=neuanmeld5;CASE neuan11:putwert(fnrsustatuss, +neuanmeld11);gewbestand:=neuanmeld11;CASE neuansonst:putwert(fnrsustatuss, +neuanmeldsonst);gewbestand:=neuanmeldsonst;CASE abgegangene:putwert( +fnrsustatuss,archivbestand);gewbestand:=archivbestand;END SELECT . +bestaendeausgeben:SELECT bestandnrOF CASE einejgst:ermittleallekomponenten( +jgst)CASE allejgstsek1:ermittlebestaendezeile(allesek1)CASE allejgstsek2: +ermittlebestaendezeile(allesek2)CASE allejgst,neuansonst,abgegangene: +ermittlebestaendezeile(allesek1+allesek2)CASE neuan5:ermittlebestaendezeile( +praefix(allesek1))CASE neuan11:ermittlebestaendezeile(praefix(allesek2))END +SELECT ;bestaendezeileersterteilIN spaltentitel.bestaendezeileersterteil:IF +laengespaltentitel<length(bestaendezeile)THEN rechtsverschiebbar:=TRUE ;text( +bestaendezeile,laengespaltentitel)ELSE rechtsverschiebbar:=FALSE ;text( +bestaendezeile,laengespaltentitel)+summentitelFI .END PROC startestatistik; +PROC werteverarbeitung(INT CONST auswertungsnr):vorbereitung;auswertung. +vorbereitung:schluesseldateinr:=dnrschluessel.auswertung:dateinummer:= +dnrschueler;SELECT auswertungsnrOF CASE geschlecht:vglfeld:=fnrsugeschlechts; +statkonst(weiblich,maennlich);CASE alter:vglfeld:=fnrsugebdatums;statalter +CASE schultyp:vglfeld:=fnrschart;dateinummer:=dnrschulen;statschluessel( +bestschulart,PROC registriereeinenschueler)CASE zugang:vglfeld:= +fnrsuartzugang;statschluessel(bestzugang)CASE versetzung:vglfeld:= +fnrhjdversetzung;dateinummer:=dnrhalbjahresdaten;statschluessel( +bestversetzung,PROC registriereeinenschueler)CASE teilnahmereli:dateinummer:= +dnrdiffdaten;statreliCASE fremdsprachen:dateinummer:=dnrdiffdaten; +statfremdsprachenCASE kunst:vglfeld:=fnrddkunstmusik;dateinummer:= +dnrdiffdaten;statvariabel(PROC registriereeinenschueler)CASE ort:vglfeld:= +fnrsuortsteils;statschluessel(bestort)CASE staat:vglfeld:=fnrsustaatsangs; +statschluessel(beststaat)CASE sprache:vglfeld:=fnrsumuttersprache; +statschluessel(bestsprache)CASE einschulung:vglfeld:=fnrsujahreinschul; +stateinschulungCASE herkunft:vglfeld:=fnrsuskennlschule;statherkunftCASE +religion:vglfeld:=fnrsureligionsz;statschluessel(bestreligion)CASE aussiedler +:vglfeld:=fnrsuspaetaus;statkonst(ja,nein);CASE abgang:vglfeld:=fnrsuabggrund +;statschluessel(bestabgang)CASE abschluss:vglfeld:=fnrsuabschluss; +statschluessel(bestabschluss)END SELECT .statalter:holetagesdatum; +statvariabel(PROC zaehlmethodealter).stateinschulung:statvariabel(PROC +registriereeinenschueler).statherkunft:schluesseldateinr:=dnrschulen; +statschluessel(bestherkunft).statreli:statvariabel(PROC zaehlmethodereli). +statfremdsprachen:statvariabel(PROC zaehlmethodefremdsprachen).END PROC +werteverarbeitung;PROC ermittlebestaendezeile(TEXT CONST titel): +bestaendezeile:=titel;INT VAR lg:=length(titel),ug:=1,og:=laengezaehlfeld,i:= +0;REP iINCR 1;spaltenwert(i):=compress(subtext(titel,ug,og));ug:=og+1;ogINCR +laengezaehlfeldUNTIL og>lgPER ;maxspaltenwert:=iEND PROC +ermittlebestaendezeile;PROC ermittleallekomponenten(INT CONST jgst):INT VAR +dnrklassenbestand:=dnraktschuelergruppen;bestaendezeile:=niltext; +maxspaltenwert:=0;vergleichsjgst:=jgstkonv(jgst);vergleichsstart:=TRUE ; +inittupel(dnrklassenbestand);putwert(fnrsgrpsj,schulkenndatum(sjahr));putwert +(fnrsgrphj,schulkenndatum(shj));statleseschleife(dnrklassenbestand, +vergleichsjgst,niltext,dnrklassenbestand+3,dnrklassenbestand+4,PROC (BOOL +VAR )gibklasseaus);END PROC ermittleallekomponenten;PROC gibklasseaus(BOOL +VAR ende):INT CONST dnr:=dnraktschuelergruppen;TEXT CONST klassenjgst:= +jgstkonv(intwert(dnr+3));IF vergleichsstartTHEN IF vergleichsjgst<> +klassenjgstTHEN ende:=TRUE ELSE vergleichsjgst:=klassenjgst;vergleichsstart:= +FALSE FI ELSE IF vergleichsjgst<>klassenjgstTHEN ende:=TRUE FI FI ;IF NOT +endeTHEN TEXT CONST klassenkennung:=wert(dnr+4);maxspaltenwertINCR 1; +spaltenwert(maxspaltenwert):=compress(klassenkennung);bestaendezeileCAT +rechtstext(klassenkennung,laengezaehlfeld);FI END PROC gibklasseaus;PROC +felderparsen:IF dateinummer=dnrschuelerTHEN IF vglfeld<=fnrsujgsteintrTHEN +parsenooffields(fnrsujgsteintr-dnrschueler)ELSE parsenooffields(vglfeld- +dnrschueler)FI ELIF dateinummer=dnrhalbjahresdatenTHEN parsenooffields( +fnrhjdversetzung)ELIF dateinummer=dnrschulenTHEN parsenooffields( +fnrsuskennlschule)ELSE parsenooffields(fnrsutiddiffdaten-dnrschueler)FI END +PROC felderparsen;PROC statkonst(TEXT CONST wert1,wert2):#dr11.05.88#LET +konstwertezahl=2;felderparsen;setzewerte;gibwerteaus;startezaehlung. +setzewerte:variablezaehlung:=FALSE ;maxzeilenwert:=konstwertezahl+ +anhangzeilen;zeileleer:=konstwertezahl+1;zeilenwert(1):=wert1;zeilenwert(2):= +wert2;zeilenwert(zeileleer):=niltext.gibwerteaus:ausgabederzeilenwerte(1). +startezaehlung:statzaehlung(PROC registriereeinenschueler).END PROC statkonst +;PROC statschluessel(TEXT CONST bestand):statschluessel(bestand,PROC +registriereeinenschueler)END PROC statschluessel;PROC statschluessel(TEXT +CONST bestand,PROC zaehlmethode):systemdboff;setzewerte;gibwerteaus; +startezaehlung.setzewerte:kuerzelbestand:=bestand;variablezaehlung:=FALSE ; +maxzeilenwert:=0;inittupel(schluesseldateinr);IF schluesselbestandTHEN +statleseschleife(schluesseldateinr,bestand,niltext,schluesseldateinr+1, +schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)ELSE +statleseschleife(schluesseldateinr,niltext,niltext,schluesseldateinr+1, +schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)FI ; +maxzeilenwertINCR anhangzeilen;zeileleer:=maxzeilenwert-1;zeilenwert( +maxzeilenwert):=sonsttitel;zeilenwert(zeileleer):=niltext.schluesselbestand:( +bestandSUB 1)="c".gibwerteaus:ausgabederzeilenwerte(1).startezaehlung: +statzaehlung(PROC zaehlmethode).END PROC statschluessel;PROC +tragegefundenenzeilenwertein(BOOL VAR schluss):IF dbstatus=okTHEN IF +schluesseldateinr=dnrschluesselTHEN IF wert(fnrschlsachgebiet)=kuerzelbestand +THEN IF maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ; +standardmeldung(meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert( +maxzeilenwert):=wert(fnrschlschluessel)FI ELSE schluss:=TRUE FI ELSE IF +maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ;standardmeldung( +meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert(maxzeilenwert):= +wert(schluesseldateinr+1)FI FI ELSE schluss:=TRUE FI END PROC +tragegefundenenzeilenwertein;PROC statvariabel(PROC zaehlmethode):setzewerte; +gibwerteaus;startezaehlung.setzewerte:variablezaehlung:=TRUE ;maxzeilenwert:= +0.gibwerteaus:stattext1IN wertebereichanfang;stattext2IN (wertebereichanfang+ +zeilenlaenge).startezaehlung:statzaehlung(PROC zaehlmethode).END PROC +statvariabel;PROC statzaehlung(PROC zaehlmethode):LET stackgroesse=15;INT +VAR anzahl;vorbereitung;zaehlschleife;IF variablezaehlungTHEN umsortierenFI ; +ausgabe.vorbereitung:reinitparsing;neueintragnoetig:=FALSE ;statinit( +maxzeilenwert,maxspaltenwert).zaehlschleife:anzahl:=stackgroesse; +multisearchforward(gewindex,anzahl);WHILE anzahl>0REP felderparsen;multisucc; +IF pruefungbestand(waspruefen)THEN IF dateinummer=dnrdiffdaten#dr11.05.88# +THEN diffdatenlesenELIF dateinummer=dnrhalbjahresdatenTHEN hjddatenlesenELIF +dateinummer=dnrschulenTHEN schuldatenlesenFI ;zaehlmethode; +gegebenenfallsneuenzeilenwertausgeben;anzahlDECR 1; +wennstackabgearbeitetnachlesenELSE LEAVE zaehlschleifeFI ;PER .diffdatenlesen +:inittupel(dnrdiffdaten);IF wert(fnrsutiddiffdaten)<>niltextTHEN readtid( +dnrdiffdaten,wert(fnrsutiddiffdaten))FI .hjddatenlesen:inittupel( +dnrhalbjahresdaten);IF wert(fnrsutidakthjd)<>niltextTHEN readtid( +dnrhalbjahresdaten,wert(fnrsutidakthjd));FI .schuldatenlesen:inittupel( +dnrschulen);IF wert(fnrsuskennlschule)<>niltextTHEN putwert(fnrschkennung, +wert(fnrsuskennlschule));search(dnrschulen,TRUE )FI . +gegebenenfallsneuenzeilenwertausgeben:IF variablezaehlungCAND +neueintragnoetigTHEN ausgabederzeilenwerte(1)FI . +wennstackabgearbeitetnachlesen:IF anzahl=0THEN anzahl:=stackgroesse;multisucc +(gewindex,anzahl);FI .umsortieren:quicksort(1,maxzeilenwert).ausgabe: +zwischentitel(0);ausgabederzeilenwerte(1);statausgeben(1,1).END PROC +statzaehlung;PROC ausgabederzeilenwerte(INT CONST startzeile): +sovielzeilenwiemoeglich;uebrigezeilenloeschen.sovielzeilenwiemoeglich:INT +VAR i,endwert:=min(maxzeilenwert,startzeile+zeilenzahl-1);INT VAR basis:= +wertebereichanfang;TEXT VAR ausgabewert:="";FOR iFROM startzeileUPTO endwert +REP IF variablezaehlungTHEN ausgabewert:=zeilenwert(i);IF ausgabewert= +leertitelplatzhalterTHEN ausgabewert:=leertitelFI ELIF i=zeileleerTHEN +ausgabewert:=leertitelELIF i=maxzeilenwertTHEN ausgabewert:=sonsttitelELSE +ausgabewert:=zeilenwert(i)FI ;rechtstext(ausgabewert,laengewertefeld)IN basis +;basisINCR zeilenlaengePER .uebrigezeilenloeschen:TEXT CONST loeschwert:= +rechtstext(niltext,laengewertefeld);WHILE basis<maxfeldREP loeschwertIN basis +;basisINCR zeilenlaengePER .END PROC ausgabederzeilenwerte;PROC +ausgabederspaltenwerte(INT CONST startspalte):INT VAR basis:=((startspalte-1) +*laengezaehlfeld)+1;TEXT VAR titel:=subtext(bestaendezeile,basis);IF length( +titel)<=laengespaltentitelTHEN setzesummenspalteELSE titel:=text(titel, +laengespaltentitel)FI ;titelIN spaltentitel.setzesummenspalte:titel:=text( +titel,laengespaltentitel)+summentitel.END PROC ausgabederspaltenwerte;PROC +spaltenneuausgeben(INT CONST basisspalte):INT VAR i;FOR iFROM spaltenzahl-1 +DOWNTO 1REP statspalteausgeben(basisspalte+i,i)PER END PROC +spaltenneuausgeben;PROC zwischentitel(INT CONST bestandnr):IF bestandnr=0 +THEN IF rechtsverschiebbarTHEN bestaendetitelsoweitesgehtIN spaltentitel;FI +ELSE setzecursorFI .bestaendetitelsoweitesgeht:text(bestaendezeile, +laengespaltentitel).setzecursor:INT VAR aktuellespalte:=bestandnr,basis;IF +bestandnr>spaltenzahlTHEN basis:=((bestandnr-spaltenzahl)*laengezaehlfeld)+1; +text(subtext(bestaendezeile,basis),laengespaltentitel)IN spaltentitel; +aktuellespalte:=spaltenzahl;loeschespalte(wertebereichanfang+aktuellespalte); +spaltenneuausgeben(bestandnr-spaltenzahl)FI ;infeld(wertebereichanfang+ +aktuellespalte);INT VAR x,y;getcursor(x,y);cursor(x+laengezaehlfeld-1,y-2). +END PROC zwischentitel;PROC statblaettern(INT CONST richtung):SELECT richtung +OF CASE links:nachlinksblaetternCASE rechts:nachrechtsblaetternCASE unten: +nachuntenblaetternCASE oben:nachobenblaetternEND SELECT ;return(nproc). +nachlinksblaettern:blaettern(xaktuell,yaktuell,0,-spaltenzahl). +nachrechtsblaettern:blaettern(xaktuell,yaktuell,0,spaltenzahl). +nachuntenblaettern:blaettern(xaktuell,yaktuell,zeilenzahl,0). +nachobenblaettern:blaettern(xaktuell,yaktuell,-zeilenzahl,0).END PROC +statblaettern;PROC blaettern(INT VAR x,y,INT CONST xincr,yincr):IF zulaessig +THEN meldefortsetzung;fuehreausFI .zulaessig:INT CONST xneu:=x+xincr;INT +CONST yneu:=y+yincr;((xneu>0)CAND (xneu<=maxzeilenwert))CAND ((yneu>0)CAND ( +yneu<=maxspaltenwert)).meldefortsetzung:IF (xneu=1)CAND (yneu=1)THEN +rechtstext(niltext,laengewertefeld)IN fortsetzungsfeldELSE fortsetzungstitel +IN fortsetzungsfeldFI .fuehreaus:x:=xneu;y:=yneu;IF xincr=0THEN +spaltentitelneuELSE zeilentitelneuFI ;statausgeben(xneu,yneu).spaltentitelneu +:ausgabederspaltenwerte(yneu).zeilentitelneu:ausgabederzeilenwerte(xneu).END +PROC blaettern;PROC registriereeinenschueler:tragevariablenwertein(wert( +vglfeld))END PROC registriereeinenschueler;PROC zaehlmethodealter:TEXT CONST +suchwert:=jgstkonv(lebensalter(wert(fnrsugebdatums)));tragevariablenwertein( +suchwert)END PROC zaehlmethodealter;PROC zaehlmethodereli:TEXT VAR suchwert:= +"";suchwert:=wert(fnrddreliunter);IF NOT leerTHEN IF abgemeldetTHEN suchwert +:=abgkz+suchwertFI FI ;eintragen.leer:suchwert=niltext.abgemeldet:datum( +datumrekonversion(wert(fnrddabmeldedatreli)))<>nildatum.eintragen: +tragevariablenwertein(suchwert).END PROC zaehlmethodereli;PROC +zaehlmethodefremdsprachen:TEXT VAR suchwert:=text(wert(fnrdd1fremdfach),2)+ +text(wert(fnrdd2fremdfach),2)+text(wert(fnrdd3fremdfach),2)+text(wert( +fnrdd4fremdfach),2);IF suchwert=zeilenlaenge*blankTHEN suchwert:=niltextFI ; +tragevariablenwertein(suchwert)END PROC zaehlmethodefremdsprachen;PROC +tragevariablenwertein(TEXT CONST suchwert):INT VAR lva:=0,zeilennr:=0;BOOL +VAR gefunden:=TRUE ;TEXT VAR gefundenerwert:=niltext;sucheaktuellenbestand; +suchegefundenenwert;IF NOT gefundenAND variablezaehlungTHEN IF maxzeilenwert= +mvTHEN fehlerzuvielewerte:=TRUE ;standardmeldung(meldzuvielewerte,niltext) +ELSE neueintragnoetig:=TRUE ;zeilennrINCR 1;maxzeilenwert:=zeilennr; +zeilenwert(zeilennr):=gefundenerwert;statinit(maxzeilenwert);registrierenFI +ELSE neueintragnoetig:=FALSE ;registrierenFI .sucheaktuellenbestand:SELECT +statbestandnrOF CASE einejgst:bestimmeaktuellenbestandCASE allejgstsek2: +aktuellerbestand:=int(wert(fnrsusgrpjgst))-10CASE allejgst,allejgstsek1, +abgegangene:aktuellerbestand:=int(wert(fnrsusgrpjgst))-4CASE neuansonst: +aktuellerbestand:=int(wert(fnrsujgsteintr))-4CASE neuan5,neuan11: +aktuellerbestand:=1END SELECT ;.bestimmeaktuellenbestand:FOR lvaFROM 1UPTO +maxspaltenwertREP IF compress(wert(fnrsusgrpzugtut))=compress(spaltenwert(lva +))THEN aktuellerbestand:=lva;LEAVE bestimmeaktuellenbestandFI PER . +suchegefundenenwert:IF suchwert=niltextTHEN IF variablezaehlungTHEN +gefundenerwert:=leertitelplatzhalter;zeilennr:=gefundenezeile(gefundenerwert, +maxzeilenwert,gefunden)ELSE zeilennr:=zeileleerFI ELSE gefundenerwert:= +suchwert;zeilennr:=gefundenezeile(gefundenerwert,maxzeilenwert,gefunden)FI . +registrieren:statauszaehlen(zeilennr,aktuellerbestand).END PROC +tragevariablenwertein;INT PROC gefundenezeile(TEXT CONST vergleichswert,INT +CONST oberegrenze,BOOL VAR gefunden):INT VAR i;FOR iFROM 1UPTO oberegrenze +REP IF vergleichswert=zeilenwert(i)THEN gefunden:=TRUE ;LEAVE gefundenezeile +WITH iFI PER ;gefunden:=FALSE ;maxzeilenwertEND PROC gefundenezeile;PROC +holetagesdatum:TEXT CONST tagesdatum:=date;jahrdestagesdatums:=int(subtext( +tagesdatum,beginnjahr));monatdestagesdatums:=int(subtext(tagesdatum, +beginnmonat,endemonat));tagdestagesdatums:=int(subtext(tagesdatum,beginntag, +endetag));END PROC holetagesdatum;INT PROC lebensalter(TEXT CONST +geburtsdatum):INT VAR grundalter:=jahrdestagesdatums-int(subtext(geburtsdatum +,beginnjahr));IF spaeterermonatgeborenCOR (gleichermonatgeborenCAND +spaeterertaggeboren)THEN einsjuengerFI ;grundalter.einsjuenger:grundalter +DECR 1.spaeterermonatgeboren:INT CONST geburtsmonat:=int(subtext(geburtsdatum +,beginnmonat,endemonat));geburtsmonat>monatdestagesdatums. +gleichermonatgeboren:geburtsmonat=monatdestagesdatums.spaeterertaggeboren:int +(subtext(geburtsdatum,beginntag,endetag))>tagdestagesdatums.END PROC +lebensalter;TEXT PROC aufberzweistellig(TEXT CONST jgst):IF length(jgst)=1 +THEN null+jgstELSE jgstFI END PROC aufberzweistellig;TEXT PROC praefix(TEXT +CONST t):subtext(t,1,laengezaehlfeld)END PROC praefix;PROC quicksort(INT +CONST anfang,ende):IF anfang<endeTHEN waehlepivot;sortieregrob;fuegepivotein; +quicksort(anfang,pivotstelle-1);quicksort(pivotstelle+1,ende)FI .waehlepivot: +vertauscheinzeilenwert(anfang,(anfang+ende)DIV 2);TEXT CONST pivot:= +zeilenwert(anfang).sortieregrob:nimmreduziertezeilenwert;REP schluckelinks; +schluckerechts;IF nochnichtleerTHEN vertauscheamrandELSE LEAVE sortieregrob +FI PER .nimmreduziertezeilenwert:INT VAR bereichsanfang:=anfang+1, +bereichsende:=ende.nochnichtleer:bereichsanfang<=bereichsende.schluckelinks: +WHILE nochnichtleerCAND zeilenwert(bereichsanfang)<=pivotREP bereichsanfang +INCR 1PER .schluckerechts:WHILE nochnichtleerCAND zeilenwert(bereichsende)>= +pivotREP bereichsendeDECR 1PER .vertauscheamrand:vertauscheinzeilenwert( +bereichsanfang,bereichsende).fuegepivotein:INT CONST pivotstelle:= +bereichsende;vertauscheinzeilenwert(anfang,pivotstelle).END PROC quicksort; +PROC vertauscheinzeilenwert(INT CONST i,j):TEXT VAR hilfselement:=zeilenwert( +i);zeilenwert(i):=zeilenwert(j);zeilenwert(j):=hilfselement; +statzeilevertauschen(i,j)END PROC vertauscheinzeilenwert;TEXT PROC jgstkonv( +INT CONST jgst):TEXT CONST tjgst:=text(jgst);IF jgst<maxsek1THEN null+tjgst +ELSE tjgstFI END PROC jgstkonv;BOOL PROC pruefungbestand(INT CONST welchen): +BOOL VAR b;SELECT welchenOF CASE einenbestand:pruefungeinenbestand(b)CASE +einejgst:pruefungeinejgst(b)CASE alleinsek1:pruefungsek1(b)CASE alleinsek2: +pruefungsek2(b)END SELECT ;bEND PROC pruefungbestand;PROC pruefungeinejgst( +BOOL VAR b):b:=(wert(fnrsustatuss)=gewbestandCAND wert(fnrsusgrpjgst)= +vergleichsjgst)END PROC pruefungeinejgst;PROC pruefungeinenbestand(BOOL VAR b +):b:=(wert(fnrsustatuss)=gewbestand)END PROC pruefungeinenbestand;PROC +pruefungsek1(BOOL VAR b):b:=(wert(fnrsustatuss)=gewbestandCAND intwert( +fnrsusgrpjgst)<=maxsek1)END PROC pruefungsek1;PROC pruefungsek2(BOOL VAR b):b +:=(wert(fnrsustatuss)=gewbestandCAND intwert(fnrsusgrpjgst)>maxsek1)END PROC +pruefungsek2;END PACKET statintern; + |