home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
log
/
cor_log
/
cor.prg
< prev
next >
Wrap
Text File
|
1988-12-02
|
83KB
|
3,589 lines
* COR.PRG - Tickler database system
************************************************************
* CORMAIN *
************************************************************
* CORMAIN Main Menu and Calling Program
CLEAR ALL
CLEAR
SET MENU ON
SET STATUS OFF
SET ESCAPE OFF
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
SET BELL OFF
SET CONFIRM ON
SET SCOREBOARD OFF
SET DELETED ON
SET ODOMETER TO 10
SET PROCEDURE TO COR
IF .NOT. FILE("CORMEM.MEM")
DO CORSETUP
RESTORE FROM CORMEM
ELSE
RESTORE FROM CORMEM
ENDIF .NOT. FILE(
IF mdelim = "Y"
SET DELIMITERS TO "[]"
SET DELIMITERS ON
ENDIF mdelim
* SET COLORS
IF ISCOLOR()
SET COLOR TO &mcolor
ELSE
SET COLOR TO &mbw
ENDIF
CLEAR
TEXT
┌────────┐ ┌────────┐ ┌────────┐ ┌────────┐ ┌────────┐ ┌────────┐
│ █ ▀▀▀▀ │ │ █ ▀▀▀█ │ │ █ ▀▀▀█ │ │ ██ │ │ █ ▀▀▀█ │ │ █ ▀▀▀ │
│ ██ │ │ ██ █ │ │ ██▄▄▄█ │ │ ██ │ │ ██ █ │ │ ██ │
│ ██ │ │ ██ █ │ │ ███ │ │ ██ │ │ ██ █ │ │ ██ ▀█ │
│ ██▄▄▄▄ │ │ ██▄▄ █ │ │ ██ █▄▄ │ ▄▄ │ █ ▄▄▄▄ │ │ ██▄▄ █ │ │ ██▄▄ █ │
└────────┘ └────────┘ └────────┘ └────────┘ └────────┘ └────────┘
C O R R E S P O N D A N C E C O N T R O L S Y S T E M
by M. W. Praskievicz - May 1988
ENDTEXT
@ 23,1 SAY ""
kount = 0
DO WHILE INKEY() = 0
kount = kount + 1
IF kount > 1000
EXIT
ENDIF kount
ENDDO WHILE INKEY()....
RELEASE kount
CLEAR
* RECORD SYSTEM DATE INTO PROGRAM AND VARIOUS DEFAULTS
STORE DTOC(DATE()) TO mdate
@ 2,17 SAY TRIM(ORGANIZ) + " " + TRIM(mheader)
@ 6,17 SAY "ENTER DATE (MM/DD/YY)" GET mdate PICTURE "99/99/99"
@ 7,17 SAY "Press ENTER to confirm choices "
@ 9,17 SAY "Please enter the letter that identifies the"
@ 10,17 SAY "disk drive containing PROGRAM files:" GET prg_drv PICTURE "!!"
@ 12,17 SAY "Please enter the letter that identifies the"
@ 13,17 SAY "disk drive containing DATA files:" GET file_drv PICTURE "!!"
@ 19,17 SAY "Use <PgDn> key if information is OK"
@ 1,1 TO 16,78 DOUBLE
@ 3,2 TO 3,77
READ
PUBLIC FOX
STORE file_drv + "CORDUM" TO CORDUM
STORE file_drv + "COR" TO COR
STORE file_drv + "CORKEY" TO CORKEY
STORE prg_drv + "CORMEM" TO CORMEM
STORE SUBSTR(LTRIM(STR(YEAR(DATE()))),3,2) TO YY
CLEAR
? " One moment please... "
* SET UP FILES
SET DEFA TO &file_drv
USE &COR
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SET TALK OFF
CLEAR
? " One moment please... "
SET DEFA TO &prg_drv
SELECT 1
USE &COR INDEX &COR
SELECT 2
USE &CORDUM
SELECT 1
* REMOVE STRAY BLANK RECORDS
GOTO TOP
DELETE ALL FOR SERIAL_NO = 0
PACK
GOTO TOP
DO WHILE .T.
SELECT 1
CLEAR
@ 2,15 SAY TRIM(mheader) + " - Main Menu"
@ 5,15 SAY "NR. MODULE"
@ 5,55 SAY " "+ DTOC(DATE())
@ 7,15 SAY "[1] ADD new incoming record"
@ 8,15 SAY "[2] Add new OUTGOING record"
@ 9,15 SAY "[3] EDIT record information"
@ 10,15 SAY "[4] DISPLAY record information"
@ 11,15 SAY "[5] PRINT route sheets and labels"
@ 12,15 SAY "[6] Mark records as COMPLETE"
@ 13,15 SAY "[7] UTILITIES Menu"
@ 14,15 SAY "[8] REPORTS"
@ 15,15 SAY "[9] Not used..."
@ 17,15 SAY "[F] dBASE; [Q] QUIT"
@ 1,1 TO 21,78 DOUBLE
@ 3,2 TO 3,77
@ 23,15 SAY "WARNING - Backup your data disk once per week !"
STORE "0" TO mod
@ 19,15 SAY "Enter choice:" GET mod PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
DO CASE
* ADD RECORD - Incoming
CASE mod = "1" .OR. mod = "A"
DO CORADD
CLOSE DATABASES
USE &COR INDEX &COR
* ADD RECORD - Outgoing
CASE mod = "2" .OR. mod = "O"
DO CORADD2
CLOSE DATABASES
USE &COR INDEX &COR
* EDIT RECORD
CASE mod = "3" .OR. mod = "E"
DO CORFIX
CLOSE DATABASES
USE &COR INDEX &COR
* DISPLAY RECORD
CASE mod = "4" .OR. mod = "D"
DO CORDIS
* PRINT ROUTE SHEETS AND LABELS
CASE mod = "5" .OR. mod = "P"
DO CORRTE
CLOSE DATABASES
USE &COR INDEX &COR
* MARK RECORDS AS COMPLETE
CASE mod = "6" .OR. mod = "C"
DO CORCOMP
CLOSE DATABASES
USE &COR INDEX &COR
* UTILITIES PROGRAM
CASE mod = "7" .OR. mod = "U"
DO CORUTI
* REPORTS
CASE MOD = "8" .OR. mod = "R"
DO CORRT0
* RETURN TO DATABASE PROGRAM
CASE mod = "F"
CLEAR
SET STATUS ON
SET DELIMITERS OFF
SET DELIMITERS TO DEFAULT
SET MENU ON
SET DELETED OFF
IF .NOT. ISCOLOR()
SET COLOR TO W,I
ENDIF .NOT. ISCOLOR()
RELEASE FOX
SAVE TO CORMEM
SET PROCEDURE TO
CLEAR ALL
RETURN
* RETURN TO SYSTEM
CASE mod = "Q"
CLEAR
RELEASE FOX
SAVE TO CORMEM
? "EXITING CORLOG and database programs"
QUIT
OTHERWISE
CLEAR
? CHR(7)
@ 22,25 SAY "ILLEGAL ANSWER - TRY AGAIN"
WAIT " "
ENDCASE
ENDDO
* EOF CORMAIN
************************************************************
* CORADD *
************************************************************
PROCEDURE CORADD
* CORADD Add new records
GOTO BOTTOM
STORE SERIAL_NO TO newdoc
STORE "X" to decide
CLEAR
* CORADD Routine
SELECT 2
USE &CORDUM
DO WHILE .T.
CLEAR
STORE newdoc+1 TO newdoc
APPEND BLANK
REPLACE SERIAL_NO WITH newdoc
REPLACE TYPE_COR WITH "L"
REPLACE CLASSIF WITH "U"
REPLACE COR_TO WITH organiz
REPLACE CONTROL_NO WITH YY + "-" + LTRIM(STR(SERIAL_NO))
REPLACE RESP_CODE WITH "O"
REPLACE COR_FILE WITH "00000"
@ 1, 10 SAY "ADD Screen - Incoming Correspondance CONTROL NO"
@ 1, 72 SAY CORDUM->CONTROL_NO FUNCTION "!"
@ 4, 11 SAY "TYPE"
@ 4, 16 GET CORDUM->TYPE_COR PICTURE "!"
@ 4, 18 SAY "M-message,L-letter,N-navgram,E-elect mail,T-T/COMM"
@ 5, 1 SAY "CLASSIFICATION"
@ 5, 16 GET CORDUM->CLASSIF PICTURE "!"
@ 5, 18 SAY "T-top secret,S-secret,C-conf,U-unclas"
@ 7, 4 SAY "FROM"
@ 7, 9 GET CORDUM->COR_FROM
@ 8, 6 SAY "TO"
@ 8, 9 GET CORDUM->COR_TO
@ 10, 1 SAY "SUBJECT"
@ 10, 9 GET CORDUM->COR_SUBJ PICTURE "@!"
@ 12, 8 SAY "FILE NO"
@ 12, 16 GET CORDUM->COR_FILE PICTURE "!9999"
@ 12, 22 SAY "Correspondance file code (SSIC) such as 07300 or 11000"
@ 13, 9 SAY "REF NO"
@ 13, 16 GET CORDUM->COR_REF_NO PICTURE "!!!!!!!!!!!!!!"
@ 13, 31 SAY "Reference no. or date-time group"
@ 14, 6 SAY "SERIAL NO"
@ 14, 16 GET CORDUM->COR_SER_NO PICTURE "!!!!!"
@ 15, 11 SAY "DATE"
@ 15, 16 GET CORDUM->COR_DATE PICTURE "99/99/99"
@ 15, 25 SAY "Date of correspondance"
@ 15, 53 SAY "DATE DUE"
@ 15, 62 GET CORDUM->DUE_DATE PICTURE "99/99/99"
@ 17, 8 SAY "ROUTING"
@ 17, 16 GET CORDUM->ROUTE_1 PICTURE "!!!!"
@ 17, 21 GET CORDUM->ACT_INFO_1 PICTURE "!"
@ 17, 25 GET CORDUM->ROUTE_2 PICTURE "!!!!"
@ 17, 30 GET CORDUM->ACT_INFO_2 PICTURE "!"
@ 17, 34 GET CORDUM->ROUTE_3 PICTURE "!!!!"
@ 17, 39 GET CORDUM->ACT_INFO_3 PICTURE "!"
@ 17, 43 GET CORDUM->ROUTE_4 PICTURE "!!!!"
@ 17, 48 GET CORDUM->ACT_INFO_4 PICTURE "!"
@ 17, 52 GET CORDUM->ROUTE_5 PICTURE "!!!!"
@ 17, 57 GET CORDUM->ACT_INFO_5 PICTURE "!"
@ 17, 62 GET CORDUM->ROUTE_6 PICTURE "!!!!"
@ 17, 67 GET CORDUM->ACT_INFO_6 PICTURE "!"
@ 18, 17 GET CORDUM->ROUTE_7 PICTURE "!!!!"
@ 18, 22 GET CORDUM->ACT_INFO_7 PICTURE "!"
@ 18, 26 GET CORDUM->ROUTE_8 PICTURE "!!!!"
@ 18, 31 GET CORDUM->ACT_INFO_8 PICTURE "!"
@ 18, 35 GET CORDUM->ROUTE_9 PICTURE "!!!!"
@ 18, 40 GET CORDUM->ACT_INFO_9 PICTURE "!"
@ 18, 44 SAY "Code; A-action,I-info"
@ 20, 7 SAY "KEYWORDS"
@ 20, 16 GET CORDUM->KEYWORD_1 PICTURE "!!!!!!!!!!"
@ 20, 28 GET CORDUM->KEYWORD_2 PICTURE "!!!!!!!!!!"
@ 20, 40 GET CORDUM->KEYWORD_3 PICTURE "!!!!!!!!!!"
@ 2, 1 TO 2, 78 DOUBLE
@ 21, 1 TO 21, 78
@ 23, 5 SAY "Use <PgDn> key if all fields are OK"
READ
@ 23, 5
@ 23,5 SAY "Enter [X] to store and exit, [C] to continue, [A] to abort:";
GET decide PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide = "A"
ZAP
USE
SELECT 1
RETURN
ENDIF
USE
SELECT 1
APPEND FROM &CORDUM FOR COR_SUBJ <> SPACE(50)
SELECT 2
USE &CORDUM
ZAP
IF decide <>"C"
SELECT 1
RETURN
ENDIF
ENDDO
* EOF CORADD
************************************************************
* CORADD2 *
************************************************************
PROCEDURE CORADD2
* CORADD2 Add new records - outgoing
GOTO BOTTOM
STORE SERIAL_NO TO newdoc
STORE "X" to decide
CLEAR
* CORADD2 Routine
SELECT 2
USE &CORDUM
DO WHILE .T.
CLEAR
STORE newdoc+1 TO newdoc
APPEND BLANK
REPLACE SERIAL_NO WITH newdoc
REPLACE TYPE_COR WITH "L"
REPLACE CLASSIF WITH "U"
REPLACE COR_FROM WITH organiz
REPLACE CONTROL_NO WITH YY + "-" + LTRIM(STR(SERIAL_NO))
REPLACE RESP_CODE WITH "X"
REPLACE COR_FILE WITH "00000"
REPLACE COR_SER_NO WITH SUBSTR(CONTROL_NO,4,4)
REPLACE COR_DATE WITH DATE()
REPLACE PRNFLG WITH .T.
REPLACE ACT_INFO_1 WITH "X"
@ 1, 10 SAY "ADD Screen - Outgoing Correspondance CONTROL NO"
@ 1, 72 SAY CORDUM->CONTROL_NO FUNCTION "!"
@ 4, 11 SAY "TYPE"
@ 4, 16 GET CORDUM->TYPE_COR PICTURE "!"
@ 4, 18 SAY "M-message,L-letter,N-navgram,E-elect mail,T-T/COMM"
@ 5, 1 SAY "CLASSIFICATION"
@ 5, 16 GET CORDUM->CLASSIF PICTURE "!"
@ 5, 18 SAY "T-top secret,S-secret,C-conf,U-unclas"
@ 7, 4 SAY "FROM"
@ 7, 9 GET CORDUM->COR_FROM
@ 8, 6 SAY "TO"
@ 8, 9 GET CORDUM->COR_TO
@ 10, 1 SAY "SUBJECT"
@ 10, 9 GET CORDUM->COR_SUBJ PICTURE "@!"
@ 12, 8 SAY "FILE NO"
@ 12, 16 GET CORDUM->COR_FILE PICTURE "!9999"
@ 12, 22 SAY "Correspondance file code (SSIC) such as 07300 or 11000"
@ 14, 6 SAY "SERIAL NO"
@ 14, 16 SAY CORDUM->COR_SER_NO PICTURE "!!!!!"
@ 15, 11 SAY "DATE"
@ 15, 16 GET CORDUM->COR_DATE PICTURE "99/99/99"
@ 15, 25 SAY "Date of correspondance"
@ 17, 5 SAY "ORIGINATOR"
@ 17, 16 GET CORDUM->ROUTE_1 PICTURE "!!!!"
@ 20, 7 SAY "KEYWORDS"
@ 20, 16 GET CORDUM->KEYWORD_1 PICTURE "!!!!!!!!!!"
@ 20, 28 GET CORDUM->KEYWORD_2 PICTURE "!!!!!!!!!!"
@ 20, 40 GET CORDUM->KEYWORD_3 PICTURE "!!!!!!!!!!"
@ 2, 1 TO 2, 78 DOUBLE
@ 21, 1 TO 21, 78
@ 23, 5 SAY "Use <PgDn> key if all fields are OK"
READ
REPLACE COR_REF_NO WITH ROUTE_1
@ 23, 5
@ 23,5 SAY "Enter [X] to store and exit, [C] to continue, [A] to abort:";
GET decide PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide = "A"
ZAP
USE
SELECT 1
RETURN
ENDIF
USE
SELECT 1
APPEND FROM &CORDUM FOR COR_SUBJ <> SPACE(50)
SELECT 2
USE &CORDUM
ZAP
IF decide <>"C"
SELECT 1
RETURN
ENDIF
ENDDO
* EOF CORADD2
************************************************************
* CORBAK *
************************************************************
PROCEDURE CORBAK
* CORBAK Backup or Archive Program
CLEAR
STORE "R" TO mbak
@ 1,5 SAY "ARCHIVE or BACKUP data files"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: CORBAK
PURPOSE: Use to Archive or Backup your data files
WARNING #1 - If you choose to archive or backup to a NEW
diskette, ensure that it is FORMATTED prior to use!
WARNING #2 - Archive only when you wish to clean out the database
and start all over with a clean slate. All existing
database files will be copied to drive A: and all
the data files on your default drive will be emptied!
To update an old fiscal year, you can select drive A:
or whatever on the opening menu for your database files.
ENDTEXT
@ 20,1 TO 20,78
STORE ARC_DRV TO marcdrv
@ 22,5 SAY "ENTER drive for archive of files:" GET marcdrv PICTURE "!!"
READ
@ 23,5 SAY "ENTER [A] for archive, [B] for backup, [R] for return:";
GET mbak PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF mbak <> "A"
IF mbak <> "B"
RETURN
ENDIF
ENDIF
STORE marcdrv TO ARC_DRV
* -----------------------------------------------Backup
STORE COR + ".DBF" TO mcordbf
STORE CORMEM + ".MEM" TO mcormem
IF .NOT. FOX
STORE COR + ".NDX" TO mcorndx
ELSE
STORE COR + ".IDX" TO mcorndx
ENDIF
STORE ARC_DRV + "COR.DBF" TO mcordbf2
STORE ARC_DRV + "CORMEM.MEM" TO mcormem2
IF .NOT. FOX
STORE ARC_DRV + "COR.NDX" TO mcorndx2
ELSE
STORE ARC_DRV + "COR.IDX" TO mcorndx2
ENDIF .NOT. FOX
CLOSE DATABASES
IF mbak = "B"
? "INSERT FORMATTED BACKUP DISKETTE IN DRIVE " + ARC_DRV
WAIT
CLEAR
RUN COPY &mcordbf &mcordbf2
? "COPYING FILE COR.DBF TO "+ARC_DRV
RUN COPY &mcormem &mcormem2
? "COPYING FILE CORMEM.MEM TO "+ARC_DRV
RUN COPY &mcorndx &mcorndx2
IF .NOT. FOX
? "COPYING FILE COR.NDX TO " +ARC_DRV
ELSE
? "COPYING FILE COR.IDX TO " +ARC_DRV
ENDIF .NOT. FOX
SELECT 1
USE &COR INDEX &COR
ENDIF
IF mbak = "A"
? "INSERT FORMATTED BACKUP DISKETTE IN DRIVE " + ARC_DRV
WAIT
CLEAR
RUN COPY &mcordbf &mcordbf2
? "COPYING FILE COR.DBF TO "+ARC_DRV
RUN COPY &mcormem &mcormem2
? "COPYING FILE CORMEM.MEM TO "+ARC_DRV
RUN COPY &mcorndx &mcorndx2
IF .NOT. FOX
? "COPYING FILE COR.NDX TO " +ARC_DRV
ELSE
? "COPYING FILE COR.IDX TO " +ARC_DRV
ENDIF .NOT. FOX
SELECT 1
USE &COR INDEX &COR
ZAP
? "EMPTYING COR.DBF"
ENDIF
RETURN
* EOF CORBAK
************************************************************
* CORCHG *
************************************************************
PROCEDURE CORCHG
* CORCHG Change data drive
CLEAR
@ 1,5 SAY "CHANGE file drive"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: CORCHG
PURPOSE: This routine is useful for changing the designation of
the disk drive containing the data you wish to work with without
restarting the program. For instance, you could have several different
departments stored on different drives (like E: F: G: H: etc.) or else
you can work with archived data on drives A: or B:.
If COR.DBF and its associated files do not exist on the new data drive,
the program will create them. (They will be empty, of course).
ENDTEXT
@ 16,1 TO 16,78
STORE NEWFILE_DRV TO mnewdrv
@ 18,5 SAY "Please enter the letter that identifies the"
@ 19,5 SAY "disk drive containing DATA files:" GET mnewdrv PICTURE "!!"
@ 20,5 SAY "[BLANK to exit]"
READ
CLEAR
? "Resetting file drive to Drive " + mnewdrv
IF mnewdrv = SPACE(2) .OR. mnewdrv = " :" .OR. mnewdrv = ": "
RETURN
ENDIF
STORE mnewdrv to NEWFILE_DRV
STORE NEWFILE_DRV + "COR" TO mtarget1
STORE NEWFILE_DRV + "CORDUM" TO mtarget2
CLOSE DATABASES
IF .NOT. FILE(NEWFILE_DRV + "COR.DBF")
SELECT 1
USE &COR
COPY STRUCTURE TO &mtarget1
ENDIF
IF .NOT. FILE(NEWFILE_DRV + "CORDUM.DBF")
SELECT 2
USE &CORDUM
COPY STRUCTURE TO &mtarget2
ENDIF
STORE NEWFILE_DRV TO FILE_DRV
STORE FILE_DRV + "COR" TO COR
STORE FILE_DRV + "CORDUM" TO CORDUM
CLOSE DATABASES
SELECT 1
USE &COR
INDEX ON SERIAL_NO TO &COR
SELECT 2
USE &CORDUM
SELECT 1
RETURN
* EOF CORCHG
************************************************************
* CORCOMP *
************************************************************
PROCEDURE CORCOMP
* CORCOMP Complete line item
STORE "X" TO decide
DO WHILE .T.
STORE SPACE(7) TO mserial
GOTO TOP
CLEAR
STORE "N" TO decide2
@ 3,1 SAY "Do you wish to display the records? {Y/N}";
GET decide2 PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF decide2="Y"
SET HEADING OFF
DISPLAY ALL CONTROL_NO,COR_DATE,COR_SUBJ FOR RESP_CODE <> "C" OFF
SET HEADING ON
ENDIF
@ 13,43 CLEAR TO 17,70
@ 14,45 SAY "MARK RECORD COMPLETE "
@ 15,45 SAY "Control Number: " GET mserial PICTURE "!!-!!!!"
@ 16,45 SAY "[Blank to exit] "
@ 13,43 TO 17,70
READ
IF mserial =SPACE(7)
RETURN
ENDIF
SEEK VAL(SUBSTR(mserial,4,4))
IF .NOT. EOF()
CLEAR
@ 1,5 SAY "Mark Correspondance Record as COMPLETE"
@ 4,5 SAY "Control Number: "
@ 4,21 SAY CONTROL_NO
@ 6,5 SAY "FROM: "
@ 6,11 SAY COR_FROM
@ 7,5 SAY " TO: "
@ 7,11 SAY COR_TO
@ 8,5 SAY "SUBJ: "
@ 8,11 SAY COR_SUBJ
@ 10,5 SAY " REF: " + RTRIM(COR_FILE) + ";" + ;
RTRIM(COR_REF_NO) + ;
", Serial " + RTRIM(COR_SER_NO) + ;
" of " + DTOC(COR_DATE)
@ 14,5 SAY "To COMPLETE this line item type [P]"
STORE "X" TO decide
@ 15,5 SAY "Exit [X], Process [P]:" GET decide PICTURE "!"
@ 2,1 TO 2,78 DOUBLE
@ 12,1 TO 12,78
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"P"
RETURN
ENDIF
REPLACE RESP_CODE WITH "C"
LOOP
ELSE
STORE "X" TO decide
STORE SPACE(7) TO mserial
@ 10,15 SAY "Control Number not found"
@ 11,15 SAY "[Enter P to try another]"
@ 13,15 SAY "Exit [X], Process [P]:" GET decide PICTURE "!"
@ 8,13 TO 15,47
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"P"
RETURN
ENDIF
LOOP
ENDIF
ENDDO
* EOF CORCOMP
************************************************************
* CORDEL *
************************************************************
PROCEDURE CORDEL
* CORDEL Delete line item
DO WHILE .T.
STORE SPACE(7) TO mserial
GOTO TOP
CLEAR
STORE "N" TO decide2
@ 3,1 SAY "Do you wish to display the records? {Y/N}";
GET decide2 PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF decide2="Y"
SET HEADING OFF
DISPLAY ALL CONTROL_NO,COR_DATE,COR_SUBJ OFF
SET HEADING ON
ENDIF
@ 13,43 CLEAR TO 17,70
@ 14,45 SAY "DELETE RECORD "
@ 15,45 SAY "Control Number: " GET mserial PICTURE "!!-!!!!"
@ 16,45 SAY "[Blank to exit] "
@ 13,43 TO 17,70
READ
IF mserial =SPACE(7)
PACK
RETURN
ENDIF
SEEK VAL(SUBSTR(mserial,4,4))
IF .NOT. EOF()
CLEAR
@ 1,5 SAY "DELETE Correspondance Record"
@ 4,5 SAY "Control Number: "
@ 4,21 SAY CONTROL_NO
@ 6,5 SAY "FROM: "
@ 6,11 SAY COR_FROM
@ 7,5 SAY " TO: "
@ 7,11 SAY COR_TO
@ 8,5 SAY "SUBJ: "
@ 8,11 SAY COR_SUBJ
@ 10,5 SAY " REF: " + RTRIM(COR_FILE) + ";" + ;
RTRIM(COR_REF_NO) + ;
", Serial " + RTRIM(COR_SER_NO) + ;
" of " + DTOC(COR_DATE)
@ 14,5 SAY "To DELETE this line item type [P]"
STORE "X" TO decide
@ 15,5 SAY "Exit [X], Process [P]:" GET decide PICTURE "!"
@ 2,1 TO 2,78 DOUBLE
@ 12,1 TO 12,78
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"P"
PACK
RETURN
ENDIF
DELETE
LOOP
ELSE
STORE "X" TO decide
STORE SPACE(4) TO mserial
@ 10,15 SAY "Serial Number not found"
@ 11,15 SAY "[Enter P to try another]"
@ 13,15 SAY "Exit [X], Process [P]:" GET decide PICTURE "!"
@ 8,13 TO 15,47
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"P"
PACK
RETURN
ENDIF
LOOP
ENDIF
ENDDO
* EOF CORDEL
************************************************************
* CORDIS *
************************************************************
PROCEDURE CORDIS
* CORDIS Edit line items
CLEAR
STORE "X" TO decide
DO WHILE .T.
GOTO TOP
CLEAR
STORE SPACE(7) TO docnmbr
STORE "N" TO decide2
@ 3,1 SAY "Do you wish to display the records? {Y/N}";
GET decide2 PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF decide2="Y"
SET HEADING OFF
DISPLAY ALL CONTROL_NO,COR_DATE,COR_SUBJ OFF
SET HEADING ON
ENDIF
@ 13,43 CLEAR TO 17,70
@ 14,45 SAY "DISPLAY RECORD "
@ 15,45 SAY "Control Number: " GET docnmbr PICTURE "!!-!!!!"
@ 16,45 SAY "[Blank to exit] "
@ 13,43 TO 17,70
READ
IF docnmbr=SPACE(7)
RETURN
ENDIF
CLEAR
SEEK VAL(SUBSTR(docnmbr,4,4))
IF EOF()
CLEAR
@ 10,10 SAY "THAT CONTROL NUMBER IS NOT IN THE DATA BASE!"
@ 11,10 SAY " TRY ANOTHER."
@ 9,8 TO 12,54
?
?
WAIT
LOOP
ENDIF
DO CASE
CASE RESP_CODE = "D"
mrespcode = "dummy record"
CASE RESP_CODE = "C"
mrespcode = "yes"
CASE RESP_CODE = "O"
mrespcode = "no"
OTHERWISE
mrespcode = "not applicable"
ENDCASE
DO CASE
CASE TYPE_COR = "M"
mtypecor = "message"
CASE TYPE_COR = "T"
mtypecor = "telecommunication or wirenote"
CASE TYPE_COR = "L"
mtypecor = "letter"
CASE TYPE_COR = "E"
mtypecor = "electronic mail"
CASE TYPE_COR = "N"
mtypecor = "NAVGRAM"
OTHERWISE
mtypecor = "not indicated"
ENDCASE
DO CASE
CASE CLASSIF = "U"
mclassif = "unclassified"
CASE CLASSIF = "T"
mclassif = "top secret"
CASE CLASSIF = "S"
mclassif = "secret"
CASE CLASSIF = "C"
mclassif = "confidential"
OTHERWISE
mclassif = "not indicated"
ENDCASE
CLEAR
@ 1, 7 SAY "DISPLAY Screen - " + IIF(RESP_CODE="X","OUTGOING CORRESPONDANCE ","INCOMING CORRESPONDANCE ") + " CONTROL NO"
@ 1, 69 SAY COR->CONTROL_NO
@ 4, 11 SAY "TYPE:"
@ 4, 17 SAY mtypecor
@ 5, 1 SAY "CLASSIFICATION:"
@ 5, 17 SAY mclassif
@ 7, 11 SAY "FROM:"
@ 7, 17 SAY COR->COR_FROM
@ 8, 13 SAY "TO:"
@ 8, 17 SAY COR->COR_TO
@ 10, 8 SAY "SUBJECT:"
@ 10, 17 SAY COR->COR_SUBJ
@ 12, 8 SAY "FILE NO:"
@ 12, 17 SAY COR->COR_FILE
@ 13, 9 SAY "REF NO:"
@ 13, 17 SAY COR->COR_REF_NO
@ 14, 6 SAY "SERIAL NO:"
@ 14, 17 SAY COR->COR_SER_NO
@ 15, 11 SAY "DATE:"
@ 15, 17 SAY IIF(DTOC(COR_DATE)=" / / ","not assigned",DTOC(COR_DATE))
@ 15, 53 SAY "DATE DUE:"
@ 15, 63 SAY IIF(DTOC(DUE_DATE)=" / / ","not assigned",DTOC(DUE_DATE))
@ 17, 8 SAY "ROUTING:"
@ 17, 17 SAY COR->ROUTE_1
@ 17, 22 SAY COR->ACT_INFO_1
@ 17, 26 SAY COR->ROUTE_2
@ 17, 31 SAY COR->ACT_INFO_2
@ 17, 35 SAY COR->ROUTE_3
@ 17, 40 SAY COR->ACT_INFO_3
@ 17, 44 SAY COR->ROUTE_4
@ 17, 49 SAY COR->ACT_INFO_4
@ 17, 53 SAY COR->ROUTE_5
@ 17, 58 SAY COR->ACT_INFO_5
@ 17, 63 SAY COR->ROUTE_6
@ 17, 68 SAY COR->ACT_INFO_6
@ 18, 18 SAY COR->ROUTE_7
@ 18, 23 SAY COR->ACT_INFO_7
@ 18, 27 SAY COR->ROUTE_8
@ 18, 32 SAY COR->ACT_INFO_8
@ 18, 36 SAY COR->ROUTE_9
@ 18, 41 SAY COR->ACT_INFO_9
@ 18, 44 SAY "Code; A-action,I-info,X-originator"
@ 20, 7 SAY "KEYWORDS:"
@ 20, 17 SAY COR->KEYWORD_1
@ 20, 29 SAY COR->KEYWORD_2
@ 20, 41 SAY COR->KEYWORD_3
@ 20, 53 SAY "COMPLETE?"
@ 20, 63 SAY mrespcode
@ 2, 1 TO 2, 78 DOUBLE
@ 21, 1 TO 21, 78
@ 23,5 SAY "Display more records? Exit [X] or continue [C]:";
GET decide PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"C"
RETURN
ENDIF
CLEAR
LOOP
ENDDO
* EOF CORDIS
************************************************************
* CORDUM *
************************************************************
PROCEDURE CORDUM
* CORDUM Reset last serial number
GOTO BOTTOM
STORE SERIAL_NO TO mserial
STORE "N" TO change
CLEAR
@ 3,10 SAY "RESET LAST SERIAL NUMBER"
@ 4,10 SAY "Current last serial number: " + YY + "-" + LTRIM(STR(mserial))
@ 10,10 SAY "Do you want to change the next serial number? {Y/N}" ;
GET change PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF change = "N"
RETURN
ENDIF
STORE mserial+1 TO mnewserial
@ 12,10 SAY "Enter revised serial number:" GET mnewserial PICTURE "9999"
READ
IF mnewserial = mserial+1
RETURN
ENDIF mnewserial
CLEAR
SELECT 2
USE &CORDUM
STORE "X" to decide
CLEAR
STORE mnewserial TO newdoc
APPEND BLANK
REPLACE COR_FROM WITH "DUMMY RECORD"
REPLACE COR_TO WITH "DUMMY RECORD"
REPLACE SERIAL_NO WITH newdoc
REPLACE CONTROL_NO WITH YY + "-" + LTRIM(STR(SERIAL_NO))
REPLACE ACT_INFO_1 WITH "D"
REPLACE RESP_CODE WITH "D"
REPLACE PRNFLG WITH .T.
REPLACE COR_SUBJ WITH "DUMMY RECORD - USED TO RESET SERIAL NO."
REPLACE KEYWORD_1 WITH "DUMMY"
USE
SELECT 1
APPEND FROM &CORDUM
SELECT 2
USE &CORDUM
ZAP
SELECT 1
RETURN
* EOF CORDUM
************************************************************
* CORFIX *
************************************************************
PROCEDURE CORFIX
* CORFIX Edit line items
CLEAR
STORE "X" TO decide
DO WHILE .T.
GOTO TOP
CLEAR
STORE SPACE(7) TO docnmbr
STORE "N" TO decide2
@ 3,1 SAY "Do you wish to display the records? {Y/N}";
GET decide2 PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF decide2="Y"
SET HEADING OFF
DISPLAY ALL CONTROL_NO,COR_DATE,COR_SUBJ OFF
SET HEADING ON
ENDIF
@ 13,43 CLEAR TO 17,70
@ 14,45 SAY "CHANGE RECORD "
@ 15,45 SAY "Control Number: " GET docnmbr PICTURE "!!-!!!!"
@ 16,45 SAY "[Blank to exit] "
@ 13,43 TO 17,70
READ
IF docnmbr=SPACE(7)
RETURN
ENDIF
CLEAR
SEEK VAL(SUBSTR(docnmbr,4,4))
IF EOF()
CLEAR
@ 10,10 SAY "THAT CONTROL NUMBER IS NOT IN THE DATA BASE!"
@ 11,10 SAY " TRY ANOTHER."
@ 9,8 TO 12,54
?
?
WAIT
LOOP
ENDIF
CLEAR
@ 1, 10 SAY "EDIT Screen - " + IIF(RESP_CODE="X","OUTGOING CORRESPONDANCE ","INCOMING CORRESPONDANCE ") + " CONTROL NO"
@ 1, 69 SAY COR->CONTROL_NO FUNCTION "!"
@ 4, 11 SAY "TYPE"
@ 4, 16 GET COR->TYPE_COR PICTURE "!"
@ 4, 18 SAY "M-message,L-letter,N-navgram,E-elect mail,T-T/COMM"
@ 5, 1 SAY "CLASSIFICATION"
@ 5, 16 GET COR->CLASSIF PICTURE "!"
@ 5, 18 SAY "T-top secret,S-secret,C-conf,U-unclas"
@ 7, 4 SAY "FROM"
@ 7, 9 GET COR->COR_FROM
@ 8, 6 SAY "TO"
@ 8, 9 GET COR->COR_TO
@ 10, 1 SAY "SUBJECT"
@ 10, 9 GET COR->COR_SUBJ FUNCTION "S50"
@ 12, 8 SAY "FILE NO"
@ 12, 16 GET COR->COR_FILE PICTURE "!9999"
@ 12, 22 SAY "Correspondance file code (SSIC)"
@ 13, 9 SAY "REF NO"
@ 13, 16 GET COR->COR_REF_NO PICTURE "!!!!!!!!!!!!!!"
@ 13, 31 SAY "Reference no. or date-time group"
@ 14, 6 SAY "SERIAL NO"
@ 14, 16 GET COR->COR_SER_NO PICTURE "!!!!!"
@ 15, 11 SAY "DATE"
@ 15, 16 GET COR->COR_DATE
@ 15, 25 SAY "Date of correspondance"
@ 15, 53 SAY "DATE DUE"
@ 15, 62 GET COR->DUE_DATE PICTURE "99/99/99"
@ 17, 8 SAY "ROUTING"
@ 17, 16 GET COR->ROUTE_1 PICTURE "!!!!"
@ 17, 21 GET COR->ACT_INFO_1 PICTURE "!"
@ 17, 25 GET COR->ROUTE_2 PICTURE "!!!!"
@ 17, 30 GET COR->ACT_INFO_2 PICTURE "!"
@ 17, 34 GET COR->ROUTE_3 PICTURE "!!!!"
@ 17, 39 GET COR->ACT_INFO_3 PICTURE "!"
@ 17, 43 GET COR->ROUTE_4 PICTURE "!!!!"
@ 17, 48 GET COR->ACT_INFO_4 PICTURE "!"
@ 17, 52 GET COR->ROUTE_5 PICTURE "!!!!"
@ 17, 57 GET COR->ACT_INFO_5 PICTURE "!"
@ 17, 62 GET COR->ROUTE_6 PICTURE "!!!!"
@ 17, 67 GET COR->ACT_INFO_6 PICTURE "!"
@ 18, 17 GET COR->ROUTE_7 PICTURE "!!!!"
@ 18, 22 GET COR->ACT_INFO_7 PICTURE "!"
@ 18, 26 GET COR->ROUTE_8 PICTURE "!!!!"
@ 18, 31 GET COR->ACT_INFO_8 PICTURE "!"
@ 18, 35 GET COR->ROUTE_9 PICTURE "!!!!"
@ 18, 40 GET COR->ACT_INFO_9 PICTURE "!"
@ 18, 44 SAY "Code; A-action,I-info,X-originator"
@ 20, 7 SAY "KEYWORDS"
@ 20, 16 GET COR->KEYWORD_1 PICTURE "!!!!!!!!!!"
@ 20, 28 GET COR->KEYWORD_2 PICTURE "!!!!!!!!!!"
@ 20, 40 GET COR->KEYWORD_3 PICTURE "!!!!!!!!!!"
@ 20, 53 SAY "COMPLETE?"
@ 20, 63 GET COR->RESP_CODE PICTURE "!"
@ 2, 1 TO 2, 78 DOUBLE
@ 21, 1 TO 21, 78
@ 23,5 SAY "Use <PgDn> key if all fields are OK"
READ
@ 23,5
@ 23,5 SAY "Edit more records? Exit [X] or continue [C]:";
GET decide PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF decide<>"C"
RETURN
ENDIF
CLEAR
LOOP
ENDDO
* EOF CORFIX
************************************************************
* CORKEY *
************************************************************
PROCEDURE CORKEY
* CORKEY.PRG - FILE MANAGER FOR KEYWORD PROGRAM TO COMPLEMENT COR.PRG
CLEAR
SELECT 4
USE &CORKEY INDEX &CORKEY
SELECT 1
* -----------------------------------------------MENU
CLEAR
DO WHILE .T.
CLEAR
STORE "9" TO kchoice
@ 2,15 SAY "KEYWORD to document locator utility - Menu"
@ 5,15 SAY "NR. MODULE"
@ 5,55 SAY " "+ DTOC(DATE())
@ 7,15 SAY " 1. DISPLAY the keyword dictionary"
@ 8,15 SAY " 2. PRINT the keyword dictionary "
@ 9,15 SAY " 3. LOCATE and display documents by keyword"
@ 10,15 SAY " 4. UPDATE keywords"
@ 11,15 SAY " 5. Not used"
@ 12,15 SAY " 6. Not used"
@ 13,15 SAY " 7. Not used"
@ 14,15 SAY " 8. Not used"
@ 15,15 SAY " 9. RETURN to calling menu"
@ 1,1 TO 19,78 DOUBLE
@ 3,2 TO 3,77
@ 17,15 SAY "Enter choice:" GET kchoice PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
DO CASE
* -----------------------------------------------DISPLAY KEYWORDS
CASE kchoice = "1" .OR. kchoice = "D"
SELECT 4
R = 4
@ 1,5 SAY "KEYWORDS currently in use"
@ 2,1 TO 2,78 DOUBLE
IF KEYWORD_C = SPACE(10)
SKIP
ENDIF
DO WHILE .NOT. EOF()
IF R = 19
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
R = 4
ENDIF R = 19
@ R, 5 SAY KEYWORD_C
SKIP
IF EOF()
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
EXIT
ENDIF EOF()
@ R,20 SAY KEYWORD_C
SKIP
IF EOF()
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
EXIT
ENDIF EOF()
@ R,35 SAY KEYWORD_C
SKIP
IF EOF()
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
EXIT
ENDIF EOF()
@ R,50 SAY KEYWORD_C
SKIP
IF EOF()
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
EXIT
ENDIF EOF()
@ R,65 SAY KEYWORD_C
SKIP
IF EOF()
@ 21,1 TO 21,78
@ 22,5 SAY ""
WAIT
EXIT
ENDIF EOF()
R = R +1
ENDDO WHILE .NOT. EOF()
GOTO TOP
SELECT 1
* -----------------------------------------------PRINT KEYWORDS
CASE kchoice = "2" .OR. kchoice = "P"
? " Printing keyword list ...."
?
SET DEVICE TO PRINT
SET PRINT ON
@ 0,0
SELECT 4
R = 9
@ 7,5 SAY "KEYWORDS currently in use as of " ;
+ DTOC(DATE())
IF KEYWORD_C = SPACE(10)
SKIP
ENDIF
DO WHILE .NOT. EOF()
IF R = 55
EJECT
R = 9
ENDIF R = 55
@ R, 5 SAY KEYWORD_C
SKIP
IF EOF()
EXIT
ENDIF EOF()
@ R,20 SAY KEYWORD_C
SKIP
IF EOF()
EXIT
ENDIF EOF()
@ R,35 SAY KEYWORD_C
SKIP
IF EOF()
EXIT
ENDIF EOF()
@ R,50 SAY KEYWORD_C
SKIP
IF EOF()
EXIT
ENDIF EOF()
@ R,65 SAY KEYWORD_C
SKIP
R = R +1
ENDDO WHILE .NOT. EOF()
GOTO TOP
EJECT
SET PRINT OFF
SET DEVICE TO SCREEN
SELECT 1
CLEAR
CASE kchoice = "3" .OR. kchoice = "L"
* -----------------------------------------------FIND RECORDS MATCHING KEYWORDS
SELECT 1
@ 1,5 SAY "FIND records matching keywords"
@ 2,1 TO 2,78 DOUBLE
m_key = SPACE(10)
zchoice = "D"
bchoice = "Y"
TEXT
Enter the KEYWORD you wish to find. A count of records containing this
keyword will be shown.
ENDTEXT
@ 9,1 TO 9,78
@ 11,5 SAY "Enter KEYWORD" ;
GET m_key PICTURE "!!!!!!!!!!"
@ 11,30 SAY " [Blank to exit]"
READ
IF m_key = SPACE(10)
LOOP
ENDIF m_key
kounter = 0
kounter1 = 0
kounter2 = 0
kounter3 = 0
COUNT ALL FOR KEYWORD_1 = m_key TO kounter1
COUNT ALL FOR KEYWORD_2 = m_key TO kounter2
COUNT ALL FOR KEYWORD_3 = m_key TO kounter3
kounter = kounter1 + kounter2 + kounter3
@ 13,5 SAY "There are(is) " + LTRIM(STR(kounter)) +;
" record(s) containing the keyword " +;
m_key
@ 15,5 SAY "Display [D], Return [R]:" GET zchoice ;
PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF zchoice = "R"
LOOP
ENDIF zchoice
GOTO TOP
CLEAR
LOCATE ALL FOR KEYWORD_1 = m_key
DO WHILE .NOT. EOF()
bchoice = "Y"
IF FOUND()
DO CORKEYDS
ENDIF FOUND()
@ 23,0
@ 23,5 SAY "Continue? {Y/N}" ;
GET bchoice PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF bchoice = "Y"
CONTINUE
LOOP
ELSE
EXIT
ENDIF bchoice
ENDDO WHILE .NOT. EOF()
GOTO TOP
LOCATE ALL FOR KEYWORD_2 = m_key
DO WHILE .NOT. EOF()
IF bchoice = "N"
EXIT
ENDIF
bchoice = "Y"
IF FOUND()
DO CORKEYDS
ENDIF FOUND()
@ 23,0
@ 23,5 SAY "Continue? {Y/N}" ;
GET bchoice PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF bchoice = "Y"
CONTINUE
LOOP
ELSE
EXIT
ENDIF bchoice
ENDDO WHILE .NOT. EOF()
GOTO TOP
LOCATE ALL FOR KEYWORD_3 = m_key
DO WHILE .NOT. EOF()
IF bchoice = "N"
EXIT
ENDIF
bchoice = "Y"
IF FOUND()
DO CORKEYDS
ENDIF FOUND()
@ 23,0
@ 23,5 SAY "Continue? {Y/N}" ;
GET bchoice PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF bchoice = "Y"
CONTINUE
LOOP
ELSE
EXIT
ENDIF bchoice
ENDDO WHILE .NOT. EOF()
GOTO TOP
CLEAR
CASE kchoice = "4" .OR. kchoice = "U"
* -----------------------------------------------UPDATE KEYWORDS
CLEAR
IF FOX
m_tempndx = FILE_DRV + "TEMP.IDX"
ELSE
m_tempndx = FILE_DRV + "TEMP.NDX"
ENDIF FOX
SELECT 4
ZAP
SELECT 1
INDEX ON KEYWORD_1 TO &m_tempndx
SET UNIQUE ON
GOTO TOP
? "COMPARING KEYWORDS - MAY TAKE A FEW MINUTES"
?
? "Checking KEYWORD_1 in all COR.DBF files"
DO WHILE .NOT. EOF()
newkey = KEYWORD_1
SELECT 4
GOTO TOP
LOCATE FOR KEYWORD_C = newkey
IF .NOT. FOUND()
APPEND BLANK
REPLACE KEYWORD_C WITH newkey
ENDIF
SELECT 1
SKIP
ENDDO .NOT. EOF()
INDEX ON KEYWORD_2 TO &m_tempndx
SET UNIQUE ON
GOTO TOP
? "Checking KEYWORD_2 in all COR.DBF files"
DO WHILE .NOT. EOF()
newkey = KEYWORD_2
SELECT 4
GOTO TOP
LOCATE FOR KEYWORD_C = newkey
IF .NOT. FOUND()
APPEND BLANK
REPLACE KEYWORD_C WITH newkey
ENDIF
SELECT 1
SKIP
ENDDO .NOT. EOF()
INDEX ON KEYWORD_3 TO &m_tempndx
SET UNIQUE ON
GOTO TOP
? "Checking KEYWORD_3 in all COR.DBF files"
DO WHILE .NOT. EOF()
newkey = KEYWORD_3
SELECT 4
GOTO TOP
LOCATE FOR KEYWORD_C = newkey
IF .NOT. FOUND()
APPEND BLANK
REPLACE KEYWORD_C WITH newkey
ENDIF
SELECT 1
SKIP
ENDDO .NOT. EOF()
SET UNIQUE OFF
CLEAR
SET INDEX TO
SET INDEX TO &COR
DELETE FILE &m_tempndx
GOTO TOP
SELECT 4
GOTO TOP
* -----------------------------------------------
* CASE kchoice = "5" .OR. kchoice = " "
* CASE kchoice = "6" .OR. kchoice = " "
* CASE kchoice = "7" .OR. kchoice = " "
* CASE kchoice = "8" .OR. kchoice = " "
CASE kchoice = "9" .OR. kchoice = "R"
RETURN
CLOSE DATABASES
USE &COR INDEX &COR
OTHERWISE
?? CHR(7)
@ 23,20 SAY "ILLEGAL ANSWER - TRY AGAIN!"
WAIT ""
CLEAR
LOOP
ENDCASE
LOOP
ENDDO WHILE .T.
* EOF CORKEY.PRG
************************************************************
* CORKEYDS *
************************************************************
PROCEDURE CORKEYDS
* CORKEYDS - Display screen for CORKEY LOCATOR program
DO CASE
CASE RESP_CODE = "D"
mrespcode = "dummy record"
CASE RESP_CODE = "C"
mrespcode = "yes"
CASE RESP_CODE = "O"
mrespcode = "no"
OTHERWISE
mrespcode = "not applicable"
ENDCASE
DO CASE
CASE TYPE_COR = "M"
mtypecor = "message"
CASE TYPE_COR = "T"
mtypecor = "telecommunication or wirenote"
CASE TYPE_COR = "L"
mtypecor = "letter"
CASE TYPE_COR = "E"
mtypecor = "electronic mail"
CASE TYPE_COR = "N"
mtypecor = "NAVGRAM"
OTHERWISE
mtypecor = "not indicated"
ENDCASE
DO CASE
CASE CLASSIF = "U"
mclassif = "unclassified"
CASE CLASSIF = "T"
mclassif = "top secret"
CASE CLASSIF = "S"
mclassif = "secret"
CASE CLASSIF = "C"
mclassif = "confidential"
OTHERWISE
mclassif = "not indicated"
ENDCASE
CLEAR
@ 1, 7 SAY "DISPLAY Screen - " + IIF(RESP_CODE="X","OUTGOING CORRESPONDANCE ","INCOMING CORRESPONDANCE ") + " CONTROL NO"
@ 1, 69 SAY COR->CONTROL_NO
@ 4, 11 SAY "TYPE:"
@ 4, 17 SAY mtypecor
@ 5, 1 SAY "CLASSIFICATION:"
@ 5, 17 SAY mclassif
@ 7, 11 SAY "FROM:"
@ 7, 17 SAY COR->COR_FROM
@ 8, 13 SAY "TO:"
@ 8, 17 SAY COR->COR_TO
@ 10, 8 SAY "SUBJECT:"
@ 10, 17 SAY COR->COR_SUBJ
@ 12, 8 SAY "FILE NO:"
@ 12, 17 SAY COR->COR_FILE
@ 13, 9 SAY "REF NO:"
@ 13, 17 SAY COR->COR_REF_NO
@ 14, 6 SAY "SERIAL NO:"
@ 14, 17 SAY COR->COR_SER_NO
@ 15, 11 SAY "DATE:"
@ 15, 17 SAY IIF(DTOC(COR_DATE)=" / / ","not assigned",DTOC(COR_DATE))
@ 15, 53 SAY "DATE DUE:"
@ 15, 63 SAY IIF(DTOC(DUE_DATE)=" / / ","not assigned",DTOC(DUE_DATE))
@ 17, 8 SAY "ROUTING:"
@ 17, 17 SAY COR->ROUTE_1
@ 17, 22 SAY COR->ACT_INFO_1
@ 17, 26 SAY COR->ROUTE_2
@ 17, 31 SAY COR->ACT_INFO_2
@ 17, 35 SAY COR->ROUTE_3
@ 17, 40 SAY COR->ACT_INFO_3
@ 17, 44 SAY COR->ROUTE_4
@ 17, 49 SAY COR->ACT_INFO_4
@ 17, 53 SAY COR->ROUTE_5
@ 17, 58 SAY COR->ACT_INFO_5
@ 17, 63 SAY COR->ROUTE_6
@ 17, 68 SAY COR->ACT_INFO_6
@ 18, 18 SAY COR->ROUTE_7
@ 18, 23 SAY COR->ACT_INFO_7
@ 18, 27 SAY COR->ROUTE_8
@ 18, 32 SAY COR->ACT_INFO_8
@ 18, 36 SAY COR->ROUTE_9
@ 18, 41 SAY COR->ACT_INFO_9
@ 18, 44 SAY "Code; A-action,I-info,X-originator"
@ 20, 7 SAY "KEYWORDS:"
@ 20, 17 SAY COR->KEYWORD_1
@ 20, 29 SAY COR->KEYWORD_2
@ 20, 41 SAY COR->KEYWORD_3
@ 20, 53 SAY "COMPLETE?"
@ 20, 63 SAY mrespcode
@ 2, 1 TO 2, 78 DOUBLE
@ 21, 1 TO 21, 78
RETURN
* EOF CORKEYDS
************************************************************
* COROLD *
************************************************************
PROCEDURE COROLD
* COROLD - Use to file completed items to COROLD.DBF
CLEAR
@ 1,5 SAY "FILE completed items"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: COROLD
PURPOSE: Use to file completed items to COROLD.DBF. Suggest using
drive A: floppy with separate disk for each quarter.
ENDTEXT
@ 13,1 TO 13,78
@ 15,5 SAY "ENTER drive with COROLD.DBF files:" GET ARC_DRV PICTURE "!!"
@ 16,5 SAY "[Blank to exit]"
@ 18,5 SAY "If your storage drive does not have COROLD files on it,"
@ 19,5 SAY "the program will create them for you."
READ
IF ARC_DRV = " "
CLEAR
RETURN
ENDIF
IF ARC_DRV = ": "
CLEAR
RETURN
ENDIF
IF ARC_DRV = " :"
CLEAR
RETURN
ENDIF
CLEAR
STORE ARC_DRV +"COROLD" TO COROLD
SET DEFA TO &ARC_DRV
IF .NOT. FILE("COROLD.DBF")
COPY STRU TO &COROLD
ENDIF
USE
SET DEFA TO &PRG_DRV
SELECT 3
USE &COROLD
? "APPENDING COMPLETED RECORDS TO COROLD.DBF..."
APPEND FROM &COR FOR RESP_CODE = "C"
INDEX ON SERIAL_NO TO &COROLD
USE
SELECT 1
USE &COR INDEX &COR
? "DELETING ALL COMPLETED RECORDS FROM COR.DBF..."
DELETE ALL FOR RESP_CODE = "C"
PACK
CLEAR
RETURN
* EOF COROLD
************************************************************
* CORRT0 *
************************************************************
PROCEDURE CORRT0
* CORRT0 Report menu
DO WHILE .T.
CLEAR
STORE "R" TO mchoice
@ 2,15 SAY TRIM(mheader) + " - Reports Menu"
@ 5,15 SAY "NR. MODULE"
@ 5,55 SAY " "+ DTOC(DATE())
@ 7,15 SAY "[1] Listing of OVERDUE items"
@ 8,15 SAY "[2] Listing of items coming DUE"
@ 9,15 SAY "[3] Listing of all PENDING items"
@ 10,15 SAY "[4] Listing of COMPLETED items"
@ 11,15 SAY "[5] SERIAL log outgoing correspondance"
@ 12,15 SAY "[6] Listing of ARCHIVED completed items"
@ 13,15 SAY "[7] Not used"
@ 14,15 SAY "[8] KEYWORD utility"
@ 15,15 SAY "[9] Not used..."
@ 17,15 SAY "[R] RETURN to calling menu"
@ 19,15 SAY "Enter choice:" GET mchoice PICTURE "!"
@ 1,1 TO 21,78 DOUBLE
@ 3,2 TO 3,77
SET CONFIRM OFF
READ
SET CONFIRM ON
DO CASE
CASE mchoice = "1" .OR. mchoice = "O"
DO CORRT1
CASE mchoice = "2" .OR. mchoice = "D"
DO CORRT2
CASE mchoice = "3" .OR. mchoice = "P"
DO CORRT3
CASE mchoice = "4" .OR. mchoice = "C"
DO CORRT4
CASE mchoice = "5" .OR. mchoice = "S"
DO CORRT5
CASE mchoice = "6" .OR. mchoice = "A"
DO CORRT6
* CASE mchoice = "7"
CASE mchoice = "8" .OR. mchoice = "K"
DO CORKEY
CASE mchoice = "R"
RETURN
OTHERWISE
CLEAR
? CHR(7)
@ 22,25 SAY "ILLEGAL ANSWER - TRY AGAIN"
WAIT " "
ENDCASE
ENDDO
* EOF CORRT0
************************************************************
* CORRT1 *
************************************************************
PROCEDURE CORRT1
* CORRT1 Listing of OVERDUE items
CLEAR
STORE SPACE(4) TO action_code
@ 1,5 SAY "Listing of OVERDUE items"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT1
PURPOSE: COR database listing of OVERDUE items.
PRINTER REQUIREMENTS: This report uses 80 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
CLEAR
SET TALK ON
INDEX ON SERIAL_NO to &COR
SET TALK OFF
SET FILTER TO (DUE_DATE < DATE()) .AND. (RESP_CODE = "O")
GOTO TOP
CLEAR
DO CASE
CASE display="S"
CLEAR
GOTO TOP
@ 1,1 SAY "CONTROL#"
@ 1,11 SAY "FROM/REFERENCE/SUBJECT"
@ 1,61 SAY "ACTION"
@ 1,68 SAY "DATE DUE"
@ 2,1 SAY REPLICATE("-",77)
R = 4
DO WHILE .NOT. EOF()
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ R,1 SAY CONTROL_NO
@ R,11 SAY RTRIM(COR_FROM) + mtype
@ R,61 SAY action_code
@ R,68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ R+1,11 SAY mcorfile + mcorref + mcorser + mcordate
@ R+2,11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ R+3,1 SAY ""
IF R = 20
WAIT
@ 4,0 CLEAR
R = 0
ENDIF
R = R+4
SKIP
LOOP
ENDDO WHILE .NOT. EOF()
@ 22,1 SAY " "
WAIT
CLEAR
CASE display="P"
STORE 61 TO tline
STORE 2 TO tcolumn
STORE 0 TO pagenum
GOTO TOP
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
IF tline > 55
STORE 1 TO tline
STORE pagenum + 1 TO pagenum
@ tline, tcolumn + 1 SAY "Page " + STR(pagenum,3)
@ tline + 1,tcolumn + 1 SAY DATE()
@ tline + 2,tcolumn + 11 SAY TRIM(mheader) + ;
" - OVERDUE CORRESPONDANCE"
@ tline + 4,tcolumn + 1 SAY "CONTROL#"
@ tline + 4,tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 4,tcolumn + 61 SAY "ACTION"
@ tline + 4,tcolumn + 68 SAY "DATE DUE"
STORE tline + 6 TO tline
ENDIF
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline,tcolumn + 1 SAY CONTROL_NO
@ tline,tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline,tcolumn + 61 SAY action_code
@ tline,tcolumn + 68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ tline + 1,tcolumn + 11 SAY mcorfile + mcorref + mcorser + mcordate
@ tline + 2,tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 3,tcolumn + 1 SAY ""
STORE tline + 4 TO tline
SKIP
LOOP
ENDDO
EJECT
SET DEVICE TO SCREEN
SET PRINT OFF
ENDCASE
CLEAR
SET FILTER TO
GOTO TOP
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SET TALK OFF
CLEAR
RETURN
* EOF CORRT1
************************************************************
* CORRT2 *
************************************************************
PROCEDURE CORRT2
* CORRT2 Listing of items coming due
CLEAR
STORE SPACE(4) TO action_code
@ 1,5 SAY "Listing of items COMING due"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT2
PURPOSE: COR database listing of items COMING due.
PRINTER REQUIREMENTS: This report uses 80 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
CLEAR
SET TALK ON
INDEX ON SERIAL_NO to &COR
SET TALK OFF
SET FILTER TO (((DUE_DATE - 14) < DATE()) .AND. DUE_DATE >= DATE()) ;
.AND. (RESP_CODE = "O")
GOTO TOP
CLEAR
DO CASE
CASE display="S"
CLEAR
GOTO TOP
@ 1,1 SAY "CONTROL#"
@ 1,11 SAY "FROM/REFERENCE/SUBJECT"
@ 1,61 SAY "ACTION"
@ 1,68 SAY "DATE DUE"
@ 2,1 SAY REPLICATE("-",77)
R = 4
DO WHILE .NOT. EOF()
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ R,1 SAY CONTROL_NO
@ R,11 SAY RTRIM(COR_FROM) + mtype
@ R,61 SAY action_code
@ R,68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ R+1,11 SAY mcorfile + mcorref + mcorser + mcordate
@ R+2,11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ R+3,1 SAY ""
IF R = 20
WAIT
@ 4,0 CLEAR
R = 0
ENDIF
R = R+4
SKIP
LOOP
ENDDO WHILE .NOT. EOF()
@ 22,1 SAY " "
WAIT
CLEAR
CASE display="P"
STORE 61 TO tline
STORE 2 TO tcolumn
STORE 0 TO pagenum
GOTO TOP
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
IF tline > 55
STORE 1 TO tline
STORE pagenum + 1 TO pagenum
@ tline, tcolumn + 1 SAY "Page " + STR(pagenum,3)
@ tline + 1,tcolumn + 1 SAY DATE()
@ tline + 2,tcolumn + 11 SAY TRIM(mheader) + ;
" - CORRESPONDANCE COMING DUE"
@ tline + 4,tcolumn + 1 SAY "CONTROL#"
@ tline + 4,tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 4,tcolumn + 61 SAY "ACTION"
@ tline + 4,tcolumn + 68 SAY "DATE DUE"
STORE tline + 6 TO tline
ENDIF
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline,tcolumn + 1 SAY CONTROL_NO
@ tline,tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline,tcolumn + 61 SAY action_code
@ tline,tcolumn + 68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ tline + 1,tcolumn + 11 SAY mcorfile + mcorref + mcorser + mcordate
@ tline + 2,tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 3,tcolumn + 1 SAY ""
STORE tline + 4 TO tline
SKIP
LOOP
ENDDO
EJECT
SET DEVICE TO SCREEN
SET PRINT OFF
ENDCASE
CLEAR
SET FILTER TO
GOTO TOP
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SET TALK OFF
CLEAR
RETURN
* EOF CORRT2
************************************************************
* CORRT3 *
************************************************************
PROCEDURE CORRT3
* CORRT3 Listing of PENDING items
CLEAR
STORE SPACE(4) TO action_code
@ 1,5 SAY "Listing of PENDING items"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT3
PURPOSE: COR database listing of PENDING items.
PRINTER REQUIREMENTS: This report uses 80 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
CLEAR
SET TALK ON
INDEX ON SERIAL_NO to &COR
SET TALK OFF
SET FILTER TO RESP_CODE = "O"
GOTO TOP
CLEAR
DO CASE
CASE display="S"
CLEAR
GOTO TOP
@ 1,1 SAY "CONTROL#"
@ 1,11 SAY "FROM/REFERENCE/SUBJECT"
@ 1,61 SAY "ACTION"
@ 1,68 SAY "DATE DUE"
@ 2,1 SAY REPLICATE("-",77)
R = 4
DO WHILE .NOT. EOF()
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ R,1 SAY CONTROL_NO
@ R,11 SAY RTRIM(COR_FROM) + mtype
@ R,61 SAY action_code
@ R,68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ R+1,11 SAY mcorfile + mcorref + mcorser + mcordate
@ R+2,11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ R+3,1 SAY ""
IF R = 20
WAIT
@ 4,0 CLEAR
R = 0
ENDIF
R = R+4
SKIP
LOOP
ENDDO WHILE .NOT. EOF()
@ 22,1 SAY " "
WAIT
CLEAR
CASE display="P"
STORE 61 TO tline
STORE 2 TO tcolumn
STORE 0 TO pagenum
GOTO TOP
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
IF tline > 55
STORE 1 TO tline
STORE pagenum + 1 TO pagenum
@ tline, tcolumn + 1 SAY "Page " + STR(pagenum,3)
@ tline + 1,tcolumn + 1 SAY DATE()
@ tline + 2,tcolumn + 11 SAY TRIM(mheader) + ;
" - CORRESPONDANCE PENDING"
@ tline + 4,tcolumn + 1 SAY "CONTROL#"
@ tline + 4,tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 4,tcolumn + 61 SAY "ACTION"
@ tline + 4,tcolumn + 68 SAY "DATE DUE"
STORE tline + 6 TO tline
ENDIF
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline,tcolumn + 1 SAY CONTROL_NO
@ tline,tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline,tcolumn + 61 SAY action_code
@ tline,tcolumn + 68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ tline + 1,tcolumn + 11 SAY mcorfile + mcorref + mcorser + mcordate
@ tline + 2,tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 3,tcolumn + 1 SAY ""
STORE tline + 4 TO tline
SKIP
LOOP
ENDDO
EJECT
SET DEVICE TO SCREEN
SET PRINT OFF
ENDCASE
CLEAR
SET FILTER TO
GOTO TOP
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SET TALK OFF
CLEAR
RETURN
* EOF CORRT3
************************************************************
* CORRT4 *
************************************************************
PROCEDURE CORRT4
* CORRT4 Listing of COMPLETED items
CLEAR
STORE SPACE(4) TO action_code
@ 1,5 SAY "Listing of COMPLETED items"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT4
PURPOSE: COR database listing of COMPLETED items.
PRINTER REQUIREMENTS: This report uses 80 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
CLEAR
SET TALK ON
INDEX ON SERIAL_NO to &COR
SET TALK OFF
SET FILTER TO RESP_CODE = "C"
GOTO TOP
CLEAR
DO CASE
CASE display="S"
CLEAR
GOTO TOP
@ 1,1 SAY "CONTROL#"
@ 1,11 SAY "FROM/REFERENCE/SUBJECT"
@ 1,61 SAY "ACTION"
@ 1,68 SAY "DATE DUE"
@ 2,1 SAY REPLICATE("-",77)
R = 4
DO WHILE .NOT. EOF()
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ R,1 SAY CONTROL_NO
@ R,11 SAY RTRIM(COR_FROM) + mtype
@ R,61 SAY action_code
@ R,68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ R+1,11 SAY mcorfile + mcorref + mcorser + mcordate
@ R+2,11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ R+3,1 SAY ""
IF R = 20
WAIT
@ 4,0 CLEAR
R = 0
ENDIF
R = R+4
SKIP
LOOP
ENDDO WHILE .NOT. EOF()
@ 22,1 SAY " "
WAIT
CLEAR
CASE display="P"
STORE 61 TO tline
STORE 2 TO tcolumn
STORE 0 TO pagenum
GOTO TOP
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
IF tline > 55
STORE 1 TO tline
STORE pagenum + 1 TO pagenum
@ tline, tcolumn + 1 SAY "Page " + STR(pagenum,3)
@ tline + 1,tcolumn + 1 SAY DATE()
@ tline + 2,tcolumn + 11 SAY TRIM(mheader) + ;
" - CORRESPONDANCE COMPLETED"
@ tline + 4,tcolumn + 1 SAY "CONTROL#"
@ tline + 4,tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 4,tcolumn + 61 SAY "ACTION"
@ tline + 4,tcolumn + 68 SAY "DATE DUE"
STORE tline + 6 TO tline
ENDIF
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline,tcolumn + 1 SAY CONTROL_NO
@ tline,tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline,tcolumn + 61 SAY action_code
@ tline,tcolumn + 68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ tline + 1,tcolumn + 11 SAY mcorfile + mcorref + mcorser + mcordate
@ tline + 2,tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 3,tcolumn + 1 SAY ""
STORE tline + 4 TO tline
SKIP
LOOP
ENDDO
EJECT
SET DEVICE TO SCREEN
SET PRINT OFF
ENDCASE
CLEAR
SET FILTER TO
GOTO TOP
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SET TALK OFF
CLEAR
RETURN
* EOF CORRT4
************************************************************
* CORRT5 *
************************************************************
PROCEDURE CORRT5
* CORRT5 Serial log of outgoing correspondance
CLEAR
@ 1,5 SAY "Serial log of outgoing correspondance"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT5
PURPOSE: Program will filter out all records except outgoing cor-
respondance and display same in serial sequence.
PRINTER REQUIREMENTS: This report uses 132 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
GOTO BOTT
mstop = SERIAL_NO
GOTO TOP
mstart = SERIAL_NO
@ 15,5 SAY "Enter STARTING SERIAL_NO (nnnn format)" GET mstart PICTURE "9999"
@ 16,5 SAY "Enter ENDING SERIAL_NO (nnnn format)" GET mstop PICTURE "9999"
READ
CLEAR
SET FILTER TO (SERIAL_NO >= mstart .AND. SERIAL_NO <= mstop)
GOTO TOP
IF display = "P"
REPORT FORM CORRT5 FOR RESP_CODE = "X" TO PRINT
ELSE
REPORT FORM CORRT5 FOR RESP_CODE = "X"
WAIT
ENDIF
SET FILTER TO
GOTO TOP
RETURN
* EOF CORRT5
************************************************************
* CORRT6 *
************************************************************
PROCEDURE CORRT6
* CORRT6 Listing of COMPLETED items
CLEAR
STORE SPACE(4) TO action_code
@ 1,5 SAY "Listing of COMPLETED items"
@ 2,1 TO 2,78 DOUBLE
TEXT
REPORT NAME: CORRT6
PURPOSE: COROLD database listing of ARCHIVED completed items.
The program will look for this database on the archive drive.
PRINTER REQUIREMENTS: This report uses 80 columns.
ENDTEXT
STORE "S" TO display
@ 11,1 TO 11,78
@ 13,5 SAY "ENTER [S] for screen, [P] for printer, [R] to return:";
GET display PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF display <> "P"
IF display <> "S"
RETURN
ENDIF
ENDIF
@ 15,5 SAY "ENTER drive with COROLD.DBF files:" GET ARC_DRV PICTURE "!!"
@ 16,5 SAY "[Blank to exit]"
READ
IF ARC_DRV = " "
CLEAR
RETURN
ENDIF
IF ARC_DRV = ": "
CLEAR
RETURN
ENDIF
IF ARC_DRV = " :"
CLEAR
RETURN
ENDIF
CLEAR
STORE ARC_DRV +"COROLD" TO COROLD
SET DEFA TO &ARC_DRV
IF .NOT. FILE("COROLD.DBF")
? CHR(7)
@ 23,5 SAY "COROLD.DBF does not exist on drive " + ARC_DRV +;
" - please try again!"
WAIT ""
SET DEFA TO &PRG_DRV
RETURN
ENDIF
SELECT 3
USE &COROLD INDEX &COROLD
CLEAR
SET TALK ON
INDEX ON SERIAL_NO to &COROLD
SET TALK OFF
DO CASE
CASE display="S"
CLEAR
GOTO TOP
@ 1,1 SAY "CONTROL#"
@ 1,11 SAY "FROM/REFERENCE/SUBJECT"
@ 1,61 SAY "ACTION"
@ 1,68 SAY "DATE DUE"
@ 2,1 SAY REPLICATE("-",77)
R = 4
DO WHILE .NOT. EOF()
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ R,1 SAY CONTROL_NO
@ R,11 SAY RTRIM(COR_FROM) + mtype
@ R,61 SAY action_code
@ R,68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ R+1,11 SAY mcorfile + mcorref + mcorser + mcordate
@ R+2,11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ R+3,1 SAY ""
IF R = 20
WAIT
@ 4,0 CLEAR
R = 0
ENDIF
R = R+4
SKIP
LOOP
ENDDO WHILE .NOT. EOF()
@ 22,1 SAY " "
WAIT
CLEAR
CASE display="P"
STORE 61 TO tline
STORE 2 TO tcolumn
STORE 0 TO pagenum
GOTO TOP
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
IF tline > 55
STORE 1 TO tline
STORE pagenum + 1 TO pagenum
@ tline, tcolumn + 1 SAY "Page " + STR(pagenum,3)
@ tline + 1,tcolumn + 1 SAY DATE()
@ tline + 2,tcolumn + 11 SAY TRIM(mheader) + ;
" - CORRESPONDANCE COMPLETED"
@ tline + 4,tcolumn + 1 SAY "CONTROL#"
@ tline + 4,tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 4,tcolumn + 61 SAY "ACTION"
@ tline + 4,tcolumn + 68 SAY "DATE DUE"
STORE tline + 6 TO tline
ENDIF
action_code = SPACE(4)
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline,tcolumn + 1 SAY CONTROL_NO
@ tline,tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline,tcolumn + 61 SAY action_code
@ tline,tcolumn + 68 SAY DTOC(DUE_DATE)
mcorfile = IIF(COR_FILE=SPACE(5),"00000",RTRIM(COR_FILE))
mcorref = IIF(COR_REF_NO=SPACE(14),"","/" + RTRIM(COR_REF_NO))
mcorser = IIF(COR_SER_NO=SPACE(5),"",", Serial " + RTRIM(COR_SER_NO))
mcordate = IIF(DTOC(COR_DATE)=" / / ",""," of " + DTOC(COR_DATE))
@ tline + 1,tcolumn + 11 SAY mcorfile + mcorref + mcorser + mcordate
@ tline + 2,tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 3,tcolumn + 1 SAY ""
STORE tline + 4 TO tline
SKIP
LOOP
ENDDO
EJECT
SET DEVICE TO SCREEN
SET PRINT OFF
ENDCASE
CLEAR
SET FILTER TO
GOTO TOP
SET TALK ON
INDEX ON SERIAL_NO TO &COROLD
SET TALK OFF
USE
SET DEFAULT TO &PRG_DRV
SELECT 1
CLEAR
RETURN
* EOF CORRT6
************************************************************
* CORRTE *
************************************************************
PROCEDURE CORRTE
* CORRTE.PRG Print route sheets or labels
CLEAR
@ 1,5 SAY "PRINT route sheets or labels for use with action correspondance"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: CORRTE.PRG
PURPOSE: Select printing of cover route sheets or labels
Labels may be attached to correspondance vice route sheets. This
may be beneficial where extensive staffing is not required for
most correspondance.
ENDTEXT
@ 13,1 TO 13,78
STORE "R" TO rchoice
@ 15,5 SAY "Print route Sheets [S], labels [L], or Return [R]?" GET rchoice PICTURE "!"
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
IF rchoice = "S"
DO CORRTE1
ENDIF
IF rchoice = "L"
DO CORRTE2
ENDIF
RETURN
* EOF CORRTE.PRG
************************************************************
* CORRTE1 *
************************************************************
PROCEDURE CORRTE1
* CORRTE1.PRG - Print route sheets
CLEAR
GOTO TOP
STORE YY + "-0000" TO mstart
STORE YY + "-0000" TO mstop
STORE "Y" TO pchoice
STORE "U N C L A S S I F I E D - U N C L A S S I F I E D - U N C L A S S I F I E D" TO msg1
STORE "C O N F I D E N T I A L - C O N F I D E N T I A L - C O N F I D E N T I A L" TO msg2
STORE "S E C R E T - S E C R E T - S E C R E T - S E C R E T - S E C R E T - S E C" TO msg3
STORE "T O P S E C R E T - T O P S E C R E T - T O P S E C R E T - T O P S" TO msg4
STORE 2 TO tline
STORE 0 TO tcolumn
@ 1,5 SAY "PRINT Route Sheets"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: CORRTE1.PRG
PURPOSE: This program will print "Route" sheets or cover sheets for action
correspondance. The program will query for which sheets to print.
REQUIREMENTS: Uses an 80 character printer.
ENDTEXT
@ 12,1 TO 12,78
@ 14, 5 SAY "Print all route sheets not previously printed?" GET pchoice PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF pchoice = "N"
@ 14, 5
@ 14, 5 SAY "Enter starting CONTROL_NO:" GET mstart PICTURE "!!-!!!!"
@ 16, 5 SAY "Enter ending CONTROL_NO:" GET mstop PICTURE "!!-!!!!"
READ
val_mstart = VAL(SUBSTR(mstart,4,4))
val_mstop = VAL(SUBSTR(mstop,4,4))
SET FILTER TO (SERIAL_NO >= val_mstart ;
.AND. SERIAL_NO <= val_mstop)
GOTO TOP
IF val_mstart > val_mstop
?? CHR(7)
@ 20,5 SAY "STOP value should be greater than START value!"
WAIT ""
SET FILTER TO
GOTO TOP
RETURN
ENDIF VAL(
IF val_mstop = 0
?? CHR(7)
@ 20,5 SAY "You have selected NO records!"
WAIT ""
SET FILTER TO
GOTO TOP
RETURN
ENDIF VAL(SUBS
ELSE
SET FILTER TO .NOT. PRNFLG
GOTO TOP
ENDIF pchoice
CLEAR
* -----------------------------------------------Print routine
SET DEVICE TO PRINT
SET PRINT ON
DO WHILE .NOT. EOF()
DO CASE
CASE CLASSIF = "U"
msg = msg1
CASE CLASSIF = "C"
msg = msg2
CASE CLASSIF = "S"
msg = msg3
CASE CLASSIF = "T"
msg = msg4
OTHERWISE
msg = SPACE(1)
ENDCASE
DO CASE
CASE TYPE_COR = "M"
mtype = " MESSAGE"
CASE TYPE_COR = "L"
mtype = " LETTER"
CASE TYPE_COR = "N"
mtype = " NAVGRAM"
CASE TYPE_COR = "T"
mtype = " T/COMM"
CASE TYPE_COR = "E"
mtype = " E-MAIL"
OTHERWISE
mtype = SPACE (8)
ENDCASE
action_code = SPACE(4)
IF ACT_INFO_1 = "A"
action_code = ROUTE_1
ENDIF
IF ACT_INFO_2 = "A"
action_code = ROUTE_2
ENDIF
IF ACT_INFO_3 = "A"
action_code = ROUTE_3
ENDIF
IF ACT_INFO_4 = "A"
action_code = ROUTE_4
ENDIF
IF ACT_INFO_5 = "A"
action_code = ROUTE_5
ENDIF
IF ACT_INFO_6 = "A"
action_code = ROUTE_6
ENDIF
IF ACT_INFO_7 = "A"
action_code = ROUTE_7
ENDIF
IF ACT_INFO_8 = "A"
action_code = ROUTE_8
ENDIF
IF ACT_INFO_9 = "A"
action_code = ROUTE_9
ENDIF
@ tline + 6, tcolumn + 1 SAY msg
@ tline + 7, tcolumn + 1 SAY msg
@ tline + 8, tcolumn + 1 SAY msg
@ tline + 9, tcolumn + 1 SAY msg
@ tline + 11, tcolumn + 1 SAY "ROUTE SHEET - Correspondance Attached - Return to MAILROOM when completed"
@ tline + 14, tcolumn + 1 SAY "CONTROL#"
@ tline + 14, tcolumn + 11 SAY "FROM/REFERENCE/SUBJECT"
@ tline + 14, tcolumn + 61 SAY "ACTION"
@ tline + 14, tcolumn + 68 SAY "DATE DUE"
@ tline + 16, tcolumn + 1 SAY CONTROL_NO
@ tline + 16, tcolumn + 11 SAY RTRIM(COR_FROM) + mtype
@ tline + 16, tcolumn + 61 SAY action_code
@ tline + 16, tcolumn + 68 SAY DTOC(DUE_DATE)
@ tline + 17 ,tcolumn + 11 SAY RTRIM(COR_FILE) ;
+ ";" + RTRIM(COR_REF_NO) + ;
", Serial " + RTRIM(COR_SER_NO) + ;
" of " + DTOC(COR_DATE)
@ tline + 18, tcolumn + 11 SAY "SUBJ: " + RTRIM(COR_SUBJ)
@ tline + 28, tcolumn + 1 SAY "ROUTING:"
@ tline + 28, tcolumn + 10 SAY COR->ROUTE_1 ;
+ " " + IIF(ACT_INFO_1="A","ACTION",IIF(ACT_INFO_1="I","Information",""))
@ tline + 28, tcolumn + 35 SAY COR->ROUTE_4 ;
+ " " + IIF(ACT_INFO_4="A","ACTION",IIF(ACT_INFO_4="I","Information",""))
@ tline + 28, tcolumn + 60 SAY COR->ROUTE_7 ;
+ " " + IIF(ACT_INFO_7="A","ACTION",IIF(ACT_INFO_7="I","Information",""))
@ tline + 33, tcolumn + 10 SAY COR->ROUTE_2 ;
+ " " + IIF(ACT_INFO_2="A","ACTION",IIF(ACT_INFO_2="I","Information",""))
@ tline + 33, tcolumn + 35 SAY COR->ROUTE_5 ;
+ " " + IIF(ACT_INFO_5="A","ACTION",IIF(ACT_INFO_5="I","Information",""))
@ tline + 33, tcolumn + 60 SAY COR->ROUTE_8 ;
+ " " + IIF(ACT_INFO_8="A","ACTION",IIF(ACT_INFO_8="I","Information",""))
@ tline + 38, tcolumn + 10 SAY COR->ROUTE_3 ;
+ " " + IIF(ACT_INFO_3="A","ACTION",IIF(ACT_INFO_3="I","Information",""))
@ tline + 38, tcolumn + 35 SAY COR->ROUTE_6 ;
+ " " + IIF(ACT_INFO_6="A","ACTION",IIF(ACT_INFO_6="I","Information",""))
@ tline + 38, tcolumn + 60 SAY COR->ROUTE_9 ;
+ " " + IIF(ACT_INFO_9="A","ACTION",IIF(ACT_INFO_9="I","Information",""))
@ tline + 43, tcolumn + 1 SAY "REMARKS: "
@ tline + 56, tcolumn + 1 SAY msg
@ tline + 57, tcolumn + 1 SAY msg
@ tline + 58, tcolumn + 1 SAY msg
@ tline + 59, tcolumn + 1 SAY msg
REPLACE PRNFLG WITH .T.
EJECT
SKIP
LOOP
ENDDO .NOT. EOF()
SET FILTER TO
GOTO TOP
SET DEVICE TO SCREEN
SET PRINT OFF
RETURN
* EOF CORRTE1.PRG
************************************************************
* CORRTE2 *
************************************************************
PROCEDURE CORRTE2
* CORRTE2.PRG - Print labels
CLEAR
GOTO TOP
STORE YY + "-0000" TO mstart
STORE YY + "-0000" TO mstop
STORE "Y" TO pchoice
@ 1,5 SAY "PRINT Labels"
@ 2,1 TO 2,78 DOUBLE
TEXT
PROGRAM: CORRTE2.PRG
PURPOSE: This program will print two stick-on labels for action
correspondance. The program will query for which labels to print.
REQUIREMENTS: Uses an 80 character printer. The printing is designed
for (3.5" x 15/16" by 1) tractor feed labels.
ENDTEXT
@ 13,1 TO 13,78
@ 15, 5 SAY "Print all labels not previously printed?" GET pchoice PICTURE "Y"
SET CONFIRM OFF
READ
SET CONFIRM ON
IF pchoice = "N"
@ 15, 5
@ 15, 5 SAY "Enter starting CONTROL_NO:" GET mstart PICTURE "!!-!!!!"
@ 17, 5 SAY "Enter ending CONTROL_NO:" GET mstop PICTURE "!!-!!!!"
READ
val_mstart = VAL(SUBSTR(mstart,4,4))
val_mstop = VAL(SUBSTR(mstop,4,4))
SET FILTER TO (SERIAL_NO >= val_mstart ;
.AND. SERIAL_NO <= val_mstop)
GOTO TOP
IF val_mstart > val_mstop
?? CHR(7)
@ 20,5 SAY "STOP value should be greater than START value!"
WAIT ""
SET FILTER TO
GOTO TOP
RETURN
ENDIF
IF val_mstop = 0
?? CHR(7)
@ 20,5 SAY "You have selected NO records!"
WAIT ""
SET FILTER TO
GOTO TOP
RETURN
ENDIF
ELSE
SET FILTER TO .NOT. PRNFLG
GOTO TOP
ENDIF pchoice
CLEAR
* -----------------------------------------------Print routine
SET DEVICE TO PRINT
SET PRINT ON
?? CHR(27) + CHR(67) + CHR(6)
@ 0,0
DO WHILE .NOT. EOF()
@ 1, 1 SAY "CONTROL NUMBER: " + COR->CONTROL_NO
@ 1, 27 SAY "ACTION"
@ 2, 1 SAY "DATE RESP DUE: " + DTOC(COR->DUE_DATE)
@ 2, 27 SAY "COPY"
@ 3, 1 SAY COR->ROUTE_1 + " " + COR->ACT_INFO_1
@ 3, 11 SAY COR->ROUTE_4 + " " + COR->ACT_INFO_4
@ 3, 21 SAY COR->ROUTE_7 + " " + COR->ACT_INFO_7
@ 4, 1 SAY COR->ROUTE_2 + " " + COR->ACT_INFO_2
@ 4, 11 SAY COR->ROUTE_5 + " " + COR->ACT_INFO_5
@ 4, 21 SAY COR->ROUTE_8 + " " + COR->ACT_INFO_8
@ 5, 1 SAY COR->ROUTE_3 + " " + COR->ACT_INFO_3
@ 5, 11 SAY COR->ROUTE_6 + " " + COR->ACT_INFO_6
@ 5, 21 SAY COR->ROUTE_9 + " " + COR->ACT_INFO_9
EJECT
@ 1, 1 SAY "CONTROL NUMBER: " + COR->CONTROL_NO
@ 1, 27 SAY "INFO"
@ 2, 1 SAY "DATE RESP DUE: " + DTOC(COR->DUE_DATE)
@ 2, 27 SAY "COPY"
@ 3, 1 SAY COR->ROUTE_1 + " " + COR->ACT_INFO_1
@ 3, 11 SAY COR->ROUTE_4 + " " + COR->ACT_INFO_4
@ 3, 21 SAY COR->ROUTE_7 + " " + COR->ACT_INFO_7
@ 4, 1 SAY COR->ROUTE_2 + " " + COR->ACT_INFO_2
@ 4, 11 SAY COR->ROUTE_5 + " " + COR->ACT_INFO_5
@ 4, 21 SAY COR->ROUTE_8 + " " + COR->ACT_INFO_8
@ 5, 1 SAY COR->ROUTE_3 + " " + COR->ACT_INFO_3
@ 5, 11 SAY COR->ROUTE_6 + " " + COR->ACT_INFO_6
@ 5, 21 SAY COR->ROUTE_9 + " " + COR->ACT_INFO_9
EJECT
REPLACE PRNFLG WITH .T.
SKIP
LOOP
ENDDO .NOT. EOF()
SET FILTER TO
GOTO TOP
?? CHR(27) + CHR(67) + CHR(80)
SET DEVICE TO SCREEN
SET PRINT OFF
RETURN
* EOF CORRTE2.PRG
************************************************************
* CORUTI *
************************************************************
PROCEDURE CORUTI
* CORUTI Calling program for UTILITIES menu
DO WHILE .T.
CLEAR
STORE "R" TO rptnmbr
@ 2,15 SAY "Utilities Menu"
@ 5,15 SAY "NR. MODULE"
@ 5,55 SAY " "+ DTOC(DATE())
@ 7,15 SAY "[1] BACKUP or archive database"
@ 8,15 SAY "[2] DELETE line items"
@ 9,15 SAY "[3] Reset document NUMBER"
@ 10,15 SAY "[4] Archive COMPLETED items"
@ 11,15 SAY "[5] Reset FILE drive"
@ 12,15 SAY "[6] ReINDEX"
@ 13,15 SAY "[7] SUSPEND"
@ 14,15 SAY "[8] Access to OPERATING system"
@ 15,15 SAY "[9] Not used..."
@ 17,15 SAY "[R] RETURN to main menu"
@ 19,15 SAY "ENTER choice:" GET rptnmbr PICTURE "!"
@ 1,1 TO 21,78 DOUBLE
@ 3,2 TO 3,77
SET CONFIRM OFF
READ
SET CONFIRM ON
CLEAR
* SELECTIONS
DO CASE
* Backup or archive
CASE rptnmbr = "1" .OR. rptnmbr = "B"
DO CORBAK
* Delete record
CASE rptnmbr = "2" .OR. rptnmbr = "D"
DO CORDEL
* Reset next record number
CASE rptnmbr = "3" .OR. rptnmbr = "N"
DO CORDUM
* Store completed items
CASE rptnmbr = "4" .OR. rptnmbr = "C"
DO COROLD
* Reset file drive designation
CASE rptnmbr = "5" .OR. rptnmbr = "F"
DO CORCHG
* Reindex
CASE rptnmbr = "6" .OR. rptnmbr = "I"
SET TALK ON
CLOSE DATABASES
SELECT 1
USE &COR INDEX &COR
SELECT 4
USE &CORKEY INDEX &CORKEY
SELECT 1
SET TALK ON
INDEX ON SERIAL_NO TO &COR
SELECT 4
INDEX ON KEYWORD_C TO &CORKEY
SET TALK OFF
USE
SELECT 1
CLEAR
* Suspend operation to dBASE
CASE rptnmbr = "7" .OR. rptnmbr = "S"
SET MESSAGE TO "Type RESUME to return to COR_LOG"
SET STATUS ON
SUSPEND
CLOSE DATABASES
SELECT 1
USE COR INDEX COR
SET STATUS OFF
SET MESSAGE TO
* Command processor
CASE rptnmbr = "8" .OR. rptnmbr = "O"
RUN COMMAND
* Return to main menu
CASE rptnmbr = "R"
RETURN
OTHERWISE
CLEAR
? CHR(7)
@ 22,25 SAY "ILLEGAL ANSWER - TRY AGAIN"
WAIT " "
ENDCASE
ENDDO
* EOF CORUTI
************************************************************
* CORSETUP *
************************************************************
PROCEDURE CORSETUP
* CORSETUP - USE TO SETUP FOR CORMAIN PROGRAM
STORE "A:" TO NEWFILE_DRV
STORE "A:" TO ARC_DRV
STORE "C:" TO FILE_DRV
STORE "C:" TO PRG_DRV
STORE SPACE(6) TO UIC
STORE SPACE(40) TO ORGANIZ
STORE "W+/B,N/W,B,B " TO mcolor
STORE "W,I " TO mbw
STORE "N" TO mdelim
STORE "Correspondance Control Log " TO mheader
*------------------------------------------------
CLEAR
@ 2, 20 SAY "CORLOG SETUP PROGRAM"
@ 4,1 TO 4,78
@ 7,1 SAY "Enter logical or physical disk drive for program: " ;
GET prg_drv PICTURE "!!"
@ 8,1 SAY "Enter logical or physical disk drive for files: " ;
GET file_drv PICTURE "!!"
@ 9,1 SAY "Enter alternate drive for more files: " ;
GET newfile_drv PICTURE "!!"
@ 10,1 SAY "Enter logical or physical disk drive for archiving: " ;
GET arc_drv PICTURE "!!"
@ 11,1 SAY "[These are starting default values, they can be changed in" ;
+ " the program]"
@ 13,1 SAY "Use delimiters (brackets) around entry fields? {Y/N} " ;
GET mdelim PICTURE "Y"
@ 15,1 SAY "Enter six-digit organization code (alphanumeric): " ;
GET uic PICTURE "!!!!!!"
@ 16,1 SAY "Enter program title: " ;
GET mheader PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 17,1 SAY "Enter organizational title: " ;
GET organiz PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 19,1 SAY "Color display codes (see dBASE SET COLOR instr.): " ;
GET mcolor PICTURE "!!!!!!!!!!!!!!!!!"
@ 21,1 SAY "Black and white display codes: " ;
GET mbw PICTURE "!!!!!!"
READ
SAVE TO CORMEM.MEM
CLEAR
RETURN
* EOF CORSETUP
* EOP COR.PRG
