What Pascal dialect is this? And what does it do?

[greyfairer]

I'm investigating somebody's mudball of mixed shell scripts, perl scripts, C code and a curious file called 'rekening.p'.

/*--------------------------------------------------------------------------------
File: rekening.p
Description: Bepalen 868-nummer dossier
History: nabn - 16/04/2004 - Citrix Implementatie (verwijderen van copy-fsk)
jedf - 17/02/2010 - F2009/030 (Aanpassingen voor DBC)
jedf - 20/12/2010 - F2010/024 (Noor)
Pefl - 22/02/2012 - F2012/002 Sequence aanpassing + controle
--------------------------------------------------------------------------------*/
/* Parameters */
DEFINE INPUT PARAMETER iHerv AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER cParam AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER cDosNr AS CHARACTER NO-UNDO.

/* Variabelen */
DEFINE VARIABLE iZetelNr AS INTEGER NO-UNDO INIT 0.
DEFINE VARIABLE dDosNr AS DECIMAL NO-UNDO.
DEFINE VARIABLE cBron AS CHARACTER NO-UNDO INIT "":u.
DEFINE VARIABLE cPrefix AS CHARACTER NO-UNDO INIT "":u.
DEFINE VARIABLE cMailParams AS CHARACTER NO-UNDO INIT "":u EXTENT 20.

DEFINE VARIABLE pvRestIn AS INTEGER NO-UNDO.
DEFINE VARIABLE pvSeqNaamTx AS CHARACTER NO-UNDO.

ASSIGN
cParam = REPLACE(cParam, ",":u, ";":u)
cParam = TRIM(cParam)
cBron = CAPS(ENTRY(1, cParam, ";":u))
NO-ERROR.

IF NUM-ENTRIES(cParam, ";":u) >= 2
THEN ASSIGN
cPrefix = CAPS(ENTRY(2, cParam, ";":u))
NO-ERROR.

/* Zet sequence naam voor controle. */
CASE cPrefix:
WHEN "934":u THEN ASSIGN pvSeqNaamTx = 'seq-banknr-noor':U.
WHEN "93489":u THEN ASSIGN pvSeqNaamTx = 'seq-banknr-auxircs':U.
OTHERWISE CASE cBron:
WHEN "DBC":u THEN .
OTHERWISE CASE iHerv:
WHEN 1 THEN ASSIGN pvSeqNaamTx = 'seq-banknr':U.
WHEN 2 THEN ASSIGN pvSeqNaamTx = 'seq-bankfinnr':U.
WHEN 3 THEN ASSIGN pvSeqNaamTx = 'seq-banknr':U.
WHEN 4 THEN ASSIGN pvSeqNaamTx = 'seq-banknr-vd':U.
WHEN 5 THEN ASSIGN pvSeqNaamTx = 'seq-banknr-cr':U.
WHEN 6 THEN ASSIGN pvSeqNaamTx = 'seq-cbk':U.
END CASE.
END CASE.
END CASE.

IF LENGTH(pvSeqNaamTx) > 0
THEN DO:
FIND FIRST fsk._sequence NO-LOCK
WHERE fsk._sequence._Seq-name = pvSeqNaamTx
NO-ERROR.
IF AVAILABLE fsk._sequence
AND fsk._sequence._Seq-Max <> ?
AND fsk._sequence._Cycle-OK = FALSE
THEN DO:
ASSIGN
pvRestIn = DYNAMIC-CURRENT-VALUE(pvSeqNaamTx, 'fsk':U)
. /* ff voor de debug. */
pvRestIn = (fsk._sequence._Seq-Max - DYNAMIC-CURRENT-VALUE(pvSeqNaamTx, 'fsk':U)) / fsk._sequence._Seq-Incr
.
IF pvRestIn < 500
THEN DO:
ASSIGN
cMailParams[1] = pvSeqNaamTx
cMailParams[2] = STRING(pvRestIn)
.
RUN programs/RootMail.p
(INPUT '868':U
,INPUT cMailParams
).


END.
END.
END.

CASE cPrefix:
WHEN "934":u THEN ASSIGN cDosNr = "9348":u + STRING(NEXT-VALUE(seq-banknr-noor , fsk), "999999":u).
WHEN '93489':U THEN ASSIGN cDosNr = '9348':U + STRING(NEXT-VALUE(seq-banknr-auxircs, fsk), '999999':U).
OTHERWISE CASE cBron:
WHEN "DBC":u THEN DO:
ASSIGN iZetelNr = INTEGER(ENTRY(2, cParam, ";":u)) NO-ERROR.

/* Waarschuwing sturen via e-mail dat 868-reeks bijna vol is */
IF CURRENT-VALUE(seq-banknr-dbc-fr, fsk) >= 49500 /* 868330 - 868334 = Franstalige klanten */
OR CURRENT-VALUE(seq-banknr-dbc-nl, fsk) >= 99500 THEN DO: /* 868335 - 868339 = Nederlandstalige klanten */
ASSIGN cMailParams[1] = (IF (iZetelNr = 0) THEN "330":u
ELSE "335":u).
RUN programs/RootMail.p(INPUT "868":u,
INPUT cMailParams).
END.

CASE iZetelNr:
WHEN 0 THEN ASSIGN cDosNr = "86833":u + STRING(NEXT-VALUE(seq-banknr-dbc-fr, fsk), "99999":u).
WHEN 1 THEN ASSIGN cDosNr = "86833":u + STRING(NEXT-VALUE(seq-banknr-dbc-nl, fsk), "99999":u).
END CASE.
END.
OTHERWISE CASE iHerv:
WHEN 1 THEN ASSIGN cDosNr = "8686":u + STRING(NEXT-VALUE(seq-banknr, fsk), "999999":u).
WHEN 2 THEN ASSIGN cDosNr = "8685":u + STRING(NEXT-VALUE(seq-bankfinnr, fsk), "999999":u).
WHEN 3 THEN ASSIGN cDosNr = "8686":u + STRING(NEXT-VALUE(seq-banknr, fsk), "999999":u).
WHEN 4 THEN ASSIGN cDosNr = "8688":u + STRING(NEXT-VALUE(seq-banknr-vd, fsk), "999999":u).
WHEN 5 THEN ASSIGN cDosNr = "8689":u + STRING(NEXT-VALUE(seq-banknr-cr, fsk), "999999":u).
WHEN 6 THEN ASSIGN cDosNr = "8687":u + STRING(NEXT-VALUE(seq-cbk, fsk), "999999":u).
END CASE.
END CASE.
END CASE.


/* Bepalen controlenummer */
ASSIGN dDosNr = DEC(cDosNr).
DO WHILE dDosNr > 2100000000:
ASSIGN dDosNr = dDosNr - 970000000.
END.
IF dDosNr MOD 97 = 0
THEN ASSIGN cDosNr = cDosNr + "97":u.
ELSE ASSIGN cDosNr = cDosNr + STRING(dDosNr MOD 97, "99":u).


Anybody got any idea if this is some sort of Pascal dialect? And for extra points, what does it do?

Thanks in advance.

Continue reading...