program ApEncumberIfx

***
* Abstract:
*    This program will interface to the current GL system (COBOL yuch!)
* so that it can track all the encumbrances for PO's. Currently there is
* a report that data entry people are entering this info from that this
* program is being designed to replace. Loosely based on the code found
* in LIST.AP70, this program will take each Expense and Service Contract
* type PO's and create a transaction record (TC70) that will be sent to
* GL.
*
***
* R e v i s i o n   L o g
* Who..... When.... Why..................................................
* Andrew   10/26/92 Initial coding.
*
***

      equ True to 1
      equ False to 0
      equ Others to 1

$include PGM.FDEF PO.FDEF
$include PGM.FDEF VENDORS.FDEF

      Spread = ""                       ;* our spreadsheet
      equ S$GL to 1
      equ S$Proj to 2
      equ S$Cost to 3

      deffun Sales.Tax(Code)

      BatchDate = oconv(DATE(),"D2/")
      iBatchDate = DATE()
      convert "/" to "" in BatchDate

* The following code will determine when the next fiscal end and start
* dates will occur.
      fYear = BatchDate[2]
      CriticalDate = "07/03/":fYear
      iCriticalDate = iconv(CriticalDate,"D")
      if iBatchDate ge iCriticalDate then fYear += 1
      FiscalStart = "07/01/":fYear
      FiscalEnd   = "06/30/":fYear
      iFiscalStart = iconv(FiscalStart,"D")
      iFiscalEnd = iconv(FiscalEnd,"D")
      convert "/" to "" in FiscalStart
      convert "/" to "" in FiscalEnd

      OpenErrors = ""
      open "","GARB"      to GarbFile     else OpenErrors := "GARB "
      open "","PO.TRANS"  to POTransFile  else OpenErrors := "PO.TRANS "
      open "","PO"        to POFile       else OpenErrors := "PO "
      open "","CLOSED.PO" to ClosedPOFile else OpenErrors := "CLOSED.PO "
      open "","VENDORS"   to VendorsFile  else OpenErrors := "VENDORS "
      open "","ENCUMBER.TICKLE" to TickleFile else OpenErrors := "ENCUMBER.TICKLE "
      if OpenErrors then
         crt "Unable to open the following files:"
         crt OpenErrors:"(ApEncumberIfx)"
         stop
      end

      read NextEncumberBatchRec from GarbFile, "NEXT.ENCUMBER.BATCH" then
         BatchSequence = ("00":NextEncumberBatchRec<1>)[2]
         NextEncumberBatchRec<1> += 1
         NextEncumberBatchRec<2> = date()
      end else
         NextEncumberBatchRec = 1:@FM:date()
      end
      write NextEncumberBatchRec to GarbFile, "NEXT.ENCUMBER.BATCH"

      select POTransFile
      Rcds = 0
      crt "Starting AP.ENCUMBER.IFX.  (apencumberifx)"
      loop
         readnext POTransKey else exit
         Rcds += 1
         if mod(Rcds,10) eq 0 then crt "*":
         read POTransRec from POTransFile, POTransKey else
            crt
            crt "Unable to read ":POTransKey:" from PO.TRANS file.  (ApEncumberIfx)"
            continue
         end
         if POTransRec<1> ne "NEW" then
            gosub DeletePOTrans
            continue
         end
         read PORec from POFile, POTransKey else
            read PORec from ClosedPOFile, POTransKey else
               crt
               crt "Unable to read ":POTransKey:" from PO or CLOSED.PO files. (ApEncumberIfx)"
               delete POTransFile, POTransKey
               continue
            end
         end
         if PORec<PO$REL.PO> ne "N" then
            gosub DeletePOTrans
         end else
            gosub TransferEncumbrance
         end
      repeat
      crt
      crt "AP.ENCUMBER.IFX complete.  (apencumberifx)"
      return

DeletePOTrans:
      delete POTransFile, POTransKey
      return

TransferEncumbrance:
      if (PORec<PO$CONTRACT.NO>[1,1] eq "D") then ;* Skip blanket PO's.
         gosub DeletePOTrans
         return
      end
      readv VendorName from VendorsFile, PORec<PO$VEND.NO>, VEN$VENDOR.NAME else
         VendorName = "Unknown"
      end
      LineItems = dcount(PORec<PO$GL.NO>, @VM)
      for LI = 1 to LineItems
         gosub ProcessLI
      next LI

      Rows = dcount(Spread<S$GL>,@VM)
      SuffixIdx = 1
      for Row = 1 to Rows
         Projects = dcount(Spread<S$Proj,Row>, @SM)
         for Project = 1 to Projects
            if Spread<S$Cost,Row,Project> then
               gosub BuildTC70
            end
         next Project
      next Row

*      gosub DeletePOTrans ;* For production only!

      Spread = ""
      return

ProcessLI:
      GLNo = PORec<PO$GL.NO, LI>
      AccountNo = field(GLNo,'-',2)
      if (AccountNo[1,1] ne 5) then return
      if AccountNo eq 50489 then return
      locate GLNo in Spread<S$GL,1> setting Row else
         ins GLNo before Spread<S$GL,Row>
      end
      Project = PORec<PO$PROJ.NO,LI>
      locate Project in Spread<S$Proj,Row,1> setting ProjLoc else
         ins Project before Spread<S$Proj,Row,ProjLoc>
      end
      Cost = PORec<PO$PO.QTY, LI>
      Cost = Cost * oconv(PORec<PO$UNIT.PRICE, LI>,"MD5")
      Cost = Cost * (Sales.Tax(PORec<PO$TAX.FLAG, LI>) + 1.00000)
      Spread<S$Cost, Row, ProjLoc> += Cost
      return

BuildTC70:
      PriorYear = iBatchDate ge iFiscalStart
      PriorYear = PriorYear and PORec<PO$ORD.DATE> le iFiscalEnd

      TC70Rec = SPACE(128)
      TC70Rec[ 1, 2] = "70"
      TC70Rec[ 3, 6] = if PriorYear then FiscalEnd else BatchDate
      TC70Rec[ 9, 4] = "MAPS"
      TC70Rec[13, 2] = BatchSequence
      TC70Rec[15, 1] = "D"
      GLNo = Spread<S$GL, Row>
      TC70Rec[16, 6] = ("000000":field(GLNo,'-',1))[6]
      TC70Rec[22, 5] = ("00000":field(GLNo,'-',2))[5]
      if (Projects * Rows) gt 1 then
         Suffix = char(64 + SuffixIdx)
         SuffixIdx += 1
      end else
         Suffix = ""
      end
      TC70Rec[27, 8] = fmt(POTransKey:Suffix,"L#8")
      TC70Rec[35,11] = fmt(iconv(Spread<S$Cost, Row, Project>, "MD2"), "R#11")
      TC70Rec[46, 6] = convert("/","",oconv(PORec<PO$ORD.DATE>,"D2/"))
      TC70Rec[53, 1] = if PriorYear then "P" else " "
      TC70Rec[54, 3] = field(GLNo, '-', 3)[1, 3]
      TC70Rec[57, 3] = fmt(field(GLNo, '-', 3)[1], "R#3")
      TC70Rec[60, 6] = fmt(Spread<S$Proj, Row, Project>, "R#6")
      TC70Rec[66,25] = fmt(VendorName,"L#25")

      gosub GetTickleKey
      write TC70Rec to TickleFile, TickleKey

      return


GetTickleKey:
      readu TickleKey from GarbFile, "NEXT.TICKLE.KEY" else
         TickleKey = 1
      end
      write TickleKey+1 to GarbFile, "NEXT.TICKLE.KEY"
      return

   end