ProCalc COBOL Program

NEXT+ ...1....*....2....*....3....*....4....*....5....*....6....*....7..       

001000$SET LIST FREE XREF                                                      

001100$SHARING = SHAREDBYALL                                                   

001200$SET TEMPORARY FEDLEVEL = 5                                              

001300*                                                                        

001400***************************************************************          

001500*   $ OPTION CARDS: SHARING MUST BE SHAREDBYALL TO FORCE ONLY *          

001600*                   ONE COPY OF THE LIBRARY. TEMPORARY CAUSES *          

001700*                   THE LIBRARY TO LEAVE THE MIX WHEN NONE OF *          

001800*                   PROGRAMS THAT ACCESS IT ARE IN THE MIX.   *          

001900***************************************************************          

002000*                                                                        

002100*************************                                                 

002200 IDENTIFICATION DIVISION.                                                

002300*************************                                                

002400                                                                          

002500***************************************************************          

002600*  PROGRAM ID IS NOT NEEDED SINCE THE ENTRY POINT FROM LINC IS*          

002700*  "PROCEDURE DIVISION".                                      *           

002800***************************************************************          

002900*                                                                        

003000*****PROGRAM-ID.                                                         

003100 AUTHOR.         GARY KUCHARK.                                           

003200 DATE-WRITTEN.   JANUARY 1996.

003300 DATE-COMPILED.                                                          

003400******************************************************************       

003500*REMARKS.                                                                

003600*        PURPOSE.  TO DETERMINE THE PRORATION CALCULATION FOR AN         

003700*                  HC STUDENT BASED ON DATES OF SERVICE. THE             

003800*                  SERVICE START AND END DATE IS PASSED TO THIS          

003900*                  PROGRAM IN THE LINC GLB.PARAM FIELD, AND IS           

004000*                  MOVED TO THIS PROGRAM'S ??? FIELD.                    

004100*                  THE RESULTING PRORATE VALUE IS PASSED BACK TO         

004200*                  THE CALLING PROGRAM IN THE ??? FIELD.                 

004300*                  VALUES ARE PASSED BACK AND FORTH IN THE LINC          

004400*                  SYSTEM DATA ITEM 'GLB.PARAM'.                         

004500*                                                                        

004600*   ENTRY POINTS:  THE ENTRY POINT TO THIS LIBRARY IS THE                

004700*                  PROCEDUREDIVISION.                                    

004800*                                                                        

004900*   REFS:   REFER TO THE COBOL MANUAL AND SOG VOLUME 2 FOR               

005000*          MORE INFORMATION ON LIBRARIES. (LOTSA LUCK!)                  

005100*                                                                        

005200****************************************************************         

005300/                                                                         

005400**********************                                                   

005500 ENVIRONMENT DIVISION.

005600**********************                                                   

005700                                                                          

005800 CONFIGURATION SECTION.                                                  

005900                                                                         

006000  SOURCE-COMPUTER.  A16.                                                  

006100  OBJECT-COMPUTER.  A16.                                                 

006200*                                                                        

006300/                                                                         

006400***************                                                          

006500 DATA DIVISION.                                                          

006600***************                                                          

006700*                                                                        

006800/                                                                        

006900*************************                                                

007000 WORKING-STORAGE SECTION.                                                

007100*************************                                                

007200*                                                                        

007300*****************************************************                    

007400*  FOR LIBRARY PROGRAMS, THE DESIGNATION 'REF' IS   *                    

007500*  REQUIRED AFTER THE DATA ITEM THAT IS USED.       *                    

007600*****************************************************                    

007700*                                                                        

007800********************************************

007900*  NOTE: WS-FILE-NAM-C MUST BE TERMINATED  *                             

008000*        WITH A PERIOD OR THE MESSAGE      *                             

008100*   "ATTRIBUTE ERROR IN IN1-EXTRACT-FILE.TI*                             

008200*    TLE ILLEGAL STRING @ (LINE) 600400"   *                             

008300*    WILL BE RECEIVED A RUN TIME AND THE   *                             

008400*    PROGRAM WILL NOT RUN CORRECTLY.       *                             

008500********************************************                             

008600*                                                                         

008700 01  WS-GLOBPARAM REF.                                                   

008800     03  WS-BEG-CCYYMMDD              PIC 9(8).                          

008900     03  WS-END-CCYYMMDD              PIC 9(8).                          

009000     03  WS-VARIANT                   PIC X.                             

009100     03  WS-PERIOD                    PIC X.                             

009200     03  WS-DURATION                  PIC XX.                             

009300* Test stuff                                                             

009400     03  WS-BEGIN                     PIC X(15).                         

009500     03  WS-END                       PIC X(15).                          

009600*        03 WS-TEST1      PIC 99.                                        

009700*        03 WS-TEST2      PIC 99.                                        

009800*        03 WS-TEST3      PIC 9.                                         

009900*        03 WS-TEST4      PIC 9999.                                      

010000*        03 WS-TEST5      PIC 9999.                                      

010100*        03 WS-TEST6      PIC 9999.

010200*        03 WS-TEST7      PIC 9.                                          

010300*        03 WS-TEST8      PIC 9.                                         

010400*        03 WS-TEST9      PIC 9.                                         

010500*        03 WS-TEST10     PIC 9.                                          

010600*    03 WS-GLB-DATE       PIC 9(8).                                      

010700*    03 WS-GLB-JJUL       PIC 999.                                       

010800                                                                         

010900 01  PRORATE-REC.                                                        

011000     05  PRORATE-DATA-FIELDS.                                            

011100         10  PRO-GREG-DATE.                                              

011200             15 PRO-GREG-MM         PIC 99.                              

011300             15 PRO-GREG-DD         PIC 99.                              

011400         10  PRO-JJUL-DATE          PIC 999.                             

011500         10  PRO-MONTH-SUB          PIC 99.                              

011600         10  PRO-DAYS-IN-MONTH      PIC 99.                              

011700         10  PRO-DAY-SUB            PIC 9.                               

011800         10  PRO-FIRST-DAY-OF-MONTH PIC 9.                               

