AN ANALYSIS OF MONTHLY WATER DEMAND

IN PHOENIX, ARIZONA

Paradox program



;**************************************************************************
;      NAME: DoOutput()
;     EVENT: displays the names of the tables with predictions and
;            produces reports.
; ARGUMENTS: no arguments
; TABLES   : selected by user
; VARIABLES: PathRep,
;            PathFrom,  PathTo,
;            mline - line in which messages are displayed
;            aesc - stores state of key [Esc]
;            v1n,v1a,v1a,v1w - screen attributes
;     NOTES: Current version does not allow user to select a form of report
;            which should be used to display predictions. Constant
;            form is assumed  "R" (#1)
;                                                           16.III.92
;**************************************************************************
PROC DoOutput()
;USEVARS PathRep, PathFrom, PathTo, mline, aesc, v1n,v1a,v1a,v1w
aform = "1" ; assumed form of reports = 1
CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@0,0
TEXT
                            WDFM: Produce a Report
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様

   Input  path:





 1  Monthly water production forecast
    a) on-project,  b) off-project and nonmember
 2  Water production forecast: current and next fiscal year.
    a) zones A to D,  b) zones E to H c) unknown, on/off-project, and total
 3  Revenue projection: current and next fiscal year
    a) charges,  b) fees,  c) summary report
 4  Long-term projections for comparison to PHXMAIN
    a) on-project,  b) off-project and nonmember.
 5  Monthly water consumption forecast.
    a) single-family resid., b) multi-family resid., c) non-residential,
    d) on-project,  e) off-project  f) total service area.
 6  Monthly forecast with and without demand adjustments
    a) on-project/single-family,      b) off-project/single-family,
    c) on-project/multi-family,       d) off-project/multi-family,
    e) on-project/nonresidential,     f) off-project/nonresidential.
ENDTEXT
STYLE ATTRIBUTE 112
x = "[Esc] Go To Menu  [Enter] Accept [Backspace]"
x = x+" Delete Chr [Ctrl][Backsp] New Entry"
@24,0 ?? x
aesc = false
xpath =PathRep
CheckPath(3,16)
IF aesc = true THEN RETURN
ENDIF
PathFrom=xpath
WHILE (aesc = false)                 ;  ***** BIG WHILE LOOP
  CANVAS OFF
  RESET
  aShow(" ",5,0,80,v1n)
  aShow(" ",7,0,80,v1n)
  CANVAS ON
  SHOWTABLES PathFrom
  "Select table with predictions, then press Enter"
  TO tname
  tableFrom = PathFrom+tname
  IF NOT(ISTABLE(tableFrom)) THEN RETURN
  ENDIF
  STYLE ATTRIBUTE v1n
  ;@3,55
  ;?? " table: :"+tname
  aShow(" table: "+tname,3,55,18,v1n)
  ;=====================================
  ; user can select a form of the report
  ;=====================================
  ;WHILE retval
  ;ACCEPT "a2"
  ;  DEFAULT aform
  ;  TO aform
  ;  PICKFORM aform
  ; IF retval = false THEN ashow (form not existing)
  ;ENDWHILE
  ;========= end of "please select a form " =============

  SHOWMENU
    "Printer" :   "Send the report to the printer.",
    "Screen" :    "Send the report to the screen.",
    "File" :      "Send the report to the DOS file on the disk.",
    "MainMenu" :  "Return to Main Menu."
  TO choice
  SWITCH
    CASE choice = "MainMenu" OR choice = "Esc":
      CANVAS OFF                       ; turn the canvas off to avoid
      RETURN                           ; flickering when return to MainMenu
      CANVAS ON                        ; now, turn the canvas back on
    CASE choice = "Printer" :REPORT Tablefrom aform
    CASE choice = "Screen" : {report} {output}
                             SELECT TableFrom  SELECT aform
                             {screen}
    CASE choice = "File" :
      @5,3 ?? "Output path:"
      @7,3 ?? "Output file:"
      tname = tname+".rep"
      aShow(tname,7,16,12,v1n)
      PathTo = PathFrom
      aShow(PathFrom,5,16,35,v1n)
      xpath = PathTo
      TakePath(5,16)
      PathTo = xpath
      WHILE TRUE
        STYLE ATTRIBUTE v1a
        @7,16
        aRow=7
        ACCEPT "A12"
          DEFAULT tname
          TO tname
        IF retval = false
          THEN aesc = true RETURN tname
        ENDIF
        ClearMsg(mline,v1n)
        FileTo = PathTo + tname
        IF ISFILE(FileTo)
          THEN
            x = " Table exists, overvrite it? (n/y) "
            aShow(x,aRow,30,35,v1w)
            STYLE ATTRIBUTE v1a
            ACCEPT "A1" TO choice
            IF retval = false THEN aesc = true RETURN
            ENDIF
            IF ((choice <>"Y") AND (choice <> "y"))
              THEN LOOP
              ELSE RUN "Del "+FileTo
            ENDIF
        ENDIF
        aShow(" ",aRow,30,36,v1n)
        aShow(tname,aRow,16,12,v1h)
        ;CANVAS OFF
        {report} {output} SELECT TableFrom
        SELECT aform
        {file}
        SELECT FileTo
        IF (ISFILE(FileTo) = false)
          THEN ashow("can't create this file ",arow,30,24,v1w)
          ELSE ashow(" ",aRow,26,36,v1n)
        ENDIF
        CANVAS ON
        IF errorcode() <> 0 THEN LOOP
        ENDIF
        QUITLOOP
      ENDWHILE
    OTHERWISE : BEEP BEEP BEEP; choice is not valid
  ENDSWITCH
  WHILE (CHARWAITING())               ; get all extra keystrokes before
    Y = GETCHAR()                     ; returning to selection menu
  ENDWHILE
;ENDWHILE
ENDWHILE                             ; END OF BIG WHILE LOOP
RETURN
ENDPROC  ;DoOutput

;**************************************************************************
;      NAME: DoExport()
;     EVENT: displays the names of the tables with predictions and
;            tables to which the results will be saved. The user can
;            accept these names or change them.
; ARGUMENTS: no arguments
; TABLES   : ??
; ARRAYS   : ?awork[]?
; VARIABLES: PathRep,
;            PathFrom,
;            PathTo,
;            mline - line in which messages are displayed
;            aesc - stores state of key [Esc]
;            v1n,v1a,v1a,v1w - screen attributes
;     NOTES: Procedure does not exist
;                                                   v42     25.III.92
;**************************************************************************
PROC DoExport()
;USEVARS PathRep, PathFrom, PathTo, mline, aesc, v1n, v1a, v1a, v1w
CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@0,0
TEXT
                WDFM: Export table to 1-2-3 format file
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様

   Input  path:

   Output path:

   Output file:

 1  Monthly water production forecast
    a) on-project,  b) off-project and nonmember
 2  Water production forecast: current and next fiscal year.
    a) zones A to D,  b) zones E to H c) unknown, on/off-project, and total
 3  Revenue projection: current and next fiscal year
    a) charges,  b) fees,  c) summary report
 4  Long-term projections for comparison to PHXMAIN
    a) on-project,  b) off-project and nonmember.
 5  Monthly water consumption forecast.
    a) single-family resid., b) multi-family resid., c) non-residential,
    d) on-project,  e) off-project  f) total service area.
 6  Monthly forecast with and without demand adjustments
    a) on-project/single-family,      b) off-project/single-family,
    c) on-project/multi-family,       d) off-project/multi-family,
    e) on-project/nonresidential,     f) off-project/nonresidential.
ENDTEXT
STYLE ATTRIBUTE 112
x = "[Esc] Go To Menu [Return] Accept [Backspace]"
x = x+" Delete Chr [Ctrl][Backsp] New Entry"
@24,0 ?? x

aesc = false
;RepScreen(31)
;PathRep = "f:\\par\\"
xpath=PathFrom
CheckPath(3,16)
IF aesc = true THEN RETURN
ENDIF
PathFrom=xpath
SHOWTABLES PathFrom
"Select table to be saved in Lotus 123 format, then press Enter"
TO tname
tableFrom = PathFrom+tname
IF NOT(ISTABLE(tableFrom)) THEN RETURN
ENDIF
STYLE ATTRIBUTE v1n
@3,55
?? " table: :"+tname
aShow(" table: "+tname,3,55,18,v1n)
tname = tname+".WK1"
aShow(tname,7,16,12,v1n)
PathTo = PathFrom
aShow(PathFrom,5,16,35,v1n)
xpath = PathTo
TakePath(5,16)
PathTo = xpath

WHILE TRUE
  STYLE ATTRIBUTE v1a
  @7,16
  aRow=7
  ACCEPT "A12"
    DEFAULT tname
    TO tname
  IF retval = false THEN aesc = true RETURN tname
  ENDIF
  ClearMsg(mline,v1n)
  FileTo = PathTo + tname
  IF ISFILE(FileTo)
    THEN
    aShow(" Table exists, overvrite it? (n/y) ",aRow,26,35,v1w)
    STYLE ATTRIBUTE v1a
    ACCEPT "A1" TO choice
    IF retval = false THEN aesc = true RETURN
    ENDIF
    IF ((choice <>"Y") AND (choice <> "y"))
      THEN LOOP
    ENDIF
  ENDIF
  aShow(" ",aRow,26,36,v1n)
  aShow(tname,aRow,16,12,v1h)
  CANVAS OFF
  RUN "Del "+FileTo
  {Tools} {ExportImport} {Export} {1-2-3} {2) 1-2-3 Release 2}
  SELECT TableFrom SELECT FileTo
  CANVAS ON
  IF errorcode() <> 0 THEN LOOP
  ENDIF
QUITLOOP
ENDWHILE
RETURN
ENDPROC ;exportWK1




;**************************************************************************
;      NAME: FindParameters(RepNo)
;     EVENT: Determines the tables in which model parameters
;            are stored
; ARGUMENTS: RepNo - report number
; TABLES   : all
; ARRAYS   :
; VARIABLES: aesc, PathRep, aRow, tname, v1h, v1a
;     NOTES: ??
;                                                    v41  ...92
;**************************************************************************
PROC FindParameters(RepNo)

; USEVARS tcpa, tsix, tdfx, tace, tmsf, tlld, tllp,
;         tuna, tpzf, tbch, tvch, twra, tjrs, tduf,
;         twdo, trrd, trpz, tabmsf

; USEVARS tabcpa, tabsix, tabdfx, tabace, tabmsf, tablld, tabllp,
;         tabuna, tabpzf, tabbch, tabvch, tabwra, tabjrs, tabduf,
;         tabwdo, tabrrd, tabrpz, tabmsf

; USEVARS aesc, PathRep,v1h,v1a,v1n,RepDate

x1 = " Normal weather water consumption per account:"   ;cpa
x2 = " Seasonal index of water use per account:"        ;six
x3 = " Coefficients of account core equations:"         ;ace
x4 = " Proportions of the unaccounted for water:"       ;una
x5 = " Low/High demand adjustments factors & st.dev.:"  ;dfx
x6 = " Pressure zone fractions:"                        ;pzf
x7 = " Monthly base charges:"                           ;bch
x8 = " Volume charges for above lifeline water use:"    ;vch
x9 = " Multi-family dwelling unit factors:"             ;duf
x10= " Proportions of accounts (South of Jomax Road):"  ;jrs
x11= " Water and Sewer Development Occupational Fees:"  ;wdo
x12= " Monthly record of revenues:"                     ;rrd
x13= " Monthly production record (by pressure zone):"   ;rpz
x14= " Water Resource Acquisition Fees:"                ;wra
x15= " Proportions of consumption below the lifeline:"  ;lld
x16= " Monthly distribution of the lifeline levels:"    ;llp
x17= " Meter size fractions:"                           ;msf
x18= " Temperature and precipitation ratios:"           ;tpr
x19= " Marginal price, fixed charge, and new account:"  ;mfn
x20= " Active retrofits:"                               ;ret
x21= " Elasticities:"                                   ;ela

CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@0,0
TEXT
              WDFM: Model parameters. Reports
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様
ENDTEXT
@3,1 ?? "Directory with model parameters:"
@5,2 ?? "Tables:"

@20,1 ?? "Report Date: "
aShow(STRVAL(RepDate),20,14,11,v1n)
STYLE ATTRIBUTE 112
x = "[Esc] Go To Menu [Return] Accept [Backspace]"
x = x+" Delete Chr [Ctrl][Backsp] New Entry"
@24,0 ?? x

