$OPTIONS A
program POIFASIfx
***
* Abstract:
*    This program will send all new PO and VENDORS data to
* IFAS for subsequent processing within AP.
*
* Resource List:
* Inputs:
*    PO.TRANS
*    PO
*    VENDORS
*    RN
* Outputs:
*    PO.FLAT sequential file
*    &SAVEDLISTS&
* I-O:
*    IFAS.PO
*    IFAS.VENDORS
*
***
* Revision Log
* Who..... When.... Why...................................................
* Andrew   26Apr93  Initial coding.
*
***

deffun CheckSum(String, FieldList)
deffun SALES.TAX(TaxFlag)
deffun New.GL.No(OldGlNo)
deffun Simple(List)
FIELDS = "!FIELDS"

$INCLUDE PGM.FDEF EMPLOYEE.FDEF
$INCLUDE PGM.FDEF IFAS.PO.FDEF
$INCLUDE PGM.FDEF OAP.FDEF
$INCLUDE PGM.FDEF PO.FDEF
$INCLUDE PGM.FDEF PO.TRANS.FDEF
$INCLUDE PGM.FDEF RCVG.NOTICES.FDEF
$INCLUDE PGM.FDEF BLNKT.FDEF
$INCLUDE PGM.FDEF TERMS.FDEF
$INCLUDE PGM.FDEF VEND.PAY.TO.FDEF
$INCLUDE PGM.FDEF VENDORS.FDEF

OpenErrors = ""
open "&SAVEDLISTS&"      to SavedListsFile      else OpenErrors := "&SAVEDLISTS& "
open "BLNKT"             to BlnktFile           else OpenErrors := "BLNKT "
open "CHECKSUM.FIELDS"   to CheckSumFieldsFile  else OpenErrors := "CHECKSUM.FIELDS "
open "CLOSED.PO"         to CLosedPOFile        else OpenErrors := "CLOSED.PO "
open "CONTRACTS"         to ContractsFile       else OpenErrors := "CONTRACTS "
open "EMPLOYEE"          to EmployeeFile        else OpenErrors := "EMPLOYEE "
open "GARB"              to GarbFile            else OpenErrors := "GARB "
open "GL.DEPT.XREF"      to GLDeptXrefFile      else OpenErrors := "GL.DEPT.XREF "
open "GL.OBJECT.XREF"    to GLObjectXrefFile    else OpenErrors := "GL.OBJECT.XREF "
open "IFAS.CONTRACT"     to IfasContractFile    else OpenErrors := "IFAS.CONTRACT "
open "IFAS.PO"           to IFASPOFile          else OpenErrors := "IFAS.PO "
open "IFAS.RCVG.NOTICES" to IfasRcvgNoticesFile else OpenErrors := "IFAS.RCVG.NOTICES "
open "IFAS.VEND.PAY.TO"  to IfasVendPayToFile   else OpenErrors := "IFAS.VEND.PAY.TO "
open "IFAS.VENDORS"      to IfasVendorsFile     else OpenErrors := "IFAS.VENDORS "
open "HDCH"              to HDCHFile            else OpenErrors := "HDCH "
open "OAP"               to OAPFile             else OpenErrors := "OAP "
open "PO"                to POFile              else OpenErrors := "PO "
open "PO.TRANS"          to POTransFile         else OpenErrors := "PO.TRANS "
open "RCVG.NOTICES"      to RcvgNoticesFile     else OpenErrors := "RCVG.NOTICES "
open "SERV.CONTRACTS"    to ServContractsFile   else OpenErrors := "SERV.CONTRACTS  "
open "TERMS"             to TermsFile           else OpenErrors := "TERMS "
open "VEND.PAY.TO"       to VendPaytoFile       else OpenErrors := "VEND.PAY.TO "
open "VENDORS"           to VendorsFile         else OpenErrors := "VENDORS "

openseq "MAPS.BATCH", "PE.REC" to PESeqFile else
   if status() then OpenErrors := "PE.REC sequential file "
end
openseq "MAPS.BATCH", "POP.REC" to POPSeqFile else
   if status() then OpenErrors := "POP.REC sequential file "
end
openseq "MAPS.BATCH", "POT.REC" to POTSeqFile else
   if status() then OpenErrors := "POT.REC sequential file "
