118 lines
1.8 KiB
Plaintext
118 lines
1.8 KiB
Plaintext
SUBROUTINE LIST(ARGX )
|
|
* LIST COMPANY BY CO_NAME
|
|
*
|
|
DECLARE FUNCTION SET_STATUS, SET_FSERROR, SEND_DYN, SEND_INFO, SET_ROWDEF
|
|
EQU TAB$ TO \09\
|
|
STATX = SET_ROWDEF( \01\ )
|
|
* HEADING/FOOTING
|
|
HEADING " "
|
|
FOOTING ""
|
|
*
|
|
@RECCOUNT=0
|
|
FIRST.PASS=1
|
|
LAST.RECORD=0
|
|
READERR=0
|
|
*
|
|
* OPEN DICT AND DATA FILES
|
|
*
|
|
OPEN "DICT","COMPANY" TO @DICT ELSE RETURN
|
|
OPEN "","COMPANY" TO FILE.IN ELSE RETURN
|
|
*
|
|
* MAKE COLUMN HEADING
|
|
*
|
|
COLHEADING "Key"
|
|
COLLENGTH 15
|
|
*
|
|
READRECORD:
|
|
*
|
|
*
|
|
READNEXT @ID, WHICH.VALUE ELSE
|
|
IF STATUS() GT 0 THEN
|
|
STATX = SET_FSERROR()
|
|
RETURN
|
|
END
|
|
IF @FILE.ERROR<1> EQ 421 THEN
|
|
STATX = SET_FSERROR()
|
|
GOTO READRECORD
|
|
END
|
|
IF @FILE.ERROR<1> NE 111 THEN
|
|
@ANS = @FILE.ERROR<1>
|
|
STATX = SEND_DYN( {RLIST_TEXT_4} )
|
|
READERR += 1
|
|
GOTO READRECORD
|
|
END
|
|
LAST.RECORD=1
|
|
END
|
|
@FILE.ERROR.MODE=0
|
|
*
|
|
S.ATID = @ID
|
|
*
|
|
IF FIRST.PASS AND LAST.RECORD THEN
|
|
STATX = SEND_DYN( {RLIST_TEXT_2} )
|
|
RETURN
|
|
END
|
|
*
|
|
IF LAST.RECORD THEN GOTO BREAKS
|
|
*
|
|
IF @REDUCTION.DONE THEN
|
|
READO @RECORD FROM FILE.IN, @ID ELSE
|
|
@FILE.ERROR.MODE = 0
|
|
IF STATUS() GT 0 THEN
|
|
STATX = SET_FSERROR()
|
|
RETURN
|
|
END
|
|
IF @FILE.ERROR<1> NE 100 THEN
|
|
READERR += 1
|
|
END
|
|
GOTO READRECORD
|
|
END
|
|
END
|
|
*
|
|
@RECCOUNT += 1
|
|
*
|
|
*
|
|
* CALCULATE VALUE(S) FOR COLUMN(S)
|
|
*
|
|
S.ATID={@ID}
|
|
I.ATID=S.ATID
|
|
*
|
|
*
|
|
IF FIRST.PASS THEN
|
|
FIRST.PASS=0
|
|
GOTO DETAIL
|
|
END
|
|
*
|
|
*
|
|
BREAKS:
|
|
*
|
|
*
|
|
* PERFORM LAST RECORD OUTPUT IF DONE
|
|
*
|
|
IF LAST.RECORD THEN
|
|
STATX = SEND_DYN("")
|
|
@ANS=@RECCOUNT
|
|
STATX = SEND_DYN( {RLIST_TEXT_1} )
|
|
IF READERR THEN
|
|
@ANS=READERR
|
|
STATX = SEND_DYN( {RLIST_TEXT_3} )
|
|
END
|
|
RETURN
|
|
END
|
|
*
|
|
DETAIL:
|
|
*
|
|
* DO CONVERSIONS IF ANY
|
|
*
|
|
*
|
|
* PRINT DETAIL LINE
|
|
*
|
|
PRINTLINE = ""
|
|
PRINTLINE := FMT( S.ATID, "L#15")
|
|
STATX = SEND_DYN( PRINTLINE )
|
|
*
|
|
*
|
|
GOTO READRECORD
|
|
*
|
|
END
|
|
|