CL Using BIFs

Using Built-In-Functions

The scan built-in function (%SCAN) is designed to return the first position of a search argument in the source string, or 0 if the character(s) was not found. The %SCAN fucntion in the CL below is performing the search of a character variable. It is looking for specific characters to determine if the file extension indicates it must be decrypted. 

.
.
.
/*-------------------------------------------------------------------*/
/* Check the file name to determine if the file needs decrypting.    */
/*-------------------------------------------------------------------*/

             CHGVAR     VAR(&FILETYPE) VALUE(' ')

 JOBFILE:    IF         COND(%SCAN('.job' &FILEPATH) *NE 0 *OR +
                          %SCAN('.JOB' &FILEPATH) *NE 0) +
                          THEN(CHGVAR VAR(&FILETYPE) VALUE('J'))
             IF         COND(&FILETYPE *EQ 'J') THEN(GOTO +
                          CMDLBL(CALLS)) 
 Decrypt:
             IF         COND(%SCAN('.pgp' &FILEPATH) *NE 0 *OR +
                          %SCAN('.PGP' &FILEPATH) *NE 0) +
                          THEN(CHGVAR VAR(&FILETYPE) VALUE('P'))
             IF         COND(&FILETYPE *EQ 'P') THEN(GOTO +
                          CMDLBL(CALLS)) 
 UNZIP:
             IF         COND(%SCAN('.zip' &FILEPATH) *NE 0 *OR +
                          %SCAN('.ZIP' &FILEPATH) *NE 0) +
                          THEN(CHGVAR VAR(&FILETYPE) VALUE('Z'))

 gzZIP:
             IF         COND(%SCAN('.gz' &FILEPATH) *NE 0 *OR +
                          %SCAN('.GZ' &FILEPATH) *NE 0) +
                          THEN(CHGVAR VAR(&FILETYPE) VALUE('G'))
.
.
.


The scan below performs much the same task. The difference is prefacing the scan operation with the %UPPER function. This guarantees the character string will be all uppercase characters. 

.
.
.
/*-------------------------------------------------------------------*/
/* Determine the file type from the file name. Check to see if       */
/* the file is a PDF-type file.                                      */
/*-------------------------------------------------------------------*/
             CHGVAR     VAR(&FILEPATH) VALUE(%UPPER(&FILEPATH))

             IF         COND(%SCAN('.PDF' &FILEPATH) *EQ 0) +
                          THEN(CALLSUBR SUBR(UPLOADDTA))

             ENDDO
.
.
.


The &TRIMR function works similar to the *TCAT operation in previous releases of CL. The *TCAT (or |<) operator trims trailing blanks from the first string before appending the second string. 

.
.
.
/*-------------------------------------------------------------------*/
/* If a document was produced, copy the file to the export folder    */
/*-------------------------------------------------------------------*/
             RTVMBRD    FILE(QTEMP/&FILENAME) NBRCURRCD(&RCD)
             IF         COND(&RCD *EQ 0) THEN(GOTO CMDLBL(EXIT))
             CHGVAR     VAR(&EXPFILE) VALUE(&EXPFOLDER *TCAT &PRE +
                          *TCAT &CMP *CAT &ORDER *TCAT '.xml')

             CPYTOIMPF  FROMFILE(QTEMP/&FILENAME) TOSTMF(&EXPFILE) +
                          MBROPT(*REPLACE) STMFCODPAG(*PCASCII) +
                          RCDDLM(*CRLF) DTAFMT(*FIXED)
EXIT:
             DLTF       FILE(QTEMP/&FILENAME)
             MONMSG     MSGID(CPF0000)
UNLOCK:
             CHKIFSOBJ  PATHFILE(&CHKOBJECT) FOUND(&FOUND)
             IF         COND(&FOUND) THEN(DO)
             DEL        OBJLNK(&CHKOBJECT)
             MONMSG     MSGID(CPFA0A9 CPFA095)
             ENDDO

     RETURN

/*-------------------------------------------------------------------*/
/* Lock subroutine, check to see if the folder is locked before      */
/* putting files into the directory.                                 */
/*-------------------------------------------------------------------*/
             SUBR       SUBR(LOCKDIR)
             CALL       PGM(ADM005RP) PARM('ADMGV001' 'DIR' &RETURN)
             CHGVAR     VAR(&INDIR) VALUE(&RETURN)

             CALL       PGM(ADM005RP) PARM('ADMGV001' 'FIL' &RETURN)
             CHGVAR     VAR(&INFILE) VALUE(&RETURN)

             CHGVAR     VAR(&INPROCESS) VALUE(&INDIR *TCAT &INFILE)
             CHGVAR     VAR(&CHKOBJECT) VALUE(&EXPFOLDER *TCAT '/' +
                          *TCAT &INFILE)
.
.
.