end

   execute "SETPTR ,,,,,,BRIEF,BANNER PO.IFAS.IFX,FORM XLAND"
   Hdg = "PO.IFAS.IFX Nightly Interface Log Report:'L'"
   printer on
   heading Hdg
print "PO.IFAS.IFX starting ":timedate()
crt "PO.IFAS.IFX starting ":timedate()

if OpenErrors then
   print "Unable to open the following files:"
   crt "Unable to open the following files:"
   print OpenErrors
   crt OpenErrors
   goto Abort
end

print "Reposition file pointer to end-of-file..."
crt "Repositioning file pointer to end-of-file..."
loop
   readseq dummy from PESeqFile else exit
repeat
loop
   readseq dummy from POPSeqFile else exit
repeat
loop
   readseq dummy from POTSeqFile else exit
repeat

read BuyerNos from GarbFile, "BUYER" else
   print "Unable to read BUYER from the GARB file."
   crt "Unable to read BUYER from the GARB file."
   goto Abort
end

ReadErrors = ""
read POFields from CheckSumFieldsFile, "PO" else ReadErrors := "PO "
read RcvgNoticesFields from CheckSumFieldsFile, "RCVG.NOTICES" else ReadErrors := "RCVG.NOTICES "
read ContractFields from CheckSumFieldsFile, "CONTRACT" else ReadErrors := "CONTRACT "
if ReadErrors then
   print "Unable to read ":ReadErrors:" from CHECKSUM.FIELDS file.  (po.ifas.ifx)"
   crt "Unable to read ":ReadErrors:" from CHECKSUM.FIELDS file.  (po.ifas.ifx)"
   goto Abort
end

Processed = 0
March31 = iconv("03/31/93","D")
POTx = 0
VendorTx = 0
POList = ""
VendorList = ""
ContractCutOffDate = iconv("7/1/93","D")
crt "PO:      /      Vendors:       processed/transfered so far...":

select POTransFile
loop
   readnext POTransKey else exit
   Processed += 1
   if mod(Processed,10) eq 0 then gosub UpdateProgress
   if POTransKey[1,1] eq "C" then ;* Is this a contract reference?
      gosub TryContract
   end else
      ContractRec = ""
      gosub TryPO
   end
repeat
gosub UpdateProgress
crt
ListStamp = date():".":time()
write POList to SavedListsFile, "IFAS.PO.":ListStamp:"000"
write VendorList to SavedListsFile, "IFAS.VENDOR.":ListStamp:"000"
print "Total PO records processed: ":Processed
crt "Total PO records processed: ":Processed
print "Total PO records transfered: ":POTx
crt "Total PO records transfered: ":POTx
print "Total VENDOR records transfered: ":dcount(VendorList,@FM)
crt "Total VENDOR records transfered: ":dcount(VendorList,@FM)
print "Select lists IFAS.PO.":ListStamp:" and IFAS.VENDOR.":ListStamp:" written."
crt "Select lists IFAS.PO.":ListStamp:" and IFAS.VENDOR.":ListStamp:" written."
print "PO.IFAS.IFX done ":timedate()
crt "PO.IFAS.IFX done ":timedate()
return

*****

TryContract:
ContractKey = POTransKey
read ContractRec       from ServContractsFile, ContractKey else
   read ContractRec    from BlnktFile        , ContractKey else
      read ContractRec from ContractsFile    , ContractKey else
         print "Unable to read ":ContractKey:" from CONTRACTS/BLNKT/SERV.CONTRACTS file."
         crt "Unable to read ":ContractKey:" from CONTRACTS/BLNKT/SERV.CONTRACTS file."
         return
      end
   end
end

read IfasRec from IfasContractFile, ContractKey else
   IfasRec = ""
end
ContractCheck = CheckSum(ContractRec,ContractFields)
if ContractCheck eq IfasRec<IPO$CHECKSUM> then return

POs = ContractRec<SC$REQ.PO.NOS>
if POs eq "" then
   delete POTransFile, POTransKey
   return
