IBM Mainframe Forum

Option Explicit

'$include "basics.ebh"

Global access_db, full_ident, in_opol, users_table as Object
Global dbDenyRead, dbDenyWrite, dbOpenTable, dbOpenSnapshot, dbUseJet, wdDoNotSaveChanges
Global vbYesNo, vbYes, vbNo

Function get_sequence_number(db as Object)
   dim table as Object, seq_num

   set table = db.OpenRecordset("cap_summary_seq", dbOpenTable, dbDenyRead Or dbDenyWrite)
   seq_num = table("summary_seq_num")
   table.Edit
   table("summary_seq_num") = seq_num + 1
   table.Update
   table.Close

   get_sequence_number = seq_num
 
End Function

Function fixup_bene(s)
    If len(s) = 0 Then
        fixup_bene = s
    Else
        fixup_bene = Chr(10) & s
    End If
End Function

function format_status(status)
    if status = "I/F" then
        format_status = "In Force"
    elseif status = "SUR" then
        format_status = "Surrendered"
    else
        format_status = status
    end if
end function

Function find_next_gic_renewal(dte)
    Dim done, i, test_date
   
    done = false
    i = 1
    While Not done
        test_date = DateSerial(Year(dte) + 5*i, Month(dte), Day(dte))
        If test_date > Now() Then
            done = True
        End If
        i = i + 1
    Wend
    find_next_gic_renewal = test_date
End Function

Function add_cap_header(db as Object, seq_number, eng, fax_page, send_to_name, send_to_fax, policies())
    Dim table As Object
    Dim num_policies As Integer, i As Integer
    Dim fax_summary As String
   
    num_policies = UBound(policies) - LBound(policies) + 1
   
    Set table = db.OpenRecordset("cap_summary_header", dbOpenTable)
    table.AddNew
    table("lang") = "en"
    If Len(send_to_name) > 0 Or Len(send_to_fax) > 0 Then
        table("seq_number") = seq_number
        table("fax_print_page") = fax_page
        table("fax_to_name") = send_to_name
        table("fax_to_number") = send_to_fax
        table("fax_pages") = ubound(policies) - lbound(policies) + 2
        table("fax_from_name") = users_table("first_name") & " " & users_table("last_name")
        table("fax_from_phone") = users_table("phone") & " x. " & users_table("ext")
        table("fax_from_fax") = users_table("fax")
        If num_policies = 1 Then
            fax_summary = "Here is the requested summary for " & policies(0)
        ElseIf num_policies = 2 Then
            fax_summary = "Here are the requested summaries for " & policies(0) & " and " & policies(1)
        Else
            fax_summary = "Here are the requested summaries for " & policies(0)
            For i = 1 To UBound(policies)
                If i = UBound(policies) Then
                    fax_summary = fax_summary & " and " & policies(i)
                Else
                    fax_summary = fax_summary & ", " & policies(i)
                End If
            Next
        End If
        table("fax_remarks") = fax_summary & "."
    End If
    table.Update
    table.Close
End Function

