| 
FDSPDBID CF E WORKSTN F RF KSFILE FSFL F RZ KSFILE ZSFL F RR KSFILE RSFL E RC 4 4 1 E RT 1 4 20 * ENTETE USER SPACE IRTVINF DS I B 1 40FIN I B 5 80TAILLE I B 9 120NBPOST I B 13 160LGPOST * DECLARATION DE VARIABLES BINAIRES IBINDS DS I B 1 40DEBUT I B 5 80LG I B 9 120LGRCV I I 0 B 13 160CODER * DEFINITION D'UN FORMAT ILISTR DS I 1 10 FMTDB I 11 23 FMTID I 24 24 RESRV I B 25 280RCDLEN I B 29 320NBRFLD I 33 77 FTXT * DEFINITION D'UNE ZONE ILIST DS I 1 10 ZONE I 11 11 TYPE I 12 12 USAGE I B 13 160OUTBUF I B 17 200INPBUF I B 21 240BLG I B 25 280DIGITS I B 29 320DECPOS I 33 82 DESCR I 83 84 EDTCDE I B 85 880EDTLEN I 89 152 EDTWRD I 153 172 COLHD1 I 173 192 COLHD2 I 193 212 COLHD3 ILISTDB DS |
|
I 21 30 WHREFI I 31 40 WHRELI I 41 41 WHTYP I B 45 480WHJREF IFICLIB DS I 1 10 FICQ I 11 20 LIBQ IDAT7 DS I 1 70DATS IDSLG DS I 1 30ZLG I 4 4 VIR I 5 50ZDEC I '£££££FMT QTEMP' C FMTCT I '£££££FLD QTEMP' C FLDCT I '£££££DBR QTEMP' C DBRCT * * DEBUT DU PGM * C *ENTRY PLIST C PARM FIC C PARM LIB C PARM TXT C PARM DAT7 C PARM CDE C MOVE FIC FICQ C MOVE LIB LIBQ C DAT7 IFEQ *BLANK C Z-ADD0 DATS C ENDIF * REMPLISSAGE DU USER SPACE VIA API "LISTE DES FMTS". C CALL 'QUSLRCD' C PARM FMTCT USRSPC 20 C PARM 'RCDL0100'FMT 8 C PARM FICLIB C PARM '0' OVRDBF 1 * EXTRACTION DES INFOS D'ENTETE C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF |
|
C NBPOST IFGT 0 C Z-ADD0 RF 40 C MOVE *OFF *IN30 C MOVE *OFF *IN31 C WRITEFCTL C MOVE *ON *IN31 C FIN ADD 1 DEBUT 1ER POSITION * * BOUCLE SUR NOMBRE DE POSTES EXTRAITS (NBR DE ZONES) * C DO NBPOST * EXTRACTION D'UN POSTE PAR API QUSRTVUS (-> DONNE INFOS SUR UNE ZONE) C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM 77 LG C PARM LISTR * ECRITURE DANS SOUS FICHIER C ADD 1 RF C WRITEFSFL * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LGPOST DEBUT C ENDDO C ENDIF C RF IFGT 0 C MOVE *ON *IN30 C WRITEGENERAL C *IN03 DOUEQ*ON C EXFMTFCTL C *IN11 IFEQ *ON C EXSR LSTR C ELSE C READCFSFL 90 C *IN90 DOWEQ*OFF C OPTION IFEQ '1' C EXSR LSTZ C MOVE ' ' OPTION C UPDATFSFL C ENDIF C READCFSFL 90 C ENDDO C ENDIF C ENDDO C ENDIF |
|
C MOVE *ON *INLR * * SOUS PROGRAMME "LISTE DES ZONES" * C LSTZ BEGSR C DEJAZ IFEQ ' ' C MOVE 'O' DEJAZ 1 * REMPLISSAGE DU USER SPACE VIA API "LISTE DES ZONES". C CALL 'QUSLFLD' C PARM FLDCT USRSPC C PARM 'FLDL0100'FMT 8 C PARM FICLIB C PARM FMTDB 10 C PARM '0' OVRDBF 1 * EXTRACTION DES INFOS D'ENTETE C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF C NBPOST IFGT 0 C Z-ADD0 RZ 40 C MOVE *OFF *IN40 C MOVE *OFF *IN41 C WRITEZCTL C MOVE *ON *IN41 C FIN ADD 1 DEBUT 1ER POSITION * * BOUCLE SUR NOMBRE DE POSTES EXTRAITS (NBR DE ZONES) * C DO NBPOST * EXTRACTION D'UN POSTE PAR API QUSRTVUS (-> DONNE INFOS SUR UNE ZONE) C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM 212 LG C PARM LIST * ECRITURE DANS SOUS FICHIER C DIGITS IFNE 0 C Z-ADDDIGITS ZLG C MOVE ',' VIR C Z-ADDDECPOS ZDEC |
|
C ELSE C MOVE ' ' DSLG C Z-ADDBLG ZLG C ENDIF C ADD 1 RZ C WRITEZSFL * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LGPOST DEBUT C ENDDO C ENDIF C ENDIF C RZ IFGT 0 C MOVE *ON *IN40 C ENDIF C EXFMTZCTL C ENDSR * * SOUS PROGRAMME "LISTE DES RELATIONS B DE D" * C LSTR BEGSR C DEJAR IFEQ ' ' C MOVE 'O' DEJAR 1 C Z-ADD0 RR 40 C MOVE *OFF *IN50 C MOVE *OFF *IN51 C WRITERCTL C MOVE *ON *IN51 * * REMPLISSAGE DU USER SPACE VIA API "LISTE DES RELATIONS DB" C CALL 'QDBLDBR' 96 C PARM DBRCT USRSPC C PARM 'DBRL0100'FMT 8 C PARM FICLIB C PARM '*ALL' DBRM 10 C PARM '*ALL' DBRF 10 C PARM CODER C *IN96 IFEQ *ON C Z-ADD0 NBPOST C ELSE * EXTRACTION DES INFOS D'ENTETE C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC |
|
C PARM DEBUT C PARM LG C PARM RTVINF C FIN ADD 1 DEBUT 1ER POSITION C ENDIF * * BOUCLE SUR NOMBRE DE POSTES EXTRAITS (NBR DE ZONES) * C DO NBPOST * EXTRACTION D'UN POSTE PAR API QUSRTVUS (-> DONNE INFOS SUR UNE ZONE) C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM 48 LG C PARM LISTDB * ECRITURE DANS SOUS FICHIER C Z-ADDWHJREF WHJR C ADD 1 RR C WRITERSFL * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LGPOST DEBUT C ENDDO C ENDIF C RR IFGT 0 C MOVE *ON *IN50 C ENDIF * AFFICHAGE C *IN12 DOUEQ*ON C EXFMTRCTL C *IN12 IFEQ *OFF C READCRSFL 91 C *IN91 DOWEQ*OFF C OPTR IFNE ' ' C 'DSPFD' CAT WHRELI:1 FDCMD 80 P C CAT '/':0 FDCMD C CAT WHREFI:0 FDCMD C Z-ADD1 RX 20 C OPTR LOKUPRC,RX 93 C *IN93 IFEQ *ON C MOVELRT,RX RTYPE 20 C CAT RTYPE:1 FDCMD C ENDIF C CALL 'QCMDEXC' 92 C PARM FDCMD |
|
C PARM 80 FDCMDL 155 C UPDATRSFL C ENDIF C READCRSFL 91 C ENDDO C ENDIF C ENDDO C ENDSR ** KSJ5 ** TYPE(*ACCPTH) TYPE(*SELECT) TYPE(*JOIN) |
