AS/400 Code Samples - AS/400 - COUNTSQL - GSS Count unique occurances of a value in a file field Author: George Pearson Company: Green Springs Software, Inc. www.green-springs.com Purpose: Programmers Utility to list discrete entries from a database file. Uses IBM SQL/400 Components: COUNT CMD COUNTSQLC CL Program COUNTR SQLRPGLE Program Parameters: File Enter Qualified or Unqualified File Name Special Values: *Libl Field Enter a valid field name in the file to count ocuurances of Output ("*" or "*Print") Written: 1998 *** REVISED 8/2003 *** /*ã*************************************************************************/ /* */ /* ¹ Green Springs Software, Inc. Ashland, OR */ /* */ /*ã*************************************************************************/ /* */ /* COMMAND ID - COUNT */ /* CPP - COUNTC OR COUNTSQLC * */ /* DESCRIPTION - COUNT VALUES IN A FIELD */ /* WRITTEN BY - GEORGE PEARSON, GREEN SPRINGS SOFTWARE, INC. */ /* DATE CREATED - 9/28/1998 */ /* PURPOSE - EXECUTES A SEQUEL TO COUNT THE VALUES IN A FIELD. */ /* */ /* NOTES - * COUNTC requires ASC's Sequel Product. */ /* COUNTSQLC uses IBM's SQL/400 */ /* */ /*ã*************************************************************************/ /* */ /* (C) MMIII GREEN SPRINGS SOFTWARE, INC. */ /* POB 3336, ASHLAND, OR 97520 */ /* (541) 488-2560 george@green-springs.com */ /* www.green-springs.com */ /* */ /*ã*************************************************************************/ CMD PROMPT('GSS COUNT VALUES IN A FIELD') PARM KWD(FILE) TYPE(QUAL1) MIN(1) MAX(1) + PROMPT('FILE TO ANALYZE?:' 1) PARM KWD(FIELD) TYPE(*CHAR) LEN(10) MIN(1) MAX(1) + PROMPT('FIELD TO COUNT?' 2) PARM KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*) VALUES(* *PRINT) MAX(1) + PROMPT('OUTPUT: * OR *PRINT' 4) QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) PROMPT('IN LIBRARY:') /*ã************** End Of Command Source ***********************************/ /*ã*************************************************************************/ /* */ /* ¹ Green Springs Software, Inc. Ashland, OR */ /* */ /*ã*************************************************************************/ /* */ /* PROGRAM ID - COUNTSQLC */ /* DISPLAY FILE - NONE */ /* DESCRIPTION - Count & List occurances in a Field. */ /* WRITTEN BY - GEORGE PEARSON, GREEN SPRINGS SOFTWARE, INC. */ /* DATE CREATED - 9/28/2003 */ /* PURPOSE - EXECUTES AN SQL TO COUNT THE VALUES IN A FIELD. */ /* NOTE - Use this program if you Don't Have ASC's SEQUEL */ /* Product. If you HAVE SEQUEL, uou can use */ /* COUNTC, a simpler process. */ /*ã*************************************************************************/ /* */ /* (C) MMIII Green Springs Software, Inc. */ /* POB 3336, Ashland, OR 97520 */ /* (541) 488-2560 george@green-springs.com */ /* www.green-springs.com */ /* */ /*ã*************************************************************************/ PGM PARM(&FILLIB &FIELD &OUTPUT) DCL &FILLIB *Char Len(21) DCL &FILE *Char Len(10) DCL &FIELD *Char Len(10) DCL &LIB *Char Len(10) DCL &MBR *Char Len(10) DCL &OUTPUT *Char Len(06) DCL &TYPE *Char Len(01) MONMSG MSGID(CPF9800 CPF2981) EXEC(GOTO + CMDLBL(ERR01)) RTVJOBA TYPE(&TYPE) CHGVAR VAR(&FILE) VALUE(%SST(&FILLIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILLIB 11 10)) CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) IF COND(&TYPE = '0') THEN(CHGVAR &OUTPUT '*PRINT') IF COND(&OUTPUT = '*PRINT') THEN(DO) OVRPRTF FILE(QSYSPRT) PAGRTT(0) ENDDO /* éRun the SQL-RPG program to get the info */ /* ¹--------------------------------------- */ CALL PGM(COUNTR) PARM(&FILE &LIB &FIELD &OUTPUT) IF COND(&OUTPUT = '* ') THEN(DO) DSPSPLF FILE(QSYSPRT) SPLNBR(*LAST) MONMSG MSGID(CPF3309) EXEC(SNDPGMMSG MSG('No file + layout to display.')) DLTSPLF FILE(QSYSPRT) SPLNBR(*LAST) MONMSG MSGID(CPF0000) ENDDO IF COND(&OUTPUT = '*PRINT') THEN(DO) DLTOVR FILE(QSYSPRT) ENDDO RETURN /* éError Trapping */ /* ¹-------------- */ ERR01: SNDPGMMSG MSG('FILE ' *CAT &LIB *TCAT '/' *CAT &FILE + *TCAT ', MBR:' *CAT &MBR *TCAT ' NOT FOUND.') ENDPGM: ENDPGM /*ã************** End Of CLP Source ****************************************/ *ã******************************************************************************************** * * ¹ Green Springs Software, Inc. Ashland, OR * *ã******************************************************************************************** * PROGRAM ID - COUNTR * DISPLAY FILE - *None * DESCRIPTION - Count & List Occurances in a field in a file * WRITTEN BY - George Pearson, Green Springs Software, Inc. * DATE CREATED - 3/17/2003 * *ã******************************************************************************************** * (C) MMIII Green Springs Software, Inc. * POB 3336, Ashland, OR 97520 * (541) 488-2560 george@green-springs.com * www.green-springs.com *ã******************************************************************************************** FQSYSPRT O F 132 PRINTER Oflind(*InOF) * Work Variables d @Count s 15S 0 d @FandL s 30 d @Field s 10 d @FieldDta s 100 d @FieldNum s 30 5 d @File s 10 d @Group s 30 d @Heading s 65 d @Lib s 10 d @Num s N d @Order s 30 d @Output s 6 d @Select s 20 d @String s 200 d @Utime s 6S 0 * éProgram Status Data Structure * ¹----------------------------- d sds d @Pgm *Proc *--------------------------------------------------------------------------------------------* * éMainline * ¹-------- c *Entry Plist c Parm @File c Parm @Lib c Parm @Field c Parm @Output c time @Utime c eval @Select = 'Select ' + @Field c eval @Group = ' Group By ' + @Field c eval @Order = ' Order By ' + @Field c If @lib = *Blank Or @Lib = '*LIBL' c eval @FandL = ' From ' + @file c Else c eval @FandL = ' From ' + %trim(@lib) + '/' c + @file c EndIf c eval @String = @Select + ' , Count(*) ' c + %trim(@FandL) + ' ' c + %trim(@Group) + ' ' + %trim(@Order) *------------------------------------------* * Process Records - Validate Percentages * *------------------------------------------* * Open the Cursor c exsr PrepareC c exsr openc * Fetch the first record c exsr fetchc c If sqlcod = -303 c exsr fetchN c Eval @Num = *On c EndIf c Eval @Heading = 'Report of Occurances of Field ' + c %trimr(@Field) + ' in File ' + %trimr(@Lib) c + '/' + @File c Except @Head * Loop until no more records c dow sqlcod <> 100 c OF Except @Head c If sqlcod = -501 c Except @Err01 c Leave c EndIf c If @Num = *On c Except @Line_Num c Else c Except @Line c EndIf c If @Num = *On c exsr fetchN c Else c exsr fetchc c EndIf c EndDO c exsr closec1 * End Job c eval *inlr = *on *ã******************************************************************************************** * Subroutine - PREPARE - Prepare the Request * *ã******************************************************************************************** c prepareC begsr c/exec sql c+ prepare S1 from :@String c/end-exec c endsr *ã******************************************************************************************** * Subroutine - OPEN - Open the SQL Cursor * *ã******************************************************************************************** c openc begsr c/exec sql c+ declare c1 cursor for S1 c/end-exec c/exec sql c+ open c1 c/end-exec c endsr *ã******************************************************************************************** * SUBROUTINE - FETCH - Fetch C1 * *ã******************************************************************************************** c fetchc begsr c/exec sql c+ fetch c1 c+ into :@FieldDta, :@Count c/end-exec c endsr *ã******************************************************************************************** * SUBROUTINE - FETCHN - Fetch C1 for numeric fields * *ã******************************************************************************************** c fetchN begsr c/exec sql c+ fetch c1 c+ into :@FieldNum, :@Count c/end-exec c endsr *ã******************************************************************************************** * SUBROUTINE - CLOSE - Close C1 Cursor * *ã******************************************************************************************** c closec1 begsr c/exec sql c+ close c1 c/end-exec c endsr OQSYSPRT E @Head 1 02 O @pgm 10 O *date y +2 O @Utime +2 ' : : ' O @Heading +10 O +5 'Page' O Page z +0 O E @Head 2 O 15 'Occurances' O +4 'Field Values' O E @Line 1 O @Count z 15 O @FieldDta +5 O E @Line_Num 1 O @Count z 15 O @FieldNum J +5 O E @Err01 1 O 26 '**************************' O 53 'Invalid Field - Terminated' O 80 '**************************' *ã********************************************************************************************