function add_cap_summaries(table as Object, seq_number, eng, policies())
    Dim i, j, plan, agent, max, max2, row, num_pages, tmp, yrs_rem, regd, income_policy

    For j = lbound(policies) To ubound(policies)
        SendSafe policies(j)
        SendSafe "<enter>"
        SendSafe "/1"
        SendSafe "<enter>"
        If instr(get_field(21, 2), "O1005") > 0 Then
            MsgBox "Policy number " & policies(j) & " is invalid, skipping to next."
            'Exit Function
        Else
            table.AddNew

            table("lang") = "en"

            table("seq_number") = seq_number
            table("REQ_DATE") = Now
            table("POLICY") = policies(j)
            table("ANNUITANT") = get_field(5, 10)
            table("OWNER") = get_field(6, 10)

            SendSafe "/3"
            SendSafe "<enter>"

            table("BRANCH") = get_field(3, 28)
            table("STATUS") = format_status(get_field(6, 2))
            plan = get_field(12, 2)

            If instr("GIC", plan) > 0 Then
                yrs_rem = get_field(18, 17)
            End If
           
            if instr("MGII", plan) > 0 then
                table("GUAR_SUB") = "Months"
            else
                table("GUAR_SUB") = "Days"
            end if

            table("PLAN") = plan

            table("POLICY_DATE") = pip_to_real_date(get_field(6, 8))
           
            regd = get_field(9, 58)
            table("REGISTERED") = regd
           
            If InStr("LIF", regd) > 0 Or InStr("RRF", regd) > 0 Or InStr("RFQ", regd) > 0 Or InStr("LFQ", regd) > 0 Then
                income_policy = true
            ElseIf InStr("AGII", plan) > 0 Or InStr("MGII", plan) > 0 Then
                MsgBox "Income policy!"
                income_policy = true
            Else
                income_policy = false
            End If
           
            table("ISSUE_AGE") = get_field(6, 31)

            table("INTEREST_RATE") = get_field(18, 29)

            SendSafe "/2"
            SendSafe "<enter>"

            If instr("RIB", plan) = 0 Then
                tmp = get_field(9, 70)
                If Len(tmp) > 0 Then
                    table("ORIG_AMT") = get_field(9, 70)
                End If
            End If
            table("ACCUM_VAL") = get_field(17, 2)
            agent = get_field(17, 49)

            if instr("AGII", plan) > 0 then
                table("GUAR_YEARS") = get_field(9, 31)
                table("GUAR_DAYS_OR_MONTHS") = 0
            elseif instr("DIA", plan) > 0 Or instr("RIB", plan) > 0 then
                ' DIAs don't have a renewal period
            elseif instr("GIC", plan) > 0 then
                table("GUAR_YEARS") = 5
                table("GUAR_DAYS_OR_MONTHS") = 0
                tmp = get_field(9, 55)
            else
                table("GUAR_YEARS") = get_field(9, 31)
                table("GUAR_DAYS_OR_MONTHS") = get_field(9, 43)
            end if

            If len(agent) > 0 Then
                table("AGENT") = agent
            Else
                MsgBox "Unable to get agent code from page 2.  This is an error and you should notify commissions."
                SendSafe "/19"
                SendSafe "<enter>"
                table("AGENT") = get_field(7, 2)
            End If

            SendSafe "/2.4"
            SendSafe "<enter>"
           
            If instr("GIC", plan) > 0 Then
                MsgBox "Value next anniversary: " & tmp
                For i = 1 to yrs_rem - 1
                    tmp = tmp * (1 + table("INTEREST_RATE") / 100)
                Next
                MsgBox "Renewal value: " & tmp
                table("RENEWAL_VAL") = tmp
            ElseIf instr("DIA", plan) = 0 And instr("RIB", plan) = 0 And instr(table("REGISTERED"), "RRF") = 0 Then
                table("RENEWAL_VAL") = trim(right(get_field(7, 20), 10))
            ElseIf instr("RIB", plan) > 0 then
                SendSafe "/3.2"
                SendSafe "<enter>"
                table("PREMIUM") = get_field(6, 37)
                table("PAYMENT_NEXT") = pip_to_real_date(get_field(6, 17))
                table("PAYMENT_FREQ") = get_field(6, 12)
            End If

            If income_policy Then
                SendSafe "/23<enter>"
                table("PREMIUM") = get_field(10, 12)
                table("PAYMENT_NEXT") = pip_to_real_date(get_field(10, 34))
                table("PAYMENT_FREQ") = get_field(7, 20)               
            End If

            SendSafe "/12"
            SendSafe "<enter>"

            If instr("GIC", plan) > 0 Then
                SendSafe "/3.2<enter>"
                table("ORIG_DEPOSIT_DATE") = pip_to_real_date(get_field(18, 2))
            Else
                table("ORIG_DEPOSIT_DATE") = pip_to_real_date(get_field(15, 49))
            End If
            If instr("GIC", plan) > 0 Then
                table("RENEWAL_DATE") = find_next_gic_renewal(table("ORIG_DEPOSIT_DATE"))
            ElseIf instr("DIA", plan) = 0 And instr("RIB", plan) = 0 Then
                table("RENEWAL_DATE") = pip_to_real_date(get_field(6, 15))
            End If

            SendSafe "/18"
            SendSafe "<enter>"

            table("ADDRESS1") = get_field(8, 8)
            table("ADDRESS2") = get_field(9, 8)
            table("ADDRESS3") = get_field(10, 8)

            SendSafe "/2.5"
            SendSafe "<enter>"
           
            Pause 1
           
            If InStr(get_field(22, 2), "Action Cancelled") = 0 Then
                SendSafe "<pf10>"
                SendSafe "vb"
                SendSafe "<enter>"

                max = get_field(5, 70)
                if Strcomp(max, "ERROR!") <> 0 and len(max) <> 0 then
                    max = cint(max)
                    if max > 5 then
                        max = 5
                    end if
                    row = 0
                    for i = 1 to max
                        table("BEN_TYPE" & i) = get_field(7 + 2*row, 7)
                        table("BEN_NAME" & i) = get_field(7 + 2*row, 19)
                        table("BEN_REL" & i) = get_field(8 + 2*row, 27)
                        table("BEN_CL" & i) = get_field(8 + 2*row, 50)
                        table("BEN_POR" & i) = get_field(8 + 2*row, 63)
                        If row = 2 Then
                            SendSafe "<pf8>"
                            row = 0
                        End If
                        row = row + 1
                    next
                else
                    max = 0
                end if

                if max < 5 then
                    SendMultiple "<down>", 8

                    max2 = get_field(13, 70)
                    if strcomp(max2, "ERROR!") <> 0 and len(max2) <> 0 then                       
                        max2 = cint(max2)
                        if max + max2 > 5 then
                            max2 = 5 - max
                        end if
                        row = 0
                        for i = 1 to max2
                            table("BEN_TYPE" & (max + i)) = get_field(15 + 2*row, 7)
                            table("BEN_NAME" & (max + i)) = get_field(15 + 2*row, 12) & _
                              fixup_bene(get_field(16 + 2*row, 12)) & _
                              fixup_bene(get_field(17 + 2*row, 12))
                            table("BEN_CL" & (max + i)) = get_field(15 + 2*row, 64)
                            If row = 2 Then
                                SendSafe "<pf8>"
                                row = 1
                            End If
                            row = row + 1
                        next
                    end if
                end if

                SendSafe "<pf3>"
            Else
                MsgBox "Unable to retrieve beneficiary information."
            End If
           
            SendSafe "<pf3>"
            SendSafe "x"
            SendSafe "<enter>"

            table.Update
        End If
    Next