end
NoExpire = ContractRec<SC$EXP.DATE> eq ""
Balance = ContractRec<SC$AMT.APPROPRIATED> - ContractRec<SC$AMT.EXPENDED>
Balance = oconv(Balance,"MD2")
SkipContract = 0
EffYear = oconv(ContractRec<SC$EFF.DATE>,"D2 Y")
if ContractKey[1,1] eq "C" then
   if EffYear matches "90":@VM:"91" then
      SkipContract = Balance LE 5000
   end else
      SkipContract = Balance LE 0
   end
end else
   if EffYear matches "90":@VM:"91" then
      SkipContract = not(((ContractRec<SC$EXP.DATE> gt March31) or NoExpire) and Balance GT 10000)
   end else
      SkipContract = not(((ContractRec<SC$EXP.DATE> gt March31) or NoExpire) and Balance GT 0)
   end
end
if SkipContract then
   delete POTransFile, POTransKey
   return
end
Agg = ""
SCLIs = count(ContractRec<SC$ITEM.NO>,@VM) + 1
if ContractRec<SC$ITEM.NO> eq "" then
   ContractRec<SC$PRICE> = ContractRec<SC$AMT.APPROPRIATED>
   ContractRec<SC$ORD.QTY> = 1
end
for SCLI = 1 to SCLIs
   POKey = field(ContractRec<SC$REQ.PO.NOS,SCLI,1>,"*",1,1)
   if POKey eq "" then continue
   read PORec    from POFile      , POKey else
      read PORec from ClosedPOFile, POKey else
         return
      end
   end
   Agg<PO$APPR.BY>     = ContractRec<SC$BUYER.NO,SCLI>
   if ContractRec<SC$GL.NO> eq "" then
      Agg<PO$GL.NO> = PORec<PO$GL.NO,1>
   end else
      Agg<PO$GL.NO> = ContractRec<SC$GL.NO,SCLI>
   end
   if ContractKey[1,1] eq "C" then
      Agg<PO$IM.DESC>     = ContractRec<SC$DESC>
   end else
      Agg<PO$IM.DESC>     = ContractRec<SC$DESC,SCLI>
   end
   Agg<PO$ORD.DATE>    = ContractRec<SC$EFF.DATE>
   Agg<PO$PART.NO>     = ContractRec<SC$ITEM.NO,SCLI>
   Agg<PO$PO.QTY>      = ContractRec<SC$ORD.QTY,SCLI>
   if ContractRec<SC$PROJ.NO> eq "" then
      Agg<PO$PROJ.NO> = PORec<PO$PROJ.NO,1>
   end else
      Agg<PO$PROJ.NO> = ContractRec<SC$PROJ.NO,SCLI>
   end
   Agg<PO$REQ.LINE.NO> = PORec<PO$REQ.LINE.NO,1>
   Agg<PO$REQRD.DATE>  = PORec<PO$REQRD.DATE,1>
   Agg<PO$REQUESTOR>   = PORec<PO$REQUESTOR,1>
   Agg<PO$RQN.NO>      = PORec<PO$RQN.NO,1>
   Agg<PO$UNIT.PRICE>  = ContractRec<SC$PRICE,SCLI>

   Aggi = 1
   gosub SendContract

   Copy = ContractRec<SC$REQ.PO.NOS,SCLI>
   call @FIELDS(POs,Copy,"*",1,1)
   POs = Simple(POs)
   MorePOs = POs ne ""
   loop while MorePOs
      remove POKey from POs setting MorePOs
      read PORec from POFile, POKey else
         read PORec from ClosedPOFile, POKey else
            continue
         end
      end
      IfasRec = ""
      IfasRec<IPO$IFAS.DATE> = date()
      IfasRec<IPO$CHECKSUM> = CheckSum(PORec, POFields)
      write IfasRec to IfasPOFile, POKey
   repeat
next SCLI
ContractRec = ""
ContractKey  = ""
IfasRec<IPO$IFAS.DATE> = date()
IfasRec<IPO$CHECKSUM> = ContractCheck
write IfasRec to IfasContractFile, ContractKey
return

*****

TryPO:
POKey = POTransKey
read IFASPORec from IFASPOFile, POKey then
   IFASPORec = ''
end
read PORec from ClosedPOFile, POKey else
   read PORec from POFile, POKey else
      print "Unable to read ":POKey:" from PO/CLOSED.PO file"
      crt "Unable to read ":POKey:" from PO/CLOSED.PO file"
      return
   end
