From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 .../2.2.1-schulis/src/isp.auskunftsfunktionen      | 69 ++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen

(limited to 'app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen')

diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
new file mode 100644
index 0000000..0f002ba
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
@@ -0,0 +1,69 @@
+PACKET auskunftsfunktionenDEFINES erteileauskunft,ergaenzeauskunft,
+auskunftszeilenende,auskunftstextende,editauskunft,quadrant:LET eol="�",stop=
+"�",fuereditor=TRUE ,fuermaske=FALSE ;TEXT CONST standardtext:=
+"Die gewünschte Auskunft ist leider noch nicht verfügbar!"+stop;TEXT CONST 
+auskunftszeilenende:=eol;TEXT CONST auskunftstextende:=stop;TEXT VAR 
+auskunftergaenzung:="";INT VAR auskunftergaenzungsnr:=0;PROC ergaenzeauskunft
+(TEXT CONST durch,INT CONST fuer):auskunftergaenzung:=durch;
+auskunftergaenzungsnr:=fuerEND PROC ergaenzeauskunft;TEXT PROC atext(INT 
+CONST nr):TEXT VAR grundauskunft;IF wert(fnrauskunftstext)=""THEN 
+grundauskunft:=standardtextELSE grundauskunft:=wert(fnrauskunftstext)FI ;IF (
+auskunftergaenzung<>"")CAND (nr=auskunftergaenzungsnr)THEN grundauskunftCAT 
+auskunftergaenzungFI ;grundauskunftEND PROC atext;TEXT PROC astichwort:
+systemdbon;wert(fnrschlverz)END PROC astichwort;WINDOW PROC altesfenster:INT 
+VAR i,j,k,l;quadrant(i,j,k,l);startwindow(i,j,k,l)END PROC altesfenster;PROC 
+quadrant(INT VAR i,j,k,l):merkeposition;fenster.merkeposition:INT VAR x,y;
+getcursorposfuerauskunft(x,y).fenster:INT VAR x1,y1,x2,y2;IF vierterquadrant
+THEN x1:=1;y1:=12;x2:=39;y2:=1ELIF dritterquadrantTHEN x1:=40;y1:=12;x2:=77;
+y2:=1ELIF zweiterquadrantTHEN x1:=1;y1:=24;x2:=39;y2:=13ELIF ersterquadrant
+THEN x1:=40;y1:=24;x2:=77;y2:=13FI ;i:=x1;j:=y1;k:=x2;l:=y2.ersterquadrant:(x
+<40)CAND (y<13).zweiterquadrant:(x>39)CAND (y<13).dritterquadrant:(x<40)CAND 
+(y>12).vierterquadrant:(x>39)CAND (y>12).END PROC quadrant;PROC holeauskunft(
+INT CONST name):putintwert(fnrauskunftsname,name);search(dnrausk,TRUE );END 
+PROC holeauskunft;PROC erteileauskunft(INT CONST nr):WINDOW VAR w:=
+altesfenster;TEXT VAR auskunft:="";TEXT CONST st:=" = ";INT CONST suchname:=
+nr;INT VAR anzahl:=5;systemdbon;erteileauskunftbody;systemdboff;
+wiederaufsetzen.erteileauskunftbody:IF menuedraussenTHEN reorganizescreenFI ;
+open(w);auskunftholen;zeige.auskunftholen:holeauskunft(suchname);.zeige:IF 
+dbstatus=okTHEN auskunft:=atext(suchname)ELSE auskunft:=standardtext;putwert(
+fnrschlverz,"")FI ;stwpruefen;auskunfterteilung(auskunft,w,fuermaske);.
+stwpruefen:IF astichwort<>""THEN textschonmalzeigen(auskunft,w,fuermaske);IF 
+pos(astichwort,"c")=1THEN schluesselverzeichnisausschluesseldateiELSE 
+schluesselverzeichnisnichtausschluesseldateiFI FI ;schlussstern.
+schluesselverzeichnisausschluesseldatei:#INT VAR i:=1;##02.02.88dr#TEXT VAR 
+bestname:=astichwort;systemdboff;bestandsuchen;IF bestandvorhandenTHEN 
+auskunftCAT stop;ankoppelnderabkuerzung;naechstelesen;WHILE erfolgreichREP 
+anhaengen;naechstelesenPER ELSE meldunganhaengen(auskunft,"Bestand "+bestname
++" ist nicht vorhanden")FI .bestandsuchen:inittupel(dnrschluessel);putwert(
+fnrschlsachgebiet,bestname);search(dnrschluessel,FALSE );.bestandvorhanden:
+dbstatus=okCAND wert(fnrschlsachgebiet)=bestname.naechstelesen:anzahl:=18;
+multisucc(dnrschluessel,anzahl);#iINCR 1##02.02.88dr#.erfolgreich:anzahl>0
+CAND wert(fnrschlsachgebiet)=bestname.anhaengen:WHILE anzahl>0REP multisucc;
+IF erfolgreichTHEN ankoppelnderabkuerzung;FI ;anzahlDECR 1UNTIL NOT 
+erfolgreichPER .ankoppelnderabkuerzung:auskunftCAT wert(fnrschlschluessel);
+auskunftCAT st;auskunftCAT wert(fnrschllangtext);auskunftCAT stop;.
+schluesselverzeichnisnichtausschluesseldatei:TEXT VAR dateiname:=astichwort;
+INT VAR dnr:=0;systemdboff;stopbeifalschemnamen(FALSE );dnr:=dateinr(
+dateiname);IF dnr>0THEN first(dnr);IF dbstatus=okTHEN auskunftCAT stop;
+anwendungsdatenkoppeln;dienaechstenanwendungsdatenlesenELSE meldunganhaengen(
+auskunft,"Keine Daten zu "+dateiname+" vorhanden")FI ELSE meldunganhaengen(
+auskunft,"Bestand "+dateiname+" ist nicht vorhanden")FI ;stopbeifalschemnamen
+(TRUE ).dienaechstenanwendungsdatenlesen:INT VAR a:=0;anzahl:=18;multisucc(
+dnr,anzahl);REP IF anzahl>0THEN WHILE a<anzahlREP multisucc;
+anwendungsdatenkoppeln;aINCR 1;PER ;a:=0;anzahl:=18;multisucc(dnr,anzahl)
+ELSE LEAVE dienaechstenanwendungsdatenlesenFI ;PER .anwendungsdatenkoppeln:
+auskunftCAT wert(dnr+1);auskunftCAT st;auskunftCAT wert(dnr+2);auskunftCAT 
+stop.schlussstern:auskunftCAT "*";auskunftCAT stop.wiederaufsetzen:
+reorganizescreen;setlasteditvalues;return(1).END PROC erteileauskunft;PROC 
+erteileauskunft:erteileauskunft(auskunftsnr)END PROC erteileauskunft;PROC 
+meldunganhaengen(TEXT VAR auskunft,TEXT CONST meldtext):auskunftCAT stop;
+auskunftCAT meldtext;auskunftCAT stop;.END PROC meldunganhaengen;PROC 
+editauskunft(INT CONST editnummer):systemdbon;erteileauskunftbody;systemdboff
+;wiederaufsetzen.erteileauskunftbody:auskunftholen;zeige.auskunftholen:
+WINDOW VAR w:=altesfenster;open(w);TEXT VAR auskunft:="";#INT VAR lu,ro;#
+cursor(1,2);holeauskunft(editnummer);IF dbstatus=okTHEN auskunft:=atext(
+editnummer)ELSE auskunft:=standardtextFI ;schlussstern.schlussstern:auskunft
+CAT "*";auskunftCAT stop.zeige:auskunfterteilung(auskunft,w,fuereditor).
+wiederaufsetzen:return(1).END PROC editauskunft;END PACKET 
+auskunftsfunktionen;
+
-- 
cgit v1.2.3