help tiny-cobol compatablities with Microfocus personal Cobol 
Author Message
 help tiny-cobol compatablities with Microfocus personal Cobol

Hi All;

I just finished installing tinycobol-0.53.1, run the test_suite and
the test.code.

Where can I get info/docs on the compatablilities(?) of tinycobol to
microfocus personal cobol.

I this program I just finished writing and I want to get it working on
linux.

 IDENTIFICATION DIVISION.
*************************
 PROGRAM-ID. JOB1.
 AUTHOR. David. E. Goble.
 INSTALLATION. Gtech_Computing
   for
   Kangaroo Island Pistol Club.
 DATE-WRITTEN. 26/11/1999.
 DATE-COMPILED.
 SECURITY. Gtech_Computing, free to distribute.
 ENVIRONMENT DIVISION.
**********************
 CONFIGURATION SECTION.
*----------------------
 SOURCE-COMPUTER. 486DX2-66.
 OBJECT-COMPUTER. 386SX-33.
 INPUT-OUTPUT SECTION.
*---------------------
 FILE-CONTROL.
  SELECT f100-matches-file
   ASSIGN TO DISK "constant/Matches.mst"
   ORGANIZATION IS LINE SEQUENTIAL
   ACCESS IS SEQUENTIAL
   FILE STATUS IS w120-file-status.
  SELECT f200-members-file
   ASSIGN TO DISK "data/members.dat"
   ORGANIZATION IS RELATIVE
   ACCESS IS DYNAMIC RELATIVE KEY IS w150-Rel-Key
   FILE STATUS IS w120-file-status.
  SELECT f300-scores-file
   ASSIGN TO DISK "data/scores.dat"
   ORGANIZATION IS INDEXED
   ACCESS IS DYNAMIC
   RECORD KEY IS f310-indexed-key
   FILE STATUS IS w120-file-status.
  SELECT f400-pbhcap-file
   ASSIGN TO DISK "data/pbhcap.dat"
   ORGANIZATION IS INDEXED
   ACCESS IS DYNAMIC
   RECORD KEY IS f410-indexed-key
   FILE STATUS IS w120-file-status.
  SELECT f500-calibras-file
   ASSIGN TO DISK "constant/Calibras.mst"
   ORGANIZATION IS LINE SEQUENTIAL
   ACCESS IS SEQUENTIAL
   FILE STATUS IS w120-file-status.
  SELECT f700-initial-file
   ASSIGN TO DISK "initial/initial.dat"
   ORGANIZATION IS LINE SEQUENTIAL
   ACCESS IS SEQUENTIAL
  FILE STATUS IS w120-file-status.
   SELECT f900-report-file
   ASSIGN TO DISK "data/report.rpt"
   ORGANIZATION IS LINE SEQUENTIAL
   ACCESS IS SEQUENTIAL
   FILE STATUS IS w120-file-status.
 DATA DIVISION.
***************
 FILE SECTION.
*-------------
 FD f100-matches-file
  LABEL RECORDS ARE STANDARD.
*
* I know these are not compat yet
*  RECORD CONTAINS 67 CHARACTERS
*  DATA RECORD IS f100-matches-rec.
*
 01 f100-matches-rec.
  05 f110-matches-match  Pic x(29).
  05 f120-grades-gradem  Pic 9(03).
  05 f130-grades-gradea  Pic 9(03).
  05 f140-grades-gradeb  Pic 9(03).
  05 f150-grades-gradec  Pic 9(03).
  05 f160-match-cal177  Pic 9.
  05 f160-match-cal22s  Pic 9.
  05 f160-match-cal22l  Pic 9.
  05 f160-match-calcf   Pic 9.
  05 f160-match-cal32   Pic 9.
  05 f160-match-cal38   Pic 9.
  05 f160-match-cal9mm  Pic 9.
  05 f160-match-cal357  Pic 9.
  05 f160-match-cal44   Pic 9.
  05 f160-match-cal45   Pic 9.
  05 f170-match-stages  Pic 9.
  05 f171-mstage1-max   Pic 9(03).
  05 f172-mstage2-max   Pic 9(03).
  05 f173-mstage3-max   Pic 9(03).
  05 f174-mstage4-max   Pic 9(03).
  05 f180-matches-max   Pic 9(03).
 FD f200-members-file
  LABEL RECORDS ARE STANDARD.
*
*  RECORD CONTAINS 124 CHARACTERS
*  DATA RECORD IS f200-members-rec.
 01 f200-members-rec   Pic x(124).
 FD f300-scores-file
  LABEL RECORDS ARE STANDARD.