011900         10  PRO-5WK-MONTH          PIC 9.                               

012000                                                                         

012100 01 MONTHS-ARAY.                                                          

012200* Based on school year months, 07-06.                                    

012300    03 FILLER PIC 9(5) VALUE 31031.                                      

012400    03 FILLER PIC 9(5) VALUE 31062.

012500    03 FILLER PIC 9(5) VALUE 30092.                                      

012600    03 FILLER PIC 9(5) VALUE 31123.                                      

012700    03 FILLER PIC 9(5) VALUE 30153.                                      

012800    03 FILLER PIC 9(5) VALUE 31184.                                      

012900    03 FILLER PIC 9(5) VALUE 31215.                                      

013000    03 FILLER PIC 9(5) VALUE 28243.                                      

013100    03 FILLER PIC 9(5) VALUE 31274.                                       

013200    03 FILLER PIC 9(5) VALUE 30304.                                      

013300    03 FILLER PIC 9(5) VALUE 31335.                                      

013400    03 FILLER PIC 9(5) VALUE 30365.                                       

013500 01 MONTHS-ARRAY REDEFINES MONTHS-ARAY.                                  

013600    03 DAYS-N-JULIAN OCCURS 12 TIMES.                                    

013700       05 DAYS-IN-MONTH PIC 99.                                           

013800       05 JULIAN-VALUE  PIC 999.                                         

013900                                                                         

014000 01 WS-JULIAN-DAYS    PIC 9(5).                                          

014100                                                                          

014200 01 WS-LEAP-YEARS     PIC 9.                                             

014300                                                                         

014400 01 WS-DAYS-REM       PIC 9.                                             

014500                                                                         

014600 01 WS-DAY-SUB        PIC 9.                                             

014700

014800 01 WS-JJUL-DATE      PIC 999.                                           

014900                                                                         

015000 01 WS-JULDATE.                                                          

015100    03 WS-JULD        PIC 9(5).                                           

015200                                                                         

015300 01 WS-JULSPLIT.                                                         

015400       05 WS-JULD-YY  PIC 99.                                             

015500       05 WS-JULD-DDD PIC 999.                                           

015600                                                                         

015700 01 WS-GDATE.                                                             

015800    03 WS-GD          PIC 9(6).                                          

015900                                                                         

016000 01 WS-DATE.                                                              

016100    03 WS-YEAR        PIC 9999.                                          

016200    03 WS-MM          PIC 99.                                            

016300    03 WS-DD          PIC 99.                                            

016400                                                                          

016500 01 WS-TOSS           PIC 9999.                                          

016600                                                                         

016700 77 WS-JULBIN         PIC 9(11) BINARY.                                  

016800 77 WS-DAY            PIC 9(11) BINARY.                                  

016900                                                                         

017000 01 WS-REM            PIC 9.

017100    88 LEAP-YEAR             VALUE 0.                                    

017200                                                                         

017300******************************************************************       

017400*             P R O R A T I O N   C A L C U L A T I O N          *       

017500*                       ( P R O  -  C A L C )                    *       

017600*           W O R K I N G  -  S T O R A G E   C O D I N G        *       

017700******************************************************************       

017800*ONLY FIELDS REFERENCED BY THE PROGRAM ARE SHOWN ON THE PROGRAM  *       

017900*LISTING IN ORDER TO SAVE SPACE AND TO PRESERVE LOGIC FLOW.      *     

018000******************************************************************       

018100*    TO USE PRO-CALC:                                            *       

018200*       1)MOVE YOUR BEGINNING DATE (MMDDYY) TO PC-DURATION-BEGIN *       

018300*       2)MOVE YOUR ENDING DATE    (MMDDYY) TO PC-DURATION-END   *       

018400*       3)IF THE SERVICE IS A SUMMER VARIANT PROGRAM,            *       

018500*                                  MOVE "Y" TO PC-VARIANT        *       

018600*       4)PERFORM THE PRO-CALC CODING                            *       

018700*       5)THE RESULT WILL BE FOUND IN THE PC-DURATION FIELD      *       

018800*         (PIC 99) EXPRESSED IN WEEKS                            *       

018900*       6)NUMBER OF DAYS BETWEEN BEG AND END DATE WILL BE IN     *       

019000*         PC-DAYS-IN-PROGRAM.  INCLUDES BEG AND END DAY IN COUNT.*       

019100*                                                                *       

019200******************************************************************       

019300*

019400 01  PC-PRORATE-DATA.                                                    

019500*                                                                        

019600     03  PC-DURATION-DATES.                                              

019700*                                                                         

019800******************************************************************       

019900*THE CALCULATION BEGINNING DATE MUST BE MOVED HERE (MMDDYY ORDER)*       

020000******************************************************************       

020100*                                                                        

020200         05  PC-DURATION-BEGIN.                                          

020300             10  PC-DUR-B-CC      PIC 99.                                

020400             10  PC-DUR-B-YY      PIC 99.                                

020500             10  PC-DUR-B-MM      PIC 99.                                

020600             10  PC-DUR-B-DD      PIC 99.                                 

020700*                                                                        

020800******************************************************************       

020900*THE CALCULATION ENDING DATE MUST BE MOVED HERE (MMDDYY ORDER)   *       

021000******************************************************************       

021100*                                                                        

021200         05  PC-DURATION-END.                                            

021300             10  PC-DUR-E-CC      PIC 99.                                

021400             10  PC-DUR-E-YY      PIC 99.                                

021500             10  PC-DUR-E-MM      PIC 99.                                

021600             10  PC-DUR-E-DD      PIC 99.

021700*                                                                        

021800******************************************************************       

021900*IF THE CALCULATION DATES ARE VARIANT, MOVE A "Y" TO THIS FIELD. *       

022000******************************************************************       

022100*                                                                        

022200     03  PC-VARIANT               PIC X.                                  

022300*                                                                        

022400******************************************************************       

022500*THIS FIELD CONTAINS THE WEEKS CALCULATION DERIVED BY THE PRORA- *       

022600*TION CALCULATION.                                               *       