SWITCH
  CASE RepNo = 1: ashow("1a and 1b",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3 ? x4 ? x5
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
                  ashow(tuna,9,48,8,v1h)
                  ashow(tdfx,10,48,8,v1h)
  CASE RepNo = 2: ashow("2a, 2b, and 2c",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3 ? x4 ? x6 ? x13
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
                  ashow(tuna,9,48,8,v1h)
                  ashow(tpzf,10,48,8,v1h)
                  ashow(trpz,11,48,8,v1h)
  CASE RepNo = 3: ashow("3a, 3b, and 3c",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3 ? x7 ? x8 ? x9 ? x10
                  ? x11 ? x12 ? x14 ? x15 ? x16 ? x17
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
                  ashow(tbch,9,48,8,v1h)
                  ashow(tvch,10,48,8,v1h)
                  ashow(tduf,11,48,8,v1h)
                  ashow(tjrs,12,48,8,v1h)
                  ashow(twdo,13,48,8,v1h)
                  ashow(trrd,14,48,8,v1h)
                  ashow(twra,15,48,8,v1h)
                  ashow(tlld,16,48,8,v1h)
                  ashow(tllp,17,48,8,v1h)
                  ashow(tmsf,18,48,8,v1h)
  CASE RepNo = 4: ashow("4a and 4b",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
  CASE RepNo = 5: ashow("from 5a to 5f",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3 ? x5
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
                  ashow(tdfx,9,48,8,v1h)
  CASE RepNo = 6: ashow("from 6a to 6f",0,46,15,v1n)
                  @5,1 ? x1 ? x2 ? x3 ? x18 ? x19
                       ? x20 ? x21
                  ashow(tcpa,6,48,8,v1h)
                  ashow(tsix,7,48,8,v1h)
                  ashow(tace,8,48,8,v1h)
                  ashow(ttpr,9,48,8,v1h)
                  ashow(tmfn,10,48,8,v1h)
                  ashow(tret,11,48,8,v1h)
                  ashow(tela,12,48,8,v1h)

ENDSWITCH
xpath = PathPar
CheckPath(3,34)
IF aesc = true THEN RETURN
ENDIF
PathPar = xpath
SWITCH
  CASE RepNo=1:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname
    tname = tuna  CheckTable(9) IF aesc=true THEN RETURN
    ENDIF tuna = tname  tabuna = tabname  VIEW tabname
    tname= tdfx  CheckTable(10) IF aesc=true THEN RETURN
    ENDIF tdfx = tname  tabdfx = tabname  VIEW tabname
  CASE RepNo=2:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname
    tname = tuna  CheckTable(9) IF aesc=true THEN RETURN
    ENDIF tuna = tname  tabuna = tabname  VIEW tabname
    tname= tpzf  CheckTable(10) IF aesc=true THEN RETURN
    ENDIF tpzf = tname  tabpzf = tabname  VIEW tabname
    tname= trpz  CheckTable(11) IF aesc=true THEN RETURN
    ENDIF trpz = tname  tabrpz = tabname  VIEW tabname
  CASE RepNo=3:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname
    tname = tbch  CheckTable(9) IF aesc=true THEN RETURN
    ENDIF tbch = tname  tabbch = tabname  VIEW tabname
    tname= tvch  CheckTable(10) IF aesc=true THEN RETURN
    ENDIF tvch = tname  tabvch = tabname  VIEW tabname
    tname= tduf  CheckTable(11) IF aesc=true THEN RETURN
    ENDIF tduf = tname  tabduf = tabname  VIEW tabname
    tname= tjrs  CheckTable(12) IF aesc=true THEN RETURN
    ENDIF tjrs = tname  tabjrs = tabname  VIEW tabname
    tname= twdo  CheckTable(13) IF aesc=true THEN RETURN
    ENDIF twdo = tname  tabwdo = tabname  VIEW tabname
    tname= trrd  CheckTable(14) IF aesc=true THEN RETURN
    ENDIF trrd = tname  tabrrd = tabname  VIEW tabname
    tname= twra  CheckTable(15) IF aesc=true THEN RETURN
    ENDIF twra = tname  tabwra = tabname  VIEW tabname
    tname= tllp  CheckTable(16) IF aesc=true THEN RETURN
    ENDIF tllp = tname  tabllp = tabname  VIEW tabname
    tname= tlld  CheckTable(17) IF aesc=true THEN RETURN
    ENDIF tlld = tname  tablld = tabname  VIEW tabname
    tname= tmsf  CheckTable(18) IF aesc=true THEN RETURN
    ENDIF tmsf = tname  tabmsf = tabname  VIEW tabname
  CASE RepNo=4:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname
  CASE RepNo=5:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname
    tname = tdfx  CheckTable(9) IF aesc=true THEN RETURN
    ENDIF tdfx = tname  tabdfx = tabname  VIEW tabname
  CASE RepNo=6:
    tname = tcpa  CheckTable(6) IF aesc=true THEN RETURN
    ENDIF tcpa = tname  tabcpa = tabname  VIEW tabname
    tname = tsix  CheckTable(7) IF aesc=true THEN RETURN
    ENDIF tsix = tname  tabsix = tabname  VIEW tabname
    tname = tace  CheckTable(8) IF aesc=true THEN RETURN
    ENDIF tace = tname  tabace = tabname  VIEW tabname

    tname = ttpr  CheckTable(9) IF aesc=true THEN RETURN
    ENDIF ttpr = tname  tabtpr = tabname  VIEW tabname
    tname= tmfn  CheckTable(10) IF aesc=true THEN RETURN
    ENDIF tmfn = tname  tabmfn = tabname  VIEW tabname
    tname = tret  CheckTable(11) IF aesc=true THEN RETURN
    ENDIF tret = tname  tabret = tabname  VIEW tabname
    tname= tela  CheckTable(12) IF aesc=true THEN RETURN
    ENDIF tela = tname  tabela = tabname  VIEW tabname
ENDSWITCH
IF aesc = true THEN RETURN
ENDIF
Ashow(STRVAL(RepDate),20,14,11,v1a)
@20,14 TakeRepDate()
RETURN
ENDPROC ; FindParameters




;**************************************************************************
;      NAME: ashow(aWhat, aRow, aCol, aLen, Attrib)
;     EVENT: displays information on the canvas
; ARGUMENTS: aWhat - text information to be displayed
;            aRow - row in which aWhat will be shown (0..24)
;            aCol - column in which text starts (0..79)
;            aLen - length of the field (aWhat + spaces)
;            Attrib - text attribute specification
; VARIABLES: see arguments
;                                              v42 16.III.92
;**************************************************************************
PROC ashow(aWhat, aRow, aCol, aLen, Attrib)
PRIVATE y
STYLE ATTRIBUTE Attrib
y = LEN(aWhat)
IF aLen < y  THEN aWhat = SUBSTR(aWhat,1,aLen) ENDIF
@ aRow, aCol
?? aWhat + SPACES(aLen - LEN(aWhat))
RETURN
ENDPROC


;**************************************************************************
;      NAME: cError()
;     EVENT: displays both: a runtime error code and the error message
;            The statement triggering the error is skipped, so
;            that execution resumes at the next statement following
;            the current one.
; VARIABLES: msg - text of a message (local)
;            mlime - line in which the message is displayed
;            attrib - style attribute code
;     NOTES: 80 characters is displayed (complete screen line)
;            (can I use arguments ?)
;                                                   v42 16.III.91
;**************************************************************************
PROC cError()
;USEVARS mline, v1w
msg = "error " + STRVAL(ERRORCODE())+ " " + ERRORMESSAGE()
Ashow(msg, mline, 0, 80, v1w)
RETURN 2
ENDPROC ; cError

;**************************************************************************
;      NAME: MsgCalc(txt,aCol)
;     EVENT: Displays messages during forecasting process
; ARGUMENTS: txt,aCol
; VARIABLES: t1,t2,t3,t4,t5
;     NOTES: whatever
;                                                     v42 16.III.91
;**************************************************************************
PROC MsgCalc(txt,aCol)
; USEVARS t1, t2, t3, t4, t5
STYLE ATTRIBUTE 14
t5 = txt
@17,aCol ??t1 @18,aCol ??t2 @19,aCol ??t3
@20,aCol ??t4 @21,aCol ??t5 t1=t2 t2=t3 t3=t4 t4=t5
RETURN
ENDPROC ;MsgCalc




;**************************************************************************
;      NAME: ClearMsg(mline,attrib)
;     EVENT: Clears one complete line on the screen (80 characters)
; ARGUMENTS: mlime - specifies line to be cleared
;            attrib - style attribute code
;     NOTES: (info might be passed by arguments)
;                                                    v42   16.III.91
;**************************************************************************
PROC ClearMsg(mline, attrib)
Ashow(" ", mline, 0, 80, attrib)
RETURN
ENDPROC ; ClearMSg

;**************************************************************************
;      NAME: TakeRepDate()
;     EVENT: takes RepDate (Report Date)
;**************************************************************************
PROC TakeRepDate()
;USEVARS aesc, RepDate
ACCEPT "D"
  DEFAULT RepDate
  TO RepDate
IF Retval = False THEN aesc = TRUE RETURN
ENDIF
RETURN
ENDPROC

;**************************************************************************
;      NAME: TakePath(aRow,aCol)
;     EVENT: accepts the path (default or specified by user)
;            to the directory where a tables are stored. If directory
;            does not exists, it can be created. The procedure
;            checks if the name of the directory to be
;            created is correct.
; ARGUMENTS: aRow -row, aCol - column (some restrictions apply)
; VARIABLES: v1n, v1a, v1h, v1w - style attributes (normal, active,
;               highlighted, warning)
;            rpath, apath, xPath - path (text)
;            aesc = true if [Esc] was pressed (go to menu)
;            otherwise aesc = false (continue)
;     NOTES: communication with the rest of the model by the variable
;            xpath (and usevars)
;
;                                                 v42  16.III.91
;**************************************************************************
PROC TakePath(aRow,aCol)
;USEVARS xPath, v1w, v1n, v1a, v1h, aesc
rpath = xpath
aR1=aRow+1
WHILE TRUE
STYLE ATTRIBUTE v1a
@aRow,aCol
ACCEPT "a35"    ; take path
  DEFAULT rpath
  TO rpath
 IF Retval = False THEN aesc = True RETURN
 ENDIF
apath=rpath
IF SUBSTR(rpath,LEN(rpath),LEN(rpath))<>"\\"
   THEN rpath = rpath + "\\"
   ELSE apath = SUBSTR(rpath,1,LEN(rpath)-1)
ENDIF
STYLE ATTRIBUTE v1n
@ar1,acol
?? SPACES(61)

IF DIREXISTS(rpath)<>1
  THEN STYLE ATTRIBUTE v1w
    @ar1, acol
    ?? " Directory does not exist, do you want to create it ? (n/y) "
    STYLE ATTRIBUTE v1a
    ACCEPT "a1" TO choice
    IF Retval = False THEN aesc = True RETURN
    ENDIF
    IF ((choice="y") OR (choice="Y"))
      THEN RUN "mkdir "+apath
      ELSE LOOP
    ENDIF
    IF DIREXISTS(rpath) <> 1
      THEN @ar1,acol
           STYLE ATTRIBUTE v1w
           ?? " Invalid DOS specification, please enter another path        "
           LOOP
      ELSE STYLE ATTRIBUTE v1n
           @ar1,acol
           ?? SPACES(61)
           QUITLOOP
    ENDIF
    ELSE QUITLOOP
ENDIF
ENDWHILE
aShow(rpath,aRow,aCol,35,v1h)
STYLE ATTRIBUTE v1n
xpath = rpath
RETURN rpath
ENDPROC  ;TakePath




;**************************************************************************
;      NAME: CheckPath(aRow,aCol)
;     EVENT: accepts the path (default or specified by user)
;            to the directory where a model parameters are stored.
; ARGUMENTS: aRow,aCol
; VARIABLES: v1n, v1a, v1h, v1w - style attributes (normal, active,
;               highlighted, warning)
;            rpath, apath , xPath - path (text)
;            aesc = true if [Esc] was pressed (go to menu)
;            otherwise aesc = false (continue)
;     NOTES: procedure uses xpath to i/o path
;                                            v1.5  13.I.91
;**************************************************************************
PROC CheckPath(aRow,aCol)
;USEVARS xPath, v1w, v1n, v1a, v1h, aesc
rpath = xpath
WHILE TRUE
  STYLE ATTRIBUTE v1a
  @ aRow,acol
  aR1=aRow+1
  ACCEPT "a35"    ; take path
    DEFAULT rpath
    TO rpath
  IF Retval = False THEN aesc = True RETURN
  ENDIF
  apath=rpath
  IF SUBSTR(rpath,LEN(rpath),LEN(rpath))<>"\\"
    THEN rpath = rpath + "\\"
    ELSE apath = SUBSTR(rpath,1,LEN(rpath)-1)
  ENDIF
  ashow(" ",aR1,aCol,35,v1n)
  IF DIREXISTS(rpath)=1
    THEN xpath = rpath
         QUITLOOP
    ELSE ashow(" Directory does not exist!",aR1,aCol,27,v1w)
         LOOP
  ENDIF
ENDWHILE
aShow(xpath,aRow,aCol,35,v1h)
STYLE ATTRIBUTE v1n
RETURN rpath ; return parameter is not important
ENDPROC  ;CheckPath


;**************************************************************************
;      NAME: TakeTable()
;     EVENT: accepts name of the table (default or specified by user)
;            where predictions will be stored. If the table exists
;            the procedure asks if the user wants to overwrite existing
;            table. The procedure checks if the name of the table is
;            correct.
; VARIABLES: v1n, v1a, v1h, v1w - style attributes (normal, active,
;               highlighted, warning)
;            TemName - complete name of the template table (path incl.)
;            PathTem - path to the directory which contains templates
;            tname - table name
;            atable - complete output table name
;            aRow - # of row used
;            rpath - model output path (text)
;            aesc = true if [Esc] was pressed (go to menu)
;                   otherwise aesc = false (continue)
;
;     NOTES:
;
;                                            (+/-) tested  v1.8  1.I.92
;**************************************************************************
PROC TakeTable()
TemName = PathTem + tname
WHILE TRUE
  STYLE ATTRIBUTE v1a
  @aRow, 30
  ACCEPT "A8"
    DEFAULT tname
    TO tname
  IF retval = false THEN aesc = true RETURN tname
  ENDIF
  ClearMsg(mline,v1n)
  atable = rpath + tname
  IF ISTABLE(atable)
    THEN
    aShow(" Table exists, overvrite it? (n/y) ", aRow,40,35,v1w)
    STYLE ATTRIBUTE v1a
    ACCEPT "A1" TO choice
    IF retval = false THEN aesc = true RETURN atable
    ENDIF
    IF ((choice <>"Y") AND (choice <> "y"))
      THEN LOOP
    ENDIF
  ENDIF
  aShow(SPACES(36),aRow,40,36,v1n)
  aShow(tname,aRow,30,8,v1h)
  COPY TemName atable
  IF errorcode() <> 0 THEN LOOP
  ENDIF
QUITLOOP
ENDWHILE
RETURN atable     ; path included
ENDPROC ;TakeTable

;**************************************************************************
;      NAME: CheckTable()
;     EVENT: Cheks if a given table exists. User must give the name of an
;            existing table or escape [Esc]
; TABLES   : specified by variables
; VARIABLES: v1n, v1a, v1h, v1w - style attributes (normal, active,
;               highlighted, warning)
;            tabName - complete name of the table (path incl.)
;            PathPar - path to the directory which contains parameters
;            tname - table name
;            aRow - # of row used
;            aesc = true if [Esc] was pressed (go to menu)
;                   otherwise aesc = false (continue)
;
;     NOTES: must have PathPar, tname, aRow, and returns tname, tabname
;
;                                           xxxx       v2.0  21.I.92
;**************************************************************************
PROC CheckTable(aRow)
tabName = PathPar + tname
aCol = 48
WHILE TRUE
  STYLE ATTRIBUTE v1a
  @aRow, aCol
  ACCEPT "A8"
    DEFAULT tname
    TO tname
  IF retval = false THEN aesc = true RETURN tname
  ENDIF
  ClearMsg(mline,v1n)
  tabName = pathPar + tname
  IF ISTABLE(tabname)
    THEN
      aShow(" ",aRow,57,22,v1n)
      aShow(tname,aRow,acol,8,v1h)
      QUITLOOP
    ELSE
      aShow(" Table does not exist!",aRow,57,22,v1w)
      LOOP
  ENDIF
ENDWHILE
RETURN
ENDPROC ;CheckTable



;**************************************************************************
;      NAME: ForScreen(x,v1n)
;     EVENT: Display " entrance screens during calculations"
; ARGUMENTS: v1n - style attribute
;            x - report indicators (text)
; VARIABLES: mlime - specifies a line to be cleared (global)
;            v1n - style attribute code (global)
;     NOTES: ..
;
;                                                    tested  v1 31.XII.91
;**************************************************************************
PROC ForScreen(x,v1n)
CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@0,0
TEXT
                  WDFM: Forecasts for Reports
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様

 Output Path:



 Output Tables for:
ENDTEXT
@0,46
?? x
FOR i FROM 1 TO j
@6+i,20
?? trep[i]
ENDFOR

STYLE ATTRIBUTE 112
x = "[Esc] Go To Menu [Return] Accept [Backspace]"
x = x+" Delete Chr [Ctrl][Backsp] New Entry"
@24,0 ?? x
RETURN
ENDPROC ;ForScreen


;**************************************************************************
;      NAME: ParamScreen(v1n)
;     EVENT: Display " entrance screen for PARAMETERS"
; ARGUMENTS: v1n - style attribute
; VARIABLES: v1n - style attribute code (global)
;     NOTES: ..
;                                                    tested  v1 12.I.92
;**************************************************************************
PROC ParamScreen(v1n)
CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@0,0
TEXT
                        WDFM: Editing Tables
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様
Default tables:
 Normal weather water consumption per account: . . . "cpa000"
 Seasonal index of water use per account:  . . . . . "six000"
 Coefficients of account core equations: . . . . . . "ace000"
 Proportions of the unaccounted for water: . . . . . "una000"
 Low/High demand adjustments factors & st.dev.:  . . "dfx000"
 Pressure zone fractions:  . . . . . . . . . . . . . "pzf000"
 Monthly base charges and bad dept multiplier: . . . "bch000"
 Volume charges and bad dept adj. multiplier:  . . . "vch000"
 Multi-family dwelling unit factors: . . . . . . . . "duf000"
 Proportions of accounts (South of Jomax Road):  . . "jrs000"
 Water and Sewer Development Occupational Fees:  . . "wdo000"
 Monthly record of revenues: . . . . . . . . . . . . "rrd000"
 Monthly production record (by pressure zone): . . . "rpz000"
 Water Resource Acquisition Fees:  . . . . . . . . . "wra000"
 Proportions of consumption below the lifeline:. . . "lld000"
 Monthly distribution of the lifeline levels:  . . . "llp000"
 Meter size fractions: . . . . . . . . . . . . . . . "msf000"
 Temperature and precipitation ratios: . . . . . . . "tpr000"
 Marginal price, fixed charge, and new account:  . . "mfn000"
 Active retrofits: . . . . . . . . . . . . . . . . . "ret000"
 Elasticities: . . . . . . . . . . . . . . . . . . . "ela000"
 Vacant 5. . . . . . . . . . . . . . . . . . . . . .
ENDTEXT
RETURN
ENDPROC ;ParamScreen



;**************************************************************************
;      NAME: CalcScreen(v1n)
;     EVENT: Display " entrance screens during calculations"
; ARGUMENTS: v1n - style attribute
; VARIABLES: v1n - style attribute code (global)
;     NOTES: ..
;                                                    tested  v1 12.I.92
;**************************************************************************
PROC CalcScreen(v1n)
CLEAR
PAINTCANVAS ATTRIBUTE v1n 0, 0, 24, 79
STYLE ATTRIBUTE v1n
@2,0
TEXT
                        WDFM: Calculating Predictions
様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様

 1  Monthly water production forecast
    a) on-project,  b) off-project and nonmember
 2  Water production forecast: current and next fiscal year.
    a) pressure zones A to D,  b) pressure zones E to H
    c) unknown or not coded in WCIS, on/off-project, and total service area.
 3  Revenue projection: current and next fiscal year
    a) base charge, consumption charge, and total water rate revenue,
    b) resource acquisition fee, water and sewer development occupational fee.
    c) summary report of 3a) and 3b).
 4  Long-term projections for comparison to PHXMAIN
    a) on-project,  b) off-project and nonmember.
 5  Monthly water consumption forecast.
    a) single-family resid., b) multi-family resid., c) non-residential,
    d) on-project,  e) off-project and nonmember,
    f) total service area.
 6  Monthly forecast with and without demand adjustments
    a) on-project/single-family,      b) off-project/single-family,
    c) on-project/multi-family,       d) off-project/multi-family,
    e) on-project/nonresidential,     f) off-project/nonresidential.