*  RECORD CONTAINS 61 CHARACTERS
*  DATA RECORD IS f300-scores-rec.
 01 f300-scores-rec.
  05 f310-indexed-key.
  10 f311-shooters-name.
   15 f311b-sname-last  Pic x(15).
   15 f311a-sname-first Pic x(15).
  10 f312-match-shot  Pic 9(02).
  10 f313-match-date.
   15 f313a-year  Pic 9(04).
   15 f313b-month  Pic 9(02).
   15 f313c-day  Pic 9(02).
  05 f340-calibra   Pic x(03).
  05 f350-stage1   Pic 9(03).
  05 f360-stage2   Pic 9(03).
  05 f370-stage3   Pic 9(03).
  05 f380-stage4   Pic 9(03).
  05 f390-aggregate   Pic 9(03).
  05 f395-hcap-attime   Pic 9(03).
 FD f400-pbhcap-file
  LABEL RECORDS ARE STANDARD.
*  RECORD CONTAINS 48 CHARACTERS
*  DATA RECORD IS f400-pbhcap-rec.
 01 f400-pbhcap-rec.
  05 f410-indexed-key.
  10 f409-match   Pic 9(02).
  10 f408-mname.
   15 f408a-lname  Pic x(15).
   15 f408a-fname  Pic x(15).
  05 f420-score1   Pic 9(03).
  05 f430-score2   Pic 9(03).
  05 f440-score3   Pic 9(03).
  05 f450-pbest   Pic 9(03).
  05 f460-hcap   Pic 9(03).
  05 f470-grade   Pic x.
 FD f500-calibras-file
  LABEL RECORDS ARE STANDARD.
*  RECORD CONTAINS 03 CHARACTERS
*  DATA RECORD IS f500-calibras-rec.
 01 f500-calibras-rec.
  05 f510-calibra   Pic x(03).
 FD f700-initial-file
  LABEL RECORDS ARE STANDARD.
*  RECORD CONTAINS 58 CHARACTERS
*  DATA RECORD IS f700-initial-rec.
 01 f700-initial-rec.
  05 f710-iname.
  10 f710-first   Pic x(15).
  10 f710-last   Pic x(15).
  05 f720-imatch   Pic 9(02).
  05 f730-cal    Pic x(03).
  05 f740-date.
  10 f741-day   Pic 9(02).
  10 f742-month   Pic 9(02).
  10 f743-year   Pic 9(04).
  05 f750-stage1   Pic 9(03).
  05 f760-stage2   Pic 9(03).
  05 f770-stage3   Pic 9(03).
  05 f780-stage4   Pic 9(03).
  05 f790-score   Pic 9(03).
 FD f900-report-file
  LABEL RECORDS ARE STANDARD.
*  RECORD CONTAINS 80 CHARACTERS
*  DATA RECORD IS f900-report-rec.
 01 f900-report-rec   Pic x(80).
 WORKING-STORAGE SECTION.
