For SYSTEM 2000 Version: 12.0
Problem Status: ZC (Zap Coded) -- Fix has received limited testing
Description of Problem:
SCF USERS NOT GETTING CLEANED UP WHEN TASKS ASSOCIATED WITH THEM ARE FORCE PURGED.
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 R12.0 BUG 4844 MVS
*
* THIS BUG FIX WILL REPAIR AREAS IN THE CICS INTERFACE ERROR HANDLING
* THAT HAVE BEEN BROKEN BY OTHER BUG FIXES. IN PARTICULAR, SCF USERS
* THAT HAVE BEEN PURGED FROM CICS WILL NEVER GET CLEANED UP.
*
* THE DFHPEP PART OF THIS FIX IS TO BE APPLIED TO DFHPEP21 FOR CICS
* 2.1 AND BELOW. APPLY THE DFHPEP32 CHANGE FOR CICS 3.2 AND ABOVE
*
./ CHANGE NAME=SCFINTF
* *11* 20JUN96 GOH B4844 SET TASK NUMBER IN URB FOR SCF USERS *11* 00020960
MVC URBTASK,EIBTASKN SET TASK NUMBER *11* 00160990
./ CHANGE NAME=SCFTERM
* *20* 20JUN96 GOH B4844 FIX HANG PROBLEMS WITH ABENDING SCF USERS 00026900
MVC SCFCUID,=CL8' ' CLEAR USER ID FIELD *20* 00103010
BE TERM0100 YES. GO AHEAD ON *20* 00174000
ST R8,SCFCURB SET URB ADDRESS *20* 00175010
TM URBFLAG1,URBWAIT WAIT FLAG ON ? *20* 00186010
BZ TERM0209 NO. PROCESS IT *20* 00186020
CLI SCFCFRC,X'FF' FORCED ? *20* 00186030
BE TERM0203 YES. CONTINUE *20* 00186040
TERM0202 EQU * *20* 00186050
* *20* 00186060
* AT THIS POINT, WE NEED TO CHECK THE URBECB TO *20* 00186070
* DETERMINE IF IT HAS BEEN POSTED BY SYSTEM 2000 AND IF SO, WE *20* 00186080
* WILL TURN OFF THE URBWAIT FLAG AND WRAP UP PROCESSING FOR THIS *20* 00186090
* URB. *20* 00186100
* *20* 00186110
TM URBECB,X'40' HAS URB BEEN POSTED ? *20* 00186120
BO TERM0203 YES. WRAP IT UP *20* 00186130
* *20* 00186140
* THE URB HAS NOT BEEN POSTED BY MULTI-USER SO WE WILL TURN ON *20* 00186150
* THE ERROR FLAG AND DELAY CLEAN UP TILL ANOTHER TIME. *20* 00186160
* *20* 00186170
OI URBFLAG1,URBERR TURN ON ERROR FLAG *20* 00186180
B TERM0299 RETURN TO CALLER *20* 00186190
TERM0203 EQU * *20* 00186200
* *20* 00186210
* IF THE URB HAS BEEN POSTED, WE WILL NOW TURN OF THE URBWAIT FLAG*20* 00186220
* AND CONTINUE PROCESSING TO TERMINATE THIS USER. *20* 00186230
* *20* 00186240
NI URBFLAG1,X'FF'-URBWAIT TURN OFF WAIT FLAG *20* 00186250
TERM0209 EQU * *20* 00186260
LA R0,#URBOCIO CANCEL OPERATION *20* 00191000
B TERM0241 CONTINUE *20* 00225010
OI URBFLAG1,#URBWAIT TURN ON WAIT FLAG *20* 00226010
TERM0241 EQU * *20* 00226020
B TERM0251 CONTINUE *20* 00237010
NI URBFLAG1,X'FF'-#URBWAIT TURN OFF WAIT FLAG *20* 00238010
TERM0251 EQU * *20* 00238020
* *20* 00263220
* DETERMINE IF USER HAS STACE TABLE ENTRY AND FREE IT TOO *20* 00263230
* *20* 00263240
L R14,SCFCUSE ADDRESS S2KCUSE *20* 00263250
L R14,S2KSTAC-DS2KCUSE(R14) STACE TABLE *20* 00263260
USING DSTACE,R14 00263270
TERM0296 EQU * *20* 00263280
CLI STACENAM,X'FF' END OF LIST ? *20* 00263290
BE TERM0299 YES. WRAP IT UP *20* 00263300
CLC STACENAM,SCFCUID OUR ENTRY *20* 00263310
BE TERM0297 YES. FIX IT *20* 00263320
LA R14,STACEL$(,R14) NO. NEXT ONE *20* 00263330
B TERM0296 CHECK THEM ALL *20* 00263340
TERM0297 EQU * *20* 00263350
XC STACENAM,STACENAM CLEAR IT ALL *20* 00263360
XC STACEFLG,STACEFLG FLAG TOO *20* 00263370
TERM0299 EQU * *20* 00263380
DROP R14 00263390
ST R8,SCFCURB SET URB ADDRESS *20* 00366125
MVC SCFCUID,URBUSER SET ID IN COMM *20* 00366127
ST R8,SCFCURB SET URB ADDRESS *20* 00383010
MVC SCFCUID,URBUSER SET USER ID IN COMM *20* 00383020
./ CHANGE NAME=DFHPEP
* DFHPEP-07 20JUN96 GOH B4844 CHECK FOR SCF AND PLEX ABENDS *07* 00023990
ZAP UNPKWK1,TCAKCTTA GET TASKID (PACKED 3) *07* 00062010
L R4,UNPKWK1 GET TASK ID *07* 00062020
DFHPC TYPE=LOAD,PROGRAM=S2KCUSE,COND=YES *07* 00062030
CLI TCAPCTR,X'00' OKAY ? *07* 00062040
BNE POSTAB20 NO. JUST DO EPOSTAB *07* 00062050
L R1,TCAPCLA ADDRESS LOADED PROGRAM *07* 00062060
L R1,S2KSCFU-DS2KCUSE(R1) ADDRESS URBS *07* 00062070
USING DURB,R1 00062080
POSTAB02 EQU * *07* 00062090
C R4,URBTASK THIS URB ? *07* 00062100
BE POSTAB04 YES. HANDLE IT *07* 00062110
TM URBFLAG1,URBLAST LAST ONE ? *07* 00062120
BO POSTAB20 YES. JUST DO EPOSTAB *07* 00062130
AH R1,URBLEN NO. NEXT ONE *07* 00062140
B POSTAB02 CHECK IT *07* 00062150
POSTAB04 EQU * *07* 00062160
OI URBFLAG1,URBERR TURN ON ERROR FLAG *07* 00062170
DFHIC TYPE=INITIATE,TRANSID=SCFZ,INTRVAL=0 *07* 00062180
*07* DON'T CALL PLXTERM DIRECTLY *07* 00062190
B S2KEXIT RETURN TO CALLER *07* 00062200
POSTAB20 EQU * *07* 00062210
* *07* LINE COMMENTED OUT *07* 00063000
DURBMU RGEQU=NO *07* 00073010
DS2KCUSE *07* 00073020
./ CHANGE NAME=DFHPEP32
DFHEISTG DSECT *01* 00009010
* *01* 00009020
* PUT YOUR STORAGE DEFINITIONS HERE *01* 00009030
* *01* 00009040
* *01* 09APR97 GOH B4844 CHECK USER PRIOR TO ERROR HANDLING AND *01* 00014980
* ALLOW FOR SCF USER CLEANUP *01* 00014990
DFHPEP CSECT 00015010
DFHPEP AMODE 31 00015020
DFHPEP RMODE ANY 00015030
L R5,EIBTASKN TASK # *01* 00016000
EXEC CICS HANDLE CONDITION ERROR(S2KEXIT) 00016010
EXEC CICS LOAD PROGRAM('S2KCUSE') SET(1) 00016020
L R4,S2KSCFU-DS2KCUSE(R1) ADDR SCF URBS *01* 00016030
USING DURB,R4 *01* 00016040
PEPURBL EQU * *01* 00016050
C R5,URBTASK THIS URB ? *01* 00016060
BE PEPSERR YES. SET ERROR TASK *01* 00016070
TM URBFLAG1,URBLAST LAST URB ? *01* 00016080
BO S2KEXIT YES. RETURN TO CALLER *01* 00016090
AH R4,URBLEN NO. NEXT URB *01* 00016100
B PEPURBL CHECK IT *01* 00016110
PEPSERR EQU * *01* 00016120
OI URBFLAG1,URBERR SET URB IN ERROR TASK *01* 00016130
EXEC CICS START TRANSID('SCFZ') 00016140
S2KEXIT EQU * *01* 00016150
* *01* LINE COMMENTED OUT *01* 00017000
DURBMU RGEQU=NO *01* 00018010
DS2KCUSE *01* 00018020
End of Zap Deck