High Voltage Shareware/high1.zip/high1/DIR2/CLATPL.ZIP/CLARION1.TPX

Text File | 1993-07-26 | 13KB | 372 lines

#!------------------------------------------------------------------------------
#!
#!      CLARION1.TPX
#!
#!      Batch     Sequential record processing of a file.
#!      External  Document external procedure call
#!      Print     Print a report from memory
#!      Screen    Process a screen
#!      Source    Process embedded source
#!      ToDo      Return immediately (for incomplete procedures)
#!
#!------------------------------------------------------------------------------
#!
#PROCEDURE(Batch,'Update or delete a batch of records'),SCREEN
#!------------------------------------------------------------------------------
#!
#!                           The Batch Template
#!
#!------------------------------------------------------------------------------
#PROTOTYPE('')
#INSERT(%StandardHeader)
#DISPLAY(' ')
#PROMPT('Range &Limit Field',FIELD),%KeyRangeField
#PROMPT('Range &Value Field',FIELD),%RangeValue
#PROMPT('Record Filter',@S180),%RecordFilter
#PROMPT('Action for Batch',OPTION),%BatchAction
#PROMPT('Change',RADIO)
#PROMPT('Delete',RADIO)
#PROMPT('No Action',RADIO)
#PROMPT('Sho&w Record Counter',CHECK),%RecordCounter

%Procedure       %ProcedureType

#INSERT(%CloseFilesFlags)
#IF(%RecordCounter)
RecordCounter    LONG
#ENDIF
%LocalData
%ScreenStructure
%PulldownStructure
#EMBED('Data Section')

  CODE
  #FIX(%File,%Primary)
  #EMBED('Setup Procedure')
  #IF(%BatchAction = 'Change')
    #SET(%BatchTitleString, ('Updating '& %Primary & ' Records'))
  #ELSIF(%BatchAction = 'Delete')
    #SET(%BatchTitleString, ('Deleting '& %Primary & ' Records'))
  #ELSE
    #SET(%BatchTitleString, ('Processing '& %Primary & ' Records'))
  #ENDIF
  ScreenTitle = CENTER('%BatchTitleString',LEN(ScreenTitle)) #<!Assign title
  StatusString = CENTER('Select Ok to Process Records',LEN(StatusString))
  OPEN(Screen)                                   !Open the screen
  #IF(%PullDownStructure)
  OPEN(%PullDown)                              #<!Open the pulldown menu
  #ENDIF
  DISPLAY
  #EMBED('Setup Screen')
  #INSERT(%OpenPrimary)
  #INSERT(%OpenSecondaryFiles)
  LOOP
    CASE SELECTED()                            #<!Jump to field setup routine
    #INSERT(%ScreenSetupRoutines)
    END                                        #<!End CASE
    ACCEPT                                     #<!Enable the mouse and keyboard
    #FOR(%HotKey)
    CASE KEYCODE()
      #FOR(%HotKey)
    OF %HotKey                                 #<!User defined HotKey
      %HotKeyProc                              #<!HotKey Procedure
      #ENDFOR
    END
      #BREAK
    #ENDFOR
    CASE FIELD()                               #<!Jump to field edit routine

    OF ?Ok                                       !On the OK button
  #FOR(%ScreenField)
    #IF(%ScreenFieldUse = '?Ok')
      #IF(%ScreenFieldEdit)
      %ScreenFieldEdit                           #<!Field Edit procedure
      #ENDIF
    #ENDIF
  #ENDFOR
      BREAK

    OF ?Cancel                                   !On Cancel button
  #FOR(%ScreenField)
    #IF(%ScreenFieldUse = '?Cancel')
      #IF(%ScreenFieldEdit)
      %ScreenFieldEdit                           #<!Field Edit procedure
      #ENDIF
    #ENDIF
  #ENDFOR
  #IF(%PullDownStructure)
      CLOSE(%PullDown)                         #<!Close the Pulldown Menu
  #ENDIF
      RETURN

  #FOR(%ScreenField)
    #IF(%ScreenFieldUse <> '?Cancel')
      #IF(%ScreenFieldUse <> '?Ok')
        #IF(%ScreenFieldEdit)
    OF %ScreenField                            #<!Edit %ScreenEditField field
      %ScreenFieldEdit
        #ENDIF
      #ENDIF
    #ENDIF
  #ENDFOR
    #INSERT(%PullDownEditRoutines)
    END                                        #<!End CASE
  END                                          #<!End LOOP
  DISABLE(?Ok)                                 #<!Disable the Ok and
  DISABLE(?Cancel)                             #<! cancel buttons
  #IF(%KeyRangeField)
  %KeyRangeField = %RangeValue                 #<!Fill the range fields
  #ENDIF
  #EMBED('Before file SET()')
  #INSERT(%BatchSetOrder)
  #IF(%RecordCounter = %Null)
    #IF(%BatchAction = 'Delete')
      #SET(%ActionString, 'Deleting')
    #ELSIF(%BatchAction = 'Change')
      #SET(%ActionString, 'Changing')
    #ENDIF
  StatusString = CENTER('%ActionString Records',LEN(StatusString))
  #ELSE
  RecordCounter = 0
  #ENDIF
  #EMBED('Before LOOP')
  DISPLAY
  LOOP
    NEXT(%Primary)
    #EMBED('NEXT Record Error Check')
    #INSERT(%FilterRecord)
    #INSERT(%GetSecondaryRecords)               #!Get lookup records
    #FOR(%Formula)
      #IF(UPPER(%FormulaClass) <> 'FILTER')
    #INSERT(%GenerateFormula)
      #ENDIF
    #ENDFOR
    #EMBED('Within LOOP')
  #IF(%BatchAction = 'Delete')
    DELETE(%Primary)
  #ELSIF(%BatchAction = 'Change')
    PUT(%Primary)
  #ENDIF
    #EMBED('PUT/DELETE Record Error Check')
    #INSERT(%DisplayCounter)
  END
  #IF(%PullDownStructure)
  CLOSE(%PullDown)                             #<!Close the Pulldown Menu
  #ENDIF
  #INSERT(%CloseOpenedFiles)
