M86FORM

Table Of Contents

  • [00001] PROC RPCEJCT 1)
  • [00002] RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT.
  • [00006] RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT.
  • [00027] PROC RPEJECT
  • [00028] PROC RPSRCH
  • [00071] PROC RPCLOSE2)
  • [00072] RPCLOSE - CLOSES A REPORT FILE.
  • [00077] RPCLOSE - CLOSES A REPORT FILE.
  • [00109] PROC RPLINEX
  • [00110] PROC RPSRCH
  • [00111] PROC WRITER
  • [00148] PROC RPEJECT3)
  • [00149] RPEJECT - STARTS A NEW REPORT PAGE.
  • [00154] RPEJECT - STARTS NEW REPORT PAGE.
  • [00187] PROC RPSRCH
  • [00188] PROC WRITEH
  • [00189] FUNC XCDD C(10)
  • [00190] PROC XPRC
  • [00250] PROC RPHEAD4)
  • [00251] RPHEAD - SETS UP HEADER PRINT FIELD.
  • [00256] RPHEAD - SETS UP HEADER PRINT FIELD.
  • [00288] PROC RPSRCH
  • [00321] PROC RPLINE5)
  • [00323] RPLINE - CALLS *RPLINEX* TO PRINT A LINE.
  • [00328] RPLINE - CALLS *RPLINEX* TO PRINT A LINE.
  • [00374] PROC RPEJECT
  • [00375] PROC RPLINEX
  • [00376] PROC RPSRCH
  • [00421] PROC RPLINEX6)
  • [00422] RPLINEX - PRINTS A REPORT LINE.
  • [00427] RPLINEX - PRINTS A LINE ON THE REPORT FILE.
  • [00472] PROC RPSRCH
  • [00473] PROC WRITEH
  • [00544] PROC RPOPEN7) [00688] RPSPACE - DOES REPORT SPACING. [00693] RPSPACE - DOES REPORT SPACING. [00727] PROC MESSAGE [00728] PROC RPSRCH [00729] PROC RPLINEX [00730] PROC RPEJECT [00830] PROC RPSRCH8) [00832] RPSRCH - SEARCHES THE PRINT TABLE. [00837] RPSRCH - SEARCHES THE PRINT TABLE FOR AN ENTRY WITH A [00870] PROC ABORT [00871] PROC MESSAGE </WRAP> === Source Code ===
    M86FORM.txt
    1. PROC RPCEJCT ((FETP),(LINES));
    2. # TITLE RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT. #
    3. BEGIN # RPCEJCT #
    4.  
    5. #
    6. ** RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT.
    7. *
    8. * *RPCEJCT* ISSUES A PAGE EJECT IF THE NUMBER OF
    9. * LINES REMAINING ON THE PAGE IS LESS THAN THE NUMBER
    10. * OF LINES TO BE CHECKED.
    11. *
    12. * PROC RPCEJCT((FETP),(LINES))
    13. *
    14. * ENTRY (FETP) = FWA OF *FET*.
    15. * (LINES) = NUMBER OF LINES TO BE CHECKED.
    16. #
    17.  
    18. ITEM FETP I; # *FET* LOCATION #
    19. ITEM LINES I; # NUMBER OF LINES TO BE CHECKED #
    20.  
    21. #
    22. **** PROC RPCEJCT - XREF LIST BEGIN.
    23. #
    24.  
    25. XREF
    26. BEGIN
    27. PROC RPEJECT; # ISSUES PAGE EJECT #
    28. PROC RPSRCH; # SEARCHES PRINT TABLE #
    29. END
    30.  
    31. #
    32. **** PROC RPCEJCT - XREF LIST END.
    33. #
    34.  
    35. DEF LISTCON #0#; # TURN COMDECK LISTING OFF #
    36. *CALL COMBFAS
    37. *CALL COMTFMT
    38. *CALL COMTOUT
    39.  
    40. CONTROL EJECT;
    41.  
    42. #
    43. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    44. #
    45.  
    46. IF FETP EQ NULLFILE
    47. THEN
    48. BEGIN
    49. RETURN;
    50. END
    51.  
    52. RPSRCH(FETP); # SEARCH PRINT TABLE #
    53.  
    54. #
    55. * IF THE NUMBER OF LINES REMAINING ON THE PAGE IS
    56. * LESS THAN THE NUMBER OF LINES TO BE CHECKED, ISSUE
    57. * A PAGE EJECT.
    58. #
    59.  
    60. IF (PRTLINELIM[ORD] - PRTLINE[ORD] + 1) GQ LINES
    61. THEN
    62. BEGIN
    63. RETURN;
    64. END
    65.  
    66. RPEJECT(FETP);
    67. RETURN;
    68. END # RPCEJCT #
    69.  
    70. TERM
    71. PROC RPCLOSE((FETP));
    72. # TITLE RPCLOSE - CLOSES A REPORT FILE. #
    73.  
    74. BEGIN # RPCLOSE #
    75.  
    76. #
    77. ** RPCLOSE - CLOSES A REPORT FILE.
    78. *
    79. * THIS PROCEDURE WRITES THE MESSAGE *REPORT
    80. * COMPLETE* ON THE REPORT FILE, CLEARS THE
    81. * *FET* ADDRESS IN THE PRINT TABLE ENTRY, AND
    82. * CALLS *WRITER* TO CLOSE THE REPORT FILE.
    83. *
    84. * PROC RPCLOSE((FETP)).
    85. *
    86. * ENTRY (FETP) - ADDRESS OF REPORT FILE *FET*.
    87. * = *NULLFILE*, NO REPORT PROCESSING DONE.
    88. * (VALUE DEFINED IN *COMTOUT*)
    89. * = OTHER, ADDRESS OF *FET*.
    90. *
    91. * EXIT REPORT FILE IS CLOSED. A PAGE EJECT IS ISSUED AND
    92. * *REPORT COMPLETE* IS PRINTED.
    93. *
    94. * NOTES *RPCLOSE* CALLS *WRITER* TO WRITE AN
    95. * END-OF-RECORD ON THE REPORT FILE, AND
    96. * CLEARS THE VALUE OF *FETP* FROM THE PRINT
    97. * TABLE ENTRY TO INDICATE THAT THE ENTRY
    98. * IS NOW EMPTY.
    99. #
    100.  
    101. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    102.  
    103. #
    104. **** PROC RPCLOSE - XREF LIST BEGIN.
    105. #
    106.  
    107. XREF
    108. BEGIN
    109. PROC RPLINEX; # PRINTS A REPORT LINE #
    110. PROC RPSRCH; # SEARCHES THE PRINT TABLE #
    111. PROC WRITER; # WRITES *EOR* ON REPORT FILE #
    112. END
    113.  
    114. #
    115. **** PROC RPCLOSE - XREF LIST END.
    116. #
    117.  
    118. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    119. *CALL COMBFAS
    120. *CALL COMTFMT
    121. *CALL COMTOUT
    122. CONTROL EJECT;
    123.  
    124. #
    125. * NO PROCESSING IS DONE IF NO REPORT FILE IS INDICATED.
    126. #
    127.  
    128. IF FETP EQ NULLFILE
    129. THEN
    130. BEGIN
    131. RETURN;
    132. END
    133.  
    134. #
    135. * PRINT COMPLETION MESSAGE AND CLEAR THE PRINT TABLE.
    136. #
    137.  
    138. RPSRCH(FETP); # SEARCH PRINT TABLE #
    139. RPLINEX(FETP,"1**REPORT COMPLETE**",0,20,0);
    140. P<RPFET> = FETP;
    141. WRITER(RPFET[0],RCL); # WRITE END-OF-RECORD #
    142.  
    143. PRTFETP[ORD] = EMPTY; # CLEAR *FET* ADDRESS FROM TABLE #
    144. RETURN;
    145. END # RPCLOSE #
    146.  
    147. TERM
    148. PROC RPEJECT((FETP));
    149. # TITLE RPEJECT - STARTS A NEW REPORT PAGE. #
    150.  
    151. BEGIN # RPEJECT #
    152.  
    153. #
    154. ** RPEJECT - STARTS NEW REPORT PAGE.
    155. *
    156. * THIS PROCEDURE ADVANCES THE REPORT FILE
    157. * TO A NEW PAGE, SETS THE CURRENT LINE NUMBER
    158. * EQUAL TO ONE, AND PRINTS THE PAGE HEADING.
    159. *
    160. * PROC RPEJECT((FETP)).
    161. *
    162. * ENTRY (FETP) - ADDRESS OF THE REPORT FILE *FET*.
    163. * = *NULLFILE*, NO REPORT PROCESSING DONE.
    164. * (VALUE DEFINED IN *COMTOUT*)
    165. * = OTHER, ADDRESS OF *FET*.
    166. *
    167. * EXIT NEW PAGE HEADING IS COMPLETED.
    168. *
    169. * NOTES *RPEJECT* SETS UP THE PAGE HEADER LINE
    170. * WITH DATE, TIME, PAGE NUMBER, AND
    171. * CARRIAGE CONTROL CHARACTER. AFTER
    172. * PRINTING THIS LINE, THE LINE BUFFER
    173. * IS BLANK-FILLED AND *XPRC* IS CALLED
    174. * TO EXECUTE THE HEADER PROCEDURE. THE
    175. * REPORT FILE MUST HAVE ALREADY BEEN OPENED
    176. * BY CALLING *RPOPEN*.
    177. #
    178.  
    179. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    180.  
    181. #
    182. **** PROC RPEJECT - XREF LIST BEGIN.
    183. #
    184.  
    185. XREF
    186. BEGIN
    187. PROC RPSRCH; # SEARCHES THE PRINT TABLE #
    188. PROC WRITEH; # WRITES LINE ON REPORT FILE #
    189. FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
    190. PROC XPRC; # EXECUTES A PROCEDURE #
    191. END
    192.  
    193. #
    194. **** PROC RPEJECT - XREF LIST END.
    195. #
    196.  
    197. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    198. *CALL COMBFAS
    199. *CALL COMTFMT
    200. *CALL COMTOUT
    201. ITEM PAGENUM C(10); # PAGE NUMBER IN DISPLAY CODE #
    202. CONTROL EJECT;
    203.  
    204. #
    205. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    206. #
    207.  
    208. IF FETP EQ NULLFILE
    209. THEN
    210. BEGIN
    211. RETURN;
    212. END
    213.  
    214.  
    215. #
    216. * UPDATE PAGE AND LINE COUNTS.
    217. #
    218.  
    219. RPSRCH(FETP); # SEARCH PRINT TABLE FOR *FETP* #
    220.  
    221. PRTPAGE[ORD] = PRTPAGE[ORD] + 1;
    222. PRTLINE[ORD] = 1;
    223. PAGENUM = XCDD(PRTPAGE[ORD]); # PAGE NUMBER IN DISPLAY CODE #
    224.  
    225. #
    226. * SET UP AND PRINT THE PAGE HEADER LINE.
    227. #
    228.  
    229. LIN$CNTRL[ORD] = PRCEJ; # CAUSE PAGE EJECT #
    230. LIN$HEAD[ORD] = PRTHEADT[ORD]; # CURRENT MESSAGE #
    231. LIN$DATE[ORD] = PRTDATE[ORD]; # CURRENT DATE #
    232. LIN$TIME[ORD] = PRTTIME[ORD]; # CURRENT TIME #
    233. LIN$PAGE[ORD] = "PAGE";
    234. LIN$PAGENM[ORD] = C<4,6>PAGENUM; # PAGE NUMBER #
    235. P<RPFET> = FETP;
    236. WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN); # PRINT LINE #
    237. PRTLINE[ORD] = PRTLINE[ORD] + 1; # INCREMENT LINE COUNTER #
    238.  
    239. LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* #
    240.  
    241. #
    242. * EXECUTE SPECIFIED HEADER PROCEDURE.
    243. #
    244.  
    245. XPRC(PRTHEADP[ORD],FETP,BLANK);
    246. RETURN;
    247. END # RPEJECT #
    248.  
    249. TERM
    250. PROC RPHEAD((FETP),(MESG),(COL),(LEN));
    251. # TITLE RPHEAD - SETS UP HEADER PRINT FIELD. #
    252.  
    253. BEGIN # RPHEAD #
    254.  
    255. #
    256. ** RPHEAD - SETS UP HEADER PRINT FIELD.
    257. *
    258. * *RPHEAD* SETS UP AN OPTIONAL HEADER PRINT FIELD IN THE
    259. * FIRST THIRTY-SEVEN CHARACTERS OF THE HEADER PAGE LINE.
    260. *
    261. * PROC RPHEAD((FETP),(MESG),(COL),(LEN))
    262. *
    263. * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE.
    264. * (MESG) - HEADER MESSAGE.
    265. * (COL) - STARTING COLUMN.
    266. * (LEN) - CHARACTER LENGTH OF FIELD.
    267. *
    268. * EXIT HEADER PRINT FIELD IS SET UP.
    269. *
    270. * NOTES THE SPECIFIED MESSAGE WILL BE PRINTED ON EVERY
    271. * SUBSEQUENT PAGE HEADING UNTIL CHANGED OR CLEARED
    272. * BY ANOTHER CALL TO *RPHEAD*. THE MAXIMUM NUMBER
    273. * OF CHARACTERS ALLOWED FOR THE HEADER FIELD IS
    274. * THIRTY-SEVEN.
    275. #
    276.  
    277. ITEM FETP U; # ADDRESS OF REPORT FILE FET #
    278. ITEM MESG C(37); # HEADER MESSAGE #
    279. ITEM COL U; # STARTING COLUMN FOR FIELD #
    280. ITEM LEN U; # LENGTH OF PRINT FIELD #
    281.  
    282. #
    283. **** PROC RPHEAD - XREF LIST BEGIN.
    284. #
    285.  
    286. XREF
    287. BEGIN
    288. PROC RPSRCH; # SEARCHES PRINT TABLE #
    289. END
    290.  
    291. #
    292. **** PROC RPHEAD - XREF LIST END.
    293. #
    294.  
    295. DEF LISTCON #0#; # TURN LISTING OFF #
    296. *CALL COMBFAS
    297. *CALL COMTFMT
    298. *CALL COMTOUT
    299.  
    300. CONTROL EJECT;
    301.  
    302. #
    303. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    304. #
    305.  
    306. IF FETP EQ NULLFILE
    307. THEN
    308. BEGIN
    309. RETURN;
    310. END
    311.  
    312. #
    313. * SET UP PRINT FIELD.
    314. #
    315.  
    316. RPSRCH(FETP); # FIND PRINT TABLE ENTRY #
    317. C<COL-1,LEN>PRTHEADT[ORD] = C<0,LEN>MESG;
    318. END # RPHEAD #
    319.  
    320. TERM
    321. PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG));
    322.  
    323. # TITLE RPLINE - CALLS *RPLINEX* TO PRINT A LINE. #
    324.  
    325. BEGIN # RPLINE #
    326.  
    327. #
    328. ** RPLINE - CALLS *RPLINEX* TO PRINT A LINE.
    329. *
    330. * THIS PROCEDURE CHECKS THE CURRENT LINE NUMBER AND CALLS
    331. * *RPEJECT* IF THE LINE LIMIT IS EXCEEDED. IT THEN CALLS
    332. * *RPLINEX* TO SET UP PRINT FIELD *FIELD* IN THE LINE BUFFER.
    333. * THE LINE IS EITHER PRINTED OR SAVED, DEPENDING ON THE VALUE
    334. * OF *FLAG* SPECIFIED.
    335. *
    336. * PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG)).
    337. *
    338. * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE.
    339. * = *NULLFILE*, NO REPORT PROCESSING IS DONE.
    340. * (VALUE DEFINED IN *COMTOUT*)
    341. * = OTHER, ADDRESS OF *FET*.
    342. * (FIELD) - STRING TO BE PRINTED.
    343. * (COL) - STARTING COLUMN FOR *FIELD*.
    344. * (LEN) - CHARACTER LENGTH OF *FIELD*.
    345. * (FLAG) - INDICATES CONTINUATION OF LINE.
    346. * (VALUES DEFINED IN *COMTOUT*)
    347. * = *END$LN*, CONTENTS OF BUFFER ARE PRINTED.
    348. * = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED.
    349. *
    350. * EXIT LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED
    351. * UNTIL NEXT CALL TO *RPLINE*. THE MAXIMUM FIELD
    352. * SIZE IS 138 CHARACTERS.
    353. #
    354.  
    355. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    356.  
    357. ARRAY FIELD [0:0] S(14); # ARRAY CONTAINING PRINT FIELD #
    358. BEGIN
    359. ITEM FIELDPR C(00,00,138); # PRINT STRING #
    360. END
    361.  
    362. ITEM COL U; # STARTING COLUMN OF FIELD #
    363. ITEM LEN U; # LENGTH OF PRINT FIELD #
    364. ITEM FLAG U; # INDICATES LINE CONTINUATION #
    365.  
    366.  
    367.  
    368. #
    369. **** PROC RPLINE - XREF LIST BEGIN.
    370. #
    371.  
    372. XREF
    373. BEGIN
    374. PROC RPEJECT; # STARTS NEW REPORT PAGE #
    375. PROC RPLINEX; # PRINTS LINE ON REPORT FILE #
    376. PROC RPSRCH; # SEARCHES PRINT TABLE #
    377. END
    378.  
    379. #
    380. **** PROC RPLINE - XREF LIST END.
    381. #
    382.  
    383. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    384.  
    385. *CALL COMBFAS
    386. *CALL COMTFMT
    387. *CALL COMTOUT
    388. CONTROL EJECT;
    389.  
    390.  
    391. #
    392. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    393. #
    394.  
    395. IF FETP EQ NULLFILE
    396. THEN
    397. BEGIN
    398. RETURN;
    399. END
    400.  
    401. #
    402. * CHECK LINE COUNT AND PRINT REPORT LINE.
    403. #
    404.  
    405. RPSRCH(FETP); # SEARCH FOR MATCHING *FETP* #
    406.  
    407. IF PRTLINE[ORD] GR PRTLINELIM[ORD]
    408. THEN # NEW PAGE NEEDED #
    409. BEGIN
    410. RPEJECT(FETP);
    411. END
    412.  
    413. RPLINEX(FETP,FIELD,COL,LEN,FLAG);
    414.  
    415.  
    416.  
    417. RETURN;
    418. END # RPLINE #
    419.  
    420. TERM
    421. PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG));
    422. # TITLE RPLINEX - PRINTS A REPORT LINE. #
    423.  
    424. BEGIN # RPLINEX #
    425.  
    426. #
    427. ** RPLINEX - PRINTS A LINE ON THE REPORT FILE.
    428. *
    429. * *RPLINEX* SETS UP PRINT FIELD *FIELD* IN A LINE BUFFER.
    430. * THE CONTENTS OF THE BUFFER ARE EITHER PRINTED OR SAVED, DEPENDING
    431. * ON THE VALUE OF *FLAG*. MORE THAN ONE FIELD PER PRINT
    432. * LINE CAN BE SPECIFIED BY MAKING MORE THAN ONE CALL TO
    433. * *RPLINEX*.
    434. *
    435. * PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG)).
    436. *
    437. * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE.
    438. * = *NULLFILE*, NO REPORT PROCESSING IS DONE.
    439. * (VALUE DEFINED IN *COMTOUT*)
    440. * = OTHER, ADDRESS OF *FET*.
    441. * (FIELD) - STRING TO BE PRINTED.
    442. * (COL) - STARTING COLUMN FOR *FIELD*.
    443. * (LEN) - CHARACTER LENGTH OF *FIELD*.
    444. * (FLAG) - INDICATES CONTINUATION OF LINE.
    445. * (VALUES DEFINED IN *COMTOUT*)
    446. * = *END$LN*, CONTENTS OF BUFFER ARE PRINTED.
    447. * = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED.
    448. *
    449. * EXIT LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED
    450. * UNTIL NEXT CALL TO *RPLINEX*. THE LINE COUNTER IS
    451. * INCREMENTED AS NEEDED.
    452. #
    453.  
    454. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    455.  
    456.  
    457. ARRAY FIELD [0:0] S(14); # ARRAY CONTAINING PRINT FIELD #
    458. BEGIN
    459. ITEM FIELDPR C(00,00,138); # PRINT STRING #
    460. END
    461.  
    462. ITEM COL U; # STARTING COLUMN OF FIELD #
    463. ITEM LEN U; # LENGTH OF PRINT FIELD #
    464. ITEM FLAG U; # INDICATES LINE CONTINUATION #
    465.  
    466. #
    467. **** PROC RPLINEX - XREF LIST BEGIN.
    468. #
    469.  
    470. XREF
    471. BEGIN
    472. PROC RPSRCH; # SEARCHES PRINT TABLE #
    473. PROC WRITEH; # WRITES LINE ON REPORT FILE #
    474. END
    475.  
    476. #
    477. **** PROC RPLINEX - XREF LIST END.
    478. #
    479.  
    480. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    481.  
    482. *CALL COMBFAS
    483. *CALL COMTFMT
    484. *CALL COMTOUT
    485.  
    486. CONTROL EJECT;
    487.  
    488.  
    489. #
    490. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    491. #
    492.  
    493. IF FETP EQ NULLFILE
    494. THEN
    495. BEGIN
    496. RETURN;
    497. END
    498.  
    499.  
    500. #
    501. * THE CHARACTER STRING *FIELD* IS PLACED IN THE
    502. * APPROPRIATE LOCATION IN *LINEBUFF*. IF THE VALUE
    503. * OF *FLAG* IS *CONT$LN*, THE CONTENTS OF *LINEBUFF*
    504. * ARE SAVED. OTHERWISE A LINE IS PRINTED.
    505. #
    506.  
    507. RPSRCH(FETP); # FIND PRINT TABLE ENTRY #
    508. P<RPFET> = FETP;
    509.  
    510. IF FIELDPR[0] NQ EMPTY # IF *FIELD* CONTAINS STRING #
    511. THEN
    512. BEGIN
    513. C<COL,LEN>LIN$BUF[ORD] = FIELDPR[0]; # SET UP PRINT FIELD #
    514. END
    515.  
    516. IF FLAG EQ CONT$LN # IF LINE CONTINUED #
    517. THEN
    518. BEGIN
    519. RETURN; # SAVE CONTENTS OF *LINEBUFF* #
    520. END
    521.  
    522. #
    523. * WRITE PRINT LINE.
    524. #
    525.  
    526. WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN);
    527. IF LIN$CNTRL[ORD] EQ PRDBL
    528. THEN # DOUBLE SPACE DONE #
    529. BEGIN
    530. PRTLINE[ORD] = PRTLINE[ORD] + 2; # INCREMENT LINE COUNT #
    531. END
    532.  
    533. ELSE # SINGLE SPACE ASSUMED #
    534. BEGIN
    535. PRTLINE[ORD] = PRTLINE[ORD] + 1; # INCREMENT BY ONE #
    536. END
    537.  
    538. LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* #
    539. RETURN;
    540.  
    541. END # RPLINEX #
    542.  
    543. TERM
    544. PROC RPOPEN((NAME),(FETP),HEADPROC);
    545. # TITLE RPOPEN - OPENS A REPORT FILE. #
    546.  
    547. BEGIN # RPOPEN #
    548.  
    549. #
    550. ** RPOPEN - OPENS A REPORT FILE.
    551. *
    552. * THIS PROCEDURE SETS UP THE PRINT TABLE
    553. * FOR A REPORT FILE AND CALLS *RPEJECT*
    554. * TO START THE FIRST PAGE.
    555. *
    556. * PROC RPOPEN((NAME),(FETP),HEADPROC).
    557. *
    558. * ENTRY (NAME) - NAME OF REPORT FILE.
    559. * (FETP) - REPORT FILE *FET* OPTION.
    560. * = *NULLFILE*, NO REPORT PROCESSING IS DONE.
    561. * (VALUE DEFINED IN *COMTOUT*)
    562. * = OTHER, ADDRESS OF REPORT FILE *FET*.
    563. * (HEADPROC) - HEADER PROCEDURE OPTION.
    564. * = *DEFLT$HDR*, DEFAULT PAGE HEADER USED.
    565. * (VALUE DEFINED IN *COMTOUT*)
    566. * = NAME OF USER-SUPPLIED PROCEDURE TO
    567. * BE EXECUTED AFTER EACH PAGE EJECT.
    568. *
    569. * EXIT REPORT FILE OPENED OR PRINT TABLE FULL.
    570. *
    571. * NOTES *RPOPEN* INITIALIZES A PRINT TABLE ENTRY FOR
    572. * THE REPORT FILE SPECIFIED. UP TO *PRTABENT* REPORT
    573. * FILES MAY BE OPEN SIMULTANEOUSLY. AFTER EACH
    574. * PAGE EJECT, A LINE IS PRINTED CONTAINING THE
    575. * THE CURRENT DATE, TIME, AND PAGE NUMBER.
    576. * FOLLOWING THIS THE USER SUPPLIED HEADER PROCEDURE
    577. * IS EXECUTED.
    578. * TO AVOID RECURSIVE CALLS, THE HEADER PROCEDURE MUST
    579. * NOT CALL *RPLINE* OR *RPSPACE*. INSTEAD *RPLINEX*
    580. * SHOULD BE USED. TO PRINT A BLANK LINE, CALL:
    581. * RPLINEX(FETP,0,0,0,0).
    582. #
    583.  
    584. ITEM NAME C(7); # NAME OF THE REPORT FILE #
    585. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    586. FPRC HEADPROC; # USER-SUPPLIED HEADER PROCEDURE #
    587.  
    588. #
    589. **** PROC RPOPEN - XREF LIST BEGIN.
    590. #
    591.  
    592. XREF
    593. BEGIN
    594. PROC CLOCK; # GETS CURRENT TIME #
    595. PROC DATE; # GETS CURRENT DATE #
    596. PROC RPEJECT; # STARTS NEW REPORT PAGE #
    597. PROC RPLINEX; # PRINTS A LINE #
    598. PROC RPSRCH; # SEARCHES THE PRINT TABLE #
    599. PROC ZSETFET; # INITIALIZES A *FET* #
    600. END
    601.  
    602. #
    603. **** PROC RPOPEN - XREF LIST END.
    604. #
    605.  
    606. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    607. *CALL COMBFAS
    608. *CALL COMTFMT
    609. *CALL COMTOUT
    610.  
    611.  
    612.  
    613. ITEM DTEMP C(10); # TEMPORARY LOCATION FOR DATE #
    614. ITEM TTEMP C(10); # TEMPORARY LOCATION FOR TIME #
    615. ITEM PRBUFP U; # ADDRESS OF *CIO* BUFFER #
    616.  
    617. BASED
    618. ARRAY HEADWORD [0:0] S(1); # USED TO TEST *HEADPROC* #
    619. BEGIN
    620. ITEM HEADNAME U(00,00,60); # NAME OF HEADER PROCEDURE #
    621. END
    622.  
    623. CONTROL EJECT;
    624.  
    625. #
    626. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    627. #
    628.  
    629. IF FETP EQ NULLFILE
    630. THEN
    631. BEGIN
    632. RETURN;
    633. END
    634.  
    635.  
    636. #
    637. * SEARCH FOR AN EMPTY ENTRY IN THE PRINT TABLE.
    638. #
    639.  
    640. RPSRCH(EMPTY); # SEARCH TABLE FOR EMPTY ENTRY #
    641.  
    642. DATE(DTEMP); # GET CURRENT DATE #
    643. CLOCK(TTEMP); # GET CURRENT TIME #
    644.  
    645. #
    646. * INITIALIZE PRINT TABLE FIELDS.
    647. #
    648.  
    649. PRBUFP = LOC(PRBUF[ORD]); # ADDRESS OF *CIO* BUFFER #
    650. PRTLFN[ORD] = NAME;
    651. PRTLINE[ORD] = MAXLINE;
    652. PRTHEADT[ORD] = " ";
    653. PRTFETP[ORD] = FETP;
    654. PRTPAGE[ORD] = 0;
    655. PRTLINELIM[ORD] = PRDEFLIM;
    656. PRTDATE[ORD] = DTEMP;
    657. PRTTIME[ORD] = TTEMP;
    658.  
    659. #
    660. * SAVE ADDRESS OF THE HEADER PROCEDURE.
    661. #
    662.  
    663. P<HEADWORD> = LOC(HEADPROC);
    664. IF HEADNAME[0] EQ DEFLT$HDR
    665. THEN # DEFAULT HEADER CHOSEN #
    666. BEGIN
    667. PRTHEADP[ORD] = LOC(RPLINEX); # GET ADDRESS OF *RPLINEX* #
    668. END
    669.  
    670. ELSE # HEADER PROVIDED #
    671. BEGIN
    672. PRTHEADP[ORD] = LOC(HEADPROC); # GET HEADER ADDRESS #
    673. END
    674.  
    675. #
    676. * INITIALIZE *FET* AND START FIRST PAGE.
    677. #
    678.  
    679. ZSETFET(FETP,NAME,PRBUFP,PRBUFL,SFETL);
    680.  
    681. LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* #
    682. RETURN;
    683.  
    684. END # RPOPEN #
    685.  
    686. TERM
    687. PROC RPSPACE((FETP),(SPTYP),(NUM));
    688. # TITLE RPSPACE - DOES REPORT SPACING. #
    689.  
    690. BEGIN # RPSPACE #
    691.  
    692. #
    693. ** RPSPACE - DOES REPORT SPACING.
    694. *
    695. * THIS PROCEDURE DOES VARIOUS TYPES OF REPORT
    696. * PROCESSING, DEPENDING ON THE VALUE OF *SPTYP*
    697. * SPECIFIED.
    698. *
    699. * PROC RPSPACE((FETP),(SPTYP),(NUM)).
    700. *
    701. * ENTRY (FETP) - ADDRESS OF REPORT FILE *FET*.
    702. * (SPTYP) - STATUS ITEM INDICATING PROCESSING.
    703. * (VALUES DEFINED IN *COMTOUT*)
    704. * = *LIMIT*, CHANGE PAGE LINE LIMIT TO *NUM*.
    705. * = *LINE*, ADVANCE TO LINE *NUM*.
    706. * = *SPACE*, PRINT *NUM* BLANK LINES.
    707. * (NUM) - NUMBER USED IN ACCORDANCE WITH THE
    708. * VALUE OF *SPTYP*.
    709. *
    710. * EXIT REPORT SPACING IS COMPLETE.
    711. *
    712. * ERRORS LINE LIMIT EXCEEDS MAXIMUM.
    713. *
    714. * MESSAGES * MAXIMUM LINE COUNT TAKEN AS LIMIT.*.
    715. #
    716.  
    717. ITEM FETP U; # ADDRESS OF *FET* #
    718. ITEM NUM I; # NUMBER OF SPACES, LINE NUMBER,
    719.   OR NEW LINE LIMIT #
    720.  
    721. #
    722. **** PROC RPSPACE - XREF LIST BEGIN.
    723. #
    724.  
    725. XREF
    726. BEGIN
    727. PROC MESSAGE; # DISPLAYS DAYFILE MESSAGE #
    728. PROC RPSRCH; # SEARCHES THE PRINT TABLE #
    729. PROC RPLINEX; # PRINTS A LINE ON REPORT FILE #
    730. PROC RPEJECT; # STARTS NEW REPORT PAGE #
    731. END
    732.  
    733. #
    734. **** PROC RPSPACE - XREF LIST END.
    735. #
    736.  
    737. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    738. *CALL COMBFAS
    739. *CALL COMTFMT
    740. *CALL COMTOUT
    741. ITEM I I; # INDUCTION VARIABLE #
    742. ITEM LINESLEFT U; # LINES LEFT ON PAGE #
    743. ITEM SPTYP S:SP; # TYPE OF SPACING SPECIFIED #
    744.  
    745. SWITCH LABTYP:SP # SWITCH CONTROLLING PROCESSING #
    746. LIMITYP:LIMIT, # CHANGE PAGE LINE LIMIT #
    747. LINETYP:LINE, # ADVANCE TO ABSOLUTE LINE #
    748. SPACETYP:SPACE; # PRINT BLANK LINES #
    749.  
    750. CONTROL EJECT;
    751.  
    752.  
    753.  
    754. #
    755. * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED.
    756. #
    757.  
    758. IF FETP EQ NULLFILE
    759. THEN
    760. BEGIN
    761. RETURN;
    762. END
    763.  
    764.  
    765. #
    766. * FIND PRINT TABLE ENTRY AND PROCESS REQUEST.
    767. #
    768.  
    769. RPSRCH(FETP);
    770. GOTO LABTYP[SPTYP]; # DO APPROPRIATE PROCESSING #
    771.  
    772. LIMITYP: # CHANGE LINE LIMIT TO *NUM* #
    773. IF NUM LS MAXLC
    774. THEN # LIMIT REQUESTED IS PERMISSABLE #
    775. BEGIN
    776. PRTLINELIM[ORD] = NUM;
    777. END
    778.  
    779. ELSE # EXCESSIVE LIMIT REQUESTED #
    780. BEGIN
    781. PRTLINELIM[ORD] = MAXLC; # MAXIMUM LINE LIMIT USED #
    782. MSGITEM[0] = " MAXIMUM LINE COUNT TAKEN AS LIMIT." ;
    783. MESSAGE(MSGITEM[0],UDFL1);
    784. END
    785.  
    786. RETURN;
    787.  
    788. LINETYP: # SKIP TO LINE NUMBER #
    789. IF NUM LQ PRTLINE[ORD]
    790. THEN # LINE IS ON NEXT PAGE #
    791. BEGIN
    792. RPEJECT(FETP); # EJECT TO NEW PAGE #
    793. END
    794.  
    795. NUM = NUM - PRTLINE[ORD];
    796. SLOWFOR I = 1 STEP 1 UNTIL NUM
    797. DO
    798. BEGIN
    799. RPLINEX(FETP,BLANK); # PRINT BLANK LINE #
    800. END
    801.  
    802. RETURN;
    803.  
    804. SPACETYP: # SKIP SPECIFIED NUMBER OF LINES #
    805. IF PRTLINE[ORD] GR PRTLINELIM[ORD]
    806. THEN
    807. BEGIN
    808. RPEJECT(FETP); # EJECT TO NEW PAGE #
    809. END
    810.  
    811. LINESLEFT = (PRTLINELIM[ORD] - PRTLINE[ORD]) + 1;
    812. IF NUM GQ LINESLEFT
    813. THEN # PAGE EJECT NECESSARY #
    814. BEGIN
    815. NUM = NUM - LINESLEFT;
    816. RPEJECT(FETP);
    817. END
    818.  
    819. SLOWFOR I = 1 STEP 1 UNTIL NUM
    820. DO # PRINT *NUM* BLANK LINES #
    821. BEGIN
    822. RPLINEX(FETP,BLANK); # PRINT *NUM* BLANK LINES #
    823. END
    824.  
    825.  
    826. RETURN;
    827. END # RPSPACE #
    828.  
    829. TERM
    830. PROC RPSRCH((FETP));
    831.  
    832. # TITLE RPSRCH - SEARCHES THE PRINT TABLE. #
    833.  
    834. BEGIN # RPSRCH #
    835.  
    836. #
    837. ** RPSRCH - SEARCHES THE PRINT TABLE FOR AN ENTRY WITH A
    838. * MATCHING *FETP*.
    839. *
    840. * *RPSRCH* SEARCHES THE PRINT TABLE FOR EITHER AN EMPTY
    841. * ENTRY, OR THE ENTRY FOR A FILE ALREADY OPENED BY
    842. * *RPOPEN*.
    843. *
    844. * PROC RPSRCH((FETP)).
    845. *
    846. * ENTRY (FETP) - THE *FET* ADDRESS FOR REPORT FILE.
    847. * = *EMPTY*, SEARCH FOR EMPTY ENTRY.
    848. * (VALUE DEFINED IN *COMTFMT*)
    849. * = OTHER, ADDRESS OF *FET*.
    850. *
    851. * EXIT (ORD) - ITEM IN COMMON CONTAINING THE ORDINAL
    852. * OF THE PRINT TABLE ENTRY FOUND.
    853. * IF THE PRINT TABLE IS FULL, OR A MATCHING
    854. * ENTRY IS NOT FOUND, PROCESSING IS ABORTED.
    855. *
    856. * MESSAGES * PRINT TABLE ENTRY NOT FOUND.*
    857. * * PRINT TABLE FULL.*
    858. #
    859.  
    860.  
    861. ITEM FETP U; # ADDRESS OF REPORT FILE *FET* #
    862.  
    863.  
    864. #
    865. **** PROC RPSRCH - XREF LIST BEGIN.
    866. #
    867.  
    868. XREF
    869. BEGIN
    870. PROC ABORT; # ABORTS PROCESSING #
    871. PROC MESSAGE; # DISPLAYS DAYFILE MESSAGE #
    872. END
    873.  
    874. #
    875. **** PROC RPSRCH - XREF LIST END.
    876. #
    877.  
    878. DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS #
    879.  
    880. *CALL COMBFAS
    881. *CALL COMTFMT
    882. *CALL COMTOUT
    883.  
    884.  
    885. CONTROL EJECT;
    886.  
    887. #
    888. * FIND PRINT TABLE ENTRY WITH AN EMPTY OR MATCHING *FETP*.
    889. #
    890.  
    891. ORD = 1;
    892. REPEAT WHILE PRTFETP[ORD] NQ FETP AND ORD LQ PRTABENT
    893. DO
    894. BEGIN
    895. ORD = ORD + 1;
    896. END
    897.  
    898. IF ORD GR PRTABENT # MATCHING ENTRY NOT FOUND #
    899. THEN
    900. BEGIN
    901. IF FETP EQ EMPTY # CALLED BY *RPOPEN* #
    902. THEN
    903. BEGIN
    904. MSGITEM[0] = " PRINT TABLE FULL." ;
    905. END
    906.  
    907. ELSE
    908. BEGIN
    909. MSGITEM[0] = " PRINT TABLE ENTRY NOT FOUND." ;
    910. END
    911.  
    912. MESSAGE(MSGITEM[0],UDFL1);
    913. ABORT; # ISSUE MESSAGE AND ABORT #
    914. END
    915.  
    916. RETURN;
    917. END # RPSRCH #
    918.  
    919. TERM
1)
FETP),(LINES
2) , 3) , 8)
FETP
4)
FETP),(MESG),(COL),(LEN
5) , 6)
FETP),FIELD,(COL),(LEN),(FLAG
7)
NAME),(FETP),HEADPROC)
  • [00545] RPOPEN - OPENS A REPORT FILE.
  • [00550] RPOPEN - OPENS A REPORT FILE.
  • [00594] PROC CLOCK
  • [00595] PROC DATE
  • [00596] PROC RPEJECT
  • [00597] PROC RPLINEX
  • [00598] PROC RPSRCH
  • [00599] PROC ZSETFET
  • [00687] PROC RPSPACE((FETP),(SPTYP),(NUM