I'm closing the temp file before doing the pc_print_file. The program actually exits with EXIT PROGRAM after that and then is re called with a dialog system callout for the second print i.e. the call to the program just handles one print request then exits. Second time around windows says the file is in use if i try to delete it in windows explorer, and opening it in cobol for output gets the RTS 199 error. Here's the program.... IDENTIFICATION DIVISION. PROGRAM-ID. LASERPAG. *REMARKS. * ----------------------------------------------- * COBOL Laser Page Plan Program * ----------------------------------------------- * Prints page plans on HPLaserJet+ printer. * Any number of pages can be output per sheet. * ----------------------------------------------- * Written by Linden Rowland from FEB 1991 * ----------------------------------------------- ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. select report1 assign to report1-filename organization is line sequential file status is WS-ERR-STAT. select planner-pag-file assign to planner-pag-file-name organization is sequential access mode is sequential FILE STATUS IS WS-ERR-STAT. select planner-ads-file assign to planner-ads-file-name organization is sequential access mode is sequential FILE STATUS IS WS-ERR-STAT. DATA DIVISION. FILE SECTION. FD REPORT1. 01 LASER-REC PIC X(70). fd planner-pag-file. 01 planner-pag-rec pic x(140). fd planner-ads-file. 01 planner-ads-rec pic x(395). WORKING-STORAGE SECTION. COPY CBLIB\ERROR.S3. 01 WS-FILE-ERROR. 03 WS-ERR-KEY PIC X(30). 03 WS-ERR-STAT. 05 WS-ERR-STAT1 PIC X. 05 WS-ERR-STAT2 PIC X. 03 WS-ERR-STAT-RED REDEFINES WS-ERR-STAT PIC 9(4) COMP. 03 WS-ERR-FILE PIC X(20). 03 WS-ERR-MSG PIC X(40). 03 WS-ERR-LNO PIC 99. 03 WS-ERR-LEVEL PIC X(30). 03 WS-ERR-LOC PIC X(8). 03 WS-ERR-BTNO PIC 99. 03 WS-CONV-ERR PIC 999. * KEY - Actual value of key field * STAT - Cobol file status return code * FILE - Physical pathname * MSG - Free format message area - updated by declaratives * LNO - 1 - Warning , 2 - Serious , 3 - Contact NSL * LEVEL - Contains Level description * LOC - Contains a unique program reference for error detection. * BTNO - BTRIEVE Return Status 01 Display-Error. 03 Display-Error-No PIC 9(4) comp-5. 03 Display-Details-1 PIC 9(4) comp-5. 03 Display-Details-2 PIC 9(4) comp-5. COPY CBLIB\FUNCKEYS.S3. COPY CBLIB\FDPLAN.W3. COPY CBLIB\FDPAGE.W3. 01 selected-issue. 03 selected-paper pic xx VALUE SPACES. 03 selected-yy pic xx VALUE SPACES. 03 selected-mm pic xx VALUE SPACES. 03 selected-dd pic xx VALUE SPACES. 03 selected-pages pic 999 VALUE ZERO. 01 any-key pic x VALUE SPACE. *********** A4 *********** 01 A4-WIDTH PIC 9(5) VALUE 2100. 01 A4-HEIGHT PIC 9(5) VALUE 3025. *********** A3 *********** 01 A3-WIDTH PIC 9(5) VALUE 3175. 01 A3-HEIGHT PIC 9(5) VALUE 4400. 01 LASER-orig-page-WIDTH PIC 9(5) VALUE 3175. 01 LASER-orig-page-HEIGHT PIC 9(5) VALUE 4500. 01 laser-orig-X0-location pic 9(5) value 150. 01 laser-orig-Y0-location pic 9(5) value 75. 01 SAVE-X0-location pic 9(5) VALUE ZERO. 01 THE-RESULT PIC 999 VALUE ZERO. 01 THE-REMAINDER PIC 999 VALUE ZERO. 01 AVAILABLE-CHARS PIC 999 VALUE ZERO. 01 gap-counter pic 99. 01 LASER-PAGE-HEIGHT PIC 9(5) VALUE ZERO. 01 LASER-PAGE-WIDTH PIC 9(5) VALUE ZERO. 01 REQUIRED-PAGE PIC 9(3) VALUE ZERO. 01 page-from PIC 9(3) VALUE ZERO. 01 page-to PIC 9(3) VALUE ZERO. 01 pages-per-sheet PIC 9(3) VALUE ZERO. 01 pages-this-sheet-so-far PIC 9(3) VALUE ZERO. 01 temp-height PIC 99.9. 01 PRINT-AD-DESCRIPTION-FLAG PIC X VALUE "N". 01 pages-per-row-n-col pic 999. 01 laser-dots-per-mm pic s9(5)V99 VALUE ZERO. 01 laser-dots-per-col pic s9(5)V99 VALUE ZERO. 01 laser-dots-per-gap pic s9(5)V99 VALUE ZERO. 01 laser-X0-location pic s9(5) VALUE ZERO. 01 laser-Y0-location pic s9(5) VALUE ZERO. 01 laser-a3-request. 03 FILLER PIC X(7) VALUE spaces. 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X VALUE "E". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXXX VALUE "&l27A". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "&l1O". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "(10U". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X(16) VALUE "(s0p10h12v0s0b3T". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "(10U". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "&l8C". 01 laser-a4-request. 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X VALUE "E". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXXX VALUE "&l26A". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "&l1O". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "(10U". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X(20) VALUE "(s0p16.66h8.5v0s0b0T". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "(10U". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X(7) VALUE "&l5.25C". 01 laser-prt-ad-request-bit1. 03 filler pic x value x"1b". 03 filler pic xx value "&a". 03 laser-prt-ad-x pic 99999. 03 filler pic x value "h". 03 laser-prt-ad-y pic 99999. 03 filler pic x value "V". 03 filler pic x value x"1b". 03 filler pic xx value "*c". 03 laser-prt-ad-width pic 99999. 03 filler pic x value "a". 03 laser-prt-ad-height pic 99999. 03 filler pic X value "b". 03 laser-prt-ad-pattern pic 99 value 5. 03 filler pic xxx value "g2P". 03 filler pic x value x"1b". 03 filler pic xx value "&a". 03 laser-prt-top-x pic 99999. 03 filler pic x value "h". 03 laser-prt-top-y pic 99999. 03 filler pic x value "V". 03 filler pic x value x"1b". 03 filler pic xx value "*c". 03 laser-prt-top-width pic 99999. 03 filler pic x value "a". 03 laser-prt-top-height pic 99999. 03 filler pic XXXX value "b03g". 03 laser-prt-top-type pic X value "0". 03 filler pic X value "P". 01 laser-prt-ad-request-bit2. 03 filler pic x value x"1b". 03 filler pic xx value "&a". 03 laser-prt-left-x pic 99999. 03 filler pic x value "h". 03 laser-prt-left-y pic 99999. 03 filler pic x value "V". 03 filler pic x value x"1b". 03 filler pic xx value "*c". 03 laser-prt-left-width pic 99999. 03 filler pic x value "a". 03 laser-prt-left-height pic 99999. 03 filler pic X value "b". 03 laser-prt-left-pattern pic 99 value 3. 03 filler pic X value "g". 03 laser-prt-left-type pic X value "0". 03 filler pic X value "P". 01 laser-prt-ad-request-bit3. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-bottom-x pic 99999. 05 filler pic x value "h". 05 laser-prt-bottom-y pic 99999. 05 filler pic x value "V". 05 filler pic x value x"1b". 05 filler pic xx value "*c". 05 laser-prt-bottom-width pic 99999. 05 filler pic x value "a". 05 laser-prt-bottom-height pic 99999. 05 filler pic XXXX value "b03g". 05 laser-prt-bottom-type pic X value "0". 05 filler pic X value "P". 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-right-x pic 99999. 05 filler pic x value "h". 05 laser-prt-right-y pic 99999. 05 filler pic x value "V". 05 filler pic x value x"1b". 05 filler pic xx value "*c". 05 laser-prt-right-width pic 99999. 05 filler pic x value "a". 05 laser-prt-right-height pic 99999. 05 filler pic XXXX value "b03g". 05 laser-prt-right-type pic X value "0". 05 filler pic X value "P". 01 laser-prt-PAGE-NO. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-PAGE-NO-X pic 99999. 05 filler pic x value "h". 05 laser-prt-PAGE-NO-Y pic 99999. 05 filler pic x value "V". 05 FILLER PIC XXXXX VALUE "Page:". 05 LASER-PRT-PAGE-NUMBER PIC ZZ9. 01 laser-prt-ISSUE. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-ISSUE-X pic 99999 value 180. 05 filler pic x value "h". 05 laser-prt-ISSUE-Y pic 99999 value 95. 05 filler pic x value "V". 05 FILLER PIC X(7) value "Paper:". 05 LASER-PRT-Paper-code PIC xx. 05 FILLER PIC X(9) value " - Date:". 05 LASER-PRT-dd PIC xx. 05 FILLER pic x value "/". 05 LASER-PRT-mm PIC xx. 05 FILLER pic x value "/". 05 LASER-PRT-yy PIC x(6). 05 FILLER PIC X(7) value "As at: ". 05 LASER-PRT-sys-date PIC x(9). 05 LASER-PRT-sys-time PIC x(5). 01 LASER-PRT-AD-descrip-urn. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-ad-x2 pic 99999. 05 filler pic x value "h". 05 laser-prt-urn-y pic 99999. 05 filler pic xx value "V ". 05 laser-prt-urn pic x(8). 01 LASER-PRT-AD-descrip-name. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-ad-x3 pic 99999. 05 filler pic x value "h". 05 laser-prt-ad-name-y pic 99999. 05 filler pic x value "V". 05 laser-prt-ad-name pic bx(20). 01 LASER-PRT-AD-descrip-size. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-ad-x4 pic 99999. 05 filler pic x value "h". 05 laser-prt-size-y pic 99999. 05 filler pic x value "V". 05 laser-prt-ad-the-size pic x(8). 01 LASER-PRT-AD-descrip-catchline. 05 filler pic x value x"1b". 05 filler pic xx value "&a". 05 laser-prt-ad-x5 pic 99999. 05 filler pic x value "h". 05 laser-prt-catchline-y pic 99999. 05 filler pic x value "V". 05 LASER-PRT-catchline pic bx(32). 01 LASER-PRT-ROW-no-REQUEST. 03 filler pic x value x"1b". 03 filler pic xx value "&a". 03 laser-prt-ROW-no-x pic 99999. 03 filler pic x value "h". 03 laser-prt-ROW-no-y pic 99999. 03 filler pic x value "V". 03 LASER-PRT-ROW-no pic 99. 03 filler pic x value "-". 01 LASER-LINEPTR-FONT-REQUEST. 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC XXXX VALUE "&l0O". 03 FILLER PIC X VALUE X"1B". 03 FILLER PIC X(20) VALUE "(s0p16.66h8.5v0s0b0T". 01 WS-DATE. 02 WS-DATE-Y PIC XX VALUE SPACES. 02 WS-DATE-M PIC XX VALUE SPACES. 02 WS-DATE-D PIC XX VALUE SPACES. 01 WS-CHANGED-DATE. 02 WS-DAY PIC XX VALUE SPACES. 02 FILLER-1 PIC X VALUE "/". 02 WS-MONTH PIC XX VALUE SPACES. 02 FILLER-2 PIC X VALUE "/". 02 WS-YEAR PIC XX VALUE SPACES. 01 WS-TIME. 02 WS-TIME-H PIC XX VALUE SPACES. 02 WS-TIME-M PIC XX VALUE SPACES. 01 WS-CHANGED-TIME. 02 WS-hours PIC XX VALUE SPACES. 02 FILLER-3 PIC X VALUE ":". 02 WS-minutes PIC XX VALUE SPACES. 01 PAP PIC XX VALUE SPACES. 01 planner-pag-file-name pic x(17). 01 planner-ads-file-name pic x(17). 01 filename-param. 03 filename-len pic x(2) comp-5 value 256. 03 report1-filename pic x(256) value "printfile.txt". 01 document-title. 03 document-name-len pic x(2) comp-5 value 7. 03 document-name pic x(7) value "PgPrint". 01 flags pic x(4) comp-5 value 32. 01 the-window-handle pic x(4) comp-5 value 0. 01 printer-status pic x(4) comp-5 value zeroes. COPY CBLIB\START1.L3. linkage section. COPY "v8Diary.CPB". PROCEDURE DIVISION USING data-block. string dialog-local-folder '\temp_laserpag' delimited by ' ' into report1-filename. ACCEPT WS-DATE FROM DATE. ACCEPT WS-TIME FROM TIME. MOVE WS-DATE-Y TO WS-YEAR. MOVE WS-DATE-M TO WS-MONTH. MOVE WS-DATE-D TO WS-DAY. move ws-time-h to ws-hours. move ws-time-m to ws-minutes. MOVE ws-changed-date to laser-prt-sys-date. MOVE ws-changed-time to laser-prt-sys-time. move ef-page-from to page-from. move ef-page-to to page-to. if ef-page-from selected-issue-line(20:3) move "'From page' higher than number of pages in paper!" to error-msg-field move "from" to error-object go to return-to-user end-if. if ef-page-to selected-issue-line(20:3) move "'To page' higher than number of pages in paper!" to error-msg-field move "to" to error-object go to return-to-user end-if. if ef-page-to ef-page-from move "'To page' is lower than 'from page'." to error-msg-field move "to" to error-object go to return-to-user end-if. CALL 'START1' USING START-PARMS. CANCEL 'START1'. STRING 'DATA\' SELECTED-issue-line(1:2) SELECTED-issue-line(10:2) SELECTED-issue-line(7:2) SELECTED-issue-line(4:2) '.ADS' DELIMITED BY SIZE INTO PLANNER-ads-FILE-NAME. open input planner-ads-file. if ws-err-stat not = '00' move "Can't access files, they may in use by Ad. Plan?" to error-msg-field move "issue" to error-object go to return-to-user end-if. STRING 'DATA\' SELECTED-issue-line(1:2) SELECTED-issue-line(10:2) SELECTED-issue-line(7:2) SELECTED-issue-line(4:2) '.PAG' DELIMITED BY SIZE INTO PLANNER-pag-FILE-NAME. open input planner-pag-file. if ws-err-stat not = '00' move "Can't access files, they may in use by Ad. Plan?" to error-msg-field move "issue" to error-object go to return-to-user end-if. move SELECTED-issue-line(1:2) to laser-prt-paper-code. move SELECTED-issue-line(10:2) to laser-prt-yy. move SELECTED-issue-line(7:2) to laser-prt-mm. move SELECTED-issue-line(4:2) to laser-prt-dd. move function numval (selected-pages-line) to PAGES-PER-SHEET. if laserpag-ad-descrips-flag = 1 move 'Y' to PRINT-AD-DESCRIPTION-FLAG else move 'N' to PRINT-AD-DESCRIPTION-FLAG end-if. OPEN OUTPUT REPORT1. * assuming A4 for now... * assuming A4 for now... * assuming A4 for now... * assuming A4 for now... * IF START-ALWAYS-A4 MOVE 'A4' TO PAP * ELSE * CALL "WHAT_PAP" USING PAP CANCEL "WHAT_PAP" * END-IF. if pap = 'A4' write laser-rec from laser-a4-request MOVE A4-WIDTH TO LASER-orig-page-WIDTH MOVE A4-HEIGHT TO LASER-orig-page-HEIGHT else write laser-rec from laser-a3-request MOVE A3-WIDTH TO LASER-orig-page-WIDTH MOVE A3-HEIGHT TO LASER-orig-page-HEIGHT end-if. IF PAGES-PER-SHEET = 1 MOVE 1 TO pages-per-row-n-col ELSE compute pages-per-row-n-col = PAGES-PER-SHEET ** 0.5 END-IF. if pages-per-row-n-col ** 2 not = PAGES-PER-SHEET add 1 to pages-per-row-n-col end-if. if pages-per-row-n-col 1 compute laser-page-width = laser-orig-page-width / pages-per-row-n-col * 0.9 compute laser-page-height = laser-orig-page-height / pages-per-row-n-col * 0.9 else move laser-orig-page-width to laser-page-width move laser-orig-page-height to laser-page-height end-if. MOVE LASER-LINEPTR-FONT-REQUEST TO laser-rec. PERFORM WRITE-laser-rec. perform with test before UNTIL page-from page-to move 0 to pages-this-sheet-so-far move laser-orig-y0-location to laser-y0-location perform with test before UNTIL page-from page-to OR pages-this-sheet-so-far = pages-per-sheet move laser-orig-x0-location to laser-x0-location perform pages-per-row-n-col TIMES if page-from NOT page-to and pages-this-sheet-so-far pages-per-sheet MOVE LASER-X0-LOCATION TO SAVE-X0-LOCATION IF PAGES-PER-ROW-N-COL 2 DIVIDE 2 INTO PAGE-FROM GIVING THE-RESULT REMAINDER THE-REMAINDER IF THE-REMAINDER = ZERO COMPUTE LASER-X0-LOCATION = LASER-X0-LOCATION + (LASER-PAGE-WIDTH / 10) END-IF END-IF perform laser-prt-a-page add 1 to page-from, pages-this-sheet-so-far compute laser-x0-location = SAVE-x0-location + (laser-page-width * 1.11111111) end-if end-perform compute laser-y0-location = laser-y0-location + (laser-page-height * 1.11111111) end-perform MOVE laser-prt-issue TO laser-rec PERFORM WRITE-laser-rec MOVE X"0C" TO laser-rec PERFORM WRITE-laser-rec end-perform. close planner-pag-file, planner-ads-file. CLOSE REPORT1. CALL "PC_PRINT_FILE" using filename-param document-title by value flags by value the-window-handle returning printer-status end-call. return-to-user. EXIT PROGRAM. STOP RUN. LASER-PRT-A-PAGE SECTION. move page-from to required-page. close planner-pag-file. open input planner-pag-file. PERFORM UNTIL ( ws-err-stat not = '00' ) OR ( ws-page-TRUE-page-no = REQUIRED-PAGE ) read planner-pag-file next into ws-page-record NOT AT END if ws-page-int-page-no = zeroes or spaces read planner-pag-file next into ws-page-record end-read end-if end-read END-PERFORM. IF ws-err-stat NOT = '00' GO TO LASER-PRT-PAG-EXIT END-IF. COMPUTE laser-dots-per-mm ROUNDED = (LASER-PAGE-HEIGHT / 10 / WS-PAGE-HEIGHT). COMPUTE laser-dots-per-gap ROUNDED = (LASER-PAGE-WIDTH / WS-PAGE-WIDTH * 0.07). COMPUTE laser-dots-per-col ROUNDED = ((LASER-PAGE-WIDTH - (WS-PAGE-WIDTH - 1) * LASER-DOTS-PER-GAP) / WS-PAGE-WIDTH). MOVE ws-page-INT-page-no TO REQUIRED-PAGE. MOVE 0 TO LASER-PRT-AD-PATTERN. MOVE ZERO TO WSP-X, WSP-Y. MOVE WS-PAGE-WIDTH TO WSP-WIDTH. COMPUTE WSP-HEIGHT = WS-PAGE-HEIGHT * 10. COMPUTE LASER-PRT-AD-X rounded = 2.4 * (LASER-X0-LOCATION + (WSP-X * (LASER-DOTS-PER-COL + LASER-DOTS-PER-GAP))). COMPUTE LASER-PRT-AD-Y rounded = 2.4 * ( LASER-Y0-LOCATION + ((WS-PAGE-HEIGHT * 10) - WSP-Y - WSP-HEIGHT) * LASER-DOTS-PER-MM ). COMPUTE LASER-PRT-AD-HEIGHT rounded = WSP-HEIGHT * LASER-DOTS-PER-MM. COMPUTE LASER-PRT-AD-WIDTH rounded = (WSP-WIDTH * LASER-DOTS-PER-COL) + ((WSP-WIDTH - 1) * LASER-DOTS-PER-GAP). COMPUTE laser-prt-top-height laser-prt-left-width laser-prt-bottom-height laser-prt-right-width = LASER-DOTS-PER-MM + 0.99. move laser-prt-ad-x to laser-prt-top-x laser-prt-left-x laser-prt-bottom-x. move laser-prt-ad-y to laser-prt-top-y laser-prt-left-y laser-prt-right-y. move laser-prt-ad-width to laser-prt-top-width laser-prt-bottom-width. move laser-prt-ad-height to laser-prt-left-height laser-prt-right-height. compute laser-prt-bottom-y rounded = laser-prt-ad-y + (wsp-height - 1) * 2.4 * laser-dots-per-mm. compute laser-prt-right-x rounded = laser-prt-ad-x + 2.4 * laser-prt-ad-width. MOVE LASER-PRT-AD-REQUEST-bit1 TO laser-rec. PERFORM WRITE-laser-rec. MOVE LASER-PRT-AD-REQUEST-bit2 TO laser-rec. PERFORM WRITE-laser-rec. MOVE LASER-PRT-AD-REQUEST-bit3 TO laser-rec. PERFORM WRITE-laser-rec. compute laser-prt-bottom-y rounded = laser-prt-bottom-y + 2.4 * laser-dots-per-mm. compute laser-prt-bottom-x rounded = laser-prt-bottom-x + 1.5 * 2.4 * laser-dots-per-mm. compute laser-prt-right-y rounded = laser-prt-right-y + 1.5 * 2.4 * laser-dots-per-mm. compute laser-prt-right-x rounded = laser-prt-right-x + 2.4 * laser-dots-per-mm. compute laser-prt-bottom-height rounded = laser-prt-bottom-height * 1.5. compute laser-prt-right-width rounded = laser-prt-right-width * 1.5. IF PAGES-PER-ROW-N-COL = 1 move "3" to laser-prt-right-type laser-prt-bottom-type END-IF. MOVE LASER-PRT-ad-request-bit3 to laser-rec. PERFORM WRITE-laser-rec. move "0" to laser-prt-right-type laser-prt-bottom-type. IF (LASER-PAGE-HEIGHT / 9) 35 MOVE LASER-PRT-BOTTOM-X TO LASER-PRT-PAGE-NO-X COMPUTE LASER-PRT-PAGE-NO-Y = LASER-PRT-BOTTOM-Y + 90 MOVE PAGE-FROM TO LASER-PRT-PAGE-NUMBER MOVE LASER-PRT-PAGE-NO TO laser-rec PERFORM WRITE-laser-rec END-IF. IF LASER-DOTS-PER-MM 2.5 AND PAGES-PER-ROW-N-COL 3 MOVE WS-PAGE-HEIGHT TO LASER-PRT-ROW-NO COMPUTE LASER-PRT-ROW-NO-X = 2.4 * (LASER-X0-LOCATION - 50) PERFORM WITH TEST BEFORE UNTIL LASER-PRT-ROW-NO = 0 COMPUTE LASER-PRT-ROW-NO-Y ROUNDED = 2.4 * (LASER-Y0-LOCATION + 14 + ((WS-PAGE-HEIGHT - LASER-PRT-ROW-NO) * 10 * LASER-DOTS-PER-MM)) MOVE LASER-PRT-ROW-NO-REQUEST TO laser-rec PERFORM WRITE-laser-rec SUBTRACT 1 FROM LASER-PRT-ROW-NO END-PERFORM END-IF. IF PAGES-PER-ROW-N-COL 3 move 8 to laser-prt-left-width move 2 to laser-prt-left-type IF pap = 'A3' move 11 to laser-prt-ad-pattern else move 5 to laser-prt-ad-pattern END-IF perform varying gap-counter from 1 by 1 until gap-counter = ws-page-width if gap-counter 1 compute laser-prt-left-x = laser-prt-left-x + (2.4 * laser-dots-per-col) + (2.4 * laser-dots-per-gap) else compute laser-prt-left-x = laser-prt-left-x + (2.4 * laser-dots-per-col) + (1.2 * laser-dots-per-gap) end-if MOVE LASER-PRT-AD-REQUEST-bit2 TO laser-rec PERFORM WRITE-laser-rec end-perform move 0 to laser-prt-left-type move 3 to laser-prt-left-pattern END-IF. close planner-ads-file. open input planner-ads-file. read planner-ads-file next into wsplanner-rec end-read. PERFORM UNTIL ws-err-stat not = '00' IF (WSP-GEN-CODE = "A" OR "L" OR "B") AND (WSP-planned-PAGE = page-from) if (wsp-y + wsp-height) (ws-page-height * 10) or (wsp-x + wsp-width) ws-page-width display " urn: xxxxxxxx, off the page ! " at 2001 with foreground-colour 7 blink background-colour 1 display wsp-urn at 2007 with foreground-colour 7 blink background-colour 1 accept any-key at 2080 with auto-skip foreground-colour 0 background-colour 0 display " " at 2001 with foreground-colour 0 background-colour 0 end-if COMPUTE LASER-PRT-AD-X rounded = 2.4 * (LASER-X0-LOCATION + (WSP-X * (LASER-DOTS-PER-COL + LASER-DOTS-PER-GAP))) COMPUTE LASER-PRT-AD-Y rounded = 2.4 * ( LASER-Y0-LOCATION + ((WS-PAGE-HEIGHT * 10) - WSP-Y - WSP-HEIGHT) * LASER-DOTS-PER-MM ) COMPUTE LASER-PRT-AD-HEIGHT rounded = WSP-HEIGHT * LASER-DOTS-PER-MM COMPUTE LASER-PRT-AD-WIDTH rounded = (WSP-WIDTH * LASER-DOTS-PER-COL) + ((WSP-WIDTH - 1) * LASER-DOTS-PER-GAP) IF WSP-ADNAME(1:2) NOT = "~L" AND (PRINT-AD-DESCRIPTION-FLAG = "Y" OR "y") PERFORM SET-UP-AD-DESCRIPTION END-IF COMPUTE laser-prt-top-height laser-prt-left-width laser-prt-bottom-height laser-prt-right-width = LASER-DOTS-PER-MM + 0.99 move laser-prt-ad-x to laser-prt-top-x laser-prt-left-x laser-prt-bottom-x move laser-prt-ad-y to laser-prt-top-y laser-prt-left-y laser-prt-right-y move laser-prt-ad-width to laser-prt-top-width laser-prt-bottom-width move laser-prt-ad-height to laser-prt-left-height laser-prt-right-height compute laser-prt-bottom-y rounded = laser-prt-ad-y + (wsp-height - 1) * 2.4 * laser-dots-per-mm compute laser-prt-right-x rounded = laser-prt-ad-x + 2.4 * laser-prt-ad-width IF PAP = 'A4' EVALUATE WSP-GEN-CODE WHEN "A" MOVE 05 TO LASER-PRT-AD-PATTERN WHEN "B" MOVE 10 TO LASER-PRT-AD-PATTERN WHEN "L" MOVE 15 TO LASER-PRT-AD-PATTERN END-EVALUATE ELSE EVALUATE WSP-GEN-CODE WHEN "A" MOVE 11 TO LASER-PRT-AD-PATTERN WHEN "B" MOVE 20 TO LASER-PRT-AD-PATTERN WHEN "L" MOVE 30 TO LASER-PRT-AD-PATTERN END-EVALUATE END-IF MOVE LASER-PRT-AD-REQUEST-bit1 TO laser-rec PERFORM WRITE-laser-rec MOVE LASER-PRT-AD-REQUEST-bit2 TO laser-rec PERFORM WRITE-laser-rec MOVE LASER-PRT-AD-REQUEST-bit3 TO laser-rec PERFORM WRITE-laser-rec END-IF read planner-ads-file into wsplanner-rec end-read END-PERFORM. LASER-PRT-PAG-EXIT. EXIT. SET-UP-AD-DESCRIPTION SECTION. move laser-prt-ad-x to laser-prt-ad-x2 laser-prt-ad-x3 laser-prt-ad-x4 laser-prt-ad-x5. add 85 to laser-prt-ad-y giving laser-prt-urn-y. add 165 to laser-prt-ad-y giving laser-prt-ad-name-y. add 245 to laser-prt-ad-y giving laser-prt-size-y. add 325 to laser-prt-ad-y giving laser-prt-catchline-y. MOVE SPACES TO LASER-PRT-AD-NAME laser-prt-urn LASER-PRT-catchline. COMPUTE AVAILABLE-CHARS = (LASER-PRT-AD-WIDTH / 300 * 16.6666) - 2. IF AVAILABLE-CHARS 20 MOVE 20 TO AVAILABLE-CHARS. IF LASER-PRT-AD-HEIGHT (100 / 2.4) AND AVAILABLE-CHARS 7 MOVE wsp-urn to laser-prt-urn MOVE LASER-PRT-AD-descrip-urn TO laser-rec PERFORM WRITE-laser-rec. IF LASER-PRT-AD-HEIGHT (180 / 2.4) MOVE wsp-adname to laser-prt-ad-name(2:AVAILABLE-CHARS) MOVE LASER-PRT-AD-descrip-name TO laser-rec PERFORM WRITE-laser-rec. IF LASER-PRT-AD-HEIGHT (260 / 2.4) AND AVAILABLE-CHARS 6 compute temp-height = wsp-height / 10 move spaces to laser-prt-ad-the-size string temp-height(1:1) delimited by '0' temp-height(2:1) delimited by size temp-height(3:2) delimited by '.0' 'x' delimited by size wsp-width(1:1) delimited by '0' wsp-width(2:1) delimited by size into laser-prt-ad-the-size(2:7) MOVE LASER-PRT-AD-descrip-size TO laser-rec PERFORM WRITE-laser-rec. COMPUTE AVAILABLE-CHARS = (LASER-PRT-AD-WIDTH / 300 * 16.6666) - 2. IF AVAILABLE-CHARS 32 MOVE 32 TO AVAILABLE-CHARS. IF LASER-PRT-AD-HEIGHT (340 / 2.4) AND wsp-gen-code NOT = "L" MOVE wsp-catchline to laser-prt-catchline(2:AVAILABLE-CHARS) MOVE LASER-PRT-AD-descrip-catchline TO laser-rec PERFORM WRITE-laser-rec. SET-UP-AD-DESCRIPTION-EXIT. EXIT. WRITE-laser-rec SECTION. WRITE LASER-REC. WRITE-laser-rec-EXIT. EXIT.
↧