This program prints the user interface, data manipulation,
system default, KSAM/3000 key sequence, VPLUS/3000 forms file, and
IMAGE/3000 database language numbers.
1 $CONTROL USLINIT
1.1 IDENTIFICATION DIVISION.
1.2 PROGRAM-ID. EXAMPLE.
1.3 * ---------------------------------------------------
1.4 ENVIRONMENT DIVISION.
1.5 CONFIGURATION SECTION.
1.6 SOURCE-COMPUTER. HP3000.
1.7 OBJECT-COMPUTER. HP3000.
1.8 SPECIAL-NAMES.
1.9 CONDITION-CODE IS CCODE.
2 * ---------------------------------------------------
2.1 DATA DIVISION.
2.2 WORKING-STORAGE SECTION.
2.3
2.4 01 LANGUAGE PIC S9(4) COMP.
2.5
2.6 01 NLERROR.
2.7 05 NLERR OCCURS 2 PIC S9(4) COMP.
2.8
2.9 01 FILENUM PIC S9(4) COMP.
3
3.1 01 KSAMAREA.
3.2 05 KSAMPARAM.
3.3 10 FILLER PIC X(20).
3.4 10 KLANG PIC S9(4) COMP.
3.5 10 FILLER PIC X(8).
3.6 10 FLAGS PIC S9(4) COMP VALUE 0.
3.7 10 FILLER PIC X(148).
3.8 05 KSAMCONTROL PIC X(256).
3.9
4 01 COMAREA.
4.1 05 COM-STAT PIC S9(4) COMP VALUE 0.
4.2 05 COM-LANG PIC S9(4) COMP VALUE 0.
4.3 05 COM-LENG PIC S9(4) COMP VALUE 60.
4.4 05 COM-FILL PIC X(114) VALUE LOW-VALUE.
4.5
4.6 01 RESULT.
4.7 05 OPER PIC X(10).
4.8 05 LANG PIC ZZZ9.
4.9 05 FILLER PIC X(6) VALUE " Error".
5 05 NERR PIC ZZZ9.
5.1
5.2 01 DBNAME.
5.3 05 FILLER PIC X(2) VALUE " ".
5.4 05 FILENAME PIC X(36).
|
5.5
5.6 01 PASSWORD PIC X(8).
5.7
5.8 01 DBMODE PIC S9(4) COMP VALUE 5.
5.9
6 01 STAT.
6.1 05 DBSTAT PIC S9(4) COMP VALUE 0.
6.2 05 FILLER PIC X(18).
6.3
6.4 01 DUMMY PIC S9(4) COMP.
6.5 * ---------------------------------------------------
6.6 PROCEDURE DIVISION.
6.7
6.8 MAIN.
6.9 PERFORM USER-LANG.
7 PERFORM DATA-LANG.
7.1 PERFORM SYST-LANG.
7.2 PERFORM KSAM-LANG.
7.3 PERFORM FORM-LANG.
7.4 PERFORM BASE-LANG.
7.5 STOP RUN.
7.6 * ...................................................
7.7 USER-LANG.
7.8 CALL INTRINSIC "NLGETLANG" USING 1 NLERROR
7.9 GIVING LANGUAGE.
8 MOVE "USER lang:" TO OPER.
8.1 MOVE LANGUAGE TO LANG.
8.2 MOVE NLERR (1) TO NERR.
8.3 DISPLAY RESULT.
8.4 * ...................................................
8.5 DATA-LANG.
8.6 CALL INTRINSIC "NLGETLANG" USING 2 NLERROR
8.7 GIVING LANGUAGE.
8.8 MOVE "DATA lang:" TO OPER.
8.9 MOVE LANGUAGE TO LANG.
9 MOVE NLERR (1) TO NERR.
9.1 DISPLAY RESULT.
9.2 * ...................................................
9.3 SYST-LANG.
9.4 CALL INTRINSIC "NLGETLANG" USING 3 NLERROR
9.5 GIVING LANGUAGE.
9.6 MOVE "SYST lang:" TO OPER.
9.7 MOVE LANGUAGE TO LANG.
9.8 MOVE NLERR (1) TO NERR.
9.9 DISPLAY RESULT.
10 * ...................................................
10.1 KSAM-LANG.
10.2 DISPLAY "Enter KSAM file name:".
10.3 ACCEPT FILENAME FREE.
10.4 IF FILENAME NOT = SPACES PERFORM KSAM-OPEN.
|
10.5
10.6 KSAM-OPEN.
10.7 CALL INTRINSIC "FOPEN" USING FILENAME 1
10.8 GIVING FILENUM.
10.9 IF CCODE = 0
11 THEN PERFORM KSAM-INFO
11.1 ELSE DISPLAY "Error in KSAM file OPEN".
11.2
11.3 KSAM-INFO.
11.4 CALL INTRINSIC "FGETKEYINFO" USING FILENUM
11.5 KSAMPARAM KSAMCONTROL.
11.6 CALL INTRINSIC "FCLOSE" USING FILENUM 0 0.
11.7 IF FLAGS < 0 THEN ADD 32768 TO FLAGS.
11.8 IF FLAGS - (FLAGS / 32) * 32 > 15
11.9 THEN MOVE KLANG TO LANGUAGE
12 ELSE MOVE ZERO TO LANGUAGE.
12.1 MOVE SPACES TO RESULT.
12.2 MOVE "KSAM lang:" TO OPER.
12.3 MOVE LANGUAGE TO LANG.
12.4 DISPLAY RESULT.
12.5 * ...................................................
12.6 FORM-LANG.
12.7 DISPLAY "Enter FORM file name:".
12.8 ACCEPT FILENAME FREE.
12.9 IF FILENAME NOT = SPACES PERFORM FORM-OPEN.
13
13.1 FORM-OPEN.
13.2 CALL "VOPENFORMF" USING COMAREA FILENAME.
13.3 IF COM-STAT = 0
13.4 THEN PERFORM FORM-INFO
13.5 ELSE DISPLAY "FORMS file OPEN failed:" COM-STAT.
13.6
13.7 FORM-INFO.
13.8 CALL "VGETLANG" USING COMAREA LANGUAGE.
13.9 CALL "VCLOSEFORMF" USING COMAREA.
14 MOVE "FORM lang:" TO OPER.
14.1 MOVE LANGUAGE TO LANG.
14.2 DISPLAY RESULT.
14.3 * ...................................................
14.4 BASE-LANG.
14.5 DISPLAY "Enter DATA BASE name:".
14.6 ACCEPT FILENAME FREE.
14.7 IF FILENAME NOT = SPACES PERFORM BASE-OPEN.
14.8
|
14.9 BASE-OPEN.
15 DISPLAY "Enter PASSWORD:".
15.1 ACCEPT PASSWORD FREE.
15.2 CALL "DBOPEN" USING DBNAME PASSWORD DBMODE STAT.
15.3 IF DBSTAT = 0
15.4 THEN PERFORM BASE-INFO
15.5 ELSE DISPLAY "Error in Data Base Open:" DBSTAT.
15.6
15.7 BASE-INFO.
15.8 MOVE 901 TO DBMODE.
15.9 CALL "DBINFO" USING DBNAME DUMMY DBMODE STAT LANGUAGE.
16 MOVE 1 TO DBMODE.
16.1 CALL "DBCLOSE" USING DBNAME DUMMY DBMODE STAT.
16.2 MOVE "BASE lang:" TO OPER.
16.3 MOVE LANGUAGE TO LANG.
16.4 DISPLAY RESULT.
|
Executing the program results in the following:
:RUN PROGRAM;MAXDATA=12000
USER lang: 0 Error 2
DATA lang: 3 Error 0
SYST lang: 0 Error 0
Enter KSAM file name:
GERMANK
KSAM lang: 8
Enter FORM file name:
FRENCHFF
FORM lang: 7
Enter DATA BASE name:
SPBASE.TEST
Enter PASSWORD:
MANAGER
BASE lang: 12
END OF PROGRAM
:
|
