The following comments from Ed Thelen - feel free to popoff also :-))
Is this the simple neat little language of yesteryear?
OK - so it was a bit limited -and this has lower case? You must be kidding !! and I don't remember any "do" loops -oops- dou loops
Obviously the world has gone to heck in a handbasket !!Backward compatable - I doubt ;-)
c*==================================================================== c* * c* Amkor Technology Inc. * Program = OPS018R1 c* 1900 South Price Rd * Program Type = RPGLE c* Chandler AZ, 85248 * Application = OPS (Operations Utilities) c* * c*==================================================================== c*==================================================================== c* Jason Olson 06/30/2004 Initial program create. c* Jason Olson 08/05/2004 Added functions to display status of sets c* on a 5250 display, web face later. c* Jason Olson 10/11/2004 Recompile due to display file color change. c*==================================================================== c*==================================================================== c* This program will monitor traffic sets and send a message if any c* set has been in a status <> 500 for more then fifteen minutes. c* A 5250 screen is also populated with this information and will c* change the color of the set depending on how behind it is. c* Yellow = Tardy Red = Severly Behind. c*==================================================================== h DftActGrp(*no) h DatFmt(*usa) c*==================================================================== c* Files c*==================================================================== *Inbound Status File fddidstp if e disk infds(FeedBacki) *Outbound Status File fddodstp if e disk infds(FeedBacko) *Main Display File fops018d1 cf e workstn sfile(panel4sf:rrn4) f sfile(panel5sf:rrn5) c*==================================================================== c* External Prototypes For Program Calls. c*==================================================================== * Delay job for a set number of seconds. d DlyJob pr ExtPgm('QCMDEXC') d 512 Const d 15P 5 Const d SndPgmMsg pr ExtPgm('QMHSNDPM') d 7a Const d 20a Const d 256a Const d 10i 0 Const d 10a Const d 10a Const d 10i 0 Const d 4a Const d ErrorFeedbk Like(ErrorInfo) * Send message that traffic is behind. d SndTrfMsg pr ExtPgm('OPS018C1') d 3s 0 Const d 8a Const d 1a Const c*==================================================================== c* Internal Prototypes Used To Replace Subrutines. c*==================================================================== d FirstLoad pr d CheckITrf pr d CheckOTrf pr d Dsp01 pr d Dsp02 pr d Dsp03 pr d Dsp04 pr d ClearSF4 pr d ClearSF5 pr d ClearAll pr d DateTime pr c*==================================================================== c* Data Structures & Arrays c*==================================================================== d InBound ds dim(1000) d likerec(DDIDST0) d InBoundS s Like(InBound) d Dim(%elem(InBound)) d Based(pInBound) d pInBound s * inz(%addr(InBound)) d sInbound ds likerec(DDIDST0) d OutBound ds dim(1000) d likerec(DDODST0) d OutBoundS s Like(OutBound) d Dim(%elem(OutBound)) d Based(pOutBound) d pOutBound s * inz(%addr(OutBound)) d sOutBound ds likerec(DDODST0) d statusI s 1a Dim(%elem(InBound)) d statusO s 1a Dim(%elem(OutBound)) d FeedBacki ds d rrni 397 400i 0 d FeedBacko ds d rrno 397 400i 0 d ErrorInfo DS d BytesAv 10U 0 Inz(%Size(ErrorInfo)) d BytesUsed 10U 0 d ExpID 7A d Reserved 1A d ExcData 80A c*==================================================================== c* Stand Alone Fields. c*==================================================================== d i s 3s 0 d o s 3s 0 d rrn4 s 5p 0 d rrn5 s 5p 0 d timestamp s z d date s d datfmt(*usa) d time s t timfmt(*usa) d date2 s d datfmt(*usa) d time2 s t timfmt(*usa) c*==================================================================== c* MAIN LINE CODE c*==================================================================== /free dou *inlr = *on; // First load from status files. Dsp01(); DlyJob('DLYJOB DLY(3)':13); FirstLoad(); DateTime(); Dsp02(); DlyJob('DLYJOB DLY(900)':15); // First 15 minute check, but only if first load found anything. if i = 0 and o = 0; else; Dsp03(); DlyJob('DLYJOB DLY(3)':13); CheckITrf(); CheckOTrf(); DateTime(); Dsp04(); DlyJob('DLYJOB DLY(900)':15); endif; // Second 15 check, but only if both the first load and the // first 15 minute check found anything. if i = 0 and o = 0; else; Dsp03(); DlyJob('DLYJOB DLY(3)':13); CheckITrf(); CheckOTrf(); DateTime(); Dsp04(); DlyJob('DLYJOB DLY(900)':15); endif; enddo; *inlr = *on; /end-free c*==================================================================== c* END OF MAIN LINE CODE AND PROGRAM c*==================================================================== c*==================================================================== c* START OF PROTOTYPES c*==================================================================== c*==================================================================== c* FirstLoad(); = Load arrays from DDIDSTP(InBound) & DDODSTP(OutBound) c* These are then checked 15 minutes later to see if sets have moved. c*==================================================================== p FirstLoad b d FirstLoad pi /free ClearSF4(); ClearSF5(); ClearAll(); dou %eof(ddidstp); read ddidst0; if %eof(ddidstp); *in45 = *on; else; if iddsts <> '500'; setll rrni ddidst0; i = i + 1; read ddidst0 InBound(i); rrn4 = rrn4 + 1; write panel4sf; else; endif; endif; enddo; dou %eof(ddodstp); read ddodstp; if %eof(ddodstp); *in55 = *on; else; if oddsts <> '500'; setll rrno ddodst0; o = o + 1; read ddodst0 OutBound(o); rrn5 = rrn5 + 1; write panel5sf; else; endif; endif; enddo; /end-free pFirstLoad e c*===================================================================== c* CheckITrf(); = Compair what is in the status file DDIDSTP(InBound) c* to what is in the array. If the set is still in the file and the c* array then the set has not moved in 15 minutes and send up the flag. c*===================================================================== p CheckITrf b d CheckITrf pi /free ClearSF4(); clear FeedBacki; setll *start ddidstp; dou %eof(ddidstp); read DDIDST0 sInBound; if %eof(ddidstp); else; if sInBound.iddsts <> '500'; setll rrni ddidst0; read ddidst0; i = %lookup(sInBound:InBoundS); if i > 0; SndTrfMsg(sInBound.idsetn: sInBound.idsnod: 'I'); rrn4 = rrn4 + 1; if statusI(i) = *blanks; statusI(i) = 'T'; *in42 = *on; write panel4sf; elseif statusI(i) = 'T'; *in42 = *off; *in43 = *on; write panel4sf; endif; endif; endif; endif; enddo; /end-free pCheckITrf e c*==================================================================== c* CheckOTrf(); = Compair what is in the status file DDODSTP(OutBound) c* to what is in the array. If the set is still in the file and the c* array then the set has not moved in 15 minutes and send up the flag. c*==================================================================== p CheckOTrf b d CheckOTrf pi /free ClearSF5(); clear FeedBacko; setll *start ddodstp; dou %eof(ddodstp); read DDODST0 sOutBound; if %eof(ddodstp); else; if sOutBound.oddsts <> '500'; setll rrno ddodst0; read ddodst0; o = %lookup(sOutBound:OutBoundS); if o > 0; SndTrfMsg(sOutBound.odsetn: sOutBound.odtnod: 'O'); rrn5 = rrn5 + 1; if statusO(o) = *blanks; statusO(o) = 'T'; *in52 = *on; write panel5sf; elseif statusO(o) = 'T'; *in52 = *off; *in53 = *on; write panel5sf; endif; endif; endif; endif; enddo; /end-free pCheckOTrf e c*==================================================================== c* Dsp01(); = Initial status display to the user. c*==================================================================== p Dsp01 b d Dsp01 pi /free write panel1; message = 'Loading Sets From Status Files...'; SndPgmMsg(' ': ' ': message: 35: '*INFO ': '*': 2: ' ': ErrorInfo); write panel2; /end-free p Dsp01 e c*==================================================================== c* Dsp02(); = Write out results of first load. c*==================================================================== p Dsp02 b d Dsp02 pi /free write panel1; message = 'Initial Load Results On Screen...'; SndPgmMsg(' ': ' ': message: 35: '*INFO ': '*': 2: ' ': ErrorInfo); write panel2; write panel3; if rrn4 = 0; write panel6; else; write panel4sfc; endif; if rrn5 = 0; write panel7; else; write panel5sfc; endif; /end-free p Dsp02 e c*==================================================================== c* Dsp03(); = Display to the user that the 15 minute is about to be c* performed. c*==================================================================== p Dsp03 b d Dsp03 pi /free write panel1; message = 'Performing 15 Minute Check...'; SndPgmMsg(' ': ' ': message: 35: '*INFO ': '*': 2: ' ': ErrorInfo); write panel2; /end-free p Dsp03 e c*==================================================================== c* Dsp04(); = Display out the results of the 15 minute check. c*==================================================================== p Dsp04 b d Dsp04 pi /free write panel1; message = 'Results Of 15 Minute Check...'; SndPgmMsg(' ': ' ': message: 35: '*INFO ': '*': 2: ' ': ErrorInfo); write panel2; write panel3; if rrn4 = 0; write panel6; else; write panel4sfc; endif; if rrn5 = 0; write panel7; else; write panel5sfc; endif; /end-free p Dsp04 e c*==================================================================== c* DateTime(); = Calculate correct dates and times. c*==================================================================== p DateTime b d DateTime pi /free timestamp = %timestamp; timestamp = timestamp - %hours(3); date = %date(timestamp); time = %time(timestamp); timestamp = timestamp + %minutes(15); date2 = %date(timestamp); time2 = %time(timestamp); /end-free p DateTime e c*==================================================================== c* ClearSF4(); = Reset subfile panel4sf. c*==================================================================== p ClearSF4 b d ClearSF4 pi /free *in40 = *on; *in41 = *off; write panel4sfc; *in40 = *off; *in41 = *on; rrn4 = 0; /end-free p ClearSF4 e c*==================================================================== c*ClearSF5(); = Reset subfile panel5sf. c*==================================================================== p ClearSF5 b d ClearSF5 pi /free *in50 = *on; *in51 = *off; write panel5sfc; *in50 = *off; *in51 = *on; rrn5 = 0; /end-free p ClearSF5 e c*==================================================================== c* ClearAll(); = Reset various data structures and record formats. c*==================================================================== p ClearAll b d ClearAll pi /free setll *start ddidstp; setll *start ddodstp; clear InBound; clear sInBound; clear OutBound; clear sOutBound; i = 0; o = 0; clear FeedBacki; clear FeedBacko; clear statusi; clear statuso; *in42 = *off; *in43 = *off; *in52 = *off; *in53 = *off; /end-free p ClearAll e c*==================================================================== c* END OF PROTOTYPES c*====================================================================
return to main page