/QUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / ABSTRACT: / ENVIRONMENT: / AUTHOR:ALICIA FODEN/MIKE STURAK CREATION DATE: OCTOBER 27,1980 / / / 033 EMcD 27-Sep-85 Add Dutch/Spanish Xlations / 032 EMcD 15-Sep-85 Add Nordic translations / 031 RCME 10-APR-85 Add handling of multinational and / technical characters in field names / / -------------------- All below refer to V2.0 and earlier ---------------- / / 030 TCW 02-NOV-83 ADD CHECK & TEXT FOR WINCHESTER DRIVE / 029 HLP 29-AUG-83 If type incorrectly to GO prompt / do not repaint screen, show error / 028 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 027 WCE 19-JUL-83 Modified labels for new prefix file / 026 WCE 06-JUL-83 Removed WS102 conditionals and code / / 025 MJS 01-JAN-83 Corrected some error messages that may / have been "misleading" to the user / (the corrections consistes of "NOP"ing / or "JMP"ing around code) / / 024 AIB 10-DEC-82 Conditionalized "Rubout key" messages / 023 MJS 12-NOV-82 Cosmetic wording changes to message / at "TRYAGN"....same wording if you were / typing to Main Menu and got an error / / 0022 AIB 28-SEP-82 MORE COSMETIC WORDING CHANGES / 0021 AIB 30-AUG-82 WORDING CHANGES IN SOME MENUS / 0020 MJS 1-APR-82 Bug fix added 'GET DENSITY' in 'GTDKID' / 0019 MJS 25-MAR-82 'Bug fix #dm-481' changed 'jmp cusgr' / to 'jmp cusr1' at 'dtao' permitting / GOLD Menu to return to MAIN Menu and / not sort menu asking for new 't a o'. / 0018 MJS 09-MAR-82 Cosmetic display fix in 'nomean' / 0017 MJS 16-FEB-82 CHANGED 'SREXT=10' to 'SREXT=20' / (double density and goto page increased / number of header blocks permitted) / ALSO-deleted 'wpssdf.pa' from the / wpstpr line within master.inf / (was never needed) / 0016 GDH 08-FEB-82 Implemented "read error detection". / 0015 MJS 19-NOV-81 Moved the 'xxsdfnbuffer' from field 5 / to field 4 / 0014 AJF 06-OCT-81 CHANGED DDCHK TO ONLY LOOK AT BLOCK / NUMBER OF ALLOC BLOCK / 0013 GR 30-SEP-81 Fixed Press Return problem / 0012 JM 03-SEP-81 FRENCH TEXT CHANGES / 0011 JM 03-SEP-81 FIXED TYPING "-" HAS NO MEANING MESSAGE / 0010 GDH 26-Aug-81 WPFILS calling seq changes. / 0009 TT 09-JULY-81 REMOVED SUPERFLUOUS CONDITIONALS / 0008 AJF 25-JUNE-81 MISCELLANEOUS COSMETIC FIXES / 0007 AJF 31-MAR-81 VERSION 1 CLEANUP AND MULIT KEY STUFF / 0006 JM 10-MAR-81 Entered CANADIAN text / 0005 JM 09-MAR-81 Entered DUTCH text / 0004 JM 05-MAR-81 Entered FRENCH text / 0003 AJF 18-MAR-81 CHANGED RD1CHAR CALL IN GETFNCHAR TO / PROCESS BLANKS / / 0002 AJF 20-FEB-81 DELETE 127 BLOCK SIZE RESTRICTION IN / TSTSZ / 0001 AJF 27-OCT-81 ADDED SORT/PARSER MODULE TO SYSTEM /-- / / WRITE OUT SORT PARSER / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSPR;100;CDF 30;-DSOSPR 0 / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / WPSPAR.PA - SORT PARSER /D028 / THE 'USER FIELD' CONSTANTS /D028 / /D028 USRFL0= -10 / USER FIELD 0 /D028 USRFL1= 0 / USER FIELD 1 /D028 USRFL3= 20 / USER FIELD 3 (PHYSICAL FIELD 5) /D028 / /D028 / REPLACES THE 'JMS' WITHIN THE MAINLINE CODE WITH THE ACTUAL (CDF) (CIF) IOT FIELD 3 *SOTFL / THE FIRST 100 LOCATIONS CONTAIN COMMON SYSTEM CONSTANTS / (E.G. P177, ETCETERA.) / *SDFNBUFFER /THIS WILL BE DEFINED IN SORT IN SORT FIELD /D007 *FTYPE+1 CDFSDFN=6241 /A014 /D028 CDFSRT=JMS .; .; JMS CIDPAT; CDF+USRFL3 /D028 CDFEDT=JMS .; .; JMS CIDPAT; CDF+USRFL1 /D028 CDIMNU=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL0 /D028 CDFMNU=JMS .; .; JMS CIDPAT; CDF+USRFL0 /D028 CIFMNU=JMS .; .; JMS CIDPAT; CIF+USRFL0 /D028 CDISRT=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL3 CDFMYF=CDFEDT /DEFINE INSTRUCTION TO RETURN TO THIS FIELD /M028 CDFSRT=CDFLP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 CDISRT=CDILP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 /D028 /THE ALL PURPOSE ROUTINE FOR THE INSTRUCTIONS /D028 / /D028 CIDPAT, . /D028 DCA SAVEAC /SAVE THE AC AT ENTRY /D028 RAL; DCA SAVEL /AND THE LINK /D028 RIF /FIND THE INSTRUCTION FIELD /D028 TAD CDF0 /SAME AS 'TAD (CDF 0)' /D028 DCA CID /STORE THE MODIFIED INSTRUCTION FOR EXECUTION /D028 CID, . / CODE TO SET THE 'DATA FIELD' SAME AS 'INSTRUCTION FIELD' /D028 AC7776 / -2 FROM THE RETURN ADDRESS /D028 TAD CIDPAT /GET YOU THE ADDRESS OF THE CALLER /D028 DCA CID /SO AFTER ALL THAT SAVE IT /D028 AC7777 / -1 /D028 TAD I CID /GET THE ADDRESS OF THE CALLER /D028 DCA CID /STORE IT SO A EXIT CAN BE MADE FROM THE INTERNAL ROUTINE /D028 RIF /D028 TAD I CIDPAT /GET AND STORE THE GENERATED INSTRUCTION /D028 DCA I CID /D028 TAD SAVEL; CLL RAR /RESTORE LINK /D028 TAD SAVEAC /GET THE OLD CONTENTS OF THE AC /D028 JMP I CID /JUMP TO THE INSTRUCTION NOW CREATED /D028 SAVEAC, 0 /HOLDS THE AC AT ENTRY TO CIDPAT /D028 SAVEL, 0 /HOLDS THE LINK AT ENTRY TO CIDPAT / / / / / PZERR, ERR1 /STANDARD SPEC DOC ERROR MESSAGE PZNRM, ERR2 /MESSAGE OF SUCCESSFUL PARSING OF AT LEASE /ONE LINE OF SPEC DOC GIVING USER CHOICE OF /CONTINUING OR GOLD M ING OUT. OUTTMP, ZBLOCK 2 /Single character output store. /a031 NEGSPC, -40 /Negative ASCII value for space. /a031 CHR2VT, ZBLOCK 1 /Terminal output store /a031 PAGE BELL= 7 / BACKSP= 10 / LF= 12 / CR= 15 / /d0017 KVTWIDTH=121 / 81(10) IS THE WIDTH OF A LINE OF THE VT A12=X2 / auto index-register 12 A13=X3 / auto index-register 13 SREXT=20 /ADDED TO SIZE OF LIST DOC DURINGSIZING /m0017 MUISTR=MUBUF+MNIBUF ERR001= JMP I PZERR / 'GENERAL ERROR' CALL: ERR001 ERR002= JMP I PZNRM / 'ENOUGH FIELDS SPECIFIED' ERROR CALL: ERR002 ADRASM= 0 /THIS ASSEMBLES THE CREATE MODULE SO IT WILL NOT /TRY TO DISPLAY ERROR MESSAGES BUT SET THE AC FOR /A PARTICULAR MESSAGE SO WPSTPR DISPLAYS APPROPRIATE /MESSAGE ON CREATE ERROR /SORT START COMMAND CUSRCM, XX CLA /ZERO FILE NUMBERS FOR ERROR RECOVERY DCA SOTFL DCA SLSTFL DCA CUSRFO DCA ORDER DCA STATUS DCA DSKID /A007 CDFMNU TAD I (FNAMSP /THIS IS THE ADDRESS OF A BUFFER TO HOLD /THE DOCUMENT ADDRESS CDFMYF DCA CULFNM /STORE IT IN CULFMN /GET DISKETTE ID NUMBER /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO GET DISKETTE ID CIA /NEGATE DCA DSKNO /STORE IT IN DKSNO TAD DSKNO /GET IT BACK AND (777) /MASK OFF FIRST THREE BITS DCA DSKID /STORE FOR SORT M007 CUGSP, /PROMPT FOR SPEC DOC CLA /0 = ERASE FROM TOP OF SCREEN JMS ERASE JMS DCPRMT /GO DISPLAY PROMPT GSPEC /ADDRESS OF SPEC PROMPT CNRG /NULL ARGUMENT TO DISPLAY BLANK ON NEXT LINE A008 CDFMYF DCA STATUS /STORE AC IN STATUS -1 = NONEXISTENT DOCUMENT CDFMNU TAD I (MUBUF+MNFNO) /GET SPEC DRIVE & DOC NUMBER CDFMYF DCA CUSRFO /SAVE SPEC DOC AND DRIVE NUMBER TAD CULFNM /PATCH COPY COMMAND TO PICK UP STUFF DCA CUGSP1 JMS CUCOPY /COPY NAME TO OUR FIELD CUGSP1, 0 /ADDRESS OF FROM FOR CUCUPY CDFMNU /CDF FROM FIELD CUSSDN /ADDRESS TO RECEIVE SPEC DOC NAME CDFMYF /CDF TO FIELD STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD CUSRFO /GET SPEC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC3 /SAVE DOCUMENT NUMBER FOR USER VERIFICATION MSG TAD CUSRFO /GET SPEC DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC4 /SAVE DRIVE NUMBER TAD STATUS SMA CLA /-1 MEANS DOC DOESN'T EXIST NOTICE WE CLEAR AC HERE JMP GPARSE /IF NOT MINUS CONTINUE JMS NDERR CUSSDN /SPEC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUGSP /ASK FOR SPEC DOC AGAIN /ALL THIS LOCK CODE IS HERE TO ENSURE USER DOESN'T SPECIFY RESULT DOC A007 /AS ANY OTHER DOC. BECAUSE OF SPACE LIMITATIONS I WILL DO AN EQUALITY A007 /TEST TO ENSURE LIST OR SPEC IS NOT OVERWRITTEN BY RESULT. THE 278 IS A007 /A SINGLE USER SYSTEM, THEREFORE THERE IS NO NEED FOR ALL THESE LOCKS. A007 /HERE WE GO TEST SPEC DOC FOR SYNTAX ERRORS GPARSE, TAD CUSRFO /PUT SPEC DRIVE AND DOC NUMBER INTO AC FOR PARSER JMS PARSE /GO CHECK SPEC DOC IF IS OK WE WILL CONTINUE IF NOT /RETURN TO MAIN MENU WITH ERROR MESSAGE /THIS ROUTINE IS A WAIT SO USER WILL SEE THE SPEC AS THE PARSER DISPLAYS IT AC7776 /SET AC TO -2 SO LOOP WILL ITERATE TWICE DCA WTCTR1 /SET WAIT COUNTER TO 0 DCA WTCTR /SET OUTER LOOP COUNTER TO 0 LOOP, CIFSYS /MAKE INSTRUCTION FIELD SYSTEM FIELD JSWAP / ISZ WTCTR /WHEN AC IS BACK TO 0 INCREMENT OUTER LOOP JMP LOOP /OTHERWISE LOOP ISZ WTCTR1 /INCREMENT OUTER LOOP IF ZERO CONTINUE JMP LOOP /OTHERWISE LOOP AGAIN CUSGL, /PROMPT FOR NAME OF LIST DOC CLA TAD CULFNM DCA CUSGL1 /PATCH COPY COMMAND TO PICK UP STUFF JMS ERASE /WILL ERASE ENTIRE SCREEN BECAUSE AC 0 IFDEF FRENCH < /A011 AC0001 /SET GLSTFG TO INDICATE /A011 DCA GLSTFG / THAT GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 JMS DCPRMT /CALL DISPLAY ROUTINE GLST /ADDRESS OF LIST DOC PROMPT CNRG /DISPLAYS BLANK ON NEXT LINE A008 CDFMYF DCA STATUS CDFMNU TAD I (MUBUF+MNFNO) /GET DRIVE AND DOC NUMBER CDFMYF / DCA SLSTFL /SAVE JMP PCUSG RETMNU, CDIMNU /RETURN TO MAIN MENU /M027 JMP I CUSRCM PCUSG, JMS CUCOPY CUSGL1, 0 /ADDRESS OF FROM FOR CUCOPY CDFMNU /CHANGE TO MENU DATA FIELD TO PICK UP CHAR STRING CUSLDN /ADDRESS TO RECEIVE LIST DOC NAME CDFMYF /CHANGE BACK TO MY DATA FIELD (FIELD TO COPY TO) STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC1 /SAVE DOCUMENT TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC2 /STORE AWAY TAD STATUS SMA CLA /CLEAR AC JMP CUSGR /IF POSITIVE DOC EXITST SO CONTINUE A007 JMS NDERR /ELSE GO TO NO DOCUMENT ERROR MSG CUSLDN /LIST DOC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUSGL /DISPLAY PROMPT AGAIN STATUS, 0 /TELL NO DOC ERROR ROUTINE WHERE TO RETURN DSKNO, 0 /DISKETTE ID NUMBER WTCTR, 0 /THIS IS THE WAIT ROUTINE COUNTER WTCTR1, 0 /THIS IS WAIT ROUTINE COUNTER FOR OUTER LOOP CULFNM, 0 /ADDRESS OF BUFFER TO HOLD DOCUMENT ADDRESS CUSRFO, 0 IFDEF FRENCH < /A011 GLSTFG, 0 / SET WHEN GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 PAGE CUSGR, CLA /0 AC MEANS ERASE FROM TOP OF SCREEN JMS ERASE SRCUSRG,JMS DCPRMT /GO DISPLAY MESSAGE GRES /ADDRESS OF RESULT DOC PROMPT GRES2 /DISPLAYS SECOND LINE OF PROMPT CDFMYF /CHANGE DATA FIELD TO MINE DCA STATUS /STORE STATUS OF DOC (EXISTS OR NOT) CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNDRV) /GET RESULT DOC DRIVE CDFMYF /CHANGE DATA FIELD TO MINE DCA CUSRC6 /STORE JMS DDCHK /CHECK IF RESULT FLOPPY IS VALID DISKETTE JMP CUSGR /ERROR RETURN INVALID DISKETTE IS REPLACED /SO ASK FOR RESULT AGAIN TAD STATUS /DISKETTE IS VALID SO GO GET STATUS SPA CLA /SEE IF DOCUMENT EXISTS IF AC NEGATIVE JMP RESCRE /DOC DOESN'T EXIST SO GO CREATE IT CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNFNO);CDFMYF /ELSE GET DOC NUMBER DCA SOTFL /AND STORE IT JMS CUSGR1 /SEE IF RESULT DOC HAS BEEN PREVIOUSLY SPECIFIED A007 /NOTE AC IS 0 HERE TAD SOTFL /GET RESULT DOC NUMBER A007 CIA /NEGATE A007 TAD SLSTFL /GET NEGATIVE OF LIST DOC A007 SNA CLA /ARE THEY EQUAL? A007 JMS LCKMSG /IF YES DISPLAY ERROR MESSAGE A007 JMP TSTSPEC /CONTINUE ALSO OK RETURN FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 TSTSPEC,TAD SOTFL /GET RESULT DOC A007 CIA /NEGTATE A007 TAD CUSRFO /ADD SPEC DOC A007 SNA CLA /ARE THEY EQUAL A007 JMS LCKMSG /YES DISPLAY ERROR MESSAGE A007 JMP DTAO /NO CONTINUE THIS IS ALSO OK RETURN A007 /FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 /DOCUMENT EXISTS AND IS NOT IN USE SO DISPLAY TAO PROMPT DTAO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT CIFMNU JMS I IOACAL 0 DEXTS /ADDRESS OF TEXT STRING 205 /POSITION FIRST LINE ON SECOND ROW 5 COLUMN 305 505 705 1105 2305 JMS ORGOLD ORAR DTAOX, / /a025 AC0001 /SET AC TO 1 SO MENU WILL READ RESPONSE JMS READMU /READ INPUT FROM MENU MODULE JMP CUSR1 /GOLD M -- Return to MAIN Menu /a0019 /d0019 JMP CUSGR /GOLD M SO ASK FOR RESULT DOC AGAIN CDFMYF /CHANGE DATA FIELD TO MINE SMA CLA /IF AC NEGATIVE INAPPROPRIATE INPUT JMP STORE /IF APPROPRIATE CONTINUE JMS MVINPT /ELSE, COPY INPUT FROM MENU FIELD TO INBUF JMS NOMEAN /GO COMPLAIN ABOUT BAD INPUT /d025 JMP DTAO /ASK AGAIN /d025 JMP DTAOX / ask again /a025 /CALLED TO COPY RESULT DOC NAME FROM MENU FIELD AND ISOLATE DOC AND DRIVE /NUMBERS MADE INTO A SUBROUTINE SO IT CAN BE USED WHEN DOC EXISTS OR NOT CUSGR1, XX TAD CULFNM DCA CUSGR2 JMS CUCOPY CUSGR2, 0 /FROM FOR CUCOPY CDFMNU / CUSRDN /RESULT DOCUMENT NAME CDFMYF / STRLEN /SIZE OF DOCUMENT NAME FOR CUCOPY /NOTE CUCOPY RETURNS WITH AC 0 TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC5 /SAVE DOC NUMBER TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC6 /SAVE DRIVE NUMBER DCA STATUS /CLEAR STATUS VARIABLE JMP I CUSGR1 /RETURN /THIS ROUTINE IS CALLED BY ROUTINES WHICH PROCESS SPEC, INPUT DOCUMENT AND /RESULT DOCUMENT NAMES. /CALLED BY / JMS DCPRMT / ADDRESS OF PROMPT TO DISPLAY / ADDRESS OF SECOND LINE OF PROMPT, IS NULL (BLANK) FOR SPEC / AND LIST DOC, TEXT FOR RESULT DOC / RETURN WITH AC CONTAINING VALUE OF MNTMP3 / DATA FIELD SET TO MENU FIELD DCPRMT, XX CLA /CLEAR AC TAD I DCPRMT /GET FIRST PARAMETER PROMPT TO DISPLAY DCA WHCDOC /STORE IT ISZ DCPRMT /GET READY TO GET NEXT PARAMETER TAD I DCPRMT /GET SECOND LINE OF PROMPT, IS NULL (BLANK) FOR /SPEC AND LIST PROMPT BUT FOR RESULT CONTAINS /SECOND LINE OF PROMPT DCA WHC2ND /STORE ISZ DCPRMT /INCREMENT DCPRMT FOR RETURN DCPRM1, JMS DSORT CIFMNU JMS I IOACAL 0 SPRMPT 1505 LOC, 7777 /WILL DISPLAY PROMPT ON SAME LINE AS ABOVE PROMPT WHCDOC, 0000 CIFMNU JMS I IOACAL 0 WHC2ND, 0000 /SECOND LINE OF PROMPT 1605 /POSITION OF SECOND LINE JMS PRETURN JMS ORGOLD ORAR CLA /SET AC TO MENU WILL READ INPUT JMS READMU /PROCESS INPUT FROM MENU JMP CUSR1 /RETURN TO MM JMP I DCPRMT /GO BACK AND PROCESS INPUT NOTE DATA FIELD /STILL SET TO MENU FIELD PAGE RESCRE, CDFMNU /CHANGE DATE FIELD DO MENU TAD I (MUBUF+MNDRV) /NOTE AC 0 HERE, GET DRIVE NUMBER OF DOC /USER SPECIFIED CDFMYF /CHANGE DATA FIELD BACK TO MINE DCA CUSRC6 /STORE IN RESULT DRIVE NUMBER JMS TSTSZ /TEST IF THERE IS ROOM TO CREATE DOC JMP SMDRVS /ERROR RETURN GO PROCESS SIZE ERROR CLA CLL TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY ARE DCA DSKID /SET FROM PREVIOUS RESULT DOC M007 CLL /THERE IS ENOUGH ROOM SO CONTINUE CLEAR LINK AC0003 /SET FOR OVERWRITE RTR RTR /MOVE TO BITS 2 AND 2 CDFMYF TAD DSKID /COMBINE WITH CONTENTS OF DSKID M007 DCA DSKID /STORE M007 JMS ADRCRT /CREATE THE OUTPUT DOCUMENT JMP CRERR /ERROR ON CREATE, PROCESS DCA SOTFL /STORE IN DOC NUMBER IN SOTFIL JMS CUSGR1 /GO COPY DOC NAME AND ISOLATE DOC AND DRIVE #S /NOTE AC MUST BE 0 HERE TO ENSURE RESULT DOC /IN SIZE TESTING ROUTINE EQUALS ZERO /BECAUSE WE ARE NOT OVERWRITING THE RESULT JMP CUSGO /CONTINUE CRERR, CLA /CLEAR AC TAD ERSTAT /GET ERROR STATUS FROM CREATE SNA /IF AC 0 JMP STMSG /DISPLAY SHORT MESSAGE TAD (7776) /ELSE ADD -2 TO SEE IF AC = 2 SZA CLA /AC =2? JMP WRGMSG /DISPLAY WRONG DOC NUMBER MESSAGE JMP NSPCMSG /ELSE MUST BE A 2 DISPLAY NO SPACE FOR DOC MESSAGE STMSG, TAD (CNRG) /GET NO DISPLAY ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE WRGMSG, TAD (WNUM) /GET WRONG DOCUMENT NUMBER ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE NSPCMSG,TAD (NMDC) /GET NO DOCUMENTS AVAILABLE ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE CREMSG, DCA CRMSG /STORE APPROPRIATE MESSAGE ARGUMENT FOR DISPLAY CRMSG1, JMS ERASE JMS RBELL JMS DSORT /DISPLAY SORT ON FIRST LINE /A008 CIFMNU JMS I IOACAL 0 CNTCRE /DISPLAY CANNOT CREATE DOCUMENT 1505 /ON LINE 15 COLUMN 5 CIFMNU JMS I IOACAL 0 CRMSG, 0000 /DISPLAY DOC # OUT OF RANGE, OR NO MORE DOCS 1605 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU JMS I IOACAL /CALL IOA A008 0 / A008 TARTN /DISPLAY PRESS RETURN TO TRY ANOTHER NAME A008 2005 /LINE TO DISPLAY A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 ORAR /DISPLAY OR M008 JMS KBRD /READ INPUT HANDLE GOLD KEYS D008 JMP CUSGR /RETURN WAS TYPED SO REQUEST RESULT AGAIN A008 STORE, CLA CLL /CLEAR LINK AND AC TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY WERE SET /PREVIOUSLY WHEN RESULT WAS SPECIFIED DCA DSKID /STORE BACK M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD CLA CLL TAD I (MUBUF+MNTMP1) /GET INPUT CDFMYF /CHANGE BACK TO MY DATA FIELD RTR / RTR /MOVE INPUT TO BITS 1 AND 2 TAD DSKID /STORE IN DSKID M007 DCA DSKID / M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNTMP1) /GET INPUT AGAIN CDFMYF /CHANGE DATA FIELD TO MINE CLL RAR /SEE IF WE ARE OVERWRITING /0 = ADD TO TOP /1 = ADD TO BOTTOM /3 = OVERWRITE (NOTE THESE ARE BINARY NUMBERS) /IF OVERWRITING AC NOT 0 SNA CLA /CONTINUE IF AC IS NOT EQUAL TO 0 JMP CLTSTSZ /GO TO TEST SIZE /ELSE TAD SOTFL /GET SIZE OF RESULT FILE CIFFIO /SET INSTRUCTION FIELD TO MENU /M0010 FILEIO / /M0010 XRDFIN CDFFIO /CHANGE DATA FIELD TO FILEIO /M0010 TAD I (RDFSIZ) /GET SIZE OF RESULT FILE CDFMYF /CHANGE DATA FIELD BACK TO MINE CLTSTSZ,JMS TSTSZ /GO TO TSTSZ WITH SIZE OF RESULT DOC IN AC JMP SMDRVS /ERROR RETURN CONTINUE SIZE ERROR HANDLING JMP CUSGO /OK RETURN CONTINUE /RTNWT MOVED HERE BECAUSE OF SPACE REASONS M007 / THIS ROUTINE READS INPUT IN RESPONSE TO ERROR MESSAGES WHICH REQUEST A RETURN / WHEN "RETURN" IS TYPED RETURN TO USER IF NOT RING BELL AND COMPLAIN AGAIN / called by: JMS RTNWT; WRONG RETURN; OK RETURN RTNWT, XX CIFMNU / JMS I INACAL / INBUF / INPUT BUFFER TO RECEIVE INPUT JMP .-3 / /a025 /d025 JMP WRNG / GOLD KEY RING BELL COMPLAIN AGAIN /a025 CLA MQA / MQ HAS # OF CHARS IF NOT 0 THEN NOT RETURN SZA CLA / SEE IF IT IS 0 JMP WRNG / IF NOT RETURN RING BELL COMPLAIN AGAIN ISZ RTNWT / MUST BE RETURN SO INCREMENT FOR OK RETURN JMP I RTNWT / RETURN TO CALLER WRNG, JMS RBELL / RING BELL JMP I RTNWT / RETURN TO CALLER TO COMPLAIN AGAIN PAGE /IF CALLED WITH ZER0 IN AC THIS ROUTINE CHECKS SIZE OF SPACE ON RESULT /FLOPPY AGAINS SIZE OF INPUT FLOPPY + 8 BLOCKS /OTHERWISE AC CONTAINS SIZE OF RESULT DOC TO ADD TO FREESPACE ON RESULT /FLOPPY WHEN OVERWRITING THE RESULT DOC /IF THERE IS ENOUGH SPACE ON RESULT FLOPPY TO ACCOMMODATE OUTPUT PROGRAM /CONTINUES. /WHEN THERE IS NOT ENOUGH SPACE ON RESULT FLOPPY DISPLAYS ARE DETERMINED /AS FOLLOWS: /IF INPUT AND OUTPUT ARE THE SAME, USER IS ASKED TO SPECIFY ANOTHER DRIVE /FOR OUTPUT AND IS RETURNED TO THE PROMPT FOR THE RESULT DOCUMENT SO /APPROPRIATE VALIDLITY TESTS ARE PERFORMED. /IF INPUT IS DRIVE 0 AND OUTPUT IS DRIVE 1 USER IS ASKED TO REPLACE /DISKETTE AND RESPECIFY RESULT DOCUMENT AS ABOVE. /IF OUTPUT AND ARE DIFFERENT AND OUTPUT IS DRIVE 0 USER IS ASKED TO /REMOVE SYSTEM FLOPPY TSTSZ, XX DCA FRESPCE /STORE RESULT DOC SIZE OR 0 DEPENDING HOW CALLED TAD SLSTFL /PUT INPUT DRIVE AND DOC NUMBER INTO AC CIFFIO /CALL RFDL TO OPEN INTPUT DOC /M0010 FILEIO / /M0010 XRDFIN CDFFIO / /M0010 TAD I (RDFSIZ) /GET SIZE OF LIST DOC CDFMYF /CHANGE TO MY DATA FIELD DCA LSTSIZ /STORE IN MY FIELD TAD CUSRC6 /TAD RESULT DRIVE NUMBER JMS CUPDRS /SET DRIVE NUMBER FOR QURX TAD (RXESP /GET SPACE LEFT ON DISKETTE DCA QUQBLK+RXQFNC JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX TAD QUQBLK+RXQSPC /GET FREE SPACE ON RESULT FLOPPY TAD FRESPCE /ADD RESULT DOC SIZE (OR 0 FOR T, A, OR CREATE) DCA FRESPCE /STORE TAD (SREXT) /THIS IS EXTRA SPACE REQUIRED IF DOC IS TO BE /EDITED AFTER SORT TAD LSTSIZ /ADD THE SIZE OF INPUT DOC CIA /NEGATE TAD FRESPCE /ADD FREE SPACE SPA CLA /IF RESULT IS NEGATIVE INPUT IS GREATER THAN JMP I TSTSZ /SPACE AVAILABLE ON FLOPPY ERROR RETURN ISZ TSTSZ /ELSE THERE IS ENOUGH SPACE INCREMENT FOR OK RETURN JMP I TSTSZ ERSTAT, 0000 /TYPE OF CREATE ERROR MESSAGE TO DISPLAY /0 = GENERAL CANNOT CREATE /1 = DOC # OUT OF RANGE /2 = NO DOCS AVAILABLE LSTSIZ, 0 /SIZE OF INPUT FILE FRESPCE,0 /SIZE OF RESULT FILE 0 WHEN ADDING TO TOP, BOTTOM OR CREATING /THE RESULT DOC AND THE SIZE OF THE RESULT DOCUMENT WHEN /OVERWRITING. THIS PROGRAM ALSO ADDS THE AMOUNT OF FREE SPACE /ON THE RESULT FLOPPY WHEN COMPUTING SIZING / IF GLST (FRENCH) HAS JUST BEEN DISPLAYED, DSPACC IMBEDS AN ACCENTED a /A011 / (^Z 141) ONTO THE SCREEN WITHIN GLST. THIS COULD NOT BE DONE NORMALLY /A011 / BECAUSE GLST IS A ^S ARGUMENT ITSELF. /A011 IFDEF FRENCH < /A011 DSPACC, XX /A011 CLA /A011 TAD GLSTFG /A011 SNA CLA / HAS GLST BEEN DISPLAYED ? /A011 JMP I DSPACC / NO, SO RETURN /A011 DCA GLSTFG / YES, CLEAR GLSTFG UNTIL NEXT DISPLAY /A011 CIFMNU / AND DISPLAY ACCENTED CHAR /A011 JMS I IOACAL /A011 0 /A011 ACCHAR /A011 1536 / CURSOR POS /A011 141 / ACCENTED a /A011 JMP I DSPACC / RETURN /A011 ACCHAR, TEXT '^P^Z' / STRING USED TO DISPLAY ACCENTED a /A011 > / END IFDEF FRENCH /A011 /**************************************************************************** / / The OUT2VT routine, which displays characters on the terminal has /a031 / been moved here to make room for the changes associated with outputing/a031 / multinational and technical characters. /a031 / /**************************************************************************** OUT2VT, XX / The moved output to terminal routine /m031 DCA CHR2VT / Save the character to be displayed /m031 TAD CHR2VT / Check for right away /m031 TAD (-CR) / /m031 SNA CLA / Is it an end dead char (CR)? /a031 JMP OU2LIV / Yes, tidy up after dead key sequence. /a031 TAD DEADKEY / No, check for in dead key sequence. /m031 SZA CLA / Are we in dead key sequence? /m031 JMP INDEAD / Yes, deal with the character. /a031 TAD CHR2VT / No. /m031 TAD (-BACKSP) / Check for a . /m031 SNA / Was it a start of dead character (BS)?/m031 JMP OU2DOA / Yes, start of dead key sequence. /a031 TAD (BACKSP-LF) / No, test for line feed. /m031 SZA CLA / Is it an LF? /m031 JMP NOTEOL / No, jump round handler. /m031 JMS NEWLN / Output a CR-LF. /m031 VTEXIT, TAD CHR2VT / Get back the character /m031 JMP I OUT2VT / Return /m031 NOTEOL, TAD CHR2VT / Output the character passed to the /a031 OU2ANY, JMS OUTCHR / routine origionally in the AC /a031 JMP VTEXIT / and return with it in AC /a031 OU2DOA, AC7777 / Set the dead key flag /a031 DCA DEADKEY / /a031 JMP VTEXIT / Get the character back and return /a031 /**************************************************************************** / / The following code handles dead key sequences found in the /a031 / sort specification document. Technical and multinational /a031 / characters are now displayed using the correct character sets /a031 / and user dead key sequences are depicted by the conventional /a031 / blot rather than the +/- symbol previously used. /a031 / /**************************************************************************** INDEAD, ISZ DEADKEY / This peice of code is used for each /a031 / character in the dead key sequence /a031 / Is this the first char in the sequence?/a031 JMP INDNOT1 / No, deal with others. /a031 ISZ DEADKEY / Yes, set the dead key flag again /a031 TAD CHR2VT / No, get the character. /a031 TAD NEGSPC / Test for space character. /a031 SNA CLA / Is it a space? /a031 JMP VTEXIT / Yes, accept and forget it. /a031 CIFMNU / No, output the escape sequence to send/a031 JMP I IOACAL / a blot to the screen /a031 0 / /a031 ASTRING / /a031 ASDK / /a031 AC4000 / Set the top bit of the dead key flag /a031 DCA DEADKEY / to indicate a user dead key that /a031 JMP VTEXIT / requires no further processing /a031 INDNOT1,TAD DEADKEY / Check the top bit of the flag for user/a031 SPA / Is this a user dead key sequence? /a031 JMP VTEXIT / Yes, ignore all further characters /a031 CLL RTR / No, test for the 2nd char in sequence /a031 SZA / Is this the 2nd character? /a031 JMP OU2DCH / No, it's a later one /a031 TAD CHR2VT / Yes, get it. /a031 TAD NEGSPC / Test for a GOLD space. /a031 SNA / Is it a GOLD space? /a031 JMP GLDSPC / Yes, deal with it. /a031 TAD (-23) / No, test character set specifier /a031 SNA / Is it a technical character? /a031 JMP OU2DTC / Yes, go send an SS3 /a031 IAC / Test for multinational character set /a031 SNA CLA / Is it multinational? /a031 JMP OU2DMC / Yes, output an SS2 /a031 JMP OU2DLC / No, is line drawing, so output SO /a031 OU2DTC, AC0001 / Build value 217 for technical char /a031 OU2DMC, TAD (200) / Build value 216 for multinational char/a031 OU2DLC, TAD (16) / Build value 16 for a line drawing char/a031 JMP OU2ANY / Output the built value to the screen /a031 OU2DCH, CLL RAL / Check that this is the 3rd character /a031 SZA CLA / Is this the 3rd character? /a031 JMP VTEXIT / No, exit /a031 JMP NOTEOL / Yes, print it /a031 GLDSPC, AC4000 / Deal with GOLD spaces. Is not dead key/a031 DCA DEADKEY / sequence, so set flag to ignore rest /a031 JMP NOTEOL / Display the space /a031 OU2LIV, DCA DEADKEY / Turn off the deadkey flag /a031 TAD (17) / Output SI when dead key finishes /a031 JMP OU2ANY / clean up after line drawing set mode /a031 OUTCHR, XX / Routine to display the character in AC/a031 DCA OUTTMP / Save the character /a031 CIFMNU / Change to the menu field /a031 JMS I IOACAL / to use IOA for character output /a031 0 / /a031 ASTRING / /a031 OUTTMP / /a031 JMP I OUTCHR / Return /a031 DEADKEY,ZBLOCK 1 / Dead key flag /m031 PAGE /SEE IF INPUT AND OUTPUT DOCS ARE IN SAME DRIVES SMDRVS, TAD CUSRC2 /GET INPUT DRIVE NUMBER CIA /NEGATE TAD CUSRC6 /RESULT DRIVE NUMBER SZA CLA /IF THEY ARE EQUAL TELL USER TO SPECIFY ANOTHER DRIVE JMP DKTST /OTHERWISE SEE IF 4 DRIVE SYSTEM M007 NDPRMT, JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 NWDRV /TEXT TELLING USER TO SPECIFY ANOTHER DRIVE 1205 /DISPLAY NEXT PROMPT ON LINE 12 COLUMN 5 NWSTR, 0000 / ADDR OF SUBSTRING /A030 JMP SRCUSRG /GO PROMPT FOR RESULT DOC AGAIN DKTST, CDF 0 /CHANGE DATA FIELD TO SYSTEM FIELD A007 TAD I (RXONLN) /GET NUMBER OF DISKETTES ON LINE NOTE AC IS ZERO A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 TAD (-4) /SEE IF IT IS 4 A007 SNA CLA /IF THERE OR 4 RX'S ON LINE A007 JMP NDPRMT /DISPLAY SPECIFY ANOTHER DRIVE A007 /OTHERWISE FALL THROUGH A007 /DRIVES ARE DIFFERENT AND THIS IS 2 DRIVE SYSTEM /SEE IF INPUT DRIVE IS 0 DFDRVS, TAD CUSRC6 /GET OUTPUT DRIVE NUMBER SNA CLA /IF IT IS NOT ZERO GO TO REPLACE DISKETTE ROUTINE JMP OUTPT0 /IF IT IS ZERO TELL USER TO REPLACE SYSTEM DISKETTE JMP DFMSG DFMSG, JMS PTRCHK /MAKE SURE NOTHING IS PRINTING. IF PRINTING USER /IS RETURNED TO THE MAIN MENU OF NOT CONTINUE JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RPLACE /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /DISKETTE OK NOW PROMPT FOR RESULT DOC AGAIN OUTPT0, JMS PTRCHK /MAKE SURE USER IS NOT PRINTING IF SO RETURN TO MM /ELSE CONTINUE OT0MSG, JMS ERASE JMS TOSMALL /TELLS USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RMOVE0 /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /GO BACK AND PROMPT FOR RESULT DOC AGAIN CUSGO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /GO DISPLAY SORT CIFMNU /CHANGE TO MENU FIELD JMS I IOACAL /OUTPUT WHAT WE THINK THINGS ARE 0 CUSR1A /ADDRESS OF OUTPUT STRING 105 /TEXT TO DISPLAY ON 1 LINE 5 COLUMN 5 IFDEF CANADA <141> CUSRC2, 0 /DRIVE NUMBER OF LIST DOC CUSRC1, 0 /DOCUMENT NUMBER OF LIST DOC CUSLDN /LIST DOCUMENT NAME 205 /TEXT TO DISPLAY ON LINE 2 COLUMN 5 CUSRC4, 0 /SPEC DRIVE NUMBER CUSRC3, 0 /SPEC DOC NUMBER CUSSDN /SPEC DOCUMENT NAME 305 /TEXT TO DISPLAY ON LINE 3 COLUMN 5 CUSRC6, 0 /RESULT DRIVE NUMBER CUSRC5, 0 /RESULT DOC NUMBER CUSRDN /RESULT DOCUMENT NAME 405 NUMKEY /NUMBER OF KEY FIELDS WE WILL SORT ON CIFMNU JMS I IOACAL 0 TYPGO /TEXT STRING TYPE GO TO BEGIN SORT 1505 JMS PRETURN /AND PRESS RETURN JMS ORGOLD /OR PRESS GOLD M ORAR CUSGO1, /A029 AC0002 /SET AC TO 2 SO MENU WILL PROCESS GO PROMPT JMS READMU JMP CUSR1 /RETURN TO MM CDFMYF /SET DATA FIELD TO MY FIELD SPA CLA /TEST FOR NEGATIVE AC JMP GNMEAN /IF NEGATIVE RESPONSE WAS INAPPRIPRIATE SO COMPLAIN /ELSE CONTINUE / /A015 / IF THE OPERATOR SPECIFIED 'O' TO OVERWRITE THE OUTPUT DOCUMENT /A015 / THEN WE MUST DELETE ALL DOCUMENT BLOCKS FROM THE ALLOCATION BLOCK /A015 / ASSOCIATED WITH THAT OUTPUT DOCUMENT /A015 / OTHERWISE THE SORT COULD RUN OUT OF 'SCRATCH' DISK SPACE /A015 / AND A 'DISK ERROR UNIT n' WOULD OCCUR /A015 / /A015 TOSORT, TAD (3000) / /A015 AND DSKID / mask the 'T', 'B', AND 'O' MODE /A015 TAD (-3000) / /A015 SZA CLA / SKIP NEXT IF 'O' /A015 JMP SORT / JMP BECAUSE 'T' OR 'B' /A015 TAD SOTFL /that / OUTPUT DOCUMENT # AND DRIVE # /A015 MQL /is / INTO THE MQ FOR THE 'XDSKIN' /A015 AC7777 /all / -1 MEANS SET FOR 'OVERWRITE' /A015 CIFFIO /there / /A015 FILEIO /is / OPEN the document /A015 XDSKIN /to / /A015 CIFFIO /it / /A015 FILEIO /boo- / CLOSE the document /A015 XDSKCL /bie / /A015 SORT, CDFSRT /CHANGE TO SORT FIELD TAD I (PARSELIST) /GET THE ADDRESS OF SELECTER ROUTINE DCA T1 /STORE IT IN T1 CDFMYF TAD CUSRCM /TO PASS THE RETURN POINT IN AC TO SELECTOR CDISRT /INSTRUCTION FIELD TO SORT FIELD DCA MMRETURN /STORE IN A LOCATION IN SORT FIELD JMP I T1 /JUMP TO SELECTER GNMEAN, JMS MVINPT /COPY INPUT FROM MENU TO INBUF JMS NOMEAN /COMPLAIN ABOUT INCORRECT INPUT JMP CUSGO1 /ASK AGAIN /C029 PAGE /ROUTINES TO DISPLAY COMMON PROMPTS ON THE SCREEN DSORT, XX CIFMNU JMS I IOACAL 0 SRT 0 JMP I DSORT /CALLED BY JMS ORGOLD / VALUE FOR FIRST WORD ARGUMENT (EITHER ORAR FOR OR PRESS GOLD / M OR NARG FOR PRESS GOLD M) ORGOLD,XX /DISPLAYS (OR) PRESS GOLD M TO RECALL MENU CLA TAD I ORGOLD DCA FWARG /STORE ARGUMENT IN FIRST WORD ARGUMENT ISZ ORGOLD /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID WILL READ SYSTEM FLOPPY JMS GTDKID /READ SYSTEM DISKETTE ID TAD DSKNO /ADD TO PREVIOUS ID # SZA CLA /IF EQUAL SYSTEM DISKETTE HAS NOT BEEN REMOVED JMP SDOUT /AC NOT 0 SYSTEM DISKETTE WAS REMOVED OGOLD1,CIFMNU JMS I IOACAL 0 DOGM /ADDRESS OF OR TYPE GOLD M TO RECALL MENU 2505 /POSITION OF LINE FWARG, 0 /FIRST WORD OF PROMPT EITHER "OR" OR " " JMP I ORGOLD /RETURN TO CALLER SDOUT, /THIS IS TO SEE OF GOLD M MESSAGE IS DISPLAYED WITH /OR OR NOT IF IT IS THEN REPLACE MESSAGE WILL BE /ALSO PRECEDED WITH AN OR ALSO TAD FWARG /GET CONTENTS OF FWARG CIA /NETATE IT TAD (NARG) /SEE IF IT IS NARG SZA CLA /IF IT IS CONTINUE JMP CHARG /IF NOT NARG CHANGE FIRST WORD OF REPLACE MESSAGE TAD (NARG) /IF NARG SET FIRST WORD ARGUMENT OF REPLACE MESSAGE TO DCA SDFW /NULL SDOUT1, TAD (AARG) /PUT ARGUMENT FOR AND IN FIRST WORD ARGUMENT OF GOLD DCA FWARG /M PROMPT SO WILL DISPLAY AND PRESS GOLD M JMS RSDSK /GO DISPLAY REPLACE SYSTEM DISK PROMPT JMP OGOLD1 /GO DISPLAY AND PRESS GOLD M CHARG, TAD (ORAR) DCA SDFW /MAKE OR FIRST WORD OF REPLACE MESSAGE JMP SDOUT1 /VERIFIES USER INSERTS INITIALIZED DOCUMENT FLOPPY INTO DRIVE WHEN /REPLACING A FLOPPY DUE TO SPACE PROBLEMS /CALLED BY JMS DDCHK;ERROR RETURN;OK RETURN /AC 0 ON RETURN DDCHK, XX DDCHK1, JMS ERASE CLA TAD CUSRC6 /MAKE AC EQUAL TO RESULT DRIVE /SO GTDKID READS FLOPPY IN APPROPRIATE DRIVE JMS GTDKID /READ HOME BLOCK INTO CUB1 CLA CLL /GTDKIT RETURNS WITH DISKETTE ID IN AC SO CLEAR / TAD CUB1+0 /GET WORD 0 OF HOME BLOCK /D014 / TAD (-7401) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECK /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 / TAD CUB1+1 /GET WORD 1 (BLOCK TYPE) OF HOME BLOCK /D014 / AND (0070) /ISOLATE BITS 6-8 /D014 / CLL RTR /CLEAR LINK AND /D014 / RAR /MOVE TO BITS 9-11 /D014 / TAD (-3) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECKING /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 TAD CUB1+6 /GET BLOCK NUMBER OF HOME BLOCK TAD (-DLALOC) /ADD NEGATIVE OF VALUE IT SHOULD BE SZA CLA /IF 0 RETURN TO USER JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID ISZ DDCHK /INCREMENT FOR OK RETURN TAD (500) /ERASE SCREEN JMS ERASE /BEFORE CONTINUING CLA DCHKXT, JMP I DDCHK /RETURN AND CONTINUE DDERR, JMS ERASE JMS DSORT JMS DERCKW / CHECK FOR WINCHESTER DRIVE /A030 CIFMNU JMS I IOACAL 0 DERR / INVALID DISKETTE MESSAGE 505 DERST1, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 CUSRC6 / RESULT DOC DRIVE NUMBER DERST2, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 605 DERST3, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 JMS PRETURN JMS ORGOLD ORAR JMS KBRD /READ INPUT CLA /USER PRESSED RETURN SO TAD (RXERT /TO TELL SYSTEM TO FORGET INDEX INFORMATION DCA QUQBLK+RXQFNC /BECAUSE USER WILL PUT IN NEW FLOPPY JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX JMP DCHKXT /USER PRESSED RETURN GO ASK FOR RESULT AGAIN PAGE /DISPLAYS THAT RESULT DOC IS ALREADY IN USE. /CALLED BY / JMS LCKMSG / NON ERROR RETURN CONTINUES / ERROR RETURN PROMPTS FOR RESULT AGAIN /TEST FOR REMOVAL OF SYSTEM FLOPPY, IF IT HAS BEEN REMOVED SURPRESS LOCK ERROR /MESSAGE BECAUSE DOCUMENTS ARE NOT THE SAME LCKMSG, XX /M007 JMS GTDKID /GET DISKETTE ID NOTE AC 0 HERE A007 TAD DSKNO /GET CURRENT SYSTEM DISKETTE ID A007 SZA CLA /HAS DISKETTE BEEN REMOVED A007 JMP LOKRTN /YES RETURN TO CALLER WITHOUT DISPLAYING ERROR A007 /ELSE DISPLAY LOCK ERROR MESSAGE TAD (2205) /ERASE GOLD M PROMPT JMS ERASE CIFMNU JMS I IOACAL 0 SRLCKER /TEXT STRING DOC ALREADY IN USE 2205 IFDEF FRENCH < 141 > /L.G.A. BELTXT /RING BELL CUSRC6 /RESULT DOC DRIVE NUMBER M007 CUSRC5 /RESULT DOC NUMBER M007 CUSRDN /RESULT DOC NAME M007 CIFMNU JMS I IOACAL 0 TARTN 2405 JMS RTNWT /READ INPUT AND WAIT FOR RETURN JMP LCKMSG /IF NOT RETURN REDISPLAY COMPLAINT TAD (2205) /RETURN WAS TYPED ERASE COMPLAINT JMS ERASE ISZ LCKMSG /INCREMENT FOR ERROR RETURN LOKRTN, JMP I LCKMSG /RETURN TO CALLER /CALLED BY JMS GMTST;GOLD M;GOLD KEY NOT GOLD M GMTST, XX /TEST IF KEY IN GOLD KEY. IF GOLD M GOES TO MM /IF GOLD KEY NOT GOLD M DISPLAYS WHEN TYPING TO MENU /ERROR MESSAGE. ASSUMES THAT CHARACTER IS IN AC GMTST1, TAD (-EDMENU) /SEE IF GOLD M SNA CLA /IF AC = 0 JMP CHKIT /GO SEE IF SYSTEM FLOPPY IS IN /ELSE RING BELL AND OUTPUT WHEN TYPING TO MENU ERROR /MESSAGE GMERDSP, / /d025 TAD (2205) /ERASES BEFORE DISPLAYING NEXT /d025 /d025 JMS ERASE / /d025 JMS RBELL / /d025 CIFMNU / /d025 /d025 JMS I IOACAL / /d025 /d025 0 / /d025 /d025 TRYAGN / /d025 /d025 2205 / /d025 /d025 2305 / /d025 /d025 2405 / /d025 /d025 IFDEF FRENCH < 153 > /L.CLFX.E /d025 /d025 2605 / /d025 /d025 IFDEF CANADA < 141 > /L.G.A. /d025 /d025 IFDEF FRENCH < 141 > /L.G.A. /d025 /d025 JMS RTNWT /WAIT FOR RETURN /d025 /d025 JMP GMERDSP /NOT RETURN DISPLAY COMPLAINT AGAIN /d025 /d025 TAD (2205) /ERASE SCREEN, RETURN TO CALLER, ASK AGAIN /d025 /d025 JMS ERASE / /d025 GMRTN2, ISZ GMTST /GOLD KEY NOT GOLD M RETURN GMRTN1, JMP I GMTST /GOLD M RETURN CHKIT, /AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO READ DISKETTE ID TAD DSKNO /ADD CURRENT DISKETTE ID SNA CLA /IF ZERO SAME DISKETTE IS IN SO JMP GMRTN1 /SET FOR GOLM RETURN JMS RBELL /ELSE RING BELL JMS RSDSK /FLASH REPLACE SYSTEM FLOPPY DISPLAY CDFMYF CIFMNU JMS I INACAL INBUF JMP GMTST1 JMS RBELL JMP CHKIT / SUBROUTINE TO DISPLAY: 'TYPING "" HAS NO MEANING HERE' / CALLED BY: JMS NOMEAN; RETURN PC (and read input again) NOMEAN, XX / COSMETIC display mods /M0018 NOMNDSP,JMS RBELL / RING BELL /d025 /d025 IFDEF ENGLSH < /A011 /d025 CLA / TRUNCATE STUFF BETWEEN QUOTES /A011 /d025 DCA I (INBUF+14)/ SO MESSAGE WILL FIT ON 1 LINE /A011 /d025 / end 'ifdef english' /A011 > /d025 /d025 IFDEF FRENCH < /A011 /d025 CLA /A011 /d025 DCA I (INBUF+14) /A011 /d025 / end 'ifdef french' /A011 > /d025 /d025 CIFMNU / DISPLAY: 'TYPING "" HAS NO MEANING HERE' /d025 JMS I IOACAL /d025 0 /d025 NMEAN /d025 -2700 / LINE 27 COLUMN 0 /M011 /d025 /d025 IFNDEF DUTCH < /A011 /d025 INBUF+1 / WE NEED THE +1 TO MOVE ONE ADDRESS BEYOND /d025 / THE -BUFFER SIZE IN FIRST LOCATION /d025 / end 'ifndef dutch' / > /d025 /d025 IFDEF CANADA < 141 > / L.G.A. /d025 IFDEF FRENCH < 141 > / L.G.A. /d025 /d025 JMS RTNWT / WAIT FOR RETURN /d025 JMP NOMNDSP / NO RETURN COMPLAIN AGAIN /d025 TAD (2605) / RETURN SO ERASE SCREEN /d025 JMS ERASE / CLA / /a025 JMP I NOMEAN / RETURN TO CALLER TO ASK AGAIN NDERR, XX TAD I NDERR /PICK UP DOC NAME DCA DCNAM /STORE IT FOR ERROR MESSAGE ISZ NDERR /INCREMENT FOR RETURN CDFMNU /CHANGE TO MENU FIELD TAD I (MUBUF+MNDRV) /PICK UP DRIVE NUMBER CDFMYF /CHANGE BACK TO MY FIELD DCA DCRV /STORE IN DRIVE NUMBER FOR ERROR MESSAGE TAD (2205) JMS ERASE JMS NDERCW / CHECK FOR WINCHESTER DRIVE /A030 NDDSP, CIFMNU JMS I IOACAL 0 NDOC 2205 NDSTR, 0000 / ADDR OF SUBSTRING "DRIVE-DEVICE /A030 DCRV, 0000 DCNAM, 0000 CIFMNU JMS I IOACAL 0 TARTN 2505 JMS RTNWT /WAIT FOR RETURN JMP NDDSP /NOT RETURN COMPLAIN AGAIN TAD (2205) /RETURN ERASE SCREEN JMS ERASE JMP I NDERR /AND CONTINUE / CHECK FOR WINCHESTER DRIVE /A030 NDERCW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA NDOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER DRIVE /A030 AND NDOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 TAD DCRV / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP NDCTD / YES - INSERT TEXT "DRIVE /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTW / NO - INSERT TEXT "DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND NDOPTN / IS VOLUME ASSIGNED TO 1 /A030 SNA CLA / YES - SKIP AND INSERT "DEVICE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 NDCTW, TAD (SRDEV) / ADDR OF TEXT "DEVICE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 JMP NDCWEX / BRANCH TO EXIT /A030 NDCTD, TAD (SRDRV) / ADDR OF TEXT "DRIVE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 NDCWEX, JMP I NDERCW / RETURN /A030 NDOPTN, 0 / OPTION WORD /A030 PAGE / READ FROM KEYBOARD / CALLED BY: JMS KBRD; RETURN TYPED KBRD, XX /COMPARE IS DESIRED CALLED WITH 0 IN AC KBRD1, CDFMYF CIFMNU JMS I INACAL / CALL INA TO READ INPUT INBUF / LOCATION TO RECEIVE INPUT JMP GOLDTST / PROCESS GOLD KEY CLA MQA / MQ CONTAINS #CHARS IN BUFFER SNA CLA / IF THIS IS 0 RETURN WAS TYPED JMP I KBRD / GO BACK TO CALLER JMS NOMEAN / ELSE MUST BE INAPPROPRIATE RESPONSE COMPLAIN JMP KBRD1 / ASK AGAIN GOLDTST,JMS GMTST / GO READ GOLD KEY JMP CUSR1 / GOLD MENU RETURN JMS PRETURN / DISPLAY PRESS RETURN A007 JMS ORGOLD / DISPLAY OR PRESS GOLD M A007 ORAR / A007 JMP KBRD1 / READ INPUT AGAIN NOT GOLD MENU / CALLED WITH 0 OR 1 IN AC TO DETERMINE / FROM WHICH FLOPPY THE 'HOME' BLOCK / WILL BE READ GTDKID, XX JMS CUPDRS TAD (CUB1) / BUFFER ADDRESS DCA QUQBLK+RXQBAD TAD (RXBDIR)/ BLOCK TO READ (HOME BLOCK) DCA QUQBLK+RXQBLK TAD (RXEDN) / TELL QURX TO 'get density' /A0020 DCA QUQBLK+RXQFNC /A0020 JMS QURX / /A0020 CLA / /A0020 TAD (RXERD) / TELL QURX TO 'read' DCA QUQBLK+RXQFNC JMS QURX CLA / THIS CLOBBERS ANY QURX ERROR RETURN TAD CUB1+5 / INDEX TO FIFTH WORD (DISKETTE ID#) JMP I GTDKID / EXIT WITH CURRENT DISKETTE ID IN AC /SEE IF PRINTER IS BUSY BEFORE TELLING USER TO REMOVE FLOPPY PTRCHK, XX CLA CDFPRT /CHANGE DATA FIELD TO PRINTER FIELD TAD I (PRSTTS) /GET PRINTER STATUS WORD CDFMYF /CHANGE DATE FIELD BACK TO MINE SNA CLA /IF NOT ZERO COMPLAIN JMP I PTRCHK /ELSE RETURN TO CALLER AND CONTINUE PTRMSG, JMS ERASE CIFMNU /DISPLAY PRINTER IS BUSY MESSAGE JMS I IOACAL 0 PTRBUS 505 605 JMS ORGOLD /DISPLAY PRESS GOLD M FOR MM NARG JMP INPUT /READ INPUT /HERE FOR SPACE REASONS M007 NEWLN, XX / A007 CDFMYF / A007 CIFMNU / A007 JMS I IOACAL / CALL IOA OUTPUT ROUTINE A007 0 / ADDRESS OF OUTPUT ROUTINE A007 ASTRING / A007 CRLF / STRING FOR CAR RETURN LINEFEED A007 JMP I NEWLN / A007 TOSMALL, XX JMS TOSCKW / CHECK FOR WINCHESTER /A030 CDFMYF CIFMNU /CHANGE INSTRUCTION FIELD TO MENU FIELD JMS I IOACAL /GO DISPLAY NOT ENOUGH ROOM SPECIFY ANOTHER DRIVE 0 TSMALL /ADDRESS OF FIRST PROMPT 505 /DISPLAY FIRST PROMPT ON LINE 5 COLUMN 5 TSSTRA, 0000 / ADDR OF SUBSTRING /A030 CUSRC6 /RESULT DRIVE NUMBER 605 JMP I TOSMALL /EXIT ROUTINE WHICH UNLOCKS DOCUMENTS BEFORE GOING TO MM CUSR1, JMP RETMNU /M027 /CALLS MENU TO READ INPUT TO DOC PROMPTS, TOA AND GO PROMPTS /CALLED BY: /JMS READMU / GOLD M DATA FIELD SET TO MY FIELD / CONTINUE PROCESSING DATA FIELD SET TO MENU FIELD READMU, XX CDFMNU DCA I (MUBUF+MNTMP4) /SET TMP4 FOR APPROPRIATE FUNCTION READLP, CDFMYF /SET DATA FIELD TO MENU /M027 CIFMNU;JMS I MNUCAL;DLMSR1 /CALL MENU CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNTMP3) /GET AND TEST CONTENTS OF TMP3 SZA /IF 0 THEN GOLD KEY WAS PRESSED JMP RDRTN2 /NOT GOLD KEY SO RETURN AND PROCESS INPUT TAD I (MUBUF+MNSYSA) /WAS GOLD KEY TO GET IT TAD (4000) /SET FIRST BIT TO 1 BECAUSE MENU STRIPS IT OFF CDFMYF /CHANGE DATA FIELD TO MINE JMS GMTST /PROCESS GOLD KEY JMP RDRTN1 /GOLD M RETURN /d025 JMS PRETURN /DISPLAY PRESS RETURN /A007 /d025 /d025 JMS ORGOLD /DISPLAY OR PRESS GOLD M /A007 /d025 /d025 ORAR / /A007 /d025 JMP READLP /GOLD GARBAGE, READ INPUT AGAIN /M027 RDRTN2, ISZ READMU /GOLD M EXIT RDRTN1, JMP I READMU /CONTINUE EXIT /COPIES INPUT FROM MENU FIELD TO INBUF FOR NO MEANING PROMPT MVINPT, XX CLA JMS CUCOPY /GO COPY INPUT FROM MENU FIELD TO INBUF MUISTR /ADDRESS OF FROM FOR CUCOPY CDFMNU /DATA FIELD OF FROM INBUF+1 /ADDRESS OF FOR FOR CUCOPY CDFMYF /CHANGE DATA FIELD TO MINE STRLEN /NUMBER OF WORDS TO COPY (STANDARD) JMP I MVINPT /RETURN TO CALLED PAGE / PARSE A SPECIFICATION DOCUMENT FOR SORT AND LOAD THE RESULT INTO MEMORY / PARSE, . DCA SPECNO /AJF PUT SPEC DRIVE & DOC FROM AC INTO SPECNO DCA DEADKEY / CLEAR DEADKEY FLAG / TAD (-KVTWIDTH); DCA VTWIDTH /SET LINE WIDTH FOR DISPLAY ROUTINE D007 /INITIALIZE FIELD NAME COUNTER MAXIMUM FIELD SIZE M007 DCA NUMKEY /SET KEY FIELD COUNTER TO ZERO A007 AC4000 /SET AC TO 4000 A007 DCA ORDWD /SET FIRST BIT OF ORDWRD TO 1 A007 DCA FTYPE /SET FIELD NAME TYPE TO 0 A007 / SETUP INTO AUTO INDEX #12 / AC7777 CDFSRT /CHANGE DATA FIELD TO SORT FIELD A007 TAD I (SDFNBUFFER) /GET LOCATION OF BUFFER M007 CDFMYF /CHANGE DATA BACK TO MY FIELD A007 DCA A12 TAD (-FNSIZE-1); DCA FNCOUNT JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT A008 CIFMNU JMS I IOACAL /CALL IOA 0 /ADDRESS OF OUTPUT ROUTINE HC /TEXT STRING TO POSITION CURSOR ON LINE 3 M008 0100 /SET TO LINE 3 SO THERE IS ROOM FOR 12 LINES /OF SPEC DOC AND ERROR MESSAGES / /OPEN THE FILE FOR READING / TAD SPECNO; CIFFIO; FILEIO; XRDFIN /M0010 /LOOKING FOR THE TEXT STRING: / / 'SORT ON IN ASCENDING ORDER' / /OR: 'SORT ON IN DESCENDING ORDER' / / WITHIN THE SORT SELECTION SPECIFICATION DOCUMENT / STPARS, JMS TXTCOM; MSORTON; ERR001 / PARSE THE FROM THE SPECIFICATION DOCUMENT / /GET A CHARACTER FROM THE SPEC DOC - *** ERR001 IF NO MORE / CLA; JMS RD1CHR; ERR001 / TEST CHARACTER FOR '<' LEFT ANGLE BRACKET *** ERR001 IF NOT / (AC) = CHARACTER FROM 'JMS RD1CHR' / TAD (-74); SZA CLA; ERR001 JMP GETFNCHAR DONE, CLA AC7777 /SET AC TO -1 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 /WRITE -1 BUFFER TERMINATOR XSDFN A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 JMP I PARSE /EXIT TO PROMPT FOR LIST DOC ERR, XX / A007 CDFMYF /MAKE SURE DATA FIELD IS MY FIELD A007 CIFMNU /MAKE INSTRUCTION FIELD MENU FIELD A007 JMS I IOACAL /CALL IOA A007 0 / A007 ASTRING / A007 ACARET /STRING TO POSITION THE CARET A007 JMS NEWLN / POSITION THE NEXT LINE A007 JMP I ERR /EXIT A007 / CHECK FOR WINCHESTER /A030 DERCKW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA DEOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND DEOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT1 / NO - INSERT TEXT - DISKETTE, DRIVE /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP DERCT2 / YES - INSERT TEXT - DISKETTE,DRIVE,DISK/VOL /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT3 / NO - INSERT TEXT - VOLUME,DEVICE,DISK/VOL /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND DEOPTN / IS VOLUME ASSIGNED ? /A030 SNA CLA / YES - SKIP & INSERT TEXT - VOL,DEV,DSK/VOL /A030 JMP DERCT2 / NO - GO INSERT TEXT - DSK,DRV,DSK/VOL /A030 DERCT3, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA DERST1 / INTO PARAMETER LIST /A030 TAD (DERVL2) / ADDR OF "VOLUME /A030 DCA DERST2 / INTO PARAMETER LIST /A030 TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO PARAMETER LIST /A030 JMP DERCEX / BBRANCH TO EXIT /A030 DERCT1, TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST3 / INTO LIST /A030 JMP DERCT4 /A030 DERCT2, TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO LIST /A030 DERCT4, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA DERST1 / INTO LIST /A030 TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST2 / INTO LIST /A030 DERCEX, JMP I DERCKW / RETURN /A030 DEOPTN, 0000 / OPTION WORD /A030 PAGE /GETFNCHAR, AC0000; JMS RD1CHR; ERR001 GETFNCHAR, AC7777; JMS RD1CHR; ERR001 /M003 MQL / TEMP SAVE IT IN THE MQ MQA TAD (-76) /SEE IF '>' SNA JMP FNEND /YES, DONE FIELD TAD (2) /SEE IF '<' SNA ERR001 / '<' FOUND WITHIN TAD (2) /SEE IF IT IS A : (COLON SIGNIFIES A007 SZA CLA /NUMERIC KEY FIELD) A007 JMP INCFCTR /IF NOT A COLON CONTINUE A007 TAD ORDWD /IF COLON SET APPROPRIATE BIT IN FTYPE A007 TAD FTYPE /A007 DCA FTYPE /STORE WORD WITH BIT SET FOR NUMERIC A007 INCFCTR,TAD DEADKEY / Check for the status of dead keys /a031 SNA CLA / Is one currently being evaluated? /a031 ISZ FNCOUNT / No, SEE IF ROOM /m031 SKP ERR001 / EXCEEDED 30(10) CHARACTERS MQA CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007M014 DCA I A12 /AND STORE IN STRING CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 JMP GETFNCHAR /LOOP BACK FOR MORE FNEND, CLA / A007 TAD FNCOUNT /GET COUNT OF WORDS USED A007 TAD (FNSIZE+1) /COMPARE WITH ORIGINAL BUFFER SIZE A007 SNA CLA /IF EQUAL A007 ERR001 /THERE IS AN ERROR ONLY <> FOUND A007 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 / [0] /THERE ARE CHARACTERS STORE TRAILING 0 A007 CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 DCA FNCOUNT /SET FIELD CHARACTER COUNTER BACK TO 0 A007 /FOR NEXT FIELD A007 ISZ NUMKEY /INCREMENT KEY FIELD COUNTER A007 CMPORDER,JMS TXTCOM; MINA; JMP CHKD; JMP CHKETC CHKD, CLA TAD THCHAR /GET CHAR TXTCOM STORED IFDEF ENGLSH < TAD (4) /IS IT A D? > IFDEF ITALIAN < TAD (4) > IFDEF V30NOR < TAD (31) /IS IT A Y? > IFDEF V30SWE < TAD (6) /IS it an F > IFDEF DUTCH < TAD (1) > IFDEF SPANISH < TAD (4) > SZA /IF AC 0 THEN IT IS A D SEE IF NEXT CHAR IS AN E ERR001 /ELSE ERROR CHKE, JMS TXTCOM; ME; ERR001 CLA / A007 TAD ORDWD /GET ORDER WORD AND COMBINE WITH ORDER A007 /FIRST TIME HERE BIT 0 IS SET FOR DESCENDING, NEXT TIME BIT 1 ETC. A007 TAD ORDER /ADD CONTENTS OF ORDER A007 DCA ORDER /STORE BACK IN ORDER A007 CHKETC, JMS TXTCOM; MSCENDING; ERR001 /A SUCCESSFUL COMPARISON OF THE TEXT STRING 'ASCENDING ' OR 'DESCENDING ' /HAS BEEN COMPLETED /SET NEXT BIT IN ORDWD FOR KEY FIELD DESCRIPTOR WORDS ORDER AND FTYPE A007 CLA CLL TAD ORDWD /GET ORDER WORD A007 RAR /MOVE BIT ONCE TO RIGHT A007 DCA ORDWD /STORE BACK IN ORDER WORD A007 /THE TEXT STRING 'ORDER' MUST SUFFIX / JMS TXTCOM; MORDER; ERR001 / /PARSE FOR AND A007 PSAND, JMS TXTCOM; MAND; JMP ERRTST / A007 CLA /SEE IF MAX FIELDS HAVE BEEN SPECIFIED A007 TAD NUMKEY /GET KEY FIELDS SPECIFIED A007 TAD (-MXFLD) /IS MAX = TO NUMBER SPECIFIED A007 SNA CLA /IF AC 0 A007 ERR002 /DISPLAY ERROR A007 JMP STPARS /ELSE BEGIN PARSING NEXT LINE A007 SPECNO, 0000 ORDWD, 0000 /USED TO SET KEY FIELD NAME DESCRIPTOR WORDS A007 /ORDER AND FTYPE, 1 IN ORDER MEANS SORT IS DESCENDING A007 /ORDER, AND 1 IN FTYPE MEANS NUMERIC FIELD A007 /THIS VARIABLE IS FIRST SET TO 4000 AND THE 1 IN BIT 0 A007 /IS SHIFTED ONCE TO RIGHT EACH TIME THROUGH PARSER A007 FNCOUNT,0000 /**************************************************************************** / / The next routine has been moved to where OUT2VT was to make /a031 / room for changes to the parser for dead key sequence evaluation /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 /d031 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 /d031 CLA / CLEAR AC /A030 /d031 CDFMNU / MENU FIELD /A030 /do31 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 /d031 CDFMYF / BACK TO THIS FIELD /A030 /d031 DCA TSOPTN / SAVE VALUE /A030 /d031 AC0004 / MASK - WINCHESTER INSTALLED /A030 /d031 AND TSOPTN / IS WINNIE BIT SET ? /A030 /d031 SNA CLA / YES - SKIP AND CONTINUE /A030 /d031 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 /d031 TAD CUSRC6 / CK FOR DRIVE 0 /A030 /d031 SNA / NO - SKIP & CONTINUE /A030 /d031 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 /d031 TAD (-1 / CK FOR DRIVE 1 /A030 /d031 SZA CLA / YES - SKIP & CONTINUE /A030 /d031 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 /d031 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 /d031 AND TSOPTN / IS VOLUME ASSIGNED /A030 /d031 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 /d031 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 /d031 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 /d031 DCA TSSTRA / INTO PARAMETER LIST /A030 /d031 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 JMP TSCKEX / BRANCH TO EXIT /A030 /d031 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 /d031 JMP TSCTD3 / /A030 /d031 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 /d031 DCA TSSTRA / INTO LIST /A030 /d031 TSCKEX, JMP I TOSCKW / RETURN /A030 /d031 TSOPTN, 0000 / OPTION WORD /A030 PAGE /BEFORE YOU START TEARING YOUR HAIR OUT I WILL EXPLAIN A007 /EVERYTHING YOU ARE AFRAID TO ASK ABOUT THE FOLLOWING FEW A007 /LINES OF CODE. WE ARE HERE BECAUSE OF A TEXT COMPARISON A007 /FAILURE. THE CATCH IS THERE ARE TWO EXITS OUT OF TXTCOM A007 /IF THERE ARE NO MORE CHARACTERS IN THE SPEC DOC AND IF A007 /THERE IS A MATCH FAILURE WITH THE CONTENTS OF SPEC DOC A007 /AND THE WORD 'AND'. IF THERE ARE NO MORE CHARACTERS IN SPEC A007 /DOC THE VARIABLE THCHAR IS NOT UPDATED SO IT STILL CONTAINS A007 /THE R FROM THE WORD ORDER FROM LAST TXTCOM CALL. SO TO A007 /DETERMINE IF WE ARE EXITING BECAUSE IT IS END OF SPEC DOC A007 /I TEST FOR AN R. THE VARIABLE THCHAR CONTAINS THE NEGATIVE A007 /VALUE OF THE LAST CHARACTER. THIS SEEMED EASIER THAN REWRITING A007 /PARSER. A007 ERRTST, CLA /SEE WHAT KIND OF ERROR A007 TAD THCHAR /SEE IF THCAR IS UPDATED IF NOT DONE A007 IFDEF ENGLSH < TAD (22) /SEE IF LAST CHAR READ FROM SPEC IS R A007 > IFDEF V30NOR < TAD (5) > IFDEF ITALIAN < TAD (5) > IFDEF V30SWE < TAD (7) > IFDEF DUTCH < TAD (5) > IFDEF SPANISH < TAD (5) > SZA CLA /IF IT IS WE ARE DONE A007 ERR002 /ELSE JUST AN ORDINARY ERROR A007 JMP DONE / NOTE THAT (AC) = 0 HERE NATURALLY / / JMS RD1CHR; SKP /TRY TO GET ANOTHER CHAR FROM THE SPEC DOC / ERR002 /CALL ERROR 2 SPEC DOC TOO BIG / /THE SORT SELECTION SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY / ERR2, JMS ERR /POSITION CARET UNDER TEXT A007 CIFMNU / A007 JMS I IOACAL /DISPLAY ERROR MESSAGE A007 0 / A007 FSERR /DISPLAY # FIELDS SPECIFIED A007 NUMKEY, 0000 /NUMBER OF KEY FIELDS SPECIFIED A007 JMS NEWLN /CARRIAGE RETURN LINE FEED A007 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU A007 JMS I IOACAL / A007 0 / A007 FSER2 /NEXT LINE OF PROMPT A007 JMS NEWLN /POSITION ON NEXT LINE A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 PRCON /PRESS RETURN TO CONTINUE A007 JMS ORGOLD / A007 ORAR / A007 JMS KBRD /Return was typed /A013 JMP DONE /Exit parser /A013 ERR1, JMS ERR / A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 MWHAT /THIS OUTPUT ROUTINE ASSUMES SPEC DOC A007 IFDEF CANADA < 141 > /L.G.A. /WON'T EXCEED 12 LINES IFDEF FRENCH < 141 > /L.G.A. JMS ORGOLD / A007 NARG / A007 /D026 IFDEF WS102 < /D007 JMS ULKSUB; SPECNO; CDFMYF /D026 > /END IFDEF WS102 JMP INPUT /READ INPUT A008 / THE SORT SPECIFICATION DOCUMENT HAS BEEN PARSED OK / / THE RESIDES WITHIN 'SDFNBUFFER' / / READ A CHARACTER FROM THE SPECIFICATION DOCUMENT (OR THE DOCUMENT OPENED) / / JMS RDNXCH; EOF RETURNS TO HERE; OK RETURNS TO HERE / RDNXCH, .; CLA; CIFFIO; FILEIO; XRDFNC /M0010 SPA; CLA / Treat read errors like E-O-F. /A0016 SZA ISZ RDNXCH JMP I RDNXCH /SUBROUTINE TO READ IN A CHARACTER FROM THE SPECIFICATION DOCUMENT /AND EXIT WITH IT IN THE AC / / AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, FUNNY SPACES AND 'S / AC AT ENTRY =-1: IGNORES ONLY: RULERS, FUNNY SPACES AND LINE FEEDS / /CALLED WITH AC=0 OR AC=-1: / JMS RD1CHR /EOF RETURN (AC UNDEFINED) /NORMAL RETURN (AC CONTAINS CHARACTER) / RD1CHR, 0 DCA RDFLAG /SAVE FLAG RDNEXT, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** DISK EOF - EXIT *** DCA CHARIN /SAVE CHAR ( *** INCLUDING MODE BITS *** ) TAD CHARIN AND P177 /STRIP OFF MODE BITS TAD (-41) / IS IT A PRINTABLE CHARACTER ? SPA JMP NPC / NON PRINTABLE CHARACTER TAD (41) /GET BACK PRINTABLE CHARACTER JMS OUT2VT /AND OUTPUT TO THE SCREEN ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR /AND EXIT /NON PRINTING (SPECIAL) CHARACTER / NPC, TAD (25) / IS THE CHARACTER A FORM FEED: (-41)+(25)=- (14) SNA JMP LPTCTRL /YES, NOW CHECK IF SPECIAL TAD (-2) /NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SKPRULER /YES, GO IGNORE RULER TAD CHARIN /NO, GET CHAR BACK AND (7600) / LOOK AT MODE BITS SZA CLA JMP RDNEXT /YES, SO IGNORE IT TAD CHARIN /NO, GET CHAR ONCE MORE AND P177 / STRIP MODE BITS TAD (-BELL) / TEST FOR ^G (MODIFIED FLAG) ? SNA CLA JMP RDNEXT /YES, JUST IGNORE NORMFF, TAD CHARIN /GET CHARACTER TO RETURN WITH AND P177 / STRIP MODE BITS JMS OUT2VT /SHOW CHAR ON SCREEN MQL /SAVE CHAR TAD RDFLAG / TEST 'IGNORE ALL' FLAG SNA CLA JMP RDNEXT /YES, IGNORE CHARACTER MQA /NO, GET CHAR BACK ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR / EXIT / /LOOKING FOR -1014 (START OF PRINTER CONTROL) / OR -1414 (END OF PRINTER CONTROL) / LPTCTRL,TAD CHARIN /TEST FOR 'START OF PRINTER CONTROL' TAD (-1014) SZA CLA /YES, IGNORE ALL CHAR UNTIL 'END OF PRINTER CONTROL' JMP NORMFF /NO, MUST HAVE BEEN NORMAL FF TILEND, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** ERROR EXIT, DISK EOF *** TAD (-1414) / 'END OF PRINTER CONTROL' YET ? SZA CLA JMP TILEND / KEEP LOOKING FOR 'END OF PRINTER CONTROL' JMP RDNEXT /YES, BACK TO NORMAL PROCESSING / /START OF RULER (16) WAS FOUND ... IGNORE THE RULER / SKPRULER,JMS RDNXCH /GET A CHARACTER JMP I RD1CHR / *** ERROR EXIT *** TAD (-17) /END OF RULER? SZA CLA JMP SKPRULER /NO, KEEP LOOKING JMP RDNEXT /YES, BACK TO NORMAL PROCESSING RSDSK, XX / DISPLAYS 'REPLACE SYSTEM DISKETTE, CALLED IF USER CIFMNU / TYPES GOLD M AND A DOCUMENT RATHER THAN SYSTEM JMS I IOACAL / DISKETTE IS IN DRIVE 0 0 RSYS / REPLACE SYSTEM DISKETTE TEXT 2405 SDFW, NARG / FIRST WORD EITHER OR OR " " JMP I RSDSK PAGE /DISPLAY (OUTPUT TO THE SCREEN) THE CHARACTER IN THE AC AT ENTRY / (INSERTING A WHEN THE CHAR IN THE AC AT ENTRY = / /This routine has been moved to page 1000 to make room for the dead key /a031 /changes. /a031 /d031 OUT2VT, 0 /d031 DCA CHR2VT /SAVE CHARACTER TO BE DISPLAYED /d031 TAD CHR2VT /CHECK FOR RIGHT AWAY /d031 TAD (-CR) /d031 SZA CLA /d031 JMP NOTCR /d031 DCA DEADKEY /d031 JMP VTEXIT /d031 NOTCR, TAD DEADKEY /SEE IF IN MIDDLE OF DEADKEY SEQUENCE /d031 SZA CLA /d031 JMP VTEXIT /YES, DON'T OUTPUT CHAR /d031 TAD CHR2VT /d031 TAD (-BACKSP) /BACKSPACE ? /d031 SZA /d031 JMP NOTBACKSPACE / / START OF DEADKEY SEQUENCE / /d031 AC7777; DCA DEADKEY /SET DEADKEY FLAG /d031 CIFMNU /d031 JMS I IOACAL /DISPLAY DEAD KEY SEQUENCE /d031 0 /d031 ASTRING /d031 ASDK /d031 JMP VTEXIT /GET CHARACTER BACK AND EXIT /d031 NOTBACKSPACE,TAD (BACKSP-LF) /SEE IF LF /d031 SZA CLA /d031 JMP NOTEOL /NO M007 /d031 JMS NEWLN /OUTPUT CARRIAGE RETURN LINE FEED A007 /d031 VTEXIT, TAD CHR2VT /GET CHAR BACK /d031 JMP I OUT2VT /AND EXIT /d031 /d031 NOTEOL, CIFMNU / CHANGE THE 'IF' TO THE 'MENU' FIELD A007 /d031 JMS I IOACAL / TO 'IOA' FOR CHARACTER OUTPUT A007 /d031 0 /d031 ASTRING / ^S MEANS AN ASCII STRING (OF 1 CHAR) A007 /d031 CHR2VT / 'CHR2VT' CONTAINS 7-BIT ASCII A007 /d031 JMP VTEXIT / /**************************************************************************** / / The following code was moved here to make room for changes to /a031 / the parsing code for dead key sequence evaluation. /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA TSOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND TSOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP & CONTINUE /A030 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP & CONTINUE /A030 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND TSOPTN / IS VOLUME ASSIGNED /A030 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA TSSTRA / INTO PARAMETER LIST /A030 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 JMP TSCKEX / BRANCH TO EXIT /A030 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 JMP TSCTD3 / /A030 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA TSSTRA / INTO LIST /A030 TSCKEX, JMP I TOSCKW / RETURN /A030 TSOPTN, 0000 / OPTION WORD /A030 /**************************************************************************** / / END OF MOVED CODE /M031 / /**************************************************************************** CHARIN, 0 RDFLAG, 0 TOEFLG, 0 /d031 CHR2VT, ZBLOCK 1 / 7-BIT ASCII FOR OUTPUT TO THE SCREEN /d031 0 / [0] TERMINATOR FOR 'ASTRING' / 6-BIT TEXT STRING COMPARISON SUBROUTINE / JMS TXTCOM; MTEXT; ERROR RETURN; OK RETURN /THE ORDER OF CHAR COMPARS FROM THE 'TEXT' STRING IS: CX(1ST) CY(2ND) / TXTCOM, 0 AC7777 TAD I TXTCOM /ADDR-1 BECAUSE OF 'ISZ' THEN 'TAD I' ISZ TXTCOM / GET THE ADDRESS OF THE 'M'TEXT DCA TXTADR /SAVE THAT ADDRESS TSC1, AC7776 / -2 DCA COUNT /TWO 'TEXT' CHARACTERS PER 12-BIT WORD ISZ TXTADR / / NOTE THAT THE (AC) = 0 HERE NATURALLY / TSC2, TAD I TXTADR /GET TWO 'TEXT' CHARACTERS: CX CY ISZ COUNT BSW /AC LOOKS LIKE: CY CX AND (37) /KEEP ONE SNA JMP EXIT DCA T1 / AND TEMP (T1) SAVE IT JMS RD1CHR /READ 1 CHARACTER FROM THE SORT SPEC DOC JMP I TXTCOM / ** ERROR ** IF NO CHARACTERS REMAIN AND (37) / MAKE CHAR FROM SPEC DOC LOWER CASE CIA /THEN NEGATE IT FOR A COMP LATER DCA THCHAR /STORE THE NEGATED CHARACTER FROM SPEC DOC TAD THCHAR /GET IT BACK IN AC TAD T1 /GET BACK NEGATED CHAR VALUE FROM MTEXT SZA CLA /ARE THEY EQUAL? JMP I TXTCOM /NO ERROR RETURN TAD COUNT /YES CONTINUE COMPARE SNA CLA JMP TSC1 /TO RESET THE 'COUNT' JMP TSC2 /TO GET THE OTHER CHARACTER FROM THE TXTADR EXIT, ISZ TXTCOM /INCREMENT FOR NON ERROR RETURN JMP I TXTCOM /RETURN /D026 IFDEF WS102 < / INPUT, CDFMYF /MAKE SURE DATA FIELD IS SET TO MINE A008 CIFMNU /CHANGE INSTRUCTION FIELD TO MINE A008 JMS I INACAL /READ INPUT A008 INBUF /BUFFER TO HOLD KEYBOARD INPUT A008 JMP GLDKY /PROCESS GOLD KEY INPUT A008 JMS RBELL /NOT GOLD KEY RING BELL A008 JMP INPUT /READ INPUT AGAIN A008 GLDKY, JMS GMTST /TEST AND HANDLE GOLD KEY A008 JMP CUSR1 /GOLD M SO EXIT A008 JMS RBELL /GOLD GARBAGE RING BELL A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 NARG /DO NOT DISPLAY OR A008 JMP INPUT /READ INPUT AGAIN A008 RBELL, XX CIFMNU JMS I IOACAL 0 ASTRING BELTXT JMP I RBELL /D026 > / END IFDEF WS102 /d031 DEADKEY,0 TXTADR, 0 COUNT, -2 THCHAR, 0000 THRHRD, 0300 / CALLED WITH POSITION OF CURSOR IN AC ERASE, XX DCA CRPOS / STORE POSITION FOR CURSOR CIFMNU JMS I IOACAL 0 PSCR / STRING TO ERASE SCREEN AND POSITION CURSOR CRPOS, 0000 / CURSOR POSITION PASSED IN AC FROM CALLER JMP I ERASE / RETURN PRETURN,XX / DISPLAYS 'and press return CIFMNU JMS I IOACAL 0 PRTRN 2305 JMP I PRETURN PAGE PAGE CUSRDN, ZBLOCK STRLEN /RESULT DOCUMENT NAME CUSSDN, ZBLOCK STRLEN /SPEC DOCUMENT NAME CUSLDN, ZBLOCK STRLEN /LIST DOCUMENT NAME SRT, IFDEF ENGLSH < TEXT '^P--&S&O&R&T--' > IFDEF ITALIAN < TEXT /^P--!&ORDINAMENTO--/ > IFDEF V30NOR < TEXT '^P--!&SORTERING--'> IFDEF V30SWE < TEXT '^P--!&SORTERING--'> IFDEF DUTCH < TEXT '^P-- &SORTEREN --'> IFDEF SPANISH < TEXT '^P-!&CLASIFICAR--'> SPRMPT, IFDEF ENGLSH < TEXT '^P&TYPE THE NAME OF THE ^P^S' > IFDEF ITALIAN < TEXT /^P&INTRODURRE IL DOCUMENTO ^P^S/ > IFDEF V30NOR < TEXT '^P&SKRIV NAVNET P\E ^P^S'> IFDEF V30SWE < TEXT '^P&SKRIV NAMNET P\E ^P^S'> IFDEF DUTCH < TEXT '^P&TYPE DE NAAM VAN ^P^S'> IFDEF SPANISH < TEXT '^P&TECLEE EL NOMBRE DE ^P^S'> GSPEC, IFDEF ENGLSH < TEXT 'SORT SPECIFICATION DOCUMENT.' > IFDEF ITALIAN < TEXT /DI SPECIFICA ORDINAMENTO./ > IFDEF V30NOR < TEXT 'SORTERINGSPESIFIKASJONEN.'> IFDEF V30SWE < TEXT 'URVALSDOKUMENTET'> IFDEF DUTCH < TEXT 'DE SORTEERSPECIFICATIE'> IFDEF SPANISH < TEXT 'DOC. DE CLASIFICACI\SN DE ESPECIFICACI\SN.'> GLST, IFDEF ENGLSH < TEXT 'INPUT DOCUMENT YOU WANT TO SORT.' > IFDEF ITALIAN < TEXT /LISTA DA ORDINARE./ > IFDEF V30NOR < TEXT 'DET DOKUMENTET DU VIL SORTERE'> IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET SOM DU VILL HA SORTERAT'> GRES, IFDEF ENGLSH < TEXT 'OUTPUT DOCUMENT THAT WILL RECEIVE' GRES2, TEXT '^PTHE SORTED COPY OF THE INPUT DOCUMENT.' > IFDEF ITALIAN < TEXT 'DI USCITA.'> IFDEF V30NOR < TEXT 'DET DOKUMENTET DEN SORTERE' /M008 GRES2, /M008 TEXT '^PKOPIEN SKAL LEGGES I.' /M008 > IFDEF V30SWE < TEXT 'SLUTDOKUMENTET SOM DU VILL HA SORTERAT' GRES2, TEXT 'DET SORTERADE REGISTERDOKUMENTET' > IFDEF DUTCH < TEXT 'HET DOCUMENT WAARIN HET RESULTAAT MOET KOMEN' GRES2, TEXT '' > IFDEF SPANISH < TEXT 'DOC. SALIDA QUE RECIBIR\A' GRES2, TEXT '^PLA COPIA CLASIFICADA DEL DOC. DE ENTRADA.'> DEXTS, IFDEF ENGLSH < TEXT '^P&DOCUMENT ALREADY EXISTS. ' *.-1 TEXT '^P&HOW WOULD YOU LIKE THE DOCUMENT MODIFIED?' *.-1 TEXT '^P&T = &ADD TEXT TO THE TOP ' *.-1 TEXT '^P&B = &ADD TEXT TO THE BOTTOM' /M021 *.-1 TEXT '^P&O = &OVERWRITE THE DOCUMENT' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO ESISTENTE. ' *.-1 TEXT '^P&MODALIT\@ DI MODIFICA: ' *.-1 TEXT /^P&I = &INSERIMENTO TESTO ALL'INIZIO / *.-1 TEXT '^P&F = &INSERIMENTO TESTO ALLA FINE ' /M021 *.-1 TEXT '^P&S = &SOVRASCRITTURA ' *.-1 TEXT /^P&SCEGLIERE UN'OPZIONE E &PREMERE !&RITORNO./ > IFDEF V30NOR < TEXT '^P&DOKUMENTET FINNES ALLEREDE.' *.-1 TEXT '^P&HVORDAN VIL DU ENDRE DOKUMENTET? ' *.-1 TEXT '^P&T = &TILF\XYE TEKST P\E TOPPEN ' *.-1 TEXT '^P&B = &TILF\XYE TEKST P\E BUNNEN ' /M021 *.-1 TEXT '^P&O = &OVERSKRIVE DOCUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF V30SWE < TEXT '^P&DOKUMENTET FINNS REDAN ' *.-1 TEXT '^P&HUR VILL DU \DNDRA I DOKUMENTET? ' *.-1 TEXT '^P%B = &L\DGGA TILL TEXT I B\VRJAN ' *.-1 TEXT '^P%S = &L\DGGA TILL TEXT I SLUTET' /M021 *.-1 TEXT '^P%S%K = &SKRIVA \VVER DOKUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS !&RETURN.' > IFDEF DUTCH < TEXT '^P&DOCUMENT BESTAAT AL. ' *.-1 TEXT '^P&HOE WILT U DIT DOCUMENT WIJZIGEN?' *.-1 TEXT '^P&B = &VOEG TEKST TOE AAN HET BEGIN' *.-1 TEXT '^P&E = &VOEG TEKST TOE ANN HET EINDE' /M021 *.-1 TEXT '^P&O = &OVERSCHRIJF HET DOCUMENT' *.-1 TEXT '^P&MAAK EEN KEUZE EN DRUK OP !&RETURN.' > IFDEF SPANISH < TEXT '^P&EL DOCUMENTO Y EXISTE. ' *.-1 TEXT '^P\?&C\SMO LE GUSTAR\MA MODIFICAR EL DOCUMENTO? ' *.-1 TEXT '^P&T = &A\QADIR TEXTO EN PARTE SUPERIOR ' *.-1 TEXT '^P&B = &A\QADIR TEXTO EN PARTE INFERIOR ' /M021 *.-1 TEXT '^P&O = &ESCRIBIR SOBRE EL DOCUMENTO' *.-1 TEXT '^P&TECLEE LA LETRA Y PULSE !&RETORNO.' > NDOC, IFDEF ENGLSH < TEXT '^P&^S ^D DOES NOT HAVE A DOCUMENT NAMED ^A.' /M030 > IFDEF ITALIAN < TEXT /^P&^S ^D NON HA IL DOCUMENTO ^A./ > IFDEF V30NOR < TEXT '^P&^S ^D HAR IKKE NOE DOKUMENT KALT ^A.' /M030 > IFDEF V30SWE < TEXT '^P&^S ^D HAR INGET DOKUMENT SOM HETER ^A'> IFDEF DUTCH < TEXT '^P&^S ^D BEVAT GEEN DOCUMENT GENAAMD ^A.'> IFDEF SPANISH TRYAGN, /m023 IFDEF ENGLSH < / -------------------------------------------- /m023 TEXT '^P&WHEN TYPING TO THE MENU, USE THE NORMAL KEYS ON THE KEYBOARD ONLY. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&THE &RUBOUT KEY' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' CAN ALSO BE USED. &A LINE MAY CONTAIN A MAXIMUM ' /M024 *.-1 TEXT '^POF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N. ' *.-1 TEXT '^P&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.' > /Amdh / end ifdef ENGLSH -------------------------------------------------- IFDEF ITALIAN < TEXT'^P&PER SCEGLIERE LE OPZIONI DEL MENU UTILIZZARE SOLO I TASTI ALFANUMERICI ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&E SE NECESSARIO IL TASTO' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' !A&X]. &UNA RIGA PU\R CONTENERE AL' /M024 /Mmdh *.-1 TEXT '^PMASSIMO 71 CARATTERI E DEVE TERMINARE CON !&RITORNO. ' *.-1 TEXT '^P&PREMERE !&RITORNO PER CONTINUARE.' 74;0 /amdh > IFDEF V30NOR < / -------------------------------------------- /m023 TEXT '^P&BRUK BARE TASTENE P\E HOVEDTASTATURET N\ER DU SKRIVER EN KOMMANDO. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P!&SLETT-TASTEN' /M024 > / END IFDEF CONDOR /A024 *.-1 TEXT ' KAN OGS\E BRUKES. &EN LINJE KAN HA MAKS. ' /M024 *.-1 TEXT '^P71 TEGN OG M\E AVSLUTTES MED !&RETUR. ' *.-1 TEXT '^P&TRYKK P\E !&RETUR OG PR\XV IGJEN.' > /Amdh IFDEF V30SWE < TEXT '^P&ANV\DND BARA "VANLIGA" TANGENTER N\DR DU SKRIVER I MENYN ' *.-1 TEXT '^P!&BACKSTEG' *.-1 TEXT ' KAN OCKS\E ANV\DNDAS. &EN RAD F\ER BEST\E AV MAXIMALT' *.-1 TEXT '^P71 TCKEN OCH M\ESTE AVSLUTAS MED !&RETUR' *.-1 TEXT '^P&TRYCK P\E !&RETUR OCH F\VRS\VK IGEN' > IFDEF DUTCH < TEXT '^P&GEBRUIK ALLEEN DE TOETSEN OP HET HOOFDTOETSENBORD. ' *.-1 TEXT '^P&U KUNT DE TOETS X&] GEBRUIKEN OM TEKENS TE WISSEN.' *.-1 TEXT 'EEN REGEL MAG 71 TEKENS BEVATTEN GEVOLGD DOOR !&RETURN. ' *.-1 TEXT '^P' *.-1 TEXT '^P&DRUK OP !&RETURN PROBEER OPNIEUW.' > IFDEF SPANISH < TEXT '^P&CUANDO TECLEE EN EL MEN\Z, USE S\SLO LAS TECLAS DEL TECLADO NORMAL.' *.-1 TEXT '^P&LA TECLA &CORRECTORA TAMBI\IN SE PUEDE USAR. &UNA L\MNEA PUEDE ' *.-1 TEXT 'CONTENER UN M\AXIMO DE ^P71 CARACTERES Y HA DE TERMINAR CON !&RETORNO' > SRLCKER, IFDEF ENGLSH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS ALREADY IN USE.' > IFDEF ITALIAN < TEXT /^P^A&DOCUMENTO (!D.!D)^A GI\@ IN USO./ > IFDEF V30NOR < TEXT '^P^A&DOKUMENT (!D.!D)^A FINNES ALLEREDE.' > IFDEF V30SWE < TEXT '^P^A&DOKUMENT (!D.!D)^A ANV\DNDS REDAN'> IFDEF DUTCH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS AL IN GEBRUIK.' > IFDEF SPANISH < TEXT '^P^A&EL DOCUMENTO (!D.!D)^A YA EST\A EN USO.'> TARTN, IFDEF ENGLSH < TEXT '^P&PRESS &R&E&T&U&R&N TO TRY ANOTHER NAME.' > IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO, USARE UN ALTRO NOME.'> IFDEF V30NOR < TEXT '^PTRYKK P\E !&RETUR OG ANGI ET ANNET NAVN.'> IFDEF V30SWE < TEXT '^PTRYCK P\E !&RETUR OCH SKRIV ETT ANNAT NAMN' > IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN EN PROBEER OPNIEUW'> IFDEF SPANISH < TEXT '^P&PULSE !&RETORNO PARA INTENTAR OTRO NOMBRE.'> CNTCRE, IFDEF ENGLSH < TEXT '^P&UNABLE TO CREATE DOCUMENT.' > IFDEF ITALIAN < TEXT '^P&IMPOSSIBILE CREARE DOCUMENTO.' > IFDEF V30NOR < TEXT '^PKAN IKKE OPPRETTE DOKUMENT.' > IFDEF V30SWE < TEXT '^PDET G\ER INTE ATT SKAPA DOKUMENT.'> IFDEF DUTCH < TEXT '^P&KAN DOCUMENT NIET AANMAKEN.'> IFDEF SPANISH < TEXT '^P&IMPOSIBLE CREAR EL DOCUMENTO.'> WNUM, IFDEF ENGLSH < TEXT '^P&DOCUMENT NUMBERS MUST BE FROM 1 TO 200.' > IFDEF ITALIAN < TEXT '^P&NUMERI DOCUMENTO DEVONO ESSERE DA 1 A 200.' > IFDEF V30NOR < TEXT '^PDOKUMENTNUMRENE G\ER FRA 1 TIL 200.'> IFDEF V30SWE < TEXT '^PDOKUMENTETS NUMMER M\ESTE VARA 1-200.' > IFDEF DUTCH < TEXT '^PDOCUMENTNUMMERS MOETEN LIGGEN TUSSEN 1 EN 200.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> NMDC, IFDEF ENGLSH < TEXT '^P&THERE ARE NO MORE DOCUMENTS AVAILABLE.' > IFDEF ITALIAN < TEXT '^P&NON CI SONO DOCUMENTI DISPONIBILI.' > IFDEF V30NOR < TEXT '^P&INGEN LEDIGE DOKUMENTER.' > IFDEF V30SWE < TEXT '^P&DET FINNS INGA FLER DOKUMENT.' > IFDEF DUTCH < TEXT '^P&MAXIMALE AANTAL DOCUMENTEN BEREIKT.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> CNRG, TEXT '^P ' TYPGO, IFDEF ENGLSH < TEXT '^P&TYPE !&GO TO BEGIN &SORT' /M021 > IFDEF ITALIAN < TEXT '^P&INTRODURRE &E PER INIZIARE &ORDINAMENTO' /M021 > IFDEF V30NOR < TEXT '^P&SKRIV !&ST FOR \E SORTERE DOKUMENTET.' /M021 > IFDEF V30SWE < TEXT '^P&SKRIV !&OK F\VR ATT B\VRJA SORTERA.' /M021 > IFDEF DUTCH < TEXT '^P&TYP !&SV OM MET SORTEREN.'> IFDEF SPANISH < TEXT '^P&TECLEE &G&O PARA COMENZAR A &CLASIFICAR'> NMEAN, /m0018 IFDEF ENGLSH < TEXT '^P &TYPING "^A" HAS NO MEANING HERE. &PRESS &R&E&T&U&R&N AND TRY AGAIN.' /M011 > IFDEF ITALIAN < TEXT '^P &OPZIONE NON VALIDA.' /M011 > IFDEF V30NOR < TEXT '^P "^A" KAN IKKE BRUKES HER. &TRYKK P\E !&RETUR OG PR\XV IGJEN.' /M011 > IFDEF V30SWE < TEXT '^P "^A" BETYDER INGENTING H\DR.&TRYCK P\E !&RETUR OCH F\VRS\VK IGJEN.' /M011 > IFDEF DUTCH < TEXT '^P &"^A" HEEFT HIER GEEN BETEKENIS. &DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P &"^A" IS INCORRECTO. &PULSE !&RETORNO E INT\INTELO OTRA VEZ.'> PRTRN, IFDEF ENGLSH < TEXT '^P&AND &PRESS &R&E&T&U&R&N.' >/M008 IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO.' >/M008 IFDEF V30NOR < TEXT '^POG TRYKK P\E !&RETUR.' >/M008 IFDEF V30SWE < TEXT '^POCH TRYCK P\E !&RETUR.' >/M008 IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P&Y PULSE !&RETORNO.'> DOGM, IFDEF ENGLSH < TEXT '^P^A&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' >/M008 IFDEF ITALIAN < TEXT '^P^A&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE.' >/M008 IFDEF V30NOR < TEXT '^P^A&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.' >/M008 IFDEF V30SWE < TEXT '^P^A&TILLBAKA TILL HUVUDMENYN: AND\DND !&GULD !&MENY.' >/M008 IFDEF DUTCH < TEXT '^P^A&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.'> IFDEF SPANISH < TEXT '^P^A&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'> ORAR, IFDEF ENGLSH < "O-200;"R-200;40;0 > IFDEF ITALIAN < 0 > IFDEF V30NOR < "E-200; "L-200; ".-200;40;0> IFDEF V30SWE < "E-200; "L-200; ".-100;40;0> NARG, IFNDEF DUTCH < 0 > IFDEF DUTCH < 40;0 > AARG, IFDEF ENGLSH < "A-200;"N-200;"D-200;40;0 > IFDEF ITALIAN < "E-200;40;0 > IFDEF V30NOR < "O-200;"G-200;40;0> IFDEF V30SWE < "O-200;"C-200;"H-200;40;0> IFDEF DUTCH <40;0> IFDEF SPANISH < "Y-200;40;0> RSYS, IFDEF ENGLSH < TEXT '^P^A&REPLACE THE SYSTEM DISKETTE IN DRIVE 0' > IFDEF ITALIAN < TEXT /^P^A&INSERIRE IL DISCO SISTEMA NELL'UNIT\@ 0/ > IFDEF V30NOR < TEXT '^P^A&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0' > IFDEF V30SWE < TEXT '^P^A&S\DTT TILLBAKA SYSTEMDISKETTEN I ENHET 0' > IFDEF DUTCH < TEXT '^P^AZET DE SYSTEEMDISKETTE IN AANDRIJVER 0'> IFDEF SPANISH < TEXT '^P^AREPLACE THE DISKETTE IN UNIDAD 0'> CUSR1A, IFDEF ENGLSH < TEXT '^P&INPUT DOCUMENT: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&USING SORT SPECIFICATION DOCUMENT: (^D.^D) ^A' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&THE SORTED DOCUMENT WILL BE STORED IN: (^D.^D) ^A' *.-1 TEXT '^P&!D &KEY &SORT' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO LISTA: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DOCUMENTO DI SPECIFICA ORDINAMENTO: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&DOCUMENTO USCITA: (^D.^D) ^A ' *.-1 TEXT '^P&!D &CHIAVI &ORDINAMENTO' > IFDEF V30NOR < TEXT '^P&DOKUMENT SOM SKAL SORTERES: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&BRUKER SORTERINGSSPESIFIKASJON: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&SORTERT KOPI LAGRES I: (^D.^D) ^A' *.-1 TEXT '^P&!D SORTERINGSN\XKLER' > IFDEF V30SWE < TEXT '^P&DU ANV\DNDER REGISTERDOKUMENT (^D.^D) ^A ' /M008 *.-1 TEXT '^P&URVALSDOKUMENTET \DR (^D.^D) ^A' *.-1 TEXT '^P&DET SORTERADE REG (SLUTDOKUMENTET) \DR: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&!D SORTERINGSNYCKEL' > IFDEF DUTCH < TEXT '^P&HET TE SORTEREN BESTAND IS: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DE SORTEERSPECIFICTIE IS: (^D.^D) ^A' *.-1 TEXT '^P&HET RESULTAT KOMT IN DOCUMENT: (^D.^D) ^A' *.-1 TEXT '^P&ER WORDT GESORTEERD OP !D VELD(EN).' > IFDEF SPANISH < TEXT '^P&DOCUMENTO DE ENTRADA: (^D.^D) ^A ' *.-1 TEXT '^P&USANDO DOCUMENTO ESPECIFICACI\SN CLASIFICACI\SN:^A ' /M008 *.-1 TEXT '^P&EL DOC. CLASIFICADO SE ALMACENAR\A EN: (^D.^D) ^A' *.-1 TEXT '^P&!D &CLAVE &CLASIFICACI\SN' > TSMALL, IFDEF ENGLSH < TEXT '^P!E&THERE IS NOT ENOUGH ROOM ON THE ^S !D ' /A030 *.-1 TEXT '^PFOR THE SORTED DOCUMENT.' >/M008 IFDEF ITALIAN < TEXT /^P!E&SPAZIO INSUFFICIENTE SULL'^S !D / /A030 *.-1 TEXT '^P' >/M008 IFDEF V30NOR < TEXT '^P!E&IKKE NOK PLASS P\E ^S !D ' /A030 *.-1 TEXT '^PTIL DET SORTERE DOKUMENTET.' >/M008 IFDEF V30SWE < TEXT '^P!E&DET FINNS INTE TILLR\CKLIGT MED ^S !D ' /A030 *.-1 TEXT '^PF\VR DET SORTERADE DOKUMENTET.' >/M008 IFDEF DUTCH < TEXT '^P!E&ONVLDOENDE RUIMTE OP ^S !D VOOR HET RESULTAAT. ^P' > IFDEF SPANISH < TEXT '^P!E&NO HAY SUFICIENTE ESPACIO EN EL ^S !D' *.-1 TEXT '^PPARA EL DOCUMENTO CLASIFICADO.' > NWDRV, IFDEF ENGLSH < TEXT '^P&SPECIFY ANOTHER ^S.' /M030/M021 > IFDEF ITALIAN < TEXT /^P&SPECIFICARE UN'ALTRA ^S./ /M030/M021 > IFDEF V30NOR < TEXT '^P&ANGI EN ANNEN ^S.'> IFDEF V30SWE < TEXT '^P&V\DLJ ANNAN ^S.'> IFDEF DUTCH < TEXT '^P&GEBRUIK EEN ^S MET MEER RUIMTE.'> IFDEF SPANISH < TEXT '^P&ESPECIFIQUE OTRO ^S.'> PTRBUS, IFDEF ENGLISH < TEXT '^P&THERE ARE DOCUMENTS PRINTING > IFDEF ITALIAN < TEXT '^P&CI SONO DOCUMENTI IN STAMPA.' > IFDEF V30NOR < TEXT '^P&UTSKRIVING AV DOKUMENTER P\EG\ER.' > IFDEF V30SWE < TEXT '^P&UTSKRIFT P\EG\ER JUST NU.' > IFDEF DUTCH < TEXT '^P&DE PRINTER IS IN GEBRUIK.'> IFDEF SPANISH DERR, IFDEF ENGLSH < TEXT '^P&THE ^S !D IS NOT A VALID DOCUMENT ^S.' /M030 *.-1 TEXT '^P&USE ANOTHER DOCUMENT ^S.' /M030 > IFDEF ITALIAN < TEXT /^P&^S !D NON \H UN VALIDO ^S. / /M030 *.-1 TEXT '^P&USARE UN ALTRO ^S.' /M030 > IFDEF V30NOR < TEXT '^P&^S !D ER IKKE EN GYLDIG DOKUMENT^S.' /M030 *.-1 TEXT '^P&BRUK EN ANNAN DOKUMENT^S.' /M030 > IFDEF V30SWE < TEXT '^P&^S !D \DR INTE ETT DOKUMENT SOM G\ER ATT ANV\DNDA^S.' /M030 *.-1 TEXT '^P&ANV\DND ETT ANNAT DOKUMENT ^S.' /M030 > IFDEF DUTCH < TEXT '^P&DE ^S !D IS GEEN DOCUMENT ^S.' /M030 *.-1 TEXT '^P&GEBRUIK EEN DOCUMENT ^S.' /M030 > IFDEF SPANISH < TEXT '^P&^P&EL ^S !D NO ES UN DOCUMENTO V\ALIDO ^S. ' /M030 *.-1 TEXT '^P&USE OTRO DOCUMENTO ^S.' /M030 > RPLACE, IFDEF ENGLSH < TEXT '^P&REPLACE THE DISKETTE WITH AN EMPTY DOCUMENT DISKETTE ' *.-1 TEXT '^POR ONE WITH MORE AVAILABLE SPACE.' > /M008 IFDEF ITALIAN < TEXT '^P&UTILIZZARE UN ALTRO DISCHETTO.^P' > /M008 IFDEF V30NOR < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF V30SWE < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE DOOR EEN LEGE DOCUMENTDISKETTE ' *.-1 TEXT '^P OF EEN MET MEER RUIMTE.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DOCUMENTO Y C\AMIELO POR UN DISKETTE HAY ' *.-1 TEXT '^P M\AS ESPACIO'> RMOVE0, IFDEF ENGLSH < TEXT '^P&REMOVE THE DISKETTE IN DRIVE 0.' *.-1 TEXT'^P&REPLACE IT WITH A DOCUMENT DISKETTE TO ACCOMMODATE THE SORTED DOCUMENT.' > IFDEF ITALIAN < TEXT /^P&TOGLIERE IL DISCHETTO DALL'UNIT\@ 0 / *.-1 TEXT'^PE SOSTITUIRLO CON UN ALTRO.' > IFDEF V30NOR < TEXT '^P&FJERN DISKETTEN I STASJON 0 .' *.-1 TEXT '^P&ERSTATT DEN MED EN DOKUMENTDISKETT SOM HAR PLASS TIL DET SORTERTE' *.-1 TEXT ' DOKUMENTET' > IFDEF V30SWE < TEXT '^PTA UT DISKETTEN I ENHET 0 . ' *.-1 TEXT '^P&ERSTATT DEN MED DOK.DISKETT SOM KAN TA EMOT DET SORTERADE DOKUMENTET' > IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE IN AANDRIJVER 0.' *.-1 TEXT'^PDOOR DE DISKETTE WAAROP HET RESULTAAT MOET KOMEN.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DEL LA UNIDAD 0.' *.-1 TEXT '^PC\AMIELO POR UN DISKETTE DOC. PARA ACOMODAR EL DOC. CALSIFICADO'> / NOTE THAT A DOES NOT EXIST BETWEEN THE WORDS 'SORT' AND 'ON' / BECAUSE THE SUBROUTINE ( 'RD1CHR' ) WHICH GETS A CHARACTER / FROM THE SPECIFICATION DOCUMENT IGNORES IF ENTERED WITH THE AC=0 / / THEREFORE THE SUBROUTINE 'TXTCOM' WHICH COMPARES TWO CHARACTERS / ( ONE OF WHICH IS A CHARACTER FROM THE SPEC DOC) - IGNORES / IFDEF ENGLSH < MSORTON, TEXT 'SORTON' / USED BY 'TXTCOM' MINA, TEXT 'INA' /USED BY TXTCOM ME, TEXT 'E' /USED BY TXTCOM MSCENDING, TEXT 'SCENDING' /USED BY TXTCOM MORDER, TEXT 'ORDER' /USED BY TXTCOM MAND, TEXT 'AND' /USED BY TXTCOM /A007 > IFDEF ITALIAN < MSORTON, TEXT 'ORDINAMENTODI' / USED BY 'TXTCOM' MINA, TEXT 'INORDINEC' /USED BY TXTCOM ME, TEXT 'EC' /USED BY TXTCOM MSCENDING, TEXT 'RESCENTE' /USED BY TXTCOM MORDER, TEXT '' /USED BY TXTCOM MAND, TEXT 'E' /USED BY TXTCOM /A007 > IFDEF V30NOR < MSORTON, TEXT 'SORTERETTER' MINA, TEXT 'ISTIG' ME, TEXT 'NK' MSCENDING, TEXT 'ENDE' MORDER, TEXT 'REKKEFOLGE' MAND, TEXT 'OG' > IFDEF V30SWE < MSORTON, TEXT 'SORTERAEFTER' MINA, TEXT 'ISTIG' ME, TEXT 'ALL' MSCENDING, TEXT 'ANDE' MORDER, TEXT 'ORDNING' MAND, TEXT 'OCH' > IFDEF DUTCH < MSORTON, TEXT 'SORTEEROP' MINA, TEXT 'INOP' ME, TEXT 'F' MSCENDING, TEXT 'LOPENDE' MORDER, TEXT 'VOLGORDE' MAND, TEXT 'EN' > IFDEF SPANISH < MSORTON, TEXT 'CLASIFICARSEGUN' MINA, TEXT 'ENORDENA' ME, TEXT 'E' MSCENDING, TEXT 'SCENDENTE' MORDER, TEXT '' MAND, TEXT ',' > HC, /POSITION CURSOR TEXT '^P' /M008 PSCR, TEXT '^P!E' ASTRING, /POSITION THE CARET TEXT '^A' ACARET, LF;BACKSP;"^-200;CR;LF;0 ASDK, ESC;"(;"0&177 /TURN ON GRAPHICS MODE ESC;"0;"G-140 /DISPLAY DEAD KEY SEQUENCE ESC;"(;"B&177 /TURN OFF GRAPHICS MODE AGAIN 0 CRLF, CR;LF;0 MWHAT, IFDEF ENGLSH < TEXT '&E&R&R&O&R--SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.' > IFDEF ITALIAN < TEXT '!&ERRORE--SPECIFICA NON CORRETA DA QUESTO PUNTO.' > IFDEF V30NOR < TEXT '!&FEIL--FORST\ER IKKE SPESIFAKASJONEN FRA DETTE PUNKTET." > IFDEF V30SWE < TEXT '!&FEL - URVALSDOKUMENTET KAN INTE INLEDAS P\E DETTA S\DTT'> IFDEF DUTCH < TEXT '!&FOUT: &SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT'> IFDEF SPANISH < TEXT '!&ERROR--NO SE HA ENTENDIDO LA ESPECIFICACI\SN COMENZANDO EN ESTE PUNTO.'> IFDEF ENGLSH < FSERR, TEXT '^D FIELD NAMES HAVE BEEN SPECIFIED. &TEXT FOLLOWING THE' /M021 FSER2, TEXT 'LAST COMPLETE KEY FIELD SPECIFICATION WILL BE IGNORED.' /M021 PRCON, TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE.' /A007 > IFDEF ITALIAN < FSERR, TEXT '^D CAMPI NOME SPECIFICATI. &IL TESTO CHE SEGUE' /M021 FSER2, TEXT /L'ULTIMO CAMPO SPECIFICATO VIENE IGNORATO./ /M021 PRCON, TEXT '&PREMERE !&RITORNO PER CONTINUARE.' /A007 > IFDEF V30NOR < FSERR, TEXT '^D FELTNAVN ER SPESIFISERT. &DET VIL IKKE BLI TATT HENSYN' /M021 FSER2, TEXT 'TIL TEKST SOM ST\ER ETTER SISTE FULLSTENDIGE FELTSPESIFIKASJON.'/M021 PRCON, TEXT '&TRYKK P\E !&RETUR FOR \E FORTSETTE.' /A007 > IFDEF V30SWE < FSERR, TEXT '^D F\DLTNAMN HAR SPECIFICERATS.&TEXT SOM FINNS EFTER DEN' FSER2, TEXT 'SISTA FULLST\DNDIGA SORTERINGNYCKELN KOMMER INTE ATT BEHANDLAS.' PRCON, TEXT '&TRYCK P\E !&RETUR F\VR ATT FORTS\DTTA.'> IFDEF DUTCH < FSERR, TEXT '&E ZIJN ^D VELDNAMEN OPGEGEVEN. &TEKST NA DE LAATSTE' FSER2, TEXT 'VELDNAAMSPECIFICATIE ZAL WORDEN GENEGEERD.' PRCON, TEXT '&DRUK OP !&RERTURN OM VERDER TE GAAN.'> IFDEF SPANISH < FSERR, TEXT '&SE HAN ESPECIFICADO NOMBRESS DE CAMPO^D. &TEXTO QUE SIGUE HA' FSER2, TEXT '&SE IGNORAR\A LA \ZLTIMA ESPECIFICACI\SN DE CAMPO DE CLAVE CPMPLETA.' PRCON, TEXT '&PULSE !&RETORNO PARA CONTINUAR' > BELTXT, BELL;0 GOTXT, IFDEF ENGLSH < TEXT 'GO' > IFDEF ITALIAN < TEXT 'E' > IFDEF V30NOR < TEXT 'ST' > IFDEF V30SWE < TEXT 'OK' > IFDEF DUTCH < TEXT 'SV'> IFDEF SPANISH < TEXT 'GO'> SRDRV, /A030 IFDEF ENGLSH < TEXT 'DRIVE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'STASJON'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIJVER'> IFDEF SPANISH < TEXT 'UNIDAD'> SRDEV, /A030 IFDEF ENGLSH < TEXT 'DEVICE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJVER'> IFDEF SPANISH < TEXT 'DISPOSITIVO'> DERDS1, /A030 IFDEF ENGLSH < TEXT 'DISKETTE IN DRIVE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'DISKETTEN I STASJON'> IFDEF V30SWE < TEXT 'DISKETTEN I ENHET'> IFDEF DUTCH < TEXT 'DISKETTE IN AANDRIJVER'> IFDEF SPANISH< TEXT 'DISKETTE EN UNIDAD'> DERDS2, /A030 IFDEF ENGLSH < TEXT 'DISKETTE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT'> IFDEF V30SWE < TEXT 'DISKETTEN'> IFDEF DUTCH < TEXT 'DISKETTE'> IFDEF SPANISH DERVL1, /A030 IFDEF ENGLSH < TEXT 'VOLUME ON DEVICE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'OMR\EDET P\E ENHET'> IFDEF V30SWE < TEXT 'VOLYMEN I ENHET'> IFDEF DUTCH < TEXT 'GEBIED OP AANDRIJVER'> IFDEF SPANISH < TEXT 'VOLUMEN EN DISPOSITIVO'> DERVL2, /A030 IFDEF ENGLSH < TEXT 'VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'OMR\DE'> IFDEF V30SWE < TEXT 'VOLYMEN'> IFDEF DUTCH < TEXT 'GEBIED'> IFDEF SPANISH < TEXT 'VOLUMEN'> DERDKV, /A030 IFDEF ENGLSH < TEXT 'DISKETTE/VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT/OMR\DE'> IFDEF V30SWE < TEXT 'DISKETTEN/VOLYMEN'> IFDEF DUTCH < TEXT 'DISKETTE/GEBIED'> IFDEF SPANISH< TEXT 'DISKETTE/VOLUMEN'> TSDEV, /A030 IFDEF ENGLSH < TEXT 'DRIVE/DEVICE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'STASJON/ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJER'> IFDEF SPANISH < TEXT 'UNIDAD/DISPOSITIVO'> /XSDFNBUFFER,ZBLOCK FNSIZE+1^MXFLD+1 /MXFLD 12(10) FNSIZE+1 31(10) D007 /CHAR BUFFER EACH KEY /SEPARATED BY [0]TERM /BUFFER ENDS WITH [-1] TERM /THE XSDFNBUFFER BUFFER WILL BE DEFINED IN THE SORT FIELD DUE TO SPACE /CONSTRAINTS IN EDIT FIELD CUB1, ZBLOCK 400 INBUF, -STRLEN ZBLOCK STRLEN+1 PAGE