022700******************************************************************       

022800*                                                                        

022900     03  PC-DURATION              PIC 99.                                

023000*                                                                        

023100******************************************************************       

023200*THIS FIELD CONTAINS THE DAYS BETWEEN THE BEG AND END DATE OF    *       

023300*THE PROGRAM.                                                    *       

023400******************************************************************       

023500*                                                                         

023600     03  PC-DAYS-IN-7DAY-PROGRAM  PIC 999.                               

023700*                                                                        

023800******************************************************************       

023900*THE FOLLOWING FIELD CONTAINS THE PRORATE FILE STATUS. IT IS DIS-*

024000*PLAYED IF A READ PROBLEM OCCURS.                                *       

024100******************************************************************        

024200*                                                                        

024300     03  PC-STAT                  PIC XX.                                

024400******************************************************************       

024500*RESET LIST                                                              

024600******************************************************************       

024700*THIS TABLE IS USED TO DETERMINE THE NUMBER OF WEEKS DIFFERENCE  *       

024800*WITHIN DAYS IN A MONTH. (USED FOR ALL EXCEPT SUMMER PLACEMENTS) *       

024900******************************************************************       

025000*                                                                        

025100     03  PC-DAYS-TABLE.                                                   

025200* SUNDAY TABLE.                                                          

025300         05  FILLER  PIC 99 VALUE 03.                                    

025400         05  FILLER  PIC 99 VALUE 10.                                     

025500         05  FILLER  PIC 99 VALUE 17.                                    

025600         05  FILLER  PIC 99 VALUE 24.                                    

025700         05  FILLER  PIC 99 VALUE 31.                                     

025800* MONDAY TABLE.                                                          

025900         05  FILLER  PIC 99 VALUE 02.                                    

026000         05  FILLER  PIC 99 VALUE 09.                                     

026100         05  FILLER  PIC 99 VALUE 16.                                    

026200         05  FILLER  PIC 99 VALUE 23.

026300         05  FILLER  PIC 99 VALUE 31.                                    

026400* TUESDAY TABLE.                                                          

026500         05  FILLER  PIC 99 VALUE 02.                                    

026600         05  FILLER  PIC 99 VALUE 08.                                    

026700         05  FILLER  PIC 99 VALUE 15.                                     

026800         05  FILLER  PIC 99 VALUE 22.                                    

026900         05  FILLER  PIC 99 VALUE 31.                                    

027000* WEDNESDAY TABLE.                                                        

027100         05  FILLER  PIC 99 VALUE 02.                                    

027200         05  FILLER  PIC 99 VALUE 07.                                    

027300         05  FILLER  PIC 99 VALUE 14.                                    

027400         05  FILLER  PIC 99 VALUE 21.                                    

027500         05  FILLER  PIC 99 VALUE 31.                                    

027600* THURSDAY TABLE.                                                        

027700         05  FILLER  PIC 99 VALUE 06.                                    

027800         05  FILLER  PIC 99 VALUE 13.                                    

027900         05  FILLER  PIC 99 VALUE 20.                                    

028000         05  FILLER  PIC 99 VALUE 27.                                    

028100         05  FILLER  PIC 99 VALUE 31.                                    

028200* FRIDAY TABLE.                                                          

028300         05  FILLER  PIC 99 VALUE 05.                                    

028400         05  FILLER  PIC 99 VALUE 12.                                    

028500         05  FILLER  PIC 99 VALUE 19.

028600         05  FILLER  PIC 99 VALUE 26.                                    

028700         05  FILLER  PIC 99 VALUE 31.                                    

028800* SATURDAY TABLE.                                                        

028900         05  FILLER  PIC 99 VALUE 04.                                    

029000         05  FILLER  PIC 99 VALUE 11.                                    

029100         05  FILLER  PIC 99 VALUE 18.                                    

029200         05  FILLER  PIC 99 VALUE 25.                                    

029300         05  FILLER  PIC 99 VALUE 31.                                    

029400     03  PC-DAYS-TAB REDEFINES PC-DAYS-TABLE.                            

029500         05  PC-DAY-OF-WEEK OCCURS 7 TIMES.                              

029600             10  PC-DAY-DIFFERENCE                                        

029700                     PIC 99 OCCURS 5 TIMES.                              

029800*                                                                        

029900******************************************************************       

030000*THIS TABLE IS USED TO DETERMINE THE NUMBER OF WEEKS DIFFERENCE  *       

030100*WITHIN DAYS IN A MONTH. (USED FOR SUMMER PLACEMENTS)            *       

030200******************************************************************        

030300*                                                                        

030400     03  PC-DAYS-TABLE-S.                                                

030500* SUNDAY TABLE.                                                          

030600         05  FILLER  PIC 99 VALUE 03.                                    

030700         05  FILLER  PIC 99 VALUE 10.                                    

030800         05  FILLER  PIC 99 VALUE 17.

030900         05  FILLER  PIC 99 VALUE 24.                                     

031000         05  FILLER  PIC 99 VALUE 31.                                    

031100         05  FILLER  PIC 99 VALUE 99.                                    

031200* MONDAY TABLE.                                                           

031300         05  FILLER  PIC 99 VALUE 02.                                    

031400         05  FILLER  PIC 99 VALUE 09.                                    

031500         05  FILLER  PIC 99 VALUE 16.                                    

031600         05  FILLER  PIC 99 VALUE 23.                                    

031700         05  FILLER  PIC 99 VALUE 30.                                    

031800         05  FILLER  PIC 99 VALUE 31.                                    

031900* TUESDAY TABLE.                                                         

032000         05  FILLER  PIC 99 VALUE 02.                                    

032100         05  FILLER  PIC 99 VALUE 08.                                    

032200         05  FILLER  PIC 99 VALUE 15.                                    

032300         05  FILLER  PIC 99 VALUE 22.                                    

032400         05  FILLER  PIC 99 VALUE 29.                                    

032500         05  FILLER  PIC 99 VALUE 31.                                    

032600* WEDNESDAY TABLE.                                                       

032700         05  FILLER  PIC 99 VALUE 02.                                    

