TO SYSDATE-SLASH-1.<br />MOVE TWA-IPL-DATE-DD<br />TO SYSDATE-DD.<br />MOVE SLASH<br />TO SYSDATE-SLASH-2.<br />MOVE TWA-IPL-DATE-CC<br />TO SYSDATE-CC.<br />MOVE TWA-IPL-DATE-YY<br />TO SYSDATE-YY.<br />MOVE 'XX:XX:XX'<br />TO PATTERN-MASK.<br />MOVE TWA-TIME<br />TO DE-EDITED-DATA.<br />PERFORM CB200-INSERT-PATTERN THRU CB299-EXIT.<br />MOVE SCREEN-FIELD<br />TO SYSTIME.<br />IF VAC01-EMPNUM NUMERIC<br />MOVE '999-99-9999'<br />TO PATTERN-MASK<br />MOVE SPACES<br />TO DE-EDITED-DATA<br />MOVE VAC01-EMPNUM<br />TO DE-EDITED-VALUE<br />PERFORM CB200-INSERT-PATTERN THRU CB299-EXIT<br />MOVE SCREEN-FIELD<br />TO SEMPNUM<br />MOVE VAC01-EMPNUM<br />TO SEMPNUM-N<br />ELSE<br />MOVE ALL '*' TO SEMPNUM<br />MOVE ZERO TO VAC01-EMPNUM<br />MOVE 91A TO ERROR-NUMBER<br />MOVE E TO SEMPNUME<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT.<br />MOVE SIF01-FIRST-NAME<br />TO SFIRST.<br />MOVE SIF01-LAST-NAME<br />TO SLAST-N.<br />MOVE VAC01-DATE-HIRED-MM<br />TO SDATE-H-MM.<br />MOVE SLASH<br />TO SDATE-H-SLASH-1.<br />MOVE VAC01-DATE-HIRED-DD<br />TO SDATE-H-DD.<br />MOVE SLASH<br />TO SDATE-H-SLASH-2.<br />MOVE VAC01-DATE-HIRED-YY<br />TO SDATE-H-YY.<br />COMPUTE SEARNED-N<br />EQUAL VAC01-EARNED-VACATION<br />MOVE SEARNED-N<br />TO SEARNED-ED.<br />COMPUTE STAKEN-N<br />EQUAL VAC01-TAKEN-VACATION<br />MOVE STAKEN-N<br />TO STAKEN-ED.<br />COMPUTE SEARN07-N<br />EQUAL VAC01-EARNED-SICK-DAYS<br />MOVE SEARN07-N<br />TO SEARN07-ED.<br />COMPUTE STAKE08-N<br />EQUAL VAC01-TAKEN-SICK-DAYS<br />MOVE STAKE08-N<br />TO STAKE08-ED.<br />COMPUTE SEARN09-N<br />EQUAL VAC01-EARNED-COMP-DAYS<br />MOVE SEARN09-N<br />TO SEARN09-ED.<br />COMPUTE STAKE10-N<br />EQUAL VAC01-TAKEN-COMP-DAYS<br />MOVE STAKE10-N<br />TO STAKE10-ED.<br />MOVE VAC01-COMMENT (001)<br />TO SCOMMEN (001).<br />MOVE VAC01-COMMENT (002)<br />TO SCOMMEN (002).<br />MOVE VAC01-COMMENT (003)<br />TO SCOMMEN (003).<br />* * * DEFAULT ALGORITHM %COMP STARTS HERE<br />MOVE PFKIL-SEG1<br />TO TWA-SERRMSG-MSG (1).<br />MOVE 'Press PF13 for Hardcopy'<br />TO TWA-SERRMSG-MSG (2).<br />MOVE 'Press PF16 to Copy field to buffer'<br />TO TWA-SERRMSG-MSG (3).<br />MOVE PFKIL-SEG4<br />TO TWA-SERRMSG-MSG (4).<br />MOVE 'Press PF2 for field-level HELP<br />TO TWA-SERRMSG-MSG (5).<br />* * * DEFAULT ALGORITHM %COMP ENDS HERE<br />BB299-EXIT.<br />EXIT.<br />```** <br />The BB200 routine moves all the database "source" fields from the record to the screen in preparation to be displayed. (cont.)<br />It is performed in the SEE and NXT Functions and in the New Transaction phase for the CHG and DEL Functions and when a (cont.)<br />duplicate record is found for the ADD Function. The coding in this routine is generated by the MMPCREAT process from (cont.)<br />the Developer's specifications in MSKDEF for "Source/Target" fields for the corresponding screen fields. Notice that (cont.)<br />dates are automatically "rearranged" and do not need to be in the same format (MMDDYY, YYMMDD, etc.) on the file as on (cont.)<br />the screen. Notice also that numeric fields are moved to the Cobol edit pattern fields having the -ED suffix. Also, (cont.)<br />notice that the Pattern Edited field is "moved" by performing the CB200 routine to insert the (cont.)<br />pattern.<br />The %COMP insertion point allows you to add your own Customization to move data to the screen for display. You can (cont.)<br />compute values or move literals or variables from the TWA, etc. You can perform the CB200 routine to insert a pattern, (cont.)<br />if you like. This allows you to dynamically establish the pattern. A handy example of how this might be used is in U.S. (cont.)<br />and foreign postal (zip) codes. You could set the pattern according to which country the address was in. Notice the (cont.)<br />Default logic for %COMP. The default code moves the "PF Key" message to the bottom of the screen. If you overrode the (cont.)<br />default in %PFKEYM you should probably also override this message.<br />| ```<br />**<br />****************************************************************<br />* BB400 *<br />* CHECK IF IT IS OK TO ALLOW RECORD TO BE DELETED *<br />****************************************************************<br />BB400-EDIT-FOR-DELETE.<br />* * * DEFAULT ALGORITHM %DELEDIT STARTS HERE<br />* * * NO STANDARD DEFAULT CODE FOR THIS INSERTION POINT<br />* * * DEFAULT ALGORITHM %DELEDIT ENDS HERE<br />* * * DATA RULE VAC01 RULDELT STARTS HERE<br />IF (NOT TWA-MSK-PF5-HIT)<br />IF VAC01-EMPNUM LESS THAN NINETEEN<br />MOVE '91J' TO ERROR-NUMBER<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT.<br />* * * DATA RULE VAC01 RULDELT ENDS HERE<br />BB499-EXIT.<br />EXIT.<br />```** <br />The BB400 routine is performed in the Continuation Mode for DEL Functions only. The insertion point %DELEDIT is here, (cont.)<br />it allows you to insert any type of logic you desire to validate that it is okay for this record to be deleted. The (cont.)<br />most common use is to read a subordinate file to see if there are records on it; ie: reading the Invoice file before (cont.)<br />deleting the Customer Master record.<br />This is also where the RULDELT logic (deletion rule) is inserted. This logic was stored in the dictionary by the (cont.)<br />database administrator and is "triggered" just before the specified element is to be deleted. Refer to the "Database (cont.)<br />Administration" chapter of this manual for more about *Business Rules* and *Deletion Rules.*<br />If you detect a condition which should prevent the deletion then you must set the FATAL-ERR flag to F, just as in all other edits.<br />| ```<br />**<br />****************************************************************<br />* BB500 *<br />* CHECK IF IT IS OK TO ALLOW RECORD TO BE ADDED/UPDATED *<br />****************************************************************<br />BB500-SCREEN-EDIT.<br />IF FATAL-ERR = E<br />MOVE F TO FATAL-ERR.<br />MOVE SYSTIME<br />TO SCREEN-FIELD<br />MOVE 'XX:XX:XX'<br />TO PATTERN-MASK<br />PERFORM CB500-EDIT-PATTERN THRU CB599-EXIT.<br />IF PATTERN-ERROR EQUAL E<br />MOVE E TO SYSTIMEE<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT<br />ELSE<br />MOVE SCREEN-FIELD<br />TO SYSTIME.<br />MOVE SEMPNUM<br />TO SCREEN-FIELD<br />MOVE '999-99-9999'<br />TO PATTERN-MASK<br />PERFORM CB500-EDIT-PATTERN THRU CB599-EXIT.<br />IF PATTERN-ERROR EQUAL E<br />MOVE E TO SEMPNUME<br />PERFORM CA100-LOAD-ERR-CODE-TBL THRU CA199-EXIT<br />ELSE<br />MOVE SCREEN-FIELD<br />TO SEMPNUM.<br />* * * DEFAULT ALGORITHM %EDIT STARTS HERE<br />* * * NO STANDARD DEFAULT CODE FOR THIS INSERTION POINT<br />* * * DEFAULT ALGORITHM %EDIT ENDS HERE<br />SKIP2<br />* * * DEFAULT ALGORITHM %EDIT2 STARTS HERE<br />* * * NO STANDARD DEFAULT CODE FOR THIS INSERTION POINT<br />* * * DEFAULT ALGORITHM %EDIT2 ENDS HERE<br />BB599-EXIT.<br />EXIT.<br />```** <br />The BB500 routine is performed to edit and validate screen data before any update or add to the database. In it you (cont.)<br />will notice some code has been inserted to edit the Pattern edited employee number and time-of-day fields. You can (cont.)<br />insert your own edit routines here using the %EDIT insertion point. The %EDIT2 insertion point is also found here. It (cont.)<br />is for edits which you wish to do only if all prior edits have been passed successfully. That allows you to bypass (cont.)<br />expensive, I/O intensive validations when errors have already been detected which will prevent the (cont.)<br />update.<br />| ```<br />**<br />****************************************************************<br />*************<br />* BB600<br />* MOVE APPROPRIATE DATA FIELDS FROM SCREEN TO RECORD<br />*<br />***************************************************<br />**************************<br />BB600-BUILD-REC.<br />IF NOT (ADD-FUNCTION)<br />GO TO BB610-MOVE-SCREEN-TO-DB.<br />* * * DEFAULT ALGORITHM %ADDINIT STARTS HERE<br />MOVE SPACES TO TWA-DB-DATA.<br />* * * DEFAULT ALGORITHM %ADDINIT ENDS HERE<br />BB610-MOVE-SCREEN-TO-DB.<br />MOVE '999-99-9999'<br />TO PATTERN-MASK.<br />MOVE SEMPNUM<br /><br />next: genmmp21.md.txt