PROGRAM REMIND,1.0(100)

PROGRAM REMIND,1.0(100)
!
! =============================
! // OPERATOR REMINDER UTILITY \\
! //=============================\\
! << BY THE GREAT & MIGHTY OZ >>
! //==============\\============================//================\\
! || * * * * * E D I T H I S T O R Y * * * * * ||
! || ||
! || 8/27/85 program created. /dmm ||
! || Sends a reminder message to be display (on bottom ||
! || status line) at a certain time on a users terminal ||
! || and then can optionally beep every miniute for 30 ||
! || minutes to remind them of the message. ||
! || Has a companion program call WATCHR.RUN which must ||
! || be running in another job to monitor and display ||
! || messages. SYSMEM.SBR must be loaded into system ||
! || memory (if you don't have SYSMEM.SBR you may copy ||
! || COMMON.SBR to SYSMEM.SBR). /dmm ||
! || The following is needed to use this system. ||
! || 1. UTLMNU.RUN (MENU) ||
! || 2. USERS.RUN (DEFINES SYSTEM USERS) ||
! || 3. SNDMSG.RUN (OPTIONAL) ||
! || 4. WATCHR.RUN (TO BE RUN IN A BACKGROUND JOB) ||
! || 5. REMIND.RUN (ENTER AND SEND MESSAGES) ||
! || 6. CLRMSG.RUN (PURGES OUT OLD MESSAGES) ||
! || 7. SYSMEM.SBR (COMMON.SBR) ||
! || 8. INFLD.SBR (YOU MAY USE INPUT.SBR WITH MINOR ||
! || CHANGES) ||
! || 9. ANYCN.SBR ||
! || 10. MESAG.SBR ||
! || 11. NOECHO.SBR ||
! || 12. JOBGET.SBR (OPTIONAL) ||
! || 13. TSTKEY.SBR (OPTIONAL) ||
! || 14. FLOCK.SBR (OPTIONAL) ||
! || 15. RDATE.SBR (OPTIONAL) ||
! || ||
! || **** IMPORTANT **** ||
! || THESE PROGRAMS ARE SET UP TO WORK ON A TVI925 & ||
! || MAY REQUIRE SOME CHANGES TO WORK ON OTHERS. ||
! || ||
! \\==============<<============================>>================//
! \\==========================//
!
MAP1 PRGTITLE,S,60,"REMIND.BAS BY DENNIS MCCABE ON 27AUG85 AT WILLITTS DESIGNS "
! //=============================\\
! || REMINDER FILE RECORD LAYOUT ||
! \\=============================//
!
MAP1 REMIND
MAP2 RDATE,S,6
MAP2 RSEND
MAP3 RTIME
MAP4 RHOUR,S,2
MAP4 RMIN,S,2
MAP3 RNAME,S,6
MAP3 RMESAG,S,70
MAP3 RBEEPS,B,1
MAP1 RRECSIZE,F,,102
MAP1 DUMREM
MAP2 JUNK,S,2
MAP2 ORGREM,F
MAP2 RECREM,F
MAP2 MAXREM,F
MAP2 DELREM,F
MAP1 JOBTBL
MAP2 JOBNO,B,1
MAP2 JOBNAM,S,6
MAP2 JOBTRM,S,6
MAP2 JOBPRG,S,6
MAP2 JOBDEV,S,3
MAP2 JOBDVR,B,2
MAP2 JOBPPN
MAP3 JOB'PROG,B,1
MAP3 JOB'PROJ,B,1
MAP3 JOBUSR,B,2,@JOBPPN
MAP2 JOBCPU,B,4
MAP2 JOBDSR,B,4
MAP2 JOBDSW,B,4
MAP2 JOBCON,S,10
XCALL JOBGET,JOBTBL !<---<<< ****(OPTIONAL)****
!
! //===========================\\
! || COMMON TRANSFER WORK AREA ||
! \\===========================//
!
!
MAP1 SEND,B,1,0
MAP1 MSGTXT
MAP2 JTIME
MAP3 JHOUR,S,2
MAP3 JMIN,S,2
MAP2 JNAME,S,6
MAP2 JMESAG,S,70
MAP2 JBEEPS,B,1
MAP1 MSGNAM,S,6,"TICKLE"
MAP1 RECV
MAP2 F'RCV,B,1,1
MAP2 RCVFLG,B,1,0
MAP1 RCVTXT,S,1
MAP1 RCVNAM,S,6,"GOTCHA"
MAP1 USERS
MAP2 JOBNAMS(30),S,6
MAP2 TRMDEFS(30),S,6
MAP1 FILENAME,S,10,"USERS.DAT"
MAP1 RECSIZ99,F,6,LEN(USERS)
MAP1 NUMFIL,F,6,30
MAP1 FILNAM,S,20
MAP1 CTLX
MAP2 ROW,S,2
MAP2 FILL'1,S,1
MAP2 COL,S,2
MAP2 FILL'2,S,1
MAP2 XMAX,S,2
MAP2 FILL'3,S,1
MAP2 XMIN,S,2
MAP2 FILL'4,S,1
MAP2 TYPE,S,24
MAP1 CTL,S,36,@CTLX
MAP1 ENTRY,S,70
MAP1 MAXREC,F,,3000
MAP1 DOW,S,9
MAP1 MONTH,F
MAP1 DAY,F
MAP1 YEAR,F
MAP1 ANSWER,F
MAP1 BRACKS,S,102,"]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]"
MAP1 TODAY,S,6
MAP1 AMPM,S,2
XCALL NOECHO
FILEBASE 1
OPEN #99, FILENAME, RANDOM, RECSIZ99, FILE99
FILE99 = 1
READ #99, USERS
CLOSE #99
? TAB(-1,0);
? TAB(-1,11);"//============================================================================\\"
? TAB(2,1); "|| O P E R A T O R D A I L Y R E M I N D E R U T I L I T Y ||"
? TAB(3,1); "\\============================================================================//"
FILNAM="REMIND.DAT"
LOOKUP FILNAM,FOUND
IF FOUND=0 CALL INITALIZE ELSE CALL OPEN
ON ERROR GOTO ERR'TRAP
FILID=9
CALL CHK'OPEN
? TAB(5,1);TAB(-1,10);TAB(-1,11);
? TAB(5,1); " 1. DATE"
? TAB(6,1); " 2. TIME "
? TAB(7,1); " 3. JOB"
? TAB(8,1); " 4. MESSAGE"
? TAB(10,1);" 5. OPTIONAL BEEPS"
? TAB(-1,12);
GDATE:
? TAB(-1,13);
? TAB(5,20);TAB(-1,10);
CDATE:
CTL="05,20,06,00,dE"
CALL INPUT
IF INXCTL GOTO DONE
RDATE=ENTRY USING "#ZZZZZ"
MONTH=RDATE[1,2] : DAY=RDATE[3,4] : YEAR=RDATE[5,6]
CALL GET'DOW
? TAB(5,30);TAB(-1,9);DOW
ON CNGCTL GOTO ANYCNG
HOUR:
CALL GET'TIME
DEFLT=1
ENTRY=HOURS USING "#Z"
CTL="06,20,02,02,#F"
CALL INPUT
JHOUR=ENTRY
IF VAL(JHOUR) < 1 OR VAL(JHOUR) > 12 XCALL MESAG,"",3 : GOTO HOUR
MIN:
? TAB(6,22);":";
CTL="06,23,02,02,#FW"
ENTRY=MINS USING "#Z"
CALL INPUT
JMIN=ENTRY
IF VAL(JMIN) < 0 OR VAL(JMIN) > 59 XCALL MESAG,"",3 : GOTO MIN
AMPM:
ENTRY=AMPM
CTL="06,26,02,02,A"
CALL INPUT
DEFLT=0
IF ENTRY # "AM" AND ENTRY # "PM" XCALL MESAG,"",3 : GOTO AMPM
IF ENTRY="PM" AND VAL(JHOUR) # 12 JHOUR=STR(VAL(JHOUR)+12) USING "#Z"
ON CNGCTL GOTO ANYCNG
JOB:
DEFLT=1
FOR I = 1 TO 30
IF JOBNAMS(I)=JOBNAM GOTO NXTJOB
NEXT I
NXTJOB:
IF I > NUMFIL I=1
IF JOBNAMS(I)=SPACE(6) AND I # 1 I=I+1 : GOTO NXTJOB
ENTRY=JOBNAMS(I)
CTL="07,20,06,01,AT"
CALL INPUT
IF INXCTL=3 I=I+1 : GOTO NXTJOB
JNAME=ENTRY
DEFLT=0
ON CNGCTL GOTO ANYCNG
MESSAGE:
ENTRY=JMESAG
CTL="09,02,70,00,A"
CALL INPUT
JMESAG=ENTRY
ON CNGCTL GOTO ANYCNG
BEEPS:
CTL="10,20,01,00,YN"
CALL INPUT
IF INXCTL=1 JBEEPS=30 ELSE JBEEPS=0
GOTO ANYCNG
SEND:
DEFLT=0
IF JNAME="ALL" GOTO SEND'ALL
CALL SENDIT
GOTO GDATE
SEND'ALL:
FOR I = 1 TO NUMFIL
JNAME=JOBNAMS(I)
IF JNAME="" GOTO NEXT'I
? TAB(24,1);TAB(-1,9);"SENDING TO ";JNAME;
CALL SENDIT
NEXT'I:
NEXT I
? TAB(24,1);TAB(-1,9);
GOTO GDATE
SENDIT:
XCALL FLOCK,3,2,RTNCDE,FILID,1
XCALL RDATE,FLTDAY : TODAY=FLTDAY USING "#ZZZZZ"
IF RDATE # TODAY GOTO JST'WRITE
XCALL SYSMEM,SEND,MSGNAM,MSGTXT
OK:
XCALL SYSMEM,RECV,RCVNAM,RCVTXT
IF RCVFLG=0 GOTO OK
JST'WRITE:
CALL WRITE'RECORD
XCALL FLOCK,5,0,RTNCDE,FILID,1
RETURN
DONE:
XCALL FLOCK,2,0,RTNCDE,FILID,0
CHAIN "UTLMNU"
ANYCNG:
XCALL ANYCN,CNGCTL,WHATNO
ON CNGCTL+1 GOTO SEND,CNGBR,HOUR
GOTO SEND
CNGBR:
DEFLT=1
ON WHATNO GOTO CDATE,HOUR,JOB,MESSAGE,BEEPS
BADCNG:
CNGCTL = 3
GOTO ANYCNG
WRITE'RECORD:
FILID=9999
RECNUM=1
XCALL FLOCK,3,2,RTNCDE,FILID,1
READ #FILID,DUMREM
RECREM=RECREM+1
IF RECREM = MAXREM XCALL MESAG,"file is now full, no more recrods may be added",2 : GOTO WRT'RTN
IF RECREM > MAXREM-10 XCALL MESAG,"file is almost full & should be cleared of old records",2
WRITE #FILID,DUMREM
RECNUM=RECREM
RSEND=MSGTXT
WRITE #FILID,REMIND
WRT'RTN:
XCALL FLOCK,5,0,RTNCDE,FILID,1
RETURN
INPUT:
XCALL INPUT,ROW,COL,XMAX,XMIN,TYPE,ENTRY,INXCTL,1,DEFLT,EXTCODE,TIMER
RETURN
GET'TIME:
T=TIME
CLOCK=60
HOURS=INT(T/(CLOCK^2))
MINS=INT(T/CLOCK)-(HOURS*60)
H'MOD:
AMPM="AM"
IF HOURS > 23 HOURS=HOURS-24 : GOTO H'MOD
IF HOURS > 12 HOURS=HOURS-12 : AMPM="PM"
? TAB(6,20);HOURS USING "#Z";":";MINS USING "#Z";" ";AMPM
RETURN
GET'DOW:
if (MONTH > 2) then goto CALC
MONTH = (MONTH + 12)
YEAR = (YEAR - 1)
CALC:
ANSWER = (((((((DAY + (2 * MONTH)) + int((0.6 * (MONTH + 1)))) + YEAR) + int((YEAR &
/ 4))) - int((YEAR / 100))) + int((YEAR / 400))) + 2)
ANSWER = int(((((ANSWER / 7) - int((ANSWER / 7))) * 7) + 0.5))
if (ANSWER > 0) then goto MONDAY
DOW= "SUNDAY"
RETURN
MONDAY:
if (ANSWER > 1) then goto TUESDAY
DOW="MONDAY"
RETURN
TUESDAY:
if (ANSWER > 2) then goto WEDNESDAY
DOW="TUESDAY"
RETURN
WEDNESDAY:
if (ANSWER > 3) then goto THURSDAY
DOW="WEDNESDAY"
RETURN
THURSDAY:
if (ANSWER > 4) then goto FRIDAY
DOW="THURSDAY"
RETURN
FRIDAY:
if (ANSWER > 5) then goto SATURDAY
DOW="FRIDAY"
RETURN
SATURDAY:
DOW="SATURDAY"
RETURN
INITALIZE:
? TAB(10,1);TAB(-1,10)"REMINDER MESSAGE FILE NOT FOUND, DO YOU WISH TO CREATE ";
CTL="10,60,01,00,YN"
CALL INPUT
IF INXCTL=2 GOTO DONE
? TAB(24,1);"Creating file, please wait...";
SIZE = INT((MAXREC)/INT(512/RRECSIZE)) + 1
ALLOCATE FILNAM,SIZE
FILID=9999
CALL CHK'OPEN
OPEN #FILID,FILNAM,RANDOM'FORCED,RRECSIZE,RECNUM
FOR RECNUM = 2 TO MAXREC
WRITE #FILID,BRACKS[1;RRECSIZE]
NEXT RECNUM
RECNUM=1
ORGREM=1 :RECREM=1 : MAXREM=MAXREC
DELREM=0
WRITE #FILID,DUMREM
XCALL MESAG,"FILE CREATED",2
RETURN
OPEN:
FILID=9999
CALL CHK'OPEN
OPEN #FILID,FILNAM,RANDOM'FORCED,RRECSIZE,RECNUM
RECNUM=1
READ #FILID,DUMREM
RETURN
CHK'OPEN:
INXCTL=0
XCALL FLOCK,0,4,RTNCDE,FILID,0
IF RTNCDE CALL SHAL'WE'WAIT
IF INXCTL=2 GOTO FLOCK'ABORT
RETURN
SHAL'WE'WAIT:
IF RTNCDE=0 GOTO FLOCK'ERR
? TAB(23,1);TAB(-1,10);"FILE#";FILID;FILNAM;" IS UNAVAILABLE ";
? TAB(24,1);"DO YOU WISH TO WAIT (Y/N)";
XCALL INPUT,24,30,01,01,"YN",ENTRY,INXCTL,1
? TAB(23,1);TAB(-1,10);
IF INXCTL=2 RETURN
TRY'OPEN:
XCALL FLOCK,0,4,RTNCDE,FILID,0
IF RTNCDE=0 RETURN
IF RTNCDE>1 GOTO FLOCK'ERR
XCALL TSTKEY,CHAR
IF CHAR=27 GOTO SHAL'WE'WAIT
? TAB(24,1);TAB(-1,9);" WAITING....";
GOTO TRY'OPEN
ERR'TRAP:
? TAB(20,1);TAB(-1,14);TAB(-1,10);"********************************************************************************"
? TAB(21,1);"ERROR CODE ";ERR(0);"IN LINE #";ERR(1);"OF ";JOBPRG;".RUN"
? TAB(22,1);"********************************************************************************"
XCALL FLOCK,2,0,RTNCDE,FILID,0
END
FLOCK'ABORT:
XCALL FLOCK,2,0,RTNCDE,FILID,0
XCALL MESAG,"JOB ABORTED BY OPERATOR",2
CHAIN "MASMEN"
RECORD'LOCKED:
IF RTNCDE > 1 GOTO FLOCK'ERR
? TAB(23,1);TAB(-1,10);"RECORD IS UNAVALIABLE"
? TAB(24,1);"DO YOU WISH TO WAIT (Y/N)";
XCALL INPUT,24,30,01,00,"YN",ENTRY,INXCTL,1
? TAB(23,1);TAB(-1,10);
IF INXCTL=2 RETURN
TRY'REC:
XCALL FLOCK,3,6,RTNCDE,FILID,FILE1
IF RTNCDE=0 RETURN
XCALL TSTKEY,CHAR
IF CHAR=27 GOTO RECORD'LOCKED
? TAB(24,1);TAB(-1,9);" WAITING....";
GOTO TRY'REC
FLOCK'ERR:
? TAB(23,1);"*** FLOCK ERROR ****";RTNCDE;TAB(-1,10);
XCALL MESAG,"JOB ABORTED",2
XCALL FLOCK,2,0,RTNCDE,FILID,0
END