home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
jbaddmon.zip
/
JBADDMON.PRG
< prev
Wrap
Text File
|
1988-01-22
|
4KB
|
89 lines
********************************************************************************
* JBADDMON.PRG Copyright (C) 1986,1987,1988. Released to Public Domain thru
* THE BOSS BBS CLIPPER CONFERENCE - 201-568-7293, 1/22/88
* I rights are released except for those of authorship. No warranties:
* expressed, written, or implied.
*
* Author : John A. Bristor (904) 474-8846
*
* Program Purpose : Subtract or Add a number of months to a date
*
* PARAMETERS
* JBDATE - date passed in CHARCATER form - mm/dd/yy or mm/dd/ccyy
* Length is 8 charcaters if 'SET CENTURY OFF'
* Length is 10 characters if 'SET CENTURY ON'
*
* JBDIFF - + or - the number of months to move date; CHARACTER
*
* JBDOS - Whether Program is being called by DOS (Y or N)
*
* The reason a pass JBDIFF as a charcter field is so this routine
* can have parameters passed to it directly from DOS.
*
* USAGE From DOS - JBADDMON 01/01/87 15 Y
* JBADDMON 11/23/2003 -49 Y
*
* From CLIPPER - DO JBADDMON WITH "01/01/87","15","N"
* DO JBADDMON WITH DTOC(DATE()),"-37","N"
*
********************************************************************************
PARAMETERS JBDATE,JBDIFF,JBDOS
STORE VAL(JBDIFF) TO JBDIFF
STORE SUBSTR(JBDATE,4,2) TO JBCURR && Initialize Current Day Parameter
STORE SUBSTR(JBDATE,1,2) TO JBM && Initialize Current Month Parameter
IF LEN(JBDATE) = 8 && If length is only eight then 'SET
STORE "19" TO JBCEN && CENTURY' is OFF. Initialize Century
STORE SUBSTR(JBDATE,7,2) TO JBCYR && Initialize Current Year Variable
STORE 0 TO JBLONG && Set Century flag
ELSE
STORE SUBSTR(JBDATE,7,2) TO JBCEN && 'SET CENTURY' must be ON
STORE SUBSTR(JBDATE,9,2) TO JBCYR && Same as above.
STORE 99 TO JBLONG
ENDIF
SET CENTURY ON && Force 'CENTURY' to ON
STORE INT(JBDIFF/12) TO JBYRDIFF && How Many Years to move
STORE JBDIFF%12 TO JBMOD && How many months are leftover to move
DO CASE
CASE VAL(JBCYR) + JBYRDIFF < 0 .AND. JBDIFF < 0
STORE STR(VAL(JBCEN)-1,2) TO JBCEN
STORE STR(100+VAL(JBCYR)+JBYRDIFF,2) TO JBCYR
CASE VAL(JBCYR) + JBYRDIFF > 99 .AND. JBDIFF > 0
STORE STR(VAL(JBCEN)+1,2) TO JBCEN
STORE STR((VAL(JBCYR)+JBYRDIFF) - 100,2) TO JBCYR
OTHERWISE
STORE STR((VAL(JBCYR)+JBYRDIFF),2) TO JBCYR
ENDCASE
STORE VAL(JBM)+JBMOD TO JBADD
DO CASE
CASE JBADD <= 0
IF val(JBCYR) = 0
STORE "99" TO JBCYR
STORE STR(VAL(JBCEN) - 1,2) TO JBCEN
ELSE
STORE STR(VAL(JBCYR) - 1,2) TO JBCYR
ENDIF
STORE IF(JBADD=0,"12",STR(12+JBADD,2)) TO JBM
CASE JBADD > 12
IF val(JBCYR) = 99
STORE "00" TO JBCYR
STORE STR(VAL(JBCEN) + 1,2) TO JBCEN
ELSE
STORE STR(VAL(JBCYR) + 1,2) TO JBCYR
ENDIF
STORE STR(JBADD-12,2) TO JBM
OTHERWISE
STORE STR(JBADD,2) TO JBM
ENDCASE
STORE IF(VAL(JBM) < 10,"0"+STR(VAL(JBM),1),JBM) TO JBM
STORE IF(VAL(JBCYR) < 10,"0"+STR(VAL(JBCYR),1),JBCYR) TO JBCYR
IF JBLONG <> 99 && Check flags to set Environment
SET CENTURY OFF && back to the way it was.
STORE JBM+'/'+JBCURR+'/'+JBCYR TO JBDATE
ELSE
STORE JBM+'/'+JBCURR+'/'+ JBCEN +JBCYR TO JBDATE
ENDIF
IF UPPER(JBDOS)$'Y'
? JBDATE
ENDIF
RETURN