032800         05  FILLER  PIC 99 VALUE 07.                                     

032900         05  FILLER  PIC 99 VALUE 14.                                    

033000         05  FILLER  PIC 99 VALUE 21.                                    

033100         05  FILLER  PIC 99 VALUE 28.

033200         05  FILLER  PIC 99 VALUE 31.                                    

033300* THURSDAY TABLE.                                                        

033400         05  FILLER  PIC 99 VALUE 06.                                    

033500         05  FILLER  PIC 99 VALUE 13.                                    

033600         05  FILLER  PIC 99 VALUE 20.                                    

033700         05  FILLER  PIC 99 VALUE 27.                                    

033800         05  FILLER  PIC 99 VALUE 31.                                     

033900         05  FILLER  PIC 99 VALUE 99.                                    

034000* FRIDAY TABLE.                                                          

034100         05  FILLER  PIC 99 VALUE 05.                                     

034200         05  FILLER  PIC 99 VALUE 12.                                    

034300         05  FILLER  PIC 99 VALUE 19.                                    

034400         05  FILLER  PIC 99 VALUE 26.                                     

034500         05  FILLER  PIC 99 VALUE 31.                                    

034600         05  FILLER  PIC 99 VALUE 99.                                    

034700* SATURDAY TABLE.                                                        

034800         05  FILLER  PIC 99 VALUE 04.                                    

034900         05  FILLER  PIC 99 VALUE 11.                                    

035000         05  FILLER  PIC 99 VALUE 18.                                    

035100         05  FILLER  PIC 99 VALUE 25.                                    

035200         05  FILLER  PIC 99 VALUE 31.                                    

035300         05  FILLER  PIC 99 VALUE 99.                                    

035400     03  PC-DAYS-TAB-S REDEFINES PC-DAYS-TABLE-S.

035500         05  PC-DAY-OF-WEEK-S  OCCURS 7 TIMES.                           

035600             10  PC-DAY-DIFFERENCE-S                                     

035700                     PIC 99 OCCURS 6 TIMES.                               

035800*                                                                        

035900******************************************************************       

036000*THESE FIELDS ARE USED TO DETERMINE VARIANT PROGRAM "JUNE" DATE  *       

036100*LEAP YEAR AND REGULAR YEAR CALCULATIONS.                        *       

036200******************************************************************       

036300*                                                                        

036400     03  PC-YEAR              PIC 99.                                    

036500     03  PC-REM               PIC 99.                                    

036600*                                                                        

036700     03  PC-VARIANT-COMPARE-DATES.                                       

036800         05  PC-DAY           PIC 9.                                     

036900         05  PC-FIRST-DAY-OF-MONTH                                       

037000                              PIC 9.                                     

037100*                                                                        

037200******************************************************************       

037300*THESE FIELDS ARE SUBSCRIPTS USED BY THE PRORATION CALCULATION.  *       

037400******************************************************************       

037500*                                                                        

037600     03  PRORATION-SUBSCRIPTS.                                            

037700         05  PC-DAYS-DIFF     PIC 99.

037800         05  PC-DAY-SUB       PIC 99.                                    

037900         05  PC-DIFF-SUB      PIC 99.                                    

038000*                                                                         

038100******************************************************************       

038200*THESE FIELDS ARE USED AS A KEY TO READ THE PRORATION FILE.      *       

038300******************************************************************       

038400*                                                                        

038500     03  PC-PRO-KEY.                                                     

038600         05  PC-PRO-MM        PIC XX.                                     

038700         05  PC-PRO-DD        PIC 99.                                    

038800*                                                                        

038900******************************************************************        

039000*THE BEGINNING DATE DATA READ FROM THE PRORATION FILE IS         *       

039100*STORED HERE.                                                    *       

039200******************************************************************       

039300*                                                                         

039400     03  PC-BEG-FIELDS.                                                  

039500         05  PC-BEG-GREG-DATE PIC 9(4).                                  

039600         05  PC-BEG-JJUL-DATE PIC 999.                                   

039700         05  PC-BEG-MONTH-SUB PIC 99.                                    

039800         05  PC-BEG-DAYS-IN-MONTH                                        

039900                              PIC 99.                                    

040000         05  PC-BEG-DAY-OF-WEEK

040100                              PIC 9.                                     

040200         05  PC-BEG-FIRST-DAY-OF-MONTH                                   

040300                              PIC 9.                                     

040400         05  PC-BEG-5WK-MONTH PIC 9.                                     

040500*                                                                        

040600******************************************************************       

040700*THE ENDING DATE DATA READ FROM THE PRORATION FILE IS STORED     *       

040800*HERE.                                                           *       

040900******************************************************************       

041000*                                                                        

041100     03  PC-END-FIELDS.                                                  

041200         05  PC-END-GREG-DATE PIC 9(4).                                   

041300         05  PC-END-JJUL-DATE PIC 999.                                   

041400         05  PC-END-MONTH-SUB PIC 99.                                    

041500         05  PC-END-DAYS-IN-MONTH                                         

041600                              PIC 99.                                    

041700         05  PC-END-DAY-OF-WEEK                                          

041800                              PIC 9.                                      

041900         05  PC-END-FIRST-DAY-OF-MONTH                                   

042000                              PIC 9.                                     

042100         05  PC-END-5WK-MONTH PIC 9.                                     

042200                                                                         

042300/

042400********************                                                     

042500 PROCEDURE DIVISION                                                      

042600********************                                                     

042700                                                                         

042800          USING WS-GLOBPARAM.                                            

042900                                                                          

043000 1000-HOUSEKEEPING.                                                      

043100                                                                         

043200*****************************************************                    

043300*   Added for the LINC library routine coding.      *                    

043400*****************************************************                    

043500*                                                                         

043600  MOVE WS-BEG-CCYYMMDD TO PC-DURATION-BEGIN.                             

043700  MOVE WS-END-CCYYMMDD TO PC-DURATION-END.                               

043800  MOVE WS-VARIANT    TO PC-VARIANT.                                       

043900*                                                                        

044000******************************************************************       