ENDTEXT
RETURN
ENDPROC ;CalcScreen





;**************************************************************************
;      NAME: fcpa(i)
;     EVENT: extracts normal weather, deseasonalized water consumption
;            per account from table tabcpa
;     UNITS: ccf/month/acct
; ARGUMENTS: i - specifies user/planning area category [i = 1..6]
; TABLES   : tabcpa
; ARRAYS   : awork
; VARIABLES: i
;                                                    tested  v2.1 3.XII.91
;**************************************************************************
PROC fcpa(i)
MOVETO tabcpa
MOVETO RECORD 1
COPYTOARRAY awork
RETURN awork[i+1]
ENDPROC

;**************************************************************************
;      NAME: fsix(m,i)
;     EVENT: extracts seasonal indices from table tabsix
;     UNITS: dimensionless
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
;            i - indicates user/planning area category [i = 1..6]
; TABLES   : tabsix
; ARRAYS   : awork
; VARIABLES: m, i
;     NOTES: table tabsix has first two fields inactive
;                                                    tested  v2.1 3.XII.91
;**************************************************************************
PROC fsix(m,i)
MOVETO tabsix
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[i+2]
ENDPROC


;**************************************************************************
;      NAME: face(my,i)
;     EVENT: determines number of accounts
;     UNITS: # of accounts
; ARGUMENTS: my - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;            1986, and so on]
;            i - indicates user/planning area category [i = 1..6]
; TABLES   : tabace
; ARRAYS   : awork[]
;          : aM[6]  (PROC slopes() assignes values to this array)
; VARIABLES: my, i
;     NOTES: Before this procedure may be used the time interval limits
;            aM[1] . . . aM[5] must be evaluated by PROC slopes()
;                               partially tested       27.III.92
;**************************************************************************
PROC face(my,i)
MOVETO tabace
IF my < aM[1]
  THEN
    MOVETO RECORD 1
    COPYTOARRAY awork
    accts = awork[1+i]
    MOVETO RECORD 2
    COPYTOARRAY awork
    accts = accts + awork[i+1] * my
  ELSE
    MOVETO RECORD 1
    COPYTOARRAY awork
    accts = awork[1+i]
    MOVETO RECORD 2
    COPYTOARRAY awork
    accts = accts + awork[i+1] * aM[1]
    IF my < aM[2]
      THEN
        MOVETO RECORD 3
        COPYTOARRAY awork
        accts = accts+awork[i+1]*(my - aM[1])
      ELSE
        MOVETO RECORD 3
        COPYTOARRAY awork
        accts = accts+awork[i+1]*(aM[2]-aM[1])
        IF my < aM[3]
          THEN
            MOVETO RECORD 4
            COPYTOARRAY awork
            accts = accts+awork[i+1]*(my - aM[2])
          ELSE
            MOVETO RECORD 4
            COPYTOARRAY awork
            accts = accts+awork[i+1]*(aM[3]-aM[2])
            IF my < aM[4]
              THEN
                MOVETO RECORD 5
                COPYTOARRAY awork
                accts = accts+awork[i+1]*(my - aM[3])
              ELSE
                MOVETO RECORD 5
                COPYTOARRAY awork
                accts = accts+awork[i+1]*(aM[4]-aM[3])
                MOVETO RECORD 6
                COPYTOARRAY awork
                accts = accts+awork[i+1]*(my-aM[4])
            ENDIF
        ENDIF
    ENDIF
ENDIF
RETURN accts
ENDPROC  ;face


;**************************************************************************
;      NAME: fmsf(m,i)
;     EVENT: extracts meter size fractions from table tabmsf
;     UNITS: dimensionless
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
;            i - indicates user/planning area category [i = 1..6]
; TABLES   : tabmsf
; ARRAYS   : awork
; VARIABLES: m, i
;     NOTES: table tabmsf has first two fields inactive
;                                                    tested  v2.1 3.XII.91
;**************************************************************************
PROC fmsf(m,i)
MOVETO tabmsf
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[i+2]
ENDPROC


;**************************************************************************
;      NAME: fbch(k)
;     EVENT: extracts base charges from table tabbch
;     UNITS: $ US Dollar
; ARGUMENTS: k - indicates meter size category [k = 1 (5/8")..7 (6")]
; TABLES   : tabbch
; ARRAYS   : awork
; VARIABLES: k
;     NOTES: table tabbch has first two fields inactive
;                                                    tested  v1.1 13.I.91
;**************************************************************************
PROC fbch(k)
MOVETO tabbch
MOVETO RECORD k
COPYTOARRAY awork
RETURN awork[3]
ENDPROC
;**************************************************************************
;      NAME: fvch(m)
;     EVENT: extracts volume charges from table tabvch
;     UNITS: US Dollar
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
; TABLES   : tabvch
; ARRAYS   : awork
; VARIABLES: m
;     NOTES: table tabvch has first two fields inactive
;                                                    tested  v1.1 13.I.91
;**************************************************************************
PROC fvch(m)
MOVETO tabvch
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[3]
ENDPROC

