A*********************************************************************
A*-------------------------------------------------------------------*
A* (c) Noordeloos Informatica Support, 2022 *
A*-------------------------------------------------------------------*
A* Program ID - WRKDAYSFM *
A* Description - Work with days from or to Date *
A* Author - Sjors Bakker *
A* Date Generated - 16 August 2022 *
A*********************************************************************
A DSPSIZ(24 80 *DS3)
A R WINDOW
A WINDOW(2 10 11 26 *NOMSGLIN)
A CA03(03)
A KEEP
A FRCDTA
A OVERLAY
A USRRStdSP
A WDWborder((*COLOR BLU))
A 68 RMVWDW
A BLINK
A P7INFO 25A O 2 1
A P7TXT1 15A O 4 1
A P7DATE 8A B 4 19DSPAtr(HI PC)
A P7TXT2 15A O 5 1
A P7DAYS 3A B 5 19DSPAtr(HI)
A P7TXT3 15A O 6 1
A P7SIGN 1A B 6 19VALUES('+' '-') DSPAtr(HI)
A P7FKEY 25A O 9 1
A P7MSG 25A O 11 1DSPAtr(HI)
A*********************************************************************
/*********************************************************************/
/* (c) Noordeloos Informatica Support, 2022 */
/*-------------------------------------------------------------------*/
/* Program ID - WRKDAYS */
/* Description - Work with Days from or to Date */
/* Author - Sjors Bakker */
/* Date generated - August 15th, 2022 */
/*-------------------------------------------------------------------*/
/*********************************************************************/
pgm
/*-------------------------------------------------------------------*/
/* Declarations */
/*-------------------------------------------------------------------*/
dclf wrkdaysfm
dcl &julyy *dec len(2 0)
dcl &juldd *dec len(3 0)
dcl &jula *char len(8)
dcl &wdays *dec len(3 0)
dcl &wdate *char len(8)
dcl &wsign *char len(1)
dcl &wdate6 *char len(6)
dcl &wcent *char len(1)
dcl &wyear *char len(2)
dcl &wmonth *char len(2)
dcl &wday *char len(2)
/*-------------------------------------------------------------------*/
/* Prefill Date with current Date */
/*-------------------------------------------------------------------*/
rtvsysval (qcentury) (&wcent)
rtvsysval (qyear) (&wyear )
rtvsysval (qmonth) (&wmonth)
rtvsysval (qday) (&wday)
if (&wcent = '0') then(chgvar (&p7date) +
('19' *tcat &wyear *tcat &wmonth *tcat &wday))
if (&wcent = '1') then(chgvar (&p7date) +
('20' *tcat &wyear *tcat &wmonth *tcat &wday))
/*-------------------------------------------------------------------*/
/* send screen */
/*-------------------------------------------------------------------*/
screen:
chgvar (&p7info) value('Insert Values and ENTER')
chgvar (&p7txt1) value('Date. . . . . . . ')
chgvar (&p7txt2) value('Days. . . . . . . ')
chgvar (&p7txt3) value('Sign ( + or - ). . ')
chgvar (&p7fkey) value('F3=Exit ')
sndrcvf rcdfmt(window) wait(*yes)
if (&in03='1') goto exit
/*-------------------------------------------------------------------*/
/* Convert inserted Date to Julian Date */
/*-------------------------------------------------------------------*/
chgvar &wdate &p7date
chgvar &wdays &p7days
chgvar &wsign &p7sign
cvtdat date(&wdate) +
tovar(&jula) +
fromfmt(*yymd) +
tofmt(*jul) +
tosep(*none)
chgvar &julyy %sst( &jula 1 2 )
chgvar &juldd %sst( &jula 3 3 )
/*-------------------------------------------------------------------*/
/* Add or Substract number of days from Julian date */
/*-------------------------------------------------------------------*/
if ( &wsign = '+' ) do
chgvar &juldd ( &juldd + &wdays )
enddo
else do
chgvar &juldd ( &juldd - &wdays )
enddo
/*-------------------------------------------------------------------*/
/* Check if date is more or less then Year */
/*-------------------------------------------------------------------*/
if ( &juldd > 365 ) do
chgvar &juldd ( &juldd -365 )
chgvar &julyy ( &julyy + 1 )
enddo
if ( &juldd < 0 ) do
chgvar &juldd (&juldd + 365 )
chgvar &julyy (&julyy - 1 )
if ( &julyy < 0 ) do
chgvar &julyy ( &julyy + 100 )
enddo
enddo
/*-------------------------------------------------------------------*/
/* Convert Julian Date format back into inserted Date format */
/*-------------------------------------------------------------------*/
chgvar %sst( &jula 1 2 ) &julyy
chgvar %sst( &jula 3 3 ) &juldd
cvtdat date(&jula) +
tovar(&wdate) +
fromfmt(*jul) +
tofmt(*yymd) +
tosep(*none)
/*-------------------------------------------------------------------*/
/* Send screen with new Date */
/*-------------------------------------------------------------------*/
chgvar &p7msg ('The new Date is : ' *cat &wdate *tcat ' ')
goto screen
/*-------------------------------------------------------------------*/
/* End of Program */
/*-------------------------------------------------------------------*/
exit:
endpgm
|