044100*            P R O R A T I O N   C A L C U L A T I O N           *        

044200*                      ( P R O  -  C A L C )                     *       

044300*        P R O C E D U R E   D I V I S I O N   C O D I N G       *       

044400******************************************************************       

044500*THIS CODING IS NOT SHOWN ON THE PROGRAM LISTING IN ORDER TO SAVE*       

044600*SPACE AND TO PRESERVE LOGIC FLOW.                               *

044700******************************************************************       

044800*    TO USE PRO-CALC:                                            *       

044900*       1)MOVE YOUR BEGINNING DATE (MMDDYY) TO PC-DURATION-BEGIN *       

045000*       2)MOVE YOUR ENDING DATE    (MMDDYY) TO PC-DURATION-END   *       

045100*       3)IF THE SERVICE IS A SUMMER VARIANT PROGRAM,            *       

045200*                                  MOVE "Y" TO PC-VARIANT        *       

045300*       4)PERFORM THE PRO-CALC CODING                            *       

045400*       5)THE RESULT WILL BE FOUND IN THE PC-DURATION FIELD      *       

045500*         (PIC 99) EXPRESSED IN WEEKS                            *       

045600*                                                                *       

045700******************************************************************       

045800                                                                         

045900                                                                         

046000******************************************************************       

046100*THIS IS THE CONTROL MODULE FOR THE PRORATION CALCULATION.       *       

046200******************************************************************       

046300*                                                                        

046400 POOO-DETERMINE-PRORATE.                                                 

046500     IF PC-VARIANT = "1"                                                 

046600        MOVE "Y" TO PC-VARIANT.                                          

046700*                                                                         

046800     MOVE PC-DURATION-BEGIN TO WS-DATE.                                  

046900*

047000     PERFORM P040-READ-PRORATEFILE.                                      

047100     MOVE PRORATE-DATA-FIELDS TO PC-BEG-FIELDS.                          

047200*                                                                        

047300     MOVE PC-DURATION-END TO WS-DATE.                                    

047400*                                                                         

047500     PERFORM P040-READ-PRORATEFILE.                                      

047600     MOVE PRORATE-DATA-FIELDS TO PC-END-FIELDS.                          

047700* Test stuff                                                              

047800     MOVE PC-BEG-FIELDS TO WS-BEGIN.                                     

047900     MOVE PC-END-FIELDS TO WS-END.                                       

048000*                                                                         

048100     COMPUTE PC-DAYS-IN-7DAY-PROGRAM =                                   

048200         PC-END-JJUL-DATE  -  PC-BEG-JJUL-DATE  +  1.                    

048300                                                                         

048400     IF (PC-DUR-B-MM = 06) AND (PC-VARIANT = "Y")                        

048500        ADD 1 PC-DUR-B-YY                                                

048600           GIVING PC-YEAR                                                

048700        DIVIDE PC-YEAR BY 4                                              

048800           GIVING PC-YEAR                                                

048900           REMAINDER PC-REM                                              

049000        MOVE PC-BEG-DAY-OF-WEEK        TO PC-DAY                         

049100        MOVE PC-BEG-FIRST-DAY-OF-MONTH TO PC-FIRST-DAY-OF-MONTH          

049200        PERFORM P003-DETERMINE-VARIANT-DATES

049300        MOVE ZERO                   TO PC-BEG-MONTH-SUB                   

049400        MOVE PC-DAY                 TO PC-BEG-DAY-OF-WEEK                

049500        MOVE PC-FIRST-DAY-OF-MONTH  TO PC-BEG-FIRST-DAY-OF-MONTH.        

049600*                                                                        

049700     IF (PC-DUR-E-MM = 06) AND (PC-VARIANT = "Y")                        

049800        ADD 1 PC-DUR-E-YY                                                

049900           GIVING PC-YEAR                                                

050000        DIVIDE PC-YEAR BY 4                                              

050100           GIVING PC-YEAR                                                

050200           REMAINDER PC-REM                                              

050300        MOVE PC-END-DAY-OF-WEEK        TO PC-DAY                         

050400        MOVE PC-END-FIRST-DAY-OF-MONTH TO PC-FIRST-DAY-OF-MONTH          

050500        PERFORM P003-DETERMINE-VARIANT-DATES                             

050600        MOVE ZERO                   TO PC-END-MONTH-SUB                  

050700        MOVE PC-DAY                 TO PC-END-DAY-OF-WEEK                

050800        MOVE PC-FIRST-DAY-OF-MONTH  TO PC-END-FIRST-DAY-OF-MONTH.        

050900*                                                                         

051000     SUBTRACT PC-BEG-MONTH-SUB FROM PC-END-MONTH-SUB                     

051100        GIVING PC-DURATION.                                              

051200     IF PC-DURATION > ZERO                                                

051300        SUBTRACT 1 FROM PC-DURATION                                      

051400        MULTIPLY 4 BY PC-DURATION                                        

051500        PERFORM P010-DETERMINE-LONG-DUR

051600     ELSE                                                                 

051700        PERFORM P015-DETERMINE-SHORT-DUR.                                

051800******************************************************************       

051900     IF (PC-DUR-B-MM = 06) AND (PC-DUR-E-MM = 08)                        

052000        MOVE PC-DURATION-BEGIN TO WS-DATE                                

052100        MOVE 07 TO WS-MM                                                 

052200        MOVE 01 TO WS-DD                                                  

052300*       MOVE "0701" TO PC-PRO-KEY                                        

052400        PERFORM P005-DETERMINE-5WK                                       

052500        GO TO P100-PRORATE-EXIT.                                          

052600*                                                                        

052700     IF (PC-DUR-B-MM = 06) AND (PC-DUR-E-MM = 09)                        

052800        MOVE PC-DURATION-BEGIN TO WS-DATE                                

052900        MOVE 07 TO WS-MM                                                 

053000        MOVE 01 TO WS-DD                                                 

053100*       MOVE "0701" TO PC-PRO-KEY                                        

053200        PERFORM P005-DETERMINE-5WK                                       

053300        IF PC-BEG-5WK-MONTH = 1                                          