#EMBED('End of Procedure')
#!
#!***************************************************************************
#GROUP(%DisplayCounter)                          #!Display record counter.
  #IF(%RecordCounter)
RecordCounter += 1
    #IF(%BatchAction = 'Delete')
      #SET(%ActionString, 'Deleted')
    #ELSE
      #SET(%ActionString, 'Changed')
    #ENDIF
StatusString = CENTER(RecordCounter & ' Records %ActionString',LEN(StatusString))
DISPLAY(?StatusString)
  #ENDIF
#!
#!***************************************************************************
#GROUP(%BatchSetOrder)                           #! Issue SET() command.
#IF(%KeyRangeField)
SET(%PrimaryKey,%PrimaryKey)
#ELSIF(%PrimaryKey)
SET(%PrimaryKey)
#ELSE
SET(%Primary)
#ENDIF
#!
#!***************************************************************************
#GROUP(%FilterRecord)                           #! Filter a record
#IF(%KeyRangeField)                             #!
IF %KeyRangeField <> %RangeValue               #<!If not in Range
  BREAK                                        #<!  Break out of the LOOP
END                                            #<!End IF
#ENDIF
#IF(%RecordFilter)
IF ~(%RecordFilter)                            #<!If Filter condition not met
  CYCLE                                        #<! Return to top of the LOOP
END                                            #<!End IF
#ELSE
  #FOR(%Formula)
    #IF(UPPER(%FormulaClass) = 'FILTER')
      #IF(%FormulaType <> 'COMPUTED')
IF ~(%FormulaCondition)                        #<!If Filter condition not met
  CYCLE                                        #<! Return to top of the LOOP
END                                            #<!End IF
      #ELSE
IF ~(%FormulaComputation)                      #<!If Filter condition not met
  CYCLE                                        #<! Return to top of the LOOP
END                                            #<!End IF
      #ENDIF
      #BREAK
    #ENDIF
  #ENDFOR
#ENDIF
#!
#PROCEDURE(TODO,'Return immediately (for incomplete procedures)')
#!------------------------------------------------------------------------------
#!
#!                            The ToDo Template
#!
#!        The Todo Template generates code for all procedures
#!        which may be called, but which have not yet been designed.
#!
#!        This template is reqired and must not be removed.
#!
#!------------------------------------------------------------------------------
%Procedure       PROCEDURE
   CODE
   GLO:Message2 = 'Procedure Not Yet Defined'
   ShowWarning
   RETURN                                      #<!Return to caller
#!
#PROCEDURE(External,'Document external procedure call')
#!------------------------------------------------------------------------------
#!
#!                         The External Template
#!
#!        This template allows the redefinition of a Todo procedure
#!        for any external procedures which may be called.
#!        This allows you to specify that this particular procedure
#!        is not a Todo procedure and no Todo code will be generated.
#!
#!        There is no source code for this procedure.  See the template
#!        help for more information.
#!
#!------------------------------------------------------------------------------
#!
#PROCEDURE(Source,'Process embedded source code')
#!------------------------------------------------------------------------------
#!
#!                           The Source Template
#!
#!      All source statements, except the PROCEDURE (or FUNCTION)
#!      and CODE statements must be entered as embedded source.
#!
#!------------------------------------------------------------------------------
#INSERT(%StandardHeader)
#PROMPT('Parameter List',@S100),%ParameterList

