-
Notifications
You must be signed in to change notification settings - Fork 0
/
SPLTJOIN.PROC
127 lines (117 loc) · 3.18 KB
/
SPLTJOIN.PROC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;"SPLTJOIN" IS A NEW COMMAND FOR ANY UPDATABLE SESSION
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* No warranty is expressed or implied. Written by Dave L Clark *
;* Neither the author nor the company is Clarke Industries, Inc. *
;* responsible for any loss or damage 2100 Highway 265 *
;* resulting from the use of this code. Springdale, AR 72764 *
;* Source is provided on an as-is basis. Phone (501)750-8248 *
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
SET PPDVBL 1
;
DCL SAVL NUM 6 V
DCL CURL NUM 6 V
DCL CURS NUM 3 V
IF SIBSESSD,EQ,0
EXIT SV,'(SPLTJOIN) ** COMMAND REQUIRES AN "UPDATABLE" SESSION **'
IF SSDTYPE,EQ,DI
GOTO EXECUTE
IF SSDTYPE,EQ,EE
GOTO EXECUTE
IF SSDTYPE,NE,ED
EXIT SV,'(SPLTJOIN) ** COMMAND REQUIRES AN "UPDATABLE" SESSION **'
LABEL EXECUTE
IF SIBCSROW,LE,&SIBSCRB&SIBSCRPM
GOTO ERROR
IF SIBCSROW,GT,&SIBSCRL&SIBSCRPM
GOTO ERROR
IF SSDLCA,EQ,0
GOTO NONE
IF SSDLCA,EQ,R
GOTO RIGHT
LABEL LEFT
IF SIBCSCOL,GE,&SIBSCRWD
GOTO ERROR
IF SIBCSCOL,GE,8
GOTO CONTINUE
GOTO ERROR
LABEL NONE
IF SIBCSCOL,GT,&SIBSCRWD
GOTO ERROR
IF SIBCSCOL,GT,1
GOTO CONTINUE
GOTO ERROR
LABEL RIGHT
IF SIBCSCOL,LE,1
GOTO ERROR
IF SIBCSCOL,LE,73
GOTO CONTINUE
LABEL ERROR
EXIT CK,'(SPLTJOIN) ** CURSOR NOT IN DATA AREA OF A VALID DATA LINE **'
LABEL CONTINUE
SET CURL &SIBSCRB&SIBSCRPM ;STARTING LINE OF LOGICAL SCREEN
ADD CURL 3 ;PLUS HEADER LINES
IF SSDBEFSP,GT,0
ADD CURL 1 ;PLUS SCALE LINE FOR "SCR BEF"
ADD CURL &SSDBEFSP ;PLUS LINES BEFORE "SCR BEF"
IF SIBCSROW,LT,&CURL
GOTO -ERROR
SET SAVL &SSDBASE&SIBSCRPM ;SAVE CURRENT LINE NUMBER
SET CURS &SIBCSROW ;CURSOR LINE NUMBER
SUBTRACT CURS &CURL ;NUMBER OF LINES TO ADVANCE
IF CURS,NE,0
DOWN &CURS
SET CURS &SIBCSCOL
ADD CURS &SSDVBSE&SIBSCRPM
IF SSDLCA,EQ,L
SUBT CURS 8
IF SSDLCA,NE,L
SUBT CURS 2
IF SSDSEQBS,GT,0
BLANK &SSDSEQBS-&SSDSEQLM
SETD PARMLIST XTRSLINE &CURS
SETD PARMLIST PARMLIST
IF PARMLIST,EQ,''
GOTO JOIN
SPLIT &CURS ;SPLIT LINE
IFTHEN SSDZONBS GT 0
NEXT 1
SHIFT +&SSDZONBS 1 1-&SSDZONLM
SHIFT -1 1
ENDIF
POSITION &SAVL ;RESTORE CURRENT LINE NUMBER
;CURSOR &SIBCSROW &SIBCSCOL ;POSITION CURSOR
EXIT
LABEL JOIN
NEXT 1
IF SSDSEQBS,GT,0
BLANK &SSDSEQBS-&SSDSEQLM
SETD PARMLIST XTRSLINE 1 &CURS
SETD PARMLIST PARMLIST
SUBT CURS 1
IF PARMLIST,NE,''
JUSTL 1 1-*
IF PARMLIST,NE,''
SHIFT +&CURS 1 1-*
STACK 1
UP 1
MERGE 1
IF SSDZONLM,EQ,253
GOTO EXIT
SET CURS &SSDZONLM
ADD CURS 1
SETD PARMLIST XTRSLINE &CURS
SETD PARMLIST PARMLIST
IF PARMLIST,EQ,''
GOTO EXIT
SPLIT &CURS ;SPLIT LINE
NEXT 2
DELETE 1
POSITION &SAVL ;RESTORE CURRENT LINE NUMBER
;CURSOR &SIBCSROW &SIBCSCOL ;POSITION CURSOR
EXIT OK,'## Data spilled during JOIN processing ##'
LABEL EXIT
NEXT 1
DELETE 1
POSITION &SAVL ;RESTORE CURRENT LINE NUMBER
;CURSOR &SIBCSROW &SIBCSCOL ;POSITION CURSOR
EXIT