053400           GO TO P100-PRORATE-EXIT                                       

053500        ELSE                                                              

053600           MOVE PC-DURATION-BEGIN TO WS-DATE                             

053700           MOVE 08 TO WS-MM                                              

053800           MOVE 01 TO WS-DD

053900*          MOVE "0801" TO PC-PRO-KEY                                     

054000           PERFORM P005-DETERMINE-5WK                                    

054100           GO TO P100-PRORATE-EXIT.                                      

054200*                                                                         

054300     IF (PC-DUR-B-MM = 07) AND (PC-DUR-E-MM NOT = 07 AND 08)             

054400        MOVE PC-DURATION-BEGIN TO WS-DATE                                

054500        MOVE 08 TO WS-MM                                                  

054600        MOVE 01 TO WS-DD                                                 

054700*       MOVE "0801" TO PC-PRO-KEY                                        

054800        PERFORM P005-DETERMINE-5WK                                        

054900        GO TO P100-PRORATE-EXIT.                                         

055000*                                                                        

055100     IF PC-DURATION = ZERO                                                

055200        MOVE 1 TO PC-DURATION.                                           

055300*                                                                        

055400     GO TO P100-PRORATE-EXIT.                                             

055500*                                                                        

055600******************************************************************       

055700*THIS MODULE IS USED TO "ADJUST" VARIANT PROGRAM DATES IF THEY   *       

055800*FALL WITHIN THE MONTH OF JUNE.  THIS ADJUSTMENT IS NECESSARY    *       

055900*SINCE THE PRORATION FILE IS CREATED TO REFLECT JULY-JUNE SCHOOL *       

056000*YEAR DATES.                                                     *       

056100******************************************************************

056200*                                                                        

056300 P003-DETERMINE-VARIANT-DATES.                                           

056400    IF PC-REM = ZERO                                                      

056500       IF PC-DAY > 2                                                     

056600          SUBTRACT 2 FROM PC-DAY                                         

056700       ELSE                                                               

056800          IF PC-DAY = 2                                                  

056900             MOVE 7 TO PC-DAY                                            

057000          ELSE                                                            

057100             MOVE 6 TO PC-DAY                                            

057200    ELSE                                                                 

057300       IF PC-DAY > 1                                                     

057400          SUBTRACT 1 FROM PC-DAY                                         

057500       ELSE                                                              

057600          MOVE 7 TO PC-DAY.                                              

057700*                                                                         

057800    IF PC-REM = ZERO                                                     

057900       IF PC-FIRST-DAY-OF-MONTH > 2                                      

058000          SUBTRACT 2 FROM PC-FIRST-DAY-OF-MONTH                          

058100       ELSE                                                              

058200          IF PC-FIRST-DAY-OF-MONTH = 2                                   

058300             MOVE 7 TO PC-FIRST-DAY-OF-MONTH                             

058400          ELSE

058500             MOVE 6 TO PC-FIRST-DAY-OF-MONTH                             

058600    ELSE                                                                 

058700       IF PC-FIRST-DAY-OF-MONTH > 1                                      

058800          SUBTRACT 1 FROM PC-FIRST-DAY-OF-MONTH                          

058900       ELSE                                                              

059000          MOVE 1 TO PC-FIRST-DAY-OF-MONTH.                               

059100*                                                                        

059200*****************************************************************        

059300*THIS MODULE DETERMINES IF AN EXTRA WEEK NEEDS TO BE ADDED FOR  *        

059400*SUMMER DATES (BECAUSE THEY ENCOMPASS A 5 WEEK MONTH).          *        

059500*****************************************************************        

059600*                                                                         

059700 P005-DETERMINE-5WK.                                                     

059800    PERFORM P040-READ-PRORATEFILE.                                       

059900    MOVE PRORATE-DATA-FIELDS TO PC-BEG-FIELDS.                           

059920* The following code commented out to eliminate incorrect 49 week        

059940* calc for programs. GMK 6/30/97                                         

060000*   IF PC-BEG-5WK-MONTH = 1                                              

060100*      ADD 1 TO PC-DURATION.                                             

060200*                                                                        

060300*****************************************************************        

060400*THIS MODULE IS PERFORMED TO DETERMINE THE PRORATION CALCULATION*        

060500*WHEN THE BEGINNING AND ENDING DATES ARE NOT IN THE SAME MONTH. *

060600*****************************************************************        

060700*                                                                         

060800 P010-DETERMINE-LONG-DUR.                                                

060900     SUBTRACT PC-DUR-B-DD FROM PC-BEG-DAYS-IN-MONTH                      

061000       GIVING PC-DAYS-DIFF.                                               

061100    MOVE PC-BEG-DAY-OF-WEEK TO PC-DAY-SUB.                               

061200    IF (PC-DUR-B-MM = 07 OR 08) AND (PC-DUR-E-MM = 07 OR 08)             

061400       PERFORM P030-CHECK-SUMMER-DAYS                                     

061500       PERFORM P035-CHECK-SUMMER-BEGIN-MONTH                             

061600    ELSE                                                                 

061700       PERFORM P020-CHECK-DAYS.                                          

061800*                                                                         

061900    SUBTRACT 1 FROM PC-DUR-E-DD                                          

062000       GIVING PC-DAYS-DIFF.                                              

062100    MOVE PC-END-FIRST-DAY-OF-MONTH TO PC-DAY-SUB.                        

062200    IF (PC-DUR-E-MM = 07 OR 08) AND (PC-DUR-B-MM = 07 OR 08)             

062400       PERFORM P030-CHECK-SUMMER-DAYS                                    

062500       PERFORM P036-CHECK-SUMMER-END-MONTH                               

062600    ELSE                                                                 

062700       PERFORM P020-CHECK-DAYS.                                          

062800*                                                                         

062900*****************************************************************        

063000*THIS MODULE IS USED TO DETERMINE THE PRORATION CALCULATION WHEN*

063100*THE BEGINNING AND ENDING DATES ARE IN THE SAME MONTH.          *        

063200*****************************************************************        

063300*                                                                        

