1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
|
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
|