********************************************************************
* Program name.......: IS3010R *
* Program description: Map CONVERTER UPLOAD
file to CVUPGIPG *
* Date written.......: 11/30/2004 Tony P. Davis *
*------------------------------------------------------------------*
* NOTE:
Library OUTFILES must be in your library list in order *
* to compile this program. This is
necessary for files *
* CVUPGIDG and EQPMSTR. *
*------------------------------------------------------------------*
* Indicators:
*
* -----------
*
* IN01 - command key HELP *
* IN03 - command key EXIT *
* IN05 - command key SET POSITION OF MAC
ADDRESS *
* IN06 - command key SET POSITION OF SERIAL
NUMBER *
* IN10 - command key CONTINUE UPDATE
PROCESS *
* IN12 - command key CANCEL or RETURN to
previous screen *
* IN17 - command key DISPLAY TOP OF
SUBFILE *
* IN18 - command key DISPLAY BOTTOM OF
SUBFILE *
* IN19 - command key MOVE WINDOW/POSITION
LEFT *
* IN20 - command key MOVE WINDOW/POSITION
RIGHT *
* IN23 - command key DELETE record in error
(one or all) *
* IN39 - VLDCMDKEY
*
* IN61 - ROLLUP *
* IN63 - SFLDSPCTL (N63=SFLCLR) *
* IN64 - SFLDSP
*
* IN66 - SFLINZ
*
* IN68 - SFLEND(*MORE) *
* IN71 - Display F23=Delete All instead of
F23=Delete on err scrn *
* IN72 - Disallows F05 again if errors are
already loaded/display *
* IN73 - Disallows F23 if no errors were
found *
* IN74 - File EQPMSTR is also being built *
* IN84 - F23 not allowed unless cursor is
within subfile range *
* IN85 - F23 not allowed unless record cursor
is on is in error *
* IN86 - Warning message the errors may exist
in input file *
* IN88 - Dislay MAC address in reverse image if
it is error *
* IN89 - Dislay SERIAL number in reverse image
if it is error *
* IN90 - Error if F10 attempted and NO DATA is
in file *
* IN92 - End of record is already shown (on
using F20) *
* IN93 - Error if user attempts F5 or F6
without positioning csr *
* IN94 - Attempt to use F5 not valid if cursor
not in position *
* IN95 - Error if F10 attempted with first
setting start/end pos *
* IN96 - Error if from or to positions are not
valid *
* IN97 - Error if from or to positions
overlap *
*------------------------------------------------------------------*
* Program maintenance information: *
* ------------------------------- *
* Fix Date
Inits Description *
********************************************************************
FGENEQP1 UF
E DISK INFDS(FILE01DS) INFSR(*PSSR)
FAGLOCNM0 IF
E K DISK
FEQPMSTR IF A E DISK INFDS(FILE03DS) INFSR(*PSSR) USROPN
FCVUPGIDG IF A E DISK INFDS(FILE02DS) INFSR(*PSSR) USROPN
F
RENAME(CVUPGIDG:CVREC)
FIS3010D CF
E WORKSTN SFILE(SFLDATA:RRN01)
F
SFILE(SFLDATA2:RRN02)
F
INFDS(FILEWKDS)
D*
Miscellaneous definiations
D rulers S 78 DIM(3) CTDATA
D window S 3S 0
D
record_count S 11S 0
D
delete_count S 11S 0
D x S 11S 0
D pos S 11S 0
D len S 11S 0
D
clear_inds S 9A INZ('000000000') error inds (90-98)
D
rollup1_val S 9S 0 INZ(14) SFLROLVAL
D skipped S 1A
D copy_complete S 1A
D
copy_cancel S 1A
D
Save_Header S 183A
D arg S 1A
D string S 32A
D
returncode S 10A
D valerrors S 1A
D
parseerrors S 1A
D
parseerror S 1A
D
SQL_statement S 80A
D SQL_file S 10A
D keys01 S 36A INZ('F3=Exit F5=SQL F10=Start -
D
F12=Cancel')
D keys02 S 36A INZ('Upload to CONVERTER FI-
D in
progress')
D xxfiled S 10A
D xxlibld S 10A
D* COX
Extended Programs Control Data Area (location)
D EXTDTA DS 256
D SITEID 254 256
D* Speical
characters array list
D
spec_chars_x S 7S 0 INZ(29)
D
spec_chars_ary S 1A DIM(29)
D
spec_chars S 29A INZ('!@#$%’&*()_-<>?/:;"-
D
,_¬}¦|\~`')
D* Output
format for file GENEQP1
D
outrecord DS
D out_rectype 1 1
D out_macaddres 39
62
D out_srlnumber 63
93
D* INFDS for
file GENEQP1
D file01ds DS
D filestat01 *STATUS
D filerreclg 125 126B 0
D filercdn01 156 159B 0
D filename01 83 92
D liblname01 93 102
D filerelr01 397 400B 0
D* INFDS for
file CVUPGIDG
D file02ds DS
D filestat02 *STATUS
D filercdn02 156 159B 0
D filename02 83 92
D liblname02 93 102
D* INFDS for
file EQPMSTR
D file03ds DS
D filestat03 *STATUS
D filercdn03 156 159B 0
D filename03 83 92
D liblname03 93 102
D* INFDS for
file workstation file
D filewkds DS
D filewk_status *STATUS
D filewk_flags 367
368
D
filewk_aidkey 369 369
D filewk_csrloc 370
371
D filewk_dtalen 372
375B 0
D filewk_relrec 376
377B 0
D filewk_minrrn 378
379B 0
D filewk_nbrrec 380
381B 0
D filewk_wincsr 382
383
D filewk_majcod 401
402
D filewk_mincod 403
404
D* QCMDEXC
related variables
D CMD1 C 'CLRPFM *LIBL/CVUPGIDG'
D CMD2 C
'CLRPFM
*LIBL/EQPMSTR'
D command S 80A INZ(' ')
D size S 15
5
D* PSSR and
other variables related to error routine
D$PSSR1 S 1
DPSSA_FILENAME S 10
DPSSA_LIBLNAME S 10
DPSSA_FILESTAT S 5
DPSSA SDS
D PGMNAM 1 10
D PGMSTS 11 15
0
Return code
D PGMLIB 81 90
Program libl
D PGMEXD 91 170
Exception data
D PGEFIL 175 184 Name of file
D PGMJBN 244 253 Job
name
D USRNAM 254 263 User
name
D PGMJNR 264 269
0
Job number
D*
I* Data area
saves values in QTEMP for user
DIS3010VALS UDS 1000
D SV_MAC_FRPOS 1 5 From
MAC
D SV_MAC_TOPOS 6
10
To MAC
D SV_SRL_FRPOS 11
15
From SERIAL#
D SV_SRL_TOPOS 16
20
To SERIAL#
I* redefine
input field name for field in file CVUPGIDG
ICVREC
I CVUPGIDG OUT_RECORD
*************************************************************************/
* MAIN PROGRAM START */
*************************************************************************/
b01C
dou *in03 = *on
01C
write prompt wrt prompt
01C
write keys wrt
keys
01C
read keys
01C
read IS3010D
01C
movea clear_inds *in(90) error inds 90 - 98
b02C
*in01 caseq *on Help
02C
*in03 caseq *on Exit
02C
*in05 caseq *on Set_pos_mac
02C *in06
caseq *on Set_pos_srl
02C
*in10 caseq *on Begin_mapping
02C
*in17 caseq *on Roll_to_top
02C
*in18 caseq *on Roll_to_bot
02C *in19 caseq *on Toggle_left
02C
*in20 caseq *on Toggle_right
02C
*in39 caseq *off Enter
02C
*in61 caseq *on Rollup
02C
endcs
e02C
enddo
*************************************************************************/
* Function key
subroutines */
*************************************************************************/
* Exit
program
01C
exit begsr
beg exit
01C
call 'IS3010C2' deallocate
CVUPGIDG
01C
parm RETURNCODE
01C
move *on *inlr
01C
movel MAC_FRPOS SV_MAC_FRPOS
01C
movel MAC_TOPOS SV_MAC_TOPOS
01C movel
SRL_FRPOS SV_SRL_FRPOS
01C
movel SRL_TOPOS SV_SRL_TOPOS
01C
out IS3010VALS
01C
return
01C
endsr end exit
* Enter key
pressed
01C
enter begsr
beg enter
b02C
if BUILD_EQPM = *blanks
02C
eval BUILD_EQPM
= 'N'
e02C
end
b02C
if IGNORE_HDR = *blanks
02C
eval IGNORE_HDR = 'N'
e02C
end
01C
exsr SUB_setcolumn
01C
exsr SUB_validate
01C
eval rrn01 = rrn01lin
01C
endsr
end enter
* F01 = HELP
01C
Help begsr
beg Help
01C
move row PMLIN
01C
move col PMPOS
b02C
if row = 23 and
02C CFD = *blanks
02C
eval CFD = '*KEYS' Help for CF keys
e02C
endif
01C
call 'IS3010HR'
01C
parm pgmnam
01C
parm CFD
01C
parm PMLIN 2
01C
parm PMPOS 3
01C
endsr end
Help
* F05 = set
position of MAC address
01C
Set_pos_mac begsr
beg Set_pos_mac
b02C
if row < 7 or row > 21
02C
eval *in93 = *on
l02C
else
* Determine
from and to positions (assume 32 character length)
02C
select
02C
when window = 1
02C
eval MAC_FRPOS = col - 2
02C
eval MAC_TOPOS = MAC_FRPOS + 32
02C
when window = 2
02C
eval MAC_FRPOS = col + 78 - 2
02C
eval MAC_TOPOS = MAC_FRPOS + 32
02C
when window = 3
02C
eval MAC_FRPOS = col + 157 - 2
02C
eval MAC_TOPOS = MAC_FRPOS + 32
02C
endsl
* Look for a
comma and if found, change length assuming this is a CSV file
b03C
MAC_FRPOS do filerreclg x
b04C
if %subst(RECDATA:x:1) =
','
04C
eval MAC_TOPOS = x - 1
04C
leave
go
e04C
endif
e03C
enddo
e02C
endif
01C
eval rrn01 = rrn01lin
01C
endsr
end Set_pos_mac
* F06 = set
position of SERIAL NUMBER
01C
Set_pos_srl begsr beg Set_pos_srl
b02C
if row < 7 or row > 21
02C
eval *in94 = *on
l02C
else
* Determine
from and to positions (assume 32 character length)
02C
select
02C
when window = 1
02C
eval SRL_FRPOS = COL - 2
02C
eval SRL_TOPOS = SRL_FRPOS + 32
02C
when window = 2
02C
eval SRL_FRPOS = COL + 78 - 2
02C
eval SRL_TOPOS = SRL_FRPOS + 32
02C
when window = 3
02C
eval SRL_FRPOS = COL + 157 - 2
02C
eval SRL_TOPOS = SRL_FRPOS + 32
02C
endsl
* Look for a
comma and if found, change length assuming this is a CSV file
b03C
SRL_FRPOS do filerreclg x
b04C
if %subst(RECDATA:x:1) =
','
04C
eval SRL_TOPOS = x - 1
04C
leave
go
e04C
endif
e03C enddo
e02C
endif
01C
eval rrn01 = rrn01lin
01C
endsr
end Set_pos_srl
* F10 = start
map/parse process
01C
Begin_mapping begsr
beg Begin_mapping
01C
eval continue = *blanks
01C
exsr SUB_validate
b02C
if valerrors <> 'Y'
02C
exsr SUB_mapdata
e02C
endif
01C
endsr
end Begin_mapping
* CF17 =
Display top of subfile
01C Roll_to_top begsr
beg Roll_to_top
01C
eval RRN01 = 1
01C
endsr
end Roll_to_top
* CF18 =
Display bottom of subfile (load all records)
01C
Roll_to_bot begsr
beg Roll_to_bot
01C
eval rollup1_val = filercdn01
01C
exsr Rollup
01C
reset
rollup1_val
01C
endsr
end Roll_to_bot
* CF19 =
Toggle subfile LEFT
01C
Toggle_left begsr beg
Toggle_left
b02C
if window = 1
02C
eval *in91 = *on start already shown
l02C
else
02C
eval window = window - 1
02C
exsr Update_sub
e02C
endif
01C
eval rrn01 = rrn01lin
01C
endsr end Toggle_left
* CF20 =
Toggle subfile RIGHT
01C
Toggle_right begsr
beg Toggle_right
b02C
if window = 3
02C
eval *in92
= *on end
already shown
l02C
else
02C
eval window = window + 1
02C
exsr Update_sub
e02C
endif
01C eval rrn01 = rrn01lin
01C
endsr
end Toggle_right
*-----------------------------------------------------------------------*/
* SUBROUTINE
- update subfile when toggle left or right. */
*-----------------------------------------------------------------------*/
01C
Update_sub begsr
beg Update_sub
b02C 1 do srn01 x
02C x chain sfldata 99
b03C
if *in99 = *off
03C select
03C when window = 1
03C eval stextl = %subst(RECDATA:1:78)
03C when window = 2
03C eval stextl = %subst(RECDATA:79:78)
03C when window = 3
03C eval stextl = %subst(RECDATA:157:26)
03C endsl
03C update sfldata upd
sfldata
e03C
endif
e02C enddo
01C
eval xruler = rulers(window)
01C
exsr SUB_setcolumn
01C
endsr
end Update_sub
*-----------------------------------------------------------------------*/
* SUBROUTINE
- Map data from input file to subfile and DISPLAY results. */
* User may choose to continue or
return to prior screen */
* and specify starting and ending
positions again. If they */
* choose to continue, population of
output files begins. */
*-----------------------------------------------------------------------*/
01C
SUB_mapdata begsr beg
SUB_mapdata
* Initialize
subfile
01C
eval number_err = 0
01C
eval COL = 0
01C
eval ROW = 0
01C
movea '0000' *in(63)
01C
eval *in84 = *off
01C
eval *in85 = *off
01C
z-add 0 rrn02 4 0
01C z-add 0 srn02 4 0
01C
z-add 0 recno 4 0
01C
write PROMPT2 wrt
PROMPT2
01C
movea '1010' *in(63)
01C
eval *in68 = *off
01C
eval *in71 = *off
01C
eval *in72 = *off
01C
eval *in86 = *off
01C 1 setll INREC
01C
exsr Rollup2
* Display
parsed data subfile
b02C
dou *in03 = *on
or
02C *in12 = *on
or
02C copy_complete =
'Y' or
02C copy_cancel = 'Y'
02C
write prompt2 wrt
prompt2
02C
write keys2 wrt
keys2
02C
read keys2
02C
read prompt2 wrt
prompt2
b03C
*in01 caseq *on Help
03C *in03 caseq *on Exit
03C *in05 caseq *on Display_errs
03C *in12 caseq *on Refresh
03C *in23 caseq *on Delete_errs
03C *in39
caseq *off SUB_begincopy
03C *in61 caseq *on Rollup2
03C endcs
e03C
enddo
b03C
if copy_complete = 'Y' or
03C copy_cancel = 'Y'
03C exsr Refresh
e03C
endif
02C
endsr
end SUB_mapdata
*-----------------------------------------------------------------------*/
* SUBROUTINE
- add records to 2nd subfile */
*-----------------------------------------------------------------------*/
02C
Rollup2 begsr
beg Rollup2
02C
eval rrn02 = srn02 SFLRCDNBR
02C
eval *in84 = *off
02C eval *in85 = *off
b03C N68 do 10
03C read INREC 99
b04C
if *in99 = *on
04C
eval *in68 = *on
l04C
else
b05C
if IGNORE_HDR = 'Y' and skipped = *blanks
05C
eval skipped = 'Y'
05C
eval Save_Header = RECDATA
l05C else
05C
eval *in88 = *off
05C
eval *in89 = *off
05C
exsr SUB_parsedata parse fields
05C
add 1 rrn02
05C
add 1 srn02
05C
eval FILEERRRRN = filerelr01
b06C
if number_err > 0
06C
eval *in86 = *on
e06C
endif
05C
write sfldata2 wrt
sfldata2
05C
move *on *in64
e05C
endif
e04C
endif
e03C
enddo
02C
endsr
end Rollup2
*-----------------------------------------------------------------------*/
* SUBROUTINE
- set field COLUMN based on where cursor is, or window. */
*-----------------------------------------------------------------------*/
02C
SUB_setcolumn begsr
beg SUB_setcolumn
b03C
if row < 7 or row > 21
03C select
03C when window = 1
03C eval CUR_COLUMN = 1
03C when window = 2
03C eval
CUR_COLUMN = 79
03C when window = 3
03C eval CUR_COLUMN = 157
03C endsl
l03C
else
03C select
03C when window = 1
03C eval CUR_COLUMN = col - 2
03C when window = 2
03C eval CUR_COLUMN = col + 78 - 2
03C when window = 3
03C eval CUR_COLUMN = col + 157 - 2
03C endsl
e03C
endif
02C
endsr
end SUB_setcolumn
*-----------------------------------------------------------------------*/
* SUBROUTINE
- display only subfile lines that have an error. This */
* subroutine
will read through the entire input file and load only */
* those
records that have embedded special characters into subfile. */
*-----------------------------------------------------------------------*/
02C
Display_errs begsr
beg Display_errs
* Initialize
subfile
* NOTE: this
subroutine LOADS the subfile and does not DISPLAY the subfile.
02C
eval COL = 0
02C
eval ROW = 0
02C
z-add 0 rrn02 4 0
02C
z-add 0 srn02 4 0
02C
z-add 0 recno 4 0
02C
movea '0000' *in(63)
02C eval
*in84 = *off
02C
eval *in85 = *off
02C
write PROMPT2 wrt
PROMPT2
02C
movea '1010' *in(63)
02C
eval *in68 = *off
02C
eval *in71 = *on
02C
eval *in72 = *on
02C
eval *in73 = *off
02C
eval number_err = 0
02C 1 setll INREC
b03C
dou *in99 = *on
03C read INREC 99
b04C
if *in99 = *on
04C
eval *in68 = *on
l04C
else
04C
eval FILEERRRRN = filerelr01
b05C
if IGNORE_HDR = 'Y' and skipped = *blanks
05C
eval skipped = 'Y'
05C
eval Save_Header = RECDATA
l05C
else
05C
eval *in88 = *off
05C
eval *in89 = *off
05C
exsr SUB_parsedata parse fields
b06C
if parseerror = 'Y' load only if errors
06C
add 1 rrn02
06C
add 1 srn02
06C
write sfldata2 wrt
sfldata2
06C
move *on *in64
06C
eval parseerror = *blanks
e06C endif
e05C
endif
e04C
endif
e03C
enddo
02C
z-add 1 rrn02 SFLRCDNBR
* If no
errors were actually found then F23=Delete will not be allowed.
b03C
if number_err = 0
03C eval PPMACD = '***No errors were found***'
03C eval PPSRLD = *blanks
03C eval
*in73 = *on
03C write sfldata2 wrt
sfldata2
03C move *on *in64
e03C
endif
02C
endsr
end Display_errs
*-----------------------------------------------------------------------*/
* SUBROUTINE
- delete subfile lines that are in error. This routine */
* will display
a WARNING message window that the record is about to */
* be deleted.
Or, return an error message (goes back to calling subr) */
* if the line
that the cursor is on is NOT an error line. */
*-----------------------------------------------------------------------*/
02C
Delete_errs begsr
beg Delete_errs
02C
eval *in84 = *off error indicator
02C
eval *in85 = *off error indicator
* If F5 was
used to display only error lines, then F23 when not on a
* specific
line in error means to DELETE ALL lines.
b03C
if (row < 8 or row > 21) and *in71 =
*on
03C exsr Delete_errs_A Delete ALL
errors
l03C
else
* Display an
error message if cursor is not within the subfiles lines.
b04C
if (row < 8 or row >
21)
04C
eval *in84 = *on
l04C
else
* Display an
error message if subfile line is not an ERROR line.
04C
SFLRRN chain SFLDATA2 99
b05C
if *in99 = *on or parseerror <> 'Y'
05C
eval *in85 = *on
l05C
else
* Display
window message warning that record is about to be deleted.
05C
eval recs01 = FILEERRRRN
b06C
dou *in03 = *on or
06C *in10 = *on or
06C *in12 = *on
06C
exfmt message3 fmt
message3
* Execute
command keys.
b07C
*in03 caseq *on Exit
07C
*in10 caseq *on Delete_err1
07C
*in12 caseq *on Refresh
07C
endcs
e07C
enddo
e06C
endif
e05C
endif
e04C
endif
03C endsr end
Delete_errs
* Delete
record from input file by relative record number that
* was stored
in the display file as a hidden field.
03C Delete_err1 begsr beg Delete_err1
03C FILEERRRRN delete
INREC
99 dlt INREC
03C eval copy_cancel = 'Y'
03C endsr end
Delete_err1
*-----------------------------------------------------------------------*/
* SUBROUTINE
- delete ALL error lines */
*-----------------------------------------------------------------------*/
03C Delete_errs_A begsr
beg Delete_errs_A
b04C
dou *in03 = *on
or
04C *in10 = *on
or
04C *in12 = *on
or
04C copy_complete =
'Y' or
04C copy_cancel = 'Y'
04C
eval RECS01 = number_err
04C
exfmt message4 fmt
message4
b05C
*in03 caseq *on Exit
05C
*in12 caseq *on Refresh
05C
endcs
* If F10 is
pressed, then delete all records in error.
b06C
if *in10 = *on
06C
eval delete_count = 0
06C 1 setll INREC
b07C
dou *in99 = *on
07C
read INREC 99
b08C
if *in99 = *off
08C exsr SUB_parsedata
b09C
if parseerror = 'Y'
09C delete INREC dlt
INREC
09C
eval delete_count = delete_count + 1
e09C
endif
e08C
endif
e07C
enddo
e06C
endif
b06C
if delete_count > 0
06C
eval copy_cancel = 'Y'
06C
eval FILE_RECS = filercdn01 - delete_count
e06C
endif
e05C
enddo
04C
endsr
end Delete_errs_A
*-----------------------------------------------------------------------*/
* SUBROUTINE
- Refresh (clear and initialize) */
*-----------------------------------------------------------------------*/
04C
refresh begsr
beg refresh
* Initialize
subfile
04C
movea '0000' *in(63)
04C
z-add 0 rrn01 4 0
04C
z-add 0 srn01 4 0
04C
z-add 0 recno 4 0
04C
z-add 0 rrn02 4 0
04C
eval COL = 0
04C
eval ROW = 0
04C
write PROMPT wrt PROMPT
04C
movea '1010' *in(63)
04C
eval *in68 = *off
04C
eval *in71 = *off
04C
eval *in73 = *off
04C 1 setll INREC
04C
eval valerrors = *blanks
04C
eval parseerrors = *blanks
04C
eval parseerror = *blanks
* Load input
file into subfile
04C
exsr Rollup
* initialize
miscellaneous variables
04C
eval record_count = filercdn01
04C
eval rrn01 = 1
04C
eval CUR_COLUMN = 1
04C
eval skipped = *blanks
04C
eval xruler = rulers(1)
04C
eval copy_complete = *blanks
04C
eval window =
1
b05C
if IGNORE_HDR = *blanks
05C
eval IGNORE_HDR = 'N'
e05C
endif
04C
endsr
end refresh
*-----------------------------------------------------------------------*/
* SUBROUTINE
- rollup (add more records to subfile) */
*-----------------------------------------------------------------------*/
04C
Rollup begsr
beg Rollup
04C
eval rrn01 = srn01 SFLRCDNBR
04C
eval copy_cancel = *blanks
04C
eval copy_complete = *blanks
04C
eval *in84 = *off
04C
eval *in85 = *off
* Load input
file into subfile
b05C N68 do rollup1_val
05C
read INREC 99
b06C
if *in99 = *on
06C
eval *in68 = *on
b07C
if rrn01 = 0
07C eval stextl = '*No data was found in input
file*'
07C
add 1 rrn01
07C
add 1 srn01
07C
write SFLDATA wrt SFLDATA
07C
move *on *in64
07C
leave
go
e07C
endif
l06C
else
b07C
if %subst(recdata:1:1) =
'1' and
07C IGNORE_HDR = *blanks
07C
eval IGNORE_HDR = 'Y'
e07C
endif
06C
eval stextl =
recdata
06C
add 1 rrn01
06C
add 1 srn01
06C
write SFLDATA wrt
SFLDATA
06C
move *on *in64
e06C
endif
e05C
enddo
04C
endsr
end Rollup
*-----------------------------------------------------------------------*/
* SUBROUTINE
- populate parsed data into CONVERTER UPLOAD file and */
* optionally into the EQUIPMENT
MASTER file. Files must */
* be cleared prior to loading. */
*-----------------------------------------------------------------------*/
04C
SUB_begincopy begsr
beg SUB_begincopy
* Continue
only if user enters a "Y" to conitinue
b05C
if continue = 'Y'
05C
eval copy_complete = 'Y'
* If any
parsing errors were encountered during the load of the MAC address
* and serial
number display (see subroutine ROLLUP2) then display a warning
* message
(done within the SUB_chkparse subroutine).
05C
exsr SUB_chkparse
b06C
if continue = 'Y'
* Before
populating output files, execute this subroutine which will check
* to see if
any records are currently in those files. If the files are not
* empty, then
a message window is displayed warning the user that the files
* are about
to be cleared (message is displayed in SUB_chkfiles).
06C
exsr SUB_chkfiles
b07C
if continue = 'Y'
* Display
status message window
07C
eval *in87 = *on
07C
eval KEYSXX = KEYS02
07C
write message1 wrt
message1
* Clear and
then open CONVERTER UPLOAD file
07C
eval command = CMD1
07C
call 'QCMDEXC'
07C
parm command
07C
parm 80 size
07C
open CVUPGIDG
* Clear and
then open EQUIPMENT MASTER file
b08C
if BUILD_EQPM = 'Y'
08C eval command = CMD2
08C call 'QCMDEXC'
08C parm command
08C parm 80 size
08C open EQPMSTR
e08C
endif
* Output
header record to converter upload file
07C
eval out_rectype = '1'
07C
eval out_macaddres = *blanks
07C
eval out_srlnumber = *blanks
07C
eval out_record = outrecord
07C
write CVREC wrt
CVREC
* Read data
from intput file and populate into converter upload file
07C 1 setll INREC
b08C
dou *in99 = *on
08C read INREC 99
b09C
if *in99 = *off
09C
eval *in88 = *off
09C
eval *in89 = *off
09C
exsr SUB_parsedata parse fields
09C
eval out_rectype = '2'
09C eval out_macaddres = PPMACD
09C
eval out_srlnumber = PPSRLD
09C
eval out_record = outrecord
09C
write CVREC wrt
CVREC
b10C
if BUILD_EQPM = 'Y'
10C
eval SERIAL = PPSRLD
10C
write EQPREC wrt
EQPREC
e10C
endif
e09C
endif
e08C
enddo
* Display
completion message / window
C if BUILD_EQPM = 'Y'
C eval *in74 = *on
C else
C eval *in74 = *off
C endif
C exfmt message5
* exit upon
completion of successful mapping into converter upload file.
07C
exsr Exit exit
program
e07C
endif
e06C
endif
e05C
endif
b05C
if continue = 'N'
05C
eval copy_cancel = 'Y'
05C
eval copy_complete = 'N'
05C
eval rrn02 = rrn02lin
e05C
endif
b05C
if continue = *blanks
05C
eval rrn02
= rrn02lin
05C
eval copy_cancel = *blanks
e05C
endif
04C
endsr
end SUB_begincopy
*-----------------------------------------------------------------------*/
* SUBROUTINE
- parse data from input record */
*-----------------------------------------------------------------------*/
04C
SUB_parsedata begsr beg
SUB_parsedata
* parse MAC
address and serial number
04C
eval len = MAC_TOPOS - MAC_FRPOS + 1
04C
eval PPMACD = %subst(RECDATA:MAC_FRPOS:len)
04C
eval PPMACD = %triml(PPMACD)
04C
eval len = SRL_TOPOS - SRL_FRPOS + 1
04C
eval PPSRLD = %subst(RECDATA:SRL_FRPOS:len)
04C eval PPSRLD = %triml(PPSRLD)
04C
eval parseerror = *blanks
* scan string
for special characters - in MAC address
b05C 1 do spec_chars_x x
05C
eval arg = spec_chars_ary(x)
05C
eval pos = %scan(arg:%trim(PPMACD):1)
b06C
if pos <> 0
06C
eval *in88 = *on
06C
eval parseerrors = 'Y'
06C
eval parseerror = 'Y'
06C
leave
go
e06C
endif
e05C
enddo
* scan string
for special characters - in SERIAL# address
b05C 1 do spec_chars_x x
05C
eval arg = spec_chars_ary(x)
05C
eval pos = %scan(arg:%trim(PPSRLD):1)
b06C
if pos <> 0
06C
eval *in89 = *on
06C
eval parseerrors = 'Y'
06C
eval parseerror = 'Y'
06C
leave
go
e06C
endif
e05C
enddo
* If either
MAC or SERIAL is blanks then it is treated as an error.
b05C
if PPSRLD = *blanks or
05C PPMACD = *blanks
05C
eval parseerror = 'Y'
b06C
if PPSRLD = *blanks
06C
eval PPSRLD = 'field is BLANKS'
06C
eval *IN89 = *on
e06C
endif
b06C
if PPMACD = *blanks
06C
eval PPMACD = 'field is BLANKS'
06C
eval *IN88 = *on
e06C
endif
e05C
endif
* Count the
number of records that have an error
b05C
if parseerror = 'Y'
05C
eval number_err = number_err + 1
e05C
endif
04C
endsr
end SUB_parsedata
*-----------------------------------------------------------------------*/
* SUBROUTINE
- check if files are empty and if not display message */
*-----------------------------------------------------------------------*/
04C
SUB_chkfiles begsr
beg SUB_chkfiles
04C
eval RECS01 = 0
04C
eval RECS02 = 0
04C
open CVUPGIDG
04C
eval RECS01 = filercdn02
04C
eval FILE01 =
04C %trim(liblname02)
+ '/' + filename02
04C
close CVUPGIDG
b05C
if BUILD_EQPM = 'Y'
05C
open EQPMSTR
05C
eval RECS02 = filercdn03
05C
eval FILE02 =
05C %trim(liblname03)
+ '/' + filename03
05C
close EQPMSTR
e05C
endif
b05C if RECS01 <> 0 or
05C RECS02 <> 0
b06C
dou *in03 = *on or
06C *in10 = *on or
06C *in12
= *on
06C
eval *in87 = *off
06C
eval KEYSXX = KEYS01
06C
eval COL = 52
06C
eval ROW = 14
06C
exfmt MESSAGE1 fmt
MESSAGE1
b07C
if *in03 = *on
07C
exsr exit
e07C
endif
b07C
if *in05 = *on and ROW = 14
07C
eval SQL_file = 'CVUPGIDG'
07C
exsr SUB_dspsql
e07C
endif
b07C
if *in05 = *on and ROW = 15
07C
eval SQL_file = 'EQPMSTR'
07C
exsr SUB_dspsql
e07C
endif
b07C
if *in12 = *on
07C
eval continue = 'N'
e07C
endif
b07C
if *in10 = *on
07C
eval continue = 'Y'
e07C
endif
e06C
enddo
e05C
endif
04C endsr
end SUB_chkfiles
*-----------------------------------------------------------------------*/
* SUBROUTINE
- if any parsing errors were encountered display warning. */
*-----------------------------------------------------------------------*/
04C
SUB_chkparse begsr
beg SUB_chkparse
b05C
if parseerrors = 'Y'
b06C dou *in03 = *on or
06C *in10 = *on or
06C *in12 = *on
06C
eval *in87 = *off
06C
eval KEYSXX
= KEYS01
06C
exfmt MESSAGE2 fmt
MESSAGE2
b07C
if *in03 = *on
07C
exsr exit
e07C
endif
b07C
if *in12 = *on
07C
eval continue = 'N'
e07C
endif
b07C
if *in10 = *on
07C
eval continue =
'Y'
e07C
endif
e06C
enddo
e05C
endif
04C
endsr
end SUB_chkparse
*-----------------------------------------------------------------------*/
* SUBROUTINE
- display converter upload files with SQL. */
*-----------------------------------------------------------------------*/
04C
SUB_dspsql begsr beg SUB_dspsql
C* RUNSQL
REQUEST('SELECT * FROM CVUPGIDG')
b05C
if SQL_file = 'CVUPGIDG'
05C
eval SQL_statement =
05C 'RUNSQL REQUEST('
+ '''' +
05C 'SELECT * FROM
CVUPGIDG' + '''' + ')'
05C
eval command = SQL_statement
05C
call 'QCMDEXC'
05C
parm command
05C
parm 80 size
e05C
endif
C* RUNSQL
REQUEST('SELECT * FROM EQPMSTR')
b05C
if SQL_file = 'EQPMSTR'
05C
eval SQL_statement =
05C 'RUNSQL REQUEST('
+ '''' +
05C 'SELECT * FROM
EQPMSTR' + '''' + ')'
05C
eval command = SQL_statement
05C
call 'QCMDEXC'
05C parm command
05C
parm 80 size
e05C
endif
04C
endsr
end SUB_dspsql
*-----------------------------------------------------------------------*/
* SUBROUTINE
- validate screen input. */
*-----------------------------------------------------------------------*/
04C
SUB_Validate begsr
beg SUB_Validate
04C
eval valerrors = *blanks
04C
eval parseerrors = *blanks
b05C
if MAC_FRPOS = MAC_TOPOS or
05C SRL_FRPOS = SRL_TOPOS or
05C MAC_FRPOS > MAC_TOPOS or
05C SRL_FRPOS > SRL_TOPOS
05C
eval *in96 = *on
05C
eval valerrors = 'Y'
l05C
else
b06C
if MAC_FRPOS = 0 or
06C MAC_TOPOS = 0 or
06C SRL_FRPOS = 0 or
06C SRL_TOPOS = 0
06C
eval *in95 = *on
06C
eval valerrors = 'Y'
l06C
else
b07C
if record_count = 0 and *in10 = *on
07C
eval *in90 = *on
07C
eval valerrors = 'Y'
l07C
else
e07C
endif
e06C
endif
e05C
endif
04C
endsr
end SUB_Validate
*-----------------------------------------------------------------------*/
*
Initialization subroutine */
*-----------------------------------------------------------------------*/
04C
*inzsr begsr
beg *inzsr
C *entry plist
C parm xxlibld
C parm xxfiled
* If
parameters are passed then use that as library and file name displayed
C if %parms >= 2
C if
xxlibld <> *blanks and
C xxfiled <> *blanks
04C
eval INPUTFILE =
04C %trim(xxlibld) +
'/' + %trim(xxfiled)
C endif
C endif
* Set file
name as actual file if not passed as parameter (displayed only)
C if INPUTFILE = *blanks
04C
eval INPUTFILE =
04C %trim(liblname01) + '/' + %trim(filename01)
C endif
* Retrieve
location from EXTCON data area.
02C
*dtaara define EXTCON EXTDTA
02C
in EXTDTA
02C
siteid chain
AGLOCNM0
99
C if *in99 = *off
C movel lmname location
C endif
* Open file
in order to determine if file lock exists (return code 01217)
04C
open CVUPGIDG 99
b05C
if *in99 = *on
05C
exsr *PSSR
e05C
endif
* Close file
then call CLP to allocate the file to this job
04C
close CVUPGIDG 99
04C
call 'IS3010C1'
04C
parm RETURNCODE
* Load first
page of subfile with input data
04C
exsr refresh
04C
eval FILE_RECS = filercdn01
* Special
characters string array to check for valid MAC and serial numbers
04C
movea spec_chars spec_chars_ary
* If from/to
values saved from last time then load values to display fields.
04C
*dtaara define IS3010DTA IS3010VALS
04C
in IS3010VALS
b05C
if SV_MAC_FRPOS
<> *blanks
05C
movel SV_MAC_FRPOS MAC_FRPOS
e05C
end
b05C
if SV_MAC_TOPOS <> *blanks
05C
movel SV_MAC_TOPOS MAC_TOPOS
e05C end
b05C
if SV_SRL_FRPOS <> *blanks
05C
movel SV_SRL_FRPOS SRL_FRPOS
e05C
end
b05C
if SV_SRL_TOPOS <> *blanks
05C
movel SV_SRL_TOPOS
SRL_TOPOS
e05C
end
04C
endsr
end *inzsr
*-----------------------------------------------------------------------*/
* Error
subroutine
*/
*-----------------------------------------------------------------------*/
04C
*PSSR begsr
beg *PSSR
* Check flag
to prevent endless looping
b05C
if $PSSR1 = *blanks
05C
eval $PSSR1 = 'Y'
* Determine
which file is in error if any
05C
select
05C
when filestat01 <> 00000
05C
eval PSSA_FILENAME =
FILENAME01
05C
eval PSSA_LIBLNAME =
LIBLNAME01
05C
movel FILESTAT01 PSSA_FILESTAT
05C
when filestat02 <> 00000
05C
eval PSSA_FILENAME =
FILENAME02
05C
eval PSSA_LIBLNAME =
LIBLNAME02
05C
movel FILESTAT02 PSSA_FILESTAT
05C
when filestat03 <> 00000
05C
eval PSSA_FILENAME =
FILENAME03
05C
eval PSSA_LIBLNAME =
LIBLNAME03
05C
movel FILESTAT03 PSSA_FILESTAT
05C
endsl
* If no file
open then use FILE ERROR from PSSA data structure
b06C
if PSSA_FILENAME = *blanks
06C
eval PSSA_FILENAME = PGEFIL
e06C
endif
b06C
if PSSA_LIBLNAME = *blanks
06C
eval PSSA_LIBLNAME = '*LIBL'
e06C
endif
* Call
program to display error
05C
call 'PSSRR1'
05C
parm PSSA
05C
parm
PSSA_FILENAME
05C
parm
PSSA_LIBLNAME
05C
parm
PSSA_FILESTAT
05C
exsr exit
e05C
endif
04C
endsr
end *PSSR
**
*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+...
.8....+....9....+....0....+....1....+....2....+....+....+....4....+....5....+.
...6....+....7....+....8...