063400 P015-DETERMINE-SHORT-DUR.                                               

063500     SUBTRACT PC-DUR-B-DD FROM PC-DUR-E-DD                               

063600        GIVING PC-DAYS-DIFF.                                             

063700     MOVE PC-BEG-DAY-OF-WEEK TO PC-DAY-SUB.                              

063800     IF (PC-DUR-B-MM = 07 OR 08) OR                                      

063900       ((PC-DUR-B-MM = 06 OR 09) AND (PC-VARIANT = "Y"))            

064000        PERFORM P030-CHECK-SUMMER-DAYS                                   

064100     ELSE                                                                 

064200        PERFORM P020-CHECK-DAYS.                                         

064300*                                                                        

064400*****************************************************************        

064500*THIS MODULE IS USED TO DETERMINE HOW MANY WEEKS (IF ANY) SHOULD*        

064600*BE ADDED TO THE PRORATION CALCULATION TO ACCOUNT FOR A PARTIAL *        

064700*MONTH ENROLLMENT.(USED FOR SCHOOL YEAR ONLY)                   *        

064800*****************************************************************        

064900*                                                                        

065000 P020-CHECK-DAYS.                                                         

065100     PERFORM P021-CHECK-DAYS-TABLE                                       

065200        VARYING PC-DIFF-SUB FROM 1 BY 1                                  

065300        UNTIL PC-DIFF-SUB > 5.

065400*                                                                         

065500 P021-CHECK-DAYS-TABLE.                                                  

065600     IF PC-DAYS-DIFF < PC-DAY-DIFFERENCE(PC-DAY-SUB,PC-DIFF-SUB)         

065700        SUBTRACT 1 FROM PC-DIFF-SUB                                       

065800        ADD PC-DIFF-SUB TO PC-DURATION                                   

065900        MOVE 5 TO PC-DIFF-SUB.                                           

066000*                                                                         

066100*****************************************************************        

066200*THIS MODULE IS USED TO DETERMINE HOW MANY WEEKS (IF ANY) SHOULD*        

066300*BE ADDED TO THE PRORATION CALCULATION TO ACCOUNT FOR A PARTIAL *        

066400*MONTH ENROLLMENT.(USED FOR SUMMER ONLY)                        *        

066500*****************************************************************        

066600*                                                                        

066700 P030-CHECK-SUMMER-DAYS.                                                 

066800     PERFORM P031-CHECK-SUMMER-DAYS-TABLE                                

066900        VARYING PC-DIFF-SUB FROM 1 BY 1                                  

067000        UNTIL PC-DIFF-SUB > 6.                                           

067100*                                                                        

067200 P031-CHECK-SUMMER-DAYS-TABLE.                                           

067300     IF PC-DAYS-DIFF < PC-DAY-DIFFERENCE-S(PC-DAY-SUB,PC-DIFF-SUB)       

067400        SUBTRACT 1 FROM PC-DIFF-SUB                                      

067500        ADD PC-DIFF-SUB TO PC-DURATION                                   

067600        MOVE 6 TO PC-DIFF-SUB.

067700*                                                                         

067800*****************************************************************        

067900*THESE MODULES ARE PERFORMED FOR SUMMER MONTHS ONLY. (JULY      *        

068000*THROUGH AUGUST FOR REGULAR PROGRAMS, JUNE THROUGH SEPTEMBER FOR*        

068100*VARIANT PROGRAMS). THEY WILL ADD 1 WEEK OF DURATION TO DATES   *        

068200*WHICH HAVE "SPLIT MONTHS", WHICH ARE DATES THAT HAVE 1 OR 2    *        

068300*DAYS OF DURATION IN ONE MONTH AND THE REST OF THE WEEK IN AN   *        

068400*ADJACENT MONTH.                                                *        

068500*****************************************************************        

068600*                                                                         

068700 P035-CHECK-SUMMER-BEGIN-MONTH.                                          

068800     IF (PC-BEG-DAY-OF-WEEK = 3 AND PC-DAYS-DIFF = 1)                    

068900                             OR                                           

069000        (PC-BEG-DAY-OF-WEEK = 4 AND PC-DAYS-DIFF < 2)                    

069100        ADD 1 TO PC-DURATION.                                            

069200*                                                                        

069300 P036-CHECK-SUMMER-END-MONTH.                                            

069400     IF (PC-END-DAY-OF-WEEK = 4 AND PC-DAYS-DIFF < 2)                    

069500                             OR                                          

069600        (PC-END-DAY-OF-WEEK = 5 AND PC-DAYS-DIFF = 1)                    

069700        ADD 1 TO PC-DURATION.                                            

069800*                                                                        

069900*****************************************************************

070000*THIS MODULE READS THE PRORATION FILE.                          *        

070100*****************************************************************        

070200*                                                                         

070300 P040-READ-PRORATEFILE.                                                  

070400*                                                                        

070500     MOVE SPACES TO PRORATE-REC.                                          

070600                                                                         

070700**************************************************************           

070800* 1) Find out if this critter is a leap year...              *            

070900**************************************************************           

071000*                                                                        

071100     DIVIDE WS-YEAR BY 4 GIVING WS-TOSS                                  

071200        REMAINDER WS-REM.                                                

071300*                                                                        

071400**************************************************************           

071500* 2) Determine Month subscript (07=1)[Start of school year]  *           

071600**************************************************************           

071700*                                                                        

071800     MOVE WS-MM TO PRO-MONTH-SUB.                                        

071900     ADD 6 TO PRO-MONTH-SUB.                                             

072000     IF PRO-MONTH-SUB > 12 THEN                                          

072100        SUBTRACT 12 FROM PRO-MONTH-SUB.                                  

072200*

072300**************************************************************           

072400* 3) Determine Gregorian date.                               *           

072500**************************************************************           

072600*                                                                        

072700     MOVE WS-MM TO PRO-GREG-MM.                                          

072800     MOVE WS-DD TO PRO-GREG-DD.                                           

072900*                                                                        

073000**************************************************************           

073100* 4) Determine the number of days in the month.              *            

