home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / clarion / ppstpx.zip / OM7.TPX < prev    next >
Text File  |  1993-06-08  |  54KB  |  1,258 lines
  1. #!------------------------------------------------------------------------------
  2. #!
  3. #!      OM7.TPX
  4. #!
  5. #!      Report    Print a report from a file
  6. #!
  7. #!------------------------------------------------------------------------------
  8. #!
  9. #PROCEDURE(Report,'Print a Report'),REPORT,SCREEN
  10. #!------------------------------------------------------------------------------
  11. #!
  12. #!                           The Report Template
  13. #!
  14. #!   This procedure template is designed to print most reports an application
  15. #!   may require.  Secondary file relationships (1:MANY) are handled by the
  16. #!   %RptGetRelatedRecords #GROUP code, which recurses through as many levels
  17. #!   of 1:MANY relationships as are defined in the File Schematic, starting
  18. #!   with the Primary file, going down the chain of Secondary files beginning
  19. #!   with the first Child file of the Primary.  Any other Child files of the
  20. #!   Primary file begin a second 1:MANY file chain -- this is not supported.
  21. #!
  22. #!   The MANY:1 (lookup) relationships go only one level below the file it is
  23. #!   related to, for every 1:MANY (Parent-Child) relationship at each level (a
  24. #!   lookup file may not generate a second lookup from it -- write embedded
  25. #!   source code for this).
  26. #!
  27. #!   This File Schematic is directly supported:
  28. #!      Primary
  29. #!       └──Secondary (Lookup MANY:1 from Primary)
  30. #!       └──Secondary (Lookup MANY:1 from Primary)
  31. #!       └─Secondary (Child File of Primary)
  32. #!          └──Secondary (Lookup MANY:1 from Secondary Child)
  33. #!          └──Secondary (Lookup MANY:1 from Secondary Child)
  34. #!          └─Secondary (Child File of Secondary Child)
  35. #!             └──Secondary (Lookup MANY:1 from Secondary Child)
  36. #!
  37. #!   This File Schematic is NOT directly supported:
  38. #!      Primary
  39. #!       └──Secondary (Lookup File from Primary)
  40. #!       │  └─Secondary (Child of Lookup File) -- NO Children of Lookups
  41. #!       └─Secondary (Child File of Primary)
  42. #!       │  └──Secondary (Lookup File from Secondary Child)
  43. #!       │     └──Secondary (Lookup File from Lookup File) -- NO 2nd Lookups
  44. #!       └─Secondary (Another Child File of Primary) -- NO 2nd Child chains
  45. #!
  46. #!   Formula Classes supported are:
  47. #!     The prefix of a Parent or Child file with :FILTER appended (Pre:FILTER).
  48. #!       Creates a record filter to skip records in which the filter
  49. #!       expression does not evaluate as true, just after the file's record
  50. #!       is read.
  51. #!     The name of a Parent or Child file (not a Lookup file).
  52. #!       Calculates the formula after each read from the file -- this is
  53. #!       immediately after any Pre:FILTER is evaluated.
  54. #!     No class --
  55. #!       Calculates the formula every time a record is read from any file.
  56. #!
  57. #!   Multi-Up labels are supported -- they must be in the Body Detail band.
  58. #!   Group Breaks are supported -- up to four per file (Primary or Child
  59. #!   Secondary -- not on Lookups).
  60. #!
  61. #!------------------------------------------------------------------------------
  62. #PROTOTYPE('')
  63. #DISPLAY(' ')
  64. #PROMPT('Enable ESC Key Abort',CHECK),%EscapeAbort
  65. #PROMPT('Show Report Progress',CHECK),%ProgressScreen
  66. #PROMPT('Primary File &Access',OPTION),%AccessMethod
  67. #PROMPT('Keyed Order',RADIO)
  68. #PROMPT('Record Order',RADIO)
  69. #PROMPT('Range &Limit Field',COMPONENT),%KeyComponent
  70. #PROMPT('Range &Value Field',FIELD),%ScopeValue
  71. #PROMPT('Red&irect Procedure',PROCEDURE),%RedirectProc
  72. #PROMPT('View Procedure',PROCEDURE),%ViewProc
  73. #INSERT(%RptSetMultiples)
  74. #INSERT(%ReportErrorCheck)
  75. #INSERT(%StandardHeader)
  76.  
  77. %Procedure       PROCEDURE
  78.  
  79. #INSERT(%LocalPPSVariables)                    #<! Declare Variables PPS
  80.  
  81. %LocalData
  82.  
  83. #INSERT(%ReportDataDeclares)                    #!Internal data declarations
  84.   #IF(%ProgressScreen)
  85.  
  86. %ScreenStructure
  87.   #ENDIF
  88.  
  89. %ReportStructure
  90.  
  91. #EMBED('Data Section')
  92.  
  93.   CODE
  94.   ProcedureName = '%Procedure'                 #<!Fill ProcedureName var. PPS
  95.   #EMBED('Setup Procedure')
  96.   #INSERT(%OpenPrimary)                         #!Open primary
  97.   #INSERT(%OpenSecondaryFiles)                  #! and all secondary files
  98.   #IF(%RedirectProc)                            #!Runtime report redirection
  99.   %RedirectProc                                #<!Call redirection procedure
  100.   CASE GLO:FileSpec                              !Detect redirection selection
  101.   OF 'CANCEL'                                    !Cancel report requested
  102.     RETURN
  103.     #IF(%ViewProc)
  104.   OF 'SCREEN'                                    !Screen view requested
  105.     Temp" = COMMAND('CLATMP',0)                  !Get temporary file directory
  106.     IF NOT Temp"                                 !None set?
  107.       Temp" = 'TempRpt.$$$'                      !Assign temporary filename
  108.     ELSIF SUB(CLIP(Temp"),-1,1) = '\'
  109.       Temp" = CLIP(Temp") & 'TempRpt.$$$'        !Assign temporary filename
  110.     ELSE
  111.       Temp" = CLIP(Temp") & '\' & 'TempRpt.$$$'  !Assign temporary filename
  112.     END
  113.     ReportDevice = Temp"
  114.     GLO:FileSpec = Temp"
  115.     #ELSE                                       #!Redirect w/o View Proc
  116.   OF 'SCREEN'                                    !Screen view requested
  117.     RETURN                                       ! w/o View Procedure
  118.     #ENDIF
  119.   ELSE                                           !All other report devices
  120.     ReportDevice = GLO:FileSpec                  ! go to the device
  121.     Temp" = SUB(LEFT(UPPER(GLO:FileSpec)),1,3)   !Get first three characters
  122.     IF (Temp" = 'LPT' OR Temp" = 'COM') AND NUMERIC(SUB(LEFT(GLO:FileSpec),4,1))
  123.       IF Temp" = 'LPT' and NOT STATUS(GLO:FileSpec) !Check printer status
  124.         GLO:Message1 = 'The Printer is Off-Line!'
  125.         GLO:Message2 = 'Please correct this situation'
  126.         ShowWarning                              !Notify the user if off-line
  127.         RETURN
  128.       END
  129.       GLO:FileSpec = ''                          !Disable viewing
  130.     END
  131.   END
  132.   #ELSIF(%ViewProc)                             #!View w/o Redirect Proc
  133.   Temp" = SUB(LEFT(UPPER(%ReportDevice)),1,3)  #<!Get first three characters
  134.   IF (Temp" = 'LPT' OR Temp" = 'COM') AND NUMERIC(SUB(LEFT(%ReportDevice),4,1))
  135.     IF Temp" = 'LPT' and NOT STATUS(%ReportDevice) #<!Check printer status
  136.       GLO:Message1 = 'The Printer is Off-Line!'
  137.       GLO:Message2 = 'Please correct this situation'
  138.       ShowWarning                                !Notify the user if off-line
  139.       RETURN
  140.     END
  141.     GLO:FileSpec = ''                            !Disable viewing
  142.   ELSE
  143.     GLO:FileSpec = ReportDevice                  !Set up filename for %ViewProc
  144.   END                                            ! port selections
  145.   #ELSE                                         #!No View or Redirect Proc
  146.   Temp" = SUB(LEFT(UPPER(%ReportDevice)),1,3)  #<!Get first three characters
  147.   IF (Temp" = 'LPT' OR Temp" = 'COM') AND NUMERIC(SUB(LEFT(%ReportDevice),4,1))
  148.     IF Temp" = 'LPT' and NOT STATUS(%ReportDevice) #<!Check printer status
  149.       GLO:Message1 = 'The Printer is Off-Line!'
  150.       GLO:Message2 = 'Please correct this situation'
  151.       ShowWarning                                !Notify the user if off-line
  152.       RETURN
  153.     END
  154.   END                                            ! port selections
  155.   #ENDIF
  156.   OPEN(%Report)                                #<!Prepare to print report
  157.   #EMBED('After Report OPEN before Title page')
  158.   #IF(%ReportTitle)                             #!Print Title Page
  159.   PRINT(%ReportPre:%ReportTitle)               #<!Print Title Page
  160.     #IF(%ProgressScreen)
  161.   DISPLAY                                      #<!Display report progress
  162.     #ENDIF
  163.   #ENDIF
  164.   #IF(%AccessMethod = 'Record Order')           #!Determine primary file order
  165.   SET(%Primary)                                #<!Top of file, record order
  166.   #ELSIF(%SelectorAccess)
  167.     #FIX(%File,%Primary)
  168.     #FIX(%Key,%PrimaryKey)
  169.     #IF(%KeyIndex = 'INDEX')
  170.       #IF(%SharedFiles)
  171.   LOCK(%Primary,1)                             #<!Exclusive access for build
  172.   IF DiskError('Cannot Lock %Primary ') THEN RETURN. !Check for lock error
  173.       #ENDIF
  174.   BUILD(%PrimaryKey)                           #<!Build the index first
  175.       #IF(%SharedFiles)
  176.   UNLOCK(%Primary)                             #<!Unlock locked file
  177.       #ENDIF
  178.     #ENDIF
  179.   %KeyComponent = %ScopeValue
  180.   #EMBED('Immediately before SET(key,key)')
  181.   SET(%PrimaryKey,%PrimaryKey)                 #<!Beginning of selected records
  182.   #ELSE
  183.     #FIX(%File,%Primary)
  184.     #FIX(%Key,%PrimaryKey)
  185.     #IF(%KeyIndex = 'INDEX')
  186.       #IF(%SharedFiles)
  187.   LOCK(%Primary,1)                             #<!Exclusive access for build
  188.   IF DiskError('Cannot Lock %Primary ') THEN RETURN. !Check for lock error
  189.       #ENDIF
  190.   BUILD(%PrimaryKey)                           #<!Built the index first
  191.       #IF(%SharedFiles)
  192.   UNLOCK(%Primary)                             #<!Unlock locked file
  193.       #ENDIF
  194.     #ENDIF
  195.   SET(%PrimaryKey)                             #<!Top of file, keyed order
  196.   #ENDIF
  197.   #IF(%ProgressScreen)
  198.   OPEN(Screen)
  199.   #ENDIF
  200.   #EMBED('Before primary LOOP after SET')
  201.   LOOP                                         #<!Primary file process loop
  202.     #EMBED('Top of primary LOOP')
  203.     NEXT(%Primary)                             #<!Get each %Primary record
  204.     IF ERRORCODE() THEN ErrEndFileFlag# = 1 ELSE ErrEndFileFlag# = 0. !Flag EOF
  205.     #EMBED('In primary LOOP immediately after NEXT')
  206.   #SET(%CurrentFile,%Primary)
  207.   #INSERT(%GroupBreakNumber)
  208.   #IF(%GroupCounter)
  209.     #FIX(%File,%Primary)
  210.     #SET(%CodePosition,(%FilePre&':FILTER'))
  211.     #INSERT(%RptRecordFilter)                   #!Generate record filter
  212.     #EMBED('In primary LOOP after Record Filter before Lookups')
  213.     #SET(%GetLookupFrom,%Primary)
  214.     #INSERT(%RptGetLookupRecords)               #!Get all Lookup records
  215.     #SET(%CodePosition,%Primary)                #!Class = primary file
  216.     #INSERT(%ReportFormulas)                    #!Generate formulas
  217.     #INSERT(%PrimaryFileGroupBrk)
  218.   #ELSE                                         #!No group break on this file
  219.     #IF(%SelectorAccess)                        #!If record selector
  220.     IF %KeyComponent <> %ScopeValue |          #<!Past selected records?
  221.        OR ErrEndFileFlag#                      #<!End of file? Terminate report
  222.       BREAK
  223.     END
  224.   #FIX(%File,%Primary)
  225.   #SET(%CodePosition,(%FilePre&':FILTER'))
  226.     #INSERT(%RptRecordFilter)                   #!Generate record filter
  227.     #EMBED('In primary LOOP after Record Filter before Lookups')
  228.       #SET(%GetLookupFrom,%Primary)
  229.     #INSERT(%RptGetLookupRecords)               #!Get all Lookup records
  230.       #SET(%CodePosition,%Primary)              #!Class = primary file
  231.     #INSERT(%ReportFormulas)                    #!Generate formulas
  232.     #ELSE                                       #!No record selector
  233.     IF ErrEndFileFlag# THEN BREAK.             #<!End of file? Terminate report
  234.       #FIX(%File,%Primary)
  235.       #SET(%CodePosition,(%FilePre&':FILTER'))
  236.     #INSERT(%RptRecordFilter)                   #!Generate record filter
  237.     #EMBED('In primary LOOP after Record Filter before Lookups')
  238.       #SET(%GetLookupFrom,%Primary)
  239.     #INSERT(%RptGetLookupRecords)               #!Get all Lookup records
  240.       #SET(%CodePosition,%Primary)              #!Class = primary file
  241.     #INSERT(%ReportFormulas)                    #!Generate formulas
  242.     #ENDIF
  243.   #ENDIF
  244.     #EMBED('In primary LOOP after Lookups')
  245.   #IF(%SecondaryExist)                          #!If there are secondary files
  246.     #SET(%GetRelatedTo,%Primary)
  247.     #INSERT(%RptGetRelatedRecords)
  248.   #ENDIF
  249.   #IF(%DetailPrinted <> 'PRINTED')              #!If detail print not generated
  250.     #INSERT(%PrintDetail)
  251.     #INSERT(%RptAbortKey)                       #!Insert ESC key abort loop
  252.   #ENDIF
  253.   END                                          #<!End %Primary file loop
  254.   #IF(%DetailPrinted <> 'PRINTED')              #!If detail print not generated
  255.     #IF(%ReportLabel)
  256.   IF SAV::LabelCounter <> 0                    #<!If any labels left to print
  257.     %ReportDetailPre
  258.     PRINT(%ReportPre:%ReportDetail)            #<!Print last line item detail
  259.       #IF(%ProgressScreen)
  260.     DISPLAY                                    #<!Display report progress
  261.       #ENDIF
  262.     %ReportDetailPost
  263.   END
  264.     #ENDIF
  265.   #ENDIF
  266.   #EMBED('After primary LOOP before grand totals & final page')
  267.   #IF(%ReportGrand)                             #!Print grand totals
  268.   PRINT(%ReportPre:%ReportGrand)               #<!Print grand totals
  269.     #IF(%ProgressScreen)
  270.   DISPLAY                                      #<!Display report progress
  271.     #ENDIF
  272.   #ENDIF
  273.   #IF(%ReportFinal)                             #!Print final page
  274.   PRINT(%ReportPre:%ReportFinal)               #<!Print final page
  275.     #IF(%ProgressScreen)
  276.   DISPLAY                                      #<!Display report progress
  277.     #ENDIF
  278.   #ENDIF
  279.   #SET(%ResetTotalType,'NONE')                  #!Reset report totals
  280.   #INSERT(%ResetTotals)
  281.   CLOSE(%Report)                               #<!Close report
  282.   #IF(%ProgressScreen)
  283.   CLOSE(Screen)                                #<!Close report progress screen
  284.   #ENDIF
  285.   #IF(%ViewProc)
  286.   %ViewProc                                    #<!Call View Procedure
  287.   #ENDIF
  288. #EMBED('End of Procedure')
  289. #INSERT(%FileMgrExit)                          #!Insert File Manager Exit PPS
  290. #INSERT(%TotalRoutines)                         #!Total tallys and resets
  291. #INSERT(%SaveFooterRoutine)                     #!Footer save field saves
  292. #INSERT(%PrintFooterRoutine)                    #!Footer save field saves
  293. #INSERT(%RestoreFooterRoutine)                  #!Footer save field saves
  294.  
  295. #!***************************************************************************
  296. #GROUP(%ReportDataDeclares)                     #!Internal data declarations
  297.   #FOR(%ReportGroup)                            #!Group break fields
  298.     #IF(%ReportGroup <> %KeyComponent)          #!Group break fields
  299. SAV::%ReportGroup LIKE(%ReportGroup)           #<!Group break save
  300.     #ENDIF
  301.   #ENDFOR
  302.   #SET(%Counter1,%NULL)
  303.   #FOR(%ReportTotal)                            #!AVERAGE total fields
  304.     #SET(%Counter1,(%Counter1 + 1))
  305.     #IF(%ReportTotalType = 'AVERAGE')
  306.       #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element
  307.         #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1)))
  308. %ReportTotal::Cnt::%ArrayField::%Counter1 LONG !Average total count
  309. %ReportTotal::Sum::%ArrayField::%Counter1 REAL !Average total sum
  310.       #ELSE
  311. %ReportTotal::Cnt::%ReportTotalField LONG      #<!Average total count
  312. %ReportTotal::Sum::%ReportTotalField REAL !Average total sum
  313.       #ENDIF
  314.     #ENDIF
  315.   #ENDFOR
  316.   #SET(%SaveFilesQueue,%NULL)
  317.   #FOR(%ReportSave)                             #!Build list of the files
  318.     #FOR(%ReportSaveField)                      #! of footer save fields
  319.       #SET(%Temp,(SUB(%ReportSaveField,1,INSTRING(':',%ReportSaveField,1,1)-1)))
  320.       #IF(NOT INSTRING(UPPER(%Temp),%SaveFilesQueue,1,1))
  321.         #SET(%SaveFilesQueue,(%SaveFilesQueue & UPPER(%Temp) & ','))
  322.       #ENDIF
  323.     #ENDFOR
  324.   #ENDFOR
  325.   #SET(%Counter1,%NULL)
  326.   #SET(%Counter2,%NULL)
  327.   #FOR(%ReportSave)                             #!Footer save fields
  328.     #SET(%Counter1,(%Counter1 + 1))
  329.     #FOR(%ReportSaveField)
  330.       #SET(%Counter2,(%Counter2 + 1))
  331.       #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element
  332.         #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1)))
  333.         #SET(%BreakField,%ReportSaveField)
  334.         #INSERT(%RptFindFile)
  335.         #FIX(%File,%FoundFile)
  336.         #FIX(%Field,%ArrayField)
  337.         #IF(%FieldType = 'STRING' OR %FieldType = 'CSTRING' OR %FieldType = 'PSTRING')
  338. SAV1::%ReportSave::%Field::%Counter1::%Counter2 STRING(SIZE(%ReportSaveField)),AUTO #<!%ReportSave Footer save field
  339. SAV2::%ReportSave::%Field::%Counter1::%Counter2 STRING(SIZE(%ReportSaveField)),AUTO #<!%ReportSave Footer save field
  340.         #ELSE
  341. SAV1::%ReportSave::%Field::%Counter1::%Counter2 REAL,AUTO #<!%ReportSave Footer save field
  342. SAV2::%ReportSave::%Field::%Counter1::%Counter2 REAL,AUTO #<!%ReportSave Footer save field
  343.         #ENDIF
  344.       #ELSE
  345. SAV1::%ReportSave::%ReportSaveField LIKE(%ReportSaveField),AUTO #<!%ReportSave Footer save field
  346. SAV2::%ReportSave::%ReportSaveField LIKE(%ReportSaveField),AUTO #<!%ReportSave Footer save field
  347.       #ENDIF
  348.     #ENDFOR
  349.   #ENDFOR
  350.   #FOR(%ReportTotal)                            #!Detect any PAGE total fields
  351.     #IF(%ReportTotalReset = 'PAGE')
  352.       #SET(%PageTotals,'YES')                   #!Set flag
  353.       #BREAK
  354.     #ELSIF(%ReportTotalTally = 'PAGE')
  355.       #SET(%PageTotals,'YES')                   #!Set flag
  356.       #BREAK
  357.     #ENDIF
  358.   #ENDFOR
  359.   #IF(%PageTotals = 'YES')
  360. SAV::LineCounter SHORT                         #<!Line counter save
  361.   #ENDIF
  362.   #IF(%SelectorAccess)                          #!Record selector save
  363. SAV::%KeyComponent LIKE(%KeyComponent)         #<!Record selector save
  364.   #ENDIF
  365.   #IF(%ReportLabel)                             #!Multi-up label USE variables
  366. SAV::LabelCounter BYTE                         #<!Multi-up label counter
  367.     #SET(%Counter1,%NULL)
  368.     #FOR(%ReportLabelField)
  369.       #SET(%Counter1,(%Counter1 + 1))
  370.       #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element
  371.         #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1)))
  372.         #SET(%BreakField,%ReportLabelField)
  373.         #INSERT(%RptFindFile)
  374.         #FIX(%File,%FoundFile)
  375.         #FIX(%Field,%ArrayField)
  376.         #IF(%FieldType = 'STRING' OR %FieldType = 'CSTRING' OR %FieldType = 'PSTRING')
  377. LBL::%ArrayField::%Counter1 STRING(SIZE(%ReportLabelField)),DIM(%ReportLabel) #<!Multi-up label USE variables
  378.         #ELSE
  379. LBL::%ArrayField::%Counter1 REAL,DIM(%ReportLabel) #<!Multi-up label USE variables
  380.         #ENDIF
  381.       #ELSE
  382. LBL::%ReportLabelField LIKE(%ReportLabelField),DIM(%ReportLabel) #<!Multi-up label USE variables
  383.       #ENDIF
  384.     #ENDFOR
  385.   #ENDIF
  386. #!
  387. #!***************************************************************************
  388. #GROUP(%RptGetLookupRecords)                    #!Get all lookup records
  389.   #FOR(%Secondary)                              #!%GetLookupFrom must be set
  390.     #IF(%SecondaryTo = %GetLookupFrom)          #! before #INSERT of this group
  391.       #IF(%SecondaryType = 'MANY:1')            #!Check for Lookup files
  392.         #FIX(%File,%SecondaryTo)
  393.         #FIX(%Relation,%Secondary)
  394.         #FOR(%RelationKeyField)
  395. %RelationKeyField = %RelationKeyFieldLink      #<!Assign linking field value
  396.         #ENDFOR
  397. GET(%Secondary,%RelationKey)                   #<!Lookup record
  398.         #FIX(%File,%Secondary)
  399. IF ERRORCODE() THEN CLEAR(%FilePre:Record).    #<!Clear record if unsuccessful
  400.         #SET(%SaveFile,%Secondary)                #!Check for footer save fields
  401. #INSERT(%SaveFooterFields)
  402.       #ENDIF
  403.     #ENDIF
  404.   #ENDFOR
  405. #!
  406. #!***************************************************************************
  407. #GROUP(%RptGetRelatedRecords)                   #!Get all related records
  408.   #FOR(%Secondary)                              #!%GetRelatedTo must be set
  409.     #IF(%SecondaryTo = %GetRelatedTo)           #! before #INSERT of this group
  410.       #IF(%SecondaryType = '1:MANY')            #!Check for children files
  411.         #FIX(%File,%SecondaryTo)
  412.         #FIX(%Relation,%Secondary)
  413.         #FOR(%RelationKeyField)
  414.           #IF(%RelationKeyFieldLink)
  415. %RelationKeyField = %RelationKeyFieldLink      #<!Assign linking field value
  416.             #SET(%RelateBreakField,%RelationKeyField)
  417.             #SET(%RelateBreakFieldLink,%RelationKeyFieldLink)
  418.           #ELSE
  419. CLEAR(%RelationKeyField)                       #<!Clear non-linking field
  420.           #ENDIF
  421.         #ENDFOR
  422. SET(%RelationKey,%RelationKey)                 #<!Set to first related record
  423. LOOP                                           #<!Loop through %Secondary
  424.   NEXT(%Secondary)                             #<! getting each record
  425.   IF ERRORCODE() THEN ErrEndFileFlag# = 1 ELSE ErrEndFileFlag# = 0. !Flag EOF
  426.         #SET(%CurrentFile,%Secondary)
  427.         #INSERT(%GroupBreakNumber)
  428.         #IF(%GroupCounter)
  429.           #FIX(%File,%Secondary)
  430.           #SET(%CodePosition,(%FilePre&':FILTER'))
  431.   #INSERT(%RptRecordFilter)
  432.           #SET(%GetLookupFrom,%Secondary)
  433.   #INSERT(%RptGetLookupRecords)                 #!Get all Lookup records
  434.           #SET(%CodePosition,%Secondary)        #!Class = primary file
  435.   #INSERT(%ReportFormulas)                      #!Generate formulas
  436.           #SET(%GetRelatedTo,%Secondary)        #!Recursive call to this group
  437.           #SET(%SaveFile,%Secondary)              #!Check for footer save fields
  438.   #INSERT(%SaveFooterFields)
  439.           #SET(%PassField1,%GroupField1)
  440.           #SET(%PassField2,%RelateBreakField)
  441.           #SET(%PassField3,%RelateBreakFieldLink)
  442.   #INSERT(%GroupBreakSelect)
  443.         #ELSE                                   #!No group break on this file
  444.           #SET(%SaveFile,%Secondary)              #!Check for footer save fields
  445.   #INSERT(%SaveFooterFields)
  446.   IF %RelateBreakField <> %RelateBreakFieldLink | #<!Past related Records?
  447.      OR ErrEndFileFlag#                        #<!  or End of file?
  448.     BREAK                                      #<!Break loop
  449.   END
  450.           #FIX(%File,%Secondary)
  451.           #SET(%CodePosition,(%FilePre&':FILTER'))
  452.   #INSERT(%RptRecordFilter)
  453.           #SET(%GetLookupFrom,%Secondary)
  454.   #INSERT(%RptGetLookupRecords)                 #!Get all Lookup records
  455.           #SET(%CodePosition,%Secondary)        #!Class = primary file
  456.   #INSERT(%ReportFormulas)                      #!Generate formulas
  457.           #SET(%GetRelatedTo,%Secondary)        #!Recursive call to this group
  458.         #ENDIF
  459.   #INSERT(%RptGetRelatedRecords)                #!  to get next level deep
  460.         #IF(%DetailPrinted <> 'PRINTED')
  461.   #INSERT(%PrintDetail)                         #!  in footer fields
  462.   #INSERT(%RptAbortKey)                         #!Insert ESC key abort loop
  463.           #SET(%DetailPrinted,'PRINTED')        #!Set detail print flag OFF
  464.         #ENDIF
  465. END                                            #<!End %Secondary Loop
  466.       #ENDIF
  467.     #ENDIF
  468.   #ENDFOR
  469. #!
  470. #!***************************************************************************
  471. #GROUP(%PrintDetail)
  472.   #IF(%ReportLabel)
  473. #INSERT(%MultiUpLabelBuild)
  474.   #ENDIF
  475. %ReportDetailPre
  476.   #IF(%ReportDetail)
  477. PRINT(%ReportPre:%ReportDetail)                #<!Print line item detail
  478.   #ENDIF
  479.   #IF(%ProgressScreen)
  480. DISPLAY                                       #<!Display report progress
  481.   #ENDIF
  482. %ReportDetailPost
  483.   #IF(%PageTotals)                              #!Any page total fields?
  484. IF SAV::LineCounter > %ReportLine              #<!Page overflow?
  485.     #SET(%ResetTotalType,'PAGE')                #!Reset page totals
  486.   #INSERT(%ResetTotals)
  487.     #SET(%TallyType,'PAGE')                     #!Tally page totals
  488.   #INSERT(%TallyTotals)
  489. END
  490. SAV::LineCounter = %ReportLine                 #<!Save line counter
  491.   #ENDIF
  492.   #SET(%TallyType,'ALL')                        #!For totals on ALL
  493. #INSERT(%TallyTotals)                           #!Tally total fields
  494.   #IF(%ReportLabel)
  495. #INSERT(%MultiUpLabelReset)
  496.   #ENDIF
  497. #!
  498. #!***************************************************************************
  499. #GROUP(%TotalRoutines)                          #!Total field routines
  500.   #FOR(%ReportTotal)
  501.     #IF(%ReportTotalTally = 'PAGE')
  502.  
  503. Tally::PAGE::Totals  ROUTINE                   #<!Tallys on page break
  504.       #SET(%TallyType,'PAGE')
  505.   #INSERT(%DoTallyTotals)
  506.       #BREAK
  507.     #ENDIF
  508.   #ENDFOR
  509.   #FOR(%ReportTotal)
  510.     #IF(%ReportTotalTally = 'ALL')
  511.  
  512. Tally::ALL::Totals ROUTINE                     #<!Tallys on body detail
  513.       #SET(%TallyType,'ALL')
  514.   #INSERT(%DoTallyTotals)
  515.       #BREAK
  516.     #ENDIF
  517.   #ENDFOR
  518.   #FOR(%ReportGroup)
  519.     #FOR(%ReportTotal)
  520.       #IF(%ReportTotalTally = %ReportGroup)
  521.  
  522. Tally::%ReportTotalTally::Totals ROUTINE       #<!Tallys on group break
  523.         #SET(%TallyType,%ReportTotalTally)
  524.   #INSERT(%DoTallyTotals)
  525.         #BREAK
  526.       #ENDIF
  527.     #ENDFOR
  528.   #ENDFOR
  529.   #FOR(%ReportTotal)
  530.     #IF(%ReportTotalReset = 'PAGE')
  531.  
  532. Reset::PAGE::Totals ROUTINE                    #<!Resets on page break
  533.      #SET(%ResetTotalType,'PAGE')
  534.   #INSERT(%DoResetTotals)
  535.       #BREAK
  536.     #ENDIF
  537.   #ENDFOR
  538.   #FOR(%ReportTotal)
  539.     #IF(%ReportTotalReset = 'NONE')
  540.  
  541. Reset::NONE::Totals ROUTINE                    #<!Resets on report close
  542.      #SET(%ResetTotalType,'NONE')
  543.   #INSERT(%DoResetTotals)
  544.       #BREAK
  545.     #ENDIF
  546.   #ENDFOR
  547.   #FOR(%ReportGroup)
  548.     #FOR(%ReportTotal)
  549.       #IF(%ReportTotalReset = %ReportGroup)
  550.  
  551. Reset::%ReportTotalReset::Totals ROUTINE       #<!Resets on group break
  552.      #SET(%ResetTotalType,%ReportTotalReset)
  553.   #INSERT(%DoResetTotals)
  554.         #BREAK
  555.       #ENDIF
  556.     #ENDFOR
  557.   #ENDFOR
  558. #!
  559. #!***************************************************************************
  560. #GROUP(%DoTallyTotals)                          #!Tally total fields
  561.   #SET(%Counter1,%NULL)                         #!%TallyType must be set
  562.   #FOR(%ReportTotal)                            #! before #INSERT this group
  563.     #SET(%Counter1,(%Counter1 + 1))
  564.     #IF(%ReportTotalTally = %TallyType)
  565.       #IF(%ReportTotalType = 'SUM')
  566. %ReportPre:%ReportTotal += %ReportTotalField   #<!SUM total of %ReportTotalField
  567.       #ELSIF(%ReportTotalType = 'COUNT')
  568. %ReportPre:%ReportTotal += 1                   #<!COUNT total of %ReportTotalField
  569.       #ELSIF(%ReportTotalType = 'HIGH')
  570. IF %ReportTotalField > %ReportPre:%ReportTotal #<!HIGH value of %ReportTotalField
  571.   %ReportPre:%ReportTotal = %ReportTotalField
  572. END
  573.       #ELSIF(%ReportTotalType = 'LOW')
  574. IF %ReportTotalField < %ReportPre:%ReportTotal #<!LOW value of %ReportTotalField
  575.   %ReportPre:%ReportTotal = %ReportTotalField
  576. END
  577.       #ELSIF(%ReportTotalType = 'AVERAGE')
  578.         #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element
  579.           #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1)))
  580. %ReportTotal::Cnt::%ArrayField::%Counter1 += 1 !AVERAGE of %ReportTotalField
  581. %ReportTotal::Sum::%ArrayField::%Counter1 += %ReportTotalField
  582. %ReportPre:%ReportTotal = %ReportTotal::Sum::%ArrayField::%Counter1 / %ReportTotal::Cnt::%ArrayField::%Counter1
  583.         #ELSE
  584. %ReportTotal::Cnt::%ReportTotalField += 1      #<!AVERAGE of %ReportTotalField
  585. %ReportTotal::Sum::%ReportTotalField += %ReportTotalField
  586. %ReportPre:%ReportTotal = %ReportTotal::Sum::%ReportTotalField / %ReportTotal::Cnt::%ReportTotalField
  587.         #ENDIF
  588.       #ENDIF
  589.     #ENDIF
  590.   #ENDFOR
  591. #!
  592. #!***************************************************************************
  593. #GROUP(%DoResetTotals)                          #!Reset total fields
  594.   #SET(%Counter1,%NULL)                         #!%ResetTotalType must be set
  595.   #FOR(%ReportTotal)                            #! before #INSERT this group
  596.     #SET(%Counter1,(%Counter1 + 1))
  597.     #IF(%ReportTotalReset = %ResetTotalType)
  598. %ReportPre:%ReportTotal = 0
  599.       #IF(%ReportTotalType = 'AVERAGE')
  600.         #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element
  601.           #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1)))
  602. %ReportTotal::Cnt::%ArrayField::%Counter1 = 0
  603. %ReportTotal::Sum::%ArrayField::%Counter1 = 0
  604.         #ELSE
  605. %ReportTotal::Cnt::%ReportTotalField = 0
  606. %ReportTotal::Sum::%ReportTotalField = 0
  607.         #ENDIF
  608.       #ENDIF
  609.     #ENDIF
  610.   #ENDFOR
  611. #!
  612. #!***************************************************************************
  613. #GROUP(%TallyTotals)                            #!Tally total fields
  614.   #FOR(%ReportTotal)                            #!%TallyType must be set
  615.     #IF(%ReportTotalTally = %TallyType)         #! before #INSERT this group
  616. DO Tally::%TallyType::Totals                   #<!Tally %TallyType totals
  617.       #BREAK
  618.     #ENDIF
  619.   #ENDFOR
  620. #!
  621. #!***************************************************************************
  622. #GROUP(%ResetTotals)                            #!Reset total fields
  623.   #FOR(%ReportTotal)                            #!%ResetTotalType must be set
  624.     #IF(%ReportTotalReset = %ResetTotalType)    #! before #INSERT this group
  625. DO Reset::%ResetTotalType::Totals              #<!Reset %ResetTotalType totals
  626.       #BREAK
  627.     #ENDIF
  628.   #ENDFOR
  629. #!
  630. #!***************************************************************************
  631. #GROUP(%SaveFooterFields)                       #!Call footer save routines
  632.   #FOR(%ReportSave)                             #!%SaveFile must be set
  633.     #FOR(%ReportSaveField)                      #! before #INSERT this group
  634.       #IF(%ReportSaveField <> %ReportPage)
  635.           #SET(%BreakField,%ReportSaveField)
  636.           #INSERT(%RptFindFile)
  637.         #IF(%FoundFile = %SaveFile)             #!Check for save file
  638. DO Save::%SaveFile::FooterFields               #<!Save %SaveFile footer fields
  639.           #SET(%Done,'YES')
  640.           #BREAK
  641.         #ELSE
  642.           #SET(%Done,%NULL)
  643.         #ENDIF
  644.       #ENDIF
  645.     #ENDFOR
  646.     #IF(%Done = 'YES')
  647.       #BREAK
  648.     #ENDIF
  649.   #ENDFOR
  650. #!
  651. #!***************************************************************************
  652. #GROUP(%SaveFooterRoutine)                      #!Rotate footer save fields
  653.   #SET(%Temp,(SUB(%SaveFilesQueue,1,INSTRING(',',%SaveFilesQueue,1,1)-1)))
  654.   #SET(%SaveFilesQueue,(SUB(%SaveFilesQueue,LEN(%Temp)+2,LEN(%SaveFilesQueue)-LEN(%Temp)+1)))
  655.   #IF(%Temp)
  656.     #FOR(%ReportSave)
  657.       #IF(%ReportSave <> 'PAGE')
  658.         #FOR(%ReportSaveField)
  659.           #IF(%Temp = UPPER(SUB(%ReportSaveField,1,INSTRING(':',%ReportSaveField,1,1)-1)))
  660.             #SET(%BreakField,%ReportSaveField)
  661.             #INSERT(%RptFindFile)
  662.  
  663. Save::%FoundFile::FooterFields ROUTINE         #<!Save footer fields
  664.             #SET(%SaveFile,%FoundFile)
  665.   #INSERT(%SaveFooterAssigns)
  666.             #SET(%GetAssigns,'YES')
  667.             #BREAK
  668.           #ELSE
  669.             #SET(%GetAssigns,%NULL)
  670.           #ENDIF
  671.         #ENDFOR
  672.       #ENDIF
  673.       #IF(%GetAssigns)
  674.         #BREAK
  675.       #ENDIF
  676.     #ENDFOR
  677. #INSERT(%SaveFooterRoutine)
  678.   #ENDIF
  679. #!
  680. #!***************************************************************************
  681. #GROUP(%SaveFooterAssigns)                      #!Rotate footer save fields
  682.   #SET(%Counter1,%NULL)
  683.   #SET(%Counter2,%NULL)
  684.   #FOR(%ReportSave)                             #!%SaveFile must be set
  685.     #SET(%Counter1,(%Counter1 + 1))
  686.     #FOR(%ReportSaveField)                      #! before #INSERT this group
  687.       #IF(%ReportSaveField <> %ReportPage)
  688.         #SET(%Counter2,(%Counter2 + 1))
  689.         #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element
  690.           #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1)))
  691.         #ELSE
  692.           #SET(%ArrayField,%NULL)               #!Clear array flag
  693.         #ENDIF
  694.         #SET(%BreakField,%ReportSaveField)
  695.         #INSERT(%RptFindFile)
  696.         #IF(%FoundFile = %SaveFile)             #!Check for save file
  697.           #IF(%ArrayField)                      #!Check for array element
  698. SAV2::%ReportSave::%ArrayField::%Counter1::%Counter2 = SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2
  699. SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2 = %ReportSaveField
  700.           #ELSE
  701. SAV2::%ReportSave::%ReportSaveField = SAV1::%ReportSave::%ReportSaveField
  702. SAV1::%ReportSave::%ReportSaveField = %ReportSaveField
  703.           #ENDIF
  704.         #ENDIF
  705.       #ENDIF
  706.     #ENDFOR
  707.   #ENDFOR
  708. #!
  709. #!***************************************************************************
  710. #GROUP(%PrintFooterFields)                      #!Set footer to print correct
  711.   #FOR(%ReportSave)                             #! before #INSERT this group
  712.     #IF(%ReportSave = %WhichFooter)             #!Check for save file
  713. DO Print::%ReportSave::FooterFields            #<!Print correct footer fields
  714.       #BREAK
  715.     #ENDIF
  716.   #ENDFOR
  717. #!
  718. #!***************************************************************************
  719. #GROUP(%PrintFooterRoutine)                     #!Set footer to print correct
  720.   #SET(%Counter1,%NULL)                         #!  footer field values
  721.   #SET(%Counter2,%NULL)
  722.   #FOR(%ReportSave)                             #! before #INSERT this group
  723.     #IF(%ReportSave <> 'PAGE')
  724.  
  725. Print::%ReportSave::FooterFields ROUTINE       #<!Print correct footer fields
  726.       #SET(%Counter1,(%Counter1 + 1))
  727.       #FOR(%ReportSaveField)                    #! before #INSERT this group
  728.         #SET(%Counter2,(%Counter2 + 1))
  729.         #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element
  730.           #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1)))
  731.   %ReportSaveField = SAV2::%ReportSave::%ArrayField::%Counter1::%Counter2
  732.         #ELSE
  733.   %ReportSaveField = SAV2::%ReportSave::%ReportSaveField
  734.         #ENDIF
  735.       #ENDFOR
  736.     #ENDIF
  737.   #ENDFOR
  738. #!
  739. #!***************************************************************************
  740. #GROUP(%RestoreFooterFields)                    #!Restore changed footer
  741.   #FOR(%ReportSave)                             #! before #INSERT this group
  742.     #IF(%ReportSave = %WhichFooter)             #!Check for save file
  743. DO Restore::%ReportSave::FooterFields          #<!Restore current footer fields
  744.       #BREAK
  745.     #ENDIF
  746.   #ENDFOR
  747. #!
  748. #!***************************************************************************
  749. #GROUP(%RestoreFooterRoutine)                   #!Restore changed footer
  750.   #SET(%Counter1,%NULL)                         #!  footer field values
  751.   #SET(%Counter2,%NULL)
  752.   #FOR(%ReportSave)                             #! before #INSERT this group
  753.     #IF(%ReportSave <> 'PAGE')
  754.  
  755. Restore::%ReportSave::FooterFields ROUTINE     #<!Restore current footer fields
  756.       #SET(%Counter1,(%Counter1 + 1))
  757.       #FOR(%ReportSaveField)                    #! before #INSERT this group
  758.         #SET(%Counter2,(%Counter2 + 1))
  759.         #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element
  760.           #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1)))
  761.   %ReportSaveField = SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2
  762.         #ELSE
  763.   %ReportSaveField = SAV1::%ReportSave::%ReportSaveField
  764.         #ENDIF
  765.       #ENDFOR
  766.     #ENDIF
  767.   #ENDFOR
  768. #!
  769. #!***************************************************************************
  770. #GROUP(%ReportFormulas)                         #!Generate formula field code
  771.   #FOR(%Formula)                                #!%CodePosition must be set
  772.                                                 #! before #INSERT this group
  773.     #IF((UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition) OR %FormulaClass = %NULL) AND %FormulaType = 'COMPUTED')
  774. %Formula = %FormulaComputation                 #<!%FormulaDescription
  775.     #ENDIF
  776.   #ENDFOR
  777.   #FOR(%Formula)                                #!All computed fields before
  778.     #IF((UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition) OR %FormulaClass = %NULL) AND %FormulaType = 'CONDITION')
  779. IF %FormulaCondition                           #<!%FormulaDescription
  780.   %Formula = %FormulaTrue
  781. ELSE
  782.   %Formula = %FormulaFalse
  783. END
  784.     #ENDIF
  785.   #ENDFOR
  786. #!
  787. #!***************************************************************************
  788. #GROUP(%RptRecordFilter)                        #!Generate record filter code
  789.   #FOR(%Formula)                                #!%CodePosition must be set
  790.                                                 #! and must contain the file
  791.                                                 #! prefix followed by :FILTER
  792.     #IF(UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition))
  793.       #IF(%FormulaType = 'COMPUTED')
  794. IF NOT (%FormulaComputation)                   #<!%FormulaDescription
  795.   CYCLE                                        #<!%File record filter
  796. END
  797.       #ELSE
  798. IF NOT (%FormulaCondition)                     #<!%FormulaDescription
  799.   CYCLE                                        #<!%File record filter
  800. END
  801.       #ENDIF
  802.     #ENDIF
  803.   #ENDFOR
  804. #!
  805. #!***************************************************************************
  806. #GROUP(%GroupBreakNumber)
  807.   #SET(%GroupCounter,%NULL)
  808.   #SET(%GroupField1,%NULL)
  809.   #SET(%GroupField2,%NULL)
  810.   #SET(%GroupField3,%NULL)
  811.   #SET(%GroupField4,%NULL)
  812.   #FOR(%ReportGroup)
  813.     #SET(%BreakField,%ReportGroup)
  814.     #INSERT(%RptFindFile)
  815.     #IF(%FoundFile = %CurrentFile)              #!Check breaks on current file
  816.       #SET(%GroupCounter,(%GroupCounter + 1))
  817.       #IF(%GroupCounter = 1)
  818.         #SET(%GroupField1,%BreakField)
  819.       #ELSIF(%GroupCounter = 2)
  820.         #SET(%GroupField2,%BreakField)
  821.       #ELSIF(%GroupCounter = 3)
  822.         #SET(%GroupField3,%BreakField)
  823.       #ELSIF(%GroupCounter = 4)
  824.         #SET(%GroupField4,%BreakField)
  825.       #ELSIF(%GroupCounter > 4)
  826.         #SET(%ErrorMessage,(%Procedure & ' ERROR:'))
  827.         #ERROR(%ErrorMessage)
  828.         #SET(%ErrorMessage,('  ' & %FoundFile & ' --Too many Group Breaks - 4/file Maximum'))
  829.         #ERROR(%ErrorMessage)
  830.       #ENDIF
  831.     #ENDIF
  832.   #ENDFOR
  833. #!
  834. #!***************************************************************************
  835. #GROUP(%PrimaryFileGroupBrk)
  836. #IF(%SelectorAccess)                          #!If record selector
  837.   #SET(%PassField1,%GroupField1)
  838.   #SET(%PassField2,%KeyComponent)
  839.   #SET(%PassField3,%ScopeValue)
  840. #INSERT(%GroupBreakSelect)
  841. #ELSE                                       #!No record selector
  842.   #SET(%SaveFile,%Primary)
  843. #INSERT(%SaveFooterFields)
  844. IF NOT SAV::%GroupField1 AND NOT ErrEndFileFlag#      #<!Print first group header
  845.   #FIX(%ReportGroup,%GroupField1)
  846.   #INSERT(%GroupBreakHeader)                #!Print group header
  847.   #IF(%GroupField2)
  848.     #FIX(%ReportGroup,%GroupField2)
  849.   #INSERT(%GroupBreakHeader)                #!Print group header
  850.   #ENDIF
  851.   #IF(%GroupField3)
  852.     #FIX(%ReportGroup,%GroupField3)
  853.   #INSERT(%GroupBreakHeader)                #!Print  group header
  854.   #ENDIF
  855.   #IF(%GroupField4)
  856.     #FIX(%ReportGroup,%GroupField4)
  857.   #INSERT(%GroupBreakHeader)                #!Print group header
  858.   #ENDIF
  859. ELSIF SAV::%GroupField1 AND ErrEndFileFlag# #<!Print last group footer
  860.   #IF(%GroupField4)
  861.     #FIX(%ReportGroup,%GroupField4)
  862.   #INSERT(%GroupBreakFooter)                #!Print last group footer
  863.   #ENDIF
  864.   #IF(%GroupField3)
  865.     #FIX(%ReportGroup,%GroupField3)
  866.   #INSERT(%GroupBreakFooter)                #!Print last group footer
  867.   #ENDIF
  868.   #IF(%GroupField2)
  869.     #FIX(%ReportGroup,%GroupField2)
  870.   #INSERT(%GroupBreakFooter)                #!Print last group footer
  871.   #ENDIF
  872.   #IF(%GroupField1)
  873.     #FIX(%ReportGroup,%GroupField1)
  874.   #INSERT(%GroupBreakFooter)                #!Print last group footer
  875.   #ENDIF
  876.   BREAK
  877. ELSIF ErrEndFileFlag#                      #<!Print nothing - no records
  878.   BREAK
  879. END
  880. IF %GroupField1 <> SAV::%GroupField1       #<!Normal group break?
  881.     #FIX(%ReportGroup,%GroupField1)
  882.   #INSERT(%GroupBreakFooter)                #!Print group footer
  883.     #FIX(%ReportGroup,%GroupField1)
  884.   #INSERT(%GroupBreakHeader)                #!Print group header
  885. END
  886.   #IF(%GroupField2)
  887. IF %GroupField2 <> SAV::%GroupField2       #<!Normal group break?
  888.     #FIX(%ReportGroup,%GroupField2)
  889.   #INSERT(%GroupBreakFooter)                #!Print group footer
  890.     #FIX(%ReportGroup,%GroupField2)
  891.   #INSERT(%GroupBreakHeader)                #!Print group header
  892. END
  893.   #ENDIF
  894.   #IF(%GroupField3)
  895. IF %GroupField3 <> SAV::%GroupField3       #<!Normal group break?
  896.     #FIX(%ReportGroup,%GroupField3)
  897.   #INSERT(%GroupBreakFooter)                #!Print group footer
  898.     #FIX(%ReportGroup,%GroupField3)
  899.   #INSERT(%GroupBreakHeader)                #!Print group header
  900. END
  901.   #ENDIF
  902.   #IF(%GroupField4)
  903. IF %GroupField4 <> SAV::%GroupField4       #<!Normal group break?
  904.     #FIX(%ReportGroup,%GroupField4)
  905.   #INSERT(%GroupBreakFooter)                #!Print group footer
  906.     #FIX(%ReportGroup,%GroupField4)
  907.   #INSERT(%GroupBreakHeader)                #!Print group header
  908. END
  909.   #ENDIF
  910. #ENDIF
  911. #!
  912. #!***************************************************************************
  913. #GROUP(%GroupBreakSelect)
  914.   #IF(%PassField1 = %PassField2)                #!1st Break field & link field same
  915. IF %PassField2 <> %PassField3       |          #<!Group Break?
  916.     OR ErrEndFileFlag#                         #<! or end of file?
  917.   IF SAV::%PassField1                          #<!Print group footer
  918.     #IF(%ReportLabel)
  919.     IF SAV::LabelCounter <> 0                  #<!If any labels left to print
  920.       %ReportDetailPre
  921.       PRINT(%ReportPre:%ReportDetail)          #<!Print last line item detail
  922.       #IF(%ProgressScreen)
  923.       DISPLAY                                  #<!Display report progress
  924.       #ENDIF
  925.       %ReportDetailPost
  926.       #INSERT(%MultiUpLabelReset)
  927.     END
  928.     #ENDIF
  929.     #IF(%GroupField4)
  930.       #FIX(%ReportGroup,%GroupField4)
  931.     #INSERT(%GroupBreakFooter)                #!Print last group footer
  932.     CLEAR(SAV::%GroupField4)                   #<!Clear group print flag
  933.     #ENDIF
  934.     #IF(%GroupField3)
  935.       #FIX(%ReportGroup,%GroupField3)
  936.     #INSERT(%GroupBreakFooter)                #!Print last group footer
  937.     CLEAR(SAV::%GroupField3)                   #<!Clear group print flag
  938.     #ENDIF
  939.     #IF(%GroupField2)
  940.       #FIX(%ReportGroup,%GroupField2)
  941.     #INSERT(%GroupBreakFooter)                #!Print last group footer
  942.     CLEAR(SAV::%GroupField2)                   #<!Clear group print flag
  943.     #ENDIF
  944.     #IF(%GroupField1)
  945.       #FIX(%ReportGroup,%GroupField1)
  946.     #INSERT(%GroupBreakFooter)                #!Print last group footer
  947.     CLEAR(SAV::%GroupField1)                   #<!Clear group print flag
  948.     #ENDIF
  949.     BREAK                                      #<!Terminate report processing
  950.   ELSE                                         #<!Print group header
  951.     BREAK
  952.   END
  953. END
  954. IF NOT SAV::%PassField1                        #<!Print first group header
  955.     #IF(%GroupField1)
  956.       #FIX(%ReportGroup,%GroupField1)
  957.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  958.     #ENDIF
  959.     #IF(%GroupField2)
  960.       #FIX(%ReportGroup,%GroupField2)
  961.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  962.     #ENDIF
  963.     #IF(%GroupField3)
  964.       #FIX(%ReportGroup,%GroupField3)
  965.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  966.     #ENDIF
  967.     #IF(%GroupField4)
  968.       #FIX(%ReportGroup,%GroupField4)
  969.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  970.     #ENDIF
  971. END
  972.     #IF(%GroupField2)
  973. IF %GroupField2 <> SAV::%GroupField2           #<!Normal group break?
  974.       #FIX(%ReportGroup,%GroupField2)
  975.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  976.       #FIX(%ReportGroup,%GroupField2)
  977.   #INSERT(%GroupBreakHeader)                    #!Print group header
  978. END
  979.     #ENDIF
  980.     #IF(%GroupField3)
  981. IF %GroupField3 <> SAV::%GroupField3           #<!Normal group break?
  982.       #FIX(%ReportGroup,%GroupField3)
  983.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  984.       #FIX(%ReportGroup,%GroupField3)
  985.   #INSERT(%GroupBreakHeader)                    #!Print group header
  986. END
  987.     #ENDIF
  988.     #IF(%GroupField4)
  989. IF %GroupField4 <> SAV::%GroupField4           #<!Normal group break?
  990.       #FIX(%ReportGroup,%GroupField4)
  991.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  992.       #FIX(%ReportGroup,%GroupField4)
  993.   #INSERT(%GroupBreakHeader)                    #!Print group header
  994. END
  995.     #ENDIF
  996.   #ELSE                                         #!Break & link field not same
  997. IF %PassField2 <> %PassField3 |                #<!End of related records?
  998.     OR ErrEndFileFlag#                         #<! or end of file?
  999.   IF SAV::%PassField1                          #<!Print last group footer
  1000.     #IF(%ReportLabel)
  1001.     IF SAV::LabelCounter <> 0                  #<!If any labels left to print
  1002.       %ReportDetailPre
  1003.       PRINT(%ReportPre:%ReportDetail)          #<!Print last line item detail
  1004.       #IF(%ProgressScreen)
  1005.       DISPLAY                                  #<!Display report progress
  1006.       #ENDIF
  1007.       %ReportDetailPost
  1008.       #INSERT(%MultiUpLabelReset)
  1009.     END
  1010.     #ENDIF
  1011.     #IF(%GroupField4)
  1012.       #FIX(%ReportGroup,%GroupField4)
  1013.       #INSERT(%GroupBreakFooter)                #!Print last group footer
  1014.     CLEAR(SAV::%GroupField4)                   #<!Clear group print flag
  1015.     #ENDIF
  1016.     #IF(%GroupField3)
  1017.       #FIX(%ReportGroup,%GroupField3)
  1018.       #INSERT(%GroupBreakFooter)                #!Print last group footer
  1019.     CLEAR(SAV::%GroupField3)                   #<!Clear group print flag
  1020.     #ENDIF
  1021.     #IF(%GroupField2)
  1022.       #FIX(%ReportGroup,%GroupField2)
  1023.       #INSERT(%GroupBreakFooter)                #!Print last group footer
  1024.     CLEAR(SAV::%GroupField2)                   #<!Clear group print flag
  1025.     #ENDIF
  1026.     #IF(%GroupField1)
  1027.       #FIX(%ReportGroup,%GroupField1)
  1028.       #INSERT(%GroupBreakFooter)                #!Print last group footer
  1029.     CLEAR(SAV::%GroupField1)                   #<!Clear group print flag
  1030.     #ENDIF
  1031.   END
  1032.   BREAK                                        #<!Terminate loop
  1033. END
  1034. IF NOT SAV::%PassField1                        #<!Print first group header
  1035.     #IF(%GroupField1)
  1036.       #FIX(%ReportGroup,%GroupField1)
  1037.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  1038.     #ENDIF
  1039.     #IF(%GroupField2)
  1040.       #FIX(%ReportGroup,%GroupField2)
  1041.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  1042.     #ENDIF
  1043.     #IF(%GroupField3)
  1044.       #FIX(%ReportGroup,%GroupField3)
  1045.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  1046.     #ENDIF
  1047.     #IF(%GroupField4)
  1048.       #FIX(%ReportGroup,%GroupField4)
  1049.   #INSERT(%GroupBreakHeader)                    #!Print first group header
  1050.     #ENDIF
  1051. END
  1052.     #IF(%GroupField1)
  1053. IF %GroupField1 <> SAV::%GroupField1           #<!Normal group break?
  1054.       #FIX(%ReportGroup,%GroupField1)
  1055.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  1056.       #FIX(%ReportGroup,%GroupField1)
  1057.   #INSERT(%GroupBreakHeader)                    #!Print group header
  1058. END
  1059.     #ENDIF
  1060.     #IF(%GroupField2)
  1061. IF %GroupField2 <> SAV::%GroupField2           #<!Normal group break?
  1062.       #FIX(%ReportGroup,%GroupField2)
  1063.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  1064.       #FIX(%ReportGroup,%GroupField2)
  1065.   #INSERT(%GroupBreakHeader)                    #!Print group header
  1066. END
  1067.     #ENDIF
  1068.     #IF(%GroupField3)
  1069. IF %GroupField3 <> SAV::%GroupField3           #<!Normal group break?
  1070.       #FIX(%ReportGroup,%GroupField3)
  1071.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  1072.       #FIX(%ReportGroup,%GroupField3)
  1073.   #INSERT(%GroupBreakHeader)                    #!Print group header
  1074. END
  1075.     #ENDIF
  1076.     #IF(%GroupField4)
  1077. IF %GroupField4 <> SAV::%GroupField4           #<!Normal group break?
  1078.       #FIX(%ReportGroup,%GroupField4)
  1079.   #INSERT(%GroupBreakFooter)                    #!Print group footer
  1080.       #FIX(%ReportGroup,%GroupField4)
  1081.   #INSERT(%GroupBreakHeader)                    #!Print group header
  1082. END
  1083.     #ENDIF
  1084.   #ENDIF
  1085. #!
  1086. #!***************************************************************************
  1087. #GROUP(%GroupBreakFooter)                       #!Print group footers
  1088.   #SET(%ThisReportGroup,%ReportGroup)           #!Save work Group
  1089.   #SET(%WhichFooter,%ThisReportGroup)           #!Ensure footer fields contain
  1090. #INSERT(%PrintFooterFields)                     #! correct values to print
  1091.   #FIX(%ReportGroup,%ThisReportGroup)           #!Fix to saved work Group
  1092.   #SET(%CodePosition,%ThisReportGroup)          #!Class = group break field
  1093. #INSERT(%ReportFormulas)                        #!Generate formulas
  1094.   #FIX(%ReportGroup,%ThisReportGroup)           #!Fix to saved work Group
  1095. %ReportGroupFooterPre
  1096.    #IF(%ReportGroupFooter)
  1097. PRINT(%ReportPre:%ReportGroupFooter)           #<!Print group footer
  1098.      #IF(%ProgressScreen)
  1099. DISPLAY                                        #<!Display report progress
  1100.      #ENDIF
  1101.    #ENDIF
  1102. %ReportGroupFooterPost
  1103.    #SET(%WhichFooter,%ThisReportGroup)          #!Ensure footer fields contain
  1104. #INSERT(%RestoreFooterFields)                   #!Restore saved footer fields
  1105.    #IF(%PageTotals)                             #!Any footer save fields?
  1106. IF SAV::LineCounter > %ReportLine              #<!Page overflow?
  1107.      #SET(%ResetTotalType,'PAGE')               #!Reset page totals
  1108.   #INSERT(%ResetTotals)
  1109.      #SET(%TallyType,'PAGE')                    #!Tally page totals
  1110.   #INSERT(%TallyTotals)
  1111. END
  1112. SAV::LineCounter = %ReportLine                 #<!Save line counter
  1113.   #ENDIF
  1114.   #SET(%ResetTotalType,%ThisReportGroup)        #!Reset group total fields
  1115. #INSERT(%ResetTotals)
  1116. #!
  1117. #!***************************************************************************
  1118. #GROUP(%GroupBreakHeader)                       #!Check for group breaks
  1119.   #SET(%ThisReportGroup,%ReportGroup)           #!Save work Group
  1120. %ReportGroupHeaderPre
  1121.   #IF(%ReportGroupHeader)
  1122. PRINT(%ReportPre:%ReportGroupHeader)           #<!Print group header
  1123.     #IF(%ProgressScreen)
  1124. DISPLAY                                        #<!Display report progress
  1125.     #ENDIF
  1126.   #ENDIF
  1127. %ReportGroupHeaderPost
  1128.    #IF(%PageTotals)                             #!Any footer save fields?
  1129. IF SAV::LineCounter > %ReportLine              #<!Page overflow?
  1130.      #SET(%ResetTotalType,'PAGE')               #!Reset page totals
  1131.   #INSERT(%ResetTotals)
  1132.      #SET(%TallyType,'PAGE')                    #!Tally page totals
  1133.   #INSERT(%TallyTotals)
  1134. END
  1135. SAV::LineCounter = %ReportLine                 #<!Save line counter
  1136.   #ENDIF
  1137. SAV::%ThisReportGroup = %ThisReportGroup       #<!New break field value
  1138.   #SET(%TallyType,%ThisReportGroup)             #!Tally group total fields
  1139. #INSERT(%TallyTotals)
  1140. #!
  1141. #!***************************************************************************
  1142. #GROUP(%MultiUpLabelBuild)
  1143. SAV::LabelCounter += 1                         #<!Increment label counter
  1144.   #SET(%Counter1,%NULL)
  1145.   #FOR(%ReportLabelField)
  1146.     #SET(%Counter1,(%Counter1 + 1))
  1147.     #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element
  1148.       #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1)))
  1149. LBL::%ArrayField::%Counter1[SAV::LabelCounter] = %ReportLabelField
  1150.     #ELSE
  1151. LBL::%ReportLabelField[SAV::LabelCounter] = %ReportLabelField
  1152.     #ENDIF
  1153.   #ENDFOR
  1154. IF SAV::LabelCounter < %ReportLabel
  1155.   CYCLE
  1156. END
  1157. #!
  1158. #!***************************************************************************
  1159. #GROUP(%MultiUpLabelReset)
  1160. SAV::LabelCounter = 0                          #<!Reset label counter
  1161.   #SET(%Counter1,%NULL)
  1162.   #FOR(%ReportLabelField)
  1163.     #SET(%Counter1,(%Counter1 + 1))
  1164.     #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element
  1165.       #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1)))
  1166. CLEAR(LBL::%ArrayField::%Counter1)             #<!Reset label USE variable
  1167.     #ELSE
  1168. CLEAR(LBL::%ReportLabelField)                  #<!Reset label USE variable
  1169.     #ENDIF
  1170.   #ENDFOR
  1171. #!
  1172. #!***************************************************************************
  1173. #GROUP(%RptAbortKey)
  1174.   #IF(%EscapeAbort)                             #!Enable ESC checked?
  1175. LOOP WHILE KEYBOARD()                          #<!If any keystrokes waiting
  1176.   ASK                                          #<! in the buffer, get them
  1177.   IF KEYCODE() = EscKey                        #<!Detect the ESC key
  1178.     CLOSE(%Report)                             #<! close the report
  1179.     RETURN                                     #<! and get out
  1180.   END
  1181. END                                            #<!End abort key loop
  1182.   #ENDIF
  1183. #!
  1184. #!***************************************************************************
  1185. #GROUP(%RptSetMultiples)
  1186.   #SET(%SelectorAccess,(%AccessMethod = 'Keyed Order' AND %KeyComponent <> %NULL))
  1187.   #FOR(%Secondary)
  1188.     #SET(%SecondaryExist,'YES')
  1189.     #BREAK
  1190.   #ENDFOR
  1191.   #FOR(%Formula)
  1192.     #SET(%FormulaExist,'YES')
  1193.     #BREAK
  1194.   #ENDFOR
  1195.   #FOR(%ReportGroup)
  1196.     #SET(%ReportGroupExist,'YES')
  1197.     #BREAK
  1198.   #ENDFOR
  1199.   #FOR(%ReportTotal)
  1200.     #SET(%ReportTotalExist,'YES')
  1201.     #BREAK
  1202.   #ENDFOR
  1203.   #FOR(%ReportSave)
  1204.     #FOR(%ReportSaveField)
  1205.       #IF(%ReportSaveField <> %ReportPage)
  1206.         #SET(%ReportSaveExist,'YES')
  1207.         #BREAK
  1208.       #ENDIF
  1209.     #ENDFOR
  1210.     #IF(%ReportSaveExist)
  1211.       #BREAK
  1212.     #ENDIF
  1213.   #ENDFOR
  1214. #!
  1215. #!***************************************************************************
  1216. #GROUP(%RptFindFile)
  1217.   #SET(%FoundFile,%NULL)
  1218.   #FOR(%File)
  1219.     #IF(UPPER(%FilePre) = UPPER(SUB(%BreakField,1,INSTRING(':',%BreakField,1,1)-1)))
  1220.       #SET(%FoundFile,%File)
  1221.       #BREAK
  1222.     #ENDIF
  1223.   #ENDFOR
  1224. #!
  1225. #!***************************************************************************
  1226. #GROUP(%ReportErrorCheck)
  1227.   #SET(%ErrorMessage,(%Procedure & ' ERROR:'))
  1228.   #IF(%Primary = %NULL)
  1229.     #ERROR(%ErrorMessage)
  1230.     #ERROR(' You MUST define a Primary File in the File Schematic.')
  1231.   #ENDIF
  1232.   #IF(%KeyComponent)
  1233.     #FIX(%File,%Primary)
  1234.     #FIX(%Key,%PrimaryKey)
  1235.     #FOR(%KeyField)
  1236.       #IF(%KeyField = %KeyComponent)
  1237.         #SET(%FoundComponent,'YES')
  1238.         #BREAK
  1239.       #ENDIF
  1240.     #ENDFOR
  1241.     #IF(%FoundComponent = %NULL)
  1242.       #ERROR(%ErrorMessage)
  1243.       #ERROR('  Range Limit Field must be a component of ')
  1244.       #ERROR('  the Primary file Access Key.')
  1245.     #ENDIF
  1246.     #IF(%ScopeValue = %NULL)
  1247.       #ERROR(%ErrorMessage)
  1248.       #ERROR('  Must define a Range Value Field')
  1249.     #ELSIF(%KeyComponent = %ScopeValue)
  1250.       #ERROR(%ErrorMessage)
  1251.       #ERROR('  Range Value Field and Range Limit Field')
  1252.       #ERROR('  must be separate fields.')
  1253.     #ENDIF
  1254.   #ENDIF
  1255. #!
  1256. #!
  1257. #CHAIN('OM8.TPX')
  1258.