The %CALC insertion point allows you to override the Default which moves NORMALIZED-KEY to the record key field and to add your own calculations or MOVEs to build the record fields.
Notice that the BB680 routine is where the Business Rules are inserted. The one in this example is the Rule associated (cont.)
with the VAC01 Element. It is executed after all MOVE's to the database fields have been completed. It references (cont.)
fields in the database Element copybook, rather than fields in the screen since this code might be inserted into many (cont.)
applications. If it sets the ERROR-FOUND condition (by performing the CA100 routine), the update or add operation will (cont.)
not carry through the database update, it will issue an error message instead.
```
****************************************************************
* BB800 *
* SEND MASK RETRIEVAL ERROR MESSAGE TO OPERATOR AT *
* TERMINAL AND TO COMMAND TERMINAL. *
****************************************************************
BB800-MSK-ERR-MSG.
MOVE FTH-FUNCT TO TWA-NONTP-REQUEST.
MOVE CLEAR-FUNCT TO MSK652-SFUNCT.
MOVE MSG-LIT TO TWA-TP-OP.
MOVE MSK-ERR-MSG TO TWA-MSK-DETAIL.
BB899-EXIT.
EXIT.
```
The BB800 routine is performed when the MMP gets a bad return code trying to read the MSK initialization record. It issues an error message via FTH-FUNCT to the Clear-Screen Function.
```
****************************************************************
* CA100 *
* THIS ROUTINE ADDS ERROR CODES TO THE ERROR CODE TABLE, *
* ELIMINATING DUPLICATE ENTRIES AND ALLOWING ONLY A MAXIMUM*
* OF SIX ENTRIES. *
****************************************************************
CA100-LOAD-ERR-CODE-TBL.
MOVE F TO FATAL-ERR.
PERFORM CA200-SERIAL-SEARCH
VARYING ERR-SUB FROM ONE BY ONE
UNTIL (TWA-ERR (ERR-SUB) = SPACE OR ERROR-NUMBER)
OR ERR-SUB GREATER SIX.
IF ERR-SUB GREATER SIX
GO TO CA199-EXIT.
MOVE ERROR-NUMBER TO TWA-ERR (ERR-SUB).
CA199-EXIT.
EXIT.
```
The CA100 routine is performed by your Customization Editing logic to set the ERROR-NUMBER into TWA-ERR-CODES and to set the FATAL-ERR flag to F (ERROR-FOUND) indicating a "fatal error".
To use this routine you would code:
MOVE '...' TO ERROR-NUMBER
PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT
```
****************************************************************
* CA200 *
* THIS IS A DUMMY ROUTINE PERFORMED IN TABLE *
* SEARCHING TO INCREMENT A SUBSCRIPT. *
****************************************************************
CA200-SERIAL-SEARCH.
EXIT.
```
The CA200 routine is a dummy EXIT which is used by many other routines to vary subscripts, as:
```
PERFORM CA200-SERIAL-SEARCH
```
```
VARYING SUB FROM ONE BY ONE
```
```
UNTIL (SUB GREATER THAN TEN)
```
```
OR (WIDGET (SUB) = 'X').
```
```
*****************************************************************
* THE FOLLOWING PARAGRAPHS CA300- THRU CA319- WILL TALLY THE *
* COUNT OF ALL OCCURRENCES OF ANY NON-BLANK CHARACTER IN A FIELD.*
* THE FIELD MUST BE IN A WORK-AREA CALLED 'INSP-LINE'. *
* THE CHARACTER TO BE TALLIED MUST BE IN A WORK FIELD CALLED *
* 'INSP-TEST'. *
* THE COUNT WILL BE RETURNED IN A WORK FIELD CALLED *
* 'NR-CHARACTERS'. *
*****************************************************************
SKIP1
CA300-INSPECT-TALLYING-ALL-CHR.
MOVE ZERO TO NR-CHARACTERS.
PERFORM CA200-SERIAL-SEARCH
VARYING INSP-SUB FROM +80 BY -1
UNTIL INSP-CHAR (INSP-SUB) NOT EQUAL SPACE.
PERFORM CA310-TALLY-CHARS THRU CA319-EXIT
VARYING INSP-SUB FROM INSP-SUB BY -1
UNTIL INSP-SUB LESS THAN +1.
CA309-EXIT.
EXIT.
CA310-TALLY-CHARS.
IF INSP-CHAR (INSP-SUB) EQUAL INSP-TEST
ADD +1 TO NR-CHARACTERS.
CA319-EXIT.
EXIT.
```
The CA300 routine is performed from the Normalize Key logic and may be used by you in your routines, as well. It does (cont.)
the job of an EXAMINE or INSPECT verb. Since MAGEC programs are transportable to many environments, and since those (cont.)
verbs are not always supported on various versions of the Cobol compiler, we have provided this (cont.)
routine.
**
```
****************************************************************
* CA400 *
* THIS ROUTINE ADDS WARNING MESSAGE NUMBERS TO THE ERROR *
* CODE TABLE *
****************************************************************
CA400-LOAD-WARNING-TO-TBL.
IF FATAL-ERR LESS THAN E
MOVE W TO FATAL-ERR.
PERFORM CA200-SERIAL-SEARCH
VARYING ERR-SUB FROM ONE BY ONE
UNTIL (TWA-ERR (ERR-SUB) = SPACE OR ERROR-NUMBER)
OR ERR-SUB GREATER SIX.
IF ERR-SUB GREATER SIX
GO TO CA499-EXIT.
MOVE ERROR-NUMBER TO TWA-ERR (ERR-SUB).
CA499-EXIT.
EXIT.
```
The CA400 routine is used just like the CA100 routine above but it sets the FATAL-ERR flag to W instead of F. W (cont.)
indicates a "warning level error" which will not prevent file updating but will issue an error message to the screen in (cont.)
SERRMSG.
```
****************************************************************
* CA500 *
* THIS MOVES THE KEY VALUE TO SKEY WHEN TRANSFERRING FROM *
* A BROWSE TO A SEE OR CHG FUNCTION VIA CURSOR-SELECTION. *
* IT ALSO FORMATS THE KEY FOR THE NEXT FUNCTION *
****************************************************************
CA500-MOVE-SKEY.
MOVE SPACES TO NORMALIZED-KEY.
MOVE ONE TO NK-SUB.
PERFORM CA560-MOVE THRU CA569-EXIT
VARYING TK-SUB FROM ONE BY ONE
UNTIL TK-SUB GREATER THAN THIRTY-ONE.
IF NK-BYTE (1) EQUAL SPACE
MOVE NK-2-END TO NORMALIZED-KEY.
MOVE NORMALIZED-KEY TO MSK652-SKEY.
GO TO CA599-EXIT.
CA560-MOVE.
ADD ONE TO NK-SUB.
MOVE TK-BYTE (TK-SUB) TO NK-BYTE (NK-SUB)
TEST-KEY-LOWER-CASE.
IF (TK-LOW-CASE)
MOVE DOUBLE-QUOTE TO NK-BYTE (ONE).
IF ((TK-BYTE (TK-SUB) NOT LESS THAN LOWER-CASE-A)
AND (TK-BYTE (TK-SUB) NOT GREATER THAN LOWER-CASE-Z))
MOVE DOUBLE-QUOTE TO NK-BYTE (ONE).
CA569-EXIT.
EXIT.
CA599-EXIT.
EXIT.
```
The CA500 routine is performed when the Browse Functions are transferring to a SEE or CHG Function because the Operator (cont.)
has Cursor Selected an item. This routine converts the record's Master Key value into the screen format with slashes ( (cont.)
/ ) separating component fields.
```
****************************************************************
* CA700 - CA800 - CA900 *
* THIS ROUTINE IS USED TO FORMAT DATA INTO THE SCREEN *
* IMAGE (PRINT-LINE) FOR BROWSE FUNCTIONS. *
* *
****************************************************************
CA700-MOVE-TO-WORK-AREA.
ADD ONE TO SCAN-CTR
CUMULATIVE-SCAN-CTR.
MOVE P TO PROCESS-INDICATOR.
MOVE ALL SPACES TO WS-ITEM--R.
PERFORM BA106-BLANK-FIL THRU BA107-EXIT.
IF LIN-CTR LESS THAN ONE
MOVE SPACES TO TWA-SAVE-MST-KEYS-AREA.
* * * DEFAULT ALGORITHM %SELECT STARTS HERE
* * * NO STANDARD DEFAULT CODE FOR THIS INSERTION POINT
* * * DEFAULT ALGORITHM %SELECT ENDS HERE
IF (BYPASS-INDICATED)
GO TO CA790-END.
IF (END-OF-LIST-INDICATED)
MOVE NOT-FOUND-LIT TO TWA-DB-RETURN-CODE
GO TO CA790-END.
ADD ONE TO LIN-CTR.
* BUILD WS-ITEM FROM RECORD
MOVE VAC01-KEY
TO NORMALIZED-KEY.
IF VAC01-EMPNUM NUMERIC
MOVE '999-99-9999'
TO PATTERN-MASK
MOVE SPACES
TO DE-EDITED-DATA
MOVE VAC01-EMPNUM
TO DE-EDITED-VALUE
PERFORM CB200-INSERT-PATTERN THRU CB299-EXIT
MOVE SCREEN-FIELD
TO WS-SEMPNUM.
MOVE SIF01-FIRST-NAME
TO WS-SFIRST.
MOVE SIF01-LAST-NAME
TO WS-SLAST-N.
MOVE VAC01-DATE-HIRED-MM
TO WS-SDATE-H-MM.
MOVE SLASH
TO WS-SDATE-H-SLASH-1.
MOVE VAC01-DATE-HIRED-DD

Next: <a href="https://magec.com/DOC/markdown/genmmp20.md.txt">https://magec.com/DOC/markdown/genmmp20.md.txt</a>