PACKET hoeherstufenlocalprogDEFINES schuljahreswechsel,halbjahreswechsel:LET
dnrschueler=2,fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6
,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsutidakthjd=9,fnrsuartzugang=10,
fnrsuneuerzugtut=11,fnrsujgsteintr=13,#fnrsuskennlschule=14,dr13.05.88#
fnrsuabgdats=16,fnrsuabschluss=18,fnrsueintrittinsek=44,dnrhalbjahresdaten=88
,fnrhjdfamnames=89,fnrhjdrufnames=90,fnrhjdgebdats=91,fnrhjdsj=92,fnrhjdhj=93
,fnrhjdjgst=94,fnrhjdkennung=95,fnrhjdversetzung=96,#dnrschulen=120,dr13.
05.88##fnrschkennung=121,dr13.05.88#dnraktschuelergruppen=129,fnrsgrpsj=130,
fnrsgrphj=131,fnrsgrpjgst=132,fnrsgrpkennung=133,ixsustatfamrufgeb=243,
ixsustatjgstzug=244,ixsustatjgst=250;LET hellan="",hellaus=" ",meldz=23;
LET neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso";LET jgst13="13",
jgst11="11";LET posvers=1,posnachpr=2,posspringer=3,posfreiwillig=4,
posnichtvers=5,poshoeherstufen=2,kennzeichenneuan="z",kennzeichenabitur="K",
gueltigekennzeichen="vnsfw",dreizehnnachpr="N";LET null=0,niltext="",
trennername=", ",sgtrenner="/",blank=" ",maxjahr=100,minjahr="00",klammerauf=
" (",klammerzu=")",leerdatum="01.01.00";LET halbjahr1="1",halbjahr2="2",
zumschuljahresende=1,zumhalbjahresende=0;LET schluesselschuljahr="Schuljahr",
schluesselhalbjahr="Schulhalbjahr",schluesselendeschulhalbjahr=
"Ende Schulhalbjahr";LET bestandabgegangene="abg",aktbestand="ls";LET
anzkenndaten=3;LET protname="Fehlerprotokoll";LET schulname="Schulname",
schulort="Schulort",zeilenlaenge=77,datumslaenge=8,ordnungstrenner=". ",
absatztrenner=" - ",protueberschrift=
"Fehlerprotokoll zum automatischen Hochsetzen";LET weiterefehler=
"Abbruch des Programmes, da zu viele Fehler",maxfehler=50;LET
fehlerkeinverserg=1,fehlerkeinneuertutor=2,fehlerungueltigesverserg=3,
fehlerungueltigesg=4,fehlerungueltigehjd=5,fehlerstatus=6,fehlerplanung=7;
LET maxfehlerart=7;LET fehleraendern="Ändern: ",fehlerloeschen="Löschen: ";
LET rcodeprot=1001,rcodenoprot=1002;BOOL VAR updatenoetig:=FALSE ;DATASPACE
VAR ds:=nilspace;FILE VAR fehlerprot;INT VAR fehlerzahl,kanal;TEXT VAR
stichtag:="";TEXT VAR letztername,letzterrufname,letztesgebdatum,
letzterstatus;ROW anzkenndatenTEXT VAR key;ROW maxfehlerartTEXT CONST
fehlertext:=ROW maxfehlerartTEXT :("Es liegt kein Versetzungsergebnis vor",
"Es wurde kein neuer Zug/Tutor eingetragen",
"Das eingetragene Versetzungsergebnis ist nicht zulässig",
"Die eingetragene Schülergruppe ist nicht vorgesehen",
"Zu diesem Schüler liegen keine oder unvollständige Halbjahresdaten vor",
"Fehler beim Datenbankzugriff","Keine Schülergruppen im Planungsbestand");
TEXT VAR geplschuelergruppen,aufbermeld,aufberprot,aktschuljahr,akthalbjahr,
kommendesschuljahr;PROC schuljahreswechsel:abschnittsendebearbeitung(
zumschuljahresende)END PROC schuljahreswechsel;PROC halbjahreswechsel:
abschnittsendebearbeitung(zumhalbjahresende)END PROC halbjahreswechsel;PROC
abschnittsendebearbeitung(INT CONST zeitpunkt):forget(ds);kanal:=int(
getrcvparam(1));continue(kanal);reinitparsing;stichtag:=schulkenndatum(
schluesselendeschulhalbjahr);aktschuljahr:=schulkenndatum(schluesselschuljahr
);akthalbjahr:=schulkenndatum(schluesselhalbjahr);kommendesschuljahr:=subtext
(aktschuljahr,3,4);kommendesschuljahrCAT (jahrestext(int(kommendesschuljahr)+
1));fehlerbehandlungvorbereiten;verarbeitung;fehlerauswertung;break(quiet).
fehlerbehandlungvorbereiten:disablestop;forget(protname,quiet);fehlerzahl:=
null.verarbeitung:IF zeitpunkt=zumschuljahresendeTHEN hochsetzenderschueler
ELSE halbjahreswechselderschuelerFI .fehlerauswertung:IF fehleraufgetreten
THEN schickefehlerprotokollananwenderELSE putsndcode(rcodenoprot);ds:=
nilspace;putsndds(ds);forget(ds)FI ;forget(protname,quiet).fehleraufgetreten:
fehlerzahl>null.schickefehlerprotokollananwender:clearerror;enablestop;
putsndcode(rcodeprot);ds:=old(protname);putsndds(ds);forget(ds).END PROC
abschnittsendebearbeitung;PROC halbjahreswechselderschueler:enablestop;
schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN
aktuellanderschulebefindlicheschuelerdurchgehen(zumhalbjahresende)FI .END
PROC halbjahreswechselderschueler;PROC hochsetzenderschueler:enablestop;
schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN
aktuellanderschulebefindlicheschuelerdurchgehen(zumschuljahresende);
neuanmeldungenuebernehmenFI .neuanmeldungenuebernehmen:
neuanmeldungenzur5uebernehmen;neuanmeldungenzur11uebernehmen;
sonstigeneuanmeldungenuebernehmen.END PROC hochsetzenderschueler;PROC
schuelergruppenausplanunguebernehmen:TEXT VAR folgesj,folgehj;
geplschuelergruppen:=niltext;neuewertefuerschuljahrhalbjahrbestimmen;
inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,folgesj);putwert(fnrsgrphj
,folgehj);search(dnraktschuelergruppen,FALSE );WHILE dbstatus=okCAND
richtigesschulhalbjahrREP leseeinesg;succ(dnraktschuelergruppen)PER ;IF
geplschuelergruppen=niltextTHEN fehler(niltext,fehlerplanung)ELSE
alteschuelergruppenloeschen;#statistikwuerfelvorbereitendr11.05.88#FI .
neuewertefuerschuljahrhalbjahrbestimmen:IF akthalbjahr=halbjahr1THEN folgesj
:=aktschuljahr;folgehj:=halbjahr2ELSE folgesj:=kommendesschuljahr;folgehj:=
halbjahr1FI .richtigesschulhalbjahr:wert(fnrsgrpsj)=folgesjCAND wert(
fnrsgrphj)=folgehj.#dr11.05.88statistikwuerfelvorbereiten:melde(hellan+
"Die speziellen Statistiken werden initialisiert"+hellaus,meldz);initstatraum
(TRUE );bestaendeinstatraumeintragen(folgesj,folgehj);
kuerzelnameninstatraumeintragen.#END PROC
schuelergruppenausplanunguebernehmen;PROC alteschuelergruppenloeschen:TEXT
VAR sg:="";inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,aktschuljahr);
putwert(fnrsgrphj,akthalbjahr);search(dnraktschuelergruppen,FALSE );WHILE
altesschuljahrhalbjahrREP sg:=wert(fnrsgrpjgst)+wert(fnrsgrpkennung);delete(
dnraktschuelergruppen);IF dbstatus<>nullTHEN fehler(sg,fehlerstatus,
fehlerloeschen+text(dbstatus))ELSE melde("Die aktuelle Schülergruppe "+hellan
+sg+hellaus+"wird gelöscht",meldz)FI ;search(dnraktschuelergruppen,FALSE )
PER .altesschuljahrhalbjahr:dbstatus=nullCAND wert(fnrsgrpsj)=aktschuljahr
CAND wert(fnrsgrphj)=akthalbjahr.END PROC alteschuelergruppenloeschen;PROC
leseeinesg:TEXT CONST jgstkurz:=wert(fnrsgrpjgst),jgstlang:=jgstaufber(
jgstkurz),zug:=compress(wert(fnrsgrpkennung));melde(
"Die aktuelle Schülergruppe "+hellan+jgstlang+zug+hellaus+"wird eingerichtet"
,meldz);geplschuelergruppenCAT jgstlang;geplschuelergruppenCAT zug;
geplschuelergruppenCAT sgtrennerEND PROC leseeinesg;PROC
aktuellanderschulebefindlicheschuelerdurchgehen(INT CONST zeitpunkt):TEXT
VAR schuelertid:="";bereitevor;erstenlesen;WHILE nochwelchedaREP schuelertid
:=gettid;saveupdateposition(dnrschueler);verarbeiten;aenderungspeichern;
updatenoetig:=TRUE ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler);
putwert(fnrsustatuss,aktbestand);updatenoetig:=TRUE .erstenlesen:search(
ixsustatfamrufgeb,FALSE );merkealleschluesselwerte.naechstenlesen:IF wert(
fnrsustatuss)=bestandabgegangeneTHEN putwert(fnrsustatuss,aktbestand);search(
ixsustatfamrufgeb,FALSE )ELSE succ(ixsustatfamrufgeb)FI ;IF
selbensatznochmalgelesenTHEN succ(ixsustatfamrufgeb)FI ;
merkealleschluesselwerte.merkealleschluesselwerte:letztername:=wert(
fnrsufamnames);letzterrufname:=wert(fnrsurufnames);letztesgebdatum:=wert(
fnrsugebdatums);letzterstatus:=wert(fnrsustatuss).selbensatznochmalgelesen:
letztername=wert(fnrsufamnames)CAND letzterrufname=wert(fnrsurufnames)CAND
letztesgebdatum=wert(fnrsugebdatums)CAND letzterstatus=wert(fnrsustatuss).
nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=aktbestand.verarbeiten:
setzekenndaten;setzejgstundsg;meldebearbeitung;IF abgemeldetTHEN
anderschulebefindlicheabmeldenELIF zeitpunkt=zumschuljahresendeTHEN
anderschulebefindlichebehandeln(aktjgst,aktsg)ELSE
schuelerzumhalbjahreswechselbehandeln(aktjgst,aktsg)FI .setzejgstundsg:TEXT
VAR aktjgst:=jgstaufber(wert(fnrsusgrpjgst)),aktsg:=compress(wert(
fnrsusgrpzugtut)).meldebearbeitung:melde("Die Daten von "+hellan+aufbermeld+
hellaus+", "+hellan+aktjgst+aktsg+hellaus+"werden bearbeitet",meldz).
abgemeldet:INT VAR aktabmeldedatum:=datum(wert(fnrsuabgdats));(
aktabmeldedatum<>datum(leerdatum))CAND (datum(stichtag)>=aktabmeldedatum).
anderschulebefindlicheabmelden:putwert(fnrsustatuss,bestandabgegangene);
updatenoetig:=TRUE ;hjdnaechstesschulhalbjahrbearbeiten(aktjgst,aktsg).
aenderungspeichern:IF dbstatus=okTHEN IF updatenoetigTHEN
restoreupdateposition(dnrschueler);selupdate(dnrschueler);ELSE replace(
dnrschueler,schuelertid);putptid(schuelertid);insertinindex(ixsustatjgstzug);
IF zeitpunkt=zumschuljahresendeTHEN insertinindex(ixsustatjgst)FI FI ;IF
dbstatus<>nullTHEN fehler(aufberprot,fehlerstatus,fehleraendern+text(dbstatus
))FI FI .END PROC aktuellanderschulebefindlicheschuelerdurchgehen;PROC
schuelerzumhalbjahreswechselbehandeln(TEXT CONST aktjgst,aktsg):TEXT VAR
neueklasse,neuesg;tutorloeschen;neueklassepruefen;dbstatus(ok).tutorloeschen:
#removeoutoffindex(ixsustatjgstzug);##dr18.08.88#neuesg:=compress(wert(
fnrsuneuerzugtut));IF neuesg<>niltextTHEN putwert(fnrsusgrpzugtut,niltext)FI
.neueklassepruefen:IF neuesg=niltextTHEN neueklasse:=aktjgst+aktsg;neuesg:=
aktsgELSE neueklasse:=aktjgst+neuesg;putwert(fnrsuneuerzugtut,niltext);
putwert(fnrsusgrpzugtut,neuesg);FI ;IF NOT gueltigesg(neueklasse)THEN fehler(
aufberprot,fehlerungueltigesg,neueklasse);dbstatus(9);LEAVE
schuelerzumhalbjahreswechselbehandelnELSE hjdnaechstesschulhalbjahrbearbeiten
(aktjgst,neuesg)FI .END PROC schuelerzumhalbjahreswechselbehandeln;PROC
anderschulebefindlichebehandeln(TEXT CONST aktjgst,aktsg):holehjd;
analysierehalbjahresdaten;aendere.holehjd:IF wert(fnrsutidakthjd)<>niltext
THEN readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));IF iserrorTHEN
clearerror;dbstatus(notfound)FI ELSE dbstatus(notfound)FI ;IF
keinehalbjahresdatenvorhandenTHEN fehler(aufberprot,fehlerungueltigehjd);
LEAVE anderschulebefindlichebehandelnFI .keinehalbjahresdatenvorhanden:
dbstatus<>okCOR aktschuljahr<>wert(fnrhjdsj)COR akthalbjahr<>wert(fnrhjdhj)
COR key[1]<>wert(fnrhjdfamnames)COR key[2]<>wert(fnrhjdrufnames)COR key[3]<>
datumrekonversion(wert(fnrhjdgebdats))COR aktjgst<>jgstaufber(wert(fnrhjdjgst
))COR aktsg<>compress(wert(fnrhjdkennung)).analysierehalbjahresdaten:TEXT
VAR versetzung:=wert(fnrhjdversetzung);pruefeversetzungskennzeichen.
pruefeversetzungskennzeichen:BOOL VAR datenkorrekt:=FALSE ;TEXT CONST
neuerzugtutor:=wert(fnrsuneuerzugtut);IF versetzung=niltextTHEN fehler(
aufberprot,fehlerkeinverserg)ELIF pos(gueltigekennzeichen,versetzung)<=null
THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);ELIF
nichtnormalhoeherstufenCAND keinzugtutorTHEN fehler(aufberprot,
fehlerkeinneuertutor);ELSE datenkorrekt:=TRUE FI ;IF NOT datenkorrektTHEN
LEAVE anderschulebefindlichebehandelnFI .nichtnormalhoeherstufen:pos(
gueltigekennzeichen,versetzung)>poshoeherstufen.keinzugtutor:neuerzugtutor=
niltext.aendere:TEXT VAR neuesg:=wert(fnrsusgrpzugtut);#removeoutoffindex(
ixsustatjgst);removeoutoffindex(ixsustatjgstzug);##dr18.08.88#IF
neuerzugtutor<>niltextTHEN neuesg:=neuerzugtutorFI ;aendereschueler(aktjgst,
aktsg,neuesg,versetzung).END PROC anderschulebefindlichebehandeln;PROC
aendereschueler(TEXT CONST aktjgst,aktsg,neuesg,versetzung):bereitevor;
setzedaten;hjddatenloeschen;hjdnaechstesschulhalbjahrbearbeiten(neuejgst,
neuesg).bereitevor:TEXT VAR neuejgst:=aktjgst;TEXT VAR loeschjgst:=aktjgst;.
setzedaten:trageversetzungundtutorein;INT CONST kennzeichenpos:=pos(
gueltigekennzeichen,versetzung);SELECT kennzeichenposOF CASE posspringer:
springenCASE posvers:normalversetzenCASE posnachpr:zurnachpruefungversetzen
CASE posnichtvers,posfreiwillig:sitzenbleibenEND SELECT ;TEXT VAR neueklasse
:=neuejgst+neuesg;IF falscherzugtutorTHEN fehler(aufberprot,
fehlerungueltigesg,neueklasse);LEAVE aendereschuelerFI .falscherzugtutor:NOT
gueltigesg(neueklasse).trageversetzungundtutorein:putwert(fnrsuartzugang,
versetzung);putwert(fnrsuneuerzugtut,niltext).springen:IF int(aktjgst)>11
THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);LEAVE
aendereschuelerFI ;BOOL VAR sitzenbleiber:=FALSE ;neuejgst:=jgstaufber(text(
int(aktjgst)+2));loeschjgst:=jgstaufber(text(int(aktjgst)+1));
nachfolgendehjdsloeschen;sgeintragen;eintrittsek2evtleintragen.
normalversetzen:IF inder13THEN dreizehnerabmelden;
hjdnaechstesschulhalbjahrbearbeiten(neuejgst,aktsg);LEAVE aendereschueler
ELSE normalhochsetzenFI .zurnachpruefungversetzen:IF inder13THEN
nachpruefling13ELSE normalhochsetzenFI .normalhochsetzen:sitzenbleiber:=
FALSE ;neuejgst:=jgstaufber(text(int(aktjgst)+1));loeschjgst:=neuejgst;
sgeintragen;eintrittsek2evtleintragen.sgeintragen:putwert(fnrsusgrpjgst,
neuejgst);putwert(fnrsusgrpzugtut,neuesg);.eintrittsek2evtleintragen:IF
neuejgst=jgst11THEN putwert(fnrsueintrittinsek,kommendesschuljahr);FI .
nachpruefling13:sitzenbleiber:=TRUE ;putwert(fnrsuartzugang,dreizehnnachpr);
sgeintragen.sitzenbleiben:sitzenbleiber:=TRUE ;sgeintragen;
nachfolgendehjdsloeschen.nachfolgendehjdsloeschen:halbjahresdatenloeschen(
PROC (INT CONST )succ,key,halbjahr2,int(aktjgst),FALSE );.inder13:aktjgst=
jgst13.hjddatenloeschen:halbjahresdatenloeschen(key,aktjgst,loeschjgst,
halbjahr1).END PROC aendereschueler;PROC dreizehnerabmelden:putwert(
fnrsuabgdats,stichtag);putwert(fnrsuabschluss,kennzeichenabitur);putwert(
fnrsustatuss,bestandabgegangene);updatenoetig:=TRUE ;END PROC
dreizehnerabmelden;PROC neuanmeldungenzur5uebernehmen:uebernehmenaus(
neuanmeld5,1)END PROC neuanmeldungenzur5uebernehmen;PROC
neuanmeldungenzur11uebernehmen:uebernehmenaus(neuanmeld11,1)END PROC
neuanmeldungenzur11uebernehmen;PROC sonstigeneuanmeldungenuebernehmen:
uebernehmenaus(neuanmeldsonst,2)END PROC sonstigeneuanmeldungenuebernehmen;
PROC uebernehmenaus(TEXT CONST bestand,INT CONST meld):BOOL VAR
allesinordnung:=FALSE ;TEXT VAR neuejgst,neuerzug;bereitevor;erstenlesen;
WHILE nochwelchedaREP saveupdateposition(dnrschueler);pruefen;IF
allesinordnungTHEN uebernehmen;putwert(fnrsustatuss,bestand);meldeuebernahme;
FI ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler);putwert(
fnrsustatuss,bestand).erstenlesen:search(ixsustatfamrufgeb,FALSE ).
nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=bestand.pruefen:
setzekenndaten;pruefetutorsg(allesinordnung);.uebernehmen:neuejgst:=wert(
fnrsujgsteintr);neuerzug:=wert(fnrsuneuerzugtut);dbwertesetzen;
hjdnaechstesschulhalbjahrbearbeiten(neuejgst,neuerzug);restoreupdateposition(
dnrschueler);selupdate(dnrschueler);IF dbstatus<>nullTHEN fehler(aufberprot,
fehlerstatus,fehleraendern+text(dbstatus))FI .dbwertesetzen:putwert(
fnrsusgrpjgst,jgstaufber(neuejgst));putwert(fnrsusgrpzugtut,neuerzug);putwert
(fnrsuartzugang,kennzeichenneuan);putwert(fnrsuneuerzugtut,niltext).
meldeuebernahme:IF meld=1THEN melde("Bearbeitung der Neuangemeldeten zur "+
jgstaufber(neuejgst)+": "+hellan+aufbermeld+hellaus,meldz)ELSE melde(
"Bearbeitung sonstiger Neuanmeldungen: "+hellan+aufbermeld+hellaus,meldz)FI .
naechstenlesen:search(ixsustatfamrufgeb,FALSE )#dr18.08.88##succ(
ixsustatfamrufgeb)##eigentlichrichtig#.END PROC uebernehmenaus;PROC fehler(
TEXT CONST name,INT CONST fehlernr):fehler(name,fehlernr,niltext)END PROC
fehler;PROC fehler(TEXT CONST name,INT CONST fehlernr,TEXT CONST ergaenzung):
IF ersterfehlerTHEN fehlerprotokollbeginnenELIF zuvielefehlerTHEN
programmendeFI ;nameinprotokoll;fehler(fehlernr,ergaenzung);dbstatus(notfound
);.ersterfehler:fehlerzahl=null.zuvielefehler:fehlerzahl=maxfehler.
fehlerprotokollbeginnen:fehlerprot:=sequentialfile(output,protname);TEXT VAR
protzeile:=schulkenndatum(schulname);protzeileCAT ((zeilenlaenge-datumslaenge
-length(protzeile))*blank);protzeileCAT date;putline(fehlerprot,protzeile);
putline(fehlerprot,schulkenndatum(schulort));line(fehlerprot,3);putline(
fehlerprot,protueberschrift);line(fehlerprot).programmende:line(fehlerprot);
putline(fehlerprot,weiterefehler);stop.nameinprotokoll:fehlerzahlINCR 1;line(
fehlerprot);protzeile:=text(fehlerzahl)+ordnungstrenner+name;putline(
fehlerprot,protzeile).END PROC fehler;PROC fehler(INT CONST fehlernr,TEXT
CONST ergaenzung):TEXT VAR protzeile:=absatztrenner+fehlertext(fehlernr);IF
ergaenzung<>niltextTHEN protzeileCAT klammerauf;protzeileCAT ergaenzung;
protzeileCAT klammerzuFI ;putline(fehlerprot,protzeile)END PROC fehler;PROC
pruefetutorsg(BOOL VAR allesinordnung):TEXT VAR eintrittjgst:=wert(
fnrsujgsteintr),neuerzug:=wert(fnrsuneuerzugtut);allesinordnung:=neuerzug<>
niltext;IF allesinordnungTHEN allesinordnung:=gueltigesg(eintrittjgst+
neuerzug);IF NOT allesinordnungTHEN fehler(aufberprot,fehlerungueltigesg,
eintrittjgst+neuerzug)FI ELSE fehler(aufberprot,fehlerkeinneuertutor)FI ;END
PROC pruefetutorsg;BOOL PROC gueltigesg(TEXT CONST sg):pos(
geplschuelergruppen,sg+sgtrenner)>nullEND PROC gueltigesg;PROC setzekenndaten
:key(1):=wert(fnrsufamnames);key(2):=wert(fnrsurufnames);key(3):=
datumrekonversion(wert(fnrsugebdatums));aufbermeld:=key(1)+trennername+key(2)
;aufberprot:=aufbermeld+trennername+datumskonversion(key(3))END PROC
setzekenndaten;TEXT PROC jahrestext(INT CONST jahr):IF jahr=maxjahrTHEN
minjahrELSE text(jahr)FI END PROC jahrestext;PROC
hjdnaechstesschulhalbjahrbearbeiten(TEXT CONST jgst,zug):IF wert(fnrsustatuss
)<>aktbestandTHEN halbjahresdateninitialisierenundverarbeitenELSE
halbjahresdatensuchenundverarbeitenFI ;dbstatus(ok)#dr18.08.88##inittupel(
dnrschulen);dr11.05.88putwert(fnrschkennung,wert(fnrsuskennlschule));search(
dnrschulen,TRUE );einenschuelerinstatraumeinfuegen#.
halbjahresdateninitialisierenundverarbeiten:putwert(fnrsutidakthjd,niltext);
inittupel(dnrhalbjahresdaten);IF wert(fnrsustatuss)<>bestandabgegangeneTHEN
putwert(fnrsustatuss,aktbestand)FI .halbjahresdatensuchenundverarbeiten:
schluesselsetzen;search(dnrhalbjahresdaten,TRUE );IF dbstatus=okTHEN
eventuellneueklasseeintragen;putwert(fnrsutidakthjd,gettid)ELSE putwert(
fnrsutidakthjd,niltext)FI .schluesselsetzen:IF akthalbjahr=halbjahr1THEN
schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,aktschuljahr,halbjahr2,jgst)
ELSE schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,kommendesschuljahr,
halbjahr2,jgst)FI .eventuellneueklasseeintragen:IF schuelergruppegeaendert
THEN halbjahresdatenaendernFI .schuelergruppegeaendert:wert(fnrhjdjgst)<>jgst
OR wert(fnrhjdkennung)<>zug.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);
putwert(fnrhjdkennung,zug);selupdate(dnrhalbjahresdaten).END PROC
hjdnaechstesschulhalbjahrbearbeiten;LET seperatorzeichen=":./ ",
seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b;
BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC
nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90
,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212,
letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334
,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j):
INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0
THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a
:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a>
letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<=
letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<=
letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<=
letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI .
januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m
:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<=
letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a-
letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli
THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli
ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m
:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a-
letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum(
TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j;
IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5)
*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum
FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF
seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1);
seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:=
z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2
)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ;
IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH
nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q
)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo):
INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e
FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j
INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE
SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4,
6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j)
ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND
SELECT FI END PROC datum;INT PROC erg(INT CONST t,m,jc):INT VAR j:=jc;INT
VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR 88;result:=-1FI ;
resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:=tagundmonat+365*j;IF
tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR 1ELIF tagimzyklus=
erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ;result+tagimzyklus.
erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:tCASE 2:t+
letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+
letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9
:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+
letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END
PROC erg;INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END
PROC jahr;TEXT PROC datum(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);
IF t<0THEN LEAVE datumWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);e
CAT seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT
seperatorzeichen1;eCAT code((jMOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND
PROC datum;END PACKET hoeherstufenlocalprog