|
midrange.com
If you guessed 32,764 lines, you are correct. I found this out the hard
way. I'm thinking about using /COPY to replace all of the long code. Will
the progam still compile?
Thanks,
Frank
*****************************************************************
*
* PROGRAM - ZP47R00401
* Description - Range Canadian Zip Codes
* Date - October 14, 2004
* Programmer - Frank Kany
*
*****************************************************************
FZP47P001 IF E DISK PREFIX(X)
FZP47P002 UF A E K DISK
*
D COUNTER S LIKE(XS19)
*
D STARTRANGE S LIKE(XN14)
D ENDRANGE S LIKE(XP16)
*
D SV_CITY S LIKE(XCITY)
D SV_STATE S LIKE(XSTATE)
D SV_SZIP S LIKE(XN14)
D SV_SVCCTR S LIKE(XSVCCTR)
D SV_DIRECTION S LIKE(XDIRECTION)
D SV_ADDSVC S LIKE(XADDSVCDAY)
*
* Start Main Processing
C EXSR MAINPRCS
*
* End Main Processing
C EVAL *INLR = *ON
C RETURN
*
**********************************************************************
* Main Processing Subroutine
**********************************************************************
C MAINPRCS BEGSR
*
* Reset Record Counter
C EVAL COUNTER = *ZEROS
*
* -----------------------------
* Read all Records in ZP47P001:
* -----------------------------
C DOU %EOF(ZP47P001)
C READ ZP47P001
*
* End of File(EOF); Leave this routine
C IF %EOF(ZP47P001)
C LEAVE
C ENDIF
*
* Another Record Found; Increase Record Counter
C EVAL COUNTER = COUNTER + 1
*
* (Only processes the first record in the file)
C IF COUNTER = 1
C EVAL SV_CITY = XCITY
C EVAL SV_STATE = XSTATE
C EVAL SV_SZIP = XN14
C EVAL STARTRANGE = XN14
C EVAL SV_SVCCTR = XSVCCTR
C EVAL SV_DIRECTION = XDIRECTION
C EVAL SV_ADDSVC = XADDSVCDAY
C ITER
C ENDIF
*
/FREE
//======================================================================
//First 5 pos. of Current_Zipcode match First 5 pos. of
Previous_Zipcode
//======================================================================
IF %SUBST(XN14:1:5)=%SUBST(SV_SZIP:1:5);
//6 Pos. Current_Zipcode in Sequence with Previous_Zipcode
EXSR CHECK_6;
IF IN_SEQUENCE = 'Y'; //Yes
ENDRANGE = XN14;
ITER;
ENDIF;
IF IN_SEQUENCE = 'N'; //No
EXSR WRITE_RECORD;
EXSR SAVE_NEWINFO;
ITER;
ENDIF;
ENDIF;
//======================================================================
//First 4 pos. of Current_Zipcode match First 4 pos. of
Previous_Zipcode
//======================================================================
IF %SUBST(XN14:1:4)=%SUBST(SV_SZIP:1:4);
//5,6 Pos. Current_Zipcode in Sequence with Previous_Zipcode
EXSR CHECK_56;
IF IN_SEQUENCE = 'Y'; //Yes
ENDRANGE = XN14;
ITER;
ENDIF;
IF IN_SEQUENCE = 'N'; //No
EXSR WRITE_RECORD;
EXSR SAVE_NEWINFO;
ITER;
ENDIF;
ENDIF;
//======================================================================
//First 3 pos. of Current_Zipcode match First 3 pos. of
Previous_Zipcode
//======================================================================
IF %SUBST(XN14:1:3)=%SUBST(SV_SZIP:1:3);
//4,5,6 Pos. Current_Zipcode in Sequence with Previous_Zipcode
EXSR CHECK_456;
IF IN_SEQUENCE = 'Y'; //Yes
ENDRANGE = XN14;
ITER;
ENDIF;
IF IN_SEQUENCE = 'N'; //No
EXSR WRITE_RECORD;
EXSR SAVE_NEWINFO;
ITER;
ENDIF;
ENDIF;
//======================================================================
//First 2 pos. of Current_Zipcode match First 2 pos. of
Previous_Zipcode
//======================================================================
IF %SUBST(XN14:1:2)=%SUBST(SV_SZIP:1:2);
//3,4,5,6 Pos. Current_Zipcode in Sequence with
Previous_Zipcode
EXSR CHECK_3456;
IF IN_SEQUENCE = 'Y'; //Yes
ENDRANGE = XN14;
ITER;
ENDIF;
IF IN_SEQUENCE = 'N'; //No
EXSR WRITE_RECORD;
EXSR SAVE_NEWINFO;
ITER;
ENDIF;
ENDIF;
//======================================================================
//First pos. of Current_Zipcode match First pos. of
Previous_Zipcode
//======================================================================
IF %SUBST(XN14:1:1)=%SUBST(SV_SZIP:1:1);
//2,3,4,5,6 Pos. Current_Zipcode in Sequence with
Previous_Zipcode
EXSR CHECK_23456;
IF IN_SEQUENCE = 'Y'; //Yes
ENDRANGE = XN14;
ITER;
ENDIF;
IF IN_SEQUENCE = 'N'; //No
EXSR WRITE_RECORD;
EXSR SAVE_NEWINFO;
ITER;
ENDIF;
ENDIF;
/END-FREE
C ENDDO
*
C ENDSR
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