;**************************************************************************
;      NAME: fwra(k,i,kk)
;     EVENT: extracts water resources acquisition fees from table tabwra
;     UNITS: Dollars
; ARGUMENTS: i - specifies area category (i = 1..On-project
;                i = 2, off-project, South of Jomax Road
;                i = 3, off-project, North of Jomax Road
;            k - meter size category  k=1 (5/8") to k=7 (6")
;            kk - kk = 1 current fiscal year
;                kk = 2 next fiscal year
; TABLES   : tabwra
; ARRAYS   : awork
; VARIABLES: k,i,kk
;                                         version 47  10.IV.92
;**************************************************************************
PROC fwra(k,i,kk)
MOVETO tabwra
MOVETO RECORD k
COPYTOARRAY awork
RETURN awork[2*i+kk]
ENDPROC

;**************************************************************************
;      NAME: fjrs(k,kk,i)
;     EVENT: extracts proportions of accounts in "South of Jomax
;            Road" area
;     UNITS: dimensionless
; ARGUMENTS: i = 1 Single-family residential
;            i = 2,Nonresidential
;            kk= 1 curent fiscal year (first data set)
;            kk= 2 next fiscal year (second data set)
;            k - meter size category  k=1 (5/8") to k=7 (6")
; TABLES   : tabjrs
; ARRAYS   : awork
; VARIABLES: k,kk,i
;                                     xxx tested  v1.3 13.I.92
;**************************************************************************
PROC fjrs(k,kk,i)
MOVETO tabjrs
MOVETO RECORD k
COPYTOARRAY awork
RETURN awork[i+2*kk]
ENDPROC

;**************************************************************************
;      NAME: fduf(i)
;     EVENT: extracts dwelling units factors from table tabduf
;     UNITS: units/acct
; ARGUMENTS: i = 1 on-project, (units per acct)
;            i = 2,off-project, South of Jomax Road
;                  (units per acct * S fraction of off-proj.)
;            i = 3,off-project, North of Jomax Road
;                  (units per acct * N fraction of off-project)
;            i = 4 total service area
; TABLES   : tabduf
; ARRAYS   : awork
; VARIABLES: i
;                                      xxx tested  v1.3 13.I.92
;**************************************************************************
PROC fduf(i)
MOVETO tabduf
MOVETO RECORD 1
COPYTOARRAY awork
RETURN awork[i+1]
ENDPROC

;**************************************************************************
;      NAME: fwdo(i,s,k)
;     EVENT: extracts Water and Sewer Development Occupational Fees
;     UNITS: Dollars
; ARGUMENTS: i = 1 single-family i=2 multi-family residential
;            i = 3 nonresidential
;            k= 1 Water Development Occupational Fees, k= 2 Sewer DOF
;            s - meter size category  s = 1 (5/8") to s = 7 (6")
; TABLES   : tabwdo
; ARRAYS   : awork
; VARIABLES: k,s,i
;                                      xxx tested  v1.3 13.I.92
;**************************************************************************
PROC fwdo(i,s,k)
MOVETO tabwdo
IF i < 3
  THEN  MOVETO RECORD i
  ELSE  MOVETO RECORD s+2
ENDIF
COPYTOARRAY awork
RETURN awork[k+3]
ENDPROC


;**************************************************************************
;      NAME: IfRecorded(i,fy)
;     EVENT: extracts recorded revenues and determines jj and SumObserved
;     UNITS: Dollars
; ARGUMENTS: i = 1 monthly revenue from base charges
;            i = 2 monthly revenue from volume charges
;            i = 3 monthly revenue from acquisition fees
;            i = 4 monthly revenue from water development fees
;            i = 5 monthly revenue from sewer development fees
;            fy - fiscal year
; TABLES   : tabrrd
; ARRAYS   : awork
; VARIABLES: kk,y,i
; NOTES:     current version of IfRecorded does not utilize the
;            parameter fy (fiscal year) and variables kk,y.
;                                      xxx tested  v1.5 14.I.92
;**************************************************************************
PROC IfRecorded(i,fy)
MOVETO tabrrd          ; table with observed revenues
kk = 0        ;Number of a record which has [date] = July/fy minus 1
y = 12       ;y = MAX(12, NoRecords in table - kk)
jj=0
SumObserved = 0.0
WHILE jj <> y
  jj = jj+1
  MOVETO RECORD kk+jj
  COPYTOARRAY awork
  IF awork[i+2] <= 0.0
    THEN jj = jj-1  ; no record available for this month
         RETURN
  ENDIF
  SumObserved = SumObserved + awork[i+2]
ENDWHILE
  MsgCalc(" months with observed values "+strval(jj)+" ",40)
RETURN
ENDPROC

;**************************************************************************
;      NAME: IfRecZone(i,fy)
;     EVENT: extracts recorded production and determines jj and SumObserved
;     UNITS: Acre-feet
; ARGUMENTS: i = 1..9 pressure zones A..H, and Unknown
;            i = 10/11 on/off-project
;            i = 12 total service area
;            fy - fiscal year
; TABLES   : tabrpz
; ARRAYS   : awork
; VARIABLES: kk,y,i
; NOTES:     current version of IfRecorded does not utilize the
;            parameter fy (fiscal year) and variables kk,y.
;                                      xxx tested  v1.5 14.I.92
;**************************************************************************
PROC IfRecZone(i,fy)
MOVETO tabrpz          ; table with observed production by zone
kk = 0        ;Number of a record with [date] = July/fy minus 1
y = 12       ;y = MAX(12, NoRecords in table - kk)
jj=0
SumObserved = 0.0
WHILE jj <> y
  jj = jj+1
  MOVETO RECORD kk+jj
  COPYTOARRAY awork
  IF awork[i+2] <= 0.0
    THEN jj = jj-1  ; no record available for this month
         RETURN
  ENDIF
  SumObserved = SumObserved + awork[i+2]
ENDWHILE
  MsgCalc(" months with observed values "+strval(jj)+" ",40)
RETURN
ENDPROC


;**************************************************************************
;      NAME: fllp(m,i)
;     EVENT: extracts lifeline proportions from table tabllp according to
;            the monthly distribution of lifeline levels which are taken
;            from table tablld
;     UNITS: dimensionless
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
;            i - indicates user/planning area category [i = 1..6]
; TABLES   : tabllp  lifeline proportions
;            tablld  lifeline distribution
; ARRAYS   : awork
; VARIABLES: m, i, s
;     NOTES: table tablld has first two fields inactive
;            table tabllp has first two fields inactive
;                                               xxx tested  v2.1 3.XII.91
;**************************************************************************
PROC fllp(m,i)
MOVETO tablld
MOVETO RECORD m
COPYTOARRAY awork
s = awork[3]
MOVETO tabllp
MOVETO RECORD (s-1)*12+m
COPYTOARRAY awork
RETURN awork[i+2]
ENDPROC

;**************************************************************************
;      NAME: funa(m,i,s)
;     EVENT: extracts the monthly proportions of the unaccounted for water
;            from table tabuna
;     UNITS: dimensionless
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
;            i - planning area category [i=1 on-project, i=2 off-project]
;            s - pressure zone [s=1 zone A, s=2 zone B. . . s=9 unassigned
;                               s=10 only planning area subdivision]
; TABLES   : tabuna
; ARRAYS   : awork
; VARIABLES: m, i, s
;     NOTES: this version takes only average unaccounted for water
;             the smoothed values are not included
;                                                 rewrited  v2.6 14.I.92
;**************************************************************************
PROC funa(m,i,s)
MOVETO tabuna
MOVETO RECORD m
COPYTOARRAY awork
IF s=10 THEN RETURN awork[2+i]
       ELSE RETURN awork[9*i-5+s]
ENDIF
ENDPROC

;**************************************************************************
;      NAME: fdfx(m,i,s)
;     EVENT: extracts the demand adjustment factors
;     UNITS: dimensionless
; ARGUMENTS: m - month of the fiscal year [m = 1 (Jul)..12 (Jun)]
;            i - planning area/user category [i=1 ..6]
;            s - data set [s=1 on/off-project historical low
;                       s=2 on/off-project historical high
;                       s=3 on/off-project demand adj. fraction st. deviation]
; TABLES   : tabdfx
; ARRAYS   : awork
; VARIABLES: m, i, s
;     NOTES:  first three columns are inactive, historical High/Low
;             give High/Low consumption by planning area
;             (total High/Low overestimated, User category High/low
;              underestimated)
;                                                tested?  v2.3 4.I.92
;**************************************************************************
PROC fdfx(m,i,s)
MOVETO tabdfx
MOVETO RECORD (s-1)*12+m
COPYTOARRAY awork
RETURN awork[i+3]
ENDPROC

;**************************************************************************
;      NAME: fpzf(s,m,i)
;     EVENT: extracts pressure zone fractions from the table tabpzf
;     UNITS: dimensionless
; ARGUMENTS: s - indicate year of prediction [s = 1 current fiscal year,
;                s = 2 next fiscal year]
;            m - indicates pressure zone [m=1 zone A..m=9 zone "Unassigned"
;    not active: m=10 (and i=1) error of predictions (by s and i, not by m)
;            i - planning area category [i=1 on-project, i=2 off-project]
; TABLES   : tabpzf
; ARRAYS   : awork
; VARIABLES: s, m, i
;     NOTES: table tabpzf has first two fields inactive
;                                     not tested !!!         v2.2 8.I.92
;**************************************************************************
PROC fpzf(s,m,i)
MOVETO tabpzf
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[s*2+i]
ENDPROC

;**************************************************************************
;      NAME: ftpr(m,j,s)
;     EVENT: extracts temperature and precipitation ratios of
;            actual/normal for each of three seasons
;     UNITS:
; ARGUMENTS: m - month for which projection is made (from 1 to 60)
;            j = 1 temperature ratios
;            j = 2 precipitation ratios
;            s - indicates season (s=1-Low, s=2 Medium, s=3 High)
; TABLES   : tabtpr
; ARRAYS   : awork
; VARIABLES: m, j, s
;     NOTES: table tabtpr has first three fields inactive
;                                                xxx tested  20.III.92
;**************************************************************************
PROC ftpr(m,j,s)
MOVETO tabtpr
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[s+j*3]
ENDPROC

;**************************************************************************
;      NAME: fmfn(m,i)
;     EVENT: extracts: the marginal price of water, a fixed charge for
;            water and sewer, and new account coefficient
;     UNITS:
; ARGUMENTS: m - month for which projection is made (from 1 to 60)
;            i - indicates variable (i=1 for marginal price,
;                i = 2 for fixed charge, and i = 3 for new account coef.
; TABLES   : tabmfn
; ARRAYS   : awork
; VARIABLES: m, i
;     NOTES: table tabmfn has first three fields inactive
;                                               xxx tested  20.III.92
;**************************************************************************
PROC fmfn(m,i)
MOVETO tabmfn
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[i+3]
ENDPROC

;**************************************************************************
;      NAME: fret(m,i)
;     EVENT: extracts seasonal indices from table tabsix
;     UNITS:
; ARGUMENTS: m - month for which projection is made (from 1 to 60)
;            i - indicates user/planning area category [i = 1..6]
; TABLES   : tabret
; ARRAYS   : awork
; VARIABLES: m, i
;     NOTES: table tabret has first three fields inactive
;                                              xxx tested  20.III.92
;**************************************************************************
PROC fret(m,i)
MOVETO tabret
MOVETO RECORD m
COPYTOARRAY awork
RETURN awork[i+3]
ENDPROC

;**************************************************************************
;      NAME: fela(i)
;     EVENT: extracts elasticities
;     UNITS: dimensionless
; ARGUMENTS: i - elasticity
;                i=1 constant, i=2 seasonal index,
;             i=3 Temp-ratio Low, i=4 Temp-ratio Med, i=5 Temp-ratio Hi,
;             i=6 Prec-ratio Low, i=7 Prec-ratio Med, i=8 Prec-ratio Hi,
;             i=9 Marginal Price, i=10 Fixed Charge, i=11 New Account,
;             i=12 Retrofit
; TABLES   : tabela
; ARRAYS   : awork
; VARIABLES: i
;     NOTES: table tabsix has first three fields inactive
;                                              xxx tested  20.III.92
;**************************************************************************
PROC fela(i)
MOVETO tabela
MOVETO RECORD i
COPYTOARRAY awork
RETURN awork[4]
ENDPROC


;**************************************************************************
;      NAME: slopes()
;     EVENT: Evaluates distances (in months) between Jan, 86 and the
;            points of time when a new slope of account equation should
;            be applied, then one month is substracted to determine
;            last month for which the previous slope is valid
;            Therefore array aM[] keeps values of month up to which
;            the equation is applicable (aM[1] keeps last month of
;            equation/slope 1 validity, aM[2] slope no 2, etc.
;     UNITS: months
; ARGUMENTS: no arguments
; TABLES   : tabace
; ARRAYS   : awork[]
;            aM[5]
; VARIABLES: j
;     NOTES: Array aM[5] must be declared in the main script (global array)
;            or in higher level procedure. Table tabace contains the five
;            account's regressions models; one full model (constant and
;            slope and four reduced models (slopes). For each model the
;            month (calendar: 1 for January) and the year which specify
;            "starting point" are given. The model is not considered
;            if the respective year equals zero (if the year is < 100)
;            First (full) model is always applied
;                           preliminary tests performed    28.III.92
;**************************************************************************
PROC slopes()
VIEW tabace
MOVETO tabace
aM[5] = 20000
FOR j FROM 6 to 3 STEP -1
  MOVETO RECORD j
  COPYTOARRAY awork
  IF awork[9] < 100
    THEN aM[j-2] = aM[j-1]
    ELSE aM[j-2] = (awork[9]-1986)*12+awork[8]-1
  ENDIF
ENDFOR
RETURN
ENDPROC ;slopes


;**************************************************************************
;      NAME: FindOutTable(RepNo)
;     EVENT: Determines the tables in which the predictions will be
;            saved
; ARGUMENTS: RepNo - report number
; TABLES   : trep[6] contains names of templates
;            rrep[6] names of output tables
; ARRAYS   : trep[6], rrep[6]
; VARIABLES: aesc, j, rpath, PathRep, aRow, tname, v1h, v1a
;     NOTES: ??

;                                   (xxx tested)      ver 2.6  2.I.92
;**************************************************************************
PROC FindOutTable(RepNo)
SWITCH
  CASE RepNo = 1: j = 2
                  trep[1]= "Report 1a"
                  trep[2]= "Report 1b"
                  x = "1a and 1b"
                  ForScreen(x,v1n)
                  trep[1]= "trep1a"
                  trep[2]= "trep1b"
  CASE RepNo = 2: j = 3
                  trep[1]= "Report 2a"
                  trep[2]= "Report 2b"
                  trep[3]= "Report 2c"
                  x = "2a, 2b, and 2c"
                  ForScreen(x,v1n)
                  trep[1]= "trep2a"
                  trep[2]= "trep2b"
                  trep[3]= "trep2c"
  CASE RepNo = 3: j = 3
                  trep[1]= "Report 3a"
                  trep[2]= "Report 3b"
                  trep[3]= "Report 3c"
                  x = "3a, 3b, and 3c"
                  ForScreen(x,v1n)
                  trep[1]= "trep3a"
                  trep[2]= "trep3b"
                  trep[3]= "trep3c"
  CASE RepNo = 4: j = 2
                  trep[1]= "Report 4a"
                  trep[2]= "Report 4b"
                  x = "4a and 4b"
                  ForScreen(x,v1n)
                  trep[1]= "trep4a"
                  trep[2]= "trep4b"
  CASE RepNo = 5: j = 6
                  trep[1]= "Report 5a"
                  trep[2]= "Report 5b"
                  trep[3]= "Report 5c"
                  trep[4]= "Report 5d"
                  trep[5]= "Report 5e"
                  trep[6]= "Report 5f"
                  x = "from 5a to 5e"
                  ForScreen(x,v1n)
                  trep[1]= "trep5a"
                  trep[2]= "trep5b"
                  trep[3]= "trep5c"
                  trep[4]= "trep5d"
                  trep[5]= "trep5e"
                  trep[6]= "trep5f"
  CASE RepNo = 6: j = 6
                  trep[1]= "Report 6a"
                  trep[2]= "Report 6b"
                  trep[3]= "Report 6c"
                  trep[4]= "Report 6d"
                  trep[5]= "Report 6e"
                  trep[6]= "Report 6f"
                  x = "from 6a to 6e"
                  ForScreen(x,v1n)
                  trep[1]= "trep6a"
                  trep[2]= "trep6b"
                  trep[3]= "trep6c"
                  trep[4]= "trep6d"
                  trep[5]= "trep6e"
                  trep[6]= "trep6f"
ENDSWITCH
rpath = PathRep
Ashow(rpath,3,15,35,v1h)
FOR i FROM 1 TO j
  aShow(trep[i],6+i,30,8,v1h)
ENDFOR
xpath=PathRep
TakePath(3,15)
IF aesc = true THEN RETURN
ENDIF
PathRep=xpath

FOR i FROM 1 TO j
;STYLE ATTRIBUTE v1a
  tname = trep[i]
  ;@6+i,30
  aRow=6+i
  rrep[i] = TakeTable()
  IF aesc = true THEN RETURN
  ENDIF
  VIEW rrep[i]
ENDFOR
;@16,15 TakeRepDate()
RETURN
ENDPROC ;


;**************************************************************************
;      NAME: CalRep1()
;     EVENT: Calculates monthly water production forecast for two planning
;            areas and for 60-month time horizon. The results include:  *
;            expected, historical low/high, and exceeded (95%, 85%, 15%,
;            and 5% of time). The predictions are stored in tables:
;            "trep1a" and "trep1b" for further use.
;     UNITS: input [ccf], output [acre-feet]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            tabuna - used by proc funa
;            tabplh - used by proc plh
;            rrep[1] - monthly water production forecast for on-project
;            rrep[2] - monthly water production forecast for off-project
; ARRAYS   : awork[]
;
; VARIABLES: RepDate  - report date
;            t95r1 - percentile of the t distrib., df= 3, 95% two sides
;            t85r1 - percentile of the t distrib., df= 3, 85% two sides
;            i, k, l, cons1, cons2, error, sdate
;            prodHL, prod95, prod85, prodMN, prod15, prod05, prodHH
;     NOTES:
;
;
;                                   xxx tested  !!!          v3.0 6.I.92
;**************************************************************************
PROC CalRep1()
FindParameters(1)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(1) ; sets the output tables and the RepDate
slopes()
IF aesc = true THEN CLEARALL RETURN
ENDIF
CURSOR OFF
;VIEW rrep[1]
;VIEW rrep[2]
cm = MONTH(RepDate)
cyr = YEAR(RepDate)
; cdy = DAY(RepDate) ; we do not need it. caused errors in printouts
RepMonth = (YEAR(RepDate)-1986)*12+cm
IF cm > 6
  THEN fm = cm - 6
  ELSE fm = cm + 6
ENDIF
FOR i FROM 1 TO 6
  cons[i] = 0.0 ; j=1,2,3 on-proj., j=4,5,6 off-proj.
ENDFOR
my = RepMonth
FOR i FROM 1 TO 3
;   on-project
  x1=fcpa(i)*fsix(fm,i)*face(my,i)
  cons[1] = cons[1] + x1* fdfx(fm,i,1)    ; historical low
  cons[2] = cons[2] + x1             ; mean
  cons[3] = cons[3] + x1* fdfx(fm,i,2)    ; historical high
;   off-project
  j = i+3
  x1=fcpa(j)*fsix(fm,j)*face(my,j)
  cons[4] = cons[4] + x1* fdfx(fm,j,1)    ; historical low
  cons[5] = cons[5] + x1             ; mean
  cons[6] = cons[6] + x1* fdfx(fm,j,2)    ; historical high
ENDFOR
k=0
FOR my FROM RepMonth+1 TO RepMonth+60
  k=k+1
  cm1 = cm
  fm1 = fm
  cy1 = cyr
  cm=cm+1
  IF cm = 13
    THEN cm = 1
         cyr = cyr + 1
  ENDIF
  IF cm < 7
    THEN fm = cm + 6
    ELSE fm = cm - 6
  ENDIF
  FOR j FROM 7 TO 12
    cons[j] = 0.0
  ENDFOR
  FOR i FROM 1 TO 3
;     on-project
    x1=fcpa(i)*fsix(fm,i)*face(my,i)
    cons[7] = cons[7] + x1* fdfx(fm,i,1)    ; historical low
    cons[8] = cons[8] + x1             ; mean
    cons[9] = cons[9] + x1* fdfx(fm,i,2)    ; historical high
;     off-project
    j = i+3
    x1=fcpa(j)*fsix(fm,j)*face(my,j)
    cons[10] = cons[10] + x1* fdfx(fm,j,1)    ; historical low
    cons[11] = cons[11] + x1             ; mean
    cons[12] = cons[12] + x1* fdfx(fm,j,2)    ; historical high
  ENDFOR
;   1 [ccf] = 0.0022955 [ac-ft] (Jeff's conversion) (my is 0.0022957)
  sdate=DATEVAL(STRVAL(cm1)+"/"+STRVAL(1)+"/"+STRVAL(cy1))
  bwork[2] = FORMAT("d6",sdate)
  MsgCalc(" k = "+strval(k)+", "+bwork[2]+ " ",40)
  FOR j FROM 1 TO 2 ; j=1 on-project, j=2 off-project
    IF j = 1
      THEN i = 1
      ELSE i = 4
    ENDIF
    bwork[2] = FORMAT("d6", sdate)
    x = (1+funa(fm1,j,0))*0.0022955
    bwork[3] = (sf1*cons[i]+sft*cons[i+6])*x; low
    bwork[6] = (sf1*cons[i+1]+sft*cons[i+7])*x ; mean
    bwork[9] = (sf1*cons[i+2]+sft*cons[i+8])*x ; high
    stdev = fdfx(fm1,i,3) * bwork[6]
    bwork[4] = bwork[6] - t95r1 * stdev  ; 95%
    bwork[5] = bwork[6] - t85r1 * stdev  ; 85%
    bwork[7] = bwork[6] + t85r1 * stdev  ; 15%
    bwork[8] = bwork[6] + t95r1 * stdev  ; 05%
    MOVETO rrep[j]
    MOVETO RECORD k
    COPYTOARRAY awork
    FOR jj FROM 2 TO 9
      awork[jj] = bwork[jj]
    ENDFOR
    EDITKEY
    COPYFROMARRAY awork
    DO_IT!
  ENDFOR
  FOR i FROM 1 TO 6
    cons[i] = cons[i+6]
  ENDFOR
ENDFOR
CURSOR NORMAL
CLEARALL
ENDPROC ; CalRep1




;**************************************************************************
;      NAME: CalRep2()
;     EVENT: Calculates water production forecast for current and next
;            fiscal year. Forecast is made for 9 pressure zone categories,
;            two planning areas, and total service area, for 60-month
;            time horizon. The results include:expacted water production
;            and semi-exceedencess (function of mean) 95%, 85%, 15%,
;            and 5% of time). The predictions are stored in tables:
;            "trep2a", "trep2b", and "trep2c" for further use.
;     UNITS: input [ccf], output [acre-feet]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            tabuna - used by proc funa
;            tabobs - used by proc fobs
;            tabpzf - used by proc fpzf
;            rrep[1] - production forecast for pressure zones A,B,C,and D
;            rrep[2] - production forecast for pressure zones E,F,G,and H
;            rrep[3] - zone "unknown", on/off-project, total service area
; ARRAYS   : awork[]
;            obs[26]  observed consumption: 1..13 on-,14..26 off-project
;            cons[50] monthly forecasts of consumption (25 months/2 areas)
;                     which are later shifted in time and converted into
;                     production
;?
;?
;?
;?(24 months/2 areas). 25th and 50th
;?                     elements of this array contain total current fiscal
;?                     year production.
;            prod2[2] total production during the next fiscal year
;            prod[2]  production which is updated after jj months elapsed
;           SumObs[2] sum of observed productions: observed consumptions
;                     which are shifted in time and converted into
;                     production (2 planning areas)
;           SumMod[2] sum of projected productions (array cons[]) in months
;                     in which the productions were observed (analogous to
;                     array SumObs[])
; VARIABLES: RepDate  - report date
;            RepMonth - # months between 1/1986 and RepDate
;            fm  - month of the fiscal year ( fm = 1 for July)
;            fm1 = fm-1
;            fy - fiscal year (fis.yr 1986 is from July, 1986 to June, 1987
;            my - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;                 1986, and so on]
;            sft - time shift coefficient
;            sf1 = 1 - sft
;            t95r2 - percentile of the t distrib., df= x , 95% two sides
;            t85r2 - percentile of the t distrib., df= x , 85% two sides
;            it - it=1 raw unaccounted for water fractions, it=2 smoothed
;            i, j, k, l, jj, x, x1, x2, x3, x4, z
;            prod95, prod85, prodMN, prod15, prod05
;     NOTES:
;                 creates only one report 2 but it should produce
;                      three reports (2a,2b,2c)
;                                   xxx tested  !!!          v2.1 3.XII.91
;**************************************************************************
PROC CalRep2()
ARRAY ft[3]
FindParameters(2)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(2) ; sets the output tables and the RepDate
slopes()
IF aesc = true THEN CLEARALL RETURN
ENDIF
CURSOR OFF
IF MONTH(RepDate) <7
  THEN fy = YEAR(RepDate)-1
  ELSE fy = YEAR(RepDate)
ENDIF
x = SUBSTR(STRVAL(fy),3,2)+"/"+SUBSTR(STRVAL(fy+1),3,2)
ft[1]= "FISCAL YEAR "+x+" TO DATE"
ft[2]= "PROJECTED TOTAL FY "+x
x = SUBSTR(STRVAL(fy+1),3,2)+"/"+SUBSTR(STRVAL(fy+2),3,2)
ft[3]= "PROJECTED FY "+x
VIEW rrep[1]
VIEW rrep[2]
VIEW rrep[3]

RepMonth = (fy - 1986) * 12 + 7
fm = 0
j = 0
FOR my FROM RepMonth TO RepMonth + 24
  fm = fm + 1
  IF fm > 12
    THEN fm = 1
  ENDIF
  j = j+1
  MsgCalc(" j = "+strval(j)+" Consumption      ",40)
  cons[j] = 0.0
  cons[j+25] = 0.0
  FOR i FROM 1 to 3
    cons[j]   = cons[j] + fcpa(i) * fsix(fm,i) * face(my,i)
    cons[j+25]= cons[j+25]+fcpa(i+3)*fsix(fm,i+3)*face(my,i+3)
  ENDFOR
ENDFOR ; On/off proj. consumption has been calculated for 25 months.

FOR j FROM 1 TO 24                          ; time shifting
  cons[j] = sf1*cons[j]+sft*cons[j+1]       ; 1..24 on-project
  cons[j+25]= sf1*cons[j+25]+sft*cons[j+26] ; 26..49 off-project
ENDFOR

FOR k FROM 1 TO 12
  jj=0
  k1=k
  IF k > 9 THEN k1 = 10 ENDIF
  SumObserved = 0.0
  IfRecZone(k,fy) ;returns jj and SumObserved (zone k)
  currentFY = 0.0
  SumModelled = 0.0
  FOR j FROM 1 TO 12
    x1 = cons[j]*(1+funa(j,1,k1))     ; on-proj., zone k
    x2 = cons[j+25]*(1+funa(j,2,k1))  ; off-proj., zone k
    SWITCH
      CASE k<10:
                x = x1 * fpzf(1,k,1) + x2 * fpzf(1,k,2)
      CASE k=10:
                x = x1
      CASE k=11:
                x = x2
      CASE k=12:
                x = x1 + x2
    ENDSWITCH
    currentFY = currentFY + x ; pressure zone k
    IF j <= jj
      THEN SumModelled = SumModelled + x
    ENDIF
  ENDFOR
; SumModelled is sum of modelled cons. for months (1..jj)
; SumObserved is sum of observations for months (1..jj)
; CurrentFY is total FY consum. (modelled) in current FY
  IF jj <> 0 THEN
    x = SumObserved/(SumModelled * 0.0022955)
    currentFY = currentFY*(1-(jj/12)*(1-x))
  ENDIF
  currentFY = currentFY * 0.0022955
  nextFY = 0.0
  FOR j FROM 1 TO 12
    x1 = cons[j+12]*(1+funa(j,1,k1))  ; on-proj., zone k
    x2 = cons[j+37]*(1+funa(j,2,k1))  ; off-proj., zone k
    SWITCH
      CASE k<10:
                x = x1 * fpzf(1,k,1) + x2 * fpzf(1,k,2)
      CASE k=10:
                x = x1
      CASE k=11:
                x = x2
      CASE k=12:
                x = x1 + x2
    ENDSWITCH
    nextFY = nextFY + x
  ENDFOR
  nextFY = nextFY * 0.0022955
  FOR i FROM 1 TO 3 ;i=1 line 1 (observed prod.)
                    ;i=2 line 2 (CURRENT FY)
                    ;i=3 line 3 (NEXT FY)
    SWITCH
      CASE k<5:   j=1
                  l=3*k-3+i
      CASE ((k>4) AND (k<9)) :
                  j=2
                  l=3*(k-4)-3+i
      CASE k>8:   j=3
                  l=3*(k-8)-3+i
    ENDSWITCH
    MOVETO rrep[j]  ; open template for report 3
    MOVETO RECORD l
    COPYTOARRAY awork
    MsgCalc(" Saving: " + awork[2],40)
    awork[4] = ft[i]
    IF i = 1
      THEN
        awork[7] = SumObserved
        awork[5] = 0
        awork[6] = 0
        awork[8] = 0
        awork[9] = 0
      ELSE
        IF i = 2
          THEN
            awork[7] = CurrentFY
            x1 = r2ZErr95[k] *(1-jj/12)
            x2 = r2ZErr85[k] *(1-jj/12)
          ELSE
            awork[7] = NextFY
            x1 = r2ZErr95[k]
            x2 = r2ZErr85[k]
        ENDIF
        awork[5] = awork[7] *(1-x1)
        awork[6] = awork[7] *(1-x2)
        awork[8] = awork[7] *(1+x2)
        awork[9] = awork[7] *(1+x1)
    ENDIF
    EDITKEY
    COPYFROMARRAY awork
    DO_IT!
  ENDFOR  ; three lines of rep 2[k]
ENDFOR
CURSOR NORMAL
CLEARALL
ENDPROC; CalRep2()

;**************************************************************************
;      NAME: CalRep3()
;     EVENT: Calculates REVENUE. The results include:
;            expected revenues and exceedencess (95%, 85%, 15%,
;            and 5% of time). The predictions are stored in tables:
;            "trep3a", "trep3b", and "trep3c" for further use.
;     UNITS: input [ccf], output [acre-feet]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            tabobr - used by proc fobr revenue recorded in momth fm
;            tabmsf - used by proc fmsf
;            rrep[1] - production forecast for pressure zones A,B,C,and D
;            rrep[2] - production forecast for pressure zones E,F,G,and H
;            rrep[3] - zone "unknown", on/off-project, total service area
; ARRAYS   : awork[]
;            obs[26]  observed consumption: 1..13 on-,14..26 off-project
;            cons[50] monthly forecasts of consumption (25 months/2 areas)
;                     which are later shifted in time and converted into
;                     production (24 months/2 areas). 25th and 50th
;                     elements of this array contain total current fiscal
;                     year production.
;            prod2[2] total production during the next fiscal year
;            prod[2]  production which is updated after jj months elapsed
;           SumObs[2] sum of observed productions: observed consumptions
;                     which are shifted in time and converted into
;                     production (2 planning areas)
;           SumMod[2] sum of projected productions (array cons[]) in months
;                     in which the productions were observed (analogous to
;                     array SumObs[])
; VARIABLES: RepDate  - report date
;            RepMonth - # months between 1/1986 and RepDate
;            fm  - month of the fiscal year ( fm = 1 for July)
;            fm1 = fm-1
;            fy - fiscal year (fis.yr 1986 is from July, 1986 to June, 1987
;            my - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;                 1986, and so on]
;            sft - time shift coefficient
;            sf1 = 1 - sft
;            r3_Err95 - fraction of the mean
;            r3_Err85 - fraction of the mean
;            BaseMutip - reflects base charge revenue outside the city
;            VolumeMutip - reflects volume charge revenue outside city
;            it - it=1 raw unaccounted for water fractions, it=2 smoothed
;            i, j, k, l, jj, x, x1, x2, x3, x4, z
;     NOTES:
;           The confidence intervals are not calculated. Instead,
;           the limits are set in a given distance from the mean. The
;           distance is equal a fraction of the mean values, and it is
;           reduced proportionally to the number of months in which the
;           revenue was recorded.
;                                   xxx tested  !!!          v2.8 14.I.92
;**************************************************************************
PROC CalRep3()
ARRAY ft[3]
FindParameters(3)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(3) ; sets the output tables and the RepDate
slopes()
IF aesc = true
  THEN CLEARALL
       RETURN
ENDIF
CURSOR OFF
IF MONTH(RepDate) <7
  THEN fy = YEAR(RepDate)-1
  ELSE fy = YEAR(RepDate)
ENDIF
x = SUBSTR(STRVAL(fy),3,2)+"/"+SUBSTR(STRVAL(fy+1),3,2)
ft[1]= "FISCAL YEAR "+x+" TO DATE"
ft[2]= "PROJECTED TOTAL FY "+x
x = SUBSTR(STRVAL(fy+1),3,2)+"/"+SUBSTR(STRVAL(fy+2),3,2)
ft[3]= "PROJECTED FY "+x
VIEW rrep[1]
VIEW rrep[2]
VIEW rrep[3]

;*******************************************endproc ;5

RepMonth = (fy - 1986) * 12 + 7

;==============================================
;                BASE CHARGES
;==============================================
fm = 0
j = 0
FOR my FROM RepMonth TO RepMonth + 23
  fm = fm + 1
  IF fm > 12
    THEN fm = 1
  ENDIF
  j = j+1
  MsgCalc(" j = "+strval(j)+" Base Charge Forecast  ",40)
  cons[j] = 0.0
  FOR i FROM 1 to 6     ; i => planning area/type of user cat.
   FOR k FROM 1 TO 7  ; k => meter size category
      cons[j] = cons[j]+face(my,i)*fmsf(k,i)*fbch(k)
    ENDFOR
  ENDFOR
  cons[j] = cons[j] * fbch(8) ; Base Multiplier is there
ENDFOR ; The base charge revenue has been calculated for 24 months.
       ; The results (24 monthly values) are stored in array cons[1..24]

currentFY = 0.0
nextFY = 0.0
FOR j FROM 1 TO 12
  currentFY = currentFY + cons[j]
  nextFY = nextFY +cons[j+12]
ENDFOR
jj=0
IfRecorded(1,fy) ; returns jj and SumObserved ; 1 = base charge
IF jj <> 0
  THEN
    SumModelled = 0.0
    FOR j FROM 1 TO jj
      SumModelled = SumModelled + cons[j]
    ENDFOR
    x = SumObserved/SumModelled
    currentFY = currentFY*(1-(jj/12)*(1-x))
ENDIF

MOVETO rrep[1]  ; open template for report 3a
FOR l FROM 1 TO 3
  MOVETO RECORD l
  COPYTOARRAY awork
  awork[3] = ft[l]
  IF l = 1
    THEN
      awork[6] = SumObserved
      awork[4] = 0
      awork[5] = 0
      awork[7] = 0
      awork[8] = 0
    ELSE
      IF l = 2
        THEN awork[6] = CurrentFY
  ;           x1 = r3BErr95 *(1-jj/12)  ; no confidence limits
  ;           x2 = r3BErr85 *(1-jj/12)  ; for base charges
        ELSE awork[6] = NextFY
  ;           x1 = r3BErr95
  ;           x2 = r3BErr85
      ENDIF
      awork[4] = awork[6] ; *(1-x1)     ; letter from 3/30/92
      awork[5] = awork[6] ; *(1-x2)
      awork[7] = awork[6] ; *(1+x2)
      awork[8] = awork[6] ; *(1+x1)
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
  FOR k FROM 1 TO 6
    cwork[l*6-6+k] = awork[2+k]
  ENDFOR
Arep3c[l] = awork[6] ; array for report 3c
ENDFOR  ; three lines of rep 3a



;==============================================
;                VOLUME CHARGES
;==============================================
fm = 0
j = 0
FOR my FROM RepMonth TO RepMonth + 23
  fm = fm + 1
  IF fm > 12 THEN fm = 1 ENDIF
  j = j+1
;  MsgCalc(" j = "+strval(j)+" Volume Charge Forecast   ",40)
  cons[j] = 0.0
  FOR i FROM 1 to 6
    cons[j] = cons[j]+fcpa(i)*fsix(fm,i)*face(my,i)*(1-fllp(fm,i))
  ENDFOR
  cons[j] = cons[j] * fvch(fm)* fvch(13); Volume Multiplier
  MsgCalc(STRVAL(j) +" "+ STRVAL(cons[j])+" V",40)
ENDFOR ; The volume charge revenue has been calculated for 24 months.
       ; The results (24 monthly values) are stored in array cons[1..24]
currentFY = 0.0
nextFY = 0.0
FOR j FROM 1 TO 12
  currentFY = currentFY + cons[j]
  nextFY = nextFY +cons[j+12]
ENDFOR
jj=0
IfRecorded(2,fy) ; returns jj and SumObserved ; 2 = volume charge
IF jj <> 0 THEN
  SumModelled = 0.0
  FOR j FROM 1 TO jj
    SumModelled = SumModelled + cons[j]
  ENDFOR
  x = SumObserved/SumModelled
  currentFY = currentFY*(1-(jj/12)*(1-x))
ENDIF


MOVETO rrep[1]  ; open template for report 3a
FOR l FROM 1 TO 3
  MOVETO RECORD l+3
  COPYTOARRAY awork
  awork[3] = ft[l]
  IF l = 1
    THEN
      awork[6] = SumObserved
      awork[4] = 0
      awork[5] = 0
      awork[7] = 0
      awork[8] = 0
    ELSE
      IF l = 2
        THEN awork[6] = CurrentFY
             x1 = r3VErr95 *(1-jj/12)
             x2 = r3VErr85 *(1-jj/12)
        ELSE awork[6] = NextFY
             x1 = r3VErr95
             x2 = r3VErr85
      ENDIF
    awork[4] = awork[6] *(1-x1)
    awork[5] = awork[6] *(1-x2)
    awork[7] = awork[6] *(1+x2)
    awork[8] = awork[6] *(1+x1)
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
  FOR k FROM 2 TO 6
    cwork[l*6-6+k] = cwork[l*6-6+k]+awork[2+k]
  ENDFOR
Arep3c[l+3] = awork[6] ; array for report 3c
ENDFOR  ; three lines of rep 3a

;==============================================
;          BASE + VOLUME CHARGES
;==============================================
FOR l FROM 1 TO 3
  MOVETO RECORD l+6
  COPYTOARRAY awork
  FOR k FROM 1 TO 6
    awork[2+k] = cwork[l*6-6+k]
  ENDFOR
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
Arep3c[l+6] = awork[6] ; array for report 3c
ENDFOR  ; last three lines of rep 3a

;==============================================
;        WATER RESOURCE ACQUISITION FEE
;==============================================
fm = 0
j = 0
kk = 1  ; kk=1 current fy, kk=2 next fy
;FOR i FROM 1 TO 6
;  base[i] = face(RepMonth-1,i)
;ENDFOR

FOR my FROM RepMonth TO RepMonth + 23
  fm = fm + 1
  IF fm > 12 THEN fm = 1
                  kk = 2 ENDIF
  j = j+1
  cons[j] = 0.0
  MsgCalc(" j = "+strval(j)+" Water Res. Acquisition   ",40)
  FOR k from 1 TO 7
    cwork[1] = (face(my,1)-face(my-1,1))*fmsf(k,1)*fwra(k,1,kk) ;on/sf
    cwork[2] = (face(my,3)-face(my-1,3))*fmsf(k,3)*fwra(k,1,kk) ;on/nr
    cwork[3] = (face(my,4)-face(my-1,4))*fmsf(k,4)
    cwork[4] = cwork[3]*fwra(k,3,kk)*(1-fjrs(k,kk,1)) ;off/sf/N
    cwork[3] = cwork[3]*fwra(k,2,kk)*fjrs(k,kk,1)  ;off/sf/S
    cwork[5] = (face(my,6)-face(my-1,6))*fmsf(k,6)
    cwork[6]=cwork[5]*fwra(k,3,kk)*(1-fjrs(k,kk,2)) ;off/nr/N
    cwork[5]=cwork[5]*fwra(k,2,kk)*fjrs(k,kk,2)  ;off/nr/S
    FOR l FROM 1 TO 6
      IF cwork[l]<0.0 THEN cwork[l] = 0.0 ENDIF
      cons[j] = cons[j] + cwork[l]
    ENDFOR       ; area and user categ. loop
  ENDFOR         ; meter size loop
; if dwelling unit factor vary with meter size category
; the following lines should be completed by adding fmsf()
; and they should be uncluded in meter size loop
    cwork[7] = (face(my,2)-face(my-1,2))*fwra(8,1,kk)*fduf(1) ;on/mf
    cwork[8] = (face(my,5)-face(my-1,5))*fwra(8,2,kk)*fduf(2) ;off/mf/S
    cwork[9] = (face(my,5)-face(my-1,5))*fwra(8,3,kk)*fduf(3) ;off/mf/N
    cons[j] = cons[j] + cwork[7] + cwork[8] + cwork[9]
; "fduf" ==> dwelling unit factors (not related to the meter size cat.)
;  mixed with coefficients of off-project area subdivision into 
;  South/North of Jomax River)
ENDFOR           ; 24 month loop
; cons[1..24] contains revenue from water resources acquisition
; fee for single-family residential and nonresidential users.
; as well as for multifamily users

currentFY = 0.0
nextFY = 0.0
FOR j FROM 1 TO 12
  currentFY = currentFY + cons[j]
  nextFY = nextFY +cons[j+12]
ENDFOR

jj=0
IfRecorded(3,fy) ; returns jj and SumObserved ; 3 = acquisition fee
IF jj <> 0 THEN
  SumModelled = 0.0
  FOR j FROM 1 TO jj
    SumModelled = SumModelled + cons[j]
  ENDFOR
  x = SumObserved/SumModelled
  currentFY = currentFY*(1-(jj/12)*(1-x))
ENDIF

MOVETO rrep[2]  ; open template for report 3b
FOR l FROM 1 TO 3
  MOVETO RECORD l
  COPYTOARRAY awork
  awork[3] = ft[l]
  IF l = 1
    THEN awork[6] = SumObserved
    ELSE IF l = 2
           THEN awork[6] = CurrentFY
                x1 = r3AErr95 *(1-jj/12)
                x2 = r3AErr85 *(1-jj/12)
           ELSE awork[6] = NextFY
                x1 = r3AErr95
                x2 = r3AErr85
         ENDIF
    awork[4] = awork[6] *(1-x1)
    awork[5] = awork[6] *(1-x2)
    awork[7] = awork[6] *(1+x2)
    awork[8] = awork[6] *(1+x1)
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
Arep3c[l+12] = awork[6] ; array for report 3c
ENDFOR  ; three lines of rep 3b

;==============================================
;    WATER DEVELOPMENT OCCUPATIONAL FEE
;==============================================
fm = 0
j = 0
kk = 1  ; kk=1 current fy, kk=2 next fy
;FOR i FROM 1 TO 6
;  base[i] = face(RepMonth-1,i)
;ENDFOR

FOR my FROM RepMonth TO RepMonth + 23
  fm = fm + 1
  IF fm > 12 THEN fm = 1
                  kk = 2 ENDIF
  j = j+1
  MsgCalc(" j = "+strval(j)+" Water Develop. Occupat.  ",40)
  cons[j] = 0.0

; Single-family:
  cwork[18] = face(my,1)-face(my-1,1)
  IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
  cwork[17] = face(my,4)-face(my-1,4)
  IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  cwork[1]=(cwork[18]+cwork[17])*fwdo(1,0,1) ;sf

; Multi-family:
  cwork[18] = face(my,2)-face(my-1,2)
  IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
  cwork[17] = face(my,5)-face(my-1,5)
  IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  cwork[2]=(cwork[18]+cwork[17])*fwdo(2,0,1)*fduf(4) ;mf
; fduf(4) dwelling units average for whole service area
; (for acquisition fee - fduf was subdivided into on-proj.,
; off-pr. South, and off-project North).

; Nonresidential (meter size related):
  cwork[3] = 0.0
;  FOR k FROM 1 TO 7
    cwork[18] = face(my,3)-face(my-1,3)
    cwork[17] = face(my,6)-face(my-1,6)
    IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
    IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  FOR k FROM 1 TO 7
    cwork[3]=cwork[3]+(cwork[18]*fmsf(k,4)+cwork[17]*fmsf(k,6))*fwdo(3,k,1)
  ENDFOR
  cons[j] = cwork[1] + cwork[2] + cwork[3]
ENDFOR           ; 24 month loop
; cons[1..24] contains revenue from water dev. occup. fee

currentFY = 0.0
nextFY = 0.0
FOR j FROM 1 TO 12
  currentFY = currentFY + cons[j]
  nextFY = nextFY +cons[j+12]
ENDFOR
jj=0
IfRecorded(4,fy) ; returns jj and SumObserved ; 4=water dev.occ. fee
IF jj <> 0 THEN
  SumModelled = 0.0
  FOR j FROM 1 TO jj
    SumModelled = SumModelled + cons[j]
  ENDFOR
  x = SumObserved/SumModelled
  currentFY = currentFY*(1-(jj/12)*(1-x))
ENDIF

MOVETO rrep[2]  ; open template for report 3b
FOR l FROM 1 TO 3
  MOVETO RECORD l+3
  COPYTOARRAY awork
  awork[3] = ft[l]
  IF l = 1
    THEN
      awork[6] = SumObserved
    ELSE
      IF l = 2
        THEN awork[6] = CurrentFY
             x1 = r3WErr95 *(1-jj/12)
             x2 = r3WErr85 *(1-jj/12)
        ELSE awork[6] = NextFY
             x1 = r3WErr95
             x2 = r3WErr85
      ENDIF
    awork[4] = awork[6] *(1-x1)
    awork[5] = awork[6] *(1-x2)
    awork[7] = awork[6] *(1+x2)
    awork[8] = awork[6] *(1+x1)
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
Arep3c[l+9] = awork[6] ; array for report 3c
ENDFOR  ; three lines of rep 3b


;==============================================
;    SEWER DEVELOPMENT OCCUPATIONAL FEE
;==============================================
fm = 0
j = 0
kk = 1  ; kk=1 current fy, kk=2 next fy
;FOR i FROM 1 TO 6
;  base[i] = face(RepMonth-1,i)
;ENDFOR

FOR my FROM RepMonth TO RepMonth + 23
  fm = fm + 1
  IF fm > 12 THEN fm = 1
                  kk = 2 ENDIF
  j = j+1
  MsgCalc(" j = "+strval(j)+" Sewer Develop. Occupat.  ",40)
  cons[j] = 0.0

; Single-family:
  cwork[18] = face(my,1) - face(my-1,1)
  IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
  cwork[17] = face(my,4) - face(my-1,4)
  IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  cwork[1] = (cwork[18] + cwork[17]) * fwdo(1,0,2) ;sf

; Multi-family:
  cwork[18] = face(my,2) - face(my-1,2)
  IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
  cwork[17] = face(my,5) - face(my-1,5)
  IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  cwork[2] = (cwork[18] + cwork[17]) * fwdo(2,0,2) * fduf(4) ;mf

; Nonresidential:
  cwork[3]=0.0
;  FOR k from 1 TO 7
    cwork[18]=(face(my,3)-face(my-1,3))
    cwork[17]=(face(my,6)-face(my-1,6))
    IF cwork[18] < 0 THEN cwork[18] = 0.0 ENDIF
    IF cwork[17] < 0 THEN cwork[17] = 0.0 ENDIF
  FOR k FROM 1 TO 7
    cwork[3]=cwork[3]+(cwork[18]*fmsf(k,4)+cwork[17]*fmsf(k,6))*fwdo(3,k,2)
  ENDFOR
  cons[j] = cwork[1] + cwork[2] + cwork[3]
ENDFOR           ; 24 month loop
; cons[1..24] contains revenue from sewer dev. occup. fee
currentFY = 0.0
nextFY = 0.0
FOR j FROM 1 TO 12
  currentFY = currentFY + cons[j]
  nextFY = nextFY +cons[j+12]
ENDFOR
jj=0
IfRecorded(5,fy) ; returns jj and SumObserved ;5=sewer dev.occ. fee
IF jj <> 0 THEN
  SumModelled = 0.0
  FOR j FROM 1 TO jj
    SumModelled = SumModelled + cons[j]
  ENDFOR
  x = SumObserved/SumModelled
  currentFY = currentFY*(1-(jj/12)*(1-x))
ENDIF

MOVETO rrep[2]  ; open template for report 3b
FOR l FROM 1 TO 3
  MOVETO RECORD l+6
  COPYTOARRAY awork
  awork[3] = ft[l]
  IF l = 1
    THEN awork[6] = SumObserved
    ELSE IF l = 2
           THEN awork[6] = CurrentFY
                x1 = r3SErr95 *(1-jj/12)
                x2 = r3SErr85 *(1-jj/12)
           ELSE awork[6] = NextFY
                x1 = r3SErr95
                x2 = r3SErr85
         ENDIF
    awork[4] = awork[6] *(1-x1)
    awork[5] = awork[6] *(1-x2)
    awork[7] = awork[6] *(1+x2)
    awork[8] = awork[6] *(1+x1)
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
Arep3c[l+15] = awork[6] ; array for report 3c
ENDFOR  ; last three lines of rep 3b


MOVETO rrep[3]  ; open template for report 3c
MsgCalc(" Summary Report 3c,   SAVING    ",40)
FOR l FROM 1 TO 7
  MOVETO RECORD l
  COPYTOARRAY awork
  IF l < 7 THEN
    awork[3] = Arep3c[3*l-2]
    awork[4] = Arep3c[3*l-1]
    awork[5] = Arep3c[3*l]
          ELSE
    awork[3] = Arep3c[7]+Arep3c[10]+Arep3c[13]
    awork[4] = Arep3c[8]+Arep3c[11]+Arep3c[14]
    awork[5] = Arep3c[9]+Arep3c[12]+Arep3c[15]
  ENDIF
  EDITKEY
  COPYFROMARRAY awork
  DO_IT!
ENDFOR  ; rep 3c
CLEARALL
CURSOR NORMAL
RETURN
ENDPROC; CalRep3()


;**************************************************************************
;      NAME: CalRep4()
;     EVENT: Calculates long-term projections of water consumption for
;            comparison to PHXMAIN. Forecasts are made for six planning
;            area/type of user categories. Winter (Nov-Apr) and Summer
;            (May-Oct) predictions of water use are made for three time
;            horizons: base year, five years from base, and ten years from
;            base.  The predictions are stored in tables "trep4a" and
;            "trep4b" for further use.
;     UNITS: input [ccf], output [acre-feet]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            rrep[1] - long term projections for on-project planning area
;            rrep[2] - long term projections for off-project planning area
; ARRAYS   : awork[]
;            win0[8]  base year Winter consumption
;                     elements 1..3 on-project/three types of user
;                     elements 4..6 off-project/three types of user
;                     element 7 on-project total, element 8 off-project tot
;            win5[8]  five years from base Winter consumption
;            win10[8] ten years from base Winter consumption
;            sum0[8]  base year Summer consumption
;            sum5[8]  five years from base Summer consumption
;            sum10[8] ten years from base Summer consumption
; VARIABLES: RepDate  - report date
;            BaseYear - consists of a year ending in a five or zero
;                       depending on which is closer to the reporting year
;            RepMonth - number of months between Jan, 1986 and January,
;                       BaseYear
;            fm  - month of the fiscal year ( fm = 1 for July)
;            cm  - month of the calendar year (cm = 1 for January)
;            my  - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;                 1986, and so on]
;            my5 = my + 60 (five years from base)
;            my10= my + 120 (ten years from base)
;            i, j, k, x1, x2
;     NOTES:
;                                   xxx tested  !!!          v2.1 3.XII.91
;**************************************************************************
PROC CalRep4()
FindParameters(4)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(4) ; sets the output tables and the RepDate
slopes()
IF aesc = true THEN CLEARALL RETURN
ENDIF
MsgCalc("Report 4. Please Wait    ",40)


ARRAY win0[8]
ARRAY win5[8]
ARRAY win10[8]
ARRAY sum0[8]
ARRAY sum5[8]
ARRAY sum10[8]
;  place needed display images (tables) on the workspace
VIEW rrep[1]
VIEW rrep[2]
x1 = YEAR(RepDate)
x2 = NUMVAL(SUBSTR(STRVAL(x1),4,1))
SWITCH
  CASE  ((x2 <= 7) AND (x2 >= 3)) :  BaseYear = x1-x2+5
  CASE x2 < 3                          :  BaseYear = x1-x2
  CASE x2 > 7                          :  BaseYear = x1-x2+10
  OTHERWISE : MESSAGE "Error in CalRep4()"
ENDSWITCH
RepMonth = (BaseYear-1986)*12+1
FOR i FROM 1 TO 8
  win0[i] = 0.0
  win5[i] = 0.0
  win10[i] = 0.0
  sum0[i] = 0.0
  sum5[i] = 0.0
  sum10[i] = 0.0
ENDFOR
my = RepMonth - 1
my5 = my + 60
my10 = my + 120
FOR cm FROM 1 TO 12
MsgCalc("Report 4, Month = "+STRVAL(cm),40)
  my = my + 1
  my5 = my5 + 1
  my10 = my10 + 1
  IF cm > 6 THEN fm = cm - 6
                    ELSE fm = cm + 6  ENDIF
  FOR i FROM 1 TO 6
    x = fcpa(i)*fsix(fm,i)
    SWITCH
      CASE cm>=5 AND cm<=10 :sum0[i] = sum0[i]+x*face(my,i)
                             sum5[i] = sum5[i]+x*face(my5,i)
                             sum10[i]=sum10[i]+x*face(my10,i)
      CASE ((cm<5) OR (cm>10)) :
                             win0[i] = win0[i]+x*face(my,i)
                             win5[i] = win5[i]+x*face(my5,i)
                             win10[i]= win10[i]+x*face(my10,i)
    ENDSWITCH
  ENDFOR
ENDFOR
FOR i FROM 1 TO 6
  IF i < 4 THEN j = 7
           ELSE j = 8
  ENDIF
  sum0[j] = sum0[j] + sum0[i]
  sum5[j] = sum5[j] + sum5[i]
  sum10[j]= sum10[j]+ sum10[i]
  win0[j] = win0[j] + win0[i]
  win5[j] = win5[j] + win5[i]
  win10[j]= win10[j]+ win10[i]
ENDFOR
af = 0.0022955
FOR j FROM 1 TO 2        ; writing predictions into Paradox tables
  MsgCalc("Saving ! Report 4."+STRVAL(j)+"  ",40)
  MOVETO rrep[j]
  FOR k FROM 1 TO 5
    MOVETO RECORD k
    COPYTOARRAY awork
   ;MsgCalc("Report 4."+strval(j)+" "+awork[2],40)
    IF k =1
      THEN awork[3] = BaseYear
           awork[4] = BaseYear
           awork[5] = BaseYear+5
           awork[6] = BaseYear+5
           awork[7] = BaseYear+10
           awork[8] = BaseYear+10
      ELSE IF ((k>1)AND(k<5))
             THEN i = (j-1)*3+k-1
             ELSE i = j+6
           ENDIF
           awork[3] = win0[i] * af
           awork[4] = sum0[i] * af
           awork[5] = win5[i] * af
           awork[6] = sum5[i] * af
           awork[7] = win10[i] * af
           awork[8] = sum10[i] * af
    ENDIF
    EDITKEY
    COPYFROMARRAY awork
    DO_IT!
  ENDFOR
ENDFOR
CLEARALL
ENDPROC ; CalRep4


;**************************************************************************
;      NAME: CalRep5()
;     EVENT: Calculates projections of monthly water consumption
;            and number of accounts five years into future
;            (60 months from the report date).
;            The following predictions are made:
;            -three user type categories (total service area)three time
;            - two planning areas (without subdivision into user types)
;            - total service area.The forecasts are stored in tables
;            "trep5a", "trep5b", "trep5c", "trep5d", "trep 5e",
;            and "trep5f" for further use.
;     UNITS: input [ccf], output [ccf/month]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            tabdfx - used by proc fdfx
;            rrep[1] - monthly forecast, single-family residential use
;            rrep[2] - monthly forecast, multi-family residential use
;            rrep[3] - monthly forecast, nonresidential use
;            rrep[4] - on-project monthly forecast
;            rrep[5] - off-project monthly forecast
;            rrep[6] - totel service area monthly forecast area
; ARRAYS   : awork[]
;            AAcct[6]  monthly number of accounts
;            ACons[6] expected water consumption
;            ACoHL[6] historical low water consumption
;            ACoHH6]  historical high water consumption
; VARIABLES: RepDate  - report date
;            RepMonth - number of months between Jan, 1986 and report
;                       month
;            fm  - month of the fiscal year ( fm = 1 for July)
;            cm  - month of the calendar year (cm = 1 for January)
;            my  - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;                 1986, and so on]
;            cyr - year component of the report date
;            cdy - day component of the report date
;            i, j, k
;     NOTES:
;                                   xxx tested  !!!    v2.1 22.XI.91
;**************************************************************************
PROC CalRep5()

