      SUBROUTINE PLZ.SUB(SRC,I.FLG,APP.SRC,R.ERR)
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
*
******************************************************************************
******************************************************************************
***                                                                        ***
*** (C) Copyright 1990-2005 Doug Dumitru, All Rights Reserved.             ***
***                                                                        ***
*** This program is licensed under the terms of the GNU General Public     ***
*** License, version 2.0 with attached notices.                            ***
***                                                                        ***
*** The full text can be found in the LICENSE.TXT file in the              ***
*** PLIP.BP database file (the /usr/qmweb/PLIP.BP/PLIP.BP directory).      ***
***                                                                        ***
******************************************************************************
******************************************************************************
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
*
      INCLUDE PLZ.COMMON
*
      RELEASE
*$*   PRINT
*
      CALL PLIP.INIT.SUB
*
      OPEN 'PLIP.BP,TEMPLATES' TO BP.FD ELSE CALL PLXX.STOP(201,'PLIP.BP,TEMPLATES')
*
      CALL PLZ.PARSE.FILENAME(SRC,TP,P1,P2)
*
      R.ERR = ''
*
      IF P2 = '' OR INDEX(P2,AM,1) THEN
         R.ERR = 'Invalid parse name ' : P2
         RETURN
      END
*
      BEGIN CASE
         CASE TP = 'FILE'
*$*         OPEN P1 TO DST.FD ELSE CALL PLXX.STOP(201,P1)
            SRC.PATH = 'FILE ' : P1 : ' ' : P2
            IF SRC.FILE = '' THEN SRC.FILE = P1
         CASE TP = 'HOST'
            SRC.PATH = 'HOST ' : P2
      END CASE
*
      CALL PLU.READ.FILE(SRC.PATH,'A',APP.SRC)
      IF APP.SRC = '' THEN
         R.ERR = 'Error reading application source module.'
         RETURN
      END
*
      IF I.FLG THEN
         I0 = 1
      END ELSE
         I0 = 2
*
         L = TRIM(APP.SRC<1>)
         CMD = FIELD(L,' ',1)
         W = OCONV(L,'G1 999')
         BEGIN CASE
            CASE CMD = '_PROGRAM'
               APP.FILE = FIELD(W,' ',1)
               APP.NAME = FIELD(W,' ',2)
               A.NAME = APP.NAME : '.HTM'
               OPEN APP.FILE TO DST.FD ELSE CALL PLXX.STOP(201,APP.FILE)
               APP.SRC<1> = '*__* ' : L
               PRINT 'Generating PROGRAM ' : APP.FILE : ' ' : APP.NAME
               SUB.FLG = NO
               S.RTN  = ''
               S.CALL = ''
            CASE CMD = '_SUBROUTINE'
               APP.FILE = FIELD(W,' ',1)
               APP.NAME = FIELD(W,' ',2)
               A.NAME = '$' : APP.NAME : '.HTM'
               OPEN APP.FILE TO DST.FD ELSE CALL PLXX.STOP(201,APP.FILE)
               APP.SRC<1> = '*__* ' : L
*    
               SUB.PARMS = FIELD(W,' ',3)
               S.RTN  = ''
               S.CALL = ''
               N = 490
               I1 = DCOUNT(SUB.PARMS,',')
               FOR I = 1 TO I1
                  S.RTN<-1>  = '      USER.COMMON(' : N : ') = ' : FIELD(SUB.PARMS,',',I)
                  S.CALL<-1> = '      ' : FIELD(SUB.PARMS,',',I) : ' = USER.COMMON(' : N : ')'
                  SUB.VARS<-1> = FIELD(SUB.PARMS,',',I)
                  N = N - 1
               NEXT I
*
               PRINT 'Generating SUBROUTINE ' : APP.FILE : ' ' : APP.NAME
               SUB.FLG = YES
            CASE YES
               R.ERR = 'Source code must be an _PROGRAM or _SUBROUTINE.'
               RETURN
         END CASE
         PRINT
      END
*
      I1 = DCOUNT(APP.SRC,AM)
      FOR I = I0 TO I1
         CALL PLZ.1(APP.SRC<I>,O,R.ERR)
         IF R.ERR <> '' THEN RETURN
         IF O <> '' THEN
            APP.SRC<I> = O
         END
      NEXT I
*
      RETURN
   END
