|
Do you have source some source that you want to share? Is there some source that you want to see posted here? If so, Contact Us and we'll be more than happy to help. |
****************************************************************
* Description.. Subfile Skeleton Program *
* Program Name. SKELSUB *
* Author....... Bradley V. Stone *
* BVS/Tools - www.bvstools.com *
* *
* 30 Subfile Display Indicator *
* 33 Subfile Clear Indicator *
* 34 Subfile End Indicator *
* 35 Subfile Display Control Indicator *
****************************************************************
FxxxxxxDF CF E WORKSTN INFDS(DSSUBF)
F SFILE(SFL01:RRN)
FxxxxxxPF IF E K DISK
****************************************************************
* Program Status Data Structure
D SDS
D W$PGM 1 10
D W$JOB 244 253
*
* Subfile File Level Data Structure
D DSSUBF DS
D SFLRR# 376 377B 0 RRN of Current Page
D SFLPG# 378 379B 0 Current Page Number
D SFLREC 380 381B 0 Not Sure Just Yet
*
D #RECDS C CONST(15) # Recds in Page
*
D RRN S 4 0 INZ Rel. Rec. Num.
D @COUNT S 4 0 INZ Counter
****************************************************************
C dow (not *INKC)
C EXSR $Display
*
C if (*INKC)
C ITER
C endif
*
C if (RRN > 0)
C EXSR $Process
C endif
*
C if (*IN25)
C if (not *IN34)
C EXSR $Load
C endif
C ITER
C endif
*
C enddo
*
C SETON LR
****************************************************************
* Initialize the Subfile *
****************************************************************
C $Init BEGSR
*
C eval RRN = 0
C SETON 3335
C WRITE CTL01
C SETOFF 303334
*
C ENDSR
****************************************************************
* Position in the Subfile *
****************************************************************
C $Position BEGSR
*
C WKxxxx SETLL xxxxxxPF
*
C ENDSR
****************************************************************
* Load the Subfile *
****************************************************************
C $Load BEGSR
*
C eval @COUNT = 0
*
C dow (not *IN34) and (@COUNT < #RECDS)
C READ xxxxxxPF 34
*
C if (*IN34) or (xxCODE = 'X')
C ITER
C endif
*
C ADD 1 RRN
C ADD 1 @COUNT
C WRITE SFL01
C enddo
*
C if (RRN > 0)
C seton 30
C endif
*
C eval RECNBR = RRN
*
C ENDSR
****************************************************************
* Display the Subfile *
****************************************************************
C $Display BEGSR
*
C WRITE OVR01
C EXFMT CTL01
C Z-ADD SFLPG# RECNBR
*
C ENDSR
****************************************************************
* Process the Subfile *
****************************************************************
C $Process BEGSR
*
C setoff 95
*
C dow (not *IN95)
C READC SFL01 95
*
C if (*IN95)
C ITER
C endif
*
C if (WFSEL = '1')
C EXSR $Opt1
C endif
*
C eval WFSEL = ' '
C UPDATE SFL01
C WRITE CTL01
C enddo
*
C ENDSR
****************************************************************
* Option 1 *
****************************************************************
C $Opt1 BEGSR
*
*
C ENDSR
****************************************************************
* Initialization Subroutine *
****************************************************************
C *INZSR BEGSR
*
C WKXXX KLIST
C KFLD XXXXX 15
*
C EXSR $Init
*
C ENDSR
|