*------------------------
 01 w100-program-switches.
  05 w110-end-of-file   Pic x.
  88 w111-eof   value 'y', 'Y'.
  05 w120-file-status   Pic x(02).
  05 w130-Menu-selection  Pic 9.
  05 w140-press-a-key   Pic x.
  05 w150-Rel-Key   Pic 9(03).
  05 w160-cancel   Pic x.
  88 w161-cancel   value 'y', 'Y'.
 01 w200-date-variables.
  05 w210-system-date.
  10 w211-year   Pic 9(04).
  10 w212-month   Pic 9(02).
  10 w213-day   Pic 9(02).
  05 w220-Date   Pic x(10).
 01 w300-vars.
  05 w310-lengths.
  10 w311-lenA   Pic 9(02).
  10 w312-lenB   Pic 9(02).
  10 w313-center   Pic 9(02).
  05 w320-temp-hcap   Pic 9(04).
  05 w330-stage   Pic 9.
  05 w340-stage-val   Pic 9(03).
  05 w350-line-count   Pic 9(02).
  05 w360-old-match   Pic 9(02).
  05 w370-old-name   Pic x(30).
 01 w400-members-rec.
  05 w410-first-key   Pic 9(03).
  05 w420-lst-key   Pic 9(03).
  05 filler    Pic x(118).
 01 w500-members-rec.
  05 w510-members-name.
   10 w512-mname-last  Pic x(15).
   10 w511-mname-first  Pic x(15).
  05 w520-phhome.
   10 w521-phharea   Pic 9(03).
   10 w522-phhfirst4  Pic 9(04).
   10 w523-phhsecond4  Pic 9(04).
  05 w520-phwork.
   10 w521-phwarea   Pic 9(03).
   10 w522-phwfirst4  Pic 9(04).
   10 w523-phwsecond4  Pic 9(04).
  05 w540-occupation   Pic x(30).
  05 w550-postal.
   10 w551-pstreetno  Pic 9(04).
   10 w552-pstreet   Pic x(15).
   10 w553-psub-town  Pic x(15).
   10 w554-ppcode   Pic 9(04).
  05 w560-lic-renewal.
   10 w561-lr-month  Pic 9(02).
   10 w562-lr-day   Pic 9(02).
 01 w600-actions.
  05 a-to-continue   Pic x(32)
    value "Press the return key to continue".
  05 a-anymore   Pic x(26)
     value "Any more members? [Yy/Nn]:".
  05 match-selection   Pic 9(02).
  05 member-selection   Pic 9(03).
  05 cal-selection   Pic 9(02).
  05 selector    Pic x.
   88 sup    value"U", "u", "<", ",".
   88 sdown   value "D", "d", ">", ".".
   88 sselect    value "S", "s".
   88 squick     value "Q", "q".
   88 sdetailed    value "D", "d".
   88 sreport    value "R", "r".
   88 ssend     value "E", "e".
   88 sgradings    value "G", "g".
   88 sscores    value "S", "s".
   88 scancel    value "C", "c".
  05 add-new-member   Pic x(30)
      value "Add New Members".
  05 all-members   Pic x(30)
       value "All Members".
  05 instructions.
   10 i1    Pic x(80) value
 "To move up press [U/u/,/<], To move down press [D/d/./>], ".
   10 i2    Pic x(80) value
 "To select current value press [S/s], to cancel press [C/c]".
   10 i3    Pic x(80)
     value "press [S/s, G/g, or E/e]".
   10 i4    Pic x(80)
  value "press [Tab or arrow keys to move thru entry fields".
   10 i5    Pic x(21)
      value " has a max ".
   10 i6    Pic x(34)
    value "Did this member shoot? [Y/y N/n]: ".
  05 calibras   Pic x(03).
   88 cal177     value "177".
   88 cal22S     value "22S".
   88 cals22     value "22s".
   88 cal22L     value "22L".
   88 call22     value "22l".
   88 cal22     value "22".
   88 cal32     value "32".
   88 calCF     value "CF".
   88 cal38     value "38".
   88 cal9mm     value "9mm".
   88 cal357     value "357".
   88 cal44     value "44".
   88 cal45     value "45".
 01 w700-matches-table.
  05 w705-match-sub   Pic 9(02).
  05 w710-by-match OCCURS 16 TIMES INDEXED BY w710-match-inx.
   10 w711-match   Pic x(29).
   10 w711a-stages   Pic 9(01).
   10 w711d-out-of   Pic 9(03).
   10 w712-by-grade OCCURS 4 TIMES
      INDEXED BY w912-grade-inx.
    15 w712b-grade  Pic 9(03).
   10 w713-match-calibra OCCURS 11 TIMES
      INDEXED BY w713-cal-inx.
    15 w713a-cal  Pic 9.
    15 w713b-cal-type  Pic x(03).
   10 w714-per-stage OCCURS 4 TIMES
      INDEXED BY w714-per-inx.
    15 w714a-stage-max  Pic 9(03).
 01 w800-line.
  05 filler    Pic x(40)
   value "----------------------------------------".
  05 filler    Pic x(40)
   value "----------------------------------------".
 01 w900-msg.
  05 w990-display-message  Pic x(70).
  05 w980-display-action  Pic x(80).
 01 w1000-gradings.
  05 w1100-heading1.
   10 w1110-date   Pic x(10).
   10 filler   Pic x(15) value spaces.
   10 filler   Pic x(27)
     value "Kangaroo Island Pistol Club".
   10 filler   Pic x(19) value spaces.
   10 filler   Pic x(06) value "Page: ".
   10 w1120-page   Pic 9(03).
  05 w1200-heading2.
   10 filler   Pic x(33) value spaces.
   10 filler   Pic x(14)
       value "Match Gradings".
   10 filler   Pic x(33) value spaces.
  05 w1400-control1.
   10 w1410-match-name  Pic x(29).
   10 filler   Pic x(51) value spaces.
  05 w1500-detailheading.
   10 w1510-detailheading1.
    15 filler   Pic x(22) value spaces.
    15 filler   Pic x(04) value "Name".
    15 filler   Pic x(16) value spaces.
    15 filler   Pic x(10)
       value "last three".
    15 filler   Pic x(11) value spaces.
    15 filler   Pic x(08)
       value "Personal".
    15 filler   Pic x(20) value spaces.
   10 w1520-detailheading2.
    15 filler   Pic x(13) value spaces.
    15 filler   Pic x(07)
       value "Surname".
    15 filler   Pic x(09) value spaces.
    15 filler   Pic x(05) value "First".
    15 filler   Pic x(09) value spaces.
    15 filler   Pic x(06) value "Scores".
    15 filler   Pic x(05) value spaces.
    15 filler   Pic x(08)
       value "handicap".
    15 filler   Pic x(02) value spaces.
    15 filler   Pic x(04) value "Best".
    15 filler   Pic x(02) value spaces.
    15 filler   Pic x(05) value "Grade".
    15 filler   Pic x(05) value spaces.
  05 w1600-detail-line.
   10 filler   Pic x(09) value spaces.
   10 w1620-lname   Pic x(15).
   10 filler   Pic x value spaces.
   10 w1610-fname   Pic x(15).
   10 filler   Pic x(02) value spaces.
   10 w1630-score1   Pic 9(03).
   10 filler   Pic x value spaces.
   10 w1640-score2   Pic 9(03).
   10 filler   Pic x value spaces.
   10 w1650-score3   Pic 9(03).
   10 filler   Pic x(05) value spaces.
   10 w1660-hcap   Pic 9(03).
   10 filler   Pic x(05) value spaces.
   10 w1670-pbest   Pic 9(03).
   10 filler   Pic x(05) value spaces.
   10 w1680-grade   Pic x.
   10 filler   Pic x(06) value spaces.
 SCREEN SECTION.
