PACKET isperfsteueroperationenDEFINES erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen, vonerfassungsbildschirmeinlesen,maskezeigenundallefeldereinlesen, allesvonerfassungsbildschirmeinlesen,schluesselbearbeiten, bearbeitetenschluesseleinlesen,angegebenedatenpruefenundevtlspeichern, schluesselloeschvorbereitung,schluesselloeschfrage,schluesselloeschen, neuenschluesseleinfuegen,schluesselzeigen,datensatzzeigen, ausgesuchtezurbearbeitung,ausgesuchtezumloeschen,zurueckzureinzelbearbeitung, erfassungswert,setzeerfassungsfeld,erfassungsmaske,setzefehlerstatus, setzeerfassungsparameter,erfassungsfelder,datumskonversion,datumrekonversion: LET fnrschluessel=2,fnrschluessellaenge=3,fnrerstesfeld=4;LET erfparamsetzen= 1,erfwertezeigen=2,erfwertepruefen=3,erfwerteindbwerte=4,erfwertelesen=6, erfwerteaendern=7,erfwerteeinfuegen=8,erfwerteloeschen=9;LET meldungloeschfrage=65,meldungspeicherung=50,meldungloeschung=61, meldungkeineloeschung=62,meldungkeineaenderung=63,meldunggibtsschon=64, meldunggibtsnicht=66,meldungletzter=67,meldungkeineliste=68, meldunglistenerstellung=7,pruefemeldung=57,meldungschluesselzulang=60, meldungnichteingefuegt=70;LET dateiname="Liste zu den allgemeinen Diensten", leer="",null=0,oblitrenner="$";LET dateinummerschluessel=137;BOOL VAR neuerschluessel:=FALSE ;LET maxfelderzahl=100;ROW maxfelderzahlTEXT VAR erfassungsfeld;TAG VAR maske;INT VAR startpos;FILE VAR f;TEXT VAR programmname,aktschluessel;TEXT VAR aktmaskenname;INT VAR aktmaxschluessellaenge,aktindex,aktdateinummer;INT VAR anzschlfelder:=1;INT VAR fnraktletztesfeld,fnrakterstesfeld;INT VAR fnrfehlerhaftesfeld;PROC erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT CONST )erfassungspeziell):erfassungspeziell(erfparamsetzen);startprozedur; erfassungsbildschirmaufbauen;startpos:=fnrschluessel; vonerfassungsbildschirmeinlesen.END PROC erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen;PROC maskezeigenundallefeldereinlesen(PROC (INT CONST )erfassungspeziell): erfassungspeziell(erfparamsetzen);startprozedur; erfassungsbildschirmganzaufbauen;allesvonerfassungsbildschirmeinlesen.END PROC maskezeigenundallefeldereinlesen;PROC startprozedur: programminitialisieren;bildschirminitialisieren.END PROC startprozedur;PROC programminitialisieren:page;programmnameholen;standardkopfmaskeausgeben( programmname).programmnameholen:programmname:=text(vergleichsknoten).END PROC programminitialisieren;PROC bildschirminitialisieren:initmaske(maske, aktmaskenname);erfassungsfelderzumanfanginitialisieren. erfassungsfelderzumanfanginitialisieren:INT VAR i;FOR iFROM 1UPTO min( maxfelderzahl,(fnraktletztesfeld+5))REP erfassungsfeld(i):=""PER .END PROC bildschirminitialisieren;PROC erfassungsbildschirmaufbauen: standardkopfmaskeaktualisieren(programmname);erfassungsmaskeausgeben; felderzurausgabevorbereiten;felderausgeben.erfassungsmaskeausgeben:show(maske ).felderzurausgabevorbereiten:IF schluessellaengenichtzuberuecksichtigenTHEN fnrakterstesfeld:=fnrschluessellaengeELSE fnrakterstesfeld:=fnrerstesfeld; erfassungsfeld(fnrschluessellaenge):=text(aktmaxschluessellaenge)FI ;protect( maske,fnrakterstesfeld,fnraktletztesfeld+1,TRUE );loeschfeldverdecken. schluessellaengenichtzuberuecksichtigen:aktmaxschluessellaenge=0. loeschfeldverdecken:LET rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1) :=rahmenzeichen.felderausgeben:put(maske,erfassungsfeld,1);startpos:= fnrschluessel.END PROC erfassungsbildschirmaufbauen;PROC erfassungsbildschirmganzaufbauen:standardkopfmaskeaktualisieren(programmname) ;erfassungsmaskeausgeben;felderzurausgabevorbereiten;loeschfeldverdecken. erfassungsmaskeausgeben:show(maske).felderzurausgabevorbereiten: fnrakterstesfeld:=fnrschluessel+anzschlfelder;.loeschfeldverdecken:LET rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1):=rahmenzeichen;protect( maske,fnraktletztesfeld+1,TRUE ).END PROC erfassungsbildschirmganzaufbauen; PROC vonerfassungsbildschirmeinlesen:schluesseleinlesen.schluesseleinlesen: get(maske,erfassungsfeld,startpos).END PROC vonerfassungsbildschirmeinlesen; PROC allesvonerfassungsbildschirmeinlesen:put(maske,erfassungsfeld,1); startpos:=fnrschluessel;get(maske,erfassungsfeld,startpos)END PROC allesvonerfassungsbildschirmeinlesen;PROC schluesselbearbeiten(PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;loeschemeldung (maske);aktschluessel:=erfassungsfeld(fnrschluessel);datendirektlesen(PROC ( INT CONST )erfassungspeziell,schluesselexistiert);IF schluesselexistiertTHEN zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell); bearbeitetenschluesseleinlesenELSE melde(maske,meldunggibtsnicht);return(1) FI .END PROC schluesselbearbeiten;PROC zeigeschluesselzurbearbeitung(PROC ( INT CONST )erfassungspeziell):neuerschluessel:=FALSE ;protect(maske, fnrakterstesfeld,fnraktletztesfeld,FALSE );erfassungspeziell(erfwertezeigen); aktschluessel:=erfassungsfeld(fnrschluessel);startpos:=fnrschluessel;put( maske,erfassungsfeld,startpos);END PROC zeigeschluesselzurbearbeitung;PROC bearbeitetenschluesseleinlesen:get(maske,erfassungsfeld,startpos);END PROC bearbeitetenschluesseleinlesen;PROC angegebenedatenpruefenundevtlspeichern( BOOL CONST zuspeichern,PROC (INT CONST )erfassungspeziell):INT VAR schritte; IF zuspeichernTHEN speichernteil;ELSE nichtspeichernteil;FI . nichtspeichernteil:meldeauffaellig(maske,meldungkeineaenderung); vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell); return(schritte).speichernteil:fnrfehlerhaftesfeld:=0; pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell);IF datenfehlerfreiTHEN erfassungspeziell(erfwertepruefen)FI ;IF datenfehlerfrei THEN BOOL VAR satzgeschrieben;datenwegschreiben;IF NOT satzgeschriebenAND neuerschluesselTHEN melde(maske,meldungnichteingefuegt);return(1)ELSE vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell); return(schritte)FI ELSE fehlerbehandeln;return(1)FI .datenwegschreiben: meldespeicherung;datenindatenbankspeichern.datenindatenbankspeichern: erfassungspeziell(erfwerteindbwerte);IF neuerschluesselTHEN neuenschluesseleinfuegenELSE bearbeitetenschluesselzurueckschreibenFI . bearbeitetenschluesselzurueckschreiben:erfassungspeziell(erfwerteaendern);. neuenschluesseleinfuegen:erfassungspeziell(erfwerteeinfuegen);satzgeschrieben :=dbstatus=0.meldespeicherung:melde(maske,meldungspeicherung).datenfehlerfrei :fnrfehlerhaftesfeld=0.fehlerbehandeln:startpos:=fnrfehlerhaftesfeld.END PROC angegebenedatenpruefenundevtlspeichern;PROC schluesselloeschvorbereitung (PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ; loeschemeldung(maske);aktschluessel:=erfassungsfeld(fnrschluessel); datendirektlesen(PROC (INT CONST )erfassungspeziell,schluesselexistiert);IF schluesselexistiertTHEN loeschennachfrage(PROC (INT CONST )erfassungspeziell) ;schluesselloeschfrageELSE melde(maske,meldunggibtsnicht);return(1)FI .END PROC schluesselloeschvorbereitung;PROC loeschennachfrage(PROC (INT CONST ) erfassungspeziell):zeigeschluesselzurbearbeitung(PROC (INT CONST ) erfassungspeziell);melde(maske,meldungloeschfrage);protect(maske, fnrschluessel,TRUE );END PROC loeschennachfrage;PROC schluesselloeschfrage: TEXT VAR xy;startpos:=fnraktletztesfeld+1;get(maske,xy,startpos).END PROC schluesselloeschfrage;PROC schluesselloeschen(BOOL CONST zuloeschen,PROC ( INT CONST )erfassungspeziell):INT VAR schritte;IF zuloeschenTHEN melde(maske, meldungloeschung);erfassungspeziell(erfwerteloeschen);IF dbstatus<>0THEN put( maske,("Löschen - Fehlerstatus: "+text(dbstatus)),1);pauseFI ELSE melde(maske ,meldungkeineloeschung)FI ;vorbereitendernaechstenschluesselbehandlung( schritte,PROC erfassungspeziell);return(schritte).END PROC schluesselloeschen ;PROC neuenschluesseleinfuegen(PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert;loeschemeldung(maske);aktschluessel:=erfassungsfeld( fnrschluessel);pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon );return(1)ELSE neuerschluesselvorbereitung;bearbeitetenschluesseleinlesenFI .neuerschluesselvorbereitung:neuerschluessel:=TRUE ;protect(maske, fnrakterstesfeld,fnraktletztesfeld,FALSE );startpos:=fnrschluessel;put(maske, erfassungsfeld,startpos).END PROC neuenschluesseleinfuegen;PROC pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,BOOL VAR existiert): TEXT VAR schluessel:=compress(erfassungsfeld(fnrschluessel));existiert:= FALSE ;IF schluessel<>leerTHEN datendirektlesen(PROC (INT CONST ) erfassungspeziell,existiert);existiert:=dbstatus=0;FI .END PROC pruefeneuenschluessel;PROC vorbereitendernaechstenschluesselbehandlung(INT VAR schritte,PROC (INT CONST )erfassungspeziell):IF exists(dateiname)THEN holenaechstenschluesselauslisteELSE bereitenaechstebenutzereingabevor; schritte:=2FI .holenaechstenschluesselausliste:BOOL VAR ok, kannbearbeitetwerden:=FALSE ;TEXT VAR oblischl2:=""; holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF kannbearbeitetwerdenTHEN zeigeschluesselzurbearbeitung(PROC (INT CONST ) erfassungspeziell);startpos:=fnrschluessel;put(maske,erfassungsfeld,startpos) ;schritte:=1ELSE behandleendederlistenabarbeitung;schritte:=3FI . behandleendederlistenabarbeitung:melde(maske,meldungletzter);pause(20); bereitenaechstebenutzereingabevor.bereitenaechstebenutzereingabevor:protect( maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,fnraktletztesfeld, TRUE );erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske, erfassungsfeld,startpos).END PROC vorbereitendernaechstenschluesselbehandlung ;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell):schluesselzeigen( PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC pruefungdummy)END PROC schluesselzeigen;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell, BOOL CONST scanja,BOOL PROC pruefungspeziell):IF aktindex= dateinummerschluesselTHEN systemdboff;datensatzzeigen(PROC (INT CONST ) erfassungspeziell,scanja,BOOL PROC pruefungspeziell);LEAVE schluesselzeigen FI ;BOOL VAR listeexistiertnicht:=FALSE ;TEXT VAR sicherungstupel;systemdbon; savetupel(aktdateinummer,sicherungstupel);melde(maske,meldunglistenerstellung );systemdbon;restoretupel(aktdateinummer,sicherungstupel);systemdboff; aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex, aktschluessel,FALSE ,listeexistiertnicht);IF listeexistiertnichtTHEN melde( maske,meldungkeineliste);return(1)ELSE objektlistenausgabe(PROC (INT CONST ) erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI END PROC schluesselzeigen;PROC datensatzzeigen(PROC (INT CONST )erfassungspeziell): datensatzzeigen(PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC pruefungdummy)END PROC datensatzzeigen;PROC datensatzzeigen(PROC (INT CONST ) erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):BOOL VAR listeexistiertnicht:=FALSE ;melde(maske,meldunglistenerstellung); aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex, aktschluessel,TRUE ,#26.03.87#listeexistiertnicht);IF listeexistiertnicht THEN melde(maske,meldungkeineliste);return(1)ELSE datensatzlistenausgabe( PROC (INT CONST )erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI .END PROC datensatzzeigen;PROC ausgesuchtezurbearbeitung(PROC (INT CONST ) erfassungspeziell):BOOL VAR ok,kannbearbeitetwerden:=FALSE ; objektlistebeenden(dateiname,TRUE );TEXT VAR oblischl2; holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen; zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell); bearbeitetenschluesseleinlesenELSE erfassungsfelderinitialisieren; erfassungsbildschirmaufbauen;return(2)FI .END PROC ausgesuchtezurbearbeitung; PROC ausgesuchtezumloeschen(PROC (INT CONST )erfassungspeziell):BOOL VAR ok, kannbearbeitetwerden:=FALSE ;objektlistebeenden(dateiname,TRUE );TEXT VAR oblischl2;holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE ok REP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;loeschennachfrage(PROC (INT CONST )erfassungspeziell);schluesselloeschfrageELSE erfassungsfelderinitialisieren;erfassungsbildschirmaufbauen;return(2)FI .END PROC ausgesuchtezumloeschen;PROC datendirektlesen(PROC (INT CONST ) erfassungspeziell,BOOL VAR dirok):erfassungspeziell(erfwertelesen);dirok:= dbstatus=0;END PROC datendirektlesen;PROC erfassungsfelderinitialisieren: erfassungsfeld(fnrschluessel):="";INT VAR feldnr;FOR feldnrFROM fnrakterstesfeldUPTO fnraktletztesfeldREP erfassungsfeld(feldnr):="";PER . END PROC erfassungsfelderinitialisieren;PROC holeerstenschluesselausdatei( TEXT VAR feld1,feld2,BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ; LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input,dateiname); holenaechstenschluesselausdatei(feld1,feld2,ok);END PROC holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(TEXT VAR feld1,feld2,BOOL VAR ok):TEXT VAR thesaurustext:="";IF eof(f)THEN ok:=FALSE ; loeschedieerstellteobjektlisteELSE getline(f,thesaurustext); bestimmeschluesselausthesaurustext;ok:=TRUE FI . bestimmeschluesselausthesaurustext:INT VAR schluesselbeginn:=pos( thesaurustext,oblitrenner);INT VAR schluesseltrennung:=pos(thesaurustext, oblitrenner,schluesselbeginn+1);IF schluesseltrennung>0THEN feld1:=subtext( thesaurustext,schluesselbeginn+1,schluesseltrennung-1);feld2:=subtext( thesaurustext,schluesseltrennung+1)ELSE feld1:=subtext(thesaurustext, schluesselbeginn+1);feld2:=leerFI .END PROC holenaechstenschluesselausdatei; PROC loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC loeschedieerstellteobjektliste;PROC put(TAG CONST t,ROW maxfelderzahlTEXT VAR pfeld,INT CONST pos):INT VAR i;FOR iFROM posUPTO maxfelderzahlREP IF fieldexists(t,i)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC protect(TAG VAR maske,INT CONST anfangfeld,endefeld,BOOL CONST schreibschutz):IF endefeld >=anfangfeldTHEN setzefeldschutzfuerdiebenanntenfelderFI . setzefeldschutzfuerdiebenanntenfelder:INT VAR feldnr;FOR feldnrFROM anfangfeldUPTO endefeldREP protect(maske,feldnr,schreibschutz)PER .END PROC protect;PROC pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell ):melde(maske,pruefemeldung);INT VAR fehlstatus;pruefe(1,maske,TEXT PROC ( INT CONST )erfassungswert,fnrschluessel,null,null,leer,fehlstatus);IF fehlstatus<>0THEN setzefehlerstatus(fehlstatus);LEAVE pruefeplausibilitaetallgemeinFI ;IF schluessellaengemussueberprueftwerden THEN IF eingabelaenge>aktmaxschluessellaengeTHEN melde(maske, meldungschluesselzulang);setzefehlerstatus(fnrschluessel);LEAVE pruefeplausibilitaetallgemeinFI FI ;BOOL VAR schluesselexistiert;IF neuerschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon );setzefehlerstatus(fnrschluessel)FI ELSE IF erfassungsfeld(fnrschluessel)<> aktschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell, schluesselexistiert);IF schluesselexistiertTHEN setzeaufaltensatzzurueck; melde(maske,meldunggibtsschon);setzefehlerstatus(fnrschluessel);ELSE setzefehlerstatus(0);FI ELSE setzefehlerstatus(0);FI FI . setzeaufaltensatzzurueck:TEXT VAR falscherschluessel:=erfassungsfeld( fnrschluessel);erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen( PROC (INT CONST )erfassungspeziell,schluesselexistiert);erfassungsfeld( fnrschluessel):=falscherschluessel.eingabelaenge:length(erfassungsfeld( fnrschluessel)).schluessellaengemussueberprueftwerden:aktmaxschluessellaenge> 0.END PROC pruefeplausibilitaetallgemein;PROC zurueckzureinzelbearbeitung: loeschedieerstellteobjektliste;standardkopfmaskeaktualisieren(programmname); protect(maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,TRUE ); erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske, erfassungsfeld,startpos);return(3);END PROC zurueckzureinzelbearbeitung;PROC setzeerfassungsfeld(TEXT CONST feldinhalt,INT CONST feldnr):erfassungsfeld( feldnr):=feldinhaltEND PROC setzeerfassungsfeld;TEXT PROC erfassungswert(INT CONST feldnr):IF (feldnr>maxfelderzahl)OR (feldnr<1)THEN ""ELSE erfassungsfeld(feldnr)FI .END PROC erfassungswert;ROW 100TEXT PROC erfassungsfelder:erfassungsfeldEND PROC erfassungsfelder;TAG PROC erfassungsmaske:maskeEND PROC erfassungsmaske;PROC setzefehlerstatus(INT CONST feldnr):fnrfehlerhaftesfeld:=feldnr.END PROC setzefehlerstatus;PROC setzeerfassungsparameter(INT CONST dateinummer,INT CONST schluessellaenge, TEXT CONST maskenname,INT CONST letzteserfassungsfeld):aktindex:=dateinummer; aktdateinummer:=dateinr(primdatid(dateinummer));aktmaxschluessellaenge:= schluessellaenge;aktmaskenname:=maskenname;fnraktletztesfeld:= letzteserfassungsfeld;anzschlfelder:=anzkey(dateinr(primdatid(aktdateinummer) ));END PROC setzeerfassungsparameter;PROC setzeerfassungsparameter(INT CONST dateinummer,TEXT CONST maskenname,INT CONST letzteserfassungsfeld):LET keineschluessellaenge=0;setzeerfassungsparameter(dateinummer, keineschluessellaenge,maskenname,letzteserfassungsfeld).END PROC setzeerfassungsparameter;TEXT PROC datumskonversion(TEXT CONST datum):TEXT VAR d:=datum;IF nurblanksoderleer(datum)OR d=" . . "THEN "01.01.00"ELSE changeall(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3); insertchar(d,".",6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC datumskonversion;BOOL PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR i FROM 1UPTO length(t)REP IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH FALSE FI PER ;TRUE ENDPROC nurblanksoderleer;TEXT PROC datumrekonversion( TEXT CONST datum):TEXT VAR d:=datum;changeall(d,".","");IF d="010100"THEN d:= ""FI ;dENDPROC datumrekonversion;END PACKET isperfsteueroperationen