073200**************************************************************           

073300*                                                                        

073400     MOVE DAYS-IN-MONTH(PRO-MONTH-SUB) TO PRO-DAYS-IN-MONTH.             

073500*                                                                        

073600**************************************************************           

073700* 5) Determine Julian date.                                  *           

073800**************************************************************           

073900*                                                                        

074000     IF PRO-MONTH-SUB NOT = 1                                            

074100        MOVE JULIAN-VALUE(PRO-MONTH-SUB - 1) TO PRO-JJUL-DATE.           

074200                                                                         

074300     ADD WS-DD TO PRO-JJUL-DATE.                                         

074400                                                                          

074500* It's a leap year and past Feb 29th. Add another day to JJUL.

074600     IF LEAP-YEAR AND PRO-JJUL-DATE > 244                                

074700        ADD 1 TO PRO-JJUL-DATE.                                           

074800*                                                                        

074900**************************************************************           

075000* 6) Determine the day of the week (1=Sunday thru 6=Saturday)*           

075100*    We've got to add 1 to the result returned here, since   *           

075200*    the function returns a 0 for Sunday and we use a 1.     *           

075300**************************************************************           

075400*                                                                         

075500     MOVE PRO-JJUL-DATE TO WS-JJUL-DATE.                                 

075600     PERFORM P041-DETERMINE-JJUL-DATE.                                   

075700     MOVE WS-DAY-SUB TO PRO-DAY-SUB.                                     

075800*                                                                        

075900                                                                         

076000**************************************************************           

076100* 7) Determine the day of the week of the 1st day of the     *           

076200*    month. Same situation as above, add 1 to the result of  *           

076300*    the function call.                                      *           

076400**************************************************************           

076500*                                                                        

076600     IF WS-DD > 1                                                         

076700        SUBTRACT WS-DD FROM PRO-JJUL-DATE                                

076800           GIVING WS-JJUL-DATE

076900        ADD 1 TO WS-JJUL-DATE.                                           

077000                                                                          

077100     PERFORM P041-DETERMINE-JJUL-DATE.                                   

077200     MOVE WS-DAY-SUB TO PRO-FIRST-DAY-OF-MONTH.                          

077300*                                                                         

077400**************************************************************           

077500* 8) Determine if this is a 5 week month.                    *           

077600**************************************************************            

077700*                                                                        

077800     IF (PRO-FIRST-DAY-OF-MONTH = 2 AND PRO-DAYS-IN-MONTH > 30)          

077900                               OR                                        

078000        (PRO-FIRST-DAY-OF-MONTH = 3 AND PRO-DAYS-IN-MONTH > 29)          

078100                               OR                                        

078200        (PRO-FIRST-DAY-OF-MONTH = 4 AND PRO-DAYS-IN-MONTH > 28)          

078300        MOVE 1 TO PRO-5WK-MONTH                                          

078400     ELSE                                                                

078500        MOVE 0 TO PRO-5WK-MONTH.                                         

078600*                                                                         

078700 P041-DETERMINE-JJUL-DATE.                                               

078800*                                                                        

078900*    MOVE WS-DATE TO WS-GLB-DATE.                                         

079000*    MOVE PRO-JJUL-DATE TO WS-GLB-JJUL.                                  

079100

079200     SUBTRACT 1980 FROM WS-YEAR                                          

079300        GIVING WS-JULIAN-DAYS.                                            

079400*    MOVE WS-JULIAN-DAYS TO WS-TEST1.                                    

079500*                                                                        

079600     IF PRO-JJUL-DATE > 184                                               

079700        SUBTRACT 1 FROM WS-JULIAN-DAYS.                                  

079800*    MOVE WS-JULIAN-DAYS TO WS-TEST2.                                    

079900                                                                          

080000     DIVIDE WS-JULIAN-DAYS BY 4                                          

080100        GIVING WS-LEAP-YEARS.                                            

080200*    MOVE WS-LEAP-YEARS TO WS-TEST3.                                     

080300                                                                         

080400     MULTIPLY WS-JULIAN-DAYS BY 365                                      

080500        GIVING WS-JULIAN-DAYS.                                           

080600*    MOVE WS-JULIAN-DAYS TO WS-TEST4.                                    

080700                                                                         

080800     ADD WS-LEAP-YEARS TO WS-JULIAN-DAYS.                                

080900*    MOVE WS-JULIAN-DAYS TO WS-TEST5.                                    

081000                                                                         

081100     ADD WS-JJUL-DATE TO WS-JULIAN-DAYS.                                 

081200*    MOVE WS-JULIAN-DAYS TO WS-TEST6.                                     

081300                                                                         

081400     DIVIDE WS-JULIAN-DAYS BY 7

081500        GIVING WS-JULIAN-DAYS                                            

081600        REMAINDER WS-DAYS-REM.                                           

081700*    MOVE WS-DAYS-REM TO WS-TEST7.                                       

081800                                                                         

081900     MOVE 2 TO WS-DAY-SUB.                                               

082000*    MOVE WS-DAY-SUB TO WS-TEST8.                                        

082100                                                                         

082200     ADD WS-DAYS-REM TO WS-DAY-SUB.                                       

082300*    MOVE WS-DAY-SUB TO WS-TEST9.                                        

082400                                                                         

082500     IF WS-DAY-SUB > 7                                                    

082600        SUBTRACT 7 FROM WS-DAY-SUB.                                      

082700*    MOVE WS-DAY-SUB TO WS-TEST10.                                       

082800*                                                                         

082900 P041-DETERMINE-JJUL-DATE-EXIT.                                          

083000*                                                                        

083100                                                                         

083200 P100-PRORATE-EXIT.                                                      

083300     MOVE SPACE TO PC-VARIANT.                                           

083400                                                                         

083500***************************************************                      

083600* Added for LINC library routine coding.          *                      

083700***************************************************

083800*                                                                         

083900     MOVE PC-DURATION TO WS-DURATION.                                    

084000*                                                                        

084100     EXIT PROGRAM.                                                        

#DISPLAY COMPLETE

Last Updated: June 2, 2009