*---------------
 01 ss100-Main-screen.
  05 BLANK SCREEN.
  05 LINE 1 COLUMN 01 value "Kangaroo Island Pistol Club".
  05  COLUMN 64 value "DATE: ".
  05  COLUMN 70 Pic x(10) from w220-Date.
 01 ss200-first-entries.
  05 ss210-enter-match.
   10 LINE 3 COLUMN 10 value "Match: ".
   10  COLUMN 17 Pic x(29) FROM
      w711-match(match-selection).
   10 LINE 24 COLUMN 65 Pic x TO selector auto.
 01 ss500-details-needed.
  05 ss510-header.
   10 LINE 8 COLUMN 19 value "Name".
   10  COLUMN 54 value "Stage".
   10 LINE 9 COLUMN 10 value "Frist".
   10  COLUMN 27 value "Last".
   10  COLUMN 40 value "Calibra".
   10  COLUMN 49 value "  ".
   10  COLUMN 68 value "Score".
  05 ss520-details.
   10 LINE 10 COLUMN 5 Pic x(15) USING w511-mname-first.
   10  COLUMN 25 Pic x(15) USING w512-mname-last.
  05 ss530-calibra.
   10  COLUMN 42 Pic x(03) FROM
    w713b-cal-type(match-selection, cal-selection).
   10 LINE 24 COLUMN 65 Pic x TO selector auto.
  05 ss540-aggregate.
   10 LINE 10 COLUMN 69 Pic 9(03) USING f390-aggregate.
 01 ss900-msg-screen.
  05 LINE 22 COLUMN 01 value "MESSAGE: ".
  05 LINE 23 COLUMN 10 Pic x(70) FROM w990-display-message.
  05 LINE 24 COLUMN 01 Pic x(80) FROM w980-display-action.
  05 LINE 24 COLUMN 65 Pic x TO w140-press-a-key.
 PROCEDURE DIVISION.
********************
 0000000-MAIN-MODULE.
*====================
  PERFORM 1000000-INITIALISE-MODULE.
  PERFORM 2000000-PROCESS-MODULE UNTIL w111-eof.
  PERFORM 3000000-END-MODULE.
  STOP RUN.
 1000000-INITIALISE-MODULE.
*==========================
  PERFORM 1300000-SET-DATE.
  PERFORM 1400000-INITIALISE-VARS.
  PERFORM 1500000-READ-INITIAL-FILE.
 1300000-SET-DATE.