ARRAY AAcct[6]
ARRAY ACons[6]
ARRAY ACoHL[6]
ARRAY ACoHH[6]
FindParameters(5)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(5) ; sets the output tables and the RepDate
slopes()
IF aesc = true THEN CLEARALL RETURN
ENDIF

VIEW rrep[1]
VIEW rrep[2]
VIEW rrep[3]
VIEW rrep[4]
VIEW rrep[5]
VIEW rrep[6]

cm = MONTH(RepDate)
cyr = YEAR(RepDate)
cdy = DAY(RepDate)
RepMonth = (YEAR(RepDate)-1986)*12+cm
cm = cm - 1
IF cm > 6 THEN fm = cm - 6
          ELSE fm = cm + 6  ENDIF
my = RepMonth-1
k=0
FOR my FROM RepMonth TO RepMonth+59
  k=k+1
  cm=cm+1
  IF cm = 13 THEN cm = 1
                  cyr = cyr + 1 ENDIF
  IF cm < 7  THEN fm = cm + 6 ELSE fm = cm - 6 ENDIF
;=======================================================================
; Planning area/user category historical low/high consumption is
; calculated by using demand adjustment factors estimated for
; months in which the maximum deviation was.. between observed
; on/off-project water use and modelled on/off-project consumption.
; Therefore low/high use forecasts for the user categories are
; underestimated. The total service area "historical low/high"
; is calculated as a sum of planning areas low/high values
; thus "historical low/high" for total service area is
; overestimated
;======================================================================

  FOR i FROM 1 TO 6
    AAcct[i] = face(my,i)
    ACons[i] = fcpa(i)*fsix(fm,i)*AAcct[i]
    ACoHL[i] = ACons[i] * fdfx(fm,i,1)
    ACoHH[i] = ACons[i] * fdfx(fm,i,2)
  ENDFOR
  sdate=DATEVAL(STRVAL(cm)+"/"+STRVAL(1)+"/"+STRVAL(cyr))
  MOVETO rrep[1]
  MOVETO RECORD 1
  COPYTOARRAY awork
  awork[2] = FORMAT("d6", sdate)
  FOR j  FROM 1 to 6
  x=" m = "+strval(my)+", "+awork[2]+" Report 5."+strval(j)+" "
  MsgCalc(x,40)
    MOVETO  rrep[j]
    IF j < 4 THEN
               awork[3] = AAcct[j] + AAcct[j+3]
               awork[4] = ACons[j] + ACons[j+3]
               awork[5] = ACoHH[j] + ACoHH[j+3]
               awork[6] = ACoHL[j] + ACoHL[j+3]
            ELSE
              IF j <6 THEN i = 3 * j - 11
               awork[3] = AAcct[i]+AAcct[i+1]+AAcct[i+2]
               awork[4] = ACons[i]+ACons[i+1]+ACons[i+2]
               awork[5] = ACoHH[i]+ACoHH[i+1]+ACoHH[i+2]
               awork[6] = ACoHL[i]+ACoHL[i+1]+ACoHL[i+2]
                      ELSE
                         awork[3] = 0
                         awork[4] = 0
                         awork[5] = 0
                         awork[6] = 0
                         FOR i FROM 1 TO 6
                           awork[3] = awork[3] + AAcct[i]
                           awork[4] = awork[4] + ACons[i]
                           awork[5] = awork[5] + ACoHH[i]
                           awork[6] = awork[6] + ACoHL[i]
                         ENDFOR  ; i
              ENDIF
    ENDIF
    EDITKEY
    MOVETO RECORD k
    COPYFROMARRAY awork
    DO_IT!
  ENDFOR  ; j