%Procedure       %ProcedureType%ParameterList

%LocalData
#EMBED('Data Section')
  CODE
#EMBED('All Executable Source Code')
#!
#PROCEDURE(Screen,'Process a screen'),SCREEN,PULLDOWN
#!------------------------------------------------------------------------------
#!
#!                           The Screen Template
#!
#!------------------------------------------------------------------------------
#PROTOTYPE('')
#INSERT(%StandardHeader)
%Procedure       PROCEDURE
#FIX(%File,%Primary)
%LocalData
%ScreenStructure
%PulldownStructure
#EMBED('Data Section')

  CODE
  #EMBED('Setup Procedure')
  OPEN(Screen)                                 #<!Open the screen
  #IF(%PullDownStructure)
  OPEN(%PullDown)                              #<!Open the pulldown menu
  #ENDIF
  #EMBED('Setup Screen')
  LOOP                                         #<!Loop through the fields
    #INSERT(%GenerateFormulas)
    #EMBED('Top of Accept Loop')
    CASE SELECTED()                            #<!Jump to field setup routine
    #INSERT(%ScreenSetupRoutines)
    END                                        #<!End CASE
    ACCEPT                                     #<!Enable the mouse and keyboard
    #FOR(%HotKey)
    CASE KEYCODE()
      #FOR(%HotKey)
    OF %HotKey                                 #<!User defined HotKey
      %HotKeyProc                              #<!HotKey Procedure
      #ENDFOR
    END
      #BREAK
    #ENDFOR
    CASE FIELD()                               #<!Jump to field edit routine
    #INSERT(%ScreenEditRoutines)
    #INSERT(%PullDownEditRoutines)
    END                                        #<!End CASE
  END                                          #<!End LOOP
  #IF(%PullDownStructure)
  CLOSE(%PullDown)                             #<!Close the Pulldown Menu
  #ENDIF
#EMBED('End of Procedure')
#!
#PROCEDURE(Print,'Print a report from memory'),REPORT
#!------------------------------------------------------------------------------
#!
#!                           The Print Template
#!
#!   This procedure template is designed to print a report from the data
#!   currently in memory.  It does not access any files, does not calculate
#!   any totals, and does not support any group breaks.  It does support
#!   Formula fields, calculated once before printing anything.
#!
#!------------------------------------------------------------------------------
#PROTOTYPE('')
#INSERT(%StandardHeader)
%Procedure       PROCEDURE                     #<!%ProcedureDescription

%LocalData
%ReportStructure
#EMBED('Data Section')

  CODE
  #IF(%ReportLabel)
    #SET(%ErrorMessage,(%Procedure & ' ERROR:'))
    #ERROR(%ErrorMessage)
    #ERROR('  Multi-Up Labels must use the REPORT Template')
  #ENDIF
  #EMBED('Setup Procedure')
  OPEN(%Report)                                #<!Prepare to print report
  #EMBED('After Report OPEN before Formulas')
  #FOR(%Formula)                                #!All computed fields before
    #IF(%FormulaType = 'COMPUTED')              #! conditional fields
  %Formula = %FormulaComputation               #<!%FormulaDesription
    #ENDIF
  #ENDFOR
  #FOR(%Formula)                                #!All computed fields before
    #IF(%FormulaType = 'CONDITION')             #! conditional fields
  IF %FormulaCondition                         #<!%FormulaDesription
    %Formula = %FormulaTrue                    #<!If true
  ELSE
    %Formula = %FormulaFalse                   #<!If false
  END
    #ENDIF
  #ENDFOR
  #EMBED('After Formulas before Title page')
  #IF(%ReportTitle)                             #!Print Title Page
  PRINT(%ReportPre:%ReportTitle)               #<!Print Title Page
  #ENDIF
  %ReportDetailPre
  #IF(%ReportDetail)
  PRINT(%ReportPre:%ReportDetail)              #<!Print Detail band
  #ENDIF
  %ReportDetailPost
  #IF(%ReportGrand)                             #!Print grand totals band
  PRINT(%ReportPre:%ReportGrand)               #<!Print grand totals band
  #ENDIF
  #EMBED('After Grand Totals before Final Page')
  #IF(%ReportFinal)                             #!Print final page
  PRINT(%ReportPre:%ReportFinal)               #<!Print final page
  #ENDIF
  #EMBED('After Final Page before CLOSE')
  CLOSE(%Report)
#EMBED('End of Procedure')
#!
#CHAIN('CLARION2.TPX')