*=================
* It chocks on this...
  MOVE FUNCTION CURRENT-DATE TO w210-system-date.
  STRING w213-day "/"
   w212-month "/"
   w211-year
   DELIMITED BY SIZE
    INTO w220-Date
  END-STRING.
 1400000-INITIALISE-VARS.
*========================
  MOVE "n" TO w110-end-of-file.
  INITIALIZE w500-members-rec
   f300-scores-rec.
  OPEN INPUT f700-initial-file
   INPUT f500-calibras-file
   INPUT f100-matches-file
   I-O f300-scores-file
   I-O f400-pbhcap-file
   OUTPUT f900-report-file.
  PERFORM 141000-LOAD-MATCH-ARRAY
   VARYING w710-match-inx FROM 1 BY 1
    UNTIL w710-match-inx>15 OR w111-eof.
  MOVE 1 TO match-selection.
  PERFORM 141110-LOAD-CALIBRA-ARRAY
   VARYING w713-cal-inx FROM 1 BY 1
    UNTIL w713-cal-inx>11 OR w111-eof.
  MOVE "n" TO w110-end-of-file.
 141000-LOAD-MATCH-ARRAY.
*========================
  READ f100-matches-file
   AT END
    MOVE "y" TO w110-end-of-file
   NOT AT END
    PERFORM 141100-LOAD-MATCH
  END-READ.
 141100-LOAD-MATCH.
*==================
  MOVE f110-matches-match TO w711-match(w710-match-inx).
  MOVE f180-matches-max TO w711d-out-of(w710-match-inx).
  MOVE f120-grades-gradem TO w712b-grade(w710-match-inx, 1).
  MOVE f130-grades-gradea TO w712b-grade(w710-match-inx, 2).
  MOVE f140-grades-gradeb TO w712b-grade(w710-match-inx, 3).
  MOVE f150-grades-gradec TO w712b-grade(w710-match-inx, 4).
  MOVE f160-match-cal177 TO w713a-cal(w710-match-inx, 1).
  MOVE f160-match-cal22s TO w713a-cal(w710-match-inx, 2).
  MOVE f160-match-cal22l TO w713a-cal(w710-match-inx, 3).
  MOVE f160-match-calcf TO w713a-cal(w710-match-inx, 4).
  MOVE f160-match-cal32 TO w713a-cal(w710-match-inx, 5).
  MOVE f160-match-cal38 TO w713a-cal(w710-match-inx, 6).
  MOVE f160-match-cal357 TO w713a-cal(w710-match-inx, 7).
  MOVE f160-match-cal9mm TO w713a-cal(w710-match-inx, 8).
  MOVE f160-match-cal44 TO w713a-cal(w710-match-inx, 9).
  MOVE f160-match-cal45 TO w713a-cal(w710-match-inx, 10).
  MOVE f170-match-stages TO w711a-stages(w710-match-inx).
  MOVE f171-mstage1-max TO w714a-stage-max(w710-match-inx, 1).
  MOVE f172-mstage2-max TO w714a-stage-max(w710-match-inx, 2).
  MOVE f173-mstage3-max TO w714a-stage-max(w710-match-inx, 3).
  MOVE f174-mstage4-max TO w714a-stage-max(w710-match-inx, 4).
  MOVE "PRA" TO w713b-cal-type(w710-match-inx, 11).
  MOVE "n" TO w110-end-of-file.
 141110-LOAD-CALIBRA-ARRAY.
*==========================
  READ f500-calibras-file
   AT END
    MOVE "y" TO w110-end-of-file
   NOT AT END
    PERFORM 141111-LOAD-CALIBRA
     VARYING w710-match-inx FROM 1 BY 1
      UNTIL w710-match-inx>15
    MOVE "PRA" TO
     w713b-cal-type(w710-match-inx, w713-cal-inx)
  END-READ.
 141111-LOAD-CALIBRA.
*====================
  MOVE f510-calibra TO
    w713b-cal-type(w710-match-inx, w713-cal-inx).
 1500000-READ-INITIAL-FILE.
*==========================
  READ f700-initial-file
   AT END
    MOVE "y" TO w110-end-of-file
  END-READ.
 2000000-PROCESS-MODULE.