ENDFOR ; my
CLEARALL
ENDPROC ; CalRep5













;**************************************************************************
;      NAME: DoParameters()
;     EVENT: displays the names of the tablas with model parametes and
;            tables to which the results will be saved. The user can
;            accept these names or change them.
; ARGUMENTS: no arguments
; TABLES   : selected by user
; VARIABLES: many
;     NOTES:
;                                      xxx tested !!!   v42 16.III.91
;**************************************************************************
PROC DoParameters()
;USEVARS aesc, PathPar, xpath,
aesc = false
CANVAS OFF
ParamScreen(31)
CANVAS ON
xpath=PathPar
CheckPath(2,38)
IF aesc = true THEN RETURN
ENDIF
PathPar=xpath
WHILE True
  CANVAS OFF
  ParamScreen(31)
  CANVAS ON
  SHOWTABLES PathPar
    "Highlight name of table to edit, then press Enter"
    TO atable
  atable = PAthPar+atable
  IF NOT(ISTABLE(atable)) THEN RETURN
  ENDIF
  EDIT atable
  WHILE true
    WAIT TABLE
    PROMPT "Editing table "+atable,
         "Press [F2] to save changes, [Esc] to cancel changes."
    UNTIL "F2", "Esc"
    SWITCH
      CASE retval = "F2":
        Do_It!
        QUITLOOP
      CASE retval = "Esc":
        SHOWMENU
          "No"     : "Don't cancel changes",
          "Cancel" : "Cancel changes to table"+atable
        TO choice
        IF choice = "Cancel"
          THEN CANCELEDIT
               QUITLOOP ENDIF
      OTHERWISE: BEEP
    ENDSWITCH
  ENDWHILE
  CLEARIMAGE
