For SYSTEM 2000 Version: 12.0
Problem Status: ZD -- ZAP DISTRIBUTED
Description of Problem:
THE LIST COMMANDS IN THE NEW INTERFACE (LALL, LPLX, LSCF) DO NOT SUPPORT MULTIPLE PAGES OF OUTPUT.
Note: Please send email to s2k@sas.com telling us which problem fixes you have downloaded so we can keep track of the fixes at your site in case questions or problems arise.
Top of Zap Deck:
* IBM V12.0 BUG 4643 MVS
./ CHANGE NAME=S2KLIST
* *06* 18AUG92 GOH B4643 12.1 FIXES FOR CLEANING UP LIST DISPLAYS * 00024999
CLI 0(R7),EQUSBA SBA IN FRONT ? *06* 00079101
BNE LIST0020 NO. CONTINUE *06* 00079201
LA R7,3(R7) PAST SBA SEQUENCE *06* 00079301
LH R6,LSTMSGL DECREMENT LENGTH BY 3 *06* 00079401
SH R6,HWD3 SBA LENGTH *06* 00079501
STH R6,LSTMSGL RESET *06* 00079601
LIST0020 EQU * *06* 00079701
BZ LIST0105 GOT NO INPUT *06* 00086000
CLI EIBAID,DFHENTER ENTER KEY ? *06* 00086010
BNE LIST0105 NO. CHECK SPECIAL INPUT *06* 00086020
L R14,LSTMSGA ADDR INPUT *06* 00086030
CLC 0(2,R14),=C'P,' PAGING COMMAND ? *06* 00086040
BNE LIST0110 NO. CHECK IT OUT *06* 00086050
LIST0105 EQU * *06* 00086060
* 00088000
* FOUR LINES REMOVED BY BUG FIX 4643 *06* 00089000
* 00090000
* 00091000
CLI LISTPAG,1 PAGING PROCESS ? *06* 00104010
BE LIST0500 YES. *06* 00104020
CLI LISTEND,1 END PROCESSING ? *06* 00104030
BE LIST0600 YES. *06* 00104040
* ADD LENGTH TO LINK COMMAREA PROCESS *06* 00129010
EXEC CICS LINK PROGRAM('SCFPGMG') COMMAREA(LSTCOMM) LENGTH(67) 00130000
BE LIST0600 YES. PROCESS END STUFF *06* 00132000
*06* SET LENGTH OF COMMAREA 00139010
EXEC CICS LINK PROGRAM('SCFPGBD') COMMAREA(LSTCOMM) LENGTH(67) 00140000
B LIST9000 RETURN WITH NO LOCK *06* 00141000
B LIST2200 NO PARAMETER FOUND, ASSUME ALL *06* 00330000
C R6,FWD7 ALLOWABLE? *06* 00349100
BNH LIST2055 YES. CONTINUE *06* 00349200
LA R6,7 SET MAX USER ID LEN *06* 00349300
LIST2055 EQU * *06* 00349400
L R14,LSTCUSE ADDR USE MODULE *06* 00389010
L R14,S2KAIDS-DS2KCUSE(R14) ADD AID TABLE *06* 00389020
CLI EIBAID,DFHENTER ENTER KEY ? *06* 00389030
BNE LIST600A NO. CHECK AID *06* 00389040
LH R15,LSTMSGL GET INPUT LENGTH *06* 00390000
LTR R15,R15 ANY INPUT ? *06* 00391000
BNZ LIST6050 YES. CHECK IT *06* 00392000
LIST600A EQU * *06* 00392010
CLI EIBAID,DFHPF15 END OF PAGING ? *06* 00392020
BE LIST6800 YES. GET OUT *06* 00392030
CLI EIBAID,DFHPF3 END OF PAGING ? *06* 00392040
BE LIST6800 YES. GET OUT *06* 00392050
CLC EIBAID,0(R14) THIS AID ? *06* 00392060
BE LIST600C YES. PROCESS IT *06* 00392070
CLI 0(R14),X'F9' END OF TABLE ? *06* 00392080
BE LIST6200 YES. ASSUME P,N *06* 00392090
LA R14,8(R14) NEXT ENTRY *06* 00392100
B LIST600A CONTINUE *06* 00392110
LIST600C EQU * *06* 00392120
CLC 1(2,R14),=CL2'P,' PAGING COMMAND ? *06* 00392130
BE LIST600E YES. CONTINUE *06* 00392140
CLC 1(4,R14),CEXIT GET OUT PROCESS ? *06* 00392150
BE LIST6800 YES. SET UP END *06* 00392160
B LIST6200 NO. ASSUME P,N *06* 00392170
LIST600E EQU * *06* 00392180
LA R15,3(R14) ADDRESS FUNCTION *06* 00392190
B LIST6190 FINISH UP *06* 00392200
*06* 00393000
*06* 00394000
*06* 00395000
*06* 00396000
*06* 21 LINES REMOVED BY BUG FIX 4643 00397000
*06* 00398000
*06* 00399000
*06* 00400000
*06* 00401000
*06* 00402000
*06* 00403000
*06* 00404000
*06* 00405000
*06* 00406000
*06* 00407000
*06* 00408000
*06* 00409000
*06* 00410000
*06* 00411000
*06* 00412000
*06* 00413000
*06* 00414000
CLC 0(2,R15),=CL2'P,' P, COMMAND *06* 00417000
LA R15,2(R15) PAGE REQUEST *06* 00419010
ST R15,LSTMSGA SAVE ADDRESS *06* 00419020
LH R15,LSTMSGL DECREMENT LENGTH *06* 00419030
S R15,=F'2' DO IT *06* 00419040
STH R15,LSTMSGL RESET LENGTH *06* 00419050
MVI LISTPAG,1 SET PAGING *06* 00419060
B LIST6900 WRAP IT UP *06* 00419070
*06* 00420000
*06* 00421000
*06* 00422000
*06* 00423000
*06* TEN LINES REMOVED BY BUG 4643 00424000
*06* 00425000
*06* 00426000
*06* 00427000
*06* 00428000
*06* 00429000
LIST6190 EQU * *06* 00436010
LA R15,5 *06* 00438000
*06* 00440000
LIST6290 EQU * *06* 00448010
LA R15,5 *06* 00450000
*06* 00452000
*06* 00455000
*06* 00456000
*06* 00457000
*06* 00458000
*06* 00459000
*06* TWELVE LINES REMOVED BY BUG 4643 00460000
*06* 00461000
*06* 00462000
*06* 00463000
*06* 00464000
*06* 00465000
*06* 00466000
* DO NOT SET PAGING FLAG HERE *06* 00473000
CLC PCITRMNL(4),EIBTRMID OURS ? *06* 00491010
BE LIST7100 YES. USE IT *06* 00491020
LA R9,PCILEN$(R9) NEXT ONE *06* 00491030
B LIST7004 CHECK EM ALL *06* 00491040
LIST7008 EQU * FIND A FREE ONE *06* 00491050
L R9,LSTPCIA RESET POINTER *06* 00491060
LIST7009 EQU * *06* 00491070
CLI PCITRMNL,X'FF' END OF BLOCKS ? *06* 00491080
BE LIST7010 YES. SET ERROR *06* 00491090
LIST7010 EQU * *06* 00497000
MVC PCITRMNL(4),CLIST PRESERVE PCI BLOCK *06* 00501100
XC PCIRTN,PCIRTN CLEAR RETURN CODE *06* 00502010
XC PCILCURR,PCILCURR CLEAR CURRENT LINE # *06* 00506100
LA R15,3(R15) BUMP BY 3 LINES *06* 00592000
LA R15,1(R15) FIRST TIME RELA TRAN LINES *06* 00592010
XR R15,R15 CLEAR REG *06* 00595010
IC R15,PCIPSIZ # LINES PER TERMINAL PAGE *06* 00595020
CH R15,LSTCLN# FULL PAGE ? *06* 00595030
BH LIST8015 NO. CONTINUE PROCESSING *06* 00595040
* L R15,LISTSEND GET END OF BUFFER *06* 00595050
* L R5,LSTCPOS CURRENT POSITION *06* 00595060
* LA R14,HEADLEN(R5) PLUS LENGTH OF HEADER *06* 00595070
* LA R14,LSLEN(R14) PLUS LENGTH OF AT LEAST ONE LI*06* 00595080
* CR R14,R15 ROOM FOR ALL OF THIS IN BUFFER*06* 00595090
* BNL LIST8720 NO. SET END OF BUFFER *06* 00595100
* MVC 0(HEADLEN,R5),SCRHEAD MOVE IN HEADINGS *06* 00595110
LH R15,LSTCPG# GET CURRENT PAGE # *06* 00595120
LA R15,1(R15) BUMP IT *06* 00595130
STH R15,LSTCPG# SAVE IT *06* 00595140
* CVD R15,LISTDWD CONVERT TO DECIMAL *06* 00595150
* UNPK LISTPGWK,LISTDWD+6(2) UNPACK INTO DISPLAY FIELD *06* 00595160
* OI LISTPGWK+2,X'F0' RESET SIGN *06* 00595170
* MVC HEADPG#-SCRHEAD(2,R5),LISTPGWK+1 MOVE TO HEADER *06* 00595180
* LA R5,HEADLEN(R5) RESET CURR POS *06* 00595190
* ST R5,LSTCPOS *06* 00595200
LA R5,3 # LINES IN HEADER *06* *06* 00595210
STH R5,LSTCLN# SET AS CURRENT LINE # *06* *06* 00595220
LIST8015 EQU * *06* 00595230
MVC LSRESP,1(R2) MOVE RESPONSE TO SCREEN*06* 00625000
*06* 00685000
*06* 00686000
*06* 00687000
*06* 00688000
*06* 00689000
*06* 00690000
*06* TWENTY ONE LINES REMOVED BY BUG 4643 00691000
*06* 00692000
*06* 00693000
*06* 00694000
*06* 00695000
*06* 00696000
*06* 00697000
*06* 00698000
*06* 00699000
*06* 00700000
*06* 00701000
*06* 00702000
*06* 00703000
*06* 00704000
*06* 00705000
* LIST9000 - MESSAGE HANDLING ROUTINES *06* * 00726000
LIST9000 EQU * *06* 00729010
LA R1,LISTMSG5 END OF PROCESS *06* 00729020
B LIST9099 PUT OUT MESSAGE *06* 00729030
BE LIST9202 *06* 00763000
LIST9202 EQU * *06* 00769000
L R15,DFHEICAP ADDRESS PASSED COMMON *06* 00770000
MVC PLXPRM3-PLXCOMM(1,R15),=X'FF' TURN ON NO USERS *06* 00771000
B LIST9900 CONTINUE *06* 00772000
L R0,LSTMSGA CHECK TRAN AREAS *06* 00784000
LTR R0,R0 EMPTY ? *06* 00785000
BNZ LIST9230 NO. JUST CONTINUE *06* 00786000
LA R0,CLSCF ADDR FORMATTED LSCF *06* 00787000
CLC EIBTRNID,CTSCF SCF TERMINATE ? *06* 00788000
BE LIST9222 YES. SET LENGTH *06* 00789000
LA R0,CLPLX ADDR FORMATTED LPLX *06* 00790000
LIST9222 EQU * *06* 00791000
ST R0,LSTMSGA SET ADDRESS *06* 00792000
LA R0,4 DEFAULT LENGTH *06* 00793000
STH R0,LSTMSGL SET IT *06* 00794000
LIST9230 EQU * *06* 00795000
*06* SET LENGTH OF COMMAREA 00795010
EXEC CICS LINK PROGRAM('SCFPGBD') COMMAREA(LSTCOMM) LENGTH(67) 00796000
XC PCITRMNL(PCILEN$),PCITRMNL FREE PCI BLOCK *06* 00803000
*06* THE FOLLOWING CHANGED TO REFLECT THE CURRENT TRANS ID RATHER 00806010
*06* THAT HARD CODED LSCF. 00806020
*06* 00807000
EXEC CICS RETURN TRANSID(EIBTRNID) 00808000
EQUSBA EQU X'11' SBA CHARACTER *06* 00815010
FWD7 DC F'7' MAX EX MOVE LENGTH FOR USERID *06* 00818010
HWD3 DC H'3' SBA SEQUENCE LENGTH *06* 00819000
CEXIT DC CL4'EXIT' *06* 00830010
CWAIT DC CL4'(W)' *06* 00837000
LISTPNXT DC CL5'N' PAGE NEXT SYNTAX *06* 00845000
LISTPCUR DC CL5'C' PAGE CURRENT SYNTAX *06* 00846000
LISTPPRV DC CL5'P' PAGE PREVIOUS SYNTAX *06* 00847000
LISTMSG5 DC CL40'S2KLIST 005 - END OF LIST PROCESSING' *06* 00857010
DC C' ' *06* 00905100
DC X'00' *06* 00906000
SCRBLKL DC CL2' ',X'00' *06* 00908000
DC CL1' ' *06* 00910010
DC C' ' *06* 00922000
DC X'00' *06* 00922100
COPY DFHAID *06* 00925000
./ CHANGE NAME=SCFPGBD
* *09* 25SEP92 GOH B4643 FIX ALL PAGING PROBLEMS WITH LIST DISPLAYS*09* 00012980
XR R14,R14 *09* 00244040
IC R14,PCIPLIN *09* 00244050
LA R14,2(R14) *09* 00244060
STC R14,PCIPLIN *09* 00244070
LA R14,TBL3270+6 LINE THREE SBA *09* 00244080
CLI PCILWID,132 IS CHAR/LINE = 132 ? *09* 00244090
BNE PGBD0160 NO. *09* 00244100
LA R14,TBLMOD5+6 YES. LINE 3 (MOD5) *09* 00244110
B PGBD0160 *05* *09* 00245000
CLC PCIPLAST,=H'0' FIRST PAGE ? *09* 00255010
BNE PGBD0148 NO. JUST CONTINUE *09* 00255020
* *09* 00264010
* BUMP LINE COUNT FOR FURTHER PROCESSING *09* 00264020
* *09* 00264030
B PGBD0170 NO. *09* 00264100
XR R14,R14 *09* 00268040
IC R14,PCIPLIN *09* 00268050
LH R14,2(R14) BUMP LINE COUNT *09* 00268060
STC R14,PCIPLIN *09* 00268070
LA R14,TBL3270+6 LINE THREE SBA *09* 00268080
CLI PCILWID,132 IS CHAR/LINE =132 ? *09* 00268090
BNE PGBD0160 NO. *09* 00268100
LA R14,TBLMOD5+6 YES. LINE 3 (MOD5) *09* 00268110
B PGBD0160 *09* 00268120
LA R14,TBL3270+6(R4) R14 <- ADDR(3270 CNTL(SBA) *09* 00271000
LTR R5,R5 ANYTHING TO FREE ? *09* 00351010
BZ PGBD0300 NO. JUST CONTINUE *09* 00351020
LTR R5,R5 ANYTHING TO FREE *09* 00373010
BZ PGBD0265 NO. CONTINUE *09* 00373020
TBL3270 DS 0CL72 SBA SEQUENCE FOR 3270 *09* 00553000
*09* 00554000
TBLMOD5 DS 0CL72 SBA SEQUENCE FOR 3270 *09* 00599000
*09* 00600000
End of Zap Deck