*=======================
  MOVE f741-day TO f313c-day.
  MOVE f742-month TO f313b-month.
  MOVE f743-year TO f313a-year.
  MOVE f710-first TO f311a-sname-first
    f408a-fname.
  MOVE f710-last TO f311b-sname-last
    f408a-lname.
  MOVE f720-imatch TO f312-match-shot
    match-selection
    f409-match.
  MOVE f730-cal TO f340-calibra.
  MOVE f750-stage1 TO f350-stage1.
  MOVE f760-stage2 TO f360-stage2.
  MOVE f770-stage3 TO f370-stage3.
  MOVE f780-stage4 TO f380-stage4.
  MOVE f790-score TO f390-aggregate.
  MOVE "n" TO w110-end-of-file.
  PERFORM 2530000-READ-PBHCAP-FILE
  MOVE f460-hcap TO f395-hcap-attime.
  PERFORM 2540000-WRITE-SCORE.
  MOVE "n" TO w110-end-of-file.
  MOVE ZEROS TO f390-aggregate.
  PERFORM 1500000-READ-INITIAL-FILE.
 2530000-READ-PBHCAP-FILE.
*=========================
  READ f400-pbhcap-file
   INVALID KEY
    IF(w120-file-status EQUALS 23)
    THEN
     MOVE w711d-out-of(match-selection) TO f460-hcap
     MOVE "n" TO w110-end-of-file
     PERFORM 2533000-VALID-CALIBRA
      VARYING cal-selection FROM 1 BY 1
       UNTIL cal-selection>10 OR w111-eof
     IF(w111-eof)
     THEN
      MOVE ZEROS TO f450-pbest
       f440-score3
       f430-score2
       f420-score1
      MOVE "D" TO f470-grade
      WRITE f400-pbhcap-rec
       INVALID KEY
        MOVE "error writing pbhcap "
         TO w980-display-action
        PERFORM 2888888-FILE-STATUS
        PERFORM 2900000-ERROR
      END-WRITE
     ELSE
      MOVE "PRA" TO f340-calibra
     END-IF
     MOVE "n" TO w110-end-of-file
    ELSE
     MOVE "error reading pbhcap "
       TO w980-display-action
   PERFORM 2888888-FILE-STATUS
   PERFORM 2900000-ERROR
   END-IF
  END-READ.
 2533000-VALID-CALIBRA.
*======================
  IF((w713a-cal(match-selection, cal-selection)>ZEROS) AND
  (w713b-cal-type(match-selection, cal-selection) EQUALS
    f340-calibra))
  THEN
  MOVE "y" TO w110-end-of-file
  END-IF.
 2540000-WRITE-SCORE.
*====================
  WRITE f300-scores-rec
  INVALID KEY
   MOVE "error writing score " TO w980-display-action
   PERFORM 2888888-FILE-STATUS
   PERFORM 2900000-ERROR
  NOT INVALID KEY
   MOVE "y" TO w110-end-of-file
   PERFORM 2531000-PBHCAP
  END-WRITE.
 2531000-PBHCAP.
*===============
  PERFORM 2530000-READ-PBHCAP-FILE.
  MOVE "n" TO w110-end-of-file.
  PERFORM 2533000-VALID-CALIBRA
  VARYING cal-selection FROM 1 BY 1
   UNTIL cal-selection>10 OR w111-eof.
  IF(NOT w111-eof)
  THEN
  MOVE "PRA" TO f340-calibra
  END-IF.
  IF(f340-calibra NOT EQUAL "PRA")
  THEN
  IF(f390-aggregate>f450-pbest)
  THEN
   MOVE f390-aggregate TO f450-pbest
   PERFORM 2531200-SET-GRADE
  END-IF
  PERFORM 2531300-CAL-HCAP
  PERFORM 2531400-REWRITE-PBHCAP-FILE
  END-IF.
 2531200-SET-GRADE.
*==================
  IF(f390-aggregate<w712b-grade(match-selection, 1))
  THEN
  MOVE "A" TO f470-grade
  IF(f390-aggregate<w712b-grade(match-selection, 2))
  THEN
   MOVE "B" TO f470-grade
   IF(f390-aggregate<w712b-grade(match-selection, 3))
   THEN
   MOVE "C" TO f470-grade
   IF
    (f390-aggregate<w712b-grade(match-selection,4))
   THEN
    MOVE "D" TO f470-grade
   END-IF
   END-IF
  END-IF
  ELSE
  MOVE "M" TO f470-grade
  END-IF.
 2531300-CAL-HCAP.