ENDWHILE
ENDPROC ; DoParameters


;**************************************************************************
;      NAME: CalRep6()
;     EVENT: Calculates projections of monthly water consumption, monthly
;            water consumption adjusted
;            and number of accounts five years into future
;            (60 months from the report date).
;            The following predictions are made:
;            - three user type categories (total service area)three time
;            - two planning areas (without subdivision into user types)
;            - total service area.The forecasts are stored in tables
;            "trep6a", "trep6b", "trep6c", "trep6d", "trep6e",
;            and "trep5f" for further use.
;     UNITS: input [ccf], output [ccf/month]
; ARGUMENTS: no arguments
; TABLES   : tabcpa - used by proc fcpa
;            tabsix - used by proc fsix
;            tabace - used by proc face
;            tabtpr - used by proc ftpr
;            tabmfn - used by proc fmfn
;            tabret - used by proc fret
;            tabela - used by proc fela
;            rrep[1] - monthly forecast, single-family residential use
;            rrep[2] - monthly forecast, multi-family residential use
;            rrep[3] - monthly forecast, nonresidential use
;            rrep[4] - on-project monthly forecast
;            rrep[5] - off-project monthly forecast
;            rrep[6] - totel service area monthly forecast area
; ARRAYS   : awork[]
;            AAcct[6]  monthly number of accounts
;            ACons[6]  expected water consumption
;            ACoHL[6]  adjusted water demand
;            ACoHH[6]  difference between Adjusted demand and
;                      Normal demand
; VARIABLES: RepDate  - report date
;            RepMonth - number of months between Jan, 1986 and report
;                       month
;            fm  - month of the fiscal year ( fm = 1 for July)
;            cm  - month of the calendar year (cm = 1 for January)
;            my  - monthly time step [my = 1 for Jan,1986, my = 2 for Feb,
;                 1986, and so on]
;            cyr - year component of the report date
;            cdy - day component of the report date
;            i, j, k
;     NOTES:
;                                   xxx tested  !!!    20.III.92
;**************************************************************************
PROC CalRep6()

ARRAY AAcct[6]
ARRAY ACons[6]
ARRAY ACoHL[6]
ARRAY ACoHH[6]
FindParameters(6)
IF aesc = true THEN CLEARALL RETURN
ENDIF
FindOutTable(6) ; sets the output tables and the RepDate
slopes()
IF aesc = true THEN CLEARALL RETURN
ENDIF

VIEW rrep[1]
VIEW rrep[2]
VIEW rrep[3]
VIEW rrep[4]
VIEW rrep[5]
VIEW rrep[6]

cm = MONTH(RepDate)
cyr = YEAR(RepDate)
; cdy = DAY(RepDate) we don't use it any more
RepMonth = (YEAR(RepDate)-1986)*12+cm
cm = cm - 1
IF cm > 6 THEN fm = cm - 6
          ELSE fm = cm + 6  ENDIF
my = RepMonth-1
k=0
FOR my FROM RepMonth TO RepMonth+59
  k=k+1
  cm=cm+1
  IF cm = 13 THEN cm = 1
                  cyr = cyr + 1 ENDIF
  IF cm < 7  THEN fm = cm + 6 ELSE fm = cm - 6 ENDIF
;=======================================================================
; Array ACoHL keeps adjusted water demand
; Array aCoHH contains difference Adjusted demand - Normal demand
;======================================================================

