TO SCREEN-FIELD.<br />PERFORM CB600-STRIP-PATTERN THRU CB699-EXIT<br />MOVE DE-EDITED-VALUE<br />TO SEMPNUM-N<br />VAC01-EMPNUM.<br />MOVE SFIRST<br />TO SIF01-FIRST-NAME.<br />MOVE SLAST-N<br />TO SIF01-LAST-NAME.<br />MOVE SDATE-H-MM<br />TO VAC01-DATE-HIRED-MM.<br />MOVE SDATE-H-DD<br />TO VAC01-DATE-HIRED-DD.<br />MOVE SDATE-H-YY<br />TO VAC01-DATE-HIRED-YY.<br />COMPUTE VAC01-EARNED-VACATION<br />ROUNDED<br />EQUAL SEARNED-N.<br />COMPUTE VAC01-TAKEN-VACATION<br />ROUNDED<br />EQUAL STAKEN-N.<br />COMPUTE VAC01-EARNED-SICK-DAYS<br />ROUNDED<br />EQUAL SEARN07-N.<br />COMPUTE VAC01-TAKEN-SICK-DAYS<br />ROUNDED<br />EQUAL STAKE08-N.<br />COMPUTE VAC01-EARNED-COMP-DAYS<br />ROUNDED<br />EQUAL SEARN09-N.<br />COMPUTE VAC01-TAKEN-COMP-DAYS<br />ROUNDED<br />EQUAL STAK10-N.<br />MOVE SCOMMEN (001)<br />TO VAC01-COMMENT (001).<br />MOVE SCOMMEN (002)<br />TO VAC01-COMMENT (002).<br />MOVE SCOMMEN (003)<br />TO VAC01-COMMENT (003).<br />* * * DEFAULT ALGORITHM %CALC STARTS HERE<br />* * * NO STANDARD DEFAULT CODE FOR THIS INSERTION POINT<br />* * * DEFAULT ALGORITHM %CALC ENDS HERE<br />MOVE NORMALIZED-KEY<br />TO VAC01-KEY.<br />BB680-BUSINESS-RULES.<br />* * * DATA RULE VAC01 RULPROC STARTS HERE<br />MOVE 'SIF01' TO TWA-ELT-LIST.<br />MOVE REDKY TO TWA-DB-REQUEST.<br />MOVE 'SIFK1' TO TWA-DB-KEY-NAME.<br />MOVE ZERO TO SIF01-KEY-PREFIX.<br />MOVE VAC01-EMPNUM TO SIF01-EMPNUM.<br />MOVE SIF01-MASTER-KEY TO TWA-KEY-VALUE.<br />CALL 'MAGECSET' USING TWA-DB-AREA-A SIF01-ELEMENT.<br />PERFORM AA840-CALL-MAGEC-IO THRU AA899-EXIT.<br />IF TWA-DB-RETURN-CODE EQUAL SPACES<br />NEXT SENTENCE<br />ELSE<br />MOVE '9XX' TO ERROR-NUMBER<br />MOVE ATUADHNM TO SKEYA<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT.<br />* * * DATA RULE VAC01 RULPROC ENDS HERE<br />BB699-EXIT.<br />EXIT.<br />```** <br />The BB600 routine is performed for ADD and CHG Functions in the Continuation Mode and if no errors were found in either (cont.)<br />the Custom or the Automatic Editing. It moves the fields from the screen to the record. Notice that it uses the numeric (cont.)<br />fields with the -N suffix where appropriate and rearranges the dates if they are not in the same format on the file as (cont.)<br />on the screen. These moves were gnereated from the Developer's specifications in MSKDEF for database "Source/Target" (cont.)<br />fields for the screen fields.<br />The %ADDINIT insertion point allows you to override the Default logic for initializing the record for an ADD.<br />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.<br />Notice that the BB680 routine is where the Business Rules are inserted. The one in this example is the Rule associated (cont.)<br />with the VAC01 Element. It is executed after all MOVE's to the database fields have been completed. It references (cont.)<br />fields in the database Element copybook, rather than fields in the screen since this code might be inserted into many (cont.)<br />applications. If it sets the ERROR-FOUND condition (by performing the CA100 routine), the update or add operation will (cont.)<br />not carry through the database update, it will issue an error message instead.<br />| ```<br />**<br />****************************************************************<br />* BB800 *<br />* SEND MASK RETRIEVAL ERROR MESSAGE TO OPERATOR AT *<br />* TERMINAL AND TO COMMAND TERMINAL. *<br />****************************************************************<br />BB800-MSK-ERR-MSG.<br />MOVE FTH-FUNCT TO TWA-NONTP-REQUEST.<br />MOVE CLEAR-FUNCT TO MSK652-SFUNCT.<br />MOVE MSG-LIT TO TWA-TP-OP.<br />MOVE MSK-ERR-MSG TO TWA-MSK-DETAIL.<br />BB899-EXIT.<br />EXIT.<br />```** <br />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.<br />| ```<br />**<br />****************************************************************<br />* CA100 *<br />* THIS ROUTINE ADDS ERROR CODES TO THE ERROR CODE TABLE, *<br />* ELIMINATING DUPLICATE ENTRIES AND ALLOWING ONLY A MAXIMUM*<br />* OF SIX ENTRIES. *<br />****************************************************************<br />CA100-LOAD-ERR-CODE-TBL.<br />MOVE F TO FATAL-ERR.<br />PERFORM CA200-SERIAL-SEARCH<br />VARYING ERR-SUB FROM ONE BY ONE<br />UNTIL (TWA-ERR (ERR-SUB) = SPACE OR ERROR-NUMBER)<br />OR ERR-SUB GREATER SIX.<br />IF ERR-SUB GREATER SIX<br />GO TO CA199-EXIT.<br />MOVE ERROR-NUMBER TO TWA-ERR (ERR-SUB).<br />CA199-EXIT.<br />EXIT.<br />```** <br />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".<br />To use this routine you would code:<br />MOVE '...' TO ERROR-NUMBER<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT<br />| ```<br />**<br />****************************************************************<br />* CA200 *<br />* THIS IS A DUMMY ROUTINE PERFORMED IN TABLE *<br />* SEARCHING TO INCREMENT A SUBSCRIPT. *<br />****************************************************************<br />CA200-SERIAL-SEARCH.<br />EXIT.<br />```** <br />The CA200 routine is a dummy EXIT which is used by many other routines to vary subscripts, as:<br />PERFORM CA200-SERIAL-SEARCH<br />VARYING SUB FROM ONE BY ONE<br />UNTIL (SUB GREATER THAN TEN)<br />OR (WIDGET (SUB) = 'X').<br />| ```<br />**<br />*****************************************************************<br />* THE FOLLOWING PARAGRAPHS CA300- THRU CA319- WILL TALLY THE *<br />* COUNT OF ALL OCCURRENCES OF ANY NON-BLANK CHARACTER IN A FIELD.*<br />* THE FIELD MUST BE IN A WORK-AREA CALLED 'INSP-LINE'. *<br />* THE CHARACTER TO BE TALLIED MUST BE IN A WORK FIELD CALLED *<br />* 'INSP-TEST'. *<br />* THE COUNT WILL BE RETURNED IN A WORK FIELD CALLED *<br />* 'NR-CHARACTERS'. *<br />*****************************************************************<br />SKIP1<br />CA300-INSPECT-TALLYING-ALL-CHR.<br />MOVE ZERO TO NR-CHARACTERS.<br />PERFORM CA200-SERIAL-SEARCH<br />VARYING INSP-SUB FROM +80 BY -1<br />UNTIL INSP-CHAR (INSP-SUB) NOT EQUAL SPACE.<br />PERFORM CA310-TALLY-CHARS THRU CA319-EXIT<br />VARYING INSP-SUB FROM INSP-SUB BY -1<br />UNTIL INSP-SUB LESS THAN +1.<br />CA309-EXIT.<br />EXIT.<br />CA310-TALLY-CHARS.<br />IF INSP-CHAR (INSP-SUB) EQUAL INSP-TEST<br />ADD +1 TO NR-CHARACTERS.<br />CA319-EXIT.<br />EXIT.<br />```** <br />The CA300 routine is performed from the Normalize Key logic and may be used by you in your routines, as well. It does (cont.)<br />the job of an EXAMINE or INSPECT verb. Since MAGEC programs are transportable to many environments, and since those (cont.)<br />verbs are not always supported on various versions of the Cobol compiler, we have provided this (cont.)<br />routine.<br />**<br />| ```<br />****************************************************************<br />* CA400 *<br />* THIS ROUTINE ADDS WARNING MESSAGE NUMBERS TO THE ERROR *<br />* CODE TABLE *<br />****************************************************************<br />CA400-LOAD-WARNING-TO-TBL.<br />IF FATAL-ERR LESS THAN E<br />MOVE W TO FATAL-ERR.<br />PERFORM CA200-SERIAL-SEARCH<br />VARYING ERR-SUB FROM ONE BY ONE<br />UNTIL (TWA-ERR (ERR-SUB) = SPACE OR ERROR-NUMBER)<br />OR ERR-SUB GREATER SIX.<br />IF ERR-SUB GREATER SIX<br />GO TO CA499-EXIT.<br />MOVE ERROR-NUMBER TO TWA-ERR (ERR-SUB).<br />CA499-EXIT.<br />EXIT.<br />```** <br />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.)<br />indicates a "warning level error" which will not prevent file updating but will issue an error message to the screen in (cont.)<br />SERRMSG.<br />| ```<br />**<br />****************************************************************<br />* CA500 *<br />* THIS MOVES THE KEY VALUE TO SKEY WHEN TRANSFERRING FROM *<br />* A BROWSE TO A SEE OR CHG FUNCTION VIA CURSOR-SELECTION. *<br />* IT ALSO FORMATS THE KEY FOR THE NEXT FUNCTION *<br />****************************************************************<br />CA500-MOVE-SKEY.<br />MOVE SPACES TO NORMALIZED-KEY.<br />MOVE ONE TO NK-SUB.<br />PERFORM CA560-MOVE THRU CA569-EXIT<br />VARYING TK-SUB FROM ONE BY ONE<br />UNTIL TK-SUB GREATER THAN THIRTY-ONE.<br /><br />next: genmmp22.md.txt