*=================
  MOVE f430-score2 TO f420-score1.
  MOVE f440-score3 TO f430-score2.
  IF(f430-score2>ZERO AND f420-score1>ZERO)
  THEN
  ADD f390-aggregate
   f420-score1
   f430-score2 GIVING w320-temp-hcap
  DIVIDE w320-temp-hcap BY 3 GIVING w320-temp-hcap
  SUBTRACT w320-temp-hcap
   FROM w711d-out-of(match-selection)
  GIVING w320-temp-hcap
  ELSE
  MOVE w711d-out-of(match-selection) TO w320-temp-hcap
  END-IF.
  MOVE f390-aggregate TO f440-score3.
  MOVE f460-hcap TO f395-hcap-attime
  IF(w320-temp-hcap<f460-hcap)
  THEN
  MOVE w320-temp-hcap TO f460-hcap
  END-IF.
 2531400-REWRITE-PBHCAP-FILE.
*============================
  REWRITE f400-pbhcap-rec
  INVALID KEY
   MOVE "error rewriting pbhcap "
       TO w980-display-action
   PERFORM 2888888-FILE-STATUS
   PERFORM 2900000-ERROR
  END-REWRITE.
 2900000-ERROR.
*==============
  MOVE FUNCTION LENGTH(a-to-continue) TO w311-lenA.
  MOVE FUNCTION LENGTH(w980-display-action) TO w312-lenB.
  COMPUTE w313-center=(w312-lenB - w311-lenA)/2.
  MOVE a-to-continue TO w980-display-action(w313-center:).
  PERFORM 2999999-DISPLAY-MESG.
 2888888-FILE-STATUS.
*====================
  EVALUATE w120-file-status
  WHEN 22
   STRING w980-display-action
   DELIMITED BY " "
    " duplicate key"
   DELIMITED BY SIZE
    INTO w990-display-message
   END-STRING
  WHEN OTHER
   STRING w980-display-action
   DELIMITED BY " "
    " "
   DELIMITED BY SIZE
    w120-file-status
   DELIMITED BY SIZE
    INTO w990-display-message
   END-STRING
  END-EVALUATE.
  MOVE SPACES TO w980-display-action.
 2999999-DISPLAY-MESG.
*=====================
  DISPLAY ss900-msg-screen.
  ACCEPT ss900-msg-screen.
  MOVE SPACES TO w990-display-message
    w980-display-action.
 3000000-END-MODULE.
*===================
  MOVE "n" TO w110-end-of-file.
  MOVE 1 TO match-selection.
  PERFORM UNTIL w111-eof
  DISPLAY ss100-Main-screen
  MOVE "n" TO w160-cancel
  PERFORM 3100000-ENTER-MATCH UNTIL w111-eof
  IF(NOT w161-cancel)
  THEN
   MOVE "n" TO w110-end-of-file
   PERFORM 3600000-GRADINGS
  END-IF
  MOVE a-anymore TO w980-display-action
  MOVE SPACES TO w990-Display-message
  PERFORM 2999999-DISPLAY-MESG
  MOVE w140-press-a-key TO w110-end-of-file
  IF(NOT w111-eof)
  THEN
   MOVE "y" TO w110-end-of-file
  ELSE
   MOVE "n" TO w110-end-of-file
  END-IF
  END-PERFORM.
  CLOSE f300-scores-file
   f400-pbhcap-file
   f700-initial-file
   f900-report-file.
 3100000-ENTER-MATCH.
*====================
  DISPLAY ss210-enter-match.
  MOVE i1 TO w990-display-message.
  MOVE i2 TO w980-display-action.
  DISPLAY ss900-msg-screen.
  MOVE SPACES TO w990-display-message
    w980-display-action.
  ACCEPT ss210-enter-match.
  EVALUATE TRUE
  WHEN sup
   PERFORM 2110000-MOVE-MATCH-UP
  WHEN sdown
   PERFORM 2120000-MOVE-MATCH-DOWN
  WHEN scancel
   MOVE "y" TO w110-end-of-file
   MOVE "y" TO w160-cancel
  WHEN sselect
   MOVE "y" TO w110-end-of-file
   MOVE "n" TO w160-cancel
  END-EVALUATE.
  MOVE SPACES TO selector.
 2110000-MOVE-MATCH-UP.
*======================
  IF(match-selection>=15)
  THEN
  MOVE 1 TO match-selection
  ELSE
  ADD 1 TO match-selection
  END-IF.
 2120000-MOVE-MATCH-DOWN.
*========================
  IF(match-selection<=1)
  THEN
  MOVE 15 TO match-selection
  ELSE
  SUBTRACT 1 FROM match-selection
  END-IF.
 3600000-GRADINGS.