end
Check = CheckSum(PORec, POFields)
if IFASPORec<IPO$CHECKSUM> eq Check then
   delete POTransFile, POKey
   return
end
if PORec<PO$CONTRACT.NO> then ;* Is this a contract?
   SavePOKey = POTransKey
   POTransKey = PORec<PO$CONTRACT.NO,1>
   gosub TryContract
   delete POTransFile, SavePOKey
   return
end
if IFASPORec<IPO$CHECKSUM> eq "" then
   NewChange = "N"
end else
   NewChange = "C"
end
POList<-1> = POKey
POLIs = dcount(PORec<PO$PART.NO>,@VM)
AllClosed = 1
for POLI = 1 to POLIs
   if PORec<PO$AP.CLOSED.DATE,POLI> ne "" then continue  ;* skip closed
   AllClosed = 0
   gosub SendPO
   Vouchers = PORec<PO$VEN.VOU,POLI>:@FM:PORec<PO$VOU.NO,POLI>
   MoreVouchers = len(Vouchers) gt 0
   loop while MoreVouchers do
      remove Voucher from Vouchers setting MoreVouchers
      if Voucher eq "" then continue
      readv PayTo from OAPFile, Voucher, OAP$PAYTO else PayTo = ""
      call TRY.VENDORS(VendorsFile, VendPayToFile, IfasVendorsFile,
           IfasVendPayToFile, TermsFile, PORec<PO$VEND.NO>, PayTo,
           VendorList, PESeqFile)
   repeat
next POLI
if AllClosed then delete POTransFile, POKey
IFASPORec<IPO$IFAS.DATE> = date()
IFASPORec<IPO$CHECKSUM> = Check
write IFASPORec to IFASPOFile, POKey
return

*****

SendContract:
* This routine builds a flat record for each different GL in the Contract. The POP.Rec is
* then written out to the sequential file (POP.REC).
POTx += 1
POP.Rec = ""
POP.Rec := "PO"
POP.Rec := ContractKey               "L#7"
POP.Rec := "N"                          "R#1"
POP.Rec := "PR"                      ;* POP-STATUS
POP.Rec := Agg<PO$RQN.NO,Aggi>        "L#5"   ;* Requisition No.
POP.Rec := ("V":ContractRec<SC$VEND.NO>) "L#6"
POP.Rec := convert(" ","",oconv(Agg<PO$REQRD.DATE,Aggi>,"D4 YMD")) "R#8" ;* CCYYMMDD
POP.Rec := "" "L#15"
readv LastName from EmployeeFile, Agg<PO$REQUESTOR,Aggi>, EMP$LAST.NAME else
   LastName = "Unknown"
end
readv FirstName from EmployeeFile, Agg<PO$REQUESTOR,Aggi>, EMP$FIRST.NAME else
   FirstName = ""
end
POP.Rec := (LastName:(if FirstName then ", " else ""):FirstName) "L#20"
POP.Rec := convert(" ","",oconv(Agg<PO$ORD.DATE,Aggi>,"D4 YMD")) "R#8" ;* CCYYMMDD
POP.Rec := ("E":ContractRec<SC$BUYER.NO>)   "L#6"
POP.Rec := ContractRec<SC$CURRENCY.CODE>  "L#4"
readv LastName from EmployeeFile, Agg<PO$APPR.BY,Aggi>, EMP$LAST.NAME else
   LastName = "Unknown"
end
readv FirstName from EmployeeFile, Agg<PO$APPR.BY,Aggi>, EMP$FIRST.NAME else
   FirstName = ""
end
POP.Rec := (LastName:(if FirstName then ", " else ""):FirstName) "L#20"
POP.Rec := "C" ;*Contract type.
*                                              C - Service Contract
*                                              D - Blanket Contract
*                                              S - Contract
POP.Rec := ContractKey   "L#8"

POP.Rec := New.GL.No(Agg<PO$GL.NO,Aggi>)  "L#9"
POP.Rec := Agg<PO$PO.QTY,Aggi>      "R#8"  ;* PIC 9(8) PO.QTY
POP.Rec := iconv(Agg<PO$UNIT.PRICE,Aggi>,"MD5")  "R#18" ;* PIC 9(13)V9(5)
POP.Rec := "EA"
POP.Rec := "00000000"      "L#8"
POP.Rec := Agg<PO$PART.NO,Aggi>                   "L#6"  ;*PART.NO
POP.Rec := "" "R#18"  ;* Sales Tax
POP.Rec := ContractRec<SC$TAX.FLAG>  "L#1"
readv DiscPer from TermsFile, ContractRec<SC$TERMS.CODE>, TRM$DISC.PER else
   DiscPer = ""
