WORKING-STORAGE SECTION.
 01 WORK-DATE.
    02 W-CCYY     PIC 9(4).
    02 W-MONTH    PIC 9(2).
    02 W-DAY      PIC 9(2).
 01 WORK-DATE-PRV-YEAR.
    02 W-CCYY-1   PIC 9(4).
    02 W-MONTH-1  PIC 9(2).
    02 W-DAY-1    PIC 9(2).
 01 WORK-SERIAL   PIC S9(9) BINARY.
 01 START-YEAR    PIC S9(8).
 01 WORK-NUM      PIC 9(8).
 01 DAYS          PIC 9(3) USAGE DISPLAY.
 
 01 NRSEMANA      PIC 99.
 
 PROCEDURE       DIVISION.
        MOVE 20221010 TO WORK-DATE
        SUBTRACT 1 FROM W-CCYY GIVING W-CCYY-1
        MOVE 12 TO W-MONTH-1
        MOVE 31 TO W-DAY-1
        MOVE WORK-DATE TO WORK-NUM
        COMPUTE WORK-SERIAL = FUNCTION INTEGER-OF-DATE(WORK-NUM)
        MOVE WORK-DATE-PRV-YEAR TO WORK-NUM
        COMPUTE START-YEAR = FUNCTION INTEGER-OF-DATE(WORK-NUM)
        COMPUTE DAYS = WORK-SERIAL - START-YEAR
        COMPUTE NRSEMANA = FUNCTION INTEGER((DAYS - 1) / 7) + 1

 data division.
 working-storage section.
 01 input-data pic 9(8) value 20220101.
 01 integer-of-input-data binary pic 9(8).
 01 work-table.
     02 work-item occurs 3.
        03 work-year binary pic 9(4).
        03 work-jan-4 binary pic 9(8).
        03 work-first-date binary pic 9(8).
 01 work-sub binary pic 9(4).
 01 week-for-input-data pic 9(2).
 procedure division.
 inicio.
      perform with test after until input-data = 0
      display "Digite a data YYYYMMDD: " with no advancing
      accept input-data
      if input-data = 0
         exit program
      else
         perform calculos
         display "Nr. da semana da data: " input-data " e "
         week-for-input-data " do ano: " work-year (work-sub)
      end-if
      end-perform
      exit program
      .
 calculos.
      divide input-data by 10000 giving work-year (2)
      subtract 1 from work-year (2) giving work-year (1)
      add 1 to work-year (2) giving work-year (3)
      perform varying work-sub from 1 by 1
         until work-sub > 3
           compute work-jan-4 (work-sub) =
           function integer-of-date(work-year (work-sub) * 10000 + 0104)
           compute work-first-date (work-sub) =(function integer ((work-jan-4 (work-sub) - 1) / 7)) * 7 + 1
       end-perform
       compute integer-of-input-data = function integer-of-date (input-data)
       evaluate integer-of-input-data
          when work-first-date (1) thru (work-first-date (2) - 1)
               move 1 to work-sub
               perform calculate-nr-semana
          when work-first-date (2) thru (work-first-date (3) - 1)
               move 2 to work-sub
               perform calculate-nr-semana
          when other
               move 3 to work-sub
               perform calculate-nr-semana
       end-evaluate
       .
 calculate-nr-semana.
       compute week-for-input-data = (function integer ((integer-of-input-data - work-first-date (work-sub)) / 7)) + 1
       .