*=================
  PERFORM 2610000-INITIAL-REPORT
  IF(NOT w111-eof)
  THEN
  PERFORM 2620000-REPORT-HEADINGS
  PERFORM 2630000-REPORT-CONTROL-BREAK
  MOVE "n" TO w110-end-of-file
  PERFORM 2640000-REPORT-DETAILS UNTIL w111-eof
  END-IF.
 2610000-INITIAL-REPORT.
*=======================
  MOVE ZEROS TO w1120-page.
  MOVE match-selection TO f409-match.
  PERFORM 2612000-MEMBER-KEY-INITIAL-SET.
 2612000-MEMBER-KEY-INITIAL-SET.
*===============================
  MOVE SPACES TO f408-mname.
  START f400-pbhcap-file
  KEY >= f410-indexed-key
  INVALID KEY
   MOVE
   "err starting pbhcap for report"
       TO w980-display-action
   PERFORM 2888888-FILE-STATUS
   PERFORM 2900000-ERROR
   MOVE "n" TO w110-end-of-file.
  PERFORM 2612100-NEXT-PBHCAP.
 2612100-NEXT-PBHCAP.
*====================
  READ f400-pbhcap-file NEXT RECORD
  AT END
   MOVE "y" TO w110-end-of-file
  END-READ.
 2620000-REPORT-HEADINGS.
*========================
  ADD 1 TO w1120-page.
  MOVE w220-Date TO w1110-date.
  WRITE f900-report-rec FROM w1100-heading1
  AFTER ADVANCING PAGE.
  WRITE f900-report-rec FROM w1200-heading2
  AFTER ADVANCING 2 LINES.
  MOVE 6 TO w350-line-count.
  MOVE f409-match TO w360-old-match.
  MOVE w711-match(w360-old-match) TO w1410-match-name.
 2630000-REPORT-CONTROL-BREAK.
*=============================
  WRITE f900-report-rec FROM w1400-control1
  AFTER ADVANCING 2 LINES.
  WRITE f900-report-rec FROM w1510-detailheading1
  AFTER ADVANCING 2 LINES.
  WRITE f900-report-rec FROM w1520-detailheading2
  AFTER ADVANCING 1 LINES.
  MOVE SPACES TO w1410-match-name.
  ADD 5 TO w350-line-count.
 2640000-REPORT-DETAILS.
*=======================
  IF(f409-match NOT EQUAL TO w360-old-match)
  THEN
  MOVE "y" TO w110-end-of-file
  ELSE
  PERFORM 2641000-SET-UP-REPORT
  PERFORM 2642000-PRINT-REPORT
  PERFORM 2612100-NEXT-PBHCAP
  END-IF.
 2641000-SET-UP-REPORT.
*======================
  MOVE f408a-fname TO w1610-fname.
  MOVE f408a-lname TO w1620-lname.
  MOVE f420-score1 TO w1630-score1.
  MOVE f430-score2 TO w1640-score2.
  MOVE f440-score3 TO w1650-score3.
  MOVE f450-pbest TO w1670-pbest.
  MOVE f460-hcap TO w1660-hcap.
  MOVE f470-grade TO w1680-grade.
 2642000-PRINT-REPORT.
*=====================
  IF(w350-line-count>70)
  THEN
  PERFORM 2620000-REPORT-HEADINGS
  PERFORM 2630000-REPORT-CONTROL-BREAK
  END-IF.
  WRITE f900-report-rec FROM w1600-detail-line
  AFTER ADVANCING 1 LINES.
  ADD 1 TO w350-line-count.
**********************************************************



Fri, 12 Dec 2003 17:32:34 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Help with Microfocus personal cobol and Microfocus Level II cobol

2. Will MicroFocus Personal COBOL do this?

3. Microfocus Personal Cobol Question

4. Creating Sample Data for COBOL Program Using Personal Microfocus

5. Microfocus PERSONAL COBOL

6. Queries re MicroFocus Personal COBOL for Windows 3.1/Windows 95

7. Needed: MicroFocus "Personal Cobol for windows"

8. Mikro Focus Cobol Compiler 3.0/ Personal Cobol Compiler 2.0

9. Microfocus Cobol Migration to IBM Cobol for AIX

10. MicroFocus COBOL vs. Mainframe COBOL II

11. compatibility beetwen microfocus cobol 2.0 and RM cobol with "linux 3.0

12. Calling Cobol from C (Microfocus Cobol)

 

 
Powered by phpBB® Forum Software