z1=fela(1)*POW(ftpr(k,1,1),fela(3))
z1 = z1 * POW(ftpr(k,1,2),fela(4))
z1 = z1 * POW(ftpr(k,1,3),fela(5))
z1 = z1 * POW(ftpr(k,2,1),fela(6))
z1 = z1 * POW(ftpr(k,2,2),fela(7))
z1 = z1 * POW(ftpr(k,2,3),fela(8))
z1 = z1 * POW(fmfn(k,1),fela(9))
z1 = z1 * POW(fmfn(k,2),fela(10))
z1 = z1 * POW(fmfn(k,3),fela(11))
  FOR i FROM 1 TO 6
    AAcct[i] = face(my,i)
    ACons[i] = fcpa(i)*fsix(fm,i)*AAcct[i]
    ACoHL[i]=(z1*POW(fsix(fm,i),fela(2))-fela(12)*fret(k,i))*AAcct[i]
    ACoHH[i] = ACoHL[i]-ACons[i]
  ENDFOR
  sdate=DATEVAL(STRVAL(cm)+"/"+STRVAL(1)+"/"+STRVAL(cyr))
  MOVETO rrep[1]
  MOVETO RECORD 1
  COPYTOARRAY awork
  awork[2] = FORMAT("d6", sdate)
  FOR j  FROM 1 to 6
  x=" m = "+strval(my)+", "+awork[2]+" Report 6."+strval(j)+" "
  MsgCalc(x,40)
    MOVETO  rrep[j]
    SWITCH
      CASE j = 1: i = 1
      CASE j = 2: i = 4
      CASE j = 3: i = 2
      CASE j = 4: i = 5
      CASE j = 5: i = 3
      CASE j = 6: i = 6
    ENDSWITCH
    awork[3] = AAcct[i]
    awork[4] = ACons[i]
    awork[5] = ACoHH[i]
    awork[6] = ACoHL[i]
    EDITKEY
    MOVETO RECORD k
    COPYFROMARRAY awork
    DO_IT!
  ENDFOR  ; j
ENDFOR ; my
CLEARALL
ENDPROC ; CalRep6

;**************************************************************************
;      NAME: DoCalculate()
;     EVENT: allows user to select report for which forecasts should be
;            made and then executes appropriate procedure CalRep..().
;            Executes procedure Slopes()
; ARGUMENTS: no arguments
; PROCEDURs:  Slopes()
; TABLES   :
; ARRAYS   :
; VARIABLES: Y, choice
;     NOTES: check optymalnosc with proc slopes()
;                                      xxx tested !!!       v0.0 25.XI.91
;**************************************************************************

PROC DoCalculate()
  PRIVATE Y
  WHILE (True)
    errorproc = "CError"
    aesc = False ;key [Esc] has not been pressed
    t1= ""  t3= "" t4=""  t2= ""  t5= "" ; contain messages (window)

   CANVAS OFF                    ; turn canvas off to prevent flashing
   CLEAR
   CalcScreen(v1n)
   CANVAS ON                       ; turn Canvas back on with menu
    SHOWMENU
      "1 (a,b)" :
        "Monthly water production forecast.",
      "2 (a,b,c)" :
        "Water production forecast: current and next fiscal year.",
      "3 (a,b,c)" :
        "Revenue projection: current and next fiscal year.",
     "4 (a,b)" :
        "Long-term projections for comparison to PHXMAIN.",
      "5 (a..f)" :
        "Monthly water consumption forecast.",
      "6 (a..f)" :
        "Monthly forecast with and without demand adjustments.",
      "MainMenu" :
        "Return to Main Menu."
      TO choice

    SWITCH
      CASE choice = "MainMenu" OR choice = "Esc" :
         CANVAS OFF                       ; turn the canvas off to avoid
        RETURN                           ; flickering when return to MainMenu
        CANVAS ON                        ; now, turn the canvas back on
      CASE choice = "1 (a,b)"   : CalRep1()
      CASE choice = "2 (a,b,c)" : CalRep2()
      CASE choice = "3 (a,b,c)" : CalRep3()
      CASE choice = "4 (a,b)"   : CalRep4()
      CASE choice = "5 (a..f)"  : CalRep5()
      CASE choice = "6 (a..f)"  : CalRep6()
      OTHERWISE : BEEP BEEP BEEP; choice is not valid
    ENDSWITCH
    WHILE (CHARWAITING())               ; get all extra keystrokes before
      Y = GETCHAR()                     ; returning to selection menu
    ENDWHILE
  ENDWHILE
ENDPROC  ; DoCalculate


;**************************************************************************

;**************************************************************************
PROC DoReset()

aDrive = "c:\\MODEL"
PathPar = aDrive+"\\PAR\\" ; path to the model parameters
PathTem = aDrive+"\\TEM\\" ; path to the report table templates
PathRep = aDrive+"\\REP\\" ; path to the output directory

tcpa = "cpa000"
tsix = "six000"
tdfx = "dfx000"
tace = "ace000"
tmsf = "msf000"
tlld = "lld000"
tllp = "llp000"
tuna = "una000"
tpzf = "pzf000"
tbch = "bch000" ; Base charges + adjustment multiplier
tvch = "vch000" ; Volume charges + adjustment multiplier
twra = "wra000" ; Water Resource Acquisition Fees
tjrs = "jrs000" ; SF and NR proportions for South of J.Road
tduf = "duf000" ; dwelling unit fact. with South/North div.
twdo = "wdo000" ; Water/Sewer Development Occupational Fees
trrd = "rrd000" ; revenues recorded within fiscal year
trpz = "rpz000" ; productions recorded within fiscal year
ttpr = "tpr000" ; temperature and rainfall ratios
tmfn = "mfn000" ; marginal price, fixed charge, and new account
tret = "ret000" ; retrofit
tela = "ela000" ; elasticities
tabcpa = PathPar+tcpa
tabsix = PathPar+tsix
tabdfx = PathPar+tdfx
tabace = PathPar+tace
tabmsf = PathPar+tmsf
tablld = PathPar+tlld
tabllp = PathPar+tllp
tabuna = PathPar+tuna
tabpzf = PathPar+tpzf
tabbch = PathPar+tbch ; Base charges
tabvch = PathPar+tvch ; Volume charges
tabwra = PathPar+twra ; Water Resource Acquisition Fees
tabjrs = PathPar+tjrs ; SF and NR proportions for South of J.Road
tabduf = PathPar+tduf ; dwelling unit fact. with South/North div.
tabwdo = PathPar+twdo ; Water/Sewer Development Occupational Fees
tabrrd = PathPar+trrd ; revenues recorded within fiscal year
tabrpz = PathPar+trpz ; productions recorded within fiscal year
tabtpr = PathPar+ttpr ; temperature and rainfall ratios
tabmfn = PathPar+tmfn ; marginal price, fixed charge, and new account
tabret = PathPar+tret ; retrofit
tabela = PathPar+tela ; elasticities

RETURN
ENDPROC ; DoReset

;**************************************************************************
;      NAME: MainMenu()
;     EVENT: allows user to select the model activit (main menu)
;            and then executes appropriate procedure Do..().
; ARGUMENTS: no arguments
; PROCEDURs: DoParameters()
;            DoCalculate()
;            DoOutput()
;            DoExport()
;            DoGraphs()
;            DOS is a command
; TABLES   :
; ARRAYS   :
; VARIABLES: Y, choice
;     NOTES: ?here the setup might be displayed (model parameters) ?
;                                      xxx tested !!!       v0.0 5.XI.91
;**************************************************************************
PROC MainMenu()
Private Y

; =====Declaration of common arrays (common to save memory ======

ARRAY aM[5]  ; used in account core equations
ARRAY trep[6] ; name of template (without a path)
ARRAY rrep[6] ; complete name of table with predictions (path included)
ARRAY obs[26]    ; report 2, 3
ARRAY cons[50]   ; report 1, 2, and 3
ARRAY prod2[2]   ; report 2
ARRAY prod[2]    ; report 2
ARRAY SumObs[2]  ; report 2
ARRAY SumMod[2]  ; report 2
ARRAY r2ZErr95[12]     ; report 2
ARRAY r2ZErr85[12]     ; report 2
ARRAY bwork[12]
ARRAY cwork[18]  ; report 3
ARRAY Arep3c[21] ; report 3
ARRAY base[6] ;    report 3b

;================Display set-up========================
v1n = 31
v1a = 80
v1h = 32
v1w = 79
;v1w = 207 ; 15 (white) + 64 (red) + 128 (blinking)
mline = 23 ; message line

;========== Some coefficients not in table (yet) =====
sft = 0.544
sf1= 1-sft
t95r1 = 2.0      ; df = 60
t85r1 = 1.483    ; df = 60

FOR k FROM 1 TO 12
  r2ZErr95[k] = 0.1     ; (10% of mean)
  r2ZErr85[k] = 0.05    ; (5% of mean)
ENDFOR

RepDate = TODAY()
; BaseMultip = 1.0 multipliers are placed in base charge
; VolumeMultip = 1.0  and volume charge tables
r3BErr95 = 0.1 ; (10% of mean)
r3BErr85 = 0.05 ; (5% of mean)
r3VErr95 = 0.1 ; (10% of mean)
r3VErr85 = 0.05 ; (5% of mean)
r3AErr95 = 0.1 ; (10% of mean)
r3AErr85 = 0.05 ; (5% of mean)
r3WErr95 = 0.1 ; (10% of mean)
r3WErr85 = 0.05 ; (5% of mean)
r3SErr95 = 0.1 ; (10% of mean)
r3SErr85 = 0.05 ; (5% of mean)


  CANVAS OFF
  CLEAR                    ; Clear all tables on canvas and workspaces
  PAINTCANVAS ATTRIBUTE 31 0, 0, 24, 79
  STYLE ATTRIBUTE 30
  @ 2, 0
  TEXT
浜様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様融
 旭旭 PHOENIX  MONTHLY  WATER  FORECASTING  MODEL 旭旭 VERSION 4.8 旭旭旭旭 
把陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳超
  Current Date:                                                               
麺様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  MENU OPTIONS:                                                               
麺様様様様様様様曜様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Parameters        Edit model parameters                                    
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Calculate         Produce and save forecasts in Paradox tables             
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Output            Send reports to screen, printer, or file                 
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Export            Convert from Paradox format to  123  file format         
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Vacant            Free space for future development                        
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  DOS               Suspends Model and lets you issue DOS commands (programs)
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Quit              Leave Model and go to PARADOX                            
麺様様様様様様様洋様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様郵
  Reset             Set default model environment                            
藩様様様様様様様擁様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様夕
  ENDTEXT
  @5,15
  ?? FORMAT ("d8", TODAY())
  @ 5,28  ?? "Memory: "
  ?? MEMLEFT() ?? "  Code Pool: " ?? RMEMLEFT()
  PAINTCANVAS ATTRIBUTE 78 3, 7, 3, 49  ; paint "PHOENIX . . . SYSTEM"
  PAINTCANVAS ATTRIBUTE 14 3, 57, 3, 67 ; paint "VERSION"
  CANVAS ON
  PathFrom = PathRep
  STYLE
  SHOWMENU
    "Parameters" : "Edit model parameters",
    "Calculate"  : "Produce and save forecasts in Paradox tables.",
    "Output"     : "Send reports to screen, printer, or file.",
    "Export"     : "Convert from Paradox format to 123 file format.",
    "Vacant"     : "Space for future development.",
    "DOS"        : "Suspends Model and lets you issue DOS commands.",
    "Quit"       : "Leave Model and go to PARADOX.",
    "Reset"      : "Return model environment to default."
    TO choice
  SWITCH
    CASE (choice = "Quit" or choice = "Esc"):
      RETURN FALSE                      ; stop execution of the main loop
    CASE (choice = "Parameters"):
      DoParameters()
    CASE (choice = "Calculate"):
      DoCalculate()
    CASE (choice = "Output"):
      DoOutput()
    CASE (choice = "Export"):
      DoExport()
    CASE (choice = "Vacant"):
      BEEP BEEP BEEP BEEP BEEP  ;DoGraphs()
    CASE (choice = "DOS"):
      DOS
    CASE (choice = "Reset"):
      DoReset()
    OTHERWISE : BEEP BEEP BEEP; choice is not valid
  ENDSWITCH
  WHILE (CHARWAITING())         ; get all extra characters that were press
    Y = GETCHAR()               ; before returning to selection menu
  ENDWHILE
  RETURN TRUE                   ; show the Main menu again
ENDPROC ;  MainMenu



;**************************************************************************
;      NAME: MODEL.SC
;     EVENT: executes main menu
; ARGUMENTS: no arguments
; PROCEDURs: MainMenu()
;                                                        v0.0 5.XI.91
;**************************************************************************
;============== default model parameters ===============
aDrive = "c:"
PathPar = aDrive+"\\MODEL\\PAR\\" ; path to the model parameters
PathTem = aDrive+"\\MODEL\\TEM\\" ; path to the report table templates
PathRep = aDrive+"\\MODEL\\REP\\" ; path to the output directory
tcpa = "cpa000"
tsix = "six000"
tdfx = "dfx000"
tace = "ace000"
tmsf = "msf000"
tlld = "lld000"
tllp = "llp000"
tuna = "una000"
tpzf = "pzf000"
tbch = "bch000" ; Base charges
tvch = "vch000" ; Volume charges
twra = "wra000" ; Water Resource Acquisition Fees
tjrs = "jrs000" ; SF and NR proportions for South of J.Road
tduf = "duf000" ; dwelling unit fact. with South/North div.
twdo = "wdo000" ; Water/Sewer Development Occupational Fees
trrd = "rrd000" ; revenues recorded within fiscal year
trpz = "rpz000" ; productions recorded within fiscal year
ttpr = "tpr000" ; temperature and rainfall ratios
tmfn = "mfn000" ; marginal price, fixed charge, and new account
tret = "ret000" ; retrofit
tela = "ela000" ; elasticities
tabcpa = PathPar+tcpa
tabsix = PathPar+tsix
tabdfx = PathPar+tdfx
tabace = PathPar+tace
tabmsf = PathPar+tmsf
tablld = PathPar+tlld
tabllp = PathPar+tllp
tabuna = PathPar+tuna
tabpzf = PathPar+tpzf
tabbch = PathPar+tbch ; Base charges
tabvch = PathPar+tvch ; Volume charges
tabwra = PathPar+twra ; Water Resource Acquisition Fees
tabjrs = PathPar+tjrs ; SF and NR proportions for South of J.Road
tabduf = PathPar+tduf ; dwelling unit fact. with South/North div.
tabwdo = PathPar+twdo ; Water/Sewer Development Occupational Fees
tabrrd = PathPar+trrd ; revenues recorded within fiscal year
tabrpz = PathPar+trpz ; productions recorded within fiscal year
tabtpr = PathPar+ttpr ; temperature and rainfall ratios
tabmfn = PathPar+tmfn ; marginal price, fixed charge, and new account
tabret = PathPar+tret ; retrofit
tabela = PathPar+tela ; elasticities
ttpr = "tpr000" ; temperature and rainfall ratios
tmfn = "mfn000" ; marginal price, fixed charge, and new account
tret = "ret000" ; retrofit
tela = "ela000" ; elasticities

DoReset()
MainMenu()
WHILE (Retval)             ; repeat until MainMenu() returns False
  MainMenu()
ENDWHILE
? " koniec "
CLEARALL
RELEASE VARS ALL           ; release all global variables