end
POP.Rec := DiscPer                 "R#4"
POP.Rec := 0                "R#18" ;* PIC 9(13)V9(5) DISC.AMT
POP.Rec := SCLI             "R#2"    ;* POLI
POP.Rec := Agg<PO$RQN.NO,Aggi>                     "L#7"
POP.Rec := Agg<PO$REQ.LINE.NO,Aggi>        "R#2"
POP.Rec := ContractRec<SC$RETEN.PCT> "R#4"   ;* PIC 9(3)V9
Limit = oconv(ContractRec<SC$RETEN.LIMIT>,"MD2")
POP.Rec := iconv(Limit,"MD5")   "R#18"  ;* PIC 9(13)V9(5)
POP.Rec := Agg<PO$PROJ.NO,Aggi>           "L#10"
delete POTransFile, POTransKey
writeseq POP.Rec on POPSeqFile else
   print "Unable to write to PE sequential file.  Status()=":status()
   crt "Unable to write to PE sequential file.  Status()=":status()
   goto Abort
end

Texts = Agg<PO$IM.DESC,Aggi>
DescSVMs = dcount(Texts,@SM)
for DescSVM = 1 to DescSVMs
   remove Text from Texts setting dummy
   if Text ne "" then
      gosub SendConText
   end
next DescSVM
return

*****

SendConText:
POT.Rec = ""
POT.Rec := "PO"
POT.Rec := ContractKey                          "L#7"
POT.Rec := "PR"
POT.Rec := Agg<PO$RQN.NO,Aggi>                "L#7" ;* Requisition Number
POT.Rec := Agg<PO$REQ.LINE.NO,Aggi>            "R#2"
POT.Rec := DescSVM                        "R#2" ;* Sub Line Item No
POT.Rec := Text    "L#50"
writeseq POT.Rec on POTSeqFile else
   print "Unable to write to POT sequential file.  Status()=":status()
   crt "Unable to write to POT sequential file.  Status()=":status()
   goto Abort
end
return

*****

SendPO:
* This routine builds a flat record for each line item in the PO. The POP.Rec is
* then written out to the sequential file (POP.REC).
POTx += 1
POP.Rec = ""
POP.Rec := "PO"
POP.Rec := POKey                   "L#7"
POP.Rec := NewChange               "R#1"
if num(PORec<PO$PART.NO,POLI>) then
   POP.Rec := "PO"                  ;* POP-STATUS
   ProjNo = ""
end else
   POP.Rec := "PR"                      ;* POP-STATUS
   ProjNo = PORec<PO$PROJ.NO,POLI>
end
POP.Rec := PORec<PO$RQN.NO,POLI>   "L#5"   ;* Requisition No.
POP.Rec := ("V":PORec<PO$VEND.NO>) "L#6"
POP.Rec := convert(" ","",oconv(PORec<PO$REQRD.DATE,POLI>,"D4 YMD")) "R#8" ;* CCYYMMDD
POP.Rec := PORec<PO$SHIP.TO>       "L#15"
readv LastName from EmployeeFile, PORec<PO$REQUESTOR,POLI>, EMP$LAST.NAME else
   LastName = "Unknown"
end
readv FirstName from EmployeeFile, PORec<PO$REQUESTOR,POLI>, EMP$FIRST.NAME else
   FirstName = ""
end
POP.Rec := (LastName:(if FirstName then ", " else ""):FirstName) "L#20"
POP.Rec := convert(" ","",oconv(PORec<PO$ORD.DATE>,"D4 YMD")) "R#8" ;* CCYYMMDD
POP.Rec := ("E":BuyerNos<PORec<PO$BUYER.NO>>)  "L#6"
POP.Rec := PORec<PO$CURRENCY.CODE> "L#4"
readv LastName from EmployeeFile, PORec<PO$APPR.BY,POLI>, EMP$LAST.NAME else
   LastName = "Unknown"
