| 
PGM PARM(&USRSPCQ &KEYPOS &KEYLEN &KEYTYP + &SRTSEQQ &SRTORDER) /* paramètres attendus */ /* 1/ user space qualifié CHAR(20) */ /* 2/ position de la clé BIN(4) */ /* 3/ Lg de la clé BIN(4) */ /* 4/ Type de clé BIN(4) 0=bin, 1=zoned */ /* 3=pck, 4=char */ /* 5/ Séquence qualifiée CHAR(20) ou *JOB,HEX */ /* 6/ Ordre de classement BIN(4) 1=A,2=D */ /*-----------------------------------------------------------------------*/ DCL &USRSPCQ *CHAR 20 DCL &KEYPOS *CHAR 4 DCL &KEYLEN *CHAR 4 DCL &KEYTYP *CHAR 4 DCL &SRTSEQQ *CHAR 20 DCL &SRTORDER *CHAR 4 DCL &RQSCTLBLK *CHAR 423 DCL &RQSCTLBL2 *CHAR 16 DCL &DEPART *DEC (15 0) DCL &DEBUT *DEC (15 0) DCL &POS *CHAR 4 DCL &RLG *CHAR 4 DCL &RETOUR *CHAR 16 DCL &TAILLE *DEC (15 0) DCL &WTAILLE *DEC (15 0) DCL &NBRECORD *DEC (11 0) DCL &WNBR *DEC (11 0) DCL &WNBR2 *DEC (11 0) DCL &NBLU *DEC (11 0) DCL &RECORDL *DEC (11 0) DCL &BUFFER *CHAR 9999 /* VARIABLES UTILISEES PAR LA GESTION DE MESSGAES */ DCL &ERRORSW *LGL /* SWITCH */ DCL &MSGID *CHAR LEN(7) /* ID MSG */ DCL &MSGDTA *CHAR LEN(100) /* DATA */ DCL &MSGF *CHAR LEN(10) /* FICHIER */ DCL &MSGFLIB *CHAR LEN(10) /* BIBLI */ MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR) /* VERIF USER SPACE */ CHGVAR %BIN(&POS) 125 CHGVAR %BIN(&RLG) 16 CALL QUSRTVUS PARM(&USRSPCQ &POS &RLG &RETOUR) |
|
/* MISE EN PLACE DU REQUEST CONTROL BLOCK */ /* INFOS GENERALES */ CHGVAR %BIN(&RQSCTLBLK 1 4) 423 /* LG DE LA VARIABLE */ CHGVAR %BIN(&RQSCTLBLK 5 4) 8 /* QLGSRTIO */ CHGVAR %BIN(&RQSCTLBLK 9 4) 0 /* RESERVED */ CHGVAR %BIN(&RQSCTLBLK 13 4) 0 /* OPTIONS */ CHGVAR %SST(&RQSCTLBLK 17 4) %SST(&RETOUR 13 4) /* LG RECORD */ CHGVAR %BIN(&RQSCTLBLK 21 4) 0 /* RECORD COUNT */ CHGVAR %BIN(&RQSCTLBLK 25 4) 56 /* OFFSET KEY-LIST */ CHGVAR %BIN(&RQSCTLBLK 29 4) 1 /* NBRE DE KEY */ CHGVAR %BIN(&RQSCTLBLK 33 4) 72 /* OFFSET TO NLS */ CHGVAR %BIN(&RQSCTLBLK 37 4) 362 /* OFFSET TO INPUT F */ CHGVAR %BIN(&RQSCTLBLK 41 4) 0 /* NBRE D'INPUT FILE */ CHGVAR %BIN(&RQSCTLBLK 45 4) 392 /* OFFSET TO OUTPUT F*/ CHGVAR %BIN(&RQSCTLBLK 49 4) 0 /* NBRE D'OUTPUT FILE*/ CHGVAR %BIN(&RQSCTLBLK 53 4) 0 /* RESERVED */ /* DÉFINITION DE LA CLÉ */ /* DEBUT */ CHGVAR %SST(&RQSCTLBLK 57 4) &KEYPOS /* LG */ CHGVAR %SST(&RQSCTLBLK 61 4) &KEYLEN /* TYPE */ CHGVAR %SST(&RQSCTLBLK 65 4) &KEYTYP /* ASCEND*/ CHGVAR %SST(&RQSCTLBLK 69 4) &SRTORDER /* SEQUENCE DE TRI */ /* TABLE */ CHGVAR %SST(&RQSCTLBLK 73 20) &SRTSEQQ /* CCSID */ CHGVAR %BIN(&RQSCTLBLK 93 4) 0 /* 0 = DFT */ /* LANG */ CHGVAR %SST(&RQSCTLBLK 97 10) '*JOB' CALL QLGSORT + PARM(&RQSCTLBLK ' ' ' ' X'00000000' X'00000000' X'00000000') /* INFOS D'ENTETE DU USER SPACE */ CHGVAR &DEPART (%BIN(&RETOUR 1 4) + 1) CHGVAR &TAILLE %BIN(&RETOUR 5 4) CHGVAR &NBRECORD %BIN(&RETOUR 9 4) CHGVAR &RECORDL %BIN(&RETOUR 13 4) IF (&TAILLE > 9999) THEN(DO) CHGVAR &WNBR (9999 / &RECORDL) CHGVAR &WTAILLE (&WNBR * &RECORDL) ENDDO ELSE DO CHGVAR &WNBR &NBRECORD CHGVAR &WTAILLE &TAILLE ENDDO |
|
CHGVAR &RQSCTLBL2 X'0000000100000000' CHGVAR %BIN(&RQSCTLBL2 9 4) &RECORDL CHGVAR %BIN(&RQSCTLBL2 13 4) &WNBR /* AJOUT DES DONNÉES À TRIER DANS L'ESPACE DE TRAVAIL */ CHGVAR &DEBUT &DEPART CHGVAR %BIN(&RLG) &WTAILLE BOUCL1: CHGVAR %BIN(&POS) &DEBUT CALL QUSRTVUS PARM(&USRSPCQ &POS &RLG &BUFFER) CALL QLGSRTIO PARM(&RQSCTLBL2 &BUFFER ' ' X'00000000' + &RETOUR X'00000000') CHGVAR &NBLU (&NBLU + &WNBR) IF (&NBLU < &NBRECORD) THEN(DO) /* ENCORE À LIRE */ CHGVAR &DEBUT (&DEBUT + &WTAILLE) IF ((&NBLU + &WNBR) > &NBRECORD) THEN(DO) /* DERNIER TOUR ==> CALCUL NOMBRE ET TAILLE À LIRE */ CHGVAR &WNBR2 (&NBRECORD - &NBLU) CHGVAR %BIN(&RQSCTLBL2 13 4) &WNBR2 CHGVAR %BIN(&RLG) VALUE((&WNBR2 * &RECORDL) + 1) ENDDO GOTO BOUCL1 ENDDO /* TRI EFFECTIF DE L'ESPACE DE TRAVAIL */ CHGVAR %SST(&RQSCTLBL2 1 4) X'00000002' CALL QLGSRTIO PARM(&RQSCTLBL2 ' ' ' ' X'00000000' + &RETOUR X'00000000') /* EXTRACTION DES DONNÉES TRIÉES ET REMPLACEMENT DANS LE USER SPACE */ CHGVAR %SST(&RQSCTLBL2 1 4) X'00000003' CHGVAR %BIN(&RQSCTLBL2 13 4) &WNBR CHGVAR &DEBUT &DEPART CHGVAR %BIN(&RLG) &WTAILLE CHGVAR &NBLU 0 BOUCL2: CHGVAR %BIN(&POS) &DEBUT CALL QLGSRTIO PARM(&RQSCTLBL2 ' ' &BUFFER &RLG + &RETOUR X'00000000') CALL QUSCHGUS PARM(&USRSPCQ &POS &RLG &BUFFER '0') CHGVAR &NBLU (&NBLU + &WNBR) IF (&NBLU < &NBRECORD) THEN(DO) /* ENCORE À LIRE */ CHGVAR &DEBUT (&DEBUT + &WTAILLE) IF ((&NBLU + &WNBR) > &NBRECORD) THEN(DO) /* DERNIER TOUR ==> CALCUL NOMBRE ET TAILLE À LIRE */ CHGVAR %BIN(&RQSCTLBL2 13 4) &WNBR2 CHGVAR %BIN(&RLG) VALUE((&WNBR2 * &RECORDL) + 1) ENDDO GOTO BOUCL2 |
|
ENDDO /* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */ COMPMSG: RCVMSG MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) IF (&MSGID *EQ ' ') RETURN /* FIN DU PGM */ SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*COMP) GOTO COMPMSG /* BOUCLE SUR MESSAGES *COMP */ /*----------------------------------------*/ ERREUR: /* GESTION DES ERREURS */ /*----------------------------------------*/ IF &ERRORSW SNDPGMMSG MSGID(CPF9899) + MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/ /* ARRET PGM*/ CHGVAR &ERRORSW '1' /* MISE EN PLACE DU SWTICH */ /* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */ DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) IF (&MSGID *EQ ' ') GOTO EXCPMSG SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*DIAG) GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */ /* RENVOI DU MESSAGE D'ERREUR */ EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) ENDPGM |