end function

Function ask_for_policies (byref policies())
    Dim policy, more, valid, num_policies

    more = true
    num_policies = 0
    While more
        valid = false
        while not valid
            policy = Trim(InputBox("Enter policy number to summarize (or nothing to build summaries):", "B Number"))
            if policy = "" then
                valid = true
                more = false
            elseif len(policy) = 7 then
                valid = true
                ReDim Preserve policies(num_policies)
                policies(num_policies) = ucase(policy)
                num_policies = num_policies + 1
            else
                MsgBox ucase(policy) & " is not a valid policy number, please re-enter."
            end if
        Wend
    Wend
    ask_for_policies = num_policies
End Function

Sub Main()
    Dim done1, seq_num, num_policies, policies(), eng
    Dim dbe As Object, db as Object, table as Object, WshShell as Object, WshEnv as Object
    Dim fax_page As Integer, send_to_name As String, send_to_fax As String

    'Global Definitions
    vbYesNo = 4
    vbYes = 6
    vbNo = 7
 
   
    dbOpenTable = 1
    dbOpenSnapshot = 4
    dbUseJet = 2
    dbDenyWrite = 1
    dbDenyRead = 2
    wdDoNotSaveChanges = 0

    in_opol = false
   

    access_db = "D:\cap_summary\cap_summary.mdb"

    Set WshShell = CreateObject("WScript.Shell")
    Set WshEnv = WshShell.Environment("PROCESS")
    full_ident = WshEnv("USERNAME")
   
   
    Set dbe = CreateObject("DAO.DBEngine.36")
    Set db = dbe.OpenDatabase(access_db)
   
    seq_num = get_sequence_number(db)
   
   
    set table = db.OpenRecordset("cap_summary_data", dbOpenTable)

    set users_table = db.OpenRecordset("SELECT * FROM users WHERE user_id = '" & full_ident & "'", dbOpenSnapshot, dbDenyWrite)

    Connect "C:"
       
   
    SendSafe "OPOL,B685476,isp60,1"              ' This just uses a dummy policy to get us into OPOL successfully
    SendSafe "<enter>"
   
   
    done1 = false
    do
        If MsgBox("Print English summary? (Hit Enter for English, Escape for French)", vbYesNo) = vbYes Then
            eng = true
   Else
            eng = false
   End If

        If MsgBox("Do you wish to print a fax cover page?", vbYesNo) = vbYes Then
            fax_page = True
            send_to_name = InputBox("Enter recipient's name:", "Send To")
            send_to_fax = InputBox("Enter recipient's fax number:", "Send To")
        Else
            fax_page = False
            send_to_name = "No fax cover page"
            send_to_fax = "No fax cover page"
        End If
        num_policies = ask_for_policies(policies)

 
        If num_policies > 0 Then
            add_cap_header db, seq_num, eng, fax_page, send_to_name, send_to_fax, policies
            add_cap_summaries table, seq_num, eng, policies
        End If
        If MsgBox("Do you want to enter more policies?", vbYesNo) = vbNo Then
            Exit Do
        End If
    loop while Not done1

    SendMultiple "<clear>", 2

    table.Close
    users_table.Close
    Set table = Nothing
    Set users_table = Nothing
 
    Set dbe = Nothing
End Sub

    access_db = "D:\cap_summary\cap_summary.mdb"
    Set WshShell = CreateObject("WScript.Shell")
    Set WshEnv = WshShell.Environment("PROCESS")
    full_ident = WshEnv("USERNAME")
    set users_table = db.OpenRecordset("SELECT * FROM users WHERE user_id = '" & full_ident & "'", dbOpenSnapshot, dbDenyWrite)