end
readv FirstName from EmployeeFile, PORec<PO$APPR.BY,POLI>, EMP$FIRST.NAME else
   FirstName = ""
end
POP.Rec := (LastName:(if FirstName then ", " else ""):FirstName) "L#20"
POP.Rec := PORec<PO$CONTRACT.NO,POLI> "L#1" ;* Contract Type
*                                              C - Service Contract
*                                              D - Blanket Contract
*                                              S - Contract
POP.Rec := PORec<PO$CONTRACT.NO,POLI> "L#8"

POP.Rec := New.GL.No(PORec<PO$GL.NO,POLI>)  "L#9"

POP.Rec := PORec<PO$PO.QTY,POLI>      "R#8"  ;* PIC 9(8)
POP.Rec := PORec<PO$UNIT.PRICE,POLI>  "R#18" ;* PIC 9(13)V9(5)
POP.Rec := PORec<PO$UNIT.MEAS,POLI>   "L#2"
POP.Rec := PORec<PO$COMM.CODE,POLI>   "L#8"
POP.Rec := PORec<PO$PART.NO,POLI>     "L#6"
SalesTax = SALES.TAX(PORec<PO$TAX.FLAG,POLI>)
SalesTaxAmount = SalesTax * PORec<PO$PO.QTY,POLI> * oconv(PORec<PO$UNIT.PRICE,POLI>,"MD5")
POP.Rec := iconv(SalesTaxAmount,"MD5") "R#18" ;* PIC 9(13)V9(5)
POP.Rec := PORec<PO$TAX.FLAG,POLI> "L#1"
readv DiscPer from TermsFile, PORec<PO$TERMS.CODE,POLI>, TRM$DISC.PER else
   DiscPer = ""
end
POP.Rec := DiscPer                 "R#4"
POP.Rec := 0                     "R#18" ;* PIC 9(13)V9(5) DISC.AMT
POP.Rec := POLI                    "R#2"
if (PORec<PO$RQN.NO,POLI> ne "") and (PORec<PO$RQN.NO,POLI> ne 0) then
   RQNNo = PORec<PO$RQN.NO,POLI>
end else
   RQNNo = POKey
end
POP.Rec := RQNNo                     "L#7"
ReqLineNo = PORec<PO$REQ.LINE.NO,POLI>
POP.Rec := ReqLineNo                  "R#2"
POP.Rec := ContractRec<SC$RETEN.PCT> "R#4"   ;* PIC 9(3)V9
Limit = oconv(ContractRec<SC$RETEN.LIMIT>,"MD2")
POP.Rec := iconv(Limit,"MD5")   "R#18"  ;* PIC 9(13)V9(5)
POP.Rec := ProjNo                 "L#10"
delete POTransFile, POTransKey
writeseq POP.Rec on POPSeqFile else
   print "Unable to write to PE sequential file.  Status()=":status()
   crt "Unable to write to PE sequential file.  Status()=":status()
   goto Abort
end

DescSVMs = dcount(PORec<PO$IM.DESC,POLI>,@SM)
for DescSVM = 1 to DescSVMs
   if PORec<PO$IM.DESC,POLI,DescSVM> ne "" then
      gosub SendPOT
   end
next DescSVM
return

SendPOT:
POT.Rec = ""
POT.Rec := "PO"
POT.Rec := POKey                          "L#7"
POT.Rec := "PR"
POT.Rec := RQNNo                          "R#7" ;* Requisition Number
POT.Rec := ReqLineNo                      "R#2"
POT.Rec := DescSVM                        "R#2" ;* Sub Line Item No
POT.Rec := PORec<PO$IM.DESC,POLI,DescSVM> "L#50"
writeseq POT.Rec on POTSeqFile else
   print "Unable to write to POT sequential file.  Status()=":status()
   crt "Unable to write to POT sequential file.  Status()=":status()
   goto Abort
end
return

UpdateProgress:
crt @(4):fmt(Processed,"R#5"):@(10):fmt(POTx,"R#5"):
crt @(25):fmt(dcount(VendorList,@FM),"R#5"):
return

Abort:
   print "PO.IFAS.IFX aborted ":timedate()
   crt "PO.IFAS.IFX aborted ":timedate()
   stop

end