azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
0f0f664e8e2d67224f688f449bc6cb93accf389f
claudetools/clients/valleywide/app-modernization/source-code/000_ASource/frmLotInfo5JJ.frm
Mike Swanson 0f0f664e8e feat(valleywide): add drive 2 findings - 000_ASource + analyzer outputs 
Drive 2 (label "Backup", 12 TB, 6.77 TB used) — second of N VWP
backup drives. Scanned via WizTree, analyzed with analyze_wiztree.py.

NEW source content:
- 000_ASource/ — Darv's active work-in-progress folder. Contains
  TEST_VWP.vbp (2021-08-16, only .vbp newer than the 2020-06-09 baseline),
  four frmLotInfo*.frm variants (2020-10 to 2021-08), and an
  MSSCCPRJ.SCC file confirming Darv used Visual SourceSafe.
- The accompanying Vwp.mdb (2022-10-19, 764 MB) stays on local disk
  per .gitignore — newest database snapshot we have.

Analysis CSVs:
- source-analysis/drive2-2026-05-16/ — per-category + per-keyword
  breakdown of drive 2's 3.95M files (vs drive 1's 1.87M). Categories
  largely match drive 1 but with ~2x volume.

Net findings vs drive 1:
- Confirmed 4-year gap: only 4 .vbp files newer than 2020-06-09 on
  drive 2, all the same TEST_VWP.vbp scaffold. Main ORDERS_C.vbp source
  remains 2020-06-09. Darv stopped active VB6 dev around mid-2020.
- 43 GB Win7 Backup-and-Restore set in D:\Archive\Darv-Win7-PC\ (2023)
  not copied — deferred to later drives, ZIPs extractable on demand.
- Master Darv folder is bit-for-bit duplicate of drive 1's master (135 GB,
  same file/folder counts). Skipped.

New helper scripts:
- find_newer_vbp.py — list .vbp files newer than a date, filter SDK noise
- drive2_inspect.py / drive2_priorities.py — drive-specific triage

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:42:19 -07:00

21436 lines
766 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmLotInfo5
BorderStyle = 1 'Fixed Single
Caption = "Lot Information - Pre-Mix / Typar Lots"
ClientHeight = 8625
ClientLeft = 45
ClientTop = 225
ClientWidth = 11910
ControlBox = 0 'False
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8625
ScaleWidth = 11910
Begin VB.TextBox txtWireAdj
Alignment = 1 'Right Justify
Height = 315
Left = 7920
TabIndex = 13
Top = 780
Width = 600
End
Begin VB.TextBox txtStoneBill
Alignment = 1 'Right Justify
Height = 330
Left = 8640
TabIndex = 227
TabStop = 0 'False
Top = 420
Visible = 0 'False
Width = 540
End
Begin VB.CheckBox chkFirst
Caption = "First Time"
Height = 315
Left = 10680
TabIndex = 212
Top = 1500
Visible = 0 'False
Width = 315
End
Begin VB.TextBox txtESTID
Height = 375
Left = 3120
TabIndex = 210
Top = 1680
Visible = 0 'False
Width = 735
End
Begin VB.TextBox txtOPEN
Height = 285
Left = 10740
TabIndex = 209
Top = 1140
Visible = 0 'False
Width = 855
End
Begin VB.TextBox txtJC
Enabled = 0 'False
Height = 315
Left = 2700
MaxLength = 7
TabIndex = 8
Top = 2220
Width = 915
End
Begin VB.Timer tmrPause
Enabled = 0 'False
Interval = 500
Left = 8700
Top = 1020
End
Begin Crystal.CrystalReport crOrder
Left = 120
Top = 960
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.TextBox txtSand
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 5160
TabIndex = 33
TabStop = 0 'False
Top = 780
Width = 420
End
Begin VB.ListBox lstPlans
Height = 2205
Left = 9240
Sorted = -1 'True
TabIndex = 31
TabStop = 0 'False
Top = 1080
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton cmdFindPlan
Height = 435
Left = 2580
Picture = "frmLotInfo5.frx":0000
Style = 1 'Graphical
TabIndex = 7
Top = 1440
Width = 435
End
Begin VB.TextBox txtOneKote
Enabled = 0 'False
Height = 315
Left = 9240
TabIndex = 29
TabStop = 0 'False
Top = 420
Width = 2475
End
Begin VB.TextBox txtFinish
Enabled = 0 'False
Height = 315
Left = 9240
TabIndex = 27
TabStop = 0 'False
Top = 60
Width = 2475
End
Begin VB.TextBox txtNotes
Height = 1020
Left = 3900
MultiLine = -1 'True
TabIndex = 15
Top = 1515
Width = 4635
End
Begin VB.TextBox txtLaborAdj
Alignment = 1 'Right Justify
Height = 315
Left = 7920
MaxLength = 3
TabIndex = 12
Top = 420
Width = 600
End
Begin VB.TextBox txtFin2
Alignment = 1 'Right Justify
Height = 315
Left = 5760
MaxLength = 3
TabIndex = 10
Top = 420
Width = 600
End
Begin VB.TextBox txtStone
Alignment = 1 'Right Justify
Height = 315
Left = 7920
TabIndex = 14
TabStop = 0 'False
Top = 1155
Width = 615
End
Begin VB.TextBox txtFoamAdj
Alignment = 1 'Right Justify
Height = 315
Left = 7920
MaxLength = 3
TabIndex = 11
Top = 60
Width = 600
End
Begin VB.TextBox txtTtlYdge
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 1440
TabIndex = 25
TabStop = 0 'False
Top = 1860
Width = 795
End
Begin VB.TextBox txtCMUYdge
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 1440
TabIndex = 24
TabStop = 0 'False
Top = 2220
Width = 795
End
Begin VB.TextBox txt28Foam
Alignment = 1 'Right Justify
Height = 315
Left = 5760
MaxLength = 2
TabIndex = 9
Top = 60
Width = 600
End
Begin VB.TextBox txtProject
Enabled = 0 'False
Height = 315
Left = 1440
TabIndex = 23
TabStop = 0 'False
Top = 60
Width = 2895
End
Begin VB.TextBox txtLotNo
Enabled = 0 'False
Height = 315
Left = 1440
MaxLength = 5
TabIndex = 5
Top = 1125
Width = 1095
End
Begin VB.TextBox txtModel
Height = 315
Left = 1440
MaxLength = 8
TabIndex = 6
Top = 1500
Width = 1095
End
Begin VB.TextBox txtOwner
Height = 315
Left = 1440
MaxLength = 15
TabIndex = 4
Top = 780
Width = 2895
End
Begin VB.TextBox txtAddress
Height = 315
Left = 1440
MaxLength = 30
TabIndex = 3
Top = 420
Width = 2895
End
Begin TabDlg.SSTab SSTLotInfo
Height = 5655
Left = 150
TabIndex = 35
TabStop = 0 'False
Top = 2895
Width = 11595
_ExtentX = 20452
_ExtentY = 9975
_Version = 393216
Tabs = 7
TabsPerRow = 4
TabHeight = 520
TabCaption(0) = "&General Information"
TabPicture(0) = "frmLotInfo5.frx":0442
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "lblDiana"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "lblYardMemo"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "lblMetal"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "lblLathBill"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).Control(4)= "lblTextureO"
Tab(0).Control(4).Enabled= 0 'False
Tab(0).Control(5)= "lblBrownO"
Tab(0).Control(5).Enabled= 0 'False
Tab(0).Control(6)= "lblScratchO"
Tab(0).Control(6).Enabled= 0 'False
Tab(0).Control(7)= "lblSandO"
Tab(0).Control(7).Enabled= 0 'False
Tab(0).Control(8)= "lblLathO"
Tab(0).Control(8).Enabled= 0 'False
Tab(0).Control(9)= "lblOrderDates"
Tab(0).Control(9).Enabled= 0 'False
Tab(0).Control(10)= "txtLotNotes"
Tab(0).Control(10).Enabled= 0 'False
Tab(0).Control(11)= "cmdShowChange"
Tab(0).Control(11).Enabled= 0 'False
Tab(0).Control(12)= "txtYardMemo"
Tab(0).Control(12).Enabled= 0 'False
Tab(0).Control(13)= "cmdEdit"
Tab(0).Control(13).Enabled= 0 'False
Tab(0).Control(14)= "cmdSetupRpt"
Tab(0).Control(14).Enabled= 0 'False
Tab(0).Control(15)= "txtMetal"
Tab(0).Control(15).Enabled= 0 'False
Tab(0).Control(16)= "cmdDelLot"
Tab(0).Control(16).Enabled= 0 'False
Tab(0).Control(17)= "cmdAddLot"
Tab(0).Control(17).Enabled= 0 'False
Tab(0).Control(18)= "txtLathBill"
Tab(0).Control(18).Enabled= 0 'False
Tab(0).Control(19)= "txtTextureO"
Tab(0).Control(19).Enabled= 0 'False
Tab(0).Control(20)= "txtBrownO"
Tab(0).Control(20).Enabled= 0 'False
Tab(0).Control(21)= "txtScratchO"
Tab(0).Control(21).Enabled= 0 'False
Tab(0).Control(22)= "txtSandO"
Tab(0).Control(22).Enabled= 0 'False
Tab(0).Control(23)= "txtLathO"
Tab(0).Control(23).Enabled= 0 'False
Tab(0).Control(24)= "cmdSaveLotInfo"
Tab(0).Control(24).Enabled= 0 'False
Tab(0).Control(25)= "cmdOrders"
Tab(0).Control(25).Enabled= 0 'False
Tab(0).Control(26)= "cmdExit"
Tab(0).Control(26).Enabled= 0 'False
Tab(0).Control(27)= "cmdCalc"
Tab(0).Control(27).Enabled= 0 'False
Tab(0).Control(28)= "cmdJCSetup"
Tab(0).Control(28).Enabled= 0 'False
Tab(0).Control(29)= "chkSynthetic"
Tab(0).Control(29).Enabled= 0 'False
Tab(0).Control(30)= "cmdOrder"
Tab(0).Control(30).Enabled= 0 'False
Tab(0).Control(31)= "chkStone"
Tab(0).Control(31).Enabled= 0 'False
Tab(0).Control(32)= "cmdPrintR"
Tab(0).Control(32).Enabled= 0 'False
Tab(0).Control(33)= "chkOthers"
Tab(0).Control(33).Enabled= 0 'False
Tab(0).Control(34)= "chkNoPay"
Tab(0).Control(34).Enabled= 0 'False
Tab(0).Control(35)= "chkPaint"
Tab(0).Control(35).Enabled= 0 'False
Tab(0).ControlCount= 36
TabCaption(1) = "&Super's Orders"
TabPicture(1) = "frmLotInfo5.frx":045E
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "cmdPreOrderPrintPC"
Tab(1).Control(1)= "cmdIssue"
Tab(1).Control(2)= "cmdLFlag"
Tab(1).Control(3)= "txtTake138"
Tab(1).Control(3).Enabled= 0 'False
Tab(1).Control(4)= "txtSuperBB"
Tab(1).Control(5)= "txtSuper12"
Tab(1).Control(6)= "txtSuper783"
Tab(1).Control(7)= "txtSuper78"
Tab(1).Control(8)= "txtSuper38"
Tab(1).Control(9)= "txtSuper1383"
Tab(1).Control(10)= "txtSuperRL"
Tab(1).Control(11)= "txtSuperML"
Tab(1).Control(12)= "txtSuperDW"
Tab(1).Control(13)= "txtSuperSP"
Tab(1).Control(14)= "txtCalc138"
Tab(1).Control(14).Enabled= 0 'False
Tab(1).Control(15)= "cmdPreOrderPrintY"
Tab(1).Control(15).Enabled= 0 'False
Tab(1).Control(16)= "cmdPreOrderPrintS"
Tab(1).Control(16).Enabled= 0 'False
Tab(1).Control(17)= "txtSuperNotes"
Tab(1).Control(18)= "cmdLathPay"
Tab(1).Control(19)= "cmdStuccoPay"
Tab(1).Control(20)= "cmdRePrintL"
Tab(1).Control(21)= "lstPreOrder"
Tab(1).Control(21).Enabled= 0 'False
Tab(1).Control(22)= "lblZMetal"
Tab(1).Control(23)= "lblBB"
Tab(1).Control(24)= "lblTake138"
Tab(1).Control(25)= "lblSuperBB"
Tab(1).Control(26)= "linSO"
Tab(1).Control(27)= "lblSuper12"
Tab(1).Control(28)= "lblSuper783"
Tab(1).Control(29)= "lblSuper78"
Tab(1).Control(30)= "lblSuper38"
Tab(1).Control(31)= "lblSuper138"
Tab(1).Control(32)= "lblSuperML"
Tab(1).Control(33)= "lblSuperRL"
Tab(1).Control(34)= "lblSuperDW"
Tab(1).Control(35)= "lblSuperSP"
Tab(1).Control(36)= "lblSupHelp"
Tab(1).Control(37)= "lblPreOrder"
Tab(1).Control(38)= "lblSuperNotes"
Tab(1).ControlCount= 39
TabCaption(2) = "&Materials"
TabPicture(2) = "frmLotInfo5.frx":047A
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "cmdAddMatrl"
Tab(2).Control(0).Enabled= 0 'False
Tab(2).Control(1)= "cmdSaveMatrl"
Tab(2).Control(2)= "cmdDelMatrl"
Tab(2).Control(2).Enabled= 0 'False
Tab(2).Control(3)= "txtLMDesc"
Tab(2).Control(4)= "txtLMInvNo"
Tab(2).Control(5)= "txtLMQty"
Tab(2).Control(6)= "txtLMLength"
Tab(2).Control(7)= "cboLMDFlag"
Tab(2).Control(8)= "cboLMType"
Tab(2).Control(9)= "cboLMMetal"
Tab(2).Control(10)= "txtLMBalance"
Tab(2).Control(10).Enabled= 0 'False
Tab(2).Control(11)= "cmdInventory"
Tab(2).Control(11).Enabled= 0 'False
Tab(2).Control(12)= "cmdFindInv"
Tab(2).Control(13)= "chkChange"
Tab(2).Control(14)= "lstInventory"
Tab(2).Control(14).Enabled= 0 'False
Tab(2).Control(15)= "lstLMaterial"
Tab(2).Control(16)= "lblLMDesc"
Tab(2).Control(17)= "lblLMInvNo"
Tab(2).Control(18)= "lblQty"
Tab(2).Control(19)= "lblLMDFlag"
Tab(2).Control(20)= "lblLMType"
Tab(2).Control(21)= "lblLMetal"
Tab(2).Control(22)= "lblLMLength"
Tab(2).Control(23)= "lblOrderBalance"
Tab(2).Control(24)= "lblMatInst"
Tab(2).ControlCount= 25
TabCaption(3) = "Op&tions"
TabPicture(3) = "frmLotInfo5.frx":0496
Tab(3).ControlEnabled= 0 'False
Tab(3).Control(0)= "txtOSt_SqFt"
Tab(3).Control(1)= "chkOStone"
Tab(3).Control(2)= "lstPOptions"
Tab(3).Control(3)= "cmdOptAdd"
Tab(3).Control(3).Enabled= 0 'False
Tab(3).Control(4)= "cmdOptDel"
Tab(3).Control(4).Enabled= 0 'False
Tab(3).Control(5)= "lstLOptions"
Tab(3).Control(6)= "txtLODesc"
Tab(3).Control(6).Enabled= 0 'False
Tab(3).Control(7)= "txtLOYdge"
Tab(3).Control(7).Enabled= 0 'False
Tab(3).Control(8)= "txtLOFin2"
Tab(3).Control(8).Enabled= 0 'False
Tab(3).Control(9)= "txtLOFoam"
Tab(3).Control(9).Enabled= 0 'False
Tab(3).Control(10)= "txtLOTexture"
Tab(3).Control(10).Enabled= 0 'False
Tab(3).Control(11)= "txtLOMDesc"
Tab(3).Control(11).Enabled= 0 'False
Tab(3).Control(12)= "txtLOMInvNo"
Tab(3).Control(12).Enabled= 0 'False
Tab(3).Control(13)= "txtLOMQty"
Tab(3).Control(13).Enabled= 0 'False
Tab(3).Control(14)= "txtLOMLength"
Tab(3).Control(14).Enabled= 0 'False
Tab(3).Control(15)= "cboLOMDFlag"
Tab(3).Control(15).Enabled= 0 'False
Tab(3).Control(16)= "cboLOMType"
Tab(3).Control(16).Enabled= 0 'False
Tab(3).Control(17)= "cboLOMetal"
Tab(3).Control(17).Enabled= 0 'False
Tab(3).Control(18)= "txtNote2"
Tab(3).Control(19)= "txtNote"
Tab(3).Control(20)= "lstOptMatrl"
Tab(3).Control(21)= "lblOptNum"
Tab(3).Control(22)= "lblOStone"
Tab(3).Control(23)= "lblPOptions"
Tab(3).Control(24)= "lblLOptions"
Tab(3).Control(25)= "lblLODesc"
Tab(3).Control(26)= "lblLOYdge"
Tab(3).Control(27)= "lblLOFin2"
Tab(3).Control(28)= "lblLOFAdj"
Tab(3).Control(29)= "lblLOTexture"
Tab(3).Control(30)= "lblLOMDesc"
Tab(3).Control(31)= "lblLOMInvNo"
Tab(3).Control(32)= "lblLOMQty"
Tab(3).Control(33)= "lblLOMDFlag"
Tab(3).Control(34)= "lblLOMType"
Tab(3).Control(35)= "lblLOMetal"
Tab(3).Control(36)= "lblLOMLength"
Tab(3).Control(37)= "lblSelectOpt"
Tab(3).Control(38)= "lblBillingAmt"
Tab(3).Control(39)= "lblBAmt"
Tab(3).ControlCount= 40
TabCaption(4) = "&Lath Orders"
TabPicture(4) = "frmLotInfo5.frx":04B2
Tab(4).ControlEnabled= 0 'False
Tab(4).Control(0)= "lstYard"
Tab(4).Control(0).Enabled= 0 'False
Tab(4).Control(1)= "lstLath"
Tab(4).Control(1).Enabled= 0 'False
Tab(4).Control(2)= "lblYardOrd"
Tab(4).Control(3)= "lblLathOrd"
Tab(4).ControlCount= 4
TabCaption(5) = "Stucco &Orders"
TabPicture(5) = "frmLotInfo5.frx":04CE
Tab(5).ControlEnabled= 0 'False
Tab(5).Control(0)= "lstScratch"
Tab(5).Control(0).Enabled= 0 'False
Tab(5).Control(1)= "lstBrown"
Tab(5).Control(1).Enabled= 0 'False
Tab(5).Control(2)= "lstTexture"
Tab(5).Control(2).Enabled= 0 'False
Tab(5).Control(3)= "lblScrOrd"
Tab(5).Control(4)= "lblBrnOrd"
Tab(5).Control(5)= "lblTexOrd"
Tab(5).ControlCount= 6
TabCaption(6) = "&Purchase Orders"
TabPicture(6) = "frmLotInfo5.frx":04EA
Tab(6).ControlEnabled= 0 'False
Tab(6).Control(0)= "lstLOOKUP"
Tab(6).Control(0).Enabled= 0 'False
Tab(6).Control(1)= "txtPayType"
Tab(6).Control(2)= "txtPOType"
Tab(6).Control(2).Enabled= 0 'False
Tab(6).Control(3)= "cboPOType"
Tab(6).Control(4)= "lstPO"
Tab(6).Control(5)= "txtPONotes"
Tab(6).Control(6)= "txtPONum"
Tab(6).Control(6).Enabled= 0 'False
Tab(6).Control(7)= "txtIssueTo"
Tab(6).Control(8)= "cmdAddPO"
Tab(6).Control(8).Enabled= 0 'False
Tab(6).Control(9)= "cmdSavePO"
Tab(6).Control(10)= "cmdDelPO"
Tab(6).Control(10).Enabled= 0 'False
Tab(6).Control(11)= "txtPOInvNo"
Tab(6).Control(12)= "txtPOQty"
Tab(6).Control(13)= "cboPODFlag"
Tab(6).Control(14)= "cboPOMType"
Tab(6).Control(15)= "cmdFindPOMat"
Tab(6).Control(16)= "cmdAddPOMat"
Tab(6).Control(16).Enabled= 0 'False
Tab(6).Control(17)= "cmdSavePOMat"
Tab(6).Control(18)= "cmdDelPOMat"
Tab(6).Control(18).Enabled= 0 'False
Tab(6).Control(19)= "cmdPrintPO"
Tab(6).Control(19).Enabled= 0 'False
Tab(6).Control(20)= "txtPOMatDesc"
Tab(6).Control(21)= "txtPODesc"
Tab(6).Control(22)= "txtPODate"
Tab(6).Control(23)= "txtPOPrice"
Tab(6).Control(24)= "cmdPrintForm"
Tab(6).Control(24).Enabled= 0 'False
Tab(6).Control(25)= "fraPO"
Tab(6).Control(26)= "txtPay"
Tab(6).Control(27)= "cmdPrintPOPay"
Tab(6).Control(28)= "lstPOMaterial"
Tab(6).Control(29)= "lblPayType"
Tab(6).Control(30)= "lblPOType"
Tab(6).Control(31)= "lblIssueTo"
Tab(6).Control(32)= "lblPOMaterials"
Tab(6).Control(33)= "lblPONotes"
Tab(6).Control(34)= "lblPO"
Tab(6).Control(35)= "lblDesc"
Tab(6).Control(36)= "lblPONum"
Tab(6).Control(37)= "lblInvNo"
Tab(6).Control(38)= "lblDescription"
Tab(6).Control(39)= "lblPOQty"
Tab(6).Control(40)= "lblPODFlag"
Tab(6).Control(41)= "lblPOMType"
Tab(6).Control(42)= "lblPODate"
Tab(6).Control(43)= "lblOptMatPrice"
Tab(6).Control(44)= "lblPayYds"
Tab(6).ControlCount= 45
Begin LpLib.fpList lstLOOKUP
Height = 2820
Left = -67275
TabIndex = 241
Top = 2760
Visible = 0 'False
Width = 3555
_Version = 196608
_ExtentX = 6271
_ExtentY = 4974
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 2
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 240
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":0506
End
Begin VB.CheckBox chkPaint
Alignment = 1 'Right Justify
Caption = "Paint"
Height = 285
Left = 1005
TabIndex = 239
Top = 2940
Width = 675
End
Begin VB.CommandButton cmdPreOrderPrintPC
Caption = "Print PreCast PreOrders"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -66540
TabIndex = 237
Top = 1380
Width = 1335
End
Begin VB.CommandButton cmdIssue
Caption = "RePrint &Yard Ticket"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -69420
TabIndex = 234
Top = 1380
Visible = 0 'False
Width = 1335
End
Begin VB.CheckBox chkNoPay
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Caption = "No Pay Sheets Issued"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2220
TabIndex = 233
Top = 3420
Width = 2295
End
Begin VB.CheckBox chkOthers
Alignment = 1 'Right Justify
Caption = "Stone by Others"
Height = 255
Left = 2940
TabIndex = 232
Top = 3180
Width = 1575
End
Begin VB.CommandButton cmdPrintR
Caption = "Process Orders"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3000
TabIndex = 231
Top = 1500
Width = 1215
End
Begin VB.TextBox txtOSt_SqFt
Alignment = 1 'Right Justify
Height = 300
Left = -64755
TabIndex = 230
Top = 675
Width = 975
End
Begin VB.CheckBox chkOStone
Alignment = 1 'Right Justify
Caption = "Stone Veneer Option:"
Height = 240
Left = -68475
TabIndex = 228
Top = 735
Width = 1890
End
Begin VB.CheckBox chkStone
Alignment = 1 'Right Justify
Caption = "Stone Veneer"
Height = 255
Left = 3180
TabIndex = 225
Top = 2940
Width = 1335
End
Begin VB.TextBox txtPayType
Height = 315
Left = -70920
MaxLength = 1
TabIndex = 58
Top = 2280
Width = 375
End
Begin VB.CommandButton cmdOrder
Caption = "Orders List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4245
TabIndex = 220
Top = 2160
Width = 1215
End
Begin VB.TextBox txtPOType
Height = 285
Left = -70980
TabIndex = 219
TabStop = 0 'False
Top = 840
Visible = 0 'False
Width = 615
End
Begin VB.ComboBox cboPOType
Height = 315
ItemData = "frmLotInfo5.frx":0837
Left = -72300
List = "frmLotInfo5.frx":0847
Style = 2 'Dropdown List
TabIndex = 55
Top = 1200
Width = 1995
End
Begin VB.CheckBox chkSynthetic
Alignment = 1 'Right Justify
Caption = "Synthetic"
Height = 195
Left = 2100
TabIndex = 215
Top = 2940
Width = 975
End
Begin VB.CommandButton cmdLFlag
Caption = "Set Lath Flags"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -69435
TabIndex = 214
Top = 705
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton cmdJCSetup
Caption = "Setup JC Record"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4245
TabIndex = 211
Top = 1500
Width = 1215
End
Begin VB.TextBox txtTake138
Alignment = 1 'Right Justify
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = -73080
TabIndex = 137
TabStop = 0 'False
Top = 1680
Width = 795
End
Begin VB.TextBox txtSuperBB
Alignment = 1 'Right Justify
Height = 315
Left = -73080
MaxLength = 4
TabIndex = 127
Top = 2325
Width = 795
End
Begin VB.TextBox txtSuper12
Alignment = 1 'Right Justify
Height = 315
Left = -73080
MaxLength = 4
TabIndex = 128
Top = 2940
Width = 795
End
Begin VB.TextBox txtSuper783
Alignment = 1 'Right Justify
Height = 315
Left = -73080
MaxLength = 4
TabIndex = 129
Top = 3540
Width = 795
End
Begin VB.TextBox txtSuper78
Alignment = 1 'Right Justify
Height = 315
Left = -73080
MaxLength = 4
TabIndex = 130
Top = 4140
Width = 795
End
Begin VB.TextBox txtSuper38
Alignment = 1 'Right Justify
Height = 315
Left = -73080
MaxLength = 4
TabIndex = 131
Top = 4740
Width = 795
End
Begin VB.TextBox txtSuper1383
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -70620
MaxLength = 4
TabIndex = 132
Top = 2340
Width = 795
End
Begin VB.TextBox txtSuperRL
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -70620
MaxLength = 4
TabIndex = 133
Top = 2940
Width = 795
End
Begin VB.TextBox txtSuperML
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -70620
MaxLength = 4
TabIndex = 134
Top = 3540
Width = 795
End
Begin VB.TextBox txtSuperDW
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -70620
MaxLength = 4
TabIndex = 135
Top = 4140
Width = 795
End
Begin VB.TextBox txtSuperSP
Alignment = 1 'Right Justify
Height = 315
Left = -70620
MaxLength = 4
TabIndex = 136
Top = 4740
Width = 795
End
Begin VB.ListBox lstPOptions
Height = 2010
ItemData = "frmLotInfo5.frx":0882
Left = -74760
List = "frmLotInfo5.frx":0889
TabIndex = 126
Top = 1020
Width = 3095
End
Begin VB.ListBox lstYard
Height = 4155
Left = -74820
TabIndex = 125
TabStop = 0 'False
Top = 1140
Width = 5445
End
Begin VB.ListBox lstLath
Height = 4155
Left = -69180
TabIndex = 124
TabStop = 0 'False
Top = 1140
Width = 5445
End
Begin VB.ListBox lstScratch
Height = 4350
Left = -74880
TabIndex = 123
TabStop = 0 'False
Top = 1140
Width = 3660
End
Begin VB.ListBox lstBrown
Height = 4350
Left = -71100
TabIndex = 122
TabStop = 0 'False
Top = 1140
Width = 3660
End
Begin VB.ListBox lstTexture
Height = 4350
Left = -67320
TabIndex = 121
TabStop = 0 'False
Top = 1140
Width = 3660
End
Begin VB.ListBox lstPO
Height = 4350
Left = -74760
Sorted = -1 'True
TabIndex = 120
Top = 1080
Width = 885
End
Begin VB.TextBox txtPONotes
Height = 1215
Left = -73800
MaxLength = 250
MultiLine = -1 'True
TabIndex = 60
Top = 2700
Width = 3915
End
Begin VB.TextBox txtPONum
BackColor = &H00E0E0E0&
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = -72300
TabIndex = 119
TabStop = 0 'False
Top = 840
Width = 975
End
Begin VB.TextBox txtIssueTo
Height = 315
Left = -72300
MaxLength = 50
TabIndex = 56
Top = 1560
Width = 3735
End
Begin VB.CommandButton cmdAddPO
Caption = "&New PO"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -68400
TabIndex = 118
TabStop = 0 'False
Top = 960
Width = 1035
End
Begin VB.CommandButton cmdSavePO
Caption = "S&ave PO"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -67260
TabIndex = 62
Top = 960
Width = 1035
End
Begin VB.CommandButton cmdDelPO
Caption = "D&elete PO"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -66120
TabIndex = 117
TabStop = 0 'False
Top = 960
Width = 1035
End
Begin VB.CommandButton cmdOptAdd
Caption = "Add Option"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -66240
TabIndex = 116
TabStop = 0 'False
Top = 1380
Width = 1275
End
Begin VB.CommandButton cmdOptDel
Caption = "Delete Option"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -64920
TabIndex = 115
TabStop = 0 'False
Top = 1380
Width = 1275
End
Begin VB.CommandButton cmdAddMatrl
Caption = "Add Materials"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -69120
TabIndex = 114
TabStop = 0 'False
Top = 5040
Width = 1335
End
Begin VB.CommandButton cmdSaveMatrl
Caption = "Save Materials"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -67080
TabIndex = 112
Top = 5040
Width = 1335
End
Begin VB.CommandButton cmdDelMatrl
Caption = "Delete Materials"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -65040
TabIndex = 113
TabStop = 0 'False
Top = 5040
Width = 1335
End
Begin VB.TextBox txtLMDesc
Height = 315
Left = -68100
MaxLength = 50
TabIndex = 103
Top = 780
Width = 4275
End
Begin VB.TextBox txtLMInvNo
Height = 315
Left = -68100
MaxLength = 18
TabIndex = 104
Top = 1200
Width = 2625
End
Begin VB.TextBox txtLMQty
Alignment = 1 'Right Justify
ForeColor = &H00000000&
Height = 315
Left = -68100
MaxLength = 4
TabIndex = 105
Top = 1560
Width = 915
End
Begin VB.TextBox txtLMLength
Alignment = 1 'Right Justify
Height = 315
Left = -68100
MaxLength = 2
TabIndex = 109
Top = 3192
Width = 915
End
Begin VB.ComboBox cboLMDFlag
Height = 315
ItemData = "frmLotInfo5.frx":089A
Left = -68100
List = "frmLotInfo5.frx":08A4
Style = 2 'Dropdown List
TabIndex = 106
Top = 1980
Width = 1215
End
Begin VB.ComboBox cboLMType
Height = 315
ItemData = "frmLotInfo5.frx":08B8
Left = -68085
List = "frmLotInfo5.frx":08BA
Style = 2 'Dropdown List
TabIndex = 107
Top = 2388
Width = 1215
End
Begin VB.ComboBox cboLMMetal
Height = 315
ItemData = "frmLotInfo5.frx":08BC
Left = -68100
List = "frmLotInfo5.frx":08C6
Style = 2 'Dropdown List
TabIndex = 108
Top = 2790
Width = 1215
End
Begin VB.TextBox txtLMBalance
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 110
TabStop = 0 'False
Top = 3600
Width = 915
End
Begin VB.ListBox lstLOptions
Height = 2010
Left = -71640
TabIndex = 102
Top = 1020
Width = 3095
End
Begin VB.TextBox txtLODesc
Enabled = 0 'False
Height = 315
Left = -67200
TabIndex = 97
TabStop = 0 'False
Top = 1020
Width = 2835
End
Begin VB.TextBox txtLOYdge
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -67200
TabIndex = 101
TabStop = 0 'False
Top = 1440
Width = 915
End
Begin VB.TextBox txtLOFin2
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -67200
TabIndex = 100
TabStop = 0 'False
Top = 1860
Width = 915
End
Begin VB.TextBox txtLOFoam
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -67200
TabIndex = 99
TabStop = 0 'False
Top = 2280
Width = 915
End
Begin VB.TextBox txtLOTexture
Enabled = 0 'False
Height = 315
Left = -67200
TabIndex = 98
TabStop = 0 'False
Top = 2700
Width = 1755
End
Begin VB.TextBox txtLOMDesc
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 96
TabStop = 0 'False
Top = 3135
Width = 4155
End
Begin VB.TextBox txtLOMInvNo
Enabled = 0 'False
Height = 315
Left = -68100
MaxLength = 18
TabIndex = 95
TabStop = 0 'False
Top = 3480
Width = 2625
End
Begin VB.TextBox txtLOMQty
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 94
TabStop = 0 'False
Top = 3810
Width = 915
End
Begin VB.TextBox txtLOMLength
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 93
TabStop = 0 'False
Top = 5160
Width = 915
End
Begin VB.ComboBox cboLOMDFlag
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 92
TabStop = 0 'False
Text = "cboLOMDFlag"
Top = 4155
Width = 1155
End
Begin VB.ComboBox cboLOMType
Enabled = 0 'False
Height = 315
ItemData = "frmLotInfo5.frx":08D7
Left = -68100
List = "frmLotInfo5.frx":08D9
TabIndex = 91
TabStop = 0 'False
Text = "cboLOMType"
Top = 4500
Width = 1155
End
Begin VB.ComboBox cboLOMetal
Enabled = 0 'False
Height = 315
Left = -68100
TabIndex = 90
TabStop = 0 'False
Text = "cboLOMetal"
Top = 4830
Width = 1155
End
Begin VB.CommandButton cmdCalc
Caption = "Calculate Materials"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 480
TabIndex = 89
TabStop = 0 'False
Top = 840
Width = 1215
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 480
TabIndex = 88
TabStop = 0 'False
Top = 2160
Width = 1215
End
Begin VB.CommandButton cmdOrders
Caption = "Setup Orders"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 480
TabIndex = 87
TabStop = 0 'False
Top = 1500
Width = 1215
End
Begin VB.CommandButton cmdSaveLotInfo
Caption = "Save Lot Information"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1740
TabIndex = 86
TabStop = 0 'False
Top = 1500
Width = 1215
End
Begin VB.CommandButton cmdInventory
Caption = "Inventory List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -69120
TabIndex = 85
TabStop = 0 'False
Top = 4440
Visible = 0 'False
Width = 1335
End
Begin VB.TextBox txtLathO
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 84
TabStop = 0 'False
Top = 1080
Width = 1335
End
Begin VB.TextBox txtSandO
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 83
TabStop = 0 'False
Top = 1422
Width = 1335
End
Begin VB.TextBox txtScratchO
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 82
TabStop = 0 'False
Top = 1764
Width = 1335
End
Begin VB.TextBox txtBrownO
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 81
TabStop = 0 'False
Top = 2106
Width = 1335
End
Begin VB.TextBox txtTextureO
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 80
TabStop = 0 'False
Top = 2448
Width = 1335
End
Begin VB.CommandButton cmdFindInv
Height = 435
Left = -65445
Picture = "frmLotInfo5.frx":08DB
Style = 1 'Graphical
TabIndex = 79
Top = 1140
Visible = 0 'False
Width = 435
End
Begin VB.TextBox txtLathBill
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
MaxLength = 10
TabIndex = 78
TabStop = 0 'False
Top = 2790
Width = 1335
End
Begin VB.CommandButton cmdAddLot
Caption = "Add New Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1740
TabIndex = 77
TabStop = 0 'False
Top = 840
Width = 1215
End
Begin VB.CommandButton cmdDelLot
Caption = "Delete Lot Information"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1740
TabIndex = 76
TabStop = 0 'False
Top = 2160
Width = 1215
End
Begin VB.TextBox txtCalc138
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 0 'None
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = -69720
TabIndex = 75
TabStop = 0 'False
Top = 2400
Width = 435
End
Begin VB.CheckBox chkChange
Alignment = 1 'Right Justify
Caption = "Recalc Flag:"
Height = 255
Left = -69180
TabIndex = 111
Top = 4020
Width = 1455
End
Begin VB.TextBox txtMetal
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 315
Left = 9900
TabIndex = 74
Top = 3480
Width = 1335
End
Begin VB.TextBox txtPOInvNo
Height = 315
Left = -68760
MaxLength = 18
TabIndex = 66
Top = 2640
Width = 2625
End
Begin VB.TextBox txtPOQty
Alignment = 1 'Right Justify
Height = 315
Left = -68760
MaxLength = 4
TabIndex = 69
Top = 3360
Width = 915
End
Begin VB.ComboBox cboPODFlag
Height = 315
ItemData = "frmLotInfo5.frx":0D1D
Left = -68760
List = "frmLotInfo5.frx":0D27
Style = 2 'Dropdown List
TabIndex = 70
Top = 3720
Width = 1215
End
Begin VB.ComboBox cboPOMType
Height = 315
ItemData = "frmLotInfo5.frx":0D3B
Left = -68760
List = "frmLotInfo5.frx":0D3D
Style = 2 'Dropdown List
TabIndex = 71
Top = 4080
Width = 1215
End
Begin VB.CommandButton cmdFindPOMat
Height = 435
Left = -66105
Picture = "frmLotInfo5.frx":0D3F
Style = 1 'Graphical
TabIndex = 67
Top = 2550
Visible = 0 'False
Width = 435
End
Begin VB.CommandButton cmdAddPOMat
Caption = "&Add Material"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -68400
TabIndex = 65
TabStop = 0 'False
Top = 1560
Width = 1035
End
Begin VB.CommandButton cmdSavePOMat
Caption = "S&ave Material"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -67260
TabIndex = 73
Top = 1560
Width = 1035
End
Begin VB.CommandButton cmdDelPOMat
Caption = "D&elete Material"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -66120
TabIndex = 64
TabStop = 0 'False
Top = 1560
Width = 1035
End
Begin VB.CommandButton cmdPrintPO
Caption = "P&rint PO"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -64980
TabIndex = 63
TabStop = 0 'False
Top = 960
Width = 1095
End
Begin VB.TextBox txtPOMatDesc
Height = 315
Left = -68760
MaxLength = 50
TabIndex = 68
Top = 3000
Width = 4275
End
Begin VB.TextBox txtPODesc
Height = 315
Left = -72300
MaxLength = 50
TabIndex = 57
Top = 1920
Width = 3735
End
Begin VB.TextBox txtPODate
Alignment = 1 'Right Justify
Height = 315
Left = -69600
MaxLength = 10
TabIndex = 61
Top = 1200
Width = 1035
End
Begin VB.TextBox txtPOPrice
Alignment = 1 'Right Justify
Height = 315
Left = -68760
TabIndex = 72
Top = 4440
Width = 975
End
Begin VB.CommandButton cmdPrintForm
Caption = "Print Form"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -64980
TabIndex = 54
TabStop = 0 'False
Top = 1560
Width = 1095
End
Begin VB.CommandButton cmdSetupRpt
Caption = "Setup Processing"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3000
TabIndex = 53
TabStop = 0 'False
Top = 840
Width = 1215
End
Begin VB.CommandButton cmdPreOrderPrintY
Caption = "Print Yard PreOrders"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -65100
TabIndex = 52
TabStop = 0 'False
Top = 720
Width = 1335
End
Begin VB.CommandButton cmdPreOrderPrintS
Caption = "Print Supplier PreOrders"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -65100
TabIndex = 51
TabStop = 0 'False
Top = 1380
Width = 1335
End
Begin VB.Frame fraPO
Height = 435
Left = -68520
TabIndex = 46
Top = 2040
Width = 4875
Begin VB.OptionButton optStone
Caption = "Stone"
Height = 255
Left = 3240
TabIndex = 236
Top = 120
Width = 795
End
Begin VB.OptionButton optPreOrder
Caption = "PreOrder"
Height = 255
Left = 2280
TabIndex = 223
Top = 120
Width = 975
End
Begin VB.OptionButton optLath
Caption = "Lath"
Height = 255
Left = 60
TabIndex = 50
Top = 120
Width = 675
End
Begin VB.OptionButton optStucco
Caption = "Stucco"
Height = 255
Left = 720
TabIndex = 49
Top = 120
Width = 855
End
Begin VB.OptionButton optSand
Caption = "Sand"
Height = 255
Left = 1560
TabIndex = 48
Top = 120
Width = 735
End
Begin VB.OptionButton optNone
Caption = "None"
Height = 255
Left = 4080
TabIndex = 47
Top = 120
Value = -1 'True
Width = 735
End
End
Begin VB.TextBox txtSuperNotes
Height = 1275
Left = -69240
MaxLength = 255
MultiLine = -1 'True
TabIndex = 147
Top = 4200
Width = 5445
End
Begin VB.CommandButton cmdEdit
Caption = "Edit Lot Information"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3000
TabIndex = 45
TabStop = 0 'False
Top = 2160
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox txtYardMemo
Height = 1755
Left = 525
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 44
Top = 3825
Width = 5355
End
Begin VB.TextBox txtPay
Alignment = 1 'Right Justify
Height = 315
Left = -69240
TabIndex = 59
Top = 2280
Width = 675
End
Begin VB.CommandButton cmdPrintPOPay
Caption = "Print Pay Sheet"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -68760
TabIndex = 43
Top = 4920
Width = 1035
End
Begin VB.CommandButton cmdLathPay
Caption = "RePrint Lath Pay"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -66525
TabIndex = 42
Top = 720
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton cmdStuccoPay
Caption = "RePrint Stucco Pay"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -67980
TabIndex = 41
Top = 1380
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton cmdRePrintL
Caption = "ReSet Lath Print"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = -67980
TabIndex = 40
Top = 720
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton cmdShowChange
Caption = "Show Change Log"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4245
TabIndex = 39
TabStop = 0 'False
Top = 840
Width = 1215
End
Begin VB.TextBox txtNote2
Enabled = 0 'False
Height = 795
Left = -74760
MultiLine = -1 'True
TabIndex = 38
Top = 3060
Width = 5475
End
Begin VB.TextBox txtNote
Enabled = 0 'False
Height = 795
Left = -74775
MultiLine = -1 'True
TabIndex = 37
Top = 3855
Width = 5475
End
Begin VB.TextBox txtLotNotes
Height = 1785
Left = 5880
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 36
Top = 3825
Width = 5355
End
Begin LpLib.fpList lstPOMaterial
Height = 1260
Left = -73800
TabIndex = 240
Top = 4230
Width = 3915
_Version = 196608
_ExtentX = 6906
_ExtentY = 2222
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 5
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= 90
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":1181
End
Begin LpLib.fpList lstOptMatrl
Height = 840
Left = -74760
TabIndex = 243
Top = 4725
Width = 5475
_Version = 196608
_ExtentX = 9657
_ExtentY = 1482
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 6
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":1542
End
Begin LpLib.fpList lstInventory
Height = 2070
Left = -66825
TabIndex = 244
Top = 2790
Visible = 0 'False
Width = 3165
_Version = 196608
_ExtentX = 5583
_ExtentY = 3651
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 2
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 225
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":1989
End
Begin LpLib.fpList lstLMaterial
Height = 4590
Left = -74880
TabIndex = 242
Top = 825
Width = 5595
_Version = 196608
_ExtentX = 9869
_ExtentY = 8096
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 6
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 240
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":1CB9
End
Begin LpLib.fpList lstPreOrder
Height = 1425
Left = -69255
TabIndex = 245
Top = 2190
Width = 5445
_Version = 196608
_ExtentX = 9604
_ExtentY = 2514
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 5
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmLotInfo5.frx":20F2
End
Begin VB.Label lblOptNum
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -70560
TabIndex = 238
Top = 720
Width = 1890
End
Begin VB.Label lblZMetal
Alignment = 2 'Center
Caption = "This House Uses Z-Metal"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = -74940
TabIndex = 235
Top = 5160
Visible = 0 'False
Width = 5655
End
Begin VB.Label lblOStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone Veneer Opt. SqFt:"
Height = 195
Left = -66540
TabIndex = 229
Top = 750
Width = 1740
End
Begin VB.Label lblPayType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Type:"
Height = 195
Left = -71805
TabIndex = 224
Top = 2340
Width = 720
End
Begin VB.Label lblPOType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO Type:"
Height = 195
Left = -73005
TabIndex = 218
Top = 1260
Width = 675
End
Begin VB.Label lblBB
Alignment = 2 'Center
Caption = "This House Uses R-Guard"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 675
Left = -72180
TabIndex = 217
Top = 1380
Width = 2475
End
Begin VB.Label lblTake138
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Takeoff 1 3/8 J-Metal:"
Height = 195
Left = -74895
TabIndex = 207
Top = 1740
Width = 1590
End
Begin VB.Label lblSuperBB
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Blackboard/R-Guard:"
Height = 195
Left = -74835
TabIndex = 206
Top = 2400
Width = 1530
End
Begin VB.Line linSO
BorderWidth = 2
X1 = -75000
X2 = -69660
Y1 = 2160
Y2 = 2160
End
Begin VB.Label lblSuper12
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "1/2 Foam:"
Height = 195
Left = -74040
TabIndex = 205
Top = 3000
Width = 735
End
Begin VB.Label lblSuper783
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "7/8X3 JMB:"
Height = 195
Left = -74160
TabIndex = 204
Top = 3600
Width = 855
End
Begin VB.Label lblSuper78
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "7/8 JMB:"
Height = 195
Left = -73965
TabIndex = 203
Top = 4200
Width = 660
End
Begin VB.Label lblSuper38
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "3/8 JMB:"
Height = 195
Left = -73965
TabIndex = 202
Top = 4800
Width = 660
End
Begin VB.Label lblSuper138
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "1 3/8 X 3 JMB:"
Height = 195
Left = -71880
TabIndex = 201
Top = 2400
Width = 1080
End
Begin VB.Label lblSuperML
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Lath:"
Enabled = 0 'False
Height = 195
Left = -71580
TabIndex = 200
Top = 3600
Width = 795
End
Begin VB.Label lblSuperRL
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Rib Lath:"
Enabled = 0 'False
Height = 195
Left = -71460
TabIndex = 199
Top = 3000
Width = 645
End
Begin VB.Label lblSuperDW
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Drywall:"
Enabled = 0 'False
Height = 195
Left = -71340
TabIndex = 198
Top = 4200
Width = 555
End
Begin VB.Label lblSuperSP
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sheer Panel:"
Height = 195
Left = -71700
TabIndex = 197
Top = 4800
Width = 915
End
Begin VB.Label lblIssueTo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Description:"
Height = 195
Left = -73740
TabIndex = 196
Top = 1620
Width = 1410
End
Begin VB.Label lblPOMaterials
AutoSize = -1 'True
Caption = "P.O. Materials:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -73800
TabIndex = 195
Top = 4020
Width = 1275
End
Begin VB.Label lblPONotes
Caption = "P.O. Notes:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -73800
TabIndex = 194
Top = 2460
Width = 1575
End
Begin VB.Label lblPO
Caption = "Purchase Orders"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -74760
TabIndex = 193
Top = 720
Width = 1815
End
Begin VB.Label lblScrOrd
AutoSize = -1 'True
Caption = "Scratch Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -74820
TabIndex = 192
Top = 840
Width = 1200
End
Begin VB.Label lblBrnOrd
AutoSize = -1 'True
Caption = "Brown Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -71040
TabIndex = 191
Top = 840
Width = 1065
End
Begin VB.Label lblTexOrd
AutoSize = -1 'True
Caption = "Texture Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -67260
TabIndex = 190
Top = 840
Width = 1185
End
Begin VB.Label lblYardOrd
AutoSize = -1 'True
Caption = "Yard Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -74700
TabIndex = 189
Top = 900
Width = 930
End
Begin VB.Label lblLathOrd
AutoSize = -1 'True
Caption = "Supplier Lath Order"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -69120
TabIndex = 188
Top = 900
Width = 1665
End
Begin VB.Label lblSupHelp
Caption = $"frmLotInfo5.frx":24AD
Height = 855
Left = -74760
TabIndex = 187
Top = 735
Width = 5115
End
Begin VB.Label lblPreOrder
Alignment = 2 'Center
Caption = "Pre Orders"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -68700
TabIndex = 186
Top = 1905
Width = 2715
End
Begin VB.Label lblLMDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = -68985
TabIndex = 185
Top = 840
Width = 840
End
Begin VB.Label lblLMInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory No:"
Height = 195
Left = -69105
TabIndex = 184
Top = 1242
Width = 960
End
Begin VB.Label lblQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quantity:"
Height = 195
Left = -68775
TabIndex = 183
Top = 1644
Width = 630
End
Begin VB.Label lblLMDFlag
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Delivery Flag:"
Height = 195
Left = -69105
TabIndex = 182
Top = 2046
Width = 960
End
Begin VB.Label lblLMType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Type:"
Height = 195
Left = -69150
TabIndex = 181
Top = 2448
Width = 1005
End
Begin VB.Label lblLMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Flag:"
Height = 195
Left = -68925
TabIndex = 180
Top = 2850
Width = 780
End
Begin VB.Label lblLMLength
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Length:"
Height = 195
Left = -69120
TabIndex = 179
Top = 3252
Width = 975
End
Begin VB.Label lblOrderBalance
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Shipped So Far:"
Height = 195
Left = -69285
TabIndex = 178
Top = 3660
Width = 1140
End
Begin VB.Label lblPOptions
AutoSize = -1 'True
Caption = "Plan Options"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -74700
TabIndex = 177
Top = 720
Width = 1095
End
Begin VB.Label lblLOptions
AutoSize = -1 'True
Caption = "Lot Options"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -71580
TabIndex = 176
Top = 720
Width = 990
End
Begin VB.Label lblLODesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = -68100
TabIndex = 175
Top = 1080
Width = 840
End
Begin VB.Label lblLOYdge
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Option Yardage:"
Height = 195
Left = -68415
TabIndex = 174
Top = 1500
Width = 1155
End
Begin VB.Label lblLOFin2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Finish 2 Ydge:"
Height = 195
Left = -68265
TabIndex = 173
Top = 1920
Width = 1005
End
Begin VB.Label lblLOFAdj
AutoSize = -1 'True
Caption = "Option Foam Adj:"
Height = 195
Left = -68475
TabIndex = 172
Top = 2340
Width = 1215
End
Begin VB.Label lblLOTexture
Caption = "Option Texture:"
Height = 255
Left = -68415
TabIndex = 171
Top = 2760
Width = 1155
End
Begin VB.Label lblLOMDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = -68985
TabIndex = 170
Top = 3135
Width = 840
End
Begin VB.Label lblLOMInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory No:"
Height = 195
Left = -69105
TabIndex = 169
Top = 3480
Width = 960
End
Begin VB.Label lblLOMQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quanitity:"
Height = 195
Left = -68805
TabIndex = 168
Top = 3840
Width = 660
End
Begin VB.Label lblLOMDFlag
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Delivery Flag:"
Height = 195
Left = -69105
TabIndex = 167
Top = 4185
Width = 960
End
Begin VB.Label lblLOMType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Type:"
Height = 195
Left = -69150
TabIndex = 166
Top = 4530
Width = 1005
End
Begin VB.Label lblLOMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Flag:"
Height = 195
Left = -68940
TabIndex = 165
Top = 4890
Width = 780
End
Begin VB.Label lblLOMLength
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Length:"
Height = 195
Left = -69120
TabIndex = 164
Top = 5220
Width = 975
End
Begin VB.Label lblMatInst
Caption = $"frmLotInfo5.frx":2597
Height = 1155
Left = -66630
TabIndex = 163
Top = 1560
Visible = 0 'False
Width = 2835
End
Begin VB.Label lblOrderDates
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Dates"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 9900
TabIndex = 162
Top = 780
Width = 1275
End
Begin VB.Label lblLathO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath:"
Height = 195
Left = 9465
TabIndex = 161
Top = 1140
Width = 360
End
Begin VB.Label lblSandO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sand:"
Height = 195
Left = 9405
TabIndex = 160
Top = 1482
Width = 420
End
Begin VB.Label lblScratchO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scratch:"
Height = 195
Left = 9225
TabIndex = 159
Top = 1824
Width = 600
End
Begin VB.Label lblBrownO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Brown:"
Height = 195
Left = 9330
TabIndex = 158
Top = 2166
Width = 495
End
Begin VB.Label lblTextureO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Texture:"
Height = 195
Left = 9240
TabIndex = 157
Top = 2508
Width = 585
End
Begin VB.Label lblLathBill
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone:"
Height = 195
Left = 9360
TabIndex = 156
Top = 2850
Width = 465
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Feet:"
Height = 195
Left = 9000
TabIndex = 155
Top = 3540
Width = 795
End
Begin VB.Label lblSelectOpt
Caption = "Double Click the desired option to selected it for Add or Delete."
Height = 375
Left = -66060
TabIndex = 154
Top = 2100
Width = 2235
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Description:"
Height = 195
Left = -73485
TabIndex = 153
Top = 1980
Width = 1155
End
Begin VB.Label lblPONum
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO #:"
Height = 195
Left = -72750
TabIndex = 152
Top = 900
Width = 420
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inv No:"
Height = 195
Left = -69360
TabIndex = 151
Top = 2700
Width = 525
End
Begin VB.Label lblDescription
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = -69675
TabIndex = 150
Top = 3060
Width = 840
End
Begin VB.Label lblPOQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quantity:"
Height = 195
Left = -69465
TabIndex = 149
Top = 3420
Width = 630
End
Begin VB.Label lblPODFlag
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Delivery Type:"
Height = 195
Left = -69795
TabIndex = 148
Top = 3780
Width = 1020
End
Begin VB.Label lblPOMType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Type:"
Height = 195
Left = -69780
TabIndex = 146
Top = 4140
Width = 1005
End
Begin VB.Label lblPODate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO Date:"
Height = 195
Left = -70260
TabIndex = 145
Top = 1260
Width = 660
End
Begin VB.Label lblBillingAmt
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = -64980
TabIndex = 144
Top = 2700
Width = 915
End
Begin VB.Label lblBAmt
Alignment = 1 'Right Justify
Caption = "$:"
Height = 255
Left = -65280
TabIndex = 143
Top = 2760
Width = 195
End
Begin VB.Label lblSuperNotes
AutoSize = -1 'True
Caption = "Notes to Super:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -69240
TabIndex = 142
Top = 3960
Width = 1350
End
Begin VB.Label lblYardMemo
AutoSize = -1 'True
Caption = "Yard Order Notes"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 540
TabIndex = 141
Top = 3600
Width = 1830
End
Begin VB.Label lblOptMatPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Mat. Price:"
Height = 195
Left = -69540
TabIndex = 140
Top = 4500
Width = 765
End
Begin VB.Label lblPayYds
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Yards:"
Height = 195
Left = -70140
TabIndex = 139
Top = 2340
Width = 765
End
Begin VB.Label lblDiana
AutoSize = -1 'True
Caption = "Lot Notes:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6000
TabIndex = 138
Top = 3600
Width = 1065
End
End
Begin VB.Label lblStone
Alignment = 2 'Center
Caption = "Stone Veneer"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 360
Left = 8640
TabIndex = 226
Top = 1440
Visible = 0 'False
Width = 3195
End
Begin VB.Label lblSandShip
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5580
TabIndex = 222
Top = 780
Width = 420
End
Begin VB.Label lblSZone
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6060
TabIndex = 221
Top = 780
Width = 315
End
Begin VB.Label lblSynthetic
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "Synthetic Texture"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 360
Left = 8970
TabIndex = 216
Top = 1440
Visible = 0 'False
Width = 2475
End
Begin VB.Label lblFirst
Alignment = 2 'Center
Caption = "First Time This Plan"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 8640
TabIndex = 213
Top = 1800
Visible = 0 'False
Width = 3195
End
Begin VB.Label lblSand
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sand:"
Height = 195
Left = 4620
TabIndex = 208
Top = 840
Width = 480
End
Begin VB.Label lblJC
Alignment = 1 'Right Justify
Caption = "Job Cost:"
Height = 375
Left = 2280
TabIndex = 34
Top = 2160
Width = 375
End
Begin VB.Label lblPlan
AutoSize = -1 'True
Caption = "Double Click the Desired Plan"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 8700
TabIndex = 32
Top = 840
Visible = 0 'False
Width = 2565
End
Begin VB.Label lblLathPrint
AutoSize = -1 'True
Caption = "Lath Order Printed"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 9000
TabIndex = 30
Top = 2220
Visible = 0 'False
Width = 2580
End
Begin VB.Label lblTexture
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Finish:"
Height = 195
Left = 8760
TabIndex = 28
Top = 120
Width = 450
End
Begin VB.Label lblNote
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = " Plan Notes:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3900
TabIndex = 26
Top = 1245
Width = 1275
End
Begin VB.Label lblCMUYdge
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMU Yardage:"
Height = 195
Left = 285
TabIndex = 22
Top = 2280
Width = 1050
End
Begin VB.Label lblLaborAdj
Alignment = 1 'Right Justify
Caption = $"frmLotInfo5.frx":2688
Height = 1350
Left = 6450
TabIndex = 21
Top = 90
Width = 1425
End
Begin VB.Label lblTtlYdge
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Total Yardage:"
Height = 195
Left = 285
TabIndex = 20
Top = 1920
Width = 1050
End
Begin VB.Label lblFin2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Finish 2 Ydge:"
Height = 195
Left = 4710
TabIndex = 19
Top = 460
Width = 1005
End
Begin VB.Label lbl28foam
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "2X8 Foam %tge:"
Height = 195
Left = 4560
TabIndex = 18
Top = 120
Width = 1155
End
Begin VB.Line linLotInfo
BorderWidth = 2
X1 = 0
X2 = 11940
Y1 = 2640
Y2 = 2640
End
Begin VB.Label lblModel
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Model/Elevation:"
Height = 195
Left = 120
TabIndex = 17
Top = 1560
Width = 1215
End
Begin VB.Label lblOwner
Alignment = 1 'Right Justify
Caption = "Owner:"
Height = 195
Left = 660
TabIndex = 16
Top = 840
Width = 675
End
Begin VB.Label lblAddress
Alignment = 1 'Right Justify
Caption = "Address:"
Height = 195
Left = 540
TabIndex = 2
Top = 480
Width = 795
End
Begin VB.Label lblLot
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lot:"
Height = 195
Left = 1065
TabIndex = 1
Top = 1200
Width = 270
End
Begin VB.Label lblProject
Alignment = 1 'Right Justify
Caption = "SubDivision:"
Height = 195
Left = 360
TabIndex = 0
Top = 120
Width = 975
End
End
Attribute VB_Name = "frmLotInfo5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRS As Recordset
Dim moRSMat As Recordset, moRSCMat As Recordset
Dim moRSPOpt As Recordset
Dim moRSPOpt2 As Recordset
Dim moRSLOpt As Recordset
Dim moRSOptMat As Recordset
Dim moRSProj As Recordset
Dim moRSPlan As Recordset
Dim moRSPO As Recordset
Dim moRSPOMAT As Recordset
Dim moRSMemo As Recordset
Dim moRSPay As Recordset
Dim moRSInvINFO As Recordset
Dim mboolNOTSUPPLIER As Boolean, mstrMTYPE As String, mstrORDERNUM As String, mintOPENPR2 As Integer
Dim mboolLATHC As Boolean, mboolSTUCCOC As Boolean, mboolWRAPC As Boolean, mboolPULTE As Boolean, mboolSTPAY As Boolean
Dim mstrFoamAdj As String, mstrLaborAdj As String, mstrStone As String, mstrBEGQTY As String, mstrENDQTY As String
Dim mboolBAD As Boolean, mboolSPLIT As Boolean, mstrWIRE As String, mboolFRMLOAD As Boolean, mboolST_ADJ As Boolean
Dim mstrPLANUP As String, mboolPLANUP As Boolean, mboolVERIFIED As Boolean, mboolWRAP As Boolean
Dim mboolSHOW As Boolean, mlngORDERID As Long, mintINVNO As String, mlngARINVID As Long, mintPAYCREW As Integer
Dim intCOUNT As Integer, mstrPROJLOT As String, mboolBADD As Boolean, mboolPSpecialCALC As Boolean
Dim mboolAdding As Boolean, mstrINV As String, strTYPE As String, mlngINVID As Long, mboolDNU As Boolean
Dim mstrType As String, mdblQTY As Double, mstrFILE As String, mboolPSW As Boolean ', mintOpenPR As Integer
Dim mlngFind As Long, mintBOOKMARK As Integer, boolPrtLATH As Boolean ', mlngARINVID As Long
Dim mintTake138 As Integer, mintPONUM As Long, mintOpenPR As Integer, mbool2Dates As Boolean, mboolSTONE3 As Boolean 'For Printing Invoices
Dim mintOPTID As Long, mintSUPPLIER As Integer, mstrSTARTDATE As String, mboolSTONE2 As Boolean
Dim mstrSUPPLIER As String, mboolCRITICAL As Boolean, mboolCERTIFIED As Boolean, mstrTAXCODE As String
Dim mbytREPRINT As Byte, mboolStone As Boolean, mboolNoPrint As Boolean, mboolPAINT As Boolean, mboolRPSTUCCO As Byte
Dim mboolSupP, mboolWrapP, mboolLathP, mboolNescoP, mboolPopOutP As Boolean, mboolADD As Boolean
Dim mboolBrownP, mboolTexP, mboolCMUP, mboolEX1P, mboolEX2P, mboolEX3P As Boolean, mboolHLNotes As Boolean
Dim mboolStoneP As Boolean, mboolCOMM As Boolean, mboolPLNCHANGE As Boolean, mstrPLNELEV As String
Dim msglPAYRT1, msglPAYRT2 As Single, mstrTexture As String, mstrCREWTYPE As String, mstrWORK As String
'Dim mboolADD As Boolean, mboolCOMM As Boolean, mboolPLNCHANGE As Boolean, mstrPLNELEV As String
Private Sub ListChanges()
Dim oRS As Recordset, strSQL As String, strMSG As String
strSQL = "SELECT * FROM tblCHANGE WHERE ChgDate > #" & gdteUPDATE & "#"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
If Not oRS.EOF Then
strMSG = strMSG & Field2Str(oRS!Chgdate) & " " & Field2Str(oRS!CHgInfo)
strMSG = strMSG & vbCrLf & vbCrLf
If Not oRS.EOF Then
oRS.MoveNext
End If
End If
Loop
MsgBox strMSG, vbOKOnly, "Click OK To Continue"
End Sub
Private Sub SetStone()
Dim strSQL As String
moRS!l_FLG = "P"
moRS!y_FLG = "P"
moRS!s_FLG = "P"
moRS!z_FLG = "P"
moRS!a_flg = vbTrue
moRS!b_flg = vbTrue
moRS!c_flg = vbTrue
moRS!t_flg = vbTrue
moRS!stone = vbTrue
moRS.Update
End Sub
Private Sub GetPayRates()
Dim oRSCR As Recordset, strSQL As String
msglPAYRT1 = 0
msglPAYRT2 = 0
strSQL = "SELECT * FROM tblCREWRATE WHERE not inactive and CREW_ID = " & mintPAYCREW & " AND PROJ_ID = " & gintPROJID
Set oRSCR = New Recordset
oRSCR.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If oRSCR.EOF Then
strSQL = "SELECT * FROM tblCREWRATE WHERE not inactive and CREW_ID = " & mintPAYCREW & " AND PROJ_ID = 99999" ' & gintPROJID
Set oRSCR = New Recordset
oRSCR.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
End If
' Else
If Not oRSCR.EOF Then
If mstrCREWTYPE = "L" Then ' Or mstrCREWTYPE = "W" Then
If mboolPULTE Then
' msglPAYRT1 = Field2Str2(oRSCR!Sand) ' Wrap Rate
msglPAYRT1 = Field2Str2(oRSCR!Smooth) ' Wrap/Lath Rate Commented this out on 05/19/2019 -- may need to be changed back
msglPAYRT2 = Field2Str2(oRSCR!METAL)
' msglPAYRT1 = Field2Str2(oRSCR!lath_skip) ' Change it back of it is not correct
Else
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
msglPAYRT2 = Field2Str2(oRSCR!METAL)
End If
End If
If (mstrCREWTYPE = "L" Or mstrCREWTYPE = "W") And mboolWRAPC Then ' Or mstrCREWTYPE = "W" Then
' If mstrCREWTYPE = "L" And mboolWRAPC Then ' Or mstrCREWTYPE = "W" Then
If mboolPULTE Then
msglPAYRT1 = Field2Str2(oRSCR!sand) ' Wrap Rate
' msglPAYRT1 = Field2Str2(oRSCR!Smooth) ' Wrap/Lath Rate
Else
msglPAYRT1 = 0
msglPAYRT2 = 0
' msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
' msglPAYRT2 = Field2Str2(oRSCR!METAL)
End If
End If
If mstrCREWTYPE = "S" And (mstrTexture = "SK" Or mstrTexture = "RL" Or mstrTexture = "CS" Or mstrTexture = "RS") Then
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "SA" Or mstrTexture = "S2" Or mstrTexture = "S3" Or mstrTexture = "RD" Or mstrTexture = "S4") Then
msglPAYRT1 = Field2Str2(oRSCR!Bsand)
' msglPAYRT1 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "DA" Then
msglPAYRT1 = Field2Str2(oRSCR!dash)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "MN" Or mstrTexture = "RM") Then
msglPAYRT1 = Field2Str2(oRSCR!mn)
End If
If mstrCREWTYPE = "S" And mstrTexture = "QU" Then
msglPAYRT1 = Field2Str2(oRSCR!qu)
End If
If mstrCREWTYPE = "S" And mstrTexture = "QS" Then
msglPAYRT1 = Field2Str2(oRSCR!qu)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "SM" Then
msglPAYRT1 = Field2Str2(oRSCR!Smooth)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "DF" Or mstrTexture = "SS" Or mstrTexture = "RF") Then
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "SC" Then
msglPAYRT1 = Field2Str2(oRSCR!sand)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "M2" Or mstrTexture = "M3" Or mstrTexture = "MF") Then
msglPAYRT1 = Field2Str2(oRSCR!mn)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
' If mstrCREWTYPE = "V" Then
' msglPAYRT1 = Field2Str2(oRSCR!Lath_Skip)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
' If mstrCREWTYPE = "S" And mstrTEXTURE = "DA" Then
' msglPAYRT1 = Field2Str2(oRSCR!Dash)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
' If mstrCREWTYPE = "S" And mstrTEXTURE = "DA" Then
' msglPAYRT1 = Field2Str2(oRSCR!Dash)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
End If
' Else
' End If
End Sub
Private Sub GetPayRatesT()
Dim oRSCR As Recordset, strSQL As String
msglPAYRT1 = 0
msglPAYRT2 = 0
strSQL = "SELECT * FROM tblCREWRATE WHERE not inactive and CREW_ID = " & mintPAYCREW & " AND PROJ_ID = " & gintPROJID
Set oRSCR = New Recordset
oRSCR.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If oRSCR.EOF Then
strSQL = "SELECT * FROM tblCREWRATE WHERE not inactive and CREW_ID = " & mintPAYCREW & " AND PROJ_ID = 99999" ' & gintPROJID
Set oRSCR = New Recordset
oRSCR.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
End If
' Else
If Not oRSCR.EOF Then
If mstrCREWTYPE = "L" Then ' Or mstrCREWTYPE = "W" Then
If mboolPULTE Then
' msglPAYRT1 = Field2Str2(oRSCR!Sand) ' Wrap Rate
msglPAYRT1 = Field2Str2(oRSCR!Smooth) ' Wrap/Lath Rate Commented this out on 05/19/2019 -- may need to be changed back
msglPAYRT2 = Field2Str2(oRSCR!METAL)
' msglPAYRT1 = Field2Str2(oRSCR!lath_skip) ' Change it back of it is not correct
Else
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
msglPAYRT2 = Field2Str2(oRSCR!METAL)
End If
End If
If (mstrCREWTYPE = "L" Or mstrCREWTYPE = "W") And mboolWRAPC Then ' Or mstrCREWTYPE = "W" Then
' If mstrCREWTYPE = "L" And mboolWRAPC Then ' Or mstrCREWTYPE = "W" Then
If mboolPULTE Then
msglPAYRT1 = Field2Str2(oRSCR!sand) ' Wrap Rate
' msglPAYRT1 = Field2Str2(oRSCR!Smooth) ' Wrap/Lath Rate
Else
msglPAYRT1 = 0
msglPAYRT2 = 0
' msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
' msglPAYRT2 = Field2Str2(oRSCR!METAL)
End If
End If
If mstrCREWTYPE = "S" And (mstrTexture = "SK" Or mstrTexture = "RL" Or mstrTexture = "CS" Or mstrTexture = "RS") Then
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "SA" Or mstrTexture = "S2" Or mstrTexture = "S3" Or mstrTexture = "RD" Or mstrTexture = "S4") Then
msglPAYRT1 = Field2Str2(oRSCR!Tsand)
' msglPAYRT1 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "DA" Then
msglPAYRT1 = Field2Str2(oRSCR!dash)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "MN" Or mstrTexture = "RM") Then
msglPAYRT1 = Field2Str2(oRSCR!mn)
End If
If mstrCREWTYPE = "S" And mstrTexture = "QU" Then
msglPAYRT1 = Field2Str2(oRSCR!qu)
End If
If mstrCREWTYPE = "S" And mstrTexture = "QS" Then
msglPAYRT1 = Field2Str2(oRSCR!qu)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "SM" Then
msglPAYRT1 = Field2Str2(oRSCR!Smooth)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "DF" Or mstrTexture = "SS" Or mstrTexture = "RF") Then
msglPAYRT1 = Field2Str2(oRSCR!lath_skip)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And mstrTexture = "SC" Then
msglPAYRT1 = Field2Str2(oRSCR!sand)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
If mstrCREWTYPE = "S" And (mstrTexture = "M2" Or mstrTexture = "M3" Or mstrTexture = "MF") Then
msglPAYRT1 = Field2Str2(oRSCR!mn)
msglPAYRT2 = Field2Str2(oRSCR!sand)
End If
' If mstrCREWTYPE = "V" Then
' msglPAYRT1 = Field2Str2(oRSCR!Lath_Skip)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
' If mstrCREWTYPE = "S" And mstrTEXTURE = "DA" Then
' msglPAYRT1 = Field2Str2(oRSCR!Dash)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
' If mstrCREWTYPE = "S" And mstrTEXTURE = "DA" Then
' msglPAYRT1 = Field2Str2(oRSCR!Dash)
' msglPAYRT2 = Field2Str2(oRSCR!metal)
' End If
End If
' Else
' End If
End Sub
Private Sub RePrintLath() 'Allows a lath order to be reprinted
Dim strSQL As String 'This resets all flags to allow the correct reprint of informatin
Dim oRS As Recordset 'but will keep a copy of the original orders printed
Call LotChange(mstrPROJLOT, "Allow RePrint Lath")
moRS!l_FLG = Null
moRS!y_FLG = Null
moRS!s_FLG = Null
moRS!z_FLG = Null
moRS!lorder = "12/31/2030"
moRS!worder = Null
moRS!Border = Null
moRS!TORDER = Null
moRS!forder = Null
moRS!corder = Null
moRS!SORDER = Null
moRS!VOrder = Null
moRS!WrapP = vbFalse
moRS!WrapD = vbFalse
moRS!LathP = vbFalse
moRS!LathD = vbFalse
'May need to add more items to be reset so that other things can be printed.
moRS.Update
moRSMemo!notes = Field2Str(moRSMemo!notes) & " - LATH PRINTING RESET ON " & Now() & " BY " & gstrLOGIN
moRSMemo.Update
strSQL = "SELECT * FROM tblOrders WHERE m_type = 'L' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!m_type = "H"
oRS!d_flag = "X"
oRS!ar_trans = vbChecked
oRS!ap_trans = vbChecked
oRS.Update
oRS.MoveNext
Loop
strSQL = "SELECT * FROM tblLOTMATRL WHERE m_type = 'L' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!o_qty = 0
' oRS!d_flag = "X"
' oRS!ar_trans = vbChecked
' oRS!ap_trans = vbChecked
oRS.Update
oRS.MoveNext
Loop
strSQL = "DELETE * FROM tblPaySheet where LotID = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblYardOrder where Lot_ID = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblARInvoice where Inv_Type = 'L' and lot_id = " & gintLOTID
goConn.Execute strSQL
Call LotRePrinted
End Sub
Private Sub cboPOType_LostFocus()
If cboPOType.ListIndex = -1 Then
cboPOType.ListIndex = 0
End If
txtPOType = Left(cboPOType.Text, 1)
gstrPO = txtPOType
Select Case txtPOType
Case "L"
lblIssueTo = "Invoice Description:"
txtIssueTo.Visible = True
lblIssueTo.Visible = True
lblDesc = "Pay Description:"
txtPODesc.Visible = True
lblDesc.Visible = True
lblPayYds = "Pay Yards:"
txtPay.Visible = True
lblPayYds.Visible = True
txtPayType.Visible = True
optLath.Enabled = True
optStucco.Enabled = True
optSand.Enabled = True
optPreOrder.Enabled = True
optNone.Enabled = True
optStone.Enabled = True
Case "Y"
lblIssueTo.Visible = False
txtIssueTo.Visible = False
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
optLath.Enabled = True
optStucco.Enabled = True
optSand.Enabled = True
optPreOrder.Enabled = True
optNone.Enabled = True
optStone.Enabled = True
Case "V"
lblIssueTo = "Mileage:"
txtIssueTo.Visible = True
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
optLath.Enabled = False
optStucco.Enabled = False
optSand.Enabled = False
optPreOrder.Enabled = False
optNone.Enabled = True
optStone.Enabled = True
Case "M"
lblIssueTo = "Person Requesting:"
txtIssueTo.Visible = True
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
optLath.Enabled = False
optStucco.Enabled = False
optSand.Enabled = False
optPreOrder.Enabled = False
optNone.Enabled = True
optStone.Enabled = True
End Select
End Sub
''Private Sub chkHoldOrders_Click()
'' cmdSaveLotInfo.Enabled = True
'' If gbytSECURITY > 3 Then
'' chkHoldOrders.Enabled = False
'' chkHoldOrders.BackColor = &H80FFFF
'' End If
''End Sub
''Private Sub chkHoldPO_Click()
'' cmdSaveLotInfo.Enabled = True
'' If gbytSECURITY > 3 Then
'' chkHoldPO.Enabled = False
'' chkHoldPO.BackColor = &H80FFFF
'' End If
''End Sub
Private Sub chkOthers_Click()
cmdSaveLotInfo.Enabled = True
End Sub
Private Sub chkSplit_Click()
cmdSaveLotInfo.Enabled = True
' lblSynthetic.Visible = True
If gbytSECURITY > 3 Then
' chkSplit.Enabled = False
' chkSplit.BackColor = &H80FFFF
End If
End Sub
Private Sub chkStone_Click()
If chkStone Then
cmdSaveLotInfo.Enabled = True
If chkOthers Then
lblStone.Caption = "Stone By Others"
chkOthers.BackColor = &HFF
Else
lblStone.Caption = "Stone Veneer"
End If
lblStone.Visible = True
Else
cmdSaveLotInfo.Enabled = True
lblStone.Visible = False
txtStone = 0
End If
If gbytSECURITY > 3 Then
chkStone.Enabled = False
chkStone.BackColor = &H80FFFF
End If
End Sub
Private Sub chkSynthetic_Click()
If chkSynthetic Then
cmdSaveLotInfo.Enabled = True
lblSynthetic.Visible = True
Else
cmdSaveLotInfo.Enabled = True
lblSynthetic.Visible = False
End If
If gbytSECURITY > 3 Then
chkSynthetic.Enabled = False
chkSynthetic.BackColor = &H80FFFF
End If
End Sub
Private Sub cmdAddPOMat_Click()
Call POMatClear
gconACTION = 0
cmdSavePO.Enabled = False
cmdDelPO.Enabled = False
cmdAddPO.Enabled = False
cmdAddPOMat.Enabled = False
cmdDelPOMat.Enabled = False
cmdSavePOMat.Enabled = True
cmdPrintPO.Enabled = False
txtPODate.Enabled = False
txtPODesc.Enabled = False
txtIssueTo.Enabled = False
txtPay.Enabled = False
txtPayType.Enabled = False
txtPONotes.Enabled = False
txtPOInvNo.Enabled = True
txtPOMatDesc.Enabled = True
txtPOQty.Enabled = True
txtPOPrice.Enabled = True
cboPODFlag.Enabled = True
cboPOMType.Enabled = True
cmdFindPOMat.Enabled = True
mboolAdding = True
txtPOInvNo.SetFocus
End Sub
Private Sub cmdBrownPrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, oRSS As Recordset, intYNS As Integer, intSTUCCOCREW As Integer
Dim strSELECT As String, strSql2 As String, strSQLUP As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strMSG As String, intResponse As Integer
Dim strORDERDATE As String, intCOPY As Integer, strPAY As String, intTCPAY As Integer
Dim oRSC As Recordset, strCrewType As String, strSQLCREW As String
On Error GoTo Error_EH
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
strCrewType = ""
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
strMSG = "This Plan Has Been Updated - It Is Recommended That You ReImport & ReCalculate"
strMSG = strMSG & Chr(10) & Chr(13)
strMSG = strMSG & "Do You Want To ReImport & ReCalculate?"
intResponse = MsgBox(strMSG, vbYesNo, "Recalculate Recommended")
' MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
If intResponse = vbYes Then
Call cmdFindPlan_Click
Call cmdCalc_Click
cmdExit.Enabled = True
End If
' Exit Sub
End If
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Orders Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
'' If chkHoldOrders Then
'' MsgBox "All Stucco Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Orders On Hold"
'' cmdExit.Enabled = True
'' Exit Sub
'' End If
gintCOPY = 1
' If moRS!Split Then
If mboolSPLIT Then
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'B' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Brown Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
intYNS = MsgBox("Do You Want To Use A Crew Number With The Stucco PaySheet? Y or N)", vbYesNo, "Use Crew")
If intYNS = vbYes Then
intSTUCCOCREW = InputBox("Enter The Stucco Crew Number", "Stucco Crew", 0)
strSQLCREW = "SELECT * FROM tblcrew WHERE NOT INACTIVE AND Crew_ID = " & intSTUCCOCREW
Set oRSC = New Recordset
oRSC.Open strSQLCREW, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
strCrewType = oRSC!Type
End If
If intSTUCCOCREW = 0 Or IsNull(intSTUCCOCREW) Or strCrewType <> "S" Then
If strCrewType = "" Then
MsgBox "Crew Is InActive - Must Enter An Active Stucco Crew Number - Will Exit Now", vbOKOnly, "InActive Crew"
Exit Sub
End If
MsgBox "Must Enter A Valid Stucco Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
Exit Sub
Else
mintPAYCREW = Field2Str2(intSTUCCOCREW)
moRS!BCREW = Field2Str2(intSTUCCOCREW)
moRS.Update
mboolSTUCCOC = True
End If
Else
moRS!BCREW = 0
moRS.Update
End If
gboolPRINT = True
gstrPO = "L"
gstrFLAG = "B"
gstrTYPE = "S"
Call ShowPrint '***************** REsume here
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE Order_Id = " & glngORDERID ' & " and m_type = 'B'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
strORDERDATE = Field2Str(oRS!order_date)
' glngORDERID = Field2Integer(oRS!order_id)
gstrPONUM = Field2Str(oRS!po_num)
' If moRS!Split Then
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'B'" ' or m_type = 'P')"
' strSQL = "{tblLotMatrl.lot_id} = " & gintLOTID & " and {tblLotMatrl.d_flag} = 'S' and ({tblLotMatrl.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
Call Form_Load
cmdExit.Enabled = True
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strMSG = oRS!Desc
If Field2Double(oRS!qty) > Field2Double(oRS!o_qty) Then
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
' strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & Chr(10) & Chr(13)
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
' Else
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!x_flag = vbChecked
oRSS!o_qty = dblOrder
oRSS!a_qty = dblOrder
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS.Update
End If
oRS.MoveNext
Loop
End If
' End If
moRS!forder = strORDERDATE
' moRS!forder = Field2Str(oRS!order_date)
If boolCOMPLETE Then
moRS!b_flg = vbTrue
' moRS!BrownD = vbTrue
End If
moRS.Update 'Mark Complete?
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
crOrder.Reset
strSQL = "{tblORDERS.PO_NUM}= '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\NewBrown.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\NewBrownM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
'***************Start of Print Stucco Pay Sheets copied from Lath Order
gintCOPY = 1
intCOPY = 0
crOrder.Reset
gstrMODULE = "Before Print Stucco Pay "
If moRSProj!stype <> "T" Then
If Field2Str2(txtTtlYdge) - 24 > 1200 Then
intCOPY = Int(((txtTtlYdge - 24) / 1200) + 0.99)
gintCOPY = intCOPY * 2
MsgBox "Insert " & gintCOPY & " Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 4
Call PrintStuccoPay
crOrder.Reset
gintCOPY = 1
Else
If moRS!texture = "SB" Or moRS!texture = "S2" Then '*** This is to print Brown paysheets
MsgBox "Insert 2 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gintCOPY = 2
Call PrintStuccoPay3
crOrder.Reset
gintCOPY = 1
End If
If (moRS!texture <> "SB" And moRS!texture <> "S2") Then
MsgBox "Insert 2 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gintCOPY = 2
Call PrintStuccoPay
crOrder.Reset
gintCOPY = 1
' ElseIf moRS!texture = "SF" Then
' MsgBox "**STONE** Insert 4 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' MsgBox "Make Sure GOLD and RED Paper Is In The Printer and then Press Enter", vbOKOnly, "Insert Gold & Red Paper"
' gintCOPY = 2
' Call PrintStuccoStone
' crOrder.Reset
' gintCOPY = 1
' Else
' MsgBox "**SYNTHETIC** Insert 4 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' MsgBox "Make Sure GOLD and RED Paper Is In The Printer and then Press Enter", vbOKOnly, "Insert Gold & Red Paper"
' gintCOPY = 2
' Call PrintStuccoSyn
crOrder.Reset
gintCOPY = 1
End If
End If
Else ' *************** Logic below this is strictly 3 coat
If Field2Str2(txtTtlYdge) - 24 > 1200 Then
intCOPY = Int(((txtTtlYdge - 24) / 1200) + 0.99)
gintCOPY = intCOPY * 2
intTCPAY = gintCOPY * 3
MsgBox "Insert " & intTCPAY & " Sheets of Paper for the Three Coat Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 4
Call PrintStuccoThree
crOrder.Reset
gintCOPY = 1
Else
MsgBox "Insert 6 Sheets of Paper for the Three Coat Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gintCOPY = 2
Call PrintStuccoThree
crOrder.Reset
gintCOPY = 1
End If
End If
'********** End of information copied to print stucco pay sheets - copied from Print Lath Orders
If boolCOMPLETE Then
If Not mboolSPLIT Then
If Not moRSProj!bill Then
Call PrintStuccoInv
Else
Call PrintCompleteInv
End If
boolFPRINT = False
End If
End If
If boolFPRINT Then
' moRS!t_flg = vbTrue
' moRS.Update
If Not moRSProj!bill Then
Call PrintStuccoInv
Else
Call PrintCompleteInv
End If
End If
' End If
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% BROWN ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'B')"
goConn.Execute strSQLUP
moRS!PRNT_S = Now()
moRS.Update
' If mboolPAINT Then
' MsgBox "Insert 1 White and 13 Color Sheets of Paper for the Paint Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 1
' intCOPY = 0
' crOrder.Reset
' gstrMODULE = "Before Print Paint Pay "
' Call PrintPaintPay
' End If
' txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "PAINT PAY SHEETS PRINTED - " & Now() & " BY " & gstrLOGIN & " "
' moRSMemo!notes = UCase(Field2Str(txtYardMemo))
' moRSMemo.Update
gboolPRINT = False
If Not moRSProj!bill Then
moRS!BrownD = vbTrue
' moRS!TexP = vbTrue
' moRS!TexD = vbTrue
Else
moRS!BrownD = vbTrue
' moRS!TexP = vbTrue
' moRS!TexD = vbTrue
End If
moRS.Update
' cmdBrownPrint.Enabled = False
Call Form_Load
End If
cmdExit.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdBrownPrint"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub PrintStuccoPay2()
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer
On Error GoTo Error_EH
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\stuccopayB2_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
ElseIf moRSProj!cocode = 1 Then
MsgBox "This is not setup for Metro Stucco - Exiting", vbOKOnly, "Invalid Company"
Exit Sub
' crOrder.ReportFileName = App.Path & "\stuccopayM_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayM.rpt"
End If
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
'' If gintCOPY > 3 Then
'' crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
'' intTOTAL = Int((gintCOPY / 2) + 0.99)
'' intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
'' i = 1
'' Do Until i = ((gintCOPY / 2) + 1)
'' crOrder.Formulas(1) = "PaySheetCount = " & i
'' crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
'' crOrder.CopiesToPrinter = 2
' crOrder.CopiesToPrinter = gintCOPY / 2
'' crOrder.Action = 1
'' moRSPay.AddNew
'' moRSPay!lotid = gintLOTID
'' moRSPay!Type = "S"
'' moRSPay!worktype = "P"
'' moRSPay!pay_ydge = intYDS
'' moRSPay!sheet = i
'' moRSPay!Create = gstrLOGIN
'' moRSPay!printed = vbChecked
'' moRSPay!totalsheet = intTOTAL
'' If moRSProj!cocode = 0 Then
'' moRSPay!cocode = 0
'' ElseIf moRSProj!cocode = 1 Then
'' moRSPay!cocode = 1
'' End If
'' moRSPay.Update
'' moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
'' moRS!multipay = vbChecked
'' moRS.Update
'' i = i + 1
'' Loop
'' crOrder.Reset
'' Exit Sub
'' Else
'**** This will Print the Pay Sheet for Brown
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
' crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "B"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
'This will print the Pay Sheet for Texture
crOrder.ReportFileName = App.Path & "\stuccopayT_17.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "T"
' moRSPay!pay_ydge = (intYDS - mintST_ADJ)
moRSPay!pay_ydge = (intYDS)
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintStuccoPay2"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoPay3() ' This is to print Brown and Texture Paysheets for Sand Finish and EIFS over OneKote
Dim strSQL As String, i As Integer, strPAY As String
Dim intTOTAL As Integer, intYDS As Integer, intMETAL As Integer
Dim dblGROSSPAY As Double, strGROSSPAY As String
On Error GoTo Error_EH
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset '******* tblPAYSHEET
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
If moRSProj!cocode = 0 Then
' crOrder.ReportFileName = App.Path & "\stuccopay_T17.rpt"
crOrder.ReportFileName = App.Path & "\stuccopayB3_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
ElseIf moRSProj!cocode = 1 Then
MsgBox "This is not setup for Metro Stucco - Exiting", vbOKOnly, "Invalid Company"
Exit Sub
' crOrder.ReportFileName = App.Path & "\stuccopayM_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayM.rpt"
End If
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
mstrCREWTYPE = "S"
Call GetPayRates
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY)
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
'' If gintCOPY > 3 Then
'' crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
'' intTOTAL = Int((gintCOPY / 2) + 0.99)
'' intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
'' i = 1
'' Do Until i = ((gintCOPY / 2) + 1)
'' crOrder.Formulas(1) = "PaySheetCount = " & i
'' crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
'' crOrder.CopiesToPrinter = 2
' crOrder.CopiesToPrinter = gintCOPY / 2
'' crOrder.Action = 1
'' moRSPay.AddNew
'' moRSPay!lotid = gintLOTID
'' moRSPay!Type = "S"
'' moRSPay!worktype = "P"
'' moRSPay!pay_ydge = intYDS
'' moRSPay!sheet = i
'' moRSPay!Create = gstrLOGIN
'' moRSPay!printed = vbChecked
'' moRSPay!totalsheet = intTOTAL
'' If moRSProj!cocode = 0 Then
'' moRSPay!cocode = 0
'' ElseIf moRSProj!cocode = 1 Then
'' moRSPay!cocode = 1
'' End If
'' moRSPay.Update
'' moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
'' moRS!multipay = vbChecked
'' moRS.Update
'' i = i + 1
'' Loop
'' crOrder.Reset
'' Exit Sub
'' Else
'**** This will Print the Pay Sheet for Brown
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2 '******************WOrk here and in PRINTSTUCCOPAY3 to fix
End If '***** BROWN PAY SHEETS AND TEXTURE PAY SHEETS
' crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
' crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
mstrCREWTYPE = "S" '*****STUCCO CREW
moRSPay!worktype = "B"
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!crewID = mintPAYCREW '******PayCrew Info
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!texture = mstrTexture
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
'This will print the Pay Sheet for Texture
' crOrder.ReportFileName = App.Path & "\stuccopayT_17.rpt"
' crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.Destination = crptToPrinter
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Action = 1
' crOrder.Reset
' moRSPay.AddNew
' moRSPay!lotid = gintLOTID
' moRSPay!Type = "S"
' moRSPay!worktype = "T"
' moRSPay!pay_ydge = (intYDS - mintST_ADJ)
' moRSPay!sheet = i
' moRSPay!Create = gstrLOGIN
' moRSPay!printed = vbChecked
' moRSPay!totalsheet = intTOTAL
' If moRSProj!cocode = 0 Then
' moRSPay!cocode = 0
' ElseIf moRSProj!cocode = 1 Then
' moRSPay!cocode = 1
' End If
' moRSPay.Update
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintStuccoPay3"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoPay4()
Dim strSQL As String, i As Integer, intMETAL As Integer
Dim intTOTAL As Integer, intYDS As Integer, strPAY As String
Dim dblGROSSPAY As Double, strGROSSPAY As String
On Error GoTo Error_EH
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset '******* tblPAYSHEET
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
' Call GetPayRates
If moRSProj!cocode = 0 Then
If mboolSTUCCOC Then
' crOrder.ReportFileName = App.Path & "\stuccopay_17.rpt"
crOrder.ReportFileName = App.Path & "\stuccopay_T17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay_T17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
Else
crOrder.ReportFileName = App.Path & "\stuccopay_T17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay_171.rpt"
End If
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\stuccopayM_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayM.rpt"
End If
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
Do Until i = ((gintCOPY / 2) + 1)
mstrCREWTYPE = "S"
' Call GetPayRates
Call GetPayRatesT
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY)
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
' crOrder.Formulas(4) = "Z_Gross = " & Format(CStr(dblGROSSPAY), "Currency")
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
' crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
moRSPay.AddNew '******* tblPAYSHEET Add Information
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
mstrCREWTYPE = "S"
moRSPay!worktype = "T"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!crewID = mintPAYCREW
moRSPay!texture = mstrTexture
moRSPay!totalsheet = intTOTAL
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS!multipay = vbChecked
moRS.Update
i = i + 1
Loop
crOrder.Reset
Exit Sub
Else
mstrCREWTYPE = "S"
' Call GetPayRates
Call GetPayRatesT
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY)
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
' dblGROSSPAY = Round(dblGROSSPAY, 2)
' crOrder.Formulas(4) = "Z_Gross = " & Format(CStr(dblGROSSPAY), "Currency")
' crOrder.CopiesToPrinter = 1
' crOrder.CopiesToPrinter = gintCOPY
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew '******* tblPAYSHEET Add New Paysheet
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
mstrCREWTYPE = "S"
moRSPay!worktype = "T"
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
' Call GetPayRates
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!crewID = mintPAYCREW
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!texture = mstrTexture
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintStuccoPay4"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdCalc_Click()
If moRS!texture = "DF" Or moRS!texture = "MF" Or moRS!texture = "QS" Or moRS!texture = "RF" Then
gbool2FIN = True
Else
gbool2FIN = False
End If
If moRS!texture = "DW" Then
moRS!calcdate = Date
moRS.Update
Else
If moRSProj!stype <> "T" Then
Call MatCalcOne
Call ConvertSuper
Call MatLoad
Call CalcMetal
Else
Call MatCalcThree
Call ConvertSuper
Call MatLoad
Call CalcMetal
End If
End If
MsgBox "Materials Calculation is Complete"
txtYardMemo = Field2Str(txtYardMemo) & " - CALC " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
End Sub
Private Sub cmdDelLot_Click()
Dim strSQL As String, strYN As String
On Error GoTo Error_EH
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
gconACTION = 3
strSQL = "DELETE * FROM tblLOption WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblLotMatrl WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblOrders WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPOrder WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPOrdMat WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblARInvoice WHERE Lot_id = " & gintLOTID
goConn.Execute strSQL
moRS.Delete
gstrFLAG = "D"
Call LotChange(mstrPROJLOT, "Delete Lot")
' Call LotChange(mstrPROJLOT, "Delete Lot", )
Unload Me
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdDelLot"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdDelPO_Click()
Dim strSQL As String
Dim strYN As String
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
gconACTION = 3
mintBOOKMARK = lstPO.ListIndex
cmdDelPO.Enabled = False
cmdAddPO.Enabled = True
cmdSavePO.Enabled = False
cmdPrintPO.Enabled = False
cmdAddPOMat.Enabled = True
cmdSavePOMat.Enabled = False
cmdDelPOMat.Enabled = False
strSQL = "DELETE * FROM tblPOrdmat where ponum = " & mintPONUM
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPOrder WHERE PONum = " & mintPONUM
goConn.Execute strSQL
Call LotChange(mstrPROJLOT, "Delete PO")
Call POLoad
If lstPO.ListCount Then
If lstPO.ListCount > mintBOOKMARK Then
lstPO.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
Else
lstPO.ListIndex = mintBOOKMARK - 1
End If
Else
mintBOOKMARK = -1
Call POMatClear
Call POClear
End If
gconACTION = 0
End Sub
Private Sub cmdDelPOMat_Click()
Dim strYN As String
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
gconACTION = 3
mintBOOKMARK = lstPOMaterial.ListIndex
moRSPOMAT.Delete
Call LotChange(mstrPROJLOT, "Delete PO Material")
Call POMatLoad
cmdAddPO.Enabled = True
cmdSavePO.Enabled = False
cmdDelPO.Enabled = False
cmdPrintPO.Enabled = False
cmdSavePOMat.Enabled = False
cmdDelPOMat.Enabled = False
cmdAddPOMat.Enabled = True
If lstPOMaterial.ListCount Then
If lstPOMaterial.ListCount > mintBOOKMARK Then
lstPOMaterial.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
Else
lstPOMaterial.ListIndex = mintBOOKMARK - 1
End If
End If
gconACTION = 0
End Sub
Private Sub cmdEdit_Click()
gconACTION = 5
cmdSaveMatrl.Enabled = True
cmdCalc.Enabled = True
cmdFindPlan.Visible = True
cmdFindPlan.Enabled = True
cmdOrders.Enabled = True
cmdSaveLotInfo.Enabled = True
' cmdPrintCMU.Enabled = True
' cmdUpCMU.Enabled = True
txtAddress.Enabled = True
txtOwner.Enabled = True
lstLOptions.Enabled = True
lstPOptions.Enabled = True
End Sub
Private Sub cmdFindPOMat_Click()
Dim oRS As Recordset, strTYPE As String
Dim strSQL As String, lngFind As Long
On Error GoTo Error_EH
strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtPOInvNo.Text & "' AND Inv_Type = " & gbytINV_TYPE
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
With oRS
txtPOInvNo = Field2Str(!inv_no)
txtPOMatDesc = Field2Str(!Desc)
txtPOPrice = Field2Str2(!price)
If !d_flag = "S" Then
cboPODFlag.Text = "Supplier"
Else
cboPODFlag.Text = "Yard"
End If
strTYPE = Field2Str(!m_type)
Call FindType(cboPOMType, strTYPE)
End With
txtPOQty.SetFocus
Else
lstLOOKUP.Visible = True
Call LoadILookUp
lngFind = Field2Long(txtPOInvNo)
Call ListFindItem2(lstLOOKUP, lngFind)
End If
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdFindPOMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub LoadILookUp()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE inv_type = " & gbytINV_TYPE
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstLOOKUP.Clear
Do Until oRS.EOF
With lstLOOKUP
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstLOOKUP.ListCount Then
lstLOOKUP.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module LoadLookUp"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdIssue_Click()
If cmdIssue.Caption = "RePrint &Yard Ticket" Then
gintCOPY = 1
Call PrintIssueA
End If
If cmdIssue.Caption = "RePrint Actual Rpt" Then
gintCOPY = 1
Call PrintActual
End If
cmdIssue.Visible = False
End Sub
Private Sub PrintIssueA()
Dim lngTIE As Long
Dim strSQL As String
lngTIE = FindMax2("tblYardOrder", "split", "LOT_ID", gintLOTID)
If mboolSPLIT Then
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P') AND {tblYARDORDER.SPLIT} = }" & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " AND {tblYARDORDER.SPLIT} = " & lngTIE
crOrder.ReportFileName = App.Path & "\issue2.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Formulas(4) = 1
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Else
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P') AND {tblYARDORDER.SPLIT} = }" & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " AND {tblYARDORDER.SPLIT} = " & lngTIE
crOrder.ReportFileName = App.Path & "\issue.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
crOrder.Formulas(4) = 1
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
End If
' cmdIssue.Visible = False
End Sub
Private Sub cmdJCSetup_Click()
Call JCSetup
End Sub
Private Sub cmdLathPay_Click()
Dim strPAY As String
Dim bytINFO As Byte
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
bytINFO = InputBox("Enter the Number of Times to Divide This Paysheet", "RePrint Lath", 1)
If bytINFO = 1 Then
gintCOPY = 1
ElseIf bytINFO = 2 Then
gintCOPY = 3
ElseIf bytINFO = 3 Then
gintCOPY = 5
ElseIf bytINFO = 4 Then
gintCOPY = 7
ElseIf bytINFO = 5 Then
gintCOPY = 9
End If
Call LotChange(mstrPROJLOT, "RePrint Lath Pay")
Call PrintLathPay
cmdLathPay.Visible = False
End Sub
Private Sub cmdLathPrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intYN As Integer, intYNL As Integer
Dim oRS As Recordset, oRSS As Recordset, intResponse As Integer, intYNS As Integer
Dim strSELECT As String, strSql2 As String, strMSG As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean, intLATHCREW As Integer
Dim boolFPRINT As Boolean, intPERCENT As Integer, strSQLUP As String, intSTUCCOCREW As Integer
Dim strPAY As String, dblBal As Double, intCOPY As Integer, intTCPAY As Integer
Dim strSQLC As String, oRSCPO As Recordset
Dim oRSC As Recordset, strCrewType As String, strSQLCREW As String
Dim oRSL As Recordset, strSQLX As String
On Error GoTo Error_EH
strCrewType = ""
boolPrtLATH = False
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
mboolLATHC = False
mboolSTUCCOC = False
mboolWRAPC = False
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Lath Order Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
If Not moRSProj!setup Then
MsgBox "The Lot Setup is not Completed - Contact Accounts Receivable - No Lath Order Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
Call GetPlanInfo
' If mboolPLANUP Then
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
MsgBox "Plan Information Has Been Updated - Click on Binoculars and Recalculate before Printing", vbOKOnly, "Must Update"
cmdExit.Enabled = True
Exit Sub
End If
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
' If moRSPay.EOF Then
' End If
gintCOPY = 1
' If moRS!Split Then
If mboolSPLIT Then
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'L' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Lath Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
If txtSuperBB = 0 And txtSuper12 = 0 Then
MsgBox "No Superintendent's Statistics have been entered", vbCritical + vbOKOnly, "No Lath Print Allowed"
cmdExit.Enabled = True
Exit Sub
End If
' strSQL = "SELECT * FROM tblplans WHERE est_id = " & moRS!est_id ' & "'"
strSQL = "SELECT * FROM tblPlanBill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
MsgBox "The Lot Start Date is Earlier Than The Billing Effective Date - Fix It", vbOKOnly, "Will Not Work"
cmdExit.Enabled = True
Exit Sub
End If
If Not moRSProj!bill And Field2Str2(oRS!l_bill) = 0 Then
MsgBox "No Lath Price in for this Plan - No Lath Can Be Printed", vbOKOnly, "No Pricing"
cmdExit.Enabled = True
Exit Sub
End If
If Field2Str2(oRS!s_bill) = 0 Then
MsgBox "No Stucco Price in for this Plan - No Lath Can Be Printed", vbOKOnly, "No Pricing"
cmdExit.Enabled = True
Exit Sub
End If
intYNL = MsgBox("Do You Want To Use A Crew Number With The Lath PaySheet? Y or N)", vbYesNo, "Use Crew")
If intYNL = vbYes Then
intLATHCREW = InputBox("Enter The Lath Crew Number", "Lath Crew", 0)
strSQLCREW = "SELECT * FROM tblcrew WHERE NOT INACTIVE AND Crew_ID = " & intLATHCREW
Set oRSC = New Recordset
oRSC.Open strSQLCREW, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
strCrewType = oRSC!Type
End If
If intLATHCREW = 0 Or IsNull(intLATHCREW) Or strCrewType <> "L" Then
If strCrewType = "" Then
MsgBox "Crew Is InActive - Must Enter An Active Lath Crew Number - Will Exit Now", vbOKOnly, "InActive Crew"
Exit Sub
End If
MsgBox "Must Enter A Valid Lath Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
Exit Sub
Else
mintPAYCREW = Field2Str2(intLATHCREW)
moRS!LCREW = Field2Str2(intLATHCREW)
moRS.Update
mboolLATHC = True
End If
Else
moRS!LCREW = 0
moRS.Update
End If
'' intYNS = MsgBox("Do You Want To Use A Crew Number With The Stucco PaySheet? Y or N)", vbYesNo, "Use Crew")
'' If intYNS = vbYes Then
'' intSTUCCOCREW = InputBox("Enter The Stucco Crew Number", "Stucco Crew", 0)
'' If intSTUCCOCREW = 0 Or IsNull(intSTUCCOCREW) Then
'' MsgBox "Must Enter A Valid Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
'' Exit Sub
'' Else
'' moRS!BCREW = Field2Str2(intSTUCCOCREW)
'' moRS.Update
'' mboolSTUCCOC = True
'' End If
'' Else
'' moRS!BCREW = 0
'' moRS.Update
'' End If
gboolPRINT = True
gstrPO = "L"
gstrFLAG = "L"
gstrTYPE = "Y"
Call ShowPrint
gstrMODULE = "After Show Print"
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE order_id = " & glngORDERID ' & " and d_flag = 'S' and m_type = 'L'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "Step 1 "
If oRS.EOF Then
Else
' glngORDERID = Field2Integer(oRS!order_id)
gstrPONUM = Field2Str(oRS!po_num)
moRS!lorder = Field2Str(oRS!order_date)
moRS.Update
End If
gstrMODULE = "Step 2 "
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and (m_type = 'L' or m_type = 'P')"
' strSQL = "{tblLotMatrl.lot_id} = " & gintLOTID & " and {tblLotMatrl.d_flag} = 'S' and ({tblLotMatrl.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "Step 3 "
If oRS.EOF Then
MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
' If Field2Str2(oRS!qty) > Field2Str2(oRS!o_qty) Then
'***************** need to move this to Issue and Make a unique identifier
If Field2Single(oRS!qty) > Field2Single(oRS!o_qty) Then
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
dblBal = Field2Double(oRS!qty) - Field2Double(oRS!o_qty)
dblBal = Round(dblBal, 2)
If dblOrder > dblBal Then
dblOrder = dblBal
End If
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
' strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & Chr(10) & Chr(13)
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Balance Available -- " & Field2Str2(oRS!qty) - Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
' Else
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
' strMSG = strMSG & "Qty For This Order -- " & Int((((oRS!qty - oRS!o_qty) * gintPERCENT) / 100) + 0.99)
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!o_qty = dblOrder
oRSS!x_flag = vbChecked
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS!a_qty = dblOrder
oRSS.Update
End If
oRS.MoveNext
Loop
End If
gstrMODULE = "Step 4 "
If oRS.State = adStateOpen Then
oRS.Close
End If
gstrMODULE = "Step 5 "
If oRSS.State = adStateOpen Then
oRSS.Close
End If
gstrMODULE = "Before Print Lath PO"
MsgBox "Insert A PINK Sheet of Paper for the Delivery Sheet and then Press Enter", vbOKOnly, "InsertPaper"
' strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\NewLath2.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\NewLath2M.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
gintCOPY = 2
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\NewLath.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\NewLathM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
gintCOPY = 1
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% SUPPLIER LATH ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
goConn.Execute strSQLUP
moRS!PRNT_L = Now()
moRS.Update
If boolFPRINT Then
gstrMODULE = "Before Print Actual "
Call PrintActual
gintCOPY = 1
crOrder.Reset
End If
' If boolFPRINT Then
gstrMODULE = "Before Print Issue Ticket "
Call PrintIssue
gintCOPY = 1
crOrder.Reset
strSQLC = "SELECT Lot_ID, M_Type FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " AND M_Type = 'D'"
Set oRSCPO = New Recordset
oRSCPO.Open strSQLC, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSCPO.EOF Then
gstrMODULE = "Before Print Coated Popout Issue Ticket "
Call PrintCoated
gintCOPY = 1
crOrder.Reset
End If
' End If
If boolFPRINT Then
gstrMODULE = "Before Print Lath Material Report "
Call PrintLathMat
crOrder.Reset
' crOrder.Reset
' Load frmEPElev
' Unload frmEPElev
If Not chkNoPay Then
' If Field2Str2(txtTtlYdge) - 19 > 1200 Then
' intCOPY = Int(((txtTtlYdge - 19) / 1200) + 0.99)
' MsgBox "Insert 4 Sheets of Paper for the Lath Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 4
' Else
' MsgBox "Insert 2 Sheets of Paper for the Lath Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 2
' End If
If Field2Str2(txtTtlYdge) - 19 > 1200 Then
intCOPY = Int(((txtTtlYdge - 19) / 1200) + 0.99)
gintCOPY = intCOPY * 2
MsgBox "Insert " & gintCOPY & " Sheets of Paper for the Lath Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' MsgBox "Insert 4 Sheets of Paper for the Lath Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
' gintCOPY = 4
Else
MsgBox "Insert 2 Sheets of Paper for the Lath Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gintCOPY = 2
End If
gstrMODULE = "Before Print Lath Pay "
Call PrintLathPay
'***********Beginning of print stucco pay - moved to Print Brown Order --- REMOVE TWO TICK MARKS TO START USING AGAIN
'' gintCOPY = 1
'' intCOPY = 0
'' crOrder.Reset
'' gstrMODULE = "Before Print Stucco Pay "
'' If moRSProj!stype <> "T" Then
'' If Field2Str2(txtTtlYdge) - 24 > 1200 Then
'' intCOPY = Int(((txtTtlYdge - 24) / 1200) + 0.99)
'' gintCOPY = intCOPY * 2
'' MsgBox "Insert " & gintCOPY & " Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' ' gintCOPY = 4
'' Call PrintStuccoPay
'' crOrder.Reset
'' gintCOPY = 1
'' Else
'' If moRS!texture <> "SB" Then
'' MsgBox "Insert 2 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' gintCOPY = 2
'' Call PrintStuccoPay
'' crOrder.Reset
'' gintCOPY = 1
'' ElseIf moRS!texture = "SF" Then
'' MsgBox "**STONE** Insert 4 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' MsgBox "Make Sure GOLD and RED Paper Is In The Printer and then Press Enter", vbOKOnly, "Insert Gold & Red Paper"
'' gintCOPY = 2
'' Call PrintStuccoStone
'' crOrder.Reset
'' gintCOPY = 1
'' Else
'' MsgBox "**SYNTHETIC** Insert 4 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' MsgBox "Make Sure GOLD and RED Paper Is In The Printer and then Press Enter", vbOKOnly, "Insert Gold & Red Paper"
'' gintCOPY = 2
'' Call PrintStuccoSyn
'' crOrder.Reset
'' gintCOPY = 1
'' End If
'' End If
'' Else
'' If Field2Str2(txtTtlYdge) - 24 > 1200 Then
'' intCOPY = Int(((txtTtlYdge - 24) / 1200) + 0.99)
'' gintCOPY = intCOPY * 2
'' intTCPAY = gintCOPY * 3
'' MsgBox "Insert " & intTCPAY & " Sheets of Paper for the Three Coat Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
''' gintCOPY = 4
'' Call PrintStuccoThree
'' crOrder.Reset
'' gintCOPY = 1
'' Else
'' MsgBox "Insert 6 Sheets of Paper for the Three Coat Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' gintCOPY = 2
'' Call PrintStuccoThree
'' crOrder.Reset
'' gintCOPY = 1
'' End If
'' End If
'****************** End of Print Stucco Pay moved to Print Brown Order
gintCOPY = 1
' If Field2Integer(moRS!CMU) > 0 Then
' intYN = MsgBox("Do You Want To Print A CMU Pay Sheet At This Time?", vbYesNo, "CMU Pay Sheet")
' If intYN = vbYes Then
' Call cmdPrintCMU_Click
' crOrder.Reset
' End If
' End If
End If
End If
'****** Print Stone Pay Sheet and Invoice
'****** Removed 06/27/05 per Rose
' If Not chkNoPay Then
' If moRS!ostone And Not moRS!otstone Then
' crOrder.Reset
' MsgBox "Insert 2 Sheets of Paper for the Stone Pay Sheets and then Press Enter", vbOKOnly, "Insert Paper"
' gintCOPY = 2
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID ' & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
' crOrder.ReportFileName = App.Path & "\StonePay.rpt"
' crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
' crOrder.Destination = crptToPrinter
' crOrder.Action = 1
' If boolCOMPLETE Then
' Call PrintStoneInv
' crOrder.Reset
' End If
' End If
' End If
If moRS!Firsttime Then
MsgBox "This is the first time for this plan - HOLD PAY SHEETS!", vbOKOnly, "HOLD PAY SHEETS"
End If
If boolCOMPLETE Then
' gintCOPY = 1
' crOrder.Reset
' If Not moRS!Split Then
' If Not moRSProj!bill Then
' Call PrintLathInv
' crOrder.Reset
' End If
' End If
moRS!l_FLG = "P"
moRS!y_FLG = "P"
moRS!s_FLG = "P"
moRS!z_FLG = "P"
moRS!LathD = vbTrue
' cmdLathPrint.Enabled = False
End If
strSQLX = "SELECT Lot_id, Invoice_NO, Inv_Type, Header, PO_NUM FROM tblARINVOICE WHERE INV_TYPE = 'L' AND LOT_ID = " & Field2Str2(moRS!Lot_ID)
Set oRSL = New Recordset
oRSL.Open strSQLX, goConn, adOpenKeyset, adLockOptimistic
' If Not oRSL.EOF Then
If oRSL.EOF Then
boolPrtLATH = True
' lblLathInv = Field2Str(oRS!invoice_no)
' lblLathPO = Field2Str(oRS!po_num)
End If
oRSL.Close
If boolPrtLATH Then
If boolFPRINT Then
gintCOPY = 1
crOrder.Reset
If Not moRSProj!bill Then
Call PrintLathInv
crOrder.Reset
End If
' moRS!l_flg = "P"
' moRS!y_flg = "P"
' moRS!S_flg = "P"
' cmdLathPrint.Enabled = False
End If
End If
End If
moRS.Update
gintCOPY = 1
gboolPRINT = False
' cmdLathPrint.Enabled = False
Call Form_Load
cmdExit.Enabled = True
If moRSPay.State = adStateOpen Then
moRSPay.Close
End If
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & " Form LotInfo5 - Module cmdLathPrint"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub cmdWrapPrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intYN As Integer, intYNW As Integer
Dim oRS As Recordset, oRSS As Recordset, intResponse As Integer, intWRAPCREW As Integer
Dim strSELECT As String, strSql2 As String, strMSG As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strSQLUP As String
Dim strPAY As String, dblBal As Double, intCOPY As Integer, intTCPAY As Integer
Dim oRSC As Recordset, strCrewType As String, strSQLCREW As String
On Error GoTo Error_EH
strCrewType = ""
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
mboolWRAPC = False
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Lath Order Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
If Not moRSProj!setup Then
MsgBox "The Lot Setup is not Completed - Contact Accounts Receivable - No Lath Order Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
Call GetPlanInfo
' If IsNull(Date2Field(moRS!calcdate)) Or (Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate)) Then
' If Date2Field(moRSPlan!Update) > Field2Str2(moRS!calcdate) Then
' If Field2Str(moRSPlan!Update) > Field2Str(moRS!calcdate) Then
' MsgBox "Plan Information Has Been Updated - Click on Binoculars and Recalculate before Printing", vbOKOnly, "Must Update"
' cmdExit.Enabled = True
' Exit Sub
' End If
If IsNull(moRS!calcdate) Then
MsgBox "Lot Has Not Been Calculated - ReCalculate", vbOKOnly, "ReCalculate"
Exit Sub
End If
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
strMSG = "This Plan Has Been Updated - It Is Recommended That You ReImport & ReCalculate"
strMSG = strMSG & Chr(10) & Chr(13)
strMSG = strMSG & "Do You Want To ReImport & ReCalculate?"
intResponse = MsgBox(strMSG, vbYesNo, "Recalculate Recommended")
' MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
If intResponse = vbYes Then
Call cmdFindPlan_Click
Call cmdCalc_Click
cmdExit.Enabled = True
End If
' Exit Sub
End If
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
gintCOPY = 1
If mboolSPLIT Then
'look at the next line and decide if it needs to be deleted
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'L' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Lath Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
If txtSuperBB = 0 And txtSuper12 = 0 Then
MsgBox "No Superintendent's Statistics have been entered", vbCritical + vbOKOnly, "No Wrap Print Allowed"
cmdExit.Enabled = True
Exit Sub
End If
strSQL = "SELECT * FROM tblPlanBill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
MsgBox "The Lot Start Date is Earlier Than The Billing Effective Date - Fix It", vbOKOnly, "Will Not Work"
cmdExit.Enabled = True
Exit Sub
End If
intYNW = MsgBox("Do You Want To Use A Crew Number With The Wrap PaySheet? Y or N)", vbYesNo, "Use Crew")
If intYNW = vbYes Then
intWRAPCREW = InputBox("Enter The Wrap Crew Number", "Wrap Crew", 0)
strSQLCREW = "SELECT * FROM tblcrew WHERE NOT INACTIVE AND Crew_ID = " & intWRAPCREW
Set oRSC = New Recordset
oRSC.Open strSQLCREW, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
strCrewType = oRSC!Type
End If
If intWRAPCREW = 0 Or IsNull(intWRAPCREW) Or strCrewType <> "L" Then
If strCrewType = "" Then
MsgBox "Crew Is InActive - Must Enter An Active Wrap Crew Number - Will Exit Now", vbOKOnly, "InActive Crew"
Exit Sub
End If
MsgBox "Must Enter A Valid Wrap Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
Exit Sub
Else
mintPAYCREW = Field2Str2(intWRAPCREW)
moRS!WCREW = Field2Str2(intWRAPCREW)
moRS.Update
mboolWRAPC = True
End If
Else
moRS!WCREW = 0
moRS.Update
End If
gboolPRINT = True
gstrPO = "W" 'Wrap
gstrFLAG = "W" 'Wrap
gstrTYPE = "S"
' gstrTYPE = "Y"
Call ShowPrint
gstrMODULE = "After Show Print"
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE order_id = " & glngORDERID ' & " and d_flag = 'S' and m_type = 'W'"
' strSELECT = "SELECT * FROM tblOrders WHERE order_id = " & glngORDERID ' & " and d_flag = 'S' and m_type = 'L'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "Step 1 "
If oRS.EOF Then
Else
gstrPONUM = Field2Str(oRS!po_num)
moRS!worder = Field2Str(oRS!order_date) 'Save Wrap Order Date
moRS.Update
End If
gstrMODULE = "Step 2 "
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and (m_type = 'W')"
' strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and (m_type = 'L' or m_type = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "Step 3 "
If oRS.EOF Then
MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
If Field2Single(oRS!qty) > Field2Single(oRS!o_qty) Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
dblBal = Field2Double(oRS!qty) - Field2Double(oRS!o_qty)
dblBal = Round(dblBal, 2)
If dblOrder > dblBal Then
dblOrder = dblBal
End If
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Balance Available -- " & Field2Str2(oRS!qty) - Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!o_qty = dblOrder
oRSS!x_flag = vbChecked
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS!a_qty = dblOrder
oRSS.Update
End If
oRS.MoveNext
Loop
End If
gstrMODULE = "Step 4 "
If oRS.State = adStateOpen Then
oRS.Close
End If
gstrMODULE = "Step 5 "
If oRSS.State = adStateOpen Then
oRSS.Close
End If
gstrMODULE = "Before Print Wrap PO"
MsgBox "Insert A PINK Sheet of Paper for the Delivery Sheet and then Press Enter", vbOKOnly, "InsertPaper"
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\NewWrap2.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\NewLath2M.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
'This is to remove 2 pages not needed with wrap orders take out the 'x to turn back on
'x gintCOPY = 2
'x If moRSProj!cocode = 0 Then
'x crOrder.ReportFileName = App.Path & "\NewWrap.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\NewLathM.rpt"
'x End If
'x crOrder.ReplaceSelectionFormula (strSQL)
'x crOrder.Destination = crptToPrinter
'x crOrder.CopiesToPrinter = gintCOPY
'x crOrder.Action = 1
'x crOrder.Reset
gintCOPY = 1
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% SUPPLIER WRAP ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and M_Type = 'W'"
goConn.Execute strSQLUP
gintCOPY = 1
crOrder.Reset
If boolFPRINT Then
gstrMODULE = "Before Print Lath Material Report "
' Call PrintWrapMat
' crOrder.Reset
' Load frmEPElev
' Unload frmEPElev
If Not chkNoPay Then
intCOPY = Int(((txtTtlYdge - 19) / 1200) + 0.99)
gintCOPY = intCOPY * 2
MsgBox "Insert " & gintCOPY & " Sheets of Paper for the Wrap Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gstrMODULE = "Before Print Lath Pay "
Call PrintWrapPay
gintCOPY = 1
intCOPY = 0
crOrder.Reset
End If
End If
End If ''''**** may need to remove this
moRS!WrapD = vbTrue
moRS!WrapP = vbTrue
moRS.Update
'Moved From Print Lath to Help with preliens
If boolFPRINT Then
gintCOPY = 1
crOrder.Reset
If Not moRSProj!bill Then
Call PrintWrapInv
' Call PrintLathInv
crOrder.Reset
End If
End If
gintCOPY = 1
gboolPRINT = False
Call Form_Load
cmdExit.Enabled = True
If moRSPay.State = adStateOpen Then
moRSPay.Close
End If
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & " Form LotInfo5 - Module cmdWrapPrint"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub PrintLathPay()
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer, intMETAL As Integer
Dim dblGROSSPAY As Double, strGROSSPAY As String
On Error GoTo Error_EH
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
If moRSProj!cocode = 0 Then
If mboolLATHC Then
crOrder.ReportFileName = App.Path & "\lathpay_17.rpt"
' crOrder.ReportFileName = App.Path & "\lathpay.rpt"
Else
crOrder.ReportFileName = App.Path & "\lathpay_171.rpt"
End If
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\lathpayM_17.rpt"
' crOrder.ReportFileName = App.Path & "\lathpayM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!l_yds / intTOTAL) + 0.99)
intMETAL = Int((moRS!METAL / intTOTAL) + 0.99)
i = 1
If gintCOPY > 3 Then
mstrCREWTYPE = "L"
Call GetPayRates
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!l_yds / intTOTAL) + 0.99)
intMETAL = Int((moRS!METAL / intTOTAL) + 0.99)
i = 1
Do Until i = (Int((gintCOPY / 2)) + 1)
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
' dblGROSSPAY = Round(dblGROSSPAY, 2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY) ', "#,0.00")
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
' crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
moRSPay.AddNew
moRSPay!lotid = gintLOTID
mstrCREWTYPE = "L"
moRSPay!Type = "L"
moRSPay!worktype = "P"
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pylath = Field2Integer(moRS!pylath) + intYDS
moRS!pmetal = Field2Integer(moRS!pmetal) + intMETAL
moRS!multipay = vbChecked
moRS.Update
i = i + 1
Loop
crOrder.Reset
' Exit Sub
Else
mstrCREWTYPE = "L"
Call GetPayRates
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
' crOrder.CopiesToPrinter = gintCOPY
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY) ', "#,0.00")
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "L"
mstrCREWTYPE = "L"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
' Call GetPayRates
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!crewID = mintPAYCREW
moRSPay!texture = mstrTexture
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pylath = Field2Integer(moRS!pylath) + intYDS
moRS!pmetal = Field2Integer(moRS!pmetal) + intMETAL
moRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintLathPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintWrapPay()
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer, intMETAL As Integer
Dim dblGROSSPAY As Double, strGROSSPAY As String
On Error GoTo Error_EH
' gintCOPY = 2
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
If moRSProj!cocode = 0 Then
If mboolWRAPC Then
crOrder.ReportFileName = App.Path & "\wrappay_17.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\lathpayM.rpt"
Else
crOrder.ReportFileName = App.Path & "\wrappay_171.rpt"
End If
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!l_yds / intTOTAL) + 0.99)
' intMETAL = Int((moRS!METAL / intTOTAL) + 0.99)
i = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
mstrCREWTYPE = "L"
Call GetPayRates
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!l_yds / intTOTAL) + 0.99)
' intMETAL = Int((moRS!METAL / intTOTAL) + 0.99)
i = 1
Do Until i = (Int((gintCOPY / 2)) + 1)
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
' dblGROSSPAY = Round(dblGROSSPAY, 2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY) ', "#,0.00")
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
crOrder.CopiesToPrinter = 2
' crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "W"
mstrCREWTYPE = "W"
moRSPay!worktype = "P"
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!WrapAmt = Field2Integer(moRS!pylath) + intYDS
' moRS!pmetal = Field2Integer(moRS!pmetal) + intMETAL
moRS!multipay = vbChecked
moRS.Update
i = i + 1
Loop
crOrder.Reset
' Exit Sub
Else
mstrCREWTYPE = "L"
Call GetPayRates
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY) ', "#,0.00")
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY ')) ', "$ #,0.00")
crOrder.CopiesToPrinter = 1
' crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "W"
mstrCREWTYPE = "W"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
Call GetPayRates
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!crewID = mintPAYCREW
moRSPay!texture = mstrTexture
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!WrapAmt = Field2Integer(moRS!pylath) + intYDS
' moRS!pmetal = Field2Integer(moRS!pmetal) + intMETAL
moRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintWrapPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoPay()
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer, strPAY As String
Dim dblGROSSPAY As Double, intMETAL As Integer, strGROSSPAY As String
On Error GoTo Error_EH
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
If moRSProj!cocode = 0 Then
If mboolSTUCCOC Then
crOrder.ReportFileName = App.Path & "\stuccopay_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
Else
crOrder.ReportFileName = App.Path & "\stuccopay_171.rpt"
End If
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\stuccopayM_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayM.rpt"
End If
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
Do Until i = ((gintCOPY / 2) + 1)
mstrCREWTYPE = "S"
Call GetPayRates
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY)
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
' crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
mstrCREWTYPE = "S"
moRSPay!worktype = "P"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS!multipay = vbChecked
moRS.Update
i = i + 1
Loop
crOrder.Reset
Exit Sub
Else
mstrCREWTYPE = "S"
Call GetPayRates
If intYDS < 300 Then
crOrder.CopiesToPrinter = 1
Else
crOrder.CopiesToPrinter = 2
End If
' crOrder.CopiesToPrinter = gintCOPY
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Format(Round(dblGROSSPAY, 2), "#,0.00")
strGROSSPAY = CStr(dblGROSSPAY)
crOrder.Formulas(4) = "Z_Gross = " & strGROSSPAY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
mstrCREWTYPE = "S"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!METAL = intMETAL
' Call GetPayRates
moRSPay!M_Rate = msglPAYRT2
moRSPay!Y_Rate = msglPAYRT1
dblGROSSPAY = (intYDS * msglPAYRT1) + (intMETAL * msglPAYRT2)
dblGROSSPAY = Round(dblGROSSPAY, 2)
moRSPay!GROSSPAY = dblGROSSPAY
moRSPay!Amt = dblGROSSPAY
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!crewID = mintPAYCREW
moRSPay!texture = mstrTexture
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintStuccoPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoThree()
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer
On Error GoTo Error_EH
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crOrder.ReportFileName = App.Path & "\stuccopayS_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayS.rpt"
' crOrder.CopiesToPrinter = gintCOPY
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
' crOrder.Action = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
i = 1
Do Until i = ((gintCOPY / 2) + 1)
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "S"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!printed = vbChecked
moRSPay!Create = gstrLOGIN
moRSPay!totalsheet = intTOTAL
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS!multipay = vbChecked
moRS.Update
i = i + 1
Loop
' Exit Sub
Else
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "S"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
End If
crOrder.ReportFileName = App.Path & "\stuccopayB_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayb.rpt"
' crOrder.CopiesToPrinter = gintCOPY
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
i = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
i = 1
Do Until i = ((gintCOPY / 2) + 1)
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "B"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
moRSPay.Update
i = i + 1
Loop
' Exit Sub
Else
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "B"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
moRSPay.Update
End If
' crOrder.Action = 1
crOrder.ReportFileName = App.Path & "\stuccopayT_17.rpt"
' crOrder.ReportFileName = App.Path & "\stuccopayt.rpt"
' crOrder.CopiesToPrinter = gintCOPY
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
i = 1
If gintCOPY > 3 Then
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
i = 1
Do Until i = ((gintCOPY / 2) + 1)
crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY / 2
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "T"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
moRSPay.Update
i = i + 1
Loop
' Exit Sub
Else
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "S"
moRSPay!worktype = "T"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = i
moRSPay!printed = vbChecked
moRSPay!Create = gstrLOGIN
moRSPay!totalsheet = intTOTAL
moRSPay.Update
End If
' crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintStuccoThree"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoSyn()
Dim strSQL As String
Dim intTOTAL As Integer, intYDS As Integer
On Error GoTo Error_EH
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crOrder.Reset
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY)
' crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
crOrder.ReportFileName = App.Path & "\stuccopayB.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.Formulas(3) = "PaySheetX = 'SYNTHETIC FINISH PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "Y"
moRSPay!worktype = "P"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = 1
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
crOrder.Reset
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY)
' crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
crOrder.ReportFileName = App.Path & "\stuccopayT.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.Formulas(3) = "PaySheetX = 'SYNTHETIC FINISH PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "Y"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = 1
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
moRS.Update
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintStuccoSyn"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoStone()
Dim strSQL As String
Dim intTOTAL As Integer, intYDS As Integer
On Error GoTo Error_EH
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crOrder.Reset
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\stuccopayB.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\stuccopayBM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.Formulas(3) = "PaySheetX = 'STONE FINISH PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "V"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = 1
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
crOrder.Reset
crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
intTOTAL = Int((gintCOPY / 2) + 0.99)
intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\stuccopayTS.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\stuccopayTSM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.Destination = crptToPrinter
crOrder.Formulas(3) = "PaySheetX = 'STONE FINISH PAY SHEET'"
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
moRSPay.AddNew
moRSPay!lotid = gintLOTID
moRSPay!Type = "V"
moRSPay!worktype = "C"
moRSPay!pay_ydge = intYDS
moRSPay!sheet = 1
moRSPay!Create = gstrLOGIN
moRSPay!printed = vbChecked
moRSPay!totalsheet = intTOTAL
If moRSProj!cocode = 0 Then
moRSPay!cocode = 0
ElseIf moRSProj!cocode = 1 Then
moRSPay!cocode = 1
End If
moRSPay.Update
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintStuccoStone"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintIssueHold()
Dim strSQL As String, strSELECT As String, strYARD As String, strPRICE As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strPRICE, goConn, adOpenKeyset, adLockOptimistic
strSQL = "SELECT inv_no, price FROM tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
Do Until oRSS.EOF
strSELECT = "inv_no = " & Field2Str(oRSS!inv_no)
oRS.MoveFirst
oRS.Find strSELECT
If Not oRS.EOF Then
oRSS!price = Field2Str2(oRS!price)
' oRSS!price = Str2Field(oRS!price)
oRSS.Update
End If
oRSS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRS.RecordCount > 0 Then
strYARD = "DELETE * FROM tblYardOrder WHERE Lot_id = " & gintLOTID
goConn.Execute strYARD
End If
strYARD = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strYARD, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSS.EOF
oRS.AddNew
oRS!Lot_ID = gintLOTID
oRS!inv_no = Field2Str(oRSS!inv_no)
oRS!Desc = Field2Str(oRSS!Desc)
oRS!qty = Field2Str2(oRSS!qty)
oRS!qtyIssue = Field2Str2(oRSS!qty)
oRS!price = Field2Str2(oRSS!price)
oRS!po_num = "ORIGINAL ORDER"
oRS!createuser = gstrLOGIN
oRS!UpdateUser = gstrLOGIN
oRS.Update
oRSS.MoveNext
Loop
txtYardMemo = Field2Str(txtYardMemo) & " YARD ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
crOrder.ReportFileName = App.Path & "\issue.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintIssueHold"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintIssue()
Dim strSQL As String, strSELECT As String, strYARD As String, strPRICE As String
Dim oRS As Recordset, oRSS As Recordset, dblOrder As Double, dblBal As Double, dblCheck As Double
Dim lngP_Qty As Long, lngO_Qty As Long, lngSHIPPED As Long, strSQLUP As String
Dim oRSYS As Recordset, strSYS As String, lngTIE As Long, strMSG As String
Dim boolSPLIT As Boolean, strMType As String
On Error GoTo Error_EH
' gintCOPY = 2
mstrMTYPE = ""
boolSPLIT = False
strSYS = "SELECT * FROM tblSYSINFO"
Set oRSYS = New Recordset
oRSYS.Open strSYS, goConn, adOpenKeyset, adLockOptimistic
lngTIE = oRSYS!Split
oRSYS!Split = oRSYS!Split + 1
oRSYS.Update
' strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P' or M_Type = 'Z')"
Set oRSS = New Recordset
oRSS.Open strPRICE, goConn, adOpenKeyset, adLockOptimistic
strSQL = "SELECT inv_no, price FROM tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
Do Until oRSS.EOF
strSELECT = "inv_no = " & Field2Str(oRSS!inv_no)
oRS.MoveFirst
oRS.Find strSELECT
If Not oRS.EOF Then
oRSS!price = Field2Str2(oRS!price)
' oRSS!price = Str2Field(oRS!price)
oRSS.Update
End If
oRSS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = " & gintLOTID & " AND split >= " & lngTIE
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRS.RecordCount > 0 Then
strYARD = "DELETE * FROM tblYardOrder WHERE Lot_id = " & gintLOTID
goConn.Execute strYARD
End If
strYARD = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'L' or M_Type = 'P' or M_Type = 'Z')"
Set oRSS = New Recordset
oRSS.Open strYARD, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSS.EOF
If CDbl(Field2Str2(oRSS!qty)) > CDbl(Field2Str2(oRSS!o_qty)) Then
' If moRS!Split Then
If mboolSPLIT Then
' mboolSPLIT = True
dblOrder = Int((((oRSS!qty) * gintPERCENT) / 100) + 0.99)
dblBal = Field2Double(oRSS!qty) - Field2Double(oRSS!o_qty)
dblBal = Round(dblBal, 2)
If dblOrder > dblBal Then
dblOrder = dblBal
End If
strMSG = "Item -- " & Trim$(Field2Str(oRSS!Desc)) & vbCrLf
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRSS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRSS!o_qty) & vbCrLf
strMSG = strMSG & "Balance Available -- " & Field2Str2(oRSS!qty) - Field2Str(oRSS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRSS!o_qty + dblOrder
If dblCheck > oRSS!qty Then
dblOrder = oRSS!qty - oRSS!o_qty
End If
' oRSS!o_qty = oRSS!o_qty + dblOrder
oRSS.Update
Else
dblOrder = oRSS!qty
End If
oRS.AddNew
oRS!Lot_ID = gintLOTID
oRS!inv_no = Field2Str(oRSS!inv_no)
oRS!Desc = Field2Str(oRSS!Desc)
oRS!qty = Round(dblOrder, 2)
oRS!qtyIssue = Round(dblOrder, 2)
' oRS!qty = Field2Str2(oRSS!qty)
' oRS!qtyIssue = Field2Str2(oRSS!qty)
oRS!price = Field2Str2(oRSS!price)
If mboolSPLIT Then
oRS!po_num = "PARTIAL ORDER"
Else
oRS!po_num = "ORIGINAL ORDER"
End If
mstrMTYPE = Field2Str(oRSS!m_type)
' If mstrMTYPE <> "" Or Not IsNull(mstrMTYPE) Then
If mstrMTYPE = "P" Or mstrMTYPE = "Z" Then
Call GetPONUM
oRS!po_num = mstrORDERNUM
mstrORDERNUM = ""
mstrType = ""
End If
oRS!createuser = gstrLOGIN
oRS!UpdateUser = gstrLOGIN
oRS!Split = lngTIE
oRS!d_flag = Field2Str(oRSS!d_flag)
oRS!m_type = Field2Str(oRSS!m_type)
oRS.Update
lngSHIPPED = Field2Str2(oRSS!o_qty)
' lngSHIPPED = Round(Field2Str2(oRSS!o_qty), 2)
oRSS!o_qty = lngSHIPPED + Field2Str2(oRS!qtyIssue)
oRSS.Update
End If
oRSS.MoveNext
Loop
If mboolSPLIT Then
txtYardMemo = Field2Str(txtYardMemo) & " PARTIAL YARD ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
Else
txtYardMemo = Field2Str(txtYardMemo) & " YARD ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
End If
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P' or M_Type = 'Z')"
' strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'L' or M_Type = 'P')"
goConn.Execute strSQLUP
' crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "Z_SPLIT = " & lngTIE
If mboolSPLIT Then
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P') AND {tblYARDORDER.SPLIT} = }" & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " AND {tblYARDORDER.SPLIT} = " & lngTIE
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\issue2.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\issue2M.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Else
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P' or {tblLOTMATRL.M_Type} = 'Z') AND {tblYARDORDER.SPLIT} = }" & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " AND {tblYARDORDER.SPLIT} = " & lngTIE
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\issue.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\issueM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
End If
' gintCOPY = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintIssue"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetPONUM()
Dim oRS As Recordset, strSQL As String
strSQL = "SELECT Lot_ID, M_Type, D_Flag, PO_NUM FROM tblORDERS WHERE Lot_ID = " & gintLOTID & " AND D_Flag = 'Y' AND M_Type = '" & mstrMTYPE & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
mstrORDERNUM = Field2Str(oRS!po_num)
End If
Exit Sub
End Sub
Private Sub PrintCoated()
Dim strSQL As String, strSELECT As String, strYARD As String, strPRICE As String
Dim oRS As Recordset, oRSS As Recordset, dblOrder As Double, dblBal As Double, dblCheck As Double
Dim lngP_Qty As Long, lngO_Qty As Long, lngSHIPPED As Long, strSQLUP As String
Dim oRSYS As Recordset, strSYS As String, lngTIE As Long, strMSG As String
Dim boolSPLIT As Boolean
On Error GoTo Error_EH
boolSPLIT = False
strSYS = "SELECT * FROM tblSYSINFO"
Set oRSYS = New Recordset
oRSYS.Open strSYS, goConn, adOpenKeyset, adLockOptimistic
lngTIE = oRSYS!Split
oRSYS!Split = oRSYS!Split + 1
oRSYS.Update
strPRICE = "SELECT lot_id, Inv_no, Price from tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'D' )" 'or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strPRICE, goConn, adOpenKeyset, adLockOptimistic
strSQL = "SELECT inv_no, price FROM tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
Do Until oRSS.EOF
strSELECT = "inv_no = " & Field2Str(oRSS!inv_no)
oRS.MoveFirst
oRS.Find strSELECT
If Not oRS.EOF Then
oRSS!price = Field2Str2(oRS!price)
' oRSS!price = Str2Field(oRS!price)
oRSS.Update
End If
oRSS.MoveNext
Loop
End If
oRS.Close
oRSS.Close
strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = " & gintLOTID & " And Split >= " & lngTIE
' strSELECT = "SELECT * FROM tblYardOrder WHERE Lot_ID = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'D') And Split >= " & lngTIE
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
' If oRS.RecordCount > 0 Then
' strYARD = "DELETE * FROM tblYardOrder WHERE Lot_id = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'D') And Split >= " & lngTIE
' goConn.Execute strYARD
' End If
strYARD = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and D_Flag = 'Y' and (M_Type = 'D')" 'or M_Type = 'P')"
Set oRSS = New Recordset
oRSS.Open strYARD, goConn, adOpenKeyset, adLockOptimistic
Do Until oRSS.EOF
' If CDbl(Field2Str2(oRSS!qty)) > CDbl(Field2Str2(oRSS!o_qty)) Then
' If CDbl(Field2Str2(oRSS!qty)) > CDbl(Field2Str2(oRSS!o_qty)) Then
' If moRS!Split Then
If mboolSPLIT Then
' mboolSPLIT = True
dblOrder = Int((((oRSS!qty) * gintPERCENT) / 100) + 0.99)
dblBal = Field2Double(oRSS!qty) - Field2Double(oRSS!o_qty)
dblBal = Round(dblBal, 2)
If dblOrder > dblBal Then
dblOrder = dblBal
End If
strMSG = "Item -- " & Trim$(Field2Str(oRSS!Desc)) & vbCrLf
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRSS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRSS!o_qty) & vbCrLf
strMSG = strMSG & "Balance Available -- " & Field2Str2(oRSS!qty) - Field2Str(oRSS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRSS!o_qty + dblOrder
If dblCheck > oRSS!qty Then
dblOrder = oRSS!qty - oRSS!o_qty
End If
' oRSS!o_qty = oRSS!o_qty + dblOrder
oRSS.Update
Else
dblOrder = oRSS!qty
End If
oRS.AddNew
oRS!Lot_ID = gintLOTID
oRS!inv_no = Field2Str(oRSS!inv_no)
oRS!Desc = Field2Str(oRSS!Desc)
oRS!qty = dblOrder
oRS!qtyIssue = dblOrder
' oRS!qty = Field2Str2(oRSS!qty)
' oRS!qtyIssue = Field2Str2(oRSS!qty)
oRS!price = Field2Str2(oRSS!price)
If mboolSPLIT Then
oRS!po_num = "PARTIAL ORDER"
Else
oRS!po_num = "ORIGINAL ORDER"
End If
oRS!createuser = gstrLOGIN
oRS!UpdateUser = gstrLOGIN
oRS!Split = lngTIE
oRS!d_flag = Field2Str(oRSS!d_flag)
oRS!m_type = Field2Str(oRSS!m_type)
oRS.Update
lngSHIPPED = Field2Str2(oRSS!o_qty)
oRSS!o_qty = lngSHIPPED + Field2Str2(oRS!qtyIssue)
oRSS.Update
' End If
oRSS.MoveNext
Loop
If mboolSPLIT Then
txtYardMemo = Field2Str(txtYardMemo) & " PARTIAL COATED POPOUT ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
Else
txtYardMemo = Field2Str(txtYardMemo) & " COATED POPOUT ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
End If
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'D')" 'or M_Type = 'P')"
goConn.Execute strSQLUP
' crOrder.Formulas(1) = "PaySheetCount = " & i
crOrder.Formulas(3) = "Z_SPLIT = " & lngTIE
If mboolSPLIT Then
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P') AND {tblYARDORDER.SPLIT} = }" & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'D' AND {tblYARDORDER.SPLIT} = " & lngTIE
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\Coated2.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\Coated2M.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Else
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P') AND {tblYARDORDER.SPLIT} = }" & lngTIE
' strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " and {tblLOTMATRL.D_Flag} = 'Y' and ({tblLOTMATRL.M_Type} = 'D' AND {tblYARDORDER.SPLIT} = " & lngTIE
strSQL = "{tblYARDORDER.lot_id} = " & gintLOTID & " and {tblYARDORDER.D_Flag} = 'Y' and {tblYARDORDER.M_Type} = 'D' AND {tblYARDORDER.SPLIT} = " & lngTIE
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\Coated.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\CoatedM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintCoated"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintLathMat()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "{tbllotmatrl.lot_id} = " & gintLOTID & " and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\lathmat.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\lathmatM.rpt"
End If
' crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.ReplaceSelectionFormula (strSQL)
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintLathMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintWrapMat()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "{tbllotmatrl.lot_id} = " & gintLOTID & " and ({tblLOTMATRL.M_Type} = 'W' or {tblLOTMATRL.M_Type} = 'P')"
' strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and ({tblLOTMATRL.M_Type} = 'L' or {tblLOTMATRL.M_Type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\wrapmat.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\lathmatM.rpt"
End If
' crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.ReplaceSelectionFormula (strSQL)
crOrder.ReplaceSelectionFormula (strSQL) 'May need to removed the or {tblLOTMATRL.M_Type} = 'P' from the strSQL
crOrder.CopiesToPrinter = gintCOPY 'Find out from Ryan how to make this report process faster.
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintWrapMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoMat()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "{tblLotInfo.lot_id} = " & gintLOTID & " and ({tblLOTMATRL.M_Type} = 'B' or {tblLOTMATRL.M_Type} = 'S' or {tblLOTMATRL.M_Type} = 'T')"
crOrder.ReportFileName = App.Path & "\stuccomat.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintStuccoMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ShowPrint()
Dim oRS As Recordset
Dim strSQL As String, lngPO As Long
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblSYSInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
lngPO = Field2Long(oRS!nextpo)
gstrMODULE = "Line 8"
lngPO = lngPO + 1
If lngPO > 99999 Then
lngPO = 1
End If
oRS!nextpo = lngPO
oRS.Update
gstrMODULE = gstrMODULE & " Line 15"
Load frmPrint
gstrMODULE = gstrMODULE & " Line 18"
frmPrint.txtJobCost = Field2Str(moRS!jobcost)
frmPrint.txtPONum = Trim(Field2Str(moRSProj!Proj_Code))
' gstrPONUM = Trim(Field2Str(moRSProj!proj_code))
gstrMODULE = gstrMODULE & " Line 20"
frmPrint.txtPONum = frmPrint.txtPONum & Trim(Field2Str(moRS!lot_no))
' gstrPONUM = gstrPONUM & Trim(Field2Str(moRS!lot_no))
gstrMODULE = gstrMODULE & " Line 22"
frmPrint.txtPONum = frmPrint.txtPONum & Format(lngPO, "0000")
' gstrPONUM = gstrPONUM & Format(intPO, "0000")
gstrMODULE = gstrMODULE & " Line 24"
frmPrint.txtMFlag = gstrFLAG
gstrMODULE = gstrMODULE & " Line 26"
frmPrint.txtSupplier = Left$(Field2Str(txtPODesc), 20)
' gstrCREW = Left$(Field2Str(txtPODesc), 20)
gstrMODULE = gstrMODULE & gstrFLAG & " "
frmPrint.txtDFlag = gstrTYPE
gstrMODULE = gstrMODULE & " Line 30"
If mintSUPPLIER = 99 Then
frmPrint.txtPO = Field2Str2(moRSPO!ponum)
' gintPONUM = moRSPO!ponum
Else
frmPrint.txtPO = 0
' gintPONUM = 0
End If
gstrMODULE = gstrMODULE & " Line 35"
frmPrint.Show 1
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & " Form LotInfo5 - Module ShowPrint"
' gstrMODULE = " Form LotInfo5 - Module ShowPrint"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAddPO_Click()
If mboolVERIFIED Then
MsgBox "This Plan Has Been Checked and Verified - No Additional Material is allowed"
End If
Call POClear
gconACTION = 0
cmdSavePO.Enabled = True
cmdDelPO.Enabled = False
cmdAddPO.Enabled = False
cmdAddPOMat.Enabled = False
cmdDelPOMat.Enabled = False
cmdSavePOMat.Enabled = False
cmdPrintPO.Enabled = False
txtPOInvNo.Enabled = False
txtPOMatDesc.Enabled = False
txtPOQty.Enabled = False
txtPOPrice.Enabled = False
txtPODate.Enabled = True
txtPODesc.Enabled = True
txtIssueTo.Enabled = True
txtPay.Enabled = True
txtPayType.Enabled = True
txtPONotes.Enabled = True
cboPODFlag.Enabled = False
cboPOMType.Enabled = False
cmdFindPOMat.Enabled = False
mboolAdding = True
cboPOType.SetFocus
End Sub
Private Sub cmdLFlag_Click()
moRS!y_FLG = "P"
moRS!l_FLG = "P"
moRS!s_FLG = "P"
moRS!z_FLG = "P"
Call cmdSaveLotInfo_Click
cmdLFlag.Visible = False
If FormFind() Then
Call FormShow 'xxxxxxxxxxxxxxxxxx
End If
End Sub
Private Sub cmdOrder_Click()
gintORDER = 9
frmOrders.Show 1
End Sub
Private Sub cmdPreOrderPrintY_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intTIME As Integer
Dim oRS As Recordset
Dim strSELECT As String
On Error GoTo Error_EH
gintCOPY = 2
gboolPRINT = True
gstrFLAG = "P"
gstrTYPE = "Y"
gstrPO = "L"
Call ShowPrint
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE po_num = '" & gstrPONUM & "'" ' and m_type = 'P'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
' strSQL = "{tblORDERS.Po_Num} = '" & gstrPONUM & "' and {tblLotMatrl.d_flag} = '" & oRS!d_flag & " ' and {tblORDERS.m_type} = '" & oRS!m_type & "'"
strSQL = "{tblORDERS.Po_Num} = '" & gstrPONUM & "' and {tblLotMatrl.d_flag} = '" & oRS!d_flag & "'" '" ' and {tblORDERS.m_type} = 'P'"
' strSQL = "{tblORDERS.Po_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'Y' and {tblORDERS.m_type} = 'P'"
' strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblORDERS.d_flag} = 'Y' and {tblORDERS.m_type} = 'P'"
crOrder.ReportFileName = App.Path & "\preorder.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
moRS!y_FLG = "P"
moRS.Update
cmdPreOrderPrintY.Enabled = False
txtYardMemo = Field2Str(txtYardMemo) & " YARD PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
gboolPRINT = False
Call Form_Load
SSTLotInfo.Tab = 1
ElseIf Len(gstrPONUM) > 0 Then
moRS!y_FLG = "P"
moRS.Update
cmdPreOrderPrintY.Enabled = False
Call Form_Load
txtYardMemo = Field2Str(txtYardMemo) & " YARD PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
SSTLotInfo.Tab = 1
End If
gintCOPY = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdPreOrderPrintY"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
'''Private Sub cmdPrint_Click()
''' If cmdPrint.Caption = "Print Lath Order" Then
''' Call cmdLathPrint_Click
''' ElseIf cmdPrint.Caption = "Print Sand Order" Then
''' Call cmdSandPrint_Click
''' ElseIf cmdPrint.Caption = "Print Brown Order" Then
''' Call cmdBrownPrint_Click
''' ElseIf cmdPrint.Caption = "Print Scratch Order" Then
''' Call cmdScratchPrint_Click
''' ElseIf cmdPrint.Caption = "Print Texture Order" Then
''' Call cmdTexturePrint_Click
''' ElseIf cmdPrint.Caption = "Print Stone Order" Then
''' Call cmdStonePrint_Click
''' Else
''' End If
'''End Sub
Private Sub cmdPrintCMU_Click()
Dim strSQL As String
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
Call LotChange(mstrPROJLOT, "Print CMU Pay Sheet")
strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
crOrder.ReportFileName = App.Path & "\cmupay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.Destination = crptToWindow
' crOrder.Destination = crptToPrinter
crOrder.Destination = gintDEST
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
txtNotes = Field2Str(txtNotes) & " -- CMU PAYSHEET PRINTED " & Now() & " BY " & gstrLOGIN
Call FormSave
' cmdPrintCMU.Enabled = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdPrintCMU_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Call ProcessRpt
End Sub
Private Sub cmdPrintPOPay_Click()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
gintCOPY = 1
gintPRINT = 1
frmReport.Show 1
If gintPRINT Then
Call LotChange(mstrPROJLOT, "Print PO Pay Sheet")
strSQL = "{tblPOrder.ponum} = " & mintPONUM
crOrder.ReportFileName = App.Path & "\POpay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.Destination = crptToWindow
' crOrder.Destination = crptToPrinter
crOrder.Destination = gintDEST
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
crOrder.Reset
strSQL = "SELECT * FROM tblPOrder WHERE ponum = " & mintPONUM
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
oRS!pay_flag = vbTrue
oRS.Update
cmdPrintPOPay.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdPrintPOPay_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintPO_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intTIME As Integer
Dim oRS As Recordset, intResponse As Integer
Dim strSELECT As String
mintBOOKMARK = lstPO.ListIndex
On Error GoTo Error_EH
gboolPRINT = True
If optPreOrder Then
gstrFLAG = "P"
Else
gstrFLAG = "R"
End If
gintCOPY = 1
If optLath Then
gstrTYPE = "Y"
ElseIf optStucco Then
gstrTYPE = "S"
ElseIf optSand Then
gstrTYPE = "A"
ElseIf optPreOrder Then
gstrTYPE = "Y"
ElseIf optStone Then
mboolSTONE2 = True
gstrPO = "L"
gstrFLAG = "V"
gstrTYPE = "S"
ElseIf optNone Then
gstrTYPE = ""
End If
mintSUPPLIER = 99
Call ShowPrint
mintSUPPLIER = 0
If gboolPRINT And mboolSTONE2 Then
strSELECT = "SELECT * FROM tblOrders WHERE Order_id = " & glngORDERID ' & " and m_type = 'T'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
moRS!VOrder = Field2Str(oRS!order_date)
' moRS!st_flg = vbTrue
moRS.Update
End If
End If
If gboolPRINT Then
strSELECT = "SELECT * FROM tblPOrder WHERE PONum = " & lstPO.ItemData(lstPO.ListIndex) ' & " and p_flg <> 'P'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If oRS!p_flg = "P" Then
MsgBox "This PO has already been printed"
Exit Sub
End If
If Not oRS.EOF Then
crOrder.Reset
strSQL = "{tblORDERS.po_num} = '" & gstrPONUM & "'" 'lstPO.ItemData(lstPO.ListIndex) ' & " and {tblORDERS.d_flag} = 'Y' and {tblORDERS.m_type} = 'P'"
' strSQL = "{tblORDERS.po_num} = " & lstPO.ItemData(lstPO.ListIndex) ' & " and {tblORDERS.d_flag} = 'Y' and {tblORDERS.m_type} = 'P'"
If gstrPO <> "L" Then
crOrder.ReportFileName = App.Path & "\POMisc.rpt"
Else
Call POSetup
crOrder.ReportFileName = App.Path & "\purchase.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
oRS!p_flg = "P"
oRS.Update
End If
gboolPRINT = False
If gstrPO = "L" Then
intResponse = MsgBox("Do You Want To Print An Invoice", vbOKCancel, "Invoice Print")
If intResponse = vbOK Then
Call POInvoice
End If
End If
Call Form_Load
SSTLotInfo.Tab = 6
Else
Call Form_Load
SSTLotInfo.Tab = 6
End If
lstPO.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdPrintPO_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub POSetup()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, oRSS As Recordset
Dim strSELECT As String, strSql2 As String
Dim dblOrder As Double
strSELECT = "SELECT * FROM tblOrders WHERE Order_Id = " & glngORDERID ' & " and m_type = 'B'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
gstrPONUM = Field2Str(oRS!po_num)
End If
strSQL = "SELECT * FROM tblPOrdMat WHERE ponum = " & gintPONUM ' & " and d_flag = 'S' and m_type = 'B'" ' or m_type = 'P')"
' strSQL = "{tblLotMatrl.lot_id} = " & gintLOTID & " and {tblLotMatrl.d_flag} = 'S' and ({tblLotMatrl.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
dblOrder = Field2Str2(oRS!qty)
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!o_qty = dblOrder
oRSS!a_qty = dblOrder
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS.Update
oRS.MoveNext
Loop
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
End Sub
Private Sub cmdPreOrderPrintS_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intTIME As Integer
Dim oRS As Recordset
Dim strSELECT As String
On Error GoTo Error_EH
gintCOPY = 2
gboolPRINT = True
gstrFLAG = "P"
gstrTYPE = "S"
gstrPO = "L"
Call ShowPrint
If gboolPRINT Then
' strSELECT = "SELECT * FROM tblOrders WHERE lot_id = " & gintLOTID & " and m_type = 'P'"
strSELECT = "SELECT * FROM tblOrders WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'P'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
End If
strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblORDERS.d_flag} = 'S' and {tblORDERS.m_type} = 'P'" '
' strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblLOTMATRL.d_flag} = 'S' and {tblLOTMATRL.m_type} = 'P'"
crOrder.ReportFileName = App.Path & "\preorder.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
moRS!s_FLG = "P"
moRS.Update
cmdPreOrderPrintS.Enabled = False
gboolPRINT = False
Call Form_Load
txtYardMemo = Field2Str(txtYardMemo) & " SUPPLIER PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
SSTLotInfo.Tab = 1
ElseIf Len(gstrPONUM) > 0 Then
moRS!s_FLG = "P"
moRS.Update
cmdPreOrderPrintS.Enabled = False
Call Form_Load
txtYardMemo = Field2Str(txtYardMemo) & " SUPPLIER PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
SSTLotInfo.Tab = 1
End If
gintCOPY = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PreOrderPrintS_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPreOrderPrintPC_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intTIME As Integer
Dim oRS As Recordset
Dim strSELECT As String
On Error GoTo Error_EH
gboolPRINT = True
gstrFLAG = "Z"
gstrTYPE = "Y"
' gstrTYPE = "S"
gstrPO = "L"
Call ShowPrint
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE lot_id = " & gintLOTID & " and m_type = 'Z'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblORDERS.d_flag} = 'Y' and {tblORDERS.m_type} = 'Z'"
' strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblORDERS.d_flag} = 'S' and {tblORDERS.m_type} = 'Z'"
crOrder.ReportFileName = App.Path & "\preorderPC.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
moRS!z_FLG = "P"
moRS.Update
cmdPreOrderPrintPC.Enabled = False
gboolPRINT = False
Call Form_Load
txtYardMemo = Field2Str(txtYardMemo) & " PRECAST PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
SSTLotInfo.Tab = 1
ElseIf Len(gstrPONUM) > 0 Then
moRS!z_FLG = "P"
moRS.Update
cmdPreOrderPrintPC.Enabled = False
Call Form_Load
txtYardMemo = Field2Str(txtYardMemo) & " PRECAST PRE-ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
SSTLotInfo.Tab = 1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PreOrderPrintPC_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintForm_Click()
Me.PrintForm
End Sub
Private Sub cmdPrintR_Click()
Call ProcessRpt
' Call LotLoad
If mboolNoPrint Then
MsgBox "No Processing Selected Yet - Exiting", vbOKOnly
Exit Sub
End If
If mboolSupP Then
Call cmdSuperRpt_Click
End If
If mboolStoneP Then
MsgBox "Stone Not Setup", vbOKOnly, "Not Enabled"
moRS!StoneP = vbFalse
moRS.Update
Call cmdStonePrint_Click
End If
If mboolWrapP Then
Call cmdWrapPrint_Click
End If
If mboolLathP Then
Call cmdLathPrint_Click
End If
If mboolNescoP Then
MsgBox "Nesco Not Setup", vbOKOnly, "Not Enabled"
moRS!NescoP = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
If mboolPopOutP Then
MsgBox "PopOut Not Setup", vbOKOnly, "Not Enabled"
moRS!PopoutP = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
If mboolBrownP Then
Call cmdBrownPrint_Click
End If
If mboolTexP Then
Call cmdTexturePrint_Click
End If
If mboolCMUP Then
MsgBox "CMU Not Setup", vbOKOnly, "Not Enabled"
moRS!CMUP = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
If mboolEX1P Then
MsgBox "Extra 1 Not Setup", vbOKOnly, "Not Enabled"
moRS!EX1P = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
If mboolEX2P Then
MsgBox "Extra 2 Not Setup", vbOKOnly, "Not Enabled"
moRS!EX2P = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
If mboolEX3P Then
MsgBox "Extra 3 Not Setup", vbOKOnly, "Not Enabled"
moRS!EX3P = vbFalse
moRS.Update
' Call cmdSuperRpt_Click
End If
mboolSupP = False
mboolLathP = False
mboolWrapP = False
mboolStoneP = False
mboolNescoP = False
mboolPopOutP = False
mboolCMUP = False
mboolBrownP = False
mboolTexP = False
mboolEX1P = False
mboolEX2P = False
mboolEX3P = False
End Sub
'''Private Sub cmdPrint_Click()
''' If cmdPrint.Caption = "Print Lath Order" Then
''' Call cmdLathPrint_Click
''' ElseIf cmdPrint.Caption = "Print Sand Order" Then
''' Call cmdSandPrint_Click
''' ElseIf cmdPrint.Caption = "Print Brown Order" Then
''' Call cmdBrownPrint_Click
''' ElseIf cmdPrint.Caption = "Print Scratch Order" Then
''' Call cmdScratchPrint_Click
''' ElseIf cmdPrint.Caption = "Print Texture Order" Then
''' Call cmdTexturePrint_Click
''' ElseIf cmdPrint.Caption = "Print Stone Order" Then
''' Call cmdStonePrint_Click
''' Else
''' End If
'''End Sub
Private Sub cmdRePrintL_Click()
Call RePrintLath
cmdRePrintL.Visible = False
Call FormShow
End Sub
Private Sub cmdSandPrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intTIME As Integer
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset, sglSAND As Single
Dim strSELECT As String, strSql2 As String, strSQL3 As String, strFIND As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strMSG As String, intResponse As Integer
On Error GoTo Error_EH
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
strMSG = "This Plan Has Been Updated - It Is Recommended That You ReImport & ReCalculate"
strMSG = strMSG & Chr(10) & Chr(13) & Chr(10) & Chr(13)
strMSG = strMSG & "Do You Want To ReImport & ReCalculate?"
intResponse = MsgBox(strMSG, vbYesNo, "Recalculate Recommended")
' MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
If intResponse = vbYes Then
Call cmdFindPlan_Click
Call cmdCalc_Click
cmdExit.Enabled = True
End If
' Exit Sub
End If
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Orders Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
If Field2Str2(moRS!zone) = 0 Then
MsgBox "Sand Delivery Zone Needs To Be Entered Before Printing", vbOKOnly, "No SandZone"
Exit Sub
End If
'' If chkHoldOrders Then
'' MsgBox "All Stucco/Sand Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Orders On Hold"
'' cmdExit.Enabled = True
'' Exit Sub
'' End If
cmdExit.Enabled = False
' If moRS!Split Then
If mboolSPLIT Then
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'A' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
' gintPERCENT = Field2Str2(CInt(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent")))
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Sand Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
gboolPRINT = True
gstrPO = "L"
gstrFLAG = "A"
gstrTYPE = "A"
gintCOPY = 1
Call ShowPrint
gstrMODULE = "After SHOWPRINT "
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE order_id = " & glngORDERID '& " and m_type = 'A'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((moRS!sand_ton) * gintPERCENT) / 100) + 0.99)
strMSG = "Item -- Plaster Sand " & vbCrLf
strMSG = strMSG & "Original Tons -- " & Field2Str2(moRS!sand_ton) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(moRS!ORD_NO) & vbCrLf
strMSG = strMSG & "Balance Available -- " & Field2Str2(moRS!sand_ton) - Field2Str(moRS!ORD_NO) & vbCrLf
If boolCOMPLETE Then
dblOrder = Field2Str2(moRS!sand_ton) - Field2Str(moRS!ORD_NO)
End If
strMSG = strMSG & "Tons For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = moRS!ORD_NO + dblOrder
If dblCheck > moRS!sand_ton Then
dblOrder = moRS!sand_ton - moRS!ORD_NO
' Else
End If
moRS!ORD_NO = moRS!ORD_NO + dblOrder
moRS.Update
Else
dblOrder = moRS!sand_ton
End If
moRS!Border = Field2Str(oRS!order_date)
If boolCOMPLETE Then
moRS!a_flg = vbTrue
End If
moRS.Update
gstrMODULE = "After Update Delivery Date "
' glngORDERID = Field2Long(oRS!order_id)
strSQL3 = "SELECT * FROM tblSZone" ' WHERE zone = 2" ' & Field2Integer(moRS!zone)
Set oRSSS = New Recordset
oRSSS.Open strSQL3, goConn, adOpenKeyset, adLockOptimistic
If oRSSS.EOF Then
Else
oRSSS.MoveFirst
strFIND = "zone = " & Field2Str2(moRS!zone)
oRSSS.Find strFIND
sglSAND = Format(Field2Str2(oRSSS!price), "#,#.00")
End If
strSql2 = "SELECT * FROM tblORDMatrl WHERE order_id = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "Before Setup Materials "
With oRSS
.AddNew
!order_id = glngORDERID
!Lot_ID = gintLOTID
!po_num = Field2Str(oRS!po_num)
!d_flag = "S"
!m_type = "A"
!inv_no = "9999"
!Desc = "ICBO RIVER PLASTER SAND"
!x_flag = vbChecked
!o_qty = dblOrder
!a_qty = dblOrder
!price = sglSAND
.Update
.AddNew
!order_id = glngORDERID
!Lot_ID = gintLOTID
!po_num = Field2Str(oRS!po_num)
!d_flag = "S"
!m_type = "A"
!inv_no = "9994"
!Desc = "SPLIT CHARGE"
!x_flag = vbChecked
!o_qty = 0
!a_qty = 0
!price = 15
.Update
.AddNew
!order_id = glngORDERID
!Lot_ID = gintLOTID
!po_num = Field2Str(oRS!po_num)
!d_flag = "S"
!m_type = "A"
!inv_no = "9993"
!Desc = "MINIMUM ORDER CHARGE"
!x_flag = vbChecked
!o_qty = 0
!a_qty = 0
!price = 40
.Update
End With
crOrder.Reset
strSQL = "{tblORDERS.Order_id} = " & glngORDERID ' & " and {tblORDERS.d_flag} = 'A' and {tblORDERS.m_type} = 'A'"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\sand.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\sandM.rpt"
End If
crOrder.Formulas(1) = "Sand = " & dblOrder
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
gboolPRINT = False
' cmdSandPrint.Enabled = False
txtYardMemo = Field2Str(txtYardMemo) & " SAND ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
Call Form_Load
End If
cmdExit.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & "Form LotInfo5 - Module cmdSandPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub cmdSaveLotInfo_ClickOLD()
If gconACTION = 4 Then
Call LotChange(mstrPROJLOT, "Change Lot Information")
gconACTION = 0
End If
If gconACTION = 5 Then
Call LotChange(mstrPROJLOT, "Update After Lath")
gconACTION = 0
End If
Call FieldsSave
Call MatSave
txtLotNo.Enabled = False
cmdSaveLotInfo.Enabled = False
If gstrLOGIN = "TYF" Or gstrLOGIN = "TYF2" Then
cmdAddLot.Enabled = False
Else
cmdAddLot.Enabled = True
End If
cmdAddMatrl.Enabled = True
cmdSaveMatrl.Enabled = False
cmdDelMatrl.Enabled = False
txtJC.Enabled = False
If gbytSECURITY = 1 Then
cmdDelLot.Enabled = True
End If
txtSuperBB = IIf(txtSuperBB = "", 0, txtSuperBB)
txtSuper12 = IIf(txtSuper12 = "", 0, txtSuper12)
If Field2Str(moRS!l_FLG) <> "P" Then
If txtSuperBB = 0 And txtSuper12 = 0 Then
cmdCalc.Enabled = False
Else
cmdCalc.Enabled = True
End If
End If
End Sub
Private Sub cmdSavePO_Click()
Dim lngID As Long
If Not IsDate(txtPODate) Then
MsgBox "You Do Not Have A Valid PO Date", vbOKOnly, "Invalid Date"
txtPODate.SetFocus
Exit Sub
End If
If mboolVERIFIED Then
MsgBox "This Plan Has Been Checked and Verified - Talk to Angel", vbOKOnly, "Plan Verified"
Call LotChange(mstrPROJLOT, "Chnge After Verified")
End If
If gconACTION = 2 Then
Call LotChange(mstrPROJLOT, "Chnge PO Information")
gconACTION = 0
End If
' If gconACTION = 5 Then
' Call LotChange(mstrPROJLOT, "Update After Lath")
' End If
mintBOOKMARK = lstPO.ListIndex
If mboolAdding Then
If mintBOOKMARK = -1 Then
mintBOOKMARK = 0
End If
End If
cmdAddPO.Enabled = True
cmdAddPOMat.Enabled = True
cmdSavePO.Enabled = False
cmdSavePOMat.Enabled = False
cmdDelPO.Enabled = True
cmdDelPOMat.Enabled = True
cmdPrintPO.Enabled = True
cmdFindPOMat.Visible = False
txtPODate.Enabled = True
txtPODesc.Enabled = True
txtIssueTo.Enabled = True
txtPay.Enabled = True
txtPayType.Enabled = True
txtPONotes.Enabled = True
lstLOOKUP.Visible = False
Call POSave
Call POLoad
If mboolAdding Then
mboolAdding = False
lngID = FindMax("tblPOrder", "PONum")
Call CBFindString(lstPO, CStr(lngID))
cmdAddPOMat.SetFocus
mintBOOKMARK = lstPO.ListIndex
End If
lstPO.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
End Sub
Private Sub cmdSavePOMat_Click()
Dim intINVNO As Integer, lngID As Long
If gconACTION = 2 Then
Call LotChange(mstrPROJLOT, "Change PO Material")
gconACTION = 0
End If
' If gconACTION = 5 Then
' Call LotChange(mstrPROJLOT, "Update After Lath")
' End If
mintBOOKMARK = lstPOMaterial.ListIndex
cmdAddPO.Enabled = True
cmdAddPOMat.Enabled = True
cmdSavePO.Enabled = False
cmdSavePOMat.Enabled = False
cmdDelPO.Enabled = True
cmdDelPOMat.Enabled = True
cmdPrintPO.Enabled = True
cmdFindPOMat.Visible = False
lstLOOKUP.Visible = False
intINVNO = txtPOInvNo
Call POMatSave
Call POMatLoad
txtPOInvNo.Enabled = False
txtPOMatDesc.Enabled = False
txtPOQty.Enabled = False
txtPOPrice.Enabled = False
cboPODFlag.Enabled = False
cboPOMType.Enabled = False
cmdFindPOMat.Enabled = False
If mboolAdding Then
mboolAdding = False
Call CBFindString4(lstPOMaterial, CStr(intINVNO))
cmdAddPOMat.SetFocus
mintBOOKMARK = 0
Exit Sub
End If
If lstPOMaterial.ListCount Then
lstPOMaterial.ListIndex = CLng(mintBOOKMARK)
' lstPOMaterial.ListIndex = 5
mintBOOKMARK = 0
Else
lstPOMaterial.ListIndex = -1
End If
mintBOOKMARK = 0
End Sub
Private Sub cmdScratchPrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, oRSS As Recordset
Dim strSELECT As String, strSql2 As String, strSQLUP As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strMSG As String, intResponse As Integer
Dim strORDERDATE As String
On Error GoTo Error_EH
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
strMSG = "This Plan Has Been Updated - It Is Recommended That You ReImport & ReCalculate"
strMSG = strMSG & Chr(10) & Chr(13)
strMSG = strMSG & "Do You Want To ReImport & ReCalculate?"
intResponse = MsgBox(strMSG, vbYesNo, "Recalculate Recommended")
' MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
If intResponse = vbYes Then
Call cmdFindPlan_Click
Call cmdCalc_Click
cmdExit.Enabled = True
End If
' Exit Sub
End If
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Orders Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
'' If chkHoldOrders Then
'' MsgBox "All Stucco Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Orders On Hold"
'' cmdExit.Enabled = True
'' Exit Sub
'' End If
gboolPRINT = True
gintCOPY = 1
' If moRS!Split Then
If mboolSPLIT Then
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'S' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Lath Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
gstrPO = "L"
gstrFLAG = "S"
gstrTYPE = "S"
Call ShowPrint
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE Order_Id = " & glngORDERID ' & " and m_type = 'B'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
strORDERDATE = Field2Str(oRS!order_date)
' glngORDERID = Field2Integer(oRS!order_id)
gstrPONUM = Field2Str(oRS!po_num)
' If moRS!Split Then
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'S'" ' or m_type = 'P')"
' strSQL = "{tblLotMatrl.lot_id} = " & gintLOTID & " and {tblLotMatrl.d_flag} = 'S' and ({tblLotMatrl.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
Call Form_Load
cmdExit.Enabled = True
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strMSG = oRS!Desc
If Field2Double(oRS!qty) > Field2Double(oRS!o_qty) Then
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
' strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & Chr(10) & Chr(13)
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
' Else
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!x_flag = vbChecked
oRSS!o_qty = dblOrder
oRSS!a_qty = dblOrder
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS.Update
End If
oRS.MoveNext
Loop
End If
' End If
moRS!TORDER = strORDERDATE
' moRS!forder = Field2Str(oRS!order_date)
If boolCOMPLETE Then
moRS!c_flg = vbTrue
End If
moRS.Update
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
crOrder.Reset
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
' strSQL = "{tblORDERS.lot_id} = " & gintLOTID & " and {tblORDERS.d_flag} = 'S' and {tblORDERS.m_type} = 'S'"
crOrder.ReportFileName = App.Path & "\NewScratch.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% SCRATCH ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
gboolPRINT = False
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and (M_Type = 'S')"
goConn.Execute strSQLUP
' cmdScratchPrint.Enabled = False
Call Form_Load
End If
cmdExit.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdScratchPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub PrintActual()
Dim strDate As String, strSQL As String, intSUP As Integer, intYARDS As Integer
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset
Dim strSELECT As String, strOPTION As String, intCOUNT As Integer
Dim start
On Error GoTo Error_EH
strSELECT = "DELETE * FROM tblReport"
goConn.Execute strSELECT
strSELECT = "SELECT * FROM tblLOption WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
strOPTION = "SELECT * FROM tblReport"
Set oRSSS = New Recordset
oRSSS.Open strOPTION, goConn, adOpenKeyset, adLockOptimistic
oRSSS.AddNew
intCOUNT = 0
Do Until oRS.EOF
strSQL = "SELECT optid, yardage, desc FROM tblPOption where optid = " & Field2Str(oRS!Opt_ID)
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
intYARDS = intYARDS + Field2Integer(oRSS!Yardage)
intCOUNT = intCOUNT + 1
If intCOUNT = 1 Then
oRSSS!desc1 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 2 Then
oRSSS!desc2 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 3 Then
oRSSS!desc3 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 4 Then
oRSSS!desc4 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 5 Then
oRSSS!desc5 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 6 Then
oRSSS!desc6 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 7 Then
oRSSS!desc7 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 8 Then
oRSSS!desc8 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 9 Then
oRSSS!desc9 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 10 Then
oRSSS!desc10 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
End If
oRS.MoveNext
Loop
oRSSS!Lot_ID = gintLOTID
oRSSS!optyds = intYARDS
oRSSS.Update
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
strSQL = "{tblReport.lot_id} = " & gintLOTID '& " and {tblLOTINFO.lot_id} = " & gintLOTID
start = Timer ' Set start time.
Do While Timer < start + 5
' DoEvents ' Yield to other processes.
Loop
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\actual.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\actualM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintActual"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSetupRpt_Click()
frmLotPrtJobs.Show 1
Call LotLoad
End Sub
Private Sub cmdShowChange_Click()
frmLotChLog.Show 1
End Sub
Private Sub cmdStonePrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, oRSS As Recordset
Dim strSELECT As String, strSql2 As String
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strMSG As String, boolNOSTONE As Boolean
On Error GoTo Error_EH
boolNOSTONE = False
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Orders Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
'' If chkHoldOrders Then
'' MsgBox "All Stone Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Orders On Hold"
'' cmdExit.Enabled = True
'' Exit Sub
'' End If
gintCOPY = 1
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
gboolPRINT = True
gstrPO = "L"
gstrFLAG = "V"
gstrTYPE = "S"
Call ShowPrint
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE Order_id = " & glngORDERID ' & " and m_type = 'T'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
moRS!VOrder = Field2Str(oRS!order_date)
If boolCOMPLETE Then
' moRS!st_flg = vbTrue
End If
moRS.Update
End If
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'V'" ' or m_type = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
boolNOSTONE = True
crOrder.Reset
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\Stone2.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
crOrder.Reset
' MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
' Call Form_Load
' cmdExit.Enabled = True
' Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
If Field2Str2(oRS!qty) > Field2Str2(oRS!o_qty) Then
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
' Else
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!o_qty = dblOrder
oRSS!a_qty = dblOrder
oRSS!x_flag = vbChecked
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS.Update
End If
oRS.MoveNext
Loop
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
' If oRSS.State = adStateOpen Then
' oRSS.Close
' End If
If Not boolNOSTONE Then
crOrder.Reset
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\Stone.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
End If
crOrder.Reset
' MsgBox "Insert 2 Sheets of Paper for the Stone Pay Sheets and then Press Enter", vbOKOnly, "Insert Paper"
gintCOPY = 1
strSQL = "{tblLotInfo.lot_id} = " & gintLOTID ' & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
crOrder.ReportFileName = App.Path & "\StonePay.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
If boolCOMPLETE Then
Call PrintStoneInv
crOrder.Reset
End If
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% STONE ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
gboolPRINT = False
Call Form_Load
End If
' cmdStonePrint.Enabled = False
cmdExit.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdStonePrint_Click"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub cmdStuccoPay_Click()
Dim strPAY As String
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
Call LotChange(mstrPROJLOT, "RePrint Stucco Pay")
If moRSProj!stype <> "T" Then
gintCOPY = 1
Call PrintStuccoPay
Else
gintCOPY = 1
Call PrintStuccoThree
End If
cmdStuccoPay.Visible = False
End Sub
Private Sub cmdSuperRpt_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intYARDS As Integer
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset
Dim strSELECT As String, strOPTION As String, intCOUNT As Integer
On Error GoTo Error_EH
cmdExit.Enabled = False
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
Exit Sub
End If
strSELECT = "DELETE * FROM tblReport"
goConn.Execute strSELECT
gintCOPY = 1
strSELECT = "SELECT * FROM tblLOption WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
strOPTION = "SELECT * FROM tblReport"
Set oRSSS = New Recordset
oRSSS.Open strOPTION, goConn, adOpenKeyset, adLockOptimistic
oRSSS.AddNew
intCOUNT = 0
Do Until oRS.EOF
strSQL = "SELECT optid, yardage, desc FROM tblPOption where optid = " & Field2Str(oRS!Opt_ID)
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
intYARDS = intYARDS + Field2Integer(oRSS!Yardage)
intCOUNT = intCOUNT + 1
If intCOUNT = 1 Then
oRSSS!desc1 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 2 Then
oRSSS!desc2 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 3 Then
oRSSS!desc3 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 4 Then
oRSSS!desc4 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 5 Then
oRSSS!desc5 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 6 Then
oRSSS!desc6 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 7 Then
oRSSS!desc7 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 8 Then
oRSSS!desc8 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 9 Then
oRSSS!desc9 = Field2Str(oRSS!Desc)
End If
If intCOUNT = 10 Then
oRSSS!desc10 = Field2Str(oRSS!Desc)
End If
End If
oRS.MoveNext
Loop
oRSSS!Lot_ID = gintLOTID
oRSSS!optyds = intYARDS
oRSSS.Update
gintPRINT = 9
frmReport.Show 1
If gintPRINT = 0 Then
cmdExit.Enabled = True
Exit Sub
End If
strSQL = "{tblReport.lot_id} = " & gintLOTID & " and {tblLOTINFO.lot_id} = " & gintLOTID
crOrder.ReportFileName = App.Path & "\super.rpt"
crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.Destination = crptToWindow
' crOrder.Destination = crptToPrinter
crOrder.Destination = gintDEST
crOrder.CopiesToPrinter = gintCOPY
crOrder.Action = 1
cmdExit.Enabled = True
strSELECT = moRS!model
' moRS!superd = vbTrue
moRS!superp = vbFalse
moRS.Update
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdSuperRpt_Click"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub cmdTexturePrint_Click()
Dim strDate As String, strSQL As String, intSUP As Integer, intSTUCCOTCREW As Integer
Dim oRS As Recordset, oRSS As Recordset, intYNS As Integer, intSTUCCOCREW As Integer
Dim strSELECT As String, strSql2 As String, strSQLUP As String, intTCPAY As Integer
Dim dblCheck As Double, dblOrder As Double, boolCOMPLETE As Boolean
Dim boolFPRINT As Boolean, intPERCENT As Integer, strMSG As String, intResponse As Integer
Dim strORDERDATE As String, intCOPY As Integer
Dim oRSC As Recordset, strCrewType As String, strSQLCREW As String
On Error GoTo Error_EH
If Not IsDate(moRSPlan!Update) Then
moRSPlan!Update = 0
End If
If Not IsDate(moRS!calcdate) Then
moRS!calcdate = 1
End If
mintPAYCREW = 0
If Date2Field(moRSPlan!Update) > Date2Field(moRS!calcdate) Then
strMSG = "This Plan Has Been Updated - It Is Recommended That You ReImport & ReCalculate"
strMSG = strMSG & Chr(10) & Chr(13)
strMSG = strMSG & "Do You Want To ReImport & ReCalculate?"
intResponse = MsgBox(strMSG, vbYesNo, "Recalculate Recommended")
' MsgBox "This Plan Has Been Updated - You Need To ReImport & ReCalculate", vbOKOnly, "Recalculate Required"
If intResponse = vbYes Then
Call cmdFindPlan_Click
Call cmdCalc_Click
cmdExit.Enabled = True
End If
' Exit Sub
End If
If moRSProj!plien_req And Not moRSProj!plien_done Then
MsgBox "This Lot Requires A PreLien Which Is Not Done - No Orders Allowed", vbOKOnly, "No Lath Allowed"
Exit Sub
End If
cmdExit.Enabled = False
'' If chkHoldOrders Then
'' MsgBox "All Stucco Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Orders On Hold"
'' cmdExit.Enabled = True
'' Exit Sub
'' End If
' If chkSynthetic Then
' MsgBox "Synthetic Finish - Texture Orders Are On Hold - Correct Problem and Then Print", vbOKOnly, "Texture Orders On Hold"
' cmdExit.Enabled = True
' Exit Sub
' End If
gintCOPY = 1
' If moRS!Split Then
If mboolSPLIT Then
strSELECT = "SELECT SUM(percentage) as SUMPercent FROM tblOrders where M_Type = 'T' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intPERCENT = Field2Str2(oRS!SUMPercent)
If intPERCENT = 0 Then
boolFPRINT = True
Else
boolFPRINT = False
End If
gintPERCENT = Field2Str2(InputBox("Enter The Percent To Order (100 = 100%)", "Enter Percent"))
If gintPERCENT = 0 Then
MsgBox "Must Enter A Value Greater Than Zero", vbOKOnly, "Zero Value"
Exit Sub
End If
If (intPERCENT + gintPERCENT) > 100 Then
MsgBox "The Sum Of All Lath Orders Is Greater Than 100% -- ReEnter", vbOKOnly, "Invalid Percentage"
cmdExit.Enabled = True
Exit Sub
End If
Else
gintPERCENT = 100
boolCOMPLETE = True
boolFPRINT = True
End If
If (intPERCENT + gintPERCENT) = 100 Then
boolCOMPLETE = True
End If
'***** LOGIC TO SETUP CREW NUMBERS FOR TEXTURE PAYSHEETS
If moRS!texture = "S2" Or moRS!texture = "SB" Then
intYNS = MsgBox("Do You Want To Use A Crew Number With The Texture PaySheet? Y or N)", vbYesNo, "Use Crew")
If intYNS = vbYes Then
intSTUCCOTCREW = InputBox("Enter The Texture Crew Number", "Stucco Crew", 0)
strSQLCREW = "SELECT * FROM tblcrew WHERE Not InActive AND Crew_ID = " & intSTUCCOTCREW
Set oRSC = New Recordset
oRSC.Open strSQLCREW, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
strCrewType = oRSC!Type
End If
If intSTUCCOTCREW = 0 Or IsNull(intSTUCCOTCREW) Or strCrewType <> "S" Then
If strCrewType = "" Then
MsgBox "Crew Is InActive - Must Enter An Active Stucco Crew Number - Will Exit Now", vbOKOnly, "InActive Crew"
Exit Sub
End If
MsgBox "Must Enter A Valid Stucco Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
Exit Sub
Else
mintPAYCREW = Field2Str2(intSTUCCOTCREW)
moRS!TCREW = Field2Str2(intSTUCCOTCREW)
moRS.Update
mboolSTUCCOC = True
End If
Else
moRS!TCREW = 0
moRS.Update
mboolSTUCCOC = False
End If
End If
'***** INSERTED TO PRINT TEXTURE PAYSHEETS FOR S2 and SB textures
gintCOPY = 1
intCOPY = 0
crOrder.Reset
gstrMODULE = "Before Print Stucco Pay "
If moRSProj!stype <> "T" Then '**** Three Coat
If Field2Str2(txtTtlYdge) - 24 > 1200 Then 'If error for S2 and SB paysheets on large yardage, this logic needs to be tweeked
intCOPY = Int(((txtTtlYdge - 24) / 1200) + 0.99)
gintCOPY = intCOPY * 2
MsgBox "Insert " & gintCOPY & " Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
If mboolST_ADJ Then
Call PrintStuccoPay4
Else
Call PrintStuccoPay4 '******
End If
crOrder.Reset
gintCOPY = 1
Else
If moRS!texture = "SB" Or moRS!texture = "S2" Then '*** This is to print Brown paysheets
MsgBox "Insert 2 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
gintCOPY = 2
Call PrintStuccoPay4
crOrder.Reset
gintCOPY = 1
End If
'*************** commenting this out to stop non SB or S2 printing texture pay sheets
'' If (moRS!texture <> "SB" And moRS!texture <> "S2") Then
'' MsgBox "Insert 2 Sheets of Paper for the Stucco Pay Sheets and then Press Enter", vbOKOnly, "InsertPaper"
'' gintCOPY = 2
'' If mboolST_ADJ Then
'' Call PrintStuccoPay2
'' Else
'' Call PrintStuccoPay
'' End If
'' crOrder.Reset
'' gintCOPY = 1
'' crOrder.Reset
'' gintCOPY = 1
'' End If
End If
End If
'********** End of information copied to print stucco pay sheets - copied from Print Lath Orders
gboolPRINT = True
gstrPO = "L"
gstrFLAG = "T"
gstrTYPE = "S"
Call ShowPrint
If gboolPRINT Then
strSELECT = "SELECT * FROM tblOrders WHERE Order_Id = " & glngORDERID ' & " and m_type = 'B'"
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.EOF Then
Else
strORDERDATE = Field2Str(oRS!order_date)
' glngORDERID = Field2Integer(oRS!order_id)
gstrPONUM = Field2Str(oRS!po_num)
' If moRS!Split Then
strSQL = "SELECT * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'T'" ' or m_type = 'P')"
' strSQL = "{tblLotMatrl.lot_id} = " & gintLOTID & " and {tblLotMatrl.d_flag} = 'S' and ({tblLotMatrl.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "There Are Not Items To Print", vbOKOnly, "No Print"
Call Form_Load
cmdExit.Enabled = True
Exit Sub
Else
strSql2 = "SELECT * FROM tblOrdMatrl WHERE Order_ID = 1"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strMSG = oRS!Desc
If Field2Double(oRS!qty) > Field2Double(oRS!o_qty) Then
' If moRS!Split Then
If mboolSPLIT Then
dblOrder = Int((((oRS!qty) * gintPERCENT) / 100) + 0.99)
strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & vbCrLf
' strMSG = "Item -- " & Trim$(Field2Str(oRS!Desc)) & Chr(10) & Chr(13)
strMSG = strMSG & "Original Qty -- " & Field2Str2(oRS!qty) & vbCrLf
strMSG = strMSG & "Already Shipped -- " & Field2Str(oRS!o_qty) & vbCrLf
strMSG = strMSG & "Qty For This Order -- " & dblOrder
dblOrder = CInt(InputBox(strMSG, "Order Quantity", dblOrder))
dblCheck = oRS!o_qty + dblOrder
If dblCheck > oRS!qty Then
dblOrder = oRS!qty - oRS!o_qty
' Else
End If
oRS!o_qty = oRS!o_qty + dblOrder
oRS.Update
Else
dblOrder = oRS!qty
End If
oRSS.AddNew
oRSS!order_id = glngORDERID
oRSS!Desc = oRS!Desc
oRSS!Lot_ID = oRS!Lot_ID
oRSS!po_num = gstrPONUM
oRSS!d_flag = oRS!d_flag
oRSS!m_type = oRS!m_type
oRSS!x_flag = vbChecked
oRSS!o_qty = dblOrder
oRSS!a_qty = dblOrder
oRSS!price = oRS!price
oRSS!inv_no = oRS!inv_no
oRSS.Update
End If
oRS.MoveNext
Loop
End If
' End If
moRS!SORDER = strORDERDATE
' moRS!forder = Field2Str(oRS!order_date)
If boolCOMPLETE Then
moRS!t_flg = vbTrue
moRS!TexD = vbTrue
End If
moRS.Update
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
If oRSS.State = adStateOpen Then
oRSS.Close
End If
crOrder.Reset
strSQL = "{tblORDERS.PO_Num} = '" & gstrPONUM & "'" ' and {tblORDERS.d_flag} = 'S' and ({tblORDERS.m_type} = 'L' or {tblLOTMATRL.m_type} = 'P')"
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\NewTexture.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\NewTextureM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
crOrder.Destination = crptToPrinter
crOrder.Action = 1
txtYardMemo = Field2Str(txtYardMemo) & " " & gintPERCENT & "% TEXTURE ORDER PRINTED - " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'Y' and M_Type = 'T'"
goConn.Execute strSQLUP
gboolPRINT = False
' strSQLUP = "UPDATE tblLotMatrl SET PRNT_Flag = true WHERE lot_id = " & gintLOTID & " and d_flag = 'S' and m_type = 'T'"
' goConn.Execute strSQLUP
moRS!PRNT_T = Now()
moRS.Update
'**** Stone Print moved back to it own button on 06/27/05
Call Form_Load
End If
cmdExit.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdTexturePrint_Click"
Call ErrorHandler2
gstrMODULE = ""
cmdExit.Enabled = True
Exit Sub
End Sub
Private Sub cmdUpCMU_Click()
Dim intCMU As Integer
intCMU = InputBox("Enter The Correct CMU Yardage", "CMU Yardage Update")
If intCMU > 0 Then
moRS!CMU = intCMU
moRS.Update
Call FormShow
End If
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
mboolBAD = False
' mboolENTER = False
If gintLOTID = 0 Then
intResponse = MsgBox("No Lot Information, do you wish to add one?", vbYesNo + vbQuestion, "Add Lot Information")
If intResponse = vbYes Then
txtProject = Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc
strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = 1"
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Call cmdAddLot_Click
If mboolBAD Then
Unload Me
End If
Else
Unload Me
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim oRS As Recordset, strSQL As String, strCOST As String, strINVNO As String, intYN As Integer
Dim strPAY As String, strMSG As String, lngOPTID As Long
Dim strSQLST As String, oRSST As Recordset, strSQLPST As String, oRSPST As Recordset
Dim intYNW As Integer, intWRAPCREW As Integer
mboolSTPAY = False
' E Print Stone Order
' Ctrl-5 Reset to allow Brown To Be Reprinted (B_Flg, BrownP, BrownD)
' L Allow Reprint of Lath Pay Sheets
' This is turned off *** A Allow update of Address and Owner information on after Lot has been completed
' X Update Paint Square Footage
' T Print Paint Pay Sheets if not already done.
' J RePrint Wrap Pay Sheets
' S Reprint Stucco Pay Sheets
' M Resets the PO Flag to true
' W Update cost on the highlighted item in the Materials List
' Y Allow the reprint of the Lath Yard Order
' I Allow Lath Material Order to be reprinted
' F Turn On The Lath material
' R Turn on the RePrint Lath Button
' H ReSet The PreOrder info & Turn On The Print PreOrder Button
' D Turn on the Reprint PreorderY button
' G Print the Actual Report for Jesse
' N Turn on the Save Lot Info BUtton
' U Set flag for Stucco Cert
' Q Mark a lot option for Stone
' A Print a Stone Invoice
' O Update Stone Options to No Invoice
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = vbKey5 And gbytSECURITY < 3 Then ' Lath Pay Reprint.
If CtrlDown And SSTLotInfo.Tab = 1 Then
moRS!b_flg = False
moRS!BrownP = False
moRS!BrownD = False
moRS.Update
End If
Exit Sub
End If
If KeyCode = vbKeyO And gbytSECURITY < 3 Then ' Update No Invoice for Stone Option
' If CtrlDown And SSTLotInfo.Tab = 1 Then
If CtrlDown Then
Call UpInvoice
End If
Exit Sub
End If
If KeyCode = vbKeyL And gbytSECURITY < 3 Then ' Lath Pay Reprint.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdLathPay.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyA And gbytSECURITY < 3 Then ' Allow RePrint of Stone? Pay Sheets
If CtrlDown And SSTLotInfo.Tab = 6 Then
mboolSTPAY = True
Call POInvoice
' cmdLathPay.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyJ And gbytSECURITY < 3 Then ' Wrap Pay Reprint.
If CtrlDown And SSTLotInfo.Tab = 1 Then
strPAY = "SELECT * FROM tblPAYSHEET WHERE PAYID = 1"
Set moRSPay = New Recordset
moRSPay.Open strPAY, goConn, adOpenKeyset, adLockOptimistic
intYNW = MsgBox("Do You Want To Use A Crew Number With The Wrap PaySheet? Y or N)", vbYesNo, "Use Crew")
If intYNW = vbYes Then
intWRAPCREW = InputBox("Enter The Wrap Crew Number", "Wrap Crew", 0)
If intWRAPCREW = 0 Or IsNull(intWRAPCREW) Then
MsgBox "Must Enter A Valid Crew Number Greater Than Zero (0) - Will Exit Now", vbOKOnly, "Invalid Crew"
Exit Sub
Else
mintPAYCREW = Field2Str2(intWRAPCREW)
moRS!WCREW = Field2Str2(intWRAPCREW)
moRS.Update
mboolWRAPC = True
End If
Else
moRS!WCREW = 0
moRS.Update
End If
gintCOPY = 1
Call PrintWrapPay
End If
Exit Sub
End If
' If KeyCode = vbKeyA And gbytSECURITY < 8 Then ' Turn the address & owner field on & the SAVE Button
' If CtrlDown And SSTLotInfo.Tab = 0 Then
' txtAddress.Enabled = True
' txtOwner.Enabled = True
' cmdSaveLotInfo.Enabled = True
' End If
' Exit Sub
' End If
If KeyCode = vbKeyG And (gbytSECURITY < 7 Or gstrLOGIN = "TYF2" Or gstrLOGIN = "VHJ") Then ' Print Special Report for Jesse
' Dim intYN As Integer
If CtrlDown And SSTLotInfo.Tab = 1 Then
intYN = MsgBox("Do You Want To Print Jesse's Special Report?", vbYesNo, "Print Jesse's Report")
If intYN = vbNo Then
Exit Sub
End If
Call PrintActualJG
End If
Exit Sub
End If
If KeyCode = vbKeyU Then ' Make the Flag that Shows Stucco Cert Done - True
If CtrlDown Then
moRS!SCert = vbTrue
moRS.Update
End If
Exit Sub
End If
If KeyCode = vbKeyS And gbytSECURITY < 3 Then ' REPrint Stucco Pay.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdStuccoPay.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyW And gbytSECURITY < 3 Then ' HotKey to allow entering Cost On HighLited Iterm
If CtrlDown And SSTLotInfo.Tab = 2 Then
strINVNO = lstLMaterial.ItemData(lstLMaterial.ListIndex)
strSQL = "SELECT * FROM tblLotMatrl WHERE LOT_ID = " & gintLOTID & " AND INV_NO = " & strINVNO
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
strCOST = InputBox("Enter The Cost Amt. You Want To Fix", "Enter Cost", strCOST)
oRS!price = Field2Str2(strCOST)
oRS.Update
End If
Exit Sub
End If
If KeyCode = vbKeyY And gbytSECURITY < 3 Then ' RePrint Yard Ticket.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdIssue.Caption = "RePrint &Yard Ticket"
cmdIssue.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyZ And gbytSECURITY < 3 Then ' RePrint Actual REport.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdIssue.Caption = "RePrint Actual Rpt"
cmdIssue.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyI And gbytSECURITY < 3 Then ' Reprint Lath Material.
If CtrlDown And SSTLotInfo.Tab = 1 Then
Call PrintLathMat
gintCOPY = 1
End If
Exit Sub
End If
If KeyCode = vbKeyF And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdLFlag.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyR And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdRePrintL.Visible = True
End If
Exit Sub
End If
If KeyCode = vbKeyH And gbytSECURITY < 3 Then ' Reprint Preorder PreCut
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdPreOrderPrintPC.Enabled = True
End If
Exit Sub
End If
If KeyCode = vbKeyD And gbytSECURITY < 3 Then 'RePrint Yard Pre Order
If CtrlDown And SSTLotInfo.Tab = 1 Then
cmdPreOrderPrintY.Enabled = True
End If
Exit Sub
End If
If KeyCode = vbKeyE And gbytSECURITY < 3 Then ' Reprint Wrap
If CtrlDown And SSTLotInfo.Tab = 1 Then
Call cmdWrapPrint_Click
End If
Exit Sub
End If
If KeyCode = vbKeyN And (gbytSECURITY < 3 Or gbytSECURITY = 6) Then ' Display key combinations.
If CtrlDown Then
cmdSaveLotInfo.Enabled = True
cmdSaveLotInfo.SetFocus
End If
Exit Sub
End If
If Field2Str(moRS!l_FLG) <> "P" Then
If Not cmdSaveLotInfo.Enabled Then
Call DataHasChanged
End If
End If
End Sub
Private Sub DataHasChanged()
cmdSaveLotInfo.Enabled = True
cmdAddLot.Enabled = False
End Sub
Private Sub PrintActualJG()
Dim strDate As String, strSQL As String, intSUP As Integer, intYARDS As Integer
Dim oRS As Recordset, oRSS As Recordset, oRSSS As Recordset, intYN As Integer
Dim strSELECT As String, strOPTION As String, intCOUNT As Integer
Dim start
On Error GoTo Error_EH
strSELECT = "DELETE * FROM tblReport"
goConn.Execute strSELECT
strSELECT = "SELECT * FROM tblLOption WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
strOPTION = "SELECT * FROM tblReport"
Set oRSSS = New Recordset
oRSSS.Open strOPTION, goConn, adOpenKeyset, adLockOptimistic
oRSSS.AddNew
intCOUNT = 0
Do Until oRS.EOF
strSQL = "SELECT optid, yardage, desc FROM tblPOption where optid = " & Field2Str(oRS!Opt_ID)
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
intYARDS = intYARDS + Field2Integer(oRSS!Yardage)
intCOUNT = intCOUNT + 1
If intCOUNT = 1 Then
oRSSS!desc1 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 2 Then
oRSSS!desc2 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 3 Then
oRSSS!desc3 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 4 Then
oRSSS!desc4 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 5 Then
oRSSS!desc5 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 6 Then
oRSSS!desc6 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 7 Then
oRSSS!desc7 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 8 Then
oRSSS!desc8 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 9 Then
oRSSS!desc9 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
If intCOUNT = 10 Then
oRSSS!desc10 = Field2Str(oRSS!Yardage) & vbTab & Field2Str(oRSS!Desc)
End If
End If
oRS.MoveNext
Loop
oRSSS!Lot_ID = gintLOTID
oRSSS!optyds = intYARDS
oRSSS.Update
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
strSQL = "{tblReport.lot_id} = " & gintLOTID '& " and {tblLOTINFO.lot_id} = " & gintLOTID
start = Timer ' Set start time.
Do While Timer < start + 5
' DoEvents ' Yield to other processes.
Loop
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\actualJG.rpt"
' ElseIf moRSProj!cocode = 1 Then
' crOrder.ReportFileName = App.Path & "\actualM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSQL)
crOrder.CopiesToPrinter = gintCOPY
intYN = MsgBox("Do You Want To Print To The Printer", vbYesNo + vbDefaultButton2, "Printer or Screen")
If intYN = vbYes Then
crOrder.Destination = crptToPrinter
Else
crOrder.Destination = crptToWindow
End If
' crOrder.Destination = crptToWindow
crOrder.Action = 1
crOrder.Reset
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PrintActualJG"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdFindInv_Click()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long, strTYPE As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtLMInvNo.Text & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
With oRS
txtLMInvNo = Field2Str(!inv_no)
txtLMDesc = Field2Str(!Desc)
txtLMLength = Field2Integer(!calc_amt)
If !d_flag = "S" Then
cboLMDFlag.Text = "Supplier"
Else
cboLMDFlag.Text = "Yard"
End If
strTYPE = Field2Str(!m_type)
Call FindType(cboPOMType, strTYPE)
If !calc_flag = "M" Then
cboLMMetal.Text = "Metal"
Else
cboLMMetal.Text = "None"
End If
End With
txtLMQty.SetFocus
Else
Call cmdInventory_Click
lngFind = Field2Long(txtLMInvNo)
Call ListFindItem2(lstInventory, lngFind)
End If
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdFindInv_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdFindPlan_Click()
Dim oRS As Recordset, oRSSS As Recordset
Dim strSQL As String, lngFind As Long, strTEST As String
Dim strSql2 As String
On Error GoTo Error_EH
If gconACTION = 5 Then
Call LotChange(mstrPROJLOT, "Update After Lath")
gconACTION = 0
End If
strSQL = "SELECT * from tblPlans WHERE Mod_elv = '" & txtModel.Text & "' and proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not mboolAdding Then
txtYardMemo = Field2Str(txtYardMemo) & " - PLAN IMPORTED ON " & Now() & " BY " & gstrLOGIN & " "
moRSMemo!notes = UCase(Field2Str(txtYardMemo))
moRSMemo.Update
End If
If oRS.RecordCount > 0 Then
With oRS
' txtTtlYdge = Field2Integer(!TO_TTLYDS)
txtTtlYdge = Field2Integer(!mat_yds) 'Changed back per Jesse on 07/09/2018
txtModel = Field2Str(!Mod_Elv)
txtCMUYdge = Field2Integer(!CMUYDS)
txtNotes = Field2Str(!notes)
txtFoamAdj = Field2Integer(!f_adj)
If !HLNotes = True Then
mboolHLNotes = True
Else
mboolHLNotes = False
End If
' chkHLNote = Field2CheckBox(!HLNotes)
txtLaborAdj = Field2Integer(!l_adj)
txtWireAdj = Field2Integer(!w_adj)
txtFin2 = Field2Integer(!fin2)
txt28Foam = Field2Integer(!foam)
txtOPEN = Field2Integer(!opening)
chkStone = Field2CheckBox(!stone)
'*** Do We Need To Add Paint Here???
txtStone = Field2Str2(!ST_SQFT)
txtStoneBill = Field2Str2(!st_bill)
moRS!Scaf6 = Field2Str2(!Scaf6)
moRS!scaf10 = Field2Str2(!scaf10)
moRS!TWOSTORY = !TWOSTORY
moRS!openpr = Field2Str2(!openpr)
moRS!P_RL = Field2CheckBox(!P_RL)
Call FindTexture2(Field2Str(!texture), strTYPE)
txtFinish = strTYPE
If !texture = "SB" Then
chkSynthetic = vbChecked
lblSynthetic.Visible = True
End If
If moRSProj!stype = "S" Then
txtOneKote.Text = "Superwall"
ElseIf moRSProj!stype = "M" Then
txtOneKote.Text = "Pre Mix"
ElseIf moRSProj!stype = "T" Then
txtOneKote.Text = "Three Coat"
ElseIf moRSProj!stype = "N" Then
txtOneKote.Text = "Synthetic"
ElseIf moRSProj!stype = "B" Then
txtOneKote.Text = "Synthetic over 1 Kote"
ElseIf moRSProj!stype = "W" Then
txtOneKote.Text = "Western 1 Kote"
End If
If Not !Firsttime Then
!Firsttime = vbChecked
chkFirst = vbChecked
.Update
End If
gintESTID = !est_id
If Not mboolAdding Then
moRS!est_id = gintESTID
moRS!import = Date
moRS!imuser = gstrLOGIN
End If
Call FieldsSave
End With
' oRS.Update
'clear materials and get correct for model
'update materials and yardage for options
Else
Call PlanLoad
cmdFindPlan.Visible = False
If lstPlans.ListCount = 0 Then
MsgBox "There are no plans for this Project/Subdivision - Exit and Enter/Import Plans", , "No Plans"
cmdSaveLotInfo.Enabled = False
gstrFLAG = "P"
Unload Me
Exit Sub
Else
lstPlans.ListIndex = 0
lstPlans.SetFocus
oRS.Close
Exit Sub
End If
End If
oRS.Close
If mboolAdding Then
Call ElevLoad
Call PlanFind
Call FormShow
Call MatLoad
Call POptLoad
Call LOptLoad
Call OptMatLoad
Call OrderLoad
Call POLoad
mboolAdding = False
Else
Call ElevLoad
Call DelLotMat
Call PlanMatLoad
Call ReloadOptMat
Call MatLoad
Call POptLoad
Call LOptLoad
Call OptMatLoad
Call OrderLoad
Call cmdSaveLotInfo_Click
Call UpInvoice
Call cmdExit_Click
End If
Exit Sub
Error_EH:
Call ErrorHandler(oRSSS.ActiveConnection)
' gstrMODULE = "Form LotInfo5 - Module cmdFindPlan_Click"
' Call ErrorHandler2
' gstrMODULE = ""
Exit Sub
End Sub
Private Sub DelLotMat()
Dim strSQL As String
strSQL = "DELETE * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and ch_flag = " & vbUnchecked
goConn.Execute strSQL
End Sub
Private Sub ReloadOptMat()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblLOption where lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRS.EOF
mintOPTID = Field2Long(oRS!Opt_ID)
Call UpLotInfo
Call UpLMat
oRS.MoveNext
Loop
Exit Sub
Error_EH:
' Call ErrorHandler(oRSS.ActiveConnection)
gstrMODULE = "Form LotInfo5 - Module ReloadOptMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub cmdAddLot_Click()
Dim strSTARTDATE As String, lngPOS As Long
strSTARTDATE = InputBox("Enter the Builder's Start Date (MMDDYYYY)", "Start Date")
lngPOS = InStr(1, strSTARTDATE, "/", 1)
If Not IsDate(strSTARTDATE) Then
If lngPOS = 0 Then
If Len(strSTARTDATE) > 0 Then
strSTARTDATE = Format(strSTARTDATE, "00/00/####")
If Not IsDate(strSTARTDATE) Then
MsgBox "The Date You Entered is not Valid Now Exiting Add Lot"
' Call cmdExit_Click
mboolBAD = True
Exit Sub
End If
mstrSTARTDATE = strSTARTDATE
Else
MsgBox "The Date You Entered is not Valid Now Exiting Add Lot"
mboolBAD = True
Exit Sub
' Call cmdExit_Click
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - Exiting"
' Call cmdExit_Click
mboolBAD = True
Exit Sub
End If
Else
mstrSTARTDATE = strSTARTDATE
End If
mboolAdding = True
gconACTION = 0
gintLOTID = 0
txtJC.Enabled = True
cmdCalc.Enabled = False
cmdDelLot.Enabled = False
cmdAddLot.Enabled = False
cmdAddMatrl.Enabled = False
cmdDelMatrl.Enabled = False
cmdSaveMatrl.Enabled = False
cmdOptAdd.Enabled = False
cmdOptDel.Enabled = False
txtLotNo.Enabled = True
cmdSaveLotInfo.Enabled = True
cmdFindPlan.Enabled = True
cmdOrders.Enabled = True
Call LotNew
Call FormClear
Call MatClear
txtAddress.SetFocus
End Sub
Private Sub cmdAddMatrl_Click()
' lstLMaterial.ListIndex = -1
lstLMaterial.Enabled = False
' moRSMat.Update
' moRSMat.Close
Call MatClear
cmdAddMatrl.Enabled = False
cmdDelMatrl.Enabled = False
cmdSaveMatrl.Enabled = True
cmdInventory.Visible = True
lblMatInst.Visible = True
txtLMDesc.SetFocus
mboolAdding = True
End Sub
Private Sub cmdDelMatrl_Click()
Dim strYN As String
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
gconACTION = 3
mintBOOKMARK = lstLMaterial.ListIndex
moRSMat.Delete
Call LotChange(mstrPROJLOT, "Delete Material")
Call MatLoad
If lstLMaterial.ListCount Then
If lstLMaterial.ListCount > mintBOOKMARK Then
lstLMaterial.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
Else
lstLMaterial.ListIndex = mintBOOKMARK - 1
End If
End If
gconACTION = 0
cmdAddMatrl.Enabled = True
cmdDelMatrl.Enabled = False
cmdSaveMatrl.Enabled = False
End Sub
Private Sub cmdInventory_Click()
lstInventory.Visible = True
Call InventoryLoad
End Sub
Private Sub UpInvoice()
Dim strSQL As String, strSQLP As String
Dim oRS As Recordset, oRSP As Recordset
Dim lngOPTID As Long, OPTCNT As Integer, CNT As Integer
CNT = 0
OPTCNT = lstLOptions.ListCount
If lstLOptions.ListCount <> 0 Then
Do Until CNT = OPTCNT
strSQL = "SELECT * FROM tblLOption WHERE Opt_ID = " & lstLOptions.ItemData(lstLOptions.ListIndex) & " AND LOT_ID = " & gintLOTID
' strSQL = "SELECT * FROM tblLOption WHERE Opt_ID = " & lstLOptions.ItemData(lstLOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
strSQLP = "SELECT * FROM tblPOption WHERE OptID = " & lstLOptions.ItemData(lstLOptions.ListIndex)
Set oRSP = New Recordset
oRSP.Open strSQLP, goConn, adOpenDynamic, adLockOptimistic
If Not oRSP.EOF And oRSP!invoice Then
' If oRSP!invoice Then
oRS!invoice = vbTrue
oRS.Update
' End If
End If
End If
If lstLOptions.ListIndex + 1 <> OPTCNT Then
lstLOptions.ListIndex = lstLOptions.ListIndex + 1
End If
CNT = CNT + 1
Loop
End If
End Sub
Private Sub cmdOptAdd_Click()
Dim strSQL As String
Dim strSql2 As String, oRS As Recordset
On Error GoTo Error_EH
If moRSLOpt.State = adStateClosed Then
strSQL = "SELECT * FROM tblLOption where opt_id = 1"
Set moRSLOpt = New Recordset
moRSLOpt.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
End If
strSql2 = "SELECT * FROM tblPOption where optid = " & lstPOptions.ItemData(lstPOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
If lstPOptions.ListIndex <> -1 Then
moRSLOpt.AddNew
moRSLOpt!Lot_ID = gintLOTID
moRSLOpt!Opt_ID = lstPOptions.ItemData(lstPOptions.ListIndex)
mintOPTID = lstPOptions.ItemData(lstPOptions.ListIndex)
moRSLOpt!C_USER = gstrLOGIN
If oRS!ostone Then
moRSLOpt!ostone = vbChecked
moRSLOpt!invoice = vbChecked
' moRSLOpt.Update
End If
moRSLOpt.Update
If oRS!ostone Then
moRSLOpt!ostone = vbChecked
End If
lstPOptions.Enabled = True
Call UpLotInfo
Call UpLMat
Call LOptLoad
Call FieldsSave
Call MatSave
Call MatLoad
lstPOptions.ListIndex = -1
cmdOptAdd.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module cmdOptAdd_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdOptDel_Click()
Dim strSQL As String
gconACTION = 3
gintOPTID = lstLOptions.ItemData(lstLOptions.ListIndex)
Call LotChange(mstrPROJLOT, "Delete Lot Option")
Call UpdateLotInfo
Call UpdateLMat
Call MatSave
Call MatLoad
Call FieldsSave
strSQL = "DELETE * FROM tblLOption WHERE Lot_ID = " & gintLOTID & " and Opt_id = " & lstLOptions.ItemData(lstLOptions.ListIndex)
goConn.Execute strSQL
Call LOptLoad
cmdOptDel.Enabled = False
gconACTION = 0
If lstOptMatrl.ListCount > 0 Then
lstOptMatrl.Clear
If lstLOptions.ListCount > 0 Then
lstLOptions.ListIndex = 0
Call lstLOptions_Click
End If
End If
End Sub
Private Sub UpLMat()
Dim oRS As Recordset
Dim oRSS As Recordset
Dim oRSSS As Recordset
Dim strSQL As String, strSql2 As String, intOpt As Integer
Dim intLoop As Integer, strSQL3 As String
On Error GoTo Error_EH
strSQL = "SELECT Opt_ID, Lot_id "
strSQL = strSQL & "FROM tblLOption "
strSQL = strSQL & "WHERE Lot_id = " & gintLOTID & " and opt_id = " & mintOPTID 'lstPOptions.ItemData(lstPOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
oRS.MoveLast
oRS.MoveFirst
intOpt = oRS.RecordCount
For intLoop = 1 To intOpt
strSql2 = "SELECT inv_no, desc, D_Flag, M_Type, Calc_Flag, Calc_Amt, Qty FROM tblPOMatrl where Optid = " & mintOPTID 'lstPOptions.ItemData(lstPOptions.ListIndex)
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRSS.EOF
strSQL3 = "SELECT * from tblLotMatrl WHERE Inv_no = '" & oRSS!inv_no & "' and Lot_id = " & gintLOTID
Set oRSSS = New Recordset
oRSSS.Open strSQL3, goConn, adOpenForwardOnly, adLockOptimistic
If oRSSS.RecordCount = 0 Then
oRSSS.AddNew
oRSSS!Lot_ID = gintLOTID
oRSSS!inv_no = Field2Str(oRSS!inv_no)
oRSSS!Desc = Field2Str(oRSS!Desc)
oRSSS!d_flag = Field2Str(oRSS!d_flag)
oRSSS!m_type = Field2Str(oRSS!m_type)
oRSSS!calc_flag = Field2Str(oRSS!calc_flag)
oRSSS!calc_amt = Field2Integer(oRSS!calc_amt)
oRSSS!qty = Field2Str(oRSS!qty)
oRSSS.Update
' oRSSS.Close
Else
oRSSS!qty = (oRSSS!qty + oRSS!qty)
oRSSS.Update
' oRSSS.Close
End If
If moRSProj!FHA Then
If Field2Str(oRSSS!inv_no) = "1570" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRSSS!qty)
txtTake138 = moRS!jmb138
' txtTake138 = mintTake138
moRS.Update
End If
Else
If Field2Str(oRSSS!inv_no) = "1130" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRSSS!qty)
txtTake138 = moRS!jmb138
' txtTake138 = mintTake138
moRS.Update
End If
End If
oRSSS.Close
oRSS.MoveNext
Loop
Next intLoop
oRS.Close
oRSS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module UpLMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub UpdateLMat()
Dim oRS As Recordset
Dim oRSS As Recordset
Dim oRSSS As Recordset, intTEST As Integer
Dim strSQL As String, strSql2 As String, intOpt As Integer
Dim intLoop As Integer, strSQL3 As String
On Error GoTo Error_EH
strSQL = "SELECT Opt_ID, Lot_id "
strSQL = strSQL & "FROM tblLOption "
strSQL = strSQL & "WHERE Lot_id = " & gintLOTID & " and opt_id = " & gintOPTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
oRS.MoveLast
oRS.MoveFirst
intOpt = oRS.RecordCount
For intLoop = 1 To intOpt
strSql2 = "SELECT inv_no, desc, D_Flag, M_Type, Calc_Flag, Calc_Amt, Qty FROM tblPOMatrl where Optid = " & gintOPTID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
intTEST = oRSS.RecordCount
Do Until oRSS.EOF
strSQL3 = "SELECT * from tblLotMatrl WHERE Inv_no = '" & oRSS!inv_no & "' and Lot_id = " & gintLOTID
Set oRSSS = New Recordset
oRSSS.Open strSQL3, goConn, adOpenForwardOnly, adLockOptimistic
If oRSSS.RecordCount = 0 Then
Else
oRSSS!qty = (oRSSS!qty - oRSS!qty)
If oRSSS!qty <= 0 Then
oRSSS.Delete
Else
oRSSS.Update
End If
End If
If moRSProj!FHA Then
If Field2Str(oRSSS!inv_no) = "1570" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRSSS!qty)
txtTake138 = moRS!jmb138
' txtTake138 = mintTake138
moRS.Update
End If
Else
If Field2Str(oRSSS!inv_no) = "1130" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRSSS!qty)
txtTake138 = moRS!jmb138
' txtTake138 = mintTake138
moRS.Update
End If
End If
oRSSS.Close
oRSS.MoveNext
Loop
Next intLoop
oRS.Close
oRSS.Close
Exit Sub
Error_EH:
If Err = -2147217885 Then
Resume Next
Else
gstrMODULE = "Form LotInfo5 - Module UpdateLMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End If
End Sub
Private Sub UpdateLotInfo()
Dim oRS As Recordset, oRSE As Recordset, oRSL As Recordset, strSQLLO As String
Dim oRSS As Recordset, oRSSE As Recordset, strSQLE2 As String
Dim strSQL As String, strSql2 As String, strSQLE As String
On Error GoTo Error_EH
'******************** Need To Make Sure That STONE LotOptions have NoInvoice checked
strSQL = "SELECT * FROM tblPOption WHERE Optid = " & lstLOptions.ItemData(lstLOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRS!invoice Then
strSQLLO = "SELECT * FROM tblLOption WHERE Optid = " & lstLOptions.ItemData(lstLOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
End If
moRS!sq_yd = moRS!sq_yd - oRS!Yardage
txtTtlYdge = moRS!sq_yd
moRS!fin2 = moRS!fin2 - oRS!fin2
txtFin2 = moRS!fin2
moRS!f_adj = moRS!f_adj - oRS!f_adj
txtFoamAdj = moRS!f_adj
If oRS!texture <> "" Then
strSQL = "SELECT Texture "
strSQL = strSQL & "FROM tblPlans "
strSQL = strSQL & "WHERE Proj_id = " & gintPROJID & " and Mod_Elv = '" & txtModel.Text & "'"
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
moRS!texture = Field2Str(oRSS!texture)
Call FindTexture2(moRS!texture, strTYPE)
txtFinish = strTYPE
If moRS!texture <> "SB" Then
chkSynthetic = vbUnchecked
lblSynthetic.Visible = False
End If
End If
If oRS!FileName <> "" Then
strSQLE = "SELECT * FROM tblLotElev WHERE Primary and lot_id = " & gintLOTID
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenKeyset, adLockOptimistic
strSQLE2 = "SELECT * FROM tblElevation WHERE Primary and est_id = " & gintESTID
Set oRSSE = New Recordset
oRSSE.Open strSQLE2, goConn, adOpenKeyset, adLockOptimistic
If Not oRSE.EOF Then
oRSE!FileName = oRSSE!FileName
oRSE.Update
oRSE.Close
End If
oRSSE.Close
End If
If oRS!ostone Then
' moRS!stone = vbUnchecked
chkStone = vbUnchecked
moRS!ST_SQFT = moRS!ST_SQFT - oRS!OSt_SqFt
txtStoneBill = Val(txtStoneBill) - Field2Double(oRS!Amt)
txtStone = moRS!ST_SQFT
moRS!ostone = vbUnchecked
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module UpdateLotInfo"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub UpLotInfo()
Dim oRS As Recordset, oRSE As Recordset
Dim strSQL As String, strMSG As String, strSQLE As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblPOption WHERE Optid = " & mintOPTID 'lstPOptions.ItemData(lstPOptions.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRS.RecordCount = 0 Then
strMSG = "Option " & mintOPTID & " was not found and was not updated - Call Darv"
MsgBox strMSG, vbCritical + vbOKOnly, "Deleted Option"
Exit Sub
End If
moRS!sq_yd = moRS!sq_yd + oRS!Yardage
txtTtlYdge = moRS!sq_yd
moRS!fin2 = moRS!fin2 + oRS!fin2
txtFin2 = moRS!fin2
moRS!f_adj = moRS!f_adj + oRS!f_adj
txtFoamAdj = moRS!f_adj
If oRS!texture <> "" Then
moRS!texture = Field2Str(oRS!texture)
Call FindTexture2(moRS!texture, strTYPE)
txtFinish = strTYPE
If moRS!texture = "SB" Then
chkSynthetic = vbChecked
lblSynthetic.Visible = True
End If
End If
If oRS!FileName <> "" Then
strSQLE = "SELECT * FROM tblLotElev WHERE Primary and lot_id = " & gintLOTID
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenKeyset, adLockOptimistic
If Not oRSE.EOF Then
oRSE!FileName = oRS!FileName
oRSE.Update
oRSE.Close
End If
End If
If oRS!ostone Then
' moRS!stone = vbChecked
chkStone = vbChecked
moRS!ST_SQFT = moRS!ST_SQFT + oRS!OSt_SqFt
' = Val(txtStoneBill) + Field2Double(oRS!amt)
txtStoneBill = Val(txtStoneBill) + Field2Double(oRS!Amt)
txtStone = moRS!ST_SQFT
moRS!ostone = vbChecked
End If
If oRS.State = adStateOpen Then
oRS.Close
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module UpLotInfo"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If mboolCRITICAL Then
Exit Sub
End If
If gstrFLAG <> "D" Then
If gstrFLAG <> "P" Then
If cmdSaveLotInfo.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
End If
End If
If moRS.State = adStateOpen Then
moRS.Update
moRS.Close
End If
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
If moRSOptMat.State = adStateOpen Then
moRSOptMat.Close
End If
If moRSLOpt.State = adStateOpen Then
moRSLOpt.Close
End If
If moRSPOpt.State = adStateOpen Then
moRSPOpt.Close
End If
If moRSProj.State = adStateOpen Then
moRSProj.Close
End If
If moRSPlan.State = adStateOpen Then
moRSPlan.Close
End If
gintLOTID = 0
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
End If
End Sub
Private Sub cmdSaveLotInfo_Click()
If gconACTION = 4 Then
Call LotChange(mstrPROJLOT, "Change Lot Information")
gconACTION = 0
End If
If gconACTION = 5 Then
Call LotChange(mstrPROJLOT, "Update After Lath")
gconACTION = 0
End If
Call FieldsSave
Call MatSave
txtLotNo.Enabled = False
cmdSaveLotInfo.Enabled = False
If gstrLOGIN = "TYF" Or gstrLOGIN = "TYF2" Then
cmdAddLot.Enabled = False
Else
cmdAddLot.Enabled = True
End If
' cmdAddLot.Enabled = True
cmdAddMatrl.Enabled = True
cmdSaveMatrl.Enabled = False
cmdDelMatrl.Enabled = False
txtJC.Enabled = False
If gbytSECURITY = 1 Then
cmdDelLot.Enabled = True
End If
txtSuperBB = IIf(txtSuperBB = "", 0, txtSuperBB)
txtSuper12 = IIf(txtSuper12 = "", 0, txtSuper12)
If Field2Str(moRS!l_FLG) <> "P" Then
If txtSuperBB = 0 And txtSuper12 = 0 Then
cmdCalc.Enabled = False
Else
cmdCalc.Enabled = True
End If
End If
End Sub
Private Sub cmdSaveMatrl_Click()
If gconACTION = 6 Then
Call LotChange2(mstrPROJLOT, "Change Lot Material", txtLMDesc, mstrBEGQTY, mstrENDQTY)
' Call LotChange(mstrPROJLOT, "Change Lot Material")
gconACTION = 0
' End If
ElseIf gconACTION = 5 Then
' Call LotChange(mstrPROJLOT, "Update After Lath")
Call LotChange(mstrPROJLOT, "Update After Lath")
gconACTION = 0
End If
On Error GoTo Error_EH
mintBOOKMARK = lstLMaterial.ListIndex
' Store the controls to the recordset
Call MatSave
Call MatLoad
' mintINVNO = Field2Str2(moRSMat!inv_no)
If mboolAdding Then
mboolAdding = False
Call ListFindItemS5(lstLMaterial, (mintINVNO)) ', 4)
' Call ListFindItem(lstLMaterial, CLng(mintINVNO))
mintBOOKMARK = lstLMaterial.ListIndex
End If
cmdInventory.Visible = False
lblMatInst.Visible = False
If gconACTION <> 5 Then
cmdAddMatrl.Enabled = True
cmdDelMatrl.Enabled = False
cmdSaveMatrl.Enabled = False
lstLMaterial.Enabled = True
End If
lstLMaterial.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
lstLMaterial.SetFocus
Exit Sub
Error_EH:
Call ErrorHandler(moRSMat.ActiveConnection)
Exit Sub
End Sub
Private Sub cmdOrders_Click()
Call OrderLoad
End Sub
Private Sub Form_Load()
Dim strSQL As String, oRS As Recordset, strSQLL As String, lngINVID As Long
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Set moRS = New Recordset
Set moRSProj = New Recordset
Set moRSMat = New Recordset
Set moRSPOpt = New Recordset
Set moRSLOpt = New Recordset
Set moRSOptMat = New Recordset
Set moRSPlan = New Recordset
Set moRSPO = New Recordset
Set moRSPOMAT = New Recordset
Set moRSMemo = New Recordset
On Error GoTo Error_EH
mboolHLNotes = False
If gstrLOGIN = "TYF" Or gstrLOGIN = "TYF2" Then
cmdAddLot.Enabled = False
Else
cmdAddLot.Enabled = True
End If
gboolPSpecialCALC = False
gboolPULTE = False
' If moRS!P_RL Then
' gboolPSpecialCALC = True
' End If
strSQL = "SELECT * FROM tblSYSINFO"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
gdteUPDATE = oRS!LastUP - 30
' gdteUPDATE = oRS!LastUP - 45
strSQLL = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic
lngINVID = Field2Str2(moRSInvINFO!ARINVOICE_TRANS_ID)
mlngINVID = lngINVID
lngINVID = lngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = lngINVID
moRSInvINFO.Update
mboolSPLIT = False
mboolStone = False
gstrFLAG = ""
gstrPO = "L"
' gbytSECURITY = 1
SSTLotInfo.Tab = 0
mboolCRITICAL = False
If gbytSECURITY = 1 Then
cmdDelLot.Enabled = True
End If
' if
Call MTypeLoad(cboPOMType)
Call MTypeLoad(cboLMType)
Call MTypeLoad(cboLOMType)
Call ProjLoad
If mboolCOMM Then
txtSuperBB.Enabled = True
Else
txtSuperBB.Enabled = False
End If
If FormFind() Then
Call PlanFind
If mboolCRITICAL Then
Unload Me
Exit Sub
End If
If mboolStone Then
Call SetStone
End If
Call FormShow
Call MatLoad
Call POptLoad
Call LOptLoad
Call OptMatLoad
Call OrderLoad
Call POLoad
' Call POMatLoad
End If
If gintLOTID <> 0 Then
If IsNull(moRS!y_FLG) Then
cmdPreOrderPrintY.Enabled = True
End If
If mboolNOTSUPPLIER Then
moRS!s_FLG = "P"
moRS.Update
End If
If IsNull(moRS!s_FLG) Then
cmdPreOrderPrintS.Enabled = True
End If
If IsNull(moRS!z_FLG) Then
cmdPreOrderPrintPC.Enabled = True
End If
' If IsNull(moRS!l_flg) Then
' cmdLathPrint.Enabled = True
' ElseIf moRS!l_flg = "P" And Not moRS!a_flg Then
' cmdSandPrint.Enabled = True
' ElseIf moRS!a_flg And moRSProj!stype = "T" And Not moRS!c_flg Then
' cmdScratchPrint.Enabled = True
' ElseIf moRS!a_flg And Not moRS!b_flg Then
' cmdBrownPrint.Enabled = True
' ElseIf moRS!b_flg And Not moRS!t_flg Then
' cmdTexturePrint.Enabled = True
' ElseIf moRS!t_flg And chkStone And Not moRS!st_flg Then
' cmdStonePrint.Enabled = True
' End If
''' If IsNull(moRS!l_FLG) Then
''' cmdPrint.Caption = "Print Lath Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!l_FLG = "P" And Not moRS!a_flg Then
''' cmdPrint.Caption = "Print Sand Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!a_flg And Not moRS!b_flg Then
''' cmdPrint.Caption = "Print Brown Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!a_flg And Not moRS!c_flg And moRSProj!stype = "T" Then
''' cmdPrint.Caption = "Print Scratch Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!b_flg And Not moRS!t_flg Then
''' cmdPrint.Caption = "Print Texture Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!t_flg And chkStone And Not moRS!st_flg Then
''' cmdPrint.Caption = "Print Stone Order"
''' cmdPrint.Enabled = True
''' Else
''' cmdPrint.Caption = "All Orders Printed"
''' cmdPrint.Enabled = False
''' End If
If IsNull(moRS!l_FLG) Then
''' cmdPrint.Caption = "Print Lath Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!l_FLG = "P" And Not moRS!a_flg Then
''' cmdPrint.Caption = "Print Sand Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!a_flg And Not moRS!b_flg Then
ElseIf moRS!l_FLG = "P" And Not moRS!b_flg Then
moRS!LathD = vbTrue
moRS!LathP = vbTrue
moRS!WrapD = vbTrue
moRS!WrapP = vbTrue
moRS.Update
''' cmdPrint.Caption = "Print Brown Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!a_flg And Not moRS!c_flg And moRSProj!stype = "T" Then
''' cmdPrint.Caption = "Print Scratch Order"
''' cmdPrint.Enabled = True
ElseIf moRS!b_flg And Not moRS!t_flg Then
moRS!BrownP = vbTrue
moRS!BrownD = vbTrue
moRS!LathD = vbTrue
moRS!LathP = vbTrue
moRS!WrapD = vbTrue
moRS!WrapP = vbTrue
moRS.Update
''' ElseIf moRS!t_flg Then
''' cmdPrint.Caption = "Print Texture Order"
''' cmdPrint.Enabled = True
''' ElseIf moRS!t_flg And chkStone And Not moRS!st_flg Then
''' cmdPrint.Caption = "Print Stone Order"
''' cmdPrint.Enabled = True
Else
moRS!TexP = vbTrue
moRS!TexD = vbTrue
moRS!BrownP = vbTrue
moRS!BrownD = vbTrue
moRS!LathD = vbTrue
moRS!LathP = vbTrue
moRS!WrapD = vbTrue
moRS!WrapP = vbTrue
moRS.Update
''' cmdPrint.Caption = "All Orders Printed"
''' cmdPrint.Enabled = False
End If
txtSuperBB = IIf(txtSuperBB = "", 0, txtSuperBB)
txtSuper12 = IIf(txtSuper12 = "", 0, txtSuper12)
If Field2Str(moRS!l_FLG) <> "P" Then
If txtSuper12 = 0 And txtSuperBB = 0 Then
cmdCalc.Enabled = False
Else
cmdCalc.Enabled = True
End If
End If
End If
If gbytSECURITY <= 6 Then
cmdEdit.Visible = True
cmdEdit.Enabled = True
End If
'' If chkHoldOrders Then
'' cmdSaveLotInfo.Enabled = False
'' If gbytSECURITY > 3 Then
'' chkHoldOrders.Enabled = False
'' chkHoldOrders.BackColor = &H80FFFF
'' Else
'' chkHoldOrders.Enabled = True
'' chkHoldOrders.BackColor = &H80FFFF
'' End If
'' Else
'' chkHoldOrders.Enabled = True
'' End If
' If chkSplit Then
' cmdSaveLotInfo.Enabled = False
' If gbytSECURITY > 3 Then
' chkSplit.Enabled = False
' chkSplit.BackColor = &H80FFFF
' Else
' chkSplit.Enabled = True
' chkSplit.BackColor = &H80FFFF
' End If
' Else
' chkSplit.Enabled = True
' End If
'' If chkHoldPO Then
'' cmdSaveLotInfo.Enabled = False
'' If gbytSECURITY > 3 Then
'' chkHoldPO.Enabled = False
'' chkHoldPO.BackColor = &H80FFFF
'' Else
'' chkHoldPO.Enabled = True
'' chkHoldPO.BackColor = &H80FFFF
'' End If
'' Else
'' chkHoldPO.Enabled = True
'' End If
If chkSynthetic Then
cmdSaveLotInfo.Enabled = False
If gbytSECURITY > 3 Then
chkSynthetic.Enabled = False
chkSynthetic.BackColor = &H80FFFF
Else
chkSynthetic.Enabled = True
chkSynthetic.BackColor = &H80FFFF
End If
End If
If chkStone Then
cmdSaveLotInfo.Enabled = False
If chkOthers Then
lblStone.Caption = "Stone By Others"
chkOthers.BackColor = &HFF
Else
lblStone.Caption = "Stone Veneer"
End If
If gbytSECURITY > 3 Then
chkStone.Enabled = False
chkStone.BackColor = &H80FFFF
Else
chkStone.Enabled = True
chkStone.BackColor = &H80FFFF
End If
End If
If gbytSECURITY = 6 And lstPO.ListCount > moRSProj!pomax Then
cmdAddPO.Enabled = False
cmdSavePO.Enabled = False
cmdDelPO.Enabled = False
cmdPrintPO.Enabled = False
cmdPrintForm.Enabled = False
cmdDelPOMat.Enabled = False
cmdSavePOMat.Enabled = False
cmdAddPOMat.Enabled = False
End If
' Call ListChanges
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjLoad()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID
moRSProj.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
If moRSProj!cont_id = 864 Or moRSProj!cont_id = 146 Then
mboolPULTE = True
Else
mboolPULTE = False
End If
If moRSProj!stone Then
mboolStone = True
End If
If moRSProj!Pulte Then
gboolPULTE = True
End If
If moRSProj!Apt Then
mboolCOMM = True
Else
mboolCOMM = False
End If
If moRSProj!P_SW Then
mboolPSW = True
Else
mboolPSW = False
End If
mstrWIRE = Field2Str(moRSProj!wire)
mstrTAXCODE = Field2Str(moRSProj!taxcode)
gintCOCODE = Field2Str2(moRSProj!cocode)
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PlanLoad()
Dim oRS As Recordset
Dim strSQL As String, strTEST As String
On Error GoTo Error_EH
strSQL = "SELECT mod_elv, Est_id from tblplans WHERE proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPlans.Clear
Do Until oRS.EOF
With lstPlans
.AddItem Field2Str(oRS!Mod_Elv)
.ItemData(.NewIndex) = oRS!est_id
End With
lstPlans.Visible = True
lblPlan.Visible = True
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module PlanLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
gintLOTID = moRS!Lot_ID
txtProject = Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc
If moRSProj!bb Then
lblBB.Caption = "This House Uses Blackboard"
Else
lblBB.Caption = "This House Uses R-Guard"
End If
If moRSProj!zmetal Then
lblZMetal.Visible = True
Else
lblZMetal.Visible = False
End If
With moRS
lblSZone = Field2Str2(!zone)
lblSandShip = Field2Str2(!ORD_NO)
txtTake138 = Field2Integer(!jmb138)
txtCalc138 = Field2Integer(!jmb138)
txtTtlYdge = Field2Integer(!sq_yd)
txtAddress = Field2Str(!address)
txtOwner = Field2Str(!Owner)
txtModel = Field2Str(!model)
txtCMUYdge = Field2Integer(!CMU)
txtNotes = Field2Str(!notes)
If !HLNotes And Len(txtNotes) > 0 Then
txtNotes.ForeColor = &HFF&
txtNotes.BackColor = &H80FFFF
Else
txtNotes.ForeColor = &H80000008
txtNotes.BackColor = &H80000005
End If
txtSuperNotes = Field2Str(!supernotes)
txtLotNotes = Field2Str(!lotnotes)
txtFoamAdj = Field2Integer(!f_adj)
txtLaborAdj = Field2Integer(!l_adj)
txtWireAdj = Field2Integer(!w_adj)
txtFin2 = Field2Integer(!fin2)
txtLotNo = Field2Str(!lot_no)
txt28Foam = Field2Integer(!foam)
txtStone = Field2Str2(!ST_SQFT)
txtOPEN = Field2Str2(!opening)
chkFirst = Field2CheckBox(!Firsttime)
txtMetal = Field2Double(!METAL)
txtSand = Field2Integer(!sand_ton)
txtSuperBB = Field2Integer(!SUP_BB)
txtSuper12 = Field2Integer(!SUP_FD12)
txtSuper1383 = Field2Integer(!SUP_138)
If CInt(txtSuper1383) < 0 Then
txtSuper1383 = 0
End If
txtSuper783 = Field2Integer(!SUP_783)
txtSuper78 = Field2Integer(!SUP_78)
txtSuper38 = Field2Integer(!SUP_38)
' txtSuperRL = Field2Integer(!SUP_RL)
txtSuperML = Field2Integer(!SUP_ML)
txtSuperDW = Field2Integer(!SUP_DW)
txtSuperSP = Field2Integer(!SUP_SP)
txtLathO = IIf(Field2Str(!lorder) = "12:00:00 AM", "", Field2Str(!lorder))
If txtLathO = "" Then
txtLathO = "12/31/2030"
End If
txtSandO = IIf(Field2Str(!Border) = "12:00:00 AM", "", Field2Str(!Border))
txtScratchO = IIf(Field2Str(!TORDER) = "12:00:00 AM", "", Field2Str(!TORDER))
txtBrownO = IIf(Field2Str(!forder) = "12:00:00 AM", "", Field2Str(!forder))
txtTextureO = IIf(Field2Str(!SORDER) = "12:00:00 AM", "", Field2Str(!SORDER))
txtLathBill = IIf(Field2Str(!VOrder) = "12:00:00 AM", "", Field2Str(!VOrder))
txtStoneBill = Field2Str2(!st_bill)
txtJC = Field2Str(!jobcost)
' chkHoldOrders = Field2CheckBox(!hold_stucco)
' chkHoldPO = Field2CheckBox(!hold_po)
chkPaint = Field2CheckBox(!PNT_FLG)
chkSynthetic = Field2CheckBox(!syn_flag)
chkStone = Field2CheckBox(!stone)
chkOthers = Field2CheckBox(!otstone)
chkNoPay = Field2CheckBox(!nopayissue)
Call FindTexture2(Field2Str(!texture), strTYPE)
txtFinish = strTYPE
If !texture = "SB" Then
chkSynthetic = vbChecked
lblSynthetic.Visible = True
End If
End With
If moRSProj!stype = "S" Then
txtOneKote.Text = "Superwall"
ElseIf moRSProj!stype = "M" Then
txtOneKote.Text = "Pre Mix"
ElseIf moRSProj!stype = "T" Then
txtOneKote.Text = "Three Coat"
ElseIf moRSProj!stype = "C" Then
txtOneKote.Text = "Synthetic"
ElseIf moRSProj!stype = "B" Then
txtOneKote.Text = "Synthetic over 1 Kote"
ElseIf moRSProj!stype = "W" Then
txtOneKote.Text = "Western 1 Kote"
ElseIf moRSProj!stype = "N" Then
txtOneKote.Text = "San Man"
End If
If moRS!l_FLG = "P" Then
txtTtlYdge.Enabled = False
txtCMUYdge.Enabled = False
txtStone.Enabled = False
txtLotNo.Enabled = False
cmdAddMatrl.Enabled = False
cmdDelMatrl.Enabled = False
cmdSaveMatrl.Enabled = False
cmdOptDel.Enabled = False
cmdDelLot.Enabled = False
cmdSaveLotInfo.Enabled = False
cmdFindPlan.Enabled = False
cmdOrders.Enabled = False
cmdCalc.Enabled = False
txtYardMemo.Enabled = True
txtYardMemo.Locked = True
' txtYardMemo.Enabled = False
' cmdUpCMU.Enabled = False
' cmdPrintCMU.Enabled = False
Call LotPrinted
End If
If moRS!Firsttime Then
lblFirst.Visible = True
End If
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub LotPrinted()
txtAddress.Enabled = False
txtOwner.Enabled = False
txtModel.Enabled = False
txtNotes.Enabled = False
txtFoamAdj.Enabled = False
txtLaborAdj.Enabled = False
txtWireAdj.Enabled = False
txtFin2.Enabled = False
txt28Foam.Enabled = False
txtSuperBB.Enabled = False
txtSuper12.Enabled = False
txtSuper783.Enabled = False
txtSuper78.Enabled = False
txtSuper38.Enabled = False
txtSuper1383.Enabled = False
txtSuperRL.Enabled = False
txtSuperML.Enabled = False
txtSuperDW.Enabled = False
txtSuperSP.Enabled = False
lblLathPrint.Visible = True
cmdPreOrderPrintY.Enabled = False
cmdPreOrderPrintS.Enabled = False
End Sub
Private Sub LotRePrinted()
txtAddress.Enabled = True
txtOwner.Enabled = True
txtModel.Enabled = True
txtNotes.Enabled = True
txtFoamAdj.Enabled = True
txtLaborAdj.Enabled = True
txtWireAdj.Enabled = True
txtFin2.Enabled = True
txt28Foam.Enabled = True
If mboolCOMM Then
txtSuperBB.Enabled = True
Else
txtSuperBB.Enabled = False
End If
txtSuper12.Enabled = True
txtSuper783.Enabled = True
txtSuper78.Enabled = True
txtSuper38.Enabled = True
' txtSuper1383.Enabled = True
' txtSuperRL.Enabled = True
' txtSuperML.Enabled = True
' txtSuperDW.Enabled = True
txtSuperSP.Enabled = True
lblLathPrint.Visible = False
cmdPreOrderPrintY.Enabled = True
cmdPreOrderPrintS.Enabled = True
''' cmdPrint.Enabled = True
End Sub
Private Sub LotNew()
txtAddress.Enabled = True
txtOwner.Enabled = True
txtModel.Enabled = True
txtNotes.Enabled = True
txtFoamAdj.Enabled = True
txtLaborAdj.Enabled = True
txtWireAdj.Enabled = True
txtFin2.Enabled = True
txt28Foam.Enabled = True
If mboolCOMM Then
txtSuperBB.Enabled = True
Else
txtSuperBB.Enabled = False
End If
' txtSuperBB.Enabled = True
txtSuper12.Enabled = True
txtSuper783.Enabled = True
txtSuper78.Enabled = True
txtSuper38.Enabled = True
' txtSuper1383.Enabled = True
' txtSuperRL.Enabled = True
' txtSuperML.Enabled = True
' txtSuperDW.Enabled = True
txtSuperSP.Enabled = True
txtSuperBB = IIf(txtSuperBB = "", 0, txtSuperBB)
txtSuper12 = IIf(txtSuper12 = "", 0, txtSuper12)
txtSuperSP = IIf(txtSuperSP = "", 0, txtSuperSP)
txtSuperDW = IIf(txtSuperDW = "", 0, txtSuperDW)
' txtSuperRL = IIf(txtSuperRL = "", 0, txtSuperRL)
txtSuperML = IIf(txtSuperML = "", 0, txtSuperML)
txtSuper38 = IIf(txtSuper38 = "", 0, txtSuper38)
txtSuper78 = IIf(txtSuper78 = "", 0, txtSuper78)
txtSuper783 = IIf(txtSuper783 = "", 0, txtSuper783)
txtSuper1383 = IIf(txtSuper1383 = "", 0, txtSuper1383)
lblLathPrint.Visible = False
lblFirst.Visible = False
End Sub
Private Sub FormShowMat()
Dim strTYPE As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSMat
txtLMInvNo = Field2Str(!inv_no)
txtLMDesc = Field2Str(!Desc)
txtLMQty = Field2Str(!qty)
If CInt(txtLMQty) < 0 Then
' txtLMQty = Format(txtLMQty, "(####)")
txtLMQty.ForeColor = &HFF&
txtLMQty.FontBold = True
Else
txtLMQty.ForeColor = &H0&
txtLMQty.FontBold = False
End If
txtLMLength = Field2Integer(!calc_amt)
txtLMBalance = Field2Str(!o_qty)
chkChange = Field2CheckBox(!ch_flag)
If !d_flag = "S" Then
cboLMDFlag.Text = "Supplier"
Else
cboLMDFlag.Text = "Yard"
End If
strTYPE = Field2Str(!m_type)
Call FindType(cboLMType, strTYPE)
If !calc_flag = "M" Then
cboLMMetal.Text = "Metal"
Else
cboLMMetal.Text = "None"
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowOpt()
On Error GoTo Error_EH
mboolSHOW = True
With moRSPOpt
txtLOYdge = Field2Integer(!Yardage)
txtLODesc = Field2Str(!Desc)
txtLOFin2 = Field2Integer(!fin2)
txtLOFoam = Field2Integer(!f_adj)
lblBillingAmt = Field2Integer(!Amt)
txtNote = Field2Str(!notes)
chkOStone = Field2CheckBox(!ostone)
txtOST_SqFt = Field2Str2(!OSt_SqFt)
Call FindTexture2(Field2Str(!texture), strTYPE)
txtLOTexture = strTYPE
' lblOptNum = "# " & Trim(Field2Str(moRSLOpt!Opt_ID))
' lblOptNum = "# " & Trim(Field2Str(!Opt_ID))
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowPOpt()
Dim strDNU As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSPOpt2
txtNote2 = Field2Str(!notes)
If Left(Field2Str(!Desc), 3) = "DNU" Then
mboolDNU = True
Else
mboolDNU = False
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowPOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowPO()
Dim bytPOType As Byte
On Error GoTo Error_EH
mboolSHOW = True
With moRSPO
gintPONUM = Field2Long(!ponum)
txtPONum = Field2Long(!ponum)
txtIssueTo = Field2Str(!towhom)
txtPODesc = Field2Str(!Desc)
txtPONotes = Field2Str(!notes)
txtPODate = Field2Str(!Date)
txtPay = Field2Str2(!yards)
txtPayType = Field2Str(!payflag)
txtPOType = Field2Str(!potype)
gstrPO = txtPOType
bytPOType = Field2Str2(!Opt_Type)
End With
If bytPOType = 1 Then
optLath = True
ElseIf bytPOType = 2 Then
optStucco = True
ElseIf bytPOType = 3 Then
optSand = True
ElseIf bytPOType = 4 Then
optPreOrder = True
ElseIf bytPOType = 5 Then
optStone = True
ElseIf bytPOType = 6 Or bytPOType = 0 Then
optNone = True
End If
If moRSPO!p_flg = "P" Then
cmdPrintPO.Enabled = False
Else
cmdPrintPO.Enabled = True
End If
mboolSHOW = False
If Field2Integer(txtPay) > 0 And Not moRSPO!pay_flag Then
cmdPrintPOPay.Enabled = True
Else
cmdPrintPOPay.Enabled = False
End If
Select Case txtPOType
Case "L"
lblIssueTo = "Invoice Description:"
txtIssueTo.Visible = True
lblIssueTo.Visible = True
lblDesc = "Pay Description:"
txtPODesc.Visible = True
lblDesc.Visible = True
lblPayYds = "Pay Yards:"
txtPay.Visible = True
lblPayYds.Visible = True
txtPayType.Visible = True
Case "Y"
lblIssueTo.Visible = False
txtIssueTo.Visible = False
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
Case "V"
lblIssueTo = "Mileage:"
txtIssueTo.Visible = True
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
Case "M"
lblIssueTo = "Person Requesting:"
txtIssueTo.Visible = True
lblDesc = "Supplier:"
txtPODesc.Visible = True
lblPayYds.Visible = False
txtPay.Visible = False
txtPayType.Visible = False
End Select
Call CBFindString1(cboPOType, txtPOType)
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowPO"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowOptMat()
Dim strTYPE As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSOptMat
txtLOMInvNo = Field2Str(!inv_no)
txtLOMDesc = Field2Str(!Desc)
txtLOMQty = Field2Str(!qty)
If CInt(txtLOMQty) < 0 Then
' txtLMQty = Format(txtLMQty, "(####)")
txtLOMQty.ForeColor = &HFF&
txtLOMQty.FontBold = True
Else
txtLOMQty.ForeColor = &H0&
txtLOMQty.FontBold = False
End If
txtLOMLength = Field2Integer(!calc_amt)
If !d_flag = "S" Then
cboLOMDFlag.Text = "Supplier"
' cboLOMDFlag.ListIndex = 0
Else
cboLOMDFlag.Text = "Yard"
' cboLOMDFlag.ListIndex = 1
End If
strTYPE = Field2Str(!m_type)
Call FindType(cboLOMType, strTYPE)
If !calc_flag = "M" Then
cboLOMetal.Text = "Metal"
Else
cboLOMetal.Text = "None"
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowOptMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowPOMat()
Dim strTYPE As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSPOMAT
txtPOInvNo = Field2Str(!inv_no)
txtPOMatDesc = Field2Str(!Desc)
txtPOQty = Field2Str(!qty)
txtPOPrice = Format(Field2Str2(!price), "#,#.00")
If !d_flag = "S" Then
cboPODFlag.Text = "Supplier"
Else
cboPODFlag.Text = "Yard"
End If
strTYPE = Field2Str(!m_type)
Call FindType(cboPOMType, strTYPE)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormShowPOMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
If IsNull(txtModel) Then
MsgBox "You Must Enter a Model/Elevation Before Saving", vbOKOnly, "Model Required"
Exit Sub
ElseIf Trim$(txtModel) = "" Then
MsgBox "You Must Enter a Model/Elevation Before Saving", vbOKOnly, "Model Required"
Exit Sub
End If
' If mboolAdding Then
' moRS.AddNew
' End If
' Store the controls to the recordset
Call FieldsSave
moRS.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRS.ActiveConnection)
Exit Sub
End Sub
Private Sub ToggleButtons()
cmdSaveLotInfo.Enabled = Not cmdSaveLotInfo.Enabled
' cmdAddLot.Enabled = Not cmdAddLot.Enabled
cmdDelLot.Enabled = Not cmdDelLot.Enabled
End Sub
Private Sub TextChanged()
If Not mboolSHOW Then
If Not cmdSaveLotInfo.Enabled Then
If gstrLOGIN = "TYF" Or gstrLOGIN = "TYF2" Then
cmdAddLot.Enabled = False
Else
cmdAddLot.Enabled = True
End If
Call ToggleButtons
End If
End If
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String, strMEMO As String
Dim strSQLB As String, oRSB As Recordset
On Error GoTo Error_EH
strMEMO = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strMEMO, goConn, adOpenKeyset, adLockOptimistic
If moRSMemo.RecordCount > 0 Then
txtYardMemo = Field2Str(moRSMemo!notes)
Else
moRSMemo.AddNew
moRSMemo!Lot_ID = gintLOTID
moRSMemo!notes = ""
moRSMemo.Update
txtYardMemo = ""
End If
strSQL = "SELECT * FROM tblLotInfo WHERE Lot_ID = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRS.EOF Then
FormFind = False
Else
FormFind = True
mstrTexture = moRS!texture
If moRS!HLNotes = True Then
mboolHLNotes = True
Else
mboolHLNotes = False
End If
mboolSTONE3 = False
mstrPROJLOT = moRSProj!Proj_Code & " " & moRSProj!Proj_Desc & " " & moRS!lot_no
mstrPLNELEV = Field2Str(moRS!model)
If moRS!P_RL Then
gboolPSpecialCALC = True
End If
If moRS!Split Then
mboolSPLIT = False '*** Changed from true to false on 7/21/2017 because discontinued split orders
Else
mboolSPLIT = False
End If
strSQLB = "SELECT * FROM tblPlanBill WHERE Proj_ID = " & Field2Str2(moRSProj!PROJ_ID) & " AND Mod_Elv = '" & mstrPLNELEV & "'"
Set oRSB = New Recordset
oRSB.Open strSQLB, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSB.EOF Then
If IsNull(oRSB!st_code) Then
mboolSTONE3 = True
Else
mboolSTONE3 = False
End If
End If
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub LotLoad()
Dim strSQL As String
strSQL = "SELECT * " & "FROM tblLotInfo WHERE Lot_ID = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
End Sub
Private Sub PlanFind()
Dim oRS As Recordset
Dim strSQL As String, strPlan As String, strTEST As String
On Error GoTo Open_EH
mintOpenPR = 0
' strSQL = "SELECT * "
strSQL = "SELECT est_id, verified, update, OpenPR FROM tblPlans WHERE Proj_ID = " & gintPROJID & " and Mod_Elv = """ & moRS!model & """"
If moRSPlan.State = adStateOpen Then
moRSPlan.Close
End If
moRSPlan.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If Not moRSPlan.EOF Then
mboolVERIFIED = moRSPlan!verified
mintOpenPR = Field2Integer(moRSPlan!openpr)
gintESTID = moRSPlan!est_id
If moRSProj!FHA Then
strPlan = "SELECT qty FROM tblPlanMat where EST_ID = " & gintESTID & " and INV_NO = '1570'"
Else
strPlan = "SELECT qty FROM tblPlanMat where EST_ID = " & gintESTID & " and INV_NO = '1130'"
End If
Set oRS = New Recordset
If oRS.State = adStateOpen Then
oRS.Close
End If
oRS.Open strPlan, goConn, _
adOpenForwardOnly, adLockPessimistic
If oRS.EOF Then
mintTake138 = 0
Else
moRS!jmb138 = oRS!qty
' mintTake138 = oRS!qty
End If
oRS.Close
Else
MsgBox "This lot does not have a valid plan - Call Darv", , "Critical Error"
mboolCRITICAL = True
End If
Exit Sub
Open_EH:
gstrMODULE = "Form LotInfo5 - Module PlanFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindPOpt() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOption "
strSQL = strSQL & "WHERE OPTID = " & lstLOptions.ItemData(lstLOptions.ListIndex)
If moRSPOpt.State = adStateOpen Then
moRSPOpt.Close
End If
moRSPOpt.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPOpt.EOF Then
FormFindPOpt = False
Else
FormFindPOpt = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindPOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindPOpt2() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT notes, optid, desc "
strSQL = strSQL & "FROM tblPOption "
strSQL = strSQL & "WHERE OPTID = " & lstPOptions.ItemData(lstPOptions.ListIndex)
Set moRSPOpt2 = New Recordset
moRSPOpt2.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPOpt2.EOF Then
FormFindPOpt2 = False
Else
FormFindPOpt2 = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindPOpt2"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindPO() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOrder "
strSQL = strSQL & "WHERE ponum = " & lstPO.ItemData(lstPO.ListIndex)
If moRSPO.State = adStateOpen Then
moRSPO.Close
End If
moRSPO.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPO.EOF Then
FormFindPO = False
Else
FormFindPO = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FindPO"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindLOpt() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
lblOptNum = "# " & lstLOptions.ItemData(lstLOptions.ListIndex)
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblLOption "
strSQL = strSQL & "WHERE Lot_id = " & gintLOTID
Set moRSLOpt = New Recordset
moRSLOpt.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSLOpt.EOF Then
FormFindLOpt = False
Else
FormFindLOpt = True
gintOPTID = moRSLOpt!Opt_ID
' lblOptNum = "# " & lstLOptions.ItemData(Index)
' lblOptNum = "# " & Trim(Field2Str(moRSLOpt!Opt_ID))
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindLOpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindOptMat() As Boolean
Dim strSQL As String, strINVNO As String
On Error GoTo Error_EH
lstOptMatrl.col = 4
strINVNO = lstOptMatrl.ColText
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOMatrl "
strSQL = strSQL & "WHERE OPTID = " & lstLOptions.ItemData(lstLOptions.ListIndex) & " and Inv_No = '" & strINVNO & "'"
' strSQL = strSQL & "WHERE OPTID = " & lstLOptions.ItemData(lstLOptions.ListIndex) & " and Inv_No = " & lstOptMatrl.ItemData(lstOptMatrl.ListIndex)
If moRSOptMat.State = adStateOpen Then
moRSOptMat.Close
End If
moRSOptMat.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSOptMat.EOF Then
FormFindOptMat = False
Else
FormFindOptMat = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindOptMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindPOMat() As Boolean
Dim strSQL As String, strINVNO As String
On Error GoTo Error_EH
lstPOMaterial.col = 3
strINVNO = lstPOMaterial.ColText
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOrdMat "
strSQL = strSQL & "WHERE ponum = " & lstPO.ItemData(lstPO.ListIndex) & " and Inv_No = '" & strINVNO & "'"
' strSQL = strSQL & "WHERE ponum = " & lstPO.ItemData(lstPO.ListIndex) & " and Inv_No = " & lstPOMaterial.ItemData(lstPOMaterial.ListIndex)
If moRSPOMAT.State = adStateOpen Then
moRSPOMAT.Close
End If
moRSPOMAT.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPOMAT.EOF Then
FormFindPOMat = False
Else
FormFindPOMat = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindPOMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindMat() As Boolean
Dim strSQL As String, strINVNO As String
On Error GoTo Error_EH
lstLMaterial.col = 4
strINVNO = lstLMaterial.ColText
Set moRSMat = New Recordset
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblLotMatrl "
strSQL = strSQL & "WHERE LOT_ID = " & gintLOTID & " AND INV_NO = '" & strINVNO & "'"
' strSQL = strSQL & "WHERE LOT_ID = " & gintLOTID & " AND INV_NO = " & lstLMaterial.ItemData(lstLMaterial.ListIndex)
moRSMat.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' intTest = moRSMat.RecordCount
If moRSMat.EOF Then
FormFindMat = False
Else
FormFindMat = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FormFindMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub FieldsSave()
Dim strLOT As String, strTYPE As String, intOpenPR As Integer, intUSEOpen As Integer
Dim dblOPEN As Double, intDELETE As Integer, int1383 As Integer
On Error GoTo Error_EH
If mboolAdding Then
moRS.AddNew
moRS!PROJ_ID = gintPROJID
moRS!createuser = gstrLOGIN
moRS!est_id = gintESTID
moRS!import = Date
moRS!imuser = gstrLOGIN
moRS!startdate = Str2Field(mstrSTARTDATE)
moRS!openpr = mintOpenPR
End If
If Field2Integer(moRS!sq_yd) > 1 Then
intOpenPR = Field2Integer(moRS!openpr)
intUSEOpen = 90 - intOpenPR ' This is primarly for labor
' intMATOpen = Int(40 - intOpenPR) ' 02/08/2020 Changed to 40% to give more materials yardage
' dblWRAP = Int(Field2Double(moRS!opening))
' dblWRAP = Int(((Field2Double(moRS!opening) * intOpenPR) / 100) + 0.99)
dblOPEN = Int(((Field2Double(moRS!opening) * intUSEOpen) / 100) + 0.99)
' dblOPEN = Int((Field2Double(moRS!opening) * 0.5) + 0.99)
If moRSProj!use_open Then
''' If Field2Integer(moRS!sq_yd) > 500 Then Changed to match MATCALCONE
' If Field2Integer(moRS!sq_yd) > 400 Then '*********** changed per Jesse 10/13/12
' intDELETE = Int((Field2Integer(moRS!sq_yd) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(moRS!sq_yd) * 0.05) + 0.99) ' Change for Jesse 06/14/05
' intDELETE = 19 ' Changed by Jesse 07/13/18
''' intDELETE = 0
''' moRS!l_yds = (Field2Integer(moRS!sq_yd) - dblOPEN) - 5 - intDELETE
''' moRS!s_yds = (Field2Integer(moRS!sq_yd) - dblOPEN) - 5 - intDELETE
''' Else
' moRS!l_yds = (Field2Integer(moRS!sq_yd) - dblOPEN) - 19
' moRS!s_yds = (Field2Integer(moRS!sq_yd) - dblOPEN) - 24
moRS!l_yds = (Field2Integer(moRS!sq_yd)) - 5 - dblOPEN 'Change per Jesse 08/22/05
moRS!s_yds = (Field2Integer(moRS!sq_yd)) - 5 - dblOPEN 'Change per Jesse 08/22/05
'' moRS!l_yds = (Field2Integer(moRS!sq_yd)) ' - 10 'Change per Jesse 10/13/12
' moRS!s_yds = (Field2Integer(moRS!sq_yd)) ' - 15 'Change per Jesse 10/13/12
''' End If
Else
''' If Field2Integer(moRS!sq_yd) > 500 Then
' If Field2Integer(moRS!sq_yd) > 400 Then '*********** changed per Jesse 10/13/12
' intDELETE = Int((Field2Integer(moRS!sq_yd) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(moRS!sq_yd) * 0.05) + 0.99) ' Change for Jesse 06/14/05
' intDELETE = 19 ' Changed by Jesse 07/13/18
''' intDELETE = 0
''' moRS!l_yds = Field2Integer(moRS!sq_yd) - 5 - intDELETE
''' moRS!s_yds = Field2Integer(moRS!sq_yd) - 5 - intDELETE
''' Else
' moRS!s_yds = Field2Integer(moRS!sq_yd) - 10
moRS!l_yds = Field2Integer(moRS!sq_yd) - 5
moRS!s_yds = Field2Integer(moRS!sq_yd) - 5
' moRS!l_yds = (Field2Integer(moRS!sq_yd)) ' - 10 'Change per Jesse 10/13/12
' moRS!s_yds = (Field2Integer(moRS!sq_yd)) ' - 15 'Change per Jesse 10/13/12
''' End If
End If
End If
With moRS
If mboolHLNotes Then
!HLNotes = vbChecked
Else
!HLNotes = vbUnchecked
End If
!zone = Integer2Field(moRSProj!zone)
!sq_yd = Integer2Field(txtTtlYdge)
!address = Str2Field(txtAddress)
!Owner = Str2Field(txtOwner)
!model = Str2Field(txtModel)
!CMU = Integer2Field(txtCMUYdge)
!notes = Str2Field(txtNotes)
!supernotes = Str2Field(txtSuperNotes)
!lotnotes = Str2Field(txtLotNotes)
!f_adj = Integer2Field(txtFoamAdj)
!l_adj = Integer2Field(txtLaborAdj)
!w_adj = Integer2Field(txtWireAdj)
!fin2 = Integer2Field(txtFin2)
!lot_no = Str2Field(txtLotNo)
!foam = Integer2Field(txt28Foam)
!lorder = Date2Field(txtLathO)
!SUP_BB = Integer2Field(txtSuperBB)
!SUP_FD12 = Integer2Field(txtSuper12)
!SUP_783 = Integer2Field(txtSuper783)
!SUP_78 = Integer2Field(txtSuper78)
!SUP_38 = Integer2Field(txtSuper38)
' !SUP_138 = Integer2Field(txtSuper1383)
int1383 = Integer2Field(txtSuper1383)
If int1383 < 0 Then
!SUP_138 = 0
Else
!SUP_138 = Integer2Field(txtSuper1383)
End If
' !SUP_RL = Integer2Field(txtSuperRL)
!SUP_ML = Integer2Field(txtSuperML)
!SUP_DW = Integer2Field(txtSuperDW)
!SUP_SP = Integer2Field(txtSuperSP)
!opening = Integer2Field(txtOPEN)
!sand_ton = Integer2Field(txtSand)
!SORDER = Str2Field(txtTextureO)
!Border = Str2Field(txtSandO)
!TORDER = Str2Field(txtScratchO)
!forder = Str2Field(txtBrownO)
!VOrder = Str2Field(txtLathBill)
!st_bill = Double2Field(txtStoneBill)
!jobcost = Str2Field(txtJC)
'' !hold_stucco = chkHoldOrders
'' !hold_po = chkHoldPO
!PNT_FLG = chkPaint
!LUUser = gstrLOGIN
!Update = Date
!Firsttime = chkFirst
!syn_flag = chkSynthetic
!stone = chkStone
!otstone = chkOthers
!ST_SQFT = Integer2Field(txtStone)
Call FindTexture(txtFinish, strTYPE)
!texture = strTYPE
End With
moRS.Update
If mboolAdding Then
Call GetLotID
Call PlanMatLoad
Call POptLoad
Call JCSetup
If FormFind() Then
Call FormShow 'xxxxxxxxxxxxxxxxxx
End If
mboolAdding = False
End If
moRSMemo!notes = Field2Str(txtYardMemo)
moRSMemo.Update
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
strLOT = InputBox("Enter a New Lot Number", "Fix Duplicate")
If Len(strLOT) > 0 Then
moRS!lot_no = Field2Str(strLOT)
txtLotNo = Field2Str(strLOT)
txtJC = Field2Str(moRSProj!jccode) & Format(Left(Field2Str(txtLotNo), 3), "000")
moRS!jobcost = Field2Str(txtJC)
moRS.Update
End If
Resume Next
End If
gstrMODULE = "Form LotInfo5 - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetLotID()
Dim oRSMAX As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT Max(Lot_ID) as MAXLotid from tblLotInfo"
Set oRSMAX = New Recordset
oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
gintLOTID = oRSMAX!maxLotid
oRSMAX.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module GetLotID"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetPlanInfo()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
mboolPLANUP = False
strSQL = "SELECT Est_Id, Update from tblPlans WHERE Est_Id = " & moRS!est_id
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
mstrPLANUP = Field2Str(oRS!Update)
' mboolVERIFIED = oRS!verified
If mstrPLANUP > Field2Str(moRS!import) Then
mboolPLANUP = True
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module GetPlanInfo"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub POSave()
Dim strSQL As String, strMAX As String
Dim oRS As Recordset, oRSS As Recordset
Dim bytPOType As Byte
On Error GoTo Error_EH
If optLath Then
bytPOType = 1
ElseIf optStucco Then
bytPOType = 2
ElseIf optSand Then
bytPOType = 3
ElseIf optPreOrder Then
bytPOType = 4
ElseIf optStone Then
bytPOType = 5
Else
bytPOType = 6
End If
If moRSPO.State = adStateClosed Then
strSQL = "SELECT * FROM tblPOrder WHERE ponum = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
oRS.AddNew
With oRS
!PROJ_ID = gintPROJID
!Lot_ID = gintLOTID
!towhom = Str2Field(txtIssueTo)
!Desc = Str2Field(txtPODesc)
!Opt_Type = bytPOType
!Date = Str2Field(txtPODate)
!User = gstrLOGIN
!Up_User = gstrLOGIN
!Update = Date
!notes = Str2Field(txtPONotes)
!yards = Str2Field(txtPay)
!payflag = Str2Field(txtPayType)
!potype = Left(cboPOType.Text, 1)
End With
oRS.Update
oRS.Close
Call POLoad
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
End If
If mboolAdding Then
moRSPO.AddNew
moRSPO!User = gstrLOGIN
End If
With moRSPO
!PROJ_ID = gintPROJID
!Lot_ID = gintLOTID
!towhom = Str2Field(txtIssueTo)
!Desc = Str2Field(txtPODesc)
!Update = Date
!Up_User = gstrLOGIN
!Date = Str2Field(txtPODate)
!notes = Str2Field(txtPONotes)
!yards = Str2Field(txtPay)
!payflag = Str2Field(txtPayType)
!potype = Left(cboPOType.Text, 1)
End With
moRSPO.Update
Exit Sub
Error_EH:
Call ErrorHandler(moRSPO.ActiveConnection)
Exit Sub
End Sub
Private Sub POMatSave()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
If moRSPOMAT.State = adStateClosed Then
strSQL = "SELECT * FROM tblPOrdMat WHERE ponum = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
oRS.AddNew
With oRS
!Lot_ID = gintLOTID
!ponum = mintPONUM
!inv_no = Str2Field(txtPOInvNo)
!Desc = Str2Field(txtPOMatDesc)
!qty = Str2Field(txtPOQty)
!price = Str2Field(txtPOPrice)
!m_type = Left$(cboPOMType.Text, 1)
If cboPODFlag.Text = "Supplier" Then
!d_flag = "S"
ElseIf cboPODFlag.Text = "Yard" Then
!d_flag = "Y"
End If
End With
oRS.Update
oRS.Close
Call OptMatLoad
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
End If
If mboolAdding Then
moRSPOMAT.AddNew
End If
With moRSPOMAT
!Lot_ID = gintLOTID
!ponum = mintPONUM
!inv_no = Str2Field(txtPOInvNo)
!Desc = Str2Field(txtPOMatDesc)
!qty = Str2Field(txtPOQty)
!price = Str2Field(txtPOPrice)
!m_type = Left$(cboPOMType.Text, 1)
If cboPODFlag.Text = "Supplier" Then
!d_flag = "S"
ElseIf cboPODFlag.Text = "Yard" Then
!d_flag = "Y"
End If
End With
moRSPOMAT.Update
Exit Sub
Error_EH:
Call ErrorHandler(moRSPOMAT.ActiveConnection)
Exit Sub
End Sub
Private Sub MatSave()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
' If moRSMat.State = adStateOpen Then
If moRSMat.State = adStateClosed Then
Exit Sub
End If
strSQL = moRSMat.RecordCount
With moRSMat
If moRSMat.EOF Then
End If
If mboolAdding Then
.AddNew
!Lot_ID = gintLOTID
End If
!inv_no = Str2Field(txtLMInvNo.Text)
!Desc = Str2Field(txtLMDesc.Text)
!qty = Str2Field(txtLMQty.Text)
!calc_amt = Integer2Field(txtLMLength.Text)
!o_qty = Integer2Field(txtLMBalance.Text)
!ch_flag = chkChange
!m_type = Left$(cboLMType.Text, 1)
If cboLMDFlag.Text = "Supplier" Then
!d_flag = "S"
ElseIf cboLMDFlag.Text = "Yard" Then
!d_flag = "Y"
End If
If cboLMMetal.Text = "Metal" Then
!calc_flag = "M"
Else
!calc_flag = ""
!calc_amt = 0
End If
End With
mintINVNO = Field2Str2(txtLMInvNo)
moRSMat.Update
Exit Sub
Error_EH:
' If Err = -2147217885 Then
If Err = -2147217864 Then
Resume Next
Else
gstrMODULE = "Form LotInfo5 - Module MatSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End If
End Sub
Private Sub FormClear()
moRSMemo.Close
txtLotNotes = ""
txtYardMemo = ""
txtSuperNotes = ""
txtTtlYdge = 0
txtAddress = ""
txtOwner = ""
txtModel = ""
txtCMUYdge = 0
chkFirst = vbUnchecked
txtNotes = ""
txtNotes.ForeColor = &H80000008
txtNotes.BackColor = &H80000005
txtFoamAdj = 0
txtLaborAdj = 0
txtWireAdj = 0
txtFin2 = 0
txtLotNo = ""
txt28Foam = 0
txtLathO = "12/31/2030"
txtMetal = 0
txtOPEN = 0
txtSuperBB = 0
txtSuper12 = 0
txtSuper783 = 0
txtSuper78 = 0
txtSuper38 = 0
txtSuper1383 = 0
txtSuperRL = 0
txtSuperML = 0
txtSuperDW = 0
txtSuperSP = 0
' txtLathO = ""
txtSandO = ""
txtScratchO = ""
txtBrownO = ""
txtTextureO = ""
txtLathBill = ""
txtStoneBill = 0
txtFinish.Text = ""
txtTake138 = 0
txtOneKote.Text = ""
lstLath.Clear
lstYard.Clear
lstPreOrder.Clear
lstLMaterial.Clear
lstInventory.Clear
lstPOptions.Clear
lstLOptions.Clear
lstOptMatrl.Clear
lstPO.Clear
lstPOMaterial.Clear
lstBrown.Clear
lstScratch.Clear
lstTexture.Clear
txtLOYdge = 0
txtLODesc = ""
txtLOFin2 = 0
txtLOFoam = 0
txtLOMInvNo = 0
txtLOMDesc = ""
txtLOMQty = ""
txtSand = 0
txtLOMLength = 0
cboLOMDFlag.ListIndex = -1
cboLOMDFlag.Text = ""
cboLOMType.ListIndex = -1
cboLOMType.Text = ""
cboLOMetal.ListIndex = -1
cboLOMetal.Text = ""
gintOPTID = 0
' txtLODate.Enabled = False
' chkHoldOrders = vbUnchecked
' chkHoldOrders.Enabled = True
' chkHoldPO = vbUnchecked
' chkHoldPO.Enabled = True
chkPaint = vbUnchecked
chkSynthetic = vbUnchecked
chkSynthetic.Enabled = True
chkStone = vbUnchecked
chkOthers = vbUnchecked
chkNoPay = vbUnchecked
chkStone.Enabled = True
txtStone = 0
lblFirst.Visible = False
lblSZone = ""
lblSandShip = ""
End Sub
Private Sub MatLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT LOT_id, Inv_no, Desc, Qty, D_Flag, M_Type, Calc_Flag from tblLOTMatrl WHERE lot_id = " & gintLOTID & " ORDER BY Inv_No"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstLMaterial.Clear
Do Until oRS.EOF
With lstLMaterial
strLine = oRS("D_Flag") & vbTab & oRS("M_Type") & vbTab & oRS("Calc_Flag") & vbTab & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc")
.AddItem strLine
' .ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.Close
If lstLMaterial.ListCount Then
lstLMaterial.ListIndex = 0
Else
txtLMInvNo = "0"
txtLMDesc = ""
txtLMQty = "0"
txtLMLength = "0"
cboLMDFlag.ListIndex = -1
cboLMType.ListIndex = -1
cboLMMetal.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module MatLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FIXTypar()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String, strINVNO As String
On Error GoTo Error_EH
strSQL = "SELECT LOT_id, Inv_no, Desc, Qty, D_Flag, M_Type, Calc_Flag from tblLOTMatrl WHERE lot_id = " & gintLOTID & " ORDER BY Inv_No"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockPessimistic
' lstLMaterial.Clear
Do Until oRS.EOF
strINVNO = Field2Str(oRS!inv_no)
If strINVNO = "3331" Or strINVNO = "1809" Or strINVNO = "1570" Or strINVNO = "1565" Or strINVNO = "1730" Or strINVNO = "1904" Or strINVNO = "1906" Or strINVNO = "7104" Or strINVNO = "7106" Or strINVNO = "1831" Then
oRS!d_flag = "S"
oRS!m_type = "W"
oRS.Update
End If
oRS.MoveNext
Loop
oRS.Close
' If lstLMaterial.ListCount Then
' lstLMaterial.ListIndex = 0
' Else
' txtLMInvNo = "0"
' txtLMDesc = ""
' txtLMQty = "0"
' txtLMLength = "0"
' cboLMDFlag.ListIndex = -1
' cboLMType.ListIndex = -1
' cboLMMetal.ListIndex = -1
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module FIXTypar"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProcessRpt()
Dim strSELECT As String
With moRS
' strSELECT = !model
If !superp And Not !superd Then
mboolSupP = True
mboolNoPrint = False
' Else
' mboolSupP = False
' mboolNoPrint = True
' End If
ElseIf !WrapP And Not !WrapD Then
mboolWrapP = True
mboolNoPrint = False
' Else
' mboolWrapP = False
' mboolNoPrint = True
' End If
ElseIf !LathP And Not !LathD Then
mboolLathP = True
mboolNoPrint = False
' Else
' mboolLathP = False
' mboolNoPrint = True
' End If
ElseIf !StoneP And Not !StoneD Then
mboolStoneP = True
mboolNoPrint = False
ElseIf !NescoP And Not !NescoD Then
mboolNescoP = True
mboolNoPrint = False
' Else
' mboolNescoP = False
' mboolNoPrint = True
' End If
ElseIf !PopoutP And Not !PopOutD Then
mboolPopOutP = True
mboolNoPrint = False
' Else
' mboolPopOutP = False
' mboolNoPrint = True
' End If
ElseIf !BrownP And Not !BrownD Then
mboolBrownP = True
mboolNoPrint = False
' Else
' mboolBrownP = False
' mboolNoPrint = True
' End If
ElseIf !TexP And Not !TexD Then
mboolTexP = True
mboolNoPrint = False
' Else
' mboolTexP = False
' mboolNoPrint = True
' End If
ElseIf !CMUP And Not !CMUD Then
mboolCMUP = True
mboolNoPrint = False
' Else
' mboolCMUP = False
' mboolNoPrint = True
' End If
ElseIf !EX1P And Not !EX1D Then
mboolEX1P = True
mboolNoPrint = False
' Else
' mboolEX1P = False
' mboolNoPrint = True
' End If
ElseIf !EX2P And Not !EX2D Then
mboolEX2P = True
mboolNoPrint = False
' Else
' mboolEX2P = False
' mboolNoPrint = True
' End If
ElseIf !EX3P And Not !EX3D Then
mboolEX3P = True
mboolNoPrint = False
Else
' mboolEX3P = False
mboolNoPrint = True
End If
End With
End Sub
Private Sub POMatLoad()
Dim oRS As Recordset
Dim strSQL As String, intINVNO As Integer
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT PONum, Inv_no, Desc, Qty, D_Flag, M_Type FROM tblPOrdMat WHERE PONum = " & mintPONUM & " ORDER BY Inv_No"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPOMaterial.Clear
Do Until oRS.EOF
With lstPOMaterial
strLine = oRS("D_Flag") & vbTab & oRS("M_Type") & vbTab & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc")
' strLine = oRS("D_Flag") & " " & oRS("M_Type") & " " & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc")
.AddItem strLine
' .ItemData(.NewIndex) = Field2Str(oRS("inv_no"))
If mboolAdding Then
' intINVNO = Field2Integer(txtPOInvNo)
If Field2Str(txtPOInvNo) = Field2Str(oRS!inv_no) Then
mintBOOKMARK = .ListIndex
End If
End If
End With
oRS.MoveNext
Loop
oRS.Close
If lstPOMaterial.ListCount Then
lstPOMaterial.ListIndex = 0
Else
txtPOInvNo = "0"
txtPOMatDesc = ""
txtPOQty = "0"
cboPODFlag.ListIndex = -1
cboPOMType.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module POMatLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PlanMatLoad()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
Dim strLine As String, intCOUNT As Integer
On Error GoTo Error_EH
strSQL = "SELECT * from tblPlanMat WHERE est_id = " & gintESTID & " ORDER BY Inv_No"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
strSQLL = "SELECT * from tblLotMatrl WHERE lot_id = 0"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic
intCOUNT = oRSS.RecordCount
Do Until oRS.EOF
oRSS.AddNew
oRSS!Lot_ID = gintLOTID
oRSS!inv_no = Field2Str(oRS!inv_no)
oRSS!Desc = Field2Str(oRS!Desc)
oRSS!d_flag = Field2Str(oRS!d_flag)
oRSS!m_type = Field2Str(oRS!m_type)
oRSS!calc_flag = Field2Str(oRS!calc_flag)
oRSS!calc_amt = Field2Integer(oRS!calc_amt)
oRSS!qty = Field2Str2(oRS!qty)
' oRSS!price = 0
oRSS!price = Field2Str2(oRS!price)
oRSS.Update
If moRSProj!FHA Then
If Field2Str(oRS!inv_no) = "1570" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRS!qty)
txtTake138 = Field2Str(moRS!jmb138)
' txtTake138 = mintTake138
End If
Else
If Field2Str(oRS!inv_no) = "1130" Then
' mintTake138 = Field2Str(oRS!qty)
moRS!jmb138 = Field2Str(oRS!qty)
txtTake138 = Field2Str(moRS!jmb138)
' txtTake138 = mintTake138
End If
End If
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
If Err = "-2147467259" Then
Resume Next
Else
Call ErrorHandler(oRSS.ActiveConnection)
Exit Sub
End If
' Resume Next
End Sub
Private Sub InventoryLoad()
Dim oRS As Recordset
Dim strSQL As String, strINVNO As String
Dim strLine As String
On Error GoTo Error_EH
lstInventory.col = 0
strINVNO = lstInventory.ColText
strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE inv_type = " & gbytINV_TYPE & " ORDER BY Inv_no"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInventory.Clear
Do Until oRS.EOF
With lstInventory
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInventory.ListCount Then
lstInventory.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module InventoryLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OptMatLoad()
Dim oRS As Recordset
Dim strSQL As String, strSELECT As String
Dim strLine As String
On Error GoTo Error_EH
If lstLOptions.ListIndex = -1 Then
lstOptMatrl.ListIndex = -1
Exit Sub
End If
strSELECT = lstLOptions.ItemData(lstLOptions.ListIndex)
strSQL = "SELECT OPTID, Inv_no, Desc, Qty, D_Flag, M_Type, Calc_Flag from tblPOMatrl WHERE optid = " & strSELECT 'gintOPTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstOptMatrl.Clear
Do Until oRS.EOF
With lstOptMatrl
strLine = oRS("D_Flag") & vbTab & oRS("M_Type") & vbTab & oRS("Calc_Flag") & vbTab & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc")
.AddItem strLine
' .ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.Close
If lstOptMatrl.ListCount Then
lstOptMatrl.ListIndex = 0
Else
txtLOMInvNo = "0"
txtLOMDesc = ""
txtLOMQty = "0"
txtLOMLength = "0"
cboLOMDFlag.ListIndex = -1
cboLOMDFlag.Text = ""
cboLOMType.ListIndex = -1
cboLOMType.Text = ""
cboLOMetal.ListIndex = -1
cboLOMetal.Text = ""
lstOptMatrl.ListIndex = -1
End If
Exit Sub
Error_EH:
If Err = 381 Then
strSELECT = 0
cmdOptDel.Enabled = False
Resume Next
End If
End Sub
Private Sub POptLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT OPTID, Opt_No, Desc, Yardage from tblPOption WHERE Est_id = " & gintESTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPOptions.Clear
Do Until oRS.EOF
With lstPOptions
strLine = oRS("Yardage") & vbTab & oRS("desc")
.AddItem strLine
.ItemData(.NewIndex) = oRS("OPTID")
End With
oRS.MoveNext
Loop
oRS.Close
If lstPOptions.ListCount Then
lstPOptions.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module POptLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub POLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT ponum from tblPOrder WHERE lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPO.Clear
Do Until oRS.EOF
With lstPO
.AddItem oRS!ponum
.ItemData(.NewIndex) = oRS!ponum
End With
oRS.MoveNext
Loop
oRS.Close
If lstPO.ListCount Then
lstPO.ListIndex = 0
mintPONUM = lstPO.ItemData(lstPO.ListIndex)
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module POLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub LOptLoad()
Dim oRS As Recordset
Dim strSQL As String, intLoop As Integer, intPos As Integer
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT OPT_ID from tblLOption WHERE Lot_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstLOptions.Clear
Do Until oRS.EOF
With lstLOptions
For intLoop = 0 To lstPOptions.ListCount - 1
If lstPOptions.ItemData(intLoop) = oRS!Opt_ID Then
.AddItem (lstPOptions.List(intLoop))
.ItemData(.NewIndex) = oRS!Opt_ID
End If
Next intLoop
End With
oRS.MoveNext
Loop
oRS.Close
If lstLOptions.ListCount Then
lstLOptions.ListIndex = 0
gintOPTID = lstLOptions.ItemData(lstLOptions.ListIndex)
Else
lstLOptions.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module LOptLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstInventory_DblClick()
Dim oRS As Recordset, strINVNO As String
Dim strSQL As String, strTYPE As String
On Error GoTo Error_EH
lstInventory.col = 0
strINVNO = lstInventory.ColText
' strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Calc_Flag, Calc_Amt from tblInvtry where Inv_no = " & lstInventory.ItemData(lstInventory.ListIndex)
strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Calc_Flag, Calc_Amt from tblInvtry where Inv_no = '" & strINVNO & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
With oRS
txtLMInvNo = Field2Str(!inv_no)
txtLMDesc = Field2Str(!Desc)
txtLMLength = Field2Integer(!calc_amt)
If !d_flag = "S" Then
cboLMDFlag.Text = "Supplier"
Else
cboLMDFlag.Text = "Yard"
End If
strTYPE = !m_type
Call FindType(cboLMType, strTYPE)
If !calc_flag = "M" Then
cboLMMetal.Text = "Metal"
Else
cboLMMetal.Text = "None"
End If
End With
oRS.Close
lstInventory.Visible = False
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module lstInventory_DblClick"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstLMaterial_DblClick()
cmdAddMatrl.Enabled = False
cmdSaveMatrl.Enabled = True
cmdDelMatrl.Enabled = True
End Sub
Private Sub lstLookup_DblClick()
Dim oRS As Recordset, strINVNO As String
Dim strSQL As String, strTYPE As String
On Error GoTo Error_EH
lstLOOKUP.col = 0
strINVNO = lstLOOKUP.ColText
' strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Price from tblInvtry where Inv_no = " & lstLOOKUP.ItemData(lstLOOKUP.ListIndex)
strSQL = "SELECT Inv_no, Desc, D_Flag, M_Type, Price from tblInvtry where Inv_no = '" & strINVNO & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
With oRS
txtPOInvNo = Field2Str(!inv_no)
txtPOMatDesc = Field2Str(!Desc)
txtPOPrice = Field2Str2(!price)
If !d_flag = "S" Then
cboPODFlag.Text = "Supplier"
Else
cboPODFlag.Text = "Yard"
End If
strTYPE = !m_type
Call FindType(cboPOMType, strTYPE)
End With
txtPOQty.SetFocus
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module lstLookup_dblClick"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstLOptions_Click()
On Error GoTo Error_EH
If lstLOptions.ListIndex <> -1 Then
If FormFindPOpt() Then
Call FormShowOpt
Call OptMatLoad
If lstOptMatrl.ListIndex <> -1 Then
If FormFindOptMat() Then
Call FormShowOptMat
Else
lstOptMatrl.Clear
txtLOMInvNo = "0"
txtLOMDesc = ""
txtLOMQty = "0"
txtLOMLength = "0"
cboLOMDFlag.Text = ""
cboLOMType.Text = ""
cboLOMetal.Text = ""
End If
End If
Else
lstLOptions.Clear
txtLOYdge = "0"
txtLODesc = ""
txtLOFin2 = "0"
txtLOFoam = "0"
txtLOTexture = ""
End If
If FormFindLOpt() Then
' lblOptNum = "# " & Trim(Field2Str(moRSLOpt!Opt_ID))
End If
Else
cmdOptDel.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module lstLOptions_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstLOptions_DblClick()
If IsNull(moRS!l_FLG) Or gconACTION = 5 Then
cmdOptDel.Enabled = True
cmdOptAdd.Enabled = False
End If
End Sub
Private Sub lstOptMatrl_Click()
On Error GoTo Error_EH
If lstOptMatrl.ListIndex <> -1 Then
If FormFindOptMat() Then
Call FormShowOptMat
Else
lstOptMatrl.Clear
txtLOMInvNo = "0"
txtLOMDesc = ""
txtLOMQty = "0"
txtLOMLength = "0"
cboLOMDFlag.Text = ""
cboLOMType.Text = ""
cboLOMetal.Text = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module lstOptMatrl_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstLMaterial_Click()
On Error GoTo Error_EH
If lstLMaterial.ListIndex <> -1 Then
If FormFindMat() Then
Call FormShowMat
Else
lstLMaterial.Clear
txtLMInvNo = "0"
txtLMDesc = ""
txtLMQty = "0"
txtLMLength = "0"
cboLMDFlag.ListIndex = -1
cboLMType.ListIndex = -1
cboLMMetal.ListIndex = -1
' cboLMDFlag.Text = ""
' cboLMType.Text = ""
' cboLMMetal.Text = ""
txtLMBalance = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module lstLMaterial_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPO_DblClick()
'' If chkHoldPO Then
'' MsgBox "All PO's Are On Hold - OK to View - No Processing", vbOKOnly, "PO's on Hold"
'' Exit Sub
'' End If
If moRSPO!p_flg = "P" Then
gconACTION = 2
End If
' If gbytSECURITY <> 6 And lstPO.ListCount > 4 Then
If gbytSECURITY <> 6 And lstPO.ListCount > moRSProj!pomax Then
cmdSavePO.Enabled = True
cmdDelPO.Enabled = False
cmdAddPO.Enabled = False
cmdAddPOMat.Enabled = False
cmdDelPOMat.Enabled = False
cmdSavePOMat.Enabled = False
cmdPrintPO.Enabled = False
End If
End Sub
Private Sub lstPOMaterial_Click()
On Error GoTo Error_EH
If lstPOMaterial.ListIndex <> -1 Then
If FormFindPOMat() Then
Call FormShowPOMat
Else
lstPOMaterial.Clear
txtPOInvNo = "0"
txtPOMatDesc = ""
txtPOQty = "0"
cboPODFlag.ListIndex = -1
cboPOMType.ListIndex = -1
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module lstPOMaterial_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPO_Click()
On Error GoTo Error_EH
If lstPO.ListIndex <> -1 Then
If FormFindPO() Then
mintPONUM = lstPO.ItemData(lstPO.ListIndex)
Call FormShowPO
Call POMatLoad
If lstPOMaterial.ListIndex <> -1 Then
If FormFindPOMat() Then
Call FormShowPOMat
Else
lstPOMaterial.Clear
txtPOInvNo = "0"
txtPOMatDesc = ""
txtPOQty = "0"
cboPODFlag.ListIndex = -1
cboPOMType.ListIndex = -1
End If
End If
Else
lstPO.Clear
txtPONum = "0"
txtPODesc = ""
txtIssueTo = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module lstPO_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderLoad()
Dim oRS As Recordset, strINVNO As String
Dim strSQL As String, strLine As String, strSELECT As String
On Error Resume Next
mboolNOTSUPPLIER = True
' lstLMaterial.col = 0
' strINVNO = lstLMaterial.ColText
strSQL = "SELECT Inv_no, Desc, Qty, D_Flag, M_Type from tblLotMatrl WHERE Lot_ID = " & gintLOTID & " ORDER BY inv_no"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' strSELECT = "M_Type = 'P'"
strSELECT = "D_Flag = 'S' and M_Type = 'P'"
oRS.Filter = strSELECT
lstPreOrder.Clear
If oRS.EOF Then
End If
' strSELECT = "M_Type = 'Z'"
' oRS.Filter = strSELECT
Do Until oRS.EOF
With lstPreOrder
mboolNOTSUPPLIER = False
strLine = oRS!d_flag & vbTab & oRS!m_type & vbTab & oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
' strSELECT = "M_Type = 'P'"
strSELECT = "D_Flag = 'Y' and M_Type = 'P'"
oRS.Filter = strSELECT
' lstPreOrder.Clear
If oRS.EOF Then
End If
' strSELECT = "M_Type = 'Z'"
' oRS.Filter = strSELECT
Do Until oRS.EOF
With lstPreOrder
strLine = oRS!d_flag & vbTab & oRS!m_type & vbTab & oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "M_Type = 'Z'"
oRS.Filter = strSELECT
lstPreOrder.Redraw = True
Do Until oRS.EOF
With lstPreOrder
strLine = oRS!d_flag & vbTab & oRS!m_type & vbTab & oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'S' and M_Type = 'L'"
oRS.Filter = strSELECT
lstLath.Clear
Do Until oRS.EOF
With lstLath
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'Y' and M_Type = 'L'"
oRS.Filter = strSELECT
lstYard.Clear
Do Until oRS.EOF
With lstYard
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'Y' and M_Type = 'D'"
oRS.Filter = strSELECT
' lstYard.Clear
Do Until oRS.EOF
With lstYard
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'S' and M_Type = 'S'"
oRS.Filter = strSELECT
lstScratch.Clear
Do Until oRS.EOF
With lstScratch
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'S' and M_Type = 'B'"
oRS.Filter = strSELECT
lstBrown.Clear
Do Until oRS.EOF
With lstBrown
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.MoveFirst
strSELECT = "D_Flag = 'S' and M_Type = 'T'"
oRS.Filter = strSELECT
lstTexture.Clear
Do Until oRS.EOF
With lstTexture
strLine = oRS!qty & vbTab & oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS("inv_no")
End With
oRS.MoveNext
Loop
oRS.Close
If lstPreOrder.ListCount Then
lstPreOrder.ListIndex = -1
End If
If lstLath.ListCount Then
lstLath.ListIndex = -1
End If
If lstYard.ListCount Then
lstYard.ListIndex = -1
End If
If lstScratch.ListCount Then
lstScratch.ListIndex = -1
End If
If lstBrown.ListCount Then
lstBrown.ListIndex = -1
End If
If lstTexture.ListCount Then
lstTexture.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module OrderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPlans_DblClick()
txtModel = lstPlans.List(lstPlans.ListIndex)
lstPlans.Visible = False
lblPlan.Visible = False
Call cmdFindPlan_Click
End Sub
Private Sub lstPOMaterial_DblClick()
'' If chkHoldPO Then
'' MsgBox "All PO's Are On Hold - OK to View - No Processing", vbOKOnly, "PO's on Hold"
'' Exit Sub
'' End If
If moRSPO!p_flg = "P" Then
gconACTION = 2
End If
' If gbytSECURITY <> 6 And lstPO.ListCount > 4 Then
If gbytSECURITY <> 6 And lstPO.ListCount > moRSProj!pomax Then
cmdSavePO.Enabled = False
cmdDelPO.Enabled = False
cmdAddPO.Enabled = False
cmdAddPOMat.Enabled = False
cmdDelPOMat.Enabled = False
cmdSavePOMat.Enabled = True
cmdPrintPO.Enabled = False
txtPOInvNo.Enabled = True
txtPOMatDesc.Enabled = True
txtPOQty.Enabled = True
txtPOPrice.Enabled = True
cboPODFlag.Enabled = True
cboPOMType.Enabled = True
cmdFindPOMat.Enabled = True
End If
End Sub
Private Sub lstPOptions_Click()
On Error GoTo Error_EH
If lstPOptions.ListIndex <> -1 Then
If FormFindPOpt2() Then
Call FormShowPOpt
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module lstPOptions_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub MatClear()
txtLMInvNo = "0"
txtLMDesc = ""
txtLMQty = "0"
txtLMLength = "0"
txtLMBalance = "0"
chkChange = vbUnchecked
cboLMDFlag.ListIndex = -1
cboLMType.ListIndex = -1
cboLMMetal.ListIndex = -1
End Sub
Private Sub POClear()
txtPOInvNo = "0"
txtPOMatDesc = ""
txtPOQty = "0"
txtPONotes = ""
txtIssueTo = ""
txtPONum = "0"
txtPODesc = ""
txtPODate = ""
txtPay = 0
txtPayType = ""
lstLOOKUP.Clear
lstPOMaterial.Clear
cboPODFlag.ListIndex = -1
cboPOMType.ListIndex = -1
cboPOType.ListIndex = -1
End Sub
Private Sub POMatClear()
txtPOInvNo = "0"
txtPOMatDesc = ""
txtPOQty = "0"
txtPOPrice = "0"
lstLOOKUP.Clear
cboPODFlag.ListIndex = -1
cboPOMType.ListIndex = -1
cmdFindPOMat.Visible = True
End Sub
Private Sub lstPOptions_DblClick()
If mboolDNU Then
MsgBox "A DNU Option Cannot Be Used - Select Another Option", vbOKOnly, "Select Again"
Exit Sub
Else
If IsNull(moRS!l_FLG) Or gconACTION = 5 Then
lstPOptions.Enabled = False
cmdOptAdd.Enabled = True
cmdOptDel.Enabled = False
End If
End If
End Sub
Private Sub SSTLotInfo_GotFocus()
If SSTLotInfo.Tab = 1 Then
txtSuperBB = IIf(txtSuperBB = "", 0, txtSuperBB)
txtSuper12 = IIf(txtSuper12 = "", 0, txtSuper12)
txtSuperSP = IIf(txtSuperSP = "", 0, txtSuperSP)
txtSuperDW = IIf(txtSuperDW = "", 0, txtSuperDW)
' txtSuperRL = IIf(txtSuperRL = "", 0, txtSuperRL)
txtSuperML = IIf(txtSuperML = "", 0, txtSuperML)
txtSuper38 = IIf(txtSuper38 = "", 0, txtSuper38)
txtSuper78 = IIf(txtSuper78 = "", 0, txtSuper78)
txtSuper783 = IIf(txtSuper783 = "", 0, txtSuper783)
txtSuper1383 = IIf(txtSuper1383 = "", 0, txtSuper1383)
End If
If SSTLotInfo.Tab = 6 Then
'' If chkHoldPO Then
'' cmdAddPO.Enabled = False
'' cmdSavePO.Enabled = False
'' cmdDelPO.Enabled = False
'' cmdPrintPO.Enabled = False
'' cmdPrintForm.Enabled = False
'' cmdAddPOMat.Enabled = False
'' cmdSavePOMat.Enabled = False
'' cmdDelPOMat.Enabled = False
'' txtPONum.Enabled = False
'' txtPODate.Enabled = False
'' txtIssueTo.Enabled = False
'' txtPODesc.Enabled = False
'' txtPay.Enabled = False
'' txtPayType.Enabled = False
'' txtPONotes.Enabled = False
'' txtPOInvNo.Enabled = False
'' txtPOMatDesc.Enabled = False
'' txtPOQty.Enabled = False
'' cboPODFlag.Enabled = False
'' cboPOMType.Enabled = False
'' txtPOPrice.Enabled = False
'' cmdPrintPOPay.Enabled = False
'' cmdFindPOMat.Enabled = False
'' lstLookup.Visible = False
'' Else
' If gbytSECURITY <> 6 And lstPO.ListCount > 4 Then
'' If gbytSECURITY <> 6 And lstPO.ListCount > moRSProj!pomax Then
'' cmdAddPO.Enabled = True
'' End If
'' End If
End If
End Sub
Private Sub txt28Foam_GotFocus()
Call FieldSelect(txt28Foam)
End Sub
Private Sub txtFin2_GotFocus()
Call FieldSelect(txtFin2)
End Sub
Private Sub txtFoamAdj_GotFocus()
Call FieldSelect(txtFoamAdj)
End Sub
Private Sub txtIssueTo_GotFocus()
Call FieldSelect(txtIssueTo)
End Sub
Private Sub txtIssueTo_LostFocus()
txtIssueTo = UCase(txtIssueTo)
End Sub
Private Sub txtJC_GotFocus()
Call FieldSelect(txtJC)
End Sub
Private Sub txtJC_LostFocus()
txtJC = UCase(txtJC)
End Sub
Private Sub txtLaborAdj_GotFocus()
Call FieldSelect(txtLaborAdj)
End Sub
Private Sub txtLMDesc_LostFocus()
txtLMDesc = UCase(txtLMDesc)
End Sub
Private Sub txtLMInvNo_GotFocus()
Call FieldSelect(txtLMInvNo)
End Sub
Private Sub txtLMQty_LostFocus()
If mdblQTY <> Field2Str2(txtLMQty) Then
If gconACTION <> 5 Then
gconACTION = 6
End If
End If
mstrENDQTY = txtLMQty
End Sub
Private Sub txtLOMQty_GotFocus()
mdblQTY = Field2Str2(txtLOMQty)
End Sub
Private Sub txtLOMQty_LostFocus()
If mdblQTY <> Field2Str2(txtLOMQty) Then
If gconACTION <> 5 Then
gconACTION = 6
End If
End If
End Sub
Private Sub txtLotNotes_GotFocus()
txtLotNotes.SelStart = 1000
End Sub
Private Sub txtLotNotes_LostFocus()
txtLotNotes = UCase(txtLotNotes)
End Sub
Private Sub txtModel_LostFocus()
txtModel = UCase(txtModel)
End Sub
Private Sub txtPay_GotFocus()
Call FieldSelect(txtPay)
End Sub
Private Sub txtPayType_GotFocus()
Call FieldSelect(txtPayType)
End Sub
Private Sub txtPayType_LostFocus()
txtPayType = UCase(txtPayType)
If txtPayType = "D" Or txtPayType = "R" Then
lblPayYds.Caption = "Pay Dollars:"
Else
lblPayYds.Caption = "Pay Yards:"
End If
End Sub
Private Sub txtPODate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtPODate, "/", 1)
If Not IsDate(txtPODate) Then
If lngPOS = 0 Then
If Len(txtPODate) > 0 Then
txtPODate = Format(txtPODate, "00/00/####")
If Not IsDate(txtPODate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtPODate.SetFocus
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtPODate.SetFocus
End If
End If
End Sub
Private Sub txtPOPrice_GotFocus()
Call FieldSelect(txtPOPrice)
End Sub
Private Sub txtPOPrice_LostFocus()
txtPOPrice = Format(txtPOPrice, "#,#.00")
End Sub
Private Sub txtPOQty_LostFocus()
If mdblQTY <> Field2Str2(txtPOQty) Then
If moRSPO!p_flg = "P" Then
gconACTION = 2
End If
End If
End Sub
Private Sub txtLMDesc_GotFocus()
Call FieldSelect(txtLMDesc)
End Sub
Private Sub txtLMLength_GotFocus()
Call FieldSelect(txtLMLength)
End Sub
Private Sub txtLMQty_GotFocus()
mdblQTY = Field2Str2(txtLMQty)
mstrBEGQTY = Field2Str(txtLMQty)
Call FieldSelect(txtLMQty)
End Sub
Private Sub txtLotNo_LostFocus()
txtLotNo = UCase(txtLotNo)
Call GETJC
' txtJC = Field2Str(moRSProj!jccode) & Format(Left(Field2Str(txtLotNo), 3), "000")
End Sub
Private Sub GETJC()
Dim strSQL As String, intJC As Integer, txtALPHA As String, intASCII As Integer
Dim oRS As Recordset
strSQL = "SELECT * FROM tblSYSINFO"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
intJC = Field2Integer(oRS!nextjc)
txtALPHA = Field2Str(oRS!jcalpha)
txtJC = txtALPHA & Format(Field2Str(intJC), "000000")
intJC = intJC + 1
If intJC > 999999 Then
intJC = 1
intASCII = Asc(txtALPHA)
intASCII = intASCII + 1
txtALPHA = Chr(intASCII)
oRS!jcalpha = Field2Str(txtALPHA)
End If
oRS!nextjc = intJC
oRS.Update
End Sub
Private Sub txtModel_GotFocus()
Call FieldSelect(txtModel)
End Sub
Private Sub txtOwner_GotFocus()
Call FieldSelect(txtOwner)
End Sub
Private Sub txtOwner_LostFocus()
txtOwner.Text = UCase(txtOwner.Text)
End Sub
Private Sub txtAddress_LostFocus()
txtAddress.Text = UCase(txtAddress.Text)
End Sub
Private Sub txtAddress_GotFocus()
Call FieldSelect(txtAddress)
End Sub
Private Sub txtNotes_LostFocus()
txtNotes.Text = UCase(txtNotes.Text)
End Sub
Private Sub txtPODate_GotFocus()
Call FieldSelect(txtPODate)
End Sub
Private Sub txtPODesc_GotFocus()
Call FieldSelect(txtPODesc)
End Sub
Private Sub txtPODesc_LostFocus()
txtPODesc = UCase(txtPODesc)
End Sub
Private Sub txtPOInvNo_GotFocus()
Call FieldSelect(txtPOInvNo)
End Sub
Private Sub txtPOMatDesc_GotFocus()
Call FieldSelect(txtPOMatDesc)
End Sub
Private Sub txtPOMatDesc_LostFocus()
txtPOMatDesc = UCase(txtPOMatDesc)
End Sub
Private Sub txtPONotes_GotFocus()
Call FieldSelect(txtPONotes)
End Sub
Private Sub txtPONotes_LostFocus()
txtPONotes = UCase(txtPONotes)
End Sub
Private Sub txtPOQty_GotFocus()
mdblQTY = Field2Str2(txtPOQty)
Call FieldSelect(txtPOQty)
End Sub
Private Sub txtSuper12_GotFocus()
Call FieldSelect(txtSuper12)
End Sub
Private Sub txtSuper12_LostFocus()
txtSuper12 = Integer2Field(txtSuper12)
If Field2Str(moRS!l_FLG) <> "P" Then
If txtSuper12 = 0 And txtSuperBB = 0 Then
cmdCalc.Enabled = False
Else
cmdCalc.Enabled = True
End If
End If
End Sub
Private Sub txtSuper1383_LostFocus()
Dim intResponse As Integer
txtSuper1383 = Integer2Field(txtSuper1383)
If (Field2Integer(txtSuper1383) + Field2Integer(txtSuper783) + Field2Integer(txtSuper78) + Field2Integer(txtSuper38)) > Field2Str2(txtTake138) Then
intResponse = MsgBox("The sum of all JMB is greater than the Takeoff Amount." & Chr(13) & "Do you want to Continue?", vbYesNo, "Over JMB Amount")
If intResponse = vbYes Then
Exit Sub
Else
txtSuper1383.SetFocus
End If
End If
End Sub
Private Sub txtSuper38_GotFocus()
Call FieldSelect(txtSuper38)
End Sub
Private Sub txtSuper78_GotFocus()
Call FieldSelect(txtSuper78)
End Sub
Private Sub txtSuper1383_GotFocus()
Call FieldSelect(txtSuper1383)
End Sub
Private Sub txtSuper783_GotFocus()
Call FieldSelect(txtSuper783)
End Sub
Private Sub txtSuper783_LostFocus()
txtSuper783 = Integer2Field(txtSuper783)
txtCalc138 = txtTake138 - (Field2Integer(txtSuper783) + Field2Integer(txtSuper78) + Field2Integer(txtSuper38))
If CInt(txtCalc138) < 0 Then
txtCalc138 = 0
End If
txtSuper1383 = Integer2Field(txtCalc138)
End Sub
Private Sub txtSuper78_LostFocus()
txtSuper78 = Integer2Field(txtSuper78)
txtCalc138 = txtTake138 - (Field2Integer(txtSuper783) + Field2Integer(txtSuper78) + Field2Integer(txtSuper38))
If CInt(txtCalc138) < 0 Then
txtCalc138 = 0
End If
txtSuper1383 = Integer2Field(txtCalc138)
End Sub
Private Sub txtSuper38_LostFocus()
txtSuper38 = Integer2Field(txtSuper38)
txtCalc138 = txtTake138 - (Field2Integer(txtSuper783) + Field2Integer(txtSuper78) + Field2Integer(txtSuper38))
If CInt(txtCalc138) < 0 Then
txtCalc138 = 0
End If
txtSuper1383 = Integer2Field(txtCalc138)
End Sub
Private Sub txtSuperBB_GotFocus()
If mboolCOMM Then
Call FieldSelect(txtSuperBB)
End If
End Sub
Private Sub txtSuperBB_LostFocus()
If mboolCOMM Then
txtSuperBB = Integer2Field(txtSuperBB)
End If
End Sub
Private Sub txtSuperDW_GotFocus()
Call FieldSelect(txtSuperDW)
End Sub
Private Sub txtSuperDW_LostFocus()
txtSuperDW = Integer2Field(txtSuperDW)
End Sub
Private Sub txtSuperML_GotFocus()
Call FieldSelect(txtSuperML)
End Sub
Private Sub txtSuperML_LostFocus()
txtSuperML = Integer2Field(txtSuperML)
End Sub
Private Sub txtSuperNotes_GotFocus()
Call FieldSelect(txtSuperNotes)
End Sub
Private Sub txtSuperNotes_LostFocus()
txtSuperNotes.Text = UCase(txtSuperNotes.Text)
End Sub
'Private Sub txtSuperRL_GotFocus()
' Call FieldSelect(txtSuperRL)
'End Sub
'Private Sub txtSuperRL_LostFocus()
' txtSuperRL = Integer2Field(txtSuperRL)
'End Sub
Private Sub txtSuperSP_GotFocus()
Call FieldSelect(txtSuperSP)
End Sub
Private Sub MatCalcOne()
Dim dblRL As Double, dblBB As Double, dblDW As Double, dblSP As Double, intOpenPR As Integer, intUSEOpen As Integer
Dim dblBP As Double, dblFD12 As Double, dblFD1 As Double, dblFD28 As Double
Dim dblFD48 As Double, dblKote1 As Double, dblCMNT As Double, dblLime As Double
Dim dblSCmnt As Double, dblSLime As Double, dblS16 As Double, dblS20 As Double
Dim dblS30 As Double, dblRS As Double, dblBatch As Double, dblCALC As Double
Dim strSQL As String, strGET As String, strSELECT As String, vntTest As Variant
Dim oRSC As Recordset, oRC As Recordset, strSql2 As String, dblARL As Double
Dim dblSYN As Double, dblSYNP As Double, dblOPEN As Double, dblWire As Double
Dim strFIN2 As String, strFIN1 As String, intDELETE As Integer, boolDEDUCT As Boolean
Dim dblML As Double, dblAML As Double, dblNEWYDS As Double, dblPYRO As Double
Dim dblTP4, dblTP6, dblTP9, dblTPNail, dblTPCTape As Double, dblML2 As Double, dblRL2 As Double
Dim intTP9 As Integer, dblTYPAR As Double, strCHECK As String, mboolSilica As Boolean
Dim mboolBAG100 As Boolean, dblBAGSAND As Double, dblCalcBAGSAND As Double, dblSUB As Double
Dim dblBB3, dblDW3, dblRL3, dblF12_3, dblRL8 As Double, dblWRAP As Double
Dim dblBB5, dblRG125, dblRG15, dblPYRO5 As Double
Dim intMATOpen As Integer, dblMATYDS As Double, dblMOPEN As Double
On Error GoTo Error_EH
' ****** If errors are reported where quantities are being changed in material
' ****** when not wanted look at this -- oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
' Else
' oRC!QTY = dblBB
' oRC.Update
mboolBADD = False
mboolBAG100 = False
mboolSilica = False
dblRL8 = 0
If mstrWIRE <> "O" Then
MsgBox "Wire Type Is Incorrect for OneCoat - Correct in Projects", vbOKOnly, "Invalid Wire Type"
mboolBADD = True
Exit Sub
End If
dblPYRO = 1
intOpenPR = Field2Integer(moRS!openpr)
intUSEOpen = 90 - intOpenPR ' This is primarly for labor
' intMATOpen = Abs(50 - intOpenPR) ' 10/4/2018 This is a new variable to take only 50% of openings for material yardage
' intMATOpen = Abs(40 - intOpenPR) ' 02/08/2020 Changed to 40% to give more materials yardage
intMATOpen = Int(40 - intOpenPR) ' 02/08/2020 Changed to 40% to give more materials yardage
dblWRAP = Int(Field2Double(moRS!opening)) 'This is to make wrap calculate on 100% of yardage - 10/04/2018
' dblWRAP = Int(((Field2Double(moRS!opening) * intOpenPR) / 100) + 0.99)
dblOPEN = Int(((Field2Double(moRS!opening) * intUSEOpen) / 100) + 0.99)
dblMOPEN = Int(((Field2Double(moRS!opening) * intMATOpen) / 100) + 0.99)
'REMOVED TO MAKE ALL CALCULATIONS THE SAME PER JESSE 2/11/2020 To fix remove triple '''
''' If Field2Integer(moRS!sq_yd) > 500 Then '****** changed per Jesse 10/13/12 Changed back to 500 on 7/9/18
' If Field2Integer(moRS!sq_yd) > 300 Then '****** changed per Jesse 12/11/17 Changed back to 500 on 7/9/18
' If Field2Integer(moRS!sq_yd) > 400 Then
''' boolDEDUCT = True
''' dblNEWYDS = Field2Integer(moRS!sq_yd) - dblOPEN
''' dblMATYDS = Field2Integer(moRS!sq_yd) - dblMOPEN '10/04/2018 changed by Jesse to give more material
' dblNEWYDS = Field2Integer(moRS!sq_yd) - Field2Integer(moRS!opening) '01/08/2018 corrected to use the opening balance
' dblNEWYDS = Field2Integer(moRS!sq_yd) ' + Field2Integer(moRS!opening) ' 01/04/2018 per Jesse removed all openings from calculations.
' dblNEWYDS = Field2Integer(moRS!sq_yd) + Field2Integer(moRS!opening)
''' Else
''' boolDEDUCT = False
dblNEWYDS = Field2Integer(moRS!sq_yd) - dblOPEN
dblMATYDS = Field2Integer(moRS!sq_yd) - dblMOPEN '10/04/2018 changed by Jesse to give more material
' dblNEWYDS = Field2Integer(moRS!sq_yd) - dblOPEN
' dblNEWYDS = Field2Integer(moRS!sq_yd) - Field2Integer(moRS!opening) '01/08/2018 corrected to use the opening balance
' dblNEWYDS = Field2Integer(moRS!sq_yd) '' 01/04/2018 per Jesse removed all openings from calculations.
''' End If
' dblOPEN = Int((Field2Double(moRS!opening) * 0.5) + 0.99)
'**** August 20, 2011 - Jesse had me change labor to subtract 10 from lath
'**** under 400 yds, 19 from lath labor on houses from 400 to 1000
'**** Also had me start taking openings off material yds on lots over 400
'REMOVED TO MAKE ALL CALCULATIONS THE SAME PER JESSE 2/11/2020 To fix remove triple '''
''' If moRSProj!use_open Then
' moRS!s_yds = (Field2Integer(dblnewyds) - dblOPEN) - 24
''' If Field2Integer(dblNEWYDS) > 500 Then
' If Field2Integer(dblNEWYDS) > 400 Then '**** changed per Jesse 10/13/2012
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) ' Change for Jesse 06/14/05
''' intDELETE = 0
' moRS!l_yds = (Field2Integer(dblNEWYDS) - dblOPEN) - intDELETE 'Changed 12/11/17 per Jesse
' moRS!s_yds = ((Field2Integer(dblNEWYDS) - dblOPEN) - intDELETE) - 5 'Changed 12/11/17 per Jesse
''' moRS!l_yds = (Field2Integer(dblNEWYDS)) - intDELETE - 5 'Changed 12/11/17 per Jesse
''' moRS!s_yds = ((Field2Integer(dblNEWYDS)) - intDELETE) - 5 'Changed 12/11/17 per Jesse
''' Else
' moRS!l_yds = (Field2Integer(dblnewyds) - dblOPEN) - 19
' moRS!s_yds = (Field2Integer(dblnewyds) - dblOPEN) - 24
' moRS!l_yds = (Field2Integer(dblNEWYDS)) - 10 'Change per Jesse 08/22/05
' moRS!s_yds = (Field2Integer(dblNEWYDS)) - 15 'Change per Jesse 08/22/05
moRS!l_yds = (Field2Integer(dblNEWYDS)) - 5 'Change per Jesse 10/13/12
moRS!s_yds = (Field2Integer(dblNEWYDS)) - 5 'Change per Jesse 10/13/12
''' End If
''' Else
' moRS!s_yds = Field2Integer(dblnewyds) - 24
''' If Field2Integer(dblNEWYDS) > 500 Then
' If Field2Integer(dblNEWYDS) > 400 Then '**** changed per Jesse 10/13/2012
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
''' intDELETE = 0
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) ' Change for Jesse 06/14/05
''' moRS!l_yds = Field2Integer(dblNEWYDS) - intDELETE - 5
''' moRS!s_yds = Field2Integer(dblNEWYDS) - intDELETE - 5
''' Else
' moRS!l_yds = Field2Integer(dblNEWYDS) - 10
' moRS!s_yds = Field2Integer(dblNEWYDS) - 15
moRS!l_yds = (Field2Integer(dblNEWYDS)) - 5 'Change per Jesse 10/13/12
moRS!s_yds = (Field2Integer(dblNEWYDS)) - 5 'Change per Jesse 10/13/12
'-------------------------------------------------------------------------------------------------------
''' End If
''' End If
strSQL = "DELETE * FROM tblLotMatrl WHERE RC_Flag and not ch_flag and lot_id = " & gintLOTID
goConn.Execute strSQL
strSELECT = "SELECT * FROM tblLotMatrl where lot_id = " & gintLOTID
Set moRSCMat = New Recordset
moRSCMat.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If moRSProj!stype <> "T" Then
'Black Paper
If IsNull(txtSuper12) Then
txtSuper12 = 0
End If
dblFD12 = CInt(txtSuper12)
If txtSuperSP > "" Then
dblSP = CDbl(txtSuperSP)
ElseIf dblSP = 0 Then
dblSP = (dblFD12 / 2)
Else
dblSP = 0
End If
'******* Need to determine ML quantity TO
'****** REMOVED 1.75 METAL LATH FROM CALCULATON TO REDUCE WIRE
'' moRSCMat.MoveFirst
'' strSELECT = "inv_no = '1370'" '1.75 Metal Lath
'' moRSCMat.Find strSELECT
'' If moRSCMat.EOF Then
'' dblML = 0
'' Else
'' dblML = Field2Integer(moRSCMat!qty)
'' End If
' If Not dblML > 0 Then
If dblML > 0 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1375'" '3.4 Metal Lath
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML2 = 0
Else
dblML2 = Field2Integer(moRSCMat!qty)
dblML = dblML + dblML2
dblML2 = 0
End If
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1375'" '3.4 Metal Lath
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML = 0
Else
dblML = Field2Integer(moRSCMat!qty)
End If
End If
' If Not dblML > 0 Then
If dblML > 0 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1371'" '2.5 Metal Lath
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML2 = 0
Else
dblML2 = Field2Integer(moRSCMat!qty)
dblML = dblML + dblML2
dblML2 = 0
End If
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1371'" '2.5 Metal Lath
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML = 0
Else
dblML = Field2Integer(moRSCMat!qty)
End If
End If
If txtSuperML > 5 Then
dblML2 = Field2Integer(txtSuperML)
dblML = dblML + dblML2 - 5
dblML2 = 0
End If
'********** Need to determine correct RL
' If txtSuperRL = "-2" Then ' Use Takeoff RL always per Jesse 05/15/18
'******* Need to make takeoff RL to be dblRL
moRSCMat.MoveFirst
strSELECT = "inv_no = '1330'" 'Rib Lath with paper
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblRL = 0
Else
dblRL = Field2Integer(moRSCMat!qty)
End If
' Else
' If txtSuperRL = "-1" Then
' strSQL = "DELETE * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and inv_no = 1330"
' goConn.Execute strSQL
' End If
' If txtSuperRL > "0" Then
' dblRL = CInt(txtSuperRL)
' moRSCMat.MoveFirst
' strSELECT = "inv_no = '1330'"
' moRSCMat.Find strSELECT
' If moRSCMat.EOF Then
' moRSCMat.MovePrevious
' strGET = "SELECT * FROM tblInvtry where inv_no = 1330"
' Set oRSC = New Recordset
' oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
' moRSCMat.AddNew
' moRSCMat!Lot_id = gintLOTID
' moRSCMat!inv_no = "1330"
' moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!d_flag = Field2Str(oRSC!d_flag)
' moRSCMat!m_type = Field2Str(oRSC!m_type)
' moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
' moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
' ' moRSCMat!rc_flag = vbChecked
'' moRSCMat!qty = Field2Str2(txtSuperRL)
' moRSCMat!ch_flag = vbChecked
' moRSCMat.Update
' Else
'' moRSCMat!qty = Field2Str2(txtSuperRL)
' moRSCMat!ch_flag = vbChecked
' moRSCMat.Update
' End If
' End If
' End If
moRSCMat.MoveFirst
strSELECT = "inv_no = '1331'" ' Rib Lath no paper
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblRL2 = 0
Else
dblRL2 = Field2Integer(moRSCMat!qty)
dblRL = dblRL + dblRL2
dblRL2 = 0
End If
If gboolPSpecialCALC Then
dblRL8 = dblRL
End If
'** Black Board and R Guard
If txtSuperBB > 0 Then
dblBB = CInt(txtSuperBB)
Else
' ElseIf moRSProj!bb Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblBB5 = Field2Str(moRSCMat!qty)
' Else
' dblBB = 0
End If
' ElseIf moRSProj!rg12 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblRG125 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
' ElseIf moRSProj!rg1 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblRG15 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
' ElseIf moRSProj!pyro Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblPYRO5 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
End If
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If moRSProj!rg1 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If moRSProj!pyro Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If dblBB5 > 0 And moRSProj!bb Then
dblBB = dblBB5
End If
If dblRG125 > 0 And (moRSProj!rg12 Or moRSProj!rg1) Then
dblBB = dblRG125
End If
If dblRG15 > 0 And moRSProj!rg1 Then
dblBB = dblRG15
End If
If moRSProj!pyro Then
dblBB = dblPYRO5
End If
If txtSuperBB = -1 Then
Else
If moRSProj!bb Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1310'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1310'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
Else
If moRSProj!rg12 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1315'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1315'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
ElseIf moRSProj!rg1 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1317'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1317'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
ElseIf moRSProj!pyro Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1805'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblPYRO
' moRSCMat!qty = Field2Str(txtSuperBB)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
dblBB = Field2Str(moRSCMat!qty)
End If
End If
End If
'*** Calc Black Paper
If moRSProj!bp_type = "" Then
' response = MsgBox("No BlackPaper is Defined in Subdivision Code - " & moRSProj!proj_code, vbOKOnly, "Black Paper Error")
' MsgBox("No BlackPaper is Defined in Subdivision Code - " & moRSProj!proj_code, vbOKOnly, "Black Paper Error") = vbOK
MsgBox "No BlackPaper is Defined for this Subdivision"
Exit Sub
End If
If moRSProj!bp_type = "B1" Then '1 Roll of BP plus sheer
dblBP = 1 + Int((((dblSP * 32) / 9) / 33) + 0.99)
End If
If moRSProj!bp_type = "B2" Then 'double cover sheer and BB
If moRSProj!bb Then
dblBP = Int(((((dblFD12 * 1.77) + ((dblBB * 3.5) + (dblSP * 3.5)) * 2)) / 33) + 0.99)
Else
dblBP = Int(((((dblFD12 * 1.77) + (dblSP * 3.5) * 2)) / 33) + 0.99)
End If
End If
If moRSProj!bp_type = "BA" Then 'cover entire house once
' dblBP = Int((CDbl(dblNEWYDS) / 33) + 0.99)
dblBP = Int((CDbl(dblMATYDS) / 33) + 0.99) '10/04/2018 changed by Jesse to give more material
End If
If moRSProj!bp_type = "BC" Then 'cover entire house once plus sheer and BB
If dblNEWYDS < 325 Then
If moRSProj!bb Then
dblBP = Int((((CDbl(dblMATYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
Else
' dblBP = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblSP * 3.5)) / 33) + 0.99)
dblBP = Int((((CDbl(dblMATYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
End If
Else
If moRSProj!bb Then
dblBP = Int(((CDbl(dblMATYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
Else
dblBP = Int(((CDbl(dblMATYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
' dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblSP * 3.5)) / 33) + 0.99)
End If
End If
End If
If moRSProj!bp_type = "BF" Then 'double cover under 1/2 foam
dblBP = Int((((dblFD12 * 1.77) * 2) / 33) + 0.99)
End If
If moRSProj!bp_type = "BS" Then 'double cover sheer panel only
dblBP = Int((((dblSP * 3.5) * 2) / 33) + 0.99)
End If
If moRSProj!bp_type = "BD" Then 'double cover entire house
If dblNEWYDS > 325 Then
dblBP = Int(((CDbl(dblMATYDS) * 2) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int(((CDbl(dblNEWYDS) * 2) / 33) + 0.99)
' dblBP = Int(((CDbl(dblMATYDS) * 2) / 33) + 0.99) '10/04/2018 did not use this because openings added over 325
Else
dblBP = Int((((CDbl(dblMATYDS) + dblOPEN) * 2) / 33) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int((((CDbl(dblNEWYDS) + dblOPEN) * 2) / 33) + 0.99)
' dblBP = Int((((CDbl(dblMATYDS) + dblOPEN) * 2) / 33) + 0.99) '10/04/2018 did not use this because openings added over 325
End If
End If
' If moRSProj!bp_type = "TV" Then 'cover entire house once
' dblBP = Int(((CDbl(dblNEWYDS)) / 30) + 0.99)
' End If
If moRSProj!bp_type = "TV" Then 'TYVEK Commercial Calculation
dblBP = Int(((CDbl(dblMATYDS)) / 100) + 0.99) 'CHANGED 2/11/2020 for use of MATYDS
' dblBP = Int(((CDbl(dblNEWYDS)) / 100) + 0.99)
End If
If moRSProj!bp_type = "BR" Then 'TYPAR Calculation for Ryland
dblBP = Int((((dblFD12 * 1.77)) / 16) + 0.99)
End If
If moRSProj!bp_type = "BT" Then 'cover entire house once plus sheer and BB
If moRSProj!bb Then
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 33) + 0.99)
dblBP = Int(((CDbl(dblMATYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 33) + 0.99) '10/04/2018 Per Jesse to use full yardate
Else
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 33) + 0.99)
dblBP = Int(((CDbl(dblMATYDS) + (dblSP * 3.5)) / 33) + 0.99) '10/04/2018 Per Jesse to use full yardate
End If
End If
If moRSProj!bp_type = "B6" Then 'cover entire house once with 60 min paper plus sheer and BB
'For 60 minute, use 1/2 foam divided by 16
' If moRSProj!bb Then
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 20) + 0.99)
' Else
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 20) * 1.5) + 0.99)
' End If
dblBP = Int(((((dblFD12 + dblRL8) * 1.77)) / 16) + 0.99) '60 Min uses 1/2 foam for yardage
End If
If moRSProj!bp_type = "B7" Then 'cover entire house once with 2 ply paper plus sheer and BB
If moRSProj!bb Then
dblBP = Int(((CDbl(dblMATYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 16) + 0.99) '10/04/2018 Changed per Jesse to use full yardage
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 16) + 0.99)
Else
dblBP = Int((((CDbl(dblMATYDS) + (dblSP * 3.5)) / 16)) + 0.99) '10/04/2018 Changed per Jesse to use full yardage
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 16)) + 0.99) 'Changed 10/12/15 per jesse
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 16) * 1.5) + 0.99)
End If
End If
If moRSProj!bp_type = "BP" Then 'Pulte Calculation
' If moRSProj!bb Then
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 20) + 0.99)
' Else
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 20) * 1.5) + 0.99)
' End If
' dblBP = Int(((((dblFD12 + dblRL8) * 1.77)) / 16) + 0.99) '60 Min uses 1/2 foam for yardage
dblBP = Int((CDbl(dblMATYDS) / 70) + 0.99) 'Foam Calc - Total Yardage/70 YDs -- FOR PULTE ONLy
End If
If moRSProj!bp_type = "TV" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1815' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1815'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1816' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1816'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
' moRSCMat!qty = ((dblBP * 3) * 0.9)
moRSCMat.Update
Else
oRC!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
oRC.Update
End If
ElseIf moRSProj!bp_type = "TC" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1817' and lot_id = " & gintLOTID 'Material is TYVEK STRAIT FLASH
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1817'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1816' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1816'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
' moRSCMat!qty = ((dblBP * 3) * 0.9)
moRSCMat.Update
Else
oRC!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
oRC.Update
End If
ElseIf moRSProj!bp_type = "B6" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
ElseIf moRSProj!bp_type = "BP" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
ElseIf moRSProj!bp_type = "B7" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1811' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1811'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
ElseIf moRSProj!bp_type = "BR" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1810' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1810'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
End If
'Stucco Wire
'Changed the Yardage figure to match what is used for all of the calculations (dblNEWYDS instead of txtTtlYdge)
'to calc wire better for Jesse 12/14/17
dblWire = Field2Integer(txtWireAdj) 'RL reducing Wire calculation
' If dblRL > 5 Then '**** per Jesse remove all RL from wire
dblARL = Int(((dblRL) * 1.77) + 0.99)
' dblARL = Int(((dblRL - 5) * 1.77) + 0.99)
' Else
' dblARL = 0
' dblARL = Int(((dblRL) * 1.77) + 0.99)
' End If
If dblML > 5 Then
dblAML = Int(((dblML - 5) * 1.77) + 0.99)
Else
dblAML = 0
End If
'**** Wire Yardage CHanged to 40 yards at Jesse's request on June 28, 2005
'**** Wire Yardage CHanged to 45 yards at Jesse's request on June 28, 2005
'**** Wire Yardage CHanged to 50 yards at Jesse's request on March 24, 2010
'**** Wire Yardage CHanged to 45 yards at Jesse's request on June 28, 2005
'CHANGED THIS ON 2/11/2020 to get more yardage to houses per JESSE To remove take out the '''
''' If CDbl(txtTtlYdge) < 350 Then
' dblCALC = Int((((CDbl(txtTtlYdge)) - (dblAML + dblARL + dblWire)) / 45) + 0.49)
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblAML + dblARL + dblWire)) / 50) + 0.99)
''' dblCALC = Int((((CDbl(dblNEWYDS)) - (dblAML + dblARL + dblWire)) / 45) + 0.79)
' dblCALC = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) - (dblAML + dblARL + dblWire)) / 45) + 0.79) 'Changed Per Jesse 11/14/2019
' dblCALC = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) - (dblAML + dblARL + dblWire)) / 45) + 0.99) 'Changed Per Jesse 11/14/2019
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblARL + dblWire)) / 40) + 0.99)
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblARL + dblWire)) / 50) + 0.99)
''' Else '10/04/2018 Did not change this to dblMATYDS because openings are already added back in
dblCALC = Int(((CDbl(dblMATYDS) - (dblAML + dblARL + dblWire)))) ' / 45) + 0.49)
' dblCALC = Int(((dblCALC) / 45) + 0.49)
dblCALC = Int(((dblCALC) / 45) + 0.79)
' dblCALC = Int(((CDbl(dblNEWYDS) - (dblAML + dblARL + dblWire)))) ' / 45) + 0.49)
' dblCALC = Int(((dblCALC) / 45) + 0.49)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblAML + dblARL + dblWire)) / 45) + 0.49)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblAML + dblARL + dblWire)) / 45) + 0.99)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblARL + dblWire)) / 40) + 0.99)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblARL + dblWire)) / 50) + 0.99)
''' End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1410' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1410'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = "1410"
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblCALC
moRSCMat.Update
dblCALC = 0
Else
oRC!qty = dblCALC
oRC.Update
End If
'Calculate Typar Stucco Wrap '10/04/2018 Not changed for dblMATYDS because using txtTTLYDGE
If moRSProj!TYPAR Then
' dblTYPAR = Int((Field2Integer(txtTTLYds) / 90) + 0.99)
' dblTYPAR = Int((Field2Integer(txtTtlYdge) / 90) + 0.79) ' CHanged on 10/4/2018 per Jesse -- Tangerine Ridge discussion
dblTYPAR = Int((Field2Integer(dblMATYDS) / 80) + 0.79) ' CHanged on 2/11/2020 per Jesse for dblMATYDS
''' dblTYPAR = Int((Field2Integer(txtTtlYdge) / 80) + 0.79) ' CHanged on 11/16/2018 per Jesse -- Fermin Discussion' 18104 dblTYPAR = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 70) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to take into consideration overlap
' dblTYPAR = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 90) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTYPAR = Int((Field2Integer(txtTtlYdge) / 90) + 0.99) 'Changed 7/22/2015 after discussion with BBart/JR
' intTP45 = 1 'combined all typar into 1 calcuation
intTP9 = dblTYPAR '- intTP45
dblTP4 = Int(((Field2Integer(dblMATYDS) + dblWRAP) / 100) + 0.99) ' CHanged on 2/11/2020 per Jesse for dblMATYDS
' dblTP4 = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 100) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTP6 = Int((Field2Integer(txtTtlYdge) / 100) + 0.99) 'Changed 10/17/17 No Longer using 6 in tape
dblTP9 = Int(((Field2Integer(dblMATYDS) + dblWRAP) / 500) + 0.99) ' CHanged on 2/11/2020 per Jesse for dblMATYDS
dblTPNail = Int(((Field2Integer(dblMATYDS) + dblWRAP) / 250) + 0.99) ' CHanged on 2/11/2020 per Jesse for dblMATYDS
' dblTP9 = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 500) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTPNail = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 250) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTP9 = Int((Field2Integer(txtTtlYdge) / 500) + 0.99)
' dblTPNail = Int((Field2Integer(txtTtlYdge) / 250) + 0.99)
dblTPCTape = intTP9
' strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = 3310 and lot_id = " & gintLOTID
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3300' and lot_id = " & gintLOTID ' To Delete
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
Else
oRC.Delete
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3310' and lot_id = " & gintLOTID
' strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = 3300 and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3310' and Inv_Type = " & gbytINV_TYPE
' strSELECT = "SELECT * FROM tblINVtry where Inv_no = 3300 and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = intTP9
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = intTP9
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3324' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3324' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!qty = (dblTP4 * 2) ' Changed 10/17/17 per JR & Jesse
moRSCMat!qty = (dblTP4 * 4) ' Changed 11/14/17 per JR so Supers do not need to request more 4"
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
' oRC!qty = (dblTP4 * 2) ' Changed 10/17/17 per JR & Jesse
oRC!qty = (dblTP4 * 4) ' Changed 11/14/17 per JR so Supers do not need to request more 4"
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3326' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3329' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
'******* This section is being removed per JR because this is not needed 05/21/2020
'******* If this needs to be included again, remove the '' from the beginning of the line.
'' strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3329' and lot_id = " & gintLOTID
'' Set oRC = New Recordset
'' oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
'' If oRC.EOF Then
'' strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3329' and Inv_Type = " & gbytINV_TYPE
'' Set oRSC = New Recordset
'' oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
'' If Not oRSC.EOF Then '********** This is for 12in Flex Butyl Tape
'' moRSCMat.AddNew
'' moRSCMat!Lot_ID = gintLOTID
'' moRSCMat!inv_no = Field2Str(oRSC!inv_no)
'' moRSCMat!Desc = Field2Str(oRSC!Desc)
'' moRSCMat!qty = 1
' moRSCMat!qty = dblTP9 ' May need to use this if coming up short. Super should hang on to extra butyl
'' moRSCMat!price = Field2Str(oRSC!tprice)
'' moRSCMat!d_flag = Field2Str(oRSC!d_flag)
'' moRSCMat!m_type = Field2Str(oRSC!m_type)
'' moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
'' moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
'' moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
'' moRSCMat.Update
'' End If
'' Else
'' oRC!qty = 1
' oRC!qty = dblTP9
'' oRC.Update
'' End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '1831' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '1831' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblTPNail
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = dblTPNail
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3320' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3320' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblTPCTape
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = dblTPCTape
oRC.Update
End If
End If
'Calculate 1 Kote, Cement, Lime, and Sand for the Current House
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3110' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3110'" 'Plastic
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 700) + 0.99)
moRSCMat.Update
Else
oRC!qty = Int((Field2Integer(dblNEWYDS) / 700) + 0.99)
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3220'" 'Red Tape
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 150) + 0.99)
moRSCMat.Update
Else
oRC!qty = Int((Field2Integer(dblNEWYDS) / 150) + 0.99)
oRC.Update
End If
If moRSProj!stype = "S" Then ' SUPERWALL One Kote
If Field2Str2(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblMATYDS) / CDbl(moRSProj!sw_order)) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblMATYDS) / 9) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / 9) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '5220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '5220'" 'Superwall
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "B" Then ' SUPERWALL One Kote with synthetic texture
If Field2Str2(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblMATYDS) / CDbl(moRSProj!sw_order)) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblMATYDS) / 9) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / 9) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '5220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '5220'" 'Superwall
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "W" Then ' WESTERN One Kote
If Field2Str(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblMATYDS) / CDbl(moRSProj!sw_order)) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblMATYDS) / 10) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / 10) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2210' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2210'" 'WESTERN
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "M" Then 'Now PREMIX Western One KOTE Not MAGNA WALL One Kote
' If Field2Str2(moRSProj!sw_order) > 0 Then
If Field2Double(moRSProj!sw_order) > 0 Then
dblKote1 = Int(CDbl(dblMATYDS) / CDbl(moRSProj!sw_order)) ' + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int(CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) ' + 0.99)
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblMATYDS) / 8) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / 8) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2250' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2250'" 'Western PREMIX
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "N" Then ' SanMan Silo One Kote
If Field2Str(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblMATYDS) / CDbl(moRSProj!sw_order)) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblMATYDS) / 10) + 0.99) '10/04/2018 Changed to use dblMATYDS to get more material
' dblKote1 = Int((CDbl(dblNEWYDS) / 10) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2260' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2260'" 'San Man Silo
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRS!texture = "" Then
MsgBox "No Texture is Selected for This House - Check the Plan"
Exit Sub
End If
'This caluclates the materials needed for the primary texture
'mboolbag100
strGET = "SELECT * FROM tblFinish where ID = '" & Field2Str(moRS!texture) & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
If Not ((Field2Str2(oRSC!s16) > 0) Or (Field2Str2(oRSC!s20) > 0) Or (Field2Str2(oRSC!s30) > 0)) Then
If moRSProj!bag100 Or mboolPSW Then
mboolBAG100 = True
dblCalcBAGSAND = Field2Str2(moRSProj!bagdollars)
Else
mboolSilica = True
End If
Else
mboolSilica = True
End If
End If
strFIN2 = Field2Str(oRSC!Secondary)
strFIN1 = Field2Str(oRSC!Primary)
If moRS!fin2 > 0 Then
' If moRS!texture = "SK" Or moRS!texture = "DA" Or moRS!texture = "SA" Or moRS!texture = "SM" Or moRS!texture = "QU" Or moRS!texture = "MN" Then
If oRSC!Secondary = "" Or IsNull(oRSC!Secondary) Then
' If moRS!texture <> "DF" And moRS!texture <> "SB" And moRS!texture <> "MF" Then
moRS!fin2 = 0
moRS.Update
End If
End If
dblBatch = Int((((Field2Integer(dblMATYDS))) / Field2Integer(oRSC!yds)) + 0.99)
' dblBatch = Int((((Field2Integer(dblNEWYDS))) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Str2(oRSC!cmnt) > 0 Then
dblCMNT = Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
Else
dblCMNT = 0
End If
If Field2Str2(oRSC!lime) > 0 Then
dblLime = Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
Else
dblLime = 0
End If
If Field2Str2(oRSC!s16) > 0 Then
dblS16 = Int((dblBatch * Field2Str2(oRSC!s16)) + 0.99)
Else
dblS16 = 0
End If
If Field2Str2(oRSC!s20) > 0 Then
dblS20 = Int((dblBatch * Field2Str2(oRSC!s20)) + 0.99)
Else
dblS20 = 0
End If
If Field2Str2(oRSC!s30) > 0 Then
dblS30 = Int((dblBatch * Field2Str2(oRSC!s30)) + 0.99)
Else
dblS30 = 0
End If
If Not mboolBAG100 Then
If Field2Integer(oRSC!brs) > 0 Then
dblRS = Int((((dblKote1 * Field2Integer(oRSC!brs)) + (dblBatch * Field2Integer(oRSC!trs)) + Field2Integer(oRSC!xrs)) / 2000) + 0.99)
Else
dblRS = 0
End If
End If
If mboolBAG100 And Not mboolPSW Then
dblBAGSAND = Int((dblCMNT * dblCalcBAGSAND) + 0.99)
ElseIf mboolPSW Then
dblBAGSAND = Int(((dblKote1 + dblCMNT) * dblCalcBAGSAND) + 0.99)
End If
If Field2Str(oRSC!id) = "SB" Then 'this calculates the synthetic needed for the base coat
If Field2Double(moRSProj!syn_o) > 0 Then
dblSYN = Int(((((Field2Integer(dblMATYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(moRSProj!syn_o)) + 0.99)
' dblSYN = Int(((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(moRSProj!syn_o)) + 0.99)
Else
dblSYN = Int(((((Field2Integer(dblMATYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(oRSC!yds)) + 0.99)
' dblSYN = Int(((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(oRSC!yds)) + 0.99)
End If
End If
'This calculates the additional materials needed for the second texture
On Error GoTo Error_EH2
If moRS!fin2 > 0 Then
If strFIN2 = "SB" Then 'This calculates the synthetic needed for the second texture
' If Field2Str(oRSC!id) = "SB" Then 'This calculates the synthetic needed for the second texture
If Field2Integer(moRSProj!syn_o2) > 0 Then
dblSYNP = Int(((Field2Integer(moRS!fin2) * 9) / Field2Double(moRSProj!syn_o2)) + 0.99)
' Exit Sub
Else
dblSYNP = Int(((Field2Integer(moRS!fin2) * 9) / Field2Double(oRSC!s_yds)) + 0.99)
' Exit Sub
End If
' ElseIf Field2Str(moRS!texture) = "DF" Or Field2Str(moRS!texture) = "MF" Then
ElseIf Not (strFIN2 = "" Or strFIN2 = "0" Or IsNull(strFIN2)) Then
strGET = "SELECT * FROM tblFinish where ID = '" & strFIN2 & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
If Field2Integer(oRSC!yds) > 0 Then
dblBatch = Int((Field2Integer(moRS!fin2) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Double(oRSC!cmnt) > 0 Then
dblCMNT = dblCMNT + Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
Else
dblCMNT = 0
End If
If Field2Integer(oRSC!lime) > 0 Then
dblLime = dblLime + Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
Else
dblLime = 0
End If
If Field2Str2(oRSC!s16) > 0 Then
dblS16 = dblS16 + Int((dblBatch * Field2Str2(oRSC!s16)) + 0.99)
'Else
' dblS16 = 0
End If
If Field2Str2(oRSC!s20) > 0 Then
dblS20 = dblS20 + Int((dblBatch * Field2Str2(oRSC!s20)) + 0.99)
'Else
' dblS20 = 0
End If
If Field2Str2(oRSC!s30) > 0 Then
dblS30 = dblS30 + Int((dblBatch * Field2Str2(oRSC!s30)) + 0.99)
'Else
' dblS30 = 0
End If
End If
End If
End If
On Error GoTo Error_EH
'**********
If dblCMNT > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2410' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2410'" 'Cement
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblCMNT
moRSCMat.Update
End If
End If
If dblLime > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2430' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2430'" 'Lime
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblLime
moRSCMat.Update
End If
End If
If dblS16 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2316' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2316'" 'Silica 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2366' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2366'" 'Marble Sand 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
End If
End If
If dblS20 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2320' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2320'" 'Silica 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2370' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2370'" 'Marble Sand 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
Else
oRSC!qty = dblS20
oRSC.Update
End If
End If
End If
If dblS30 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2330' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2330'" 'Silica 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2380' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2380'" 'Marble Sand 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
End If
End If
' If mboolBAG100 Then
' dblBAGSAND = Int((dblCMNT * dblCalcBAGSAND) + 0.99)
' End If
If dblBAGSAND > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2350' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2350'" 'Bag Sand
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBAGSAND
moRSCMat.Update
Else
oRC!qty = dblBAGSAND
oRC.Update
End If
End If
If dblSYNP > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2601' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2601'" 'EIFS SANDBLAST Second Color
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSYNP
moRSCMat.Update
End If
End If
If dblSYN > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2600' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2600'" 'EIFS SANDBLAST
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSYN
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2610' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2610'" 'EIFS COLOR Fast
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((dblSYN + dblSYNP) / 10) + 0.99)
moRSCMat.Update
End If
End If
'Calculate the Bag Sand
If dblRS > 0 And Not mboolSilica Then
txtSand = dblRS
Else
txtSand = 0
End If
'Calculate Foam
If txt28Foam = 0 Then
txt28Foam = 25
End If
'CHanged all dblNEWYDS in foam calculations to dblmatyds 02/18/2020
If Field2Integer(dblMATYDS) < 325 Then
' If Field2Integer(dblNEWYDS) < 325 Then
dblFD1 = Int(((((Field2Integer(dblMATYDS) + CDbl(moRS!opening)) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
' dblFD1 = Int(((((Field2Integer(dblNEWYDS) + CDbl(moRS!opening)) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
Else
dblBB3 = (dblBB * 3.5)
dblDW3 = (dblDW * 3.5)
dblRL3 = (dblRL * 1.77)
dblF12_3 = (dblFD12 * 1.77)
dblSUB = (((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77)) / 1.77)
' dblFD1 = Int((Field2Integer(dblNEWYDS) - Field2Integer(moRS!f_adj)) - dblSUB + 0.99)
' dblFD1 = Int((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
dblFD1 = Int((((Field2Integer(dblMATYDS) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
End If
dblFD28 = Int(((dblFD1 * Field2Integer(txt28Foam)) / 100) + 0.99)
dblFD48 = Int(((dblFD1 - dblFD28) / 2) + 0.99)
If moRSProj!ftype = "O" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1211' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1211'" '2X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD28
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1241' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1241'" '4X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD48
moRSCMat.Update
End If
End If
If moRSProj!ftype = "T" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1211' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1211'" '2X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD28
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1241' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1241'" '4X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD48
moRSCMat.Update
End If
End If
If moRSProj!ftype = "D" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1250' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1250'" '2X8 sheets of Dow Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD1
moRSCMat.Update
End If
End If
If moRSProj!ftype = "U" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1260' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1260'" '4X8 sheets of Urethane Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((dblFD1 / 2) + 0.99)
moRSCMat.Update
End If
End If
If txtSuper12 > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1230' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1230'" '2X8 sheets of 1/2 inch Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Field2Str(txtSuper12)
moRSCMat.Update
Else
oRC!qty = Field2Str(txtSuper12)
oRC.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1230' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
End If
'Calculate Nails
strSELECT = "inv_no = '1610'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then 'Changed 11/1/17 per Rose
' If Field2Integer(dblNEWYDS) <= 450 Then
If Field2Integer(dblNEWYDS) <= 2200 Then
moRSCMat!qty = 1
' ElseIf Field2Integer(dblNEWYDS) > 450 And Field2Integer(dblNEWYDS) <= 750 Then
' moRSCMat!qty = 1.5
' ElseIf Field2Integer(dblNEWYDS) > 750 And Field2Integer(dblNEWYDS) <= 1000 Then
' moRSCMat!qty = 2
' ElseIf Field2Integer(dblNEWYDS) > 1000 And Field2Integer(dblNEWYDS) <= 1450 Then
' moRSCMat!qty = 2.5
' ElseIf Field2Integer(dblNEWYDS) > 1450 And Field2Integer(dblNEWYDS) <= 1750 Then
' moRSCMat!qty = 3
' ElseIf Field2Integer(dblNEWYDS) > 1750 And Field2Integer(dblNEWYDS) <= 2000 Then
' moRSCMat!qty = 3.5
End If
End If
moRSCMat.Update
End If
'Calculate Staples
strSELECT = "inv_no = '1710'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 240 Then
moRSCMat!qty = 1
Else
' moRSCMat!qty = Round(((Field2Integer(dblNEWYDS) / 230) + 0.05), 1) 'Changed to help with the rounding to full boxes
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 240) + 0.79)) 'Changed on 7/23/2020 Per Jesse
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 240) + 0.49))
End If
End If
moRSCMat.Update
End If
strSELECT = "inv_no = '1720'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 240 Then
moRSCMat!qty = 1
Else
' moRSCMat!qty = Round(((Field2Integer(dblNEWYDS) / 230) + 0.05), 1) 'Changed to help with the rounding to full boxes
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 240) + 0.79)) 'Changed on 7/23/2020 Per Jesse
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 240) + 0.49))
End If
End If
moRSCMat.Update
End If
'Rapid Staples
strSELECT = "inv_no = '1730'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 280 Then
moRSCMat!qty = 1
Else
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 280) + 0.49))
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 280) + 0.99))
End If
' If Field2Integer(dblnewyds) <= 400 Then
' moRSCMat!qty = 1
' ElseIf Field2Integer(dblnewyds) > 400 And Field2Integer(dblnewyds) <= 700 Then
' moRSCMat!qty = 2
' ElseIf Field2Integer(dblnewyds) > 700 And Field2Integer(dblnewyds) <= 1000 Then
' moRSCMat!qty = 3
' ElseIf Field2Integer(dblnewyds) > 1000 And Field2Integer(dblnewyds) <= 1300 Then
' moRSCMat!qty = 4
' ElseIf Field2Integer(dblnewyds) > 1300 And Field2Integer(dblnewyds) <= 1600 Then
' moRSCMat!qty = 5
' ElseIf Field2Integer(dblnewyds) > 1600 And Field2Integer(dblnewyds) <= 1900 Then
' moRSCMat!qty = 6
' ElseIf Field2Integer(dblnewyds) > 1900 And Field2Integer(dblnewyds) <= 2200 Then
' moRSCMat!qty = 7
' ElseIf Field2Integer(dblnewyds) > 2200 And Field2Integer(dblnewyds) <= 2500 Then
' moRSCMat!qty = 8
' ElseIf Field2Integer(dblnewyds) > 2500 And Field2Integer(dblnewyds) <= 2800 Then
' moRSCMat!qty = 9
' ElseIf Field2Integer(dblnewyds) > 2800 And Field2Integer(dblnewyds) <= 3100 Then
' moRSCMat!qty = 10
' ElseIf Field2Integer(dblnewyds) > 3200 And Field2Integer(dblnewyds) <= 3500 Then
' moRSCMat!qty = 11
' ElseIf Field2Integer(dblnewyds) > 3500 And Field2Integer(dblnewyds) <= 3800 Then
' moRSCMat!qty = 12
' End If
End If
moRSCMat.Update
End If
'Latex Caulking
strSELECT = "inv_no = '1820'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If gboolPULTE Then
moRSCMat.Delete
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 100) * 1.25) + 0.49)
' moRSCMat.Update
Else
moRSCMat!qty = Int(((Field2Integer(dblMATYDS) / 25) * 1.5) + 0.99)
moRSCMat.Update
End If
End If
End If
strSELECT = "inv_no = '1822'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1822'" 'XTRA 9500 Caulk
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((Field2Integer(dblMATYDS) / 75)) + 0.99)
moRSCMat.Update
Else
moRSCMat!qty = Int(((Field2Integer(dblMATYDS) / 75)) + 0.99)
moRSCMat.Update
End If
' If Not moRSCMat.EOF Then
' If Not moRSCMat!ch_flag Then
' If gboolPULTE Then
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 100) * 1.25) + 0.49)
' moRSCMat.Update
' Else
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 25) * 1.5) + 0.99)
' moRSCMat.Update
' End If
' End If
' End If
'Mesh Tape
strSELECT = "inv_no = '3200'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
moRSCMat!qty = Int((Field2Integer(dblMATYDS) / 90) + 0.99)
moRSCMat.Update
End If
End If
' End If
End If
Call MatLoad
If moRSProj!cont_id = 146 Or moRSProj!cont_id = 864 Then
' If moRSProj!Cont_ID = "146" Or moRSProj!Cont_ID = 864 Then
Call FIXTypar
End If
Call WrapMatPrices
Call UpInvoice
Exit Sub
Error_EH2:
If Err = 11 Then
Resume Next
End If
gstrMODULE = "Form LotInfo5 - Module MatCalcOne"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module MatCalcOne"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub WrapMatPrices()
Dim oRS As Recordset, oRSS As Recordset, strINV As String
Dim strSQL As String, strSQLL As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module WrapMatPrices"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub OrderMatPrices()
Dim oRS As Recordset, oRSS As Recordset, strINV As String
Dim strSQL As String, strSQLL As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
Do Until oRS.EOF
strINV = Field2Str(oRS!inv_no)
If strINV < "1000" Then
Else
' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'"
strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = " & Field2Str(oRS!inv_no) ' & "'"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
oRS!price = Field2Str2(oRSS!price)
oRS.Update
End If
oRSS.Close
End If
oRS.MoveNext
Loop
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module OrderMatPrices"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub MatCalcOne_20180629()
Dim dblRL As Double, dblBB As Double, dblDW As Double, dblSP As Double, intOpenPR As Integer, intUSEOpen As Integer
Dim dblBP As Double, dblFD12 As Double, dblFD1 As Double, dblFD28 As Double
Dim dblFD48 As Double, dblKote1 As Double, dblCMNT As Double, dblLime As Double
Dim dblSCmnt As Double, dblSLime As Double, dblS16 As Double, dblS20 As Double
Dim dblS30 As Double, dblRS As Double, dblBatch As Double, dblCALC As Double
Dim strSQL As String, strGET As String, strSELECT As String, vntTest As Variant
Dim oRSC As Recordset, oRC As Recordset, strSql2 As String, dblARL As Double
Dim dblSYN As Double, dblSYNP As Double, dblOPEN As Double, dblWire As Double
Dim strFIN2 As String, strFIN1 As String, intDELETE As Integer, boolDEDUCT As Boolean
Dim dblML As Double, dblAML As Double, dblNEWYDS As Double, dblPYRO As Double
Dim dblTP4, dblTP6, dblTP9, dblTPNail, dblTPCTape As Double, dblML2 As Double, dblRL2 As Double
Dim intTP9 As Integer, dblTYPAR As Double, strCHECK As String, mboolSilica As Boolean
Dim mboolBAG100 As Boolean, dblBAGSAND As Double, dblCalcBAGSAND As Double, dblSUB As Double
Dim dblBB3, dblDW3, dblRL3, dblF12_3 As Double, dblWRAP As Double
Dim dblBB5, dblRG125, dblRG15, dblPYRO5 As Double
On Error GoTo Error_EH
' ****** If errors are reported where quantities are being changed in material
' ****** when not wanted look at this -- oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
' Else
' oRC!QTY = dblBB
' oRC.Update
mboolBADD = False
mboolBAG100 = False
mboolSilica = False
If mstrWIRE <> "O" Then
MsgBox "Wire Type Is Incorrect for OneCoat - Correct in Projects", vbOKOnly, "Invalid Wire Type"
mboolBADD = True
Exit Sub
End If
dblPYRO = 1
intOpenPR = Field2Integer(moRS!openpr)
intUSEOpen = 100 - intOpenPR
dblWRAP = Int(Field2Double(moRS!opening))
' dblWRAP = Int(((Field2Double(moRS!opening) * intOpenPR) / 100) + 0.99)
dblOPEN = Int(((Field2Double(moRS!opening) * intUSEOpen) / 100) + 0.99)
' If Field2Integer(moRS!sq_yd) > 500 Then '****** changed per Jesse 10/13/12
If Field2Integer(moRS!sq_yd) > 300 Then '****** changed per Jesse 12/11/17
' If Field2Integer(moRS!sq_yd) > 400 Then
boolDEDUCT = True
dblNEWYDS = Field2Integer(moRS!sq_yd) - dblOPEN
' dblNEWYDS = Field2Integer(moRS!sq_yd) - Field2Integer(moRS!opening) '01/08/2018 corrected to use the opening balance
' dblNEWYDS = Field2Integer(moRS!sq_yd) ' + Field2Integer(moRS!opening) ' 01/04/2018 per Jesse removed all openings from calculations.
' dblNEWYDS = Field2Integer(moRS!sq_yd) + Field2Integer(moRS!opening)
Else
boolDEDUCT = False
dblNEWYDS = Field2Integer(moRS!sq_yd) '- dblOPEN
' dblNEWYDS = Field2Integer(moRS!sq_yd) - dblOPEN
' dblNEWYDS = Field2Integer(moRS!sq_yd) - Field2Integer(moRS!opening) '01/08/2018 corrected to use the opening balance
' dblNEWYDS = Field2Integer(moRS!sq_yd) '' 01/04/2018 per Jesse removed all openings from calculations.
End If
' dblOPEN = Int((Field2Double(moRS!opening) * 0.5) + 0.99)
'**** August 20, 2011 - Jesse had me change labor to subtract 10 from lath
'**** under 400 yds, 19 from lath labor on houses from 400 to 1000
'**** Also had me start taking openings off material yds on lots over 400
If moRSProj!use_open Then
' moRS!s_yds = (Field2Integer(dblnewyds) - dblOPEN) - 24
If Field2Integer(dblNEWYDS) > 500 Then
' If Field2Integer(dblNEWYDS) > 400 Then '**** changed per Jesse 10/13/2012
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) ' Change for Jesse 06/14/05
intDELETE = 19
' moRS!l_yds = (Field2Integer(dblNEWYDS) - dblOPEN) - intDELETE 'Changed 12/11/17 per Jesse
' moRS!s_yds = ((Field2Integer(dblNEWYDS) - dblOPEN) - intDELETE) - 5 'Changed 12/11/17 per Jesse
moRS!l_yds = (Field2Integer(dblNEWYDS)) - intDELETE 'Changed 12/11/17 per Jesse
moRS!s_yds = ((Field2Integer(dblNEWYDS)) - intDELETE) - 5 'Changed 12/11/17 per Jesse
Else
' moRS!l_yds = (Field2Integer(dblnewyds) - dblOPEN) - 19
' moRS!s_yds = (Field2Integer(dblnewyds) - dblOPEN) - 24
' moRS!l_yds = (Field2Integer(dblNEWYDS)) - 10 'Change per Jesse 08/22/05
' moRS!s_yds = (Field2Integer(dblNEWYDS)) - 15 'Change per Jesse 08/22/05
moRS!l_yds = (Field2Integer(dblNEWYDS)) - 10 'Change per Jesse 10/13/12
moRS!s_yds = (Field2Integer(dblNEWYDS)) - 15 'Change per Jesse 10/13/12
End If
Else
' moRS!s_yds = Field2Integer(dblnewyds) - 24
If Field2Integer(dblNEWYDS) > 500 Then
' If Field2Integer(dblNEWYDS) > 400 Then '**** changed per Jesse 10/13/2012
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
intDELETE = 19
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) ' Change for Jesse 06/14/05
moRS!l_yds = Field2Integer(dblNEWYDS) - intDELETE
moRS!s_yds = Field2Integer(dblNEWYDS) - intDELETE - 5
Else
' moRS!l_yds = Field2Integer(dblNEWYDS) - 10
' moRS!s_yds = Field2Integer(dblNEWYDS) - 15
moRS!l_yds = (Field2Integer(dblNEWYDS)) - 10 'Change per Jesse 10/13/12
moRS!s_yds = (Field2Integer(dblNEWYDS)) - 15 'Change per Jesse 10/13/12
End If
End If
strSQL = "DELETE * FROM tblLotMatrl WHERE RC_Flag and not ch_flag and lot_id = " & gintLOTID
goConn.Execute strSQL
strSELECT = "SELECT * FROM tblLotMatrl where lot_id = " & gintLOTID
Set moRSCMat = New Recordset
moRSCMat.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If moRSProj!stype <> "T" Then
'Black Paper
If IsNull(txtSuper12) Then
txtSuper12 = 0
End If
dblFD12 = CInt(txtSuper12)
If txtSuperSP > "" Then
dblSP = CDbl(txtSuperSP)
ElseIf dblSP = 0 Then
dblSP = (dblFD12 / 2)
Else
dblSP = 0
End If
'******* Need to determine ML quantity
moRSCMat.MoveFirst
strSELECT = "inv_no = '1370'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML = 0
Else
dblML = Field2Integer(moRSCMat!qty)
End If
' If Not dblML > 0 Then
If dblML > 0 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1375'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML2 = 0
Else
dblML2 = Field2Integer(moRSCMat!qty)
dblML = dblML + dblML2
dblML2 = 0
End If
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1375'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML = 0
Else
dblML = Field2Integer(moRSCMat!qty)
End If
End If
' If Not dblML > 0 Then
If dblML > 0 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1371'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML2 = 0
Else
dblML2 = Field2Integer(moRSCMat!qty)
dblML = dblML + dblML2
dblML2 = 0
End If
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1371'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblML = 0
Else
dblML = Field2Integer(moRSCMat!qty)
End If
End If
If txtSuperML > 5 Then
dblML2 = Field2Integer(txtSuperML)
dblML = dblML + dblML2 - 5
dblML2 = 0
End If
'********** Need to determine correct RL
' If txtSuperRL = "-2" Then ' Use Takeoff RL always per Jesse 05/15/18
'******* Need to make takeoff RL to be dblRL
moRSCMat.MoveFirst
strSELECT = "inv_no = '1330'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblRL = 0
Else
dblRL = Field2Integer(moRSCMat!qty)
End If
' Else
' If txtSuperRL = "-1" Then
' strSQL = "DELETE * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and inv_no = 1330"
' goConn.Execute strSQL
' End If
' If txtSuperRL > "0" Then
' dblRL = CInt(txtSuperRL)
' moRSCMat.MoveFirst
' strSELECT = "inv_no = '1330'"
' moRSCMat.Find strSELECT
' If moRSCMat.EOF Then
' moRSCMat.MovePrevious
' strGET = "SELECT * FROM tblInvtry where inv_no = 1330"
' Set oRSC = New Recordset
' oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
' moRSCMat.AddNew
' moRSCMat!Lot_id = gintLOTID
' moRSCMat!inv_no = "1330"
' moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!d_flag = Field2Str(oRSC!d_flag)
' moRSCMat!m_type = Field2Str(oRSC!m_type)
' moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
' moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
' ' moRSCMat!rc_flag = vbChecked
'' moRSCMat!qty = Field2Str2(txtSuperRL)
' moRSCMat!ch_flag = vbChecked
' moRSCMat.Update
' Else
'' moRSCMat!qty = Field2Str2(txtSuperRL)
' moRSCMat!ch_flag = vbChecked
' moRSCMat.Update
' End If
' End If
' End If
moRSCMat.MoveFirst
strSELECT = "inv_no = '1331'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
dblRL2 = 0
Else
dblRL2 = Field2Integer(moRSCMat!qty)
dblRL = dblRL + dblRL2
dblRL2 = 0
End If
'** Black Board and R Guard
If txtSuperBB > 0 Then
dblBB = CInt(txtSuperBB)
Else
' ElseIf moRSProj!bb Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblBB5 = Field2Str(moRSCMat!qty)
' Else
' dblBB = 0
End If
' ElseIf moRSProj!rg12 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblRG125 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
' ElseIf moRSProj!rg1 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblRG15 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
' ElseIf moRSProj!pyro Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblPYRO5 = Field2Str2(moRSCMat!qty)
' txtSuperBB = Field2Str2(moRSCMat!Qty)
End If
End If
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If moRSProj!rg1 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If moRSProj!pyro Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If dblBB5 > 0 And moRSProj!bb Then
dblBB = dblBB5
End If
If dblRG125 > 0 And (moRSProj!rg12 Or moRSProj!rg1) Then
dblBB = dblRG125
End If
If dblRG15 > 0 And moRSProj!rg1 Then
dblBB = dblRG15
End If
If moRSProj!pyro Then
dblBB = dblPYRO5
End If
If txtSuperBB = -1 Then
Else
If moRSProj!bb Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1310'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1310'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
Else
If moRSProj!rg12 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1315'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1315'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
ElseIf moRSProj!rg1 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1317'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!Qty = Field2Str(txtSuperBB)
moRSCMat!qty = dblBB
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
' strSELECT = "inv_no = '1317'"
' moRSCMat.Find strSELECT
' dblBB = Field2Str(moRSCMat!Qty)
ElseIf moRSProj!pyro Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1805'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblPYRO
' moRSCMat!qty = Field2Str(txtSuperBB)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
strSELECT = "inv_no = '1805'"
moRSCMat.Find strSELECT
dblBB = Field2Str(moRSCMat!qty)
End If
End If
End If
'*** Calc Black Paper
If moRSProj!bp_type = "" Then
' response = MsgBox("No BlackPaper is Defined in Subdivision Code - " & moRSProj!proj_code, vbOKOnly, "Black Paper Error")
' MsgBox("No BlackPaper is Defined in Subdivision Code - " & moRSProj!proj_code, vbOKOnly, "Black Paper Error") = vbOK
MsgBox "No BlackPaper is Defined for this Subdivision"
Exit Sub
End If
If moRSProj!bp_type = "B1" Then '1 Roll of BP plus sheer
dblBP = 1 + Int((((dblSP * 32) / 9) / 33) + 0.99)
End If
If moRSProj!bp_type = "B2" Then 'double cover sheer and BB
If moRSProj!bb Then
dblBP = Int(((((dblFD12 * 1.77) + ((dblBB * 3.5) + (dblSP * 3.5)) * 2)) / 33) + 0.99)
Else
dblBP = Int(((((dblFD12 * 1.77) + (dblSP * 3.5) * 2)) / 33) + 0.99)
End If
End If
If moRSProj!bp_type = "BA" Then 'cover entire house once
dblBP = Int((CDbl(dblNEWYDS) / 33) + 0.99)
End If
If moRSProj!bp_type = "BC" Then 'cover entire house once plus sheer and BB
If dblNEWYDS < 325 Then
If moRSProj!bb Then
dblBP = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
Else
dblBP = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
' dblBP = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) + (dblFD12 * 1.77) + (dblSP * 3.5)) / 33) + 0.99)
End If
Else
If moRSProj!bb Then
dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
Else
dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblBB * 3.5) + (dblSP * 3.5)) / 33) + 0.99)
' dblBP = Int(((CDbl(dblNEWYDS) + (dblFD12 * 1.77) + (dblSP * 3.5)) / 33) + 0.99)
End If
End If
End If
If moRSProj!bp_type = "BF" Then 'double cover under 1/2 foam
dblBP = Int((((dblFD12 * 1.77) * 2) / 33) + 0.99)
End If
If moRSProj!bp_type = "BS" Then 'double cover sheer panel only
dblBP = Int((((dblSP * 3.5) * 2) / 33) + 0.99)
End If
If moRSProj!bp_type = "BD" Then 'double cover entire house
If dblNEWYDS > 325 Then
dblBP = Int(((CDbl(dblNEWYDS) * 2) / 33) + 0.99)
Else
dblBP = Int((((CDbl(dblNEWYDS) + dblOPEN) * 2) / 33) + 0.99)
End If
End If
' If moRSProj!bp_type = "TV" Then 'cover entire house once
' dblBP = Int(((CDbl(dblNEWYDS)) / 30) + 0.99)
' End If
If moRSProj!bp_type = "TV" Then 'TYVEK Commercial Calculation
dblBP = Int(((CDbl(dblNEWYDS)) / 100) + 0.99)
End If
If moRSProj!bp_type = "BR" Then 'TYPAR Calculation for Ryland
dblBP = Int((((dblFD12 * 1.77)) / 16) + 0.99)
End If
If moRSProj!bp_type = "BT" Then 'cover entire house once plus sheer and BB
If moRSProj!bb Then
dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 33) + 0.99)
Else
dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 33) + 0.99)
End If
End If
If moRSProj!bp_type = "B6" Then 'cover entire house once with 60 min paper plus sheer and BB
'For 60 minute, use 1/2 foam divided by 16
' If moRSProj!bb Then
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 20) + 0.99)
' Else
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 20) * 1.5) + 0.99)
' End If
dblBP = Int((((dblFD12 * 1.77)) / 16) + 0.99)
End If
If moRSProj!bp_type = "B7" Then 'cover entire house once with 2 ply paper plus sheer and BB
If moRSProj!bb Then
dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 16) + 0.99)
Else
dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 16)) + 0.99) 'Changed 10/12/15 per jesse
' dblBP = Int((((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 16) * 1.5) + 0.99)
End If
End If
If moRSProj!bp_type = "TV" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1815' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1815'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1816' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1816'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
' moRSCMat!qty = ((dblBP * 3) * 0.9)
moRSCMat.Update
Else
oRC!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
oRC.Update
End If
ElseIf moRSProj!bp_type = "TC" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1817' and lot_id = " & gintLOTID 'Material is TYVEK STRAIT FLASH
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1817'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1816' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1816'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
' moRSCMat!qty = ((dblBP * 3) * 0.9)
moRSCMat.Update
Else
oRC!qty = Int(((CDbl(dblNEWYDS)) / 300) + 0.99)
oRC.Update
End If
ElseIf moRSProj!bp_type = "B6" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
ElseIf moRSProj!bp_type = "B7" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1811' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1811'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
ElseIf moRSProj!bp_type = "BR" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1810' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1810'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
Else
oRC!qty = dblBP
oRC.Update
End If
End If
'Stucco Wire
'Changed the Yardage figure to match what is used for all of the calculations (dblNEWYDS instead of txtTtlYdge)
'to calc wire better for Jesse 12/14/17
dblWire = Field2Integer(txtWireAdj) 'RL reducing Wire calculation
' If dblRL > 5 Then
dblARL = Int(((dblRL) * 1.77) + 0.99)
' dblARL = Int(((dblRL - 5) * 1.77) + 0.99)
' Else
' dblARL = 0
' dblARL = Int(((dblRL) * 1.77) + 0.99)
' End If
If dblML > 5 Then
dblAML = Int(((dblML - 5) * 1.77) + 0.99)
Else
dblAML = 0
End If
'**** Wire Yardage CHanged to 40 yards at Jesse's request on June 28, 2005
'**** Wire Yardage CHanged to 45 yards at Jesse's request on June 28, 2005
'**** Wire Yardage CHanged to 50 yards at Jesse's request on March 24, 2010
'**** Wire Yardage CHanged to 45 yards at Jesse's request on June 28, 2005
If CDbl(txtTtlYdge) < 350 Then
' dblCALC = Int((((CDbl(txtTtlYdge)) - (dblAML + dblARL + dblWire)) / 45) + 0.49)
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblAML + dblARL + dblWire)) / 50) + 0.99)
dblCALC = Int((((CDbl(dblNEWYDS) + CDbl(moRS!opening)) - (dblAML + dblARL + dblWire)) / 45) + 0.99)
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblARL + dblWire)) / 40) + 0.99)
' dblCALC = Int((((CDbl(txtTtlYdge) + CDbl(moRS!opening)) - (dblARL + dblWire)) / 50) + 0.99)
Else
dblCALC = Int(((CDbl(dblNEWYDS) - (dblAML + dblARL + dblWire)) / 45) + 0.49)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblAML + dblARL + dblWire)) / 45) + 0.49)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblAML + dblARL + dblWire)) / 45) + 0.99)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblARL + dblWire)) / 40) + 0.99)
' dblCALC = Int(((CDbl(txtTtlYdge) - (dblARL + dblWire)) / 50) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1410' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1410'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = "1410"
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblCALC
moRSCMat.Update
dblCALC = 0
Else
oRC!qty = dblCALC
oRC.Update
End If
'Calculate Typar Stucco Wrap
If moRSProj!TYPAR Then
' dblTYPAR = Int((Field2Integer(txtTTLYds) / 90) + 0.99)
dblTYPAR = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 70) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to take into consideration overlap
' dblTYPAR = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 90) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTYPAR = Int((Field2Integer(txtTtlYdge) / 90) + 0.99) 'Changed 7/22/2015 after discussion with BBart/JR
' intTP45 = 1 'combined all typar into 1 calcuation
intTP9 = dblTYPAR '- intTP45
dblTP4 = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 100) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTP6 = Int((Field2Integer(txtTtlYdge) / 100) + 0.99) 'Changed 10/17/17 No Longer using 6 in tape
dblTP9 = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 500) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
dblTPNail = Int(((Field2Integer(txtTtlYdge) + dblWRAP) / 250) + 0.99) 'Changed 5/7/2018 after discussion with Jesse to include total yardage of house
' dblTP9 = Int((Field2Integer(txtTtlYdge) / 500) + 0.99)
' dblTPNail = Int((Field2Integer(txtTtlYdge) / 250) + 0.99)
dblTPCTape = intTP9
' strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = 3310 and lot_id = " & gintLOTID
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3300' and lot_id = " & gintLOTID ' To Delete
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
Else
oRC.Delete
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3310' and lot_id = " & gintLOTID
' strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = 3300 and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3310' and Inv_Type = " & gbytINV_TYPE
' strSELECT = "SELECT * FROM tblINVtry where Inv_no = 3300 and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = intTP9
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = intTP9
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3324' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3324' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
' moRSCMat!qty = (dblTP4 * 2) ' Changed 10/17/17 per JR & Jesse
moRSCMat!qty = (dblTP4 * 4) ' Changed 11/14/17 per JR so Supers do not need to request more 4"
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
' oRC!qty = (dblTP4 * 2) ' Changed 10/17/17 per JR & Jesse
oRC!qty = (dblTP4 * 4) ' Changed 11/14/17 per JR so Supers do not need to request more 4"
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3326' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3329' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3329' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3329' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then '**********
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = 1
' moRSCMat!qty = dblTP9 ' May need to use this if coming up short. Super should hang on to extra butyl
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
'' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = dblTP9
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '1831' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '1831' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblTPNail
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = dblTPNail
oRC.Update
End If
strCHECK = "SELECT * FROM tblLotMatrl WHERE inv_no = '3320' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strCHECK, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strSELECT = "SELECT * FROM tblINVtry where Inv_no = '3320' and Inv_Type = " & gbytINV_TYPE
Set oRSC = New Recordset
oRSC.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = dblTPCTape
moRSCMat!price = Field2Str(oRSC!tprice)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Str(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' moRSCMat!cflag = vbChecked
' moRSCMat!trnsflag = vbChecked
moRSCMat.Update
End If
Else
oRC!qty = dblTPCTape
oRC.Update
End If
End If
'Calculate 1 Kote, Cement, Lime, and Sand for the Current House
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3110' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3110'" 'Plastic
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 700) + 0.99)
moRSCMat.Update
Else
oRC!qty = Int((Field2Integer(dblNEWYDS) / 700) + 0.99)
oRC.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3220'" 'Red Tape
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 150) + 0.99)
moRSCMat.Update
Else
oRC!qty = Int((Field2Integer(dblNEWYDS) / 150) + 0.99)
oRC.Update
End If
If moRSProj!stype = "S" Then ' SUPERWALL One Kote
If Field2Str2(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblNEWYDS) / 9) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '5220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '5220'" 'Superwall
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "B" Then ' SUPERWALL One Kote with synthetic texture
If Field2Str2(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblNEWYDS) / 9) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '5220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '5220'" 'Superwall
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "W" Then ' WESTERN One Kote
If Field2Str(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblNEWYDS) / 10) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2210' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2210'" 'WESTERN
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "M" Then 'Now PREMIX Western One KOTE Not MAGNA WALL One Kote
' If Field2Str2(moRSProj!sw_order) > 0 Then
If Field2Double(moRSProj!sw_order) > 0 Then
dblKote1 = Int(CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) ' + 0.99)
' dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblNEWYDS) / 8) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2250' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2250'" 'Western PREMIX
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRSProj!stype = "N" Then ' SanMan Silo One Kote
If Field2Str(moRSProj!sw_order) > 0 Then
dblKote1 = Int((CDbl(dblNEWYDS) / CDbl(moRSProj!sw_order)) + 0.99)
Else
dblKote1 = Int((CDbl(dblNEWYDS) / 10) + 0.99)
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2260' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2260'" 'San Man Silo
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblKote1
moRSCMat.Update
Else
oRC!qty = dblKote1
oRC.Update
End If
End If
If moRS!texture = "" Then
MsgBox "No Texture is Selected for This House - Check the Plan"
Exit Sub
End If
'This caluclates the materials needed for the primary texture
'mboolbag100
strGET = "SELECT * FROM tblFinish where ID = '" & Field2Str(moRS!texture) & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
If Not ((Field2Str2(oRSC!s16) > 0) Or (Field2Str2(oRSC!s20) > 0) Or (Field2Str2(oRSC!s30) > 0)) Then
If moRSProj!bag100 Or mboolPSW Then
mboolBAG100 = True
dblCalcBAGSAND = Field2Str2(moRSProj!bagdollars)
Else
mboolSilica = True
End If
Else
mboolSilica = True
End If
End If
strFIN2 = Field2Str(oRSC!Secondary)
strFIN1 = Field2Str(oRSC!Primary)
If moRS!fin2 > 0 Then
' If moRS!texture = "SK" Or moRS!texture = "DA" Or moRS!texture = "SA" Or moRS!texture = "SM" Or moRS!texture = "QU" Or moRS!texture = "MN" Then
If oRSC!Secondary = "" Or IsNull(oRSC!Secondary) Then
' If moRS!texture <> "DF" And moRS!texture <> "SB" And moRS!texture <> "MF" Then
moRS!fin2 = 0
moRS.Update
End If
End If
dblBatch = Int((((Field2Integer(dblNEWYDS))) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Str2(oRSC!cmnt) > 0 Then
dblCMNT = Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
Else
dblCMNT = 0
End If
If Field2Str2(oRSC!lime) > 0 Then
dblLime = Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
Else
dblLime = 0
End If
If Field2Str2(oRSC!s16) > 0 Then
dblS16 = Int((dblBatch * Field2Str2(oRSC!s16)) + 0.99)
Else
dblS16 = 0
End If
If Field2Str2(oRSC!s20) > 0 Then
dblS20 = Int((dblBatch * Field2Str2(oRSC!s20)) + 0.99)
Else
dblS20 = 0
End If
If Field2Str2(oRSC!s30) > 0 Then
dblS30 = Int((dblBatch * Field2Str2(oRSC!s30)) + 0.99)
Else
dblS30 = 0
End If
If Not mboolBAG100 Then
If Field2Integer(oRSC!brs) > 0 Then
dblRS = Int((((dblKote1 * Field2Integer(oRSC!brs)) + (dblBatch * Field2Integer(oRSC!trs)) + Field2Integer(oRSC!xrs)) / 2000) + 0.99)
Else
dblRS = 0
End If
End If
If mboolBAG100 And Not mboolPSW Then
dblBAGSAND = Int((dblCMNT * dblCalcBAGSAND) + 0.99)
ElseIf mboolPSW Then
dblBAGSAND = Int(((dblKote1 + dblCMNT) * dblCalcBAGSAND) + 0.99)
End If
If Field2Str(oRSC!id) = "SB" Then 'this calculates the synthetic needed for the base coat
If Field2Double(moRSProj!syn_o) > 0 Then
dblSYN = Int(((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(moRSProj!syn_o)) + 0.99)
Else
dblSYN = Int(((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!fin2)) - 10) * 9) / Field2Double(oRSC!yds)) + 0.99)
End If
End If
'This calculates the additional materials needed for the second texture
On Error GoTo Error_EH2
If moRS!fin2 > 0 Then
If strFIN2 = "SB" Then 'This calculates the synthetic needed for the second texture
' If Field2Str(oRSC!id) = "SB" Then 'This calculates the synthetic needed for the second texture
If Field2Integer(moRSProj!syn_o2) > 0 Then
dblSYNP = Int(((Field2Integer(moRS!fin2) * 9) / Field2Double(moRSProj!syn_o2)) + 0.99)
' Exit Sub
Else
dblSYNP = Int(((Field2Integer(moRS!fin2) * 9) / Field2Double(oRSC!s_yds)) + 0.99)
' Exit Sub
End If
' ElseIf Field2Str(moRS!texture) = "DF" Or Field2Str(moRS!texture) = "MF" Then
ElseIf Not (strFIN2 = "" Or strFIN2 = "0" Or IsNull(strFIN2)) Then
strGET = "SELECT * FROM tblFinish where ID = '" & strFIN2 & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
If Field2Integer(oRSC!yds) > 0 Then
dblBatch = Int((Field2Integer(moRS!fin2) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Double(oRSC!cmnt) > 0 Then
dblCMNT = dblCMNT + Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
Else
dblCMNT = 0
End If
If Field2Integer(oRSC!lime) > 0 Then
dblLime = dblLime + Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
Else
dblLime = 0
End If
If Field2Str2(oRSC!s16) > 0 Then
dblS16 = dblS16 + Int((dblBatch * Field2Str2(oRSC!s16)) + 0.99)
'Else
' dblS16 = 0
End If
If Field2Str2(oRSC!s20) > 0 Then
dblS20 = dblS20 + Int((dblBatch * Field2Str2(oRSC!s20)) + 0.99)
'Else
' dblS20 = 0
End If
If Field2Str2(oRSC!s30) > 0 Then
dblS30 = dblS30 + Int((dblBatch * Field2Str2(oRSC!s30)) + 0.99)
'Else
' dblS30 = 0
End If
End If
End If
End If
On Error GoTo Error_EH
If dblCMNT > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2410' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2410'" 'Cement
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblCMNT
moRSCMat.Update
End If
End If
If dblLime > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2430' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2430'" 'Lime
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblLime
moRSCMat.Update
End If
End If
If dblS16 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2316' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2316'" 'Silica 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2366' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2366'" 'Marble Sand 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
End If
End If
If dblS20 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2320' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2320'" 'Silica 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2370' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2370'" 'Marble Sand 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
Else
oRSC!qty = dblS20
oRSC.Update
End If
End If
End If
If dblS30 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2330' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2330'" 'Silica 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2380' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2380'" 'Marble Sand 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
End If
End If
' If mboolBAG100 Then
' dblBAGSAND = Int((dblCMNT * dblCalcBAGSAND) + 0.99)
' End If
If dblBAGSAND > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2350' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2350'" 'Bag Sand
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBAGSAND
moRSCMat.Update
Else
oRC!qty = dblBAGSAND
oRC.Update
End If
End If
If dblSYNP > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2601' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2601'" 'EIFS SANDBLAST Second Color
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSYNP
moRSCMat.Update
End If
End If
If dblSYN > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2600' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2600'" 'EIFS SANDBLAST
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSYN
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2610' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2610'" 'EIFS COLOR Fast
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((dblSYN + dblSYNP) / 10) + 0.99)
moRSCMat.Update
End If
End If
'Calculate the Bag Sand
If dblRS > 0 And Not mboolSilica Then
txtSand = dblRS
Else
txtSand = 0
End If
'Calculate Foam
If txt28Foam = 0 Then
txt28Foam = 25
End If
If Field2Integer(dblNEWYDS) < 325 Then
dblFD1 = Int(((((Field2Integer(dblNEWYDS) + CDbl(moRS!opening)) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
Else
dblBB3 = (dblBB * 3.5)
dblDW3 = (dblDW * 3.5)
dblRL3 = (dblRL * 1.77)
dblF12_3 = (dblFD12 * 1.77)
dblSUB = (((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77)) / 1.77)
' dblFD1 = Int((Field2Integer(dblNEWYDS) - Field2Integer(moRS!f_adj)) - dblSUB + 0.99)
dblFD1 = Int((((Field2Integer(dblNEWYDS) - Field2Integer(moRS!f_adj)) - ((dblBB * 3.5) + (dblDW * 3.5) + (dblRL * 1.77) + (dblFD12 * 1.77))) / 1.77) + 0.99)
End If
dblFD28 = Int(((dblFD1 * Field2Integer(txt28Foam)) / 100) + 0.99)
dblFD48 = Int(((dblFD1 - dblFD28) / 2) + 0.99)
If moRSProj!ftype = "O" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1211' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1211'" '2X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD28
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1241' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1241'" '4X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD48
moRSCMat.Update
End If
End If
If moRSProj!ftype = "T" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1211' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1211'" '2X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD28
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1241' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1241'" '4X8 sheets of 1" Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD48
moRSCMat.Update
End If
End If
If moRSProj!ftype = "D" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1250' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1250'" '2X8 sheets of Dow Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblFD1
moRSCMat.Update
End If
End If
If moRSProj!ftype = "U" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1260' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1260'" '4X8 sheets of Urethane Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((dblFD1 / 2) + 0.99)
moRSCMat.Update
End If
End If
If txtSuper12 > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1230' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1230'" '2X8 sheets of 1/2 inch Foam
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Field2Str(txtSuper12)
moRSCMat.Update
Else
oRC!qty = Field2Str(txtSuper12)
oRC.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1230' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenDynamic, adLockOptimistic
If Not oRC.EOF Then
oRC.Delete
End If
End If
'Calculate Nails
strSELECT = "inv_no = '1610'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then 'Changed 11/1/17 per Rose
' If Field2Integer(dblNEWYDS) <= 450 Then
If Field2Integer(dblNEWYDS) <= 2200 Then
moRSCMat!qty = 1
' ElseIf Field2Integer(dblNEWYDS) > 450 And Field2Integer(dblNEWYDS) <= 750 Then
' moRSCMat!qty = 1.5
' ElseIf Field2Integer(dblNEWYDS) > 750 And Field2Integer(dblNEWYDS) <= 1000 Then
' moRSCMat!qty = 2
' ElseIf Field2Integer(dblNEWYDS) > 1000 And Field2Integer(dblNEWYDS) <= 1450 Then
' moRSCMat!qty = 2.5
' ElseIf Field2Integer(dblNEWYDS) > 1450 And Field2Integer(dblNEWYDS) <= 1750 Then
' moRSCMat!qty = 3
' ElseIf Field2Integer(dblNEWYDS) > 1750 And Field2Integer(dblNEWYDS) <= 2000 Then
' moRSCMat!qty = 3.5
End If
End If
moRSCMat.Update
End If
'Calculate Staples
strSELECT = "inv_no = '1710'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 250 Then
moRSCMat!qty = 1
Else
moRSCMat!qty = Round(((Field2Integer(dblNEWYDS) / 230) + 0.05), 1)
End If
End If
moRSCMat.Update
End If
strSELECT = "inv_no = '1720'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 230 Then
moRSCMat!qty = 1
Else
moRSCMat!qty = Round(((Field2Integer(dblNEWYDS) / 230) + 0.05), 1)
End If
End If
moRSCMat.Update
End If
'Rapid Staples
strSELECT = "inv_no = '1730'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 280 Then
moRSCMat!qty = 1
Else
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 280) + 0.99))
End If
' If Field2Integer(dblnewyds) <= 400 Then
' moRSCMat!qty = 1
' ElseIf Field2Integer(dblnewyds) > 400 And Field2Integer(dblnewyds) <= 700 Then
' moRSCMat!qty = 2
' ElseIf Field2Integer(dblnewyds) > 700 And Field2Integer(dblnewyds) <= 1000 Then
' moRSCMat!qty = 3
' ElseIf Field2Integer(dblnewyds) > 1000 And Field2Integer(dblnewyds) <= 1300 Then
' moRSCMat!qty = 4
' ElseIf Field2Integer(dblnewyds) > 1300 And Field2Integer(dblnewyds) <= 1600 Then
' moRSCMat!qty = 5
' ElseIf Field2Integer(dblnewyds) > 1600 And Field2Integer(dblnewyds) <= 1900 Then
' moRSCMat!qty = 6
' ElseIf Field2Integer(dblnewyds) > 1900 And Field2Integer(dblnewyds) <= 2200 Then
' moRSCMat!qty = 7
' ElseIf Field2Integer(dblnewyds) > 2200 And Field2Integer(dblnewyds) <= 2500 Then
' moRSCMat!qty = 8
' ElseIf Field2Integer(dblnewyds) > 2500 And Field2Integer(dblnewyds) <= 2800 Then
' moRSCMat!qty = 9
' ElseIf Field2Integer(dblnewyds) > 2800 And Field2Integer(dblnewyds) <= 3100 Then
' moRSCMat!qty = 10
' ElseIf Field2Integer(dblnewyds) > 3200 And Field2Integer(dblnewyds) <= 3500 Then
' moRSCMat!qty = 11
' ElseIf Field2Integer(dblnewyds) > 3500 And Field2Integer(dblnewyds) <= 3800 Then
' moRSCMat!qty = 12
' End If
End If
moRSCMat.Update
End If
'Latex Caulking
strSELECT = "inv_no = '1820'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If gboolPULTE Then
moRSCMat.Delete
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 100) * 1.25) + 0.49)
' moRSCMat.Update
Else
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 25) * 1.5) + 0.99)
moRSCMat.Update
End If
End If
End If
strSELECT = "inv_no = '1822'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = 1822" 'XTRA 9500 Caulk
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 75)) + 0.99)
moRSCMat.Update
Else
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 75)) + 0.99)
moRSCMat.Update
End If
' If Not moRSCMat.EOF Then
' If Not moRSCMat!ch_flag Then
' If gboolPULTE Then
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 100) * 1.25) + 0.49)
' moRSCMat.Update
' Else
' moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 25) * 1.5) + 0.99)
' moRSCMat.Update
' End If
' End If
' End If
'Mesh Tape
strSELECT = "inv_no = '3200'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 90) + 0.99)
moRSCMat.Update
End If
End If
' End If
End If
Call MatLoad
If moRSProj!cont_id = 146 Or moRSProj!cont_id = 864 Then
' If moRSProj!Cont_ID = "146" Or moRSProj!Cont_ID = 864 Then
Call FIXTypar
End If
Exit Sub
Error_EH2:
If Err = 11 Then
Resume Next
End If
gstrMODULE = "Form LotInfo5- Module MatCalcOne"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5 - Module MatCalcOne"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub MatCalcThree()
Dim dblRL As Double, dblDW As Double, dblSP As Double
Dim dblBP As Double, dblFD12 As Double, dblFD1 As Double, dblFD28 As Double
Dim dblTLime As Double, dblTCMNT As Double, dblCMNT As Double, dblLime As Double
Dim dblSCmnt As Double, dblSLime As Double, dblS16 As Double, dblS20 As Double
Dim dblS30 As Double, dblRS As Double, dblBatch As Double, dblCALC As Double, dblSYN As Double
Dim strSQL As String, strGET As String, strSELECT As String, vntTest As Variant
Dim oRSC As Recordset, oRST As Recordset, oRC As Recordset, strSql2 As String
Dim dblOPEN As Double, dblARL As Double, intDELETE As Integer
Dim strFIN2 As String, strFIN1 As String, dblWire As Double
Dim dblNEWYDS As Double, boolDEDUCT As Boolean, dblBB As Double
On Error GoTo Error_EH
mboolBADD = False
If mstrWIRE = "O" Then
MsgBox "Wire Type Is Incorrect for ThreeCoat - Correct in Projects", vbOKOnly, "Invalid Wire Type"
mboolBADD = True
Exit Sub
End If
If Field2Integer(moRS!sq_yd) > 400 Then
boolDEDUCT = True
dblNEWYDS = Field2Integer(moRS!sq_yd) ' + Field2Integer(moRS!opening)
' dblNEWYDS = Field2Integer(moRS!sq_yd) + Field2Integer(moRS!opening)
Else
boolDEDUCT = False
dblNEWYDS = Field2Integer(moRS!sq_yd)
End If
dblOPEN = Int((Field2Double(moRS!opening) * 0.5) + 0.99)
'**** August 20, 2011 - Jesse had me change labor to subtract 10 from lath
'**** under 400 yds, 19 from lath labor on houses from 400 to 1000
'**** Also had me start taking openings off material yds on lots over 400
If moRSProj!use_open Then
moRS!s_yds = (Field2Integer(dblNEWYDS) - dblOPEN) - 24
If Field2Integer(dblNEWYDS) > 400 Then
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) 'Change for Jesse 06/14/2005
intDELETE = 0 ' changed from 19 to 0 per Jesse 01/13/18
moRS!l_yds = (Field2Integer(dblNEWYDS) - dblOPEN) - intDELETE
Else
' moRS!l_yds = (Field2Integer(dblnewyds) - dblOPEN) - 19
' moRS!l_yds = (Field2Integer(dblNEWYDS)) - 5 'Change per Jesse 08/22/05
moRS!l_yds = (Field2Integer(dblNEWYDS)) 'Change per Jesse 08/01/18
End If
Else
moRS!s_yds = Field2Integer(dblNEWYDS) - 5 'Change per Jesse 08/01/18
' moRS!s_yds = Field2Integer(dblNEWYDS) - 5
If Field2Integer(dblNEWYDS) > 400 Then
' intDELETE = Int((Field2Integer(dblnewyds) * 0.06) + 0.99)
' intDELETE = Int((Field2Integer(dblNEWYDS) * 0.05) + 0.99) 'Change for Jesse 06/14/2005
intDELETE = 0 ' changed from 19 to 0 per Jesse 01/13/18
' intDELETE = 19
moRS!l_yds = Field2Integer(dblNEWYDS) - intDELETE
Else
moRS!l_yds = Field2Integer(dblNEWYDS) ' Change for Jesse 08/01/2018
' moRS!l_yds = Field2Integer(dblNEWYDS) - 5
End If
End If
strSQL = "DELETE * FROM tblLotMatrl WHERE RC_Flag and not CH_Flag and lot_id = " & gintLOTID
goConn.Execute strSQL
strSELECT = "SELECT * FROM tblLotMatrl where lot_id = " & gintLOTID
Set moRSCMat = New Recordset
moRSCMat.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
If txtSuperRL = -1 Then
strSQL = "DELETE * FROM tblLotMatrl WHERE lot_id = " & gintLOTID & " and inv_no = '1330'"
goConn.Execute strSQL
End If
If txtSuperRL > 0 Then
dblRL = CInt(txtSuperRL)
moRSCMat.MoveFirst
strSELECT = "inv_no = '1330'"
moRSCMat.Find strSELECT
If moRSCMat.EOF Then
moRSCMat.MovePrevious
strGET = "SELECT * FROM tblInvtry where inv_no = '1330'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = "1330"
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
' moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Field2Str2(txtSuperRL)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
Else
moRSCMat!qty = Field2Str2(txtSuperRL)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
End If
End If
'Black Board
If txtSuperBB > 0 Then
dblBB = CInt(txtSuperBB)
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
dblBB = Field2Str(moRSCMat!qty)
Else
dblBB = 0
End If
End If
moRSCMat.MoveFirst
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
Else
moRSCMat.MoveFirst
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If moRSProj!rg1 Then
moRSCMat.MoveFirst
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
End If
If txtSuperBB = -1 Then
Else
If moRSProj!bb Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1310'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = Field2Str(txtSuperBB)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
strSELECT = "inv_no = '1310'"
moRSCMat.Find strSELECT
dblBB = Field2Str(moRSCMat!qty)
Else
If moRSProj!rg12 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1315'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = Field2Str(txtSuperBB)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
strSELECT = "inv_no = '1315'"
moRSCMat.Find strSELECT
dblBB = Field2Str(moRSCMat!qty)
ElseIf moRSProj!rg1 Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1317'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!qty = Field2Str(txtSuperBB)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!ch_flag = vbChecked
moRSCMat.Update
strSELECT = "inv_no = '1317'"
moRSCMat.Find strSELECT
dblBB = Field2Str(moRSCMat!qty)
End If
End If
End If
'Stucco Wire
'Paperback wire
If mstrWIRE = "P" Then
dblWire = Field2Integer(txtWireAdj)
If txtSuperSP > 0 Then
dblSP = Field2Str(txtSuperSP)
Else
dblSP = 0
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1450' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1450'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
If dblRL > 10 Then
dblARL = Int(((dblRL - 10) * 1.77) + 0.99)
Else
dblARL = 0
' dblARL = Int(((dblRL) * 1.77) + 0.99)
End If
dblCALC = Int(((CDbl(txtTtlYdge) - (dblSP * 3.5) - dblARL - dblWire) / 33) + 0.99)
moRSCMat!qty = dblCALC
moRSCMat.Update
dblCALC = 0
End If
End If
'Self Furing wire
If mstrWIRE = "F" Then
' If dblSP > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1417' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1417'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
' dblCALC = Int(((dblSP * 3.5) / 45) + 0.99)
' dblCALC = Int(((dblSP * 3.5) / 50) + 0.99)
dblCALC = Int(((CDbl(txtTtlYdge) - (dblSP * 3.5) - dblARL - dblWire) / 45) + 0.99)
moRSCMat!qty = dblCALC
moRSCMat.Update
dblCALC = 0
End If
End If
'Black Paper
If txtSuperSP > 0 Then
dblSP = CDbl(txtSuperSP)
Else
dblSP = 0
End If
' If moRSProj!bp_type = "B6" Then 'cover entire house once plus sheer and BB
' If moRSProj!bb Then
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5) + (dblBB * 3.5)) / 20) + 0.99)
' Else
' dblBP = Int(((CDbl(dblNEWYDS) + (dblSP * 3.5)) / 20) + 0.99)
' End If
' End If
' If dblSP > 0 Then
If moRSProj!bp_type = "B6" Then
If dblSP > 0 Then
dblBP = ((Field2Integer(dblNEWYDS) - (dblSP * 3.5)) / 20)
dblBP = dblBP + (((dblSP * 3.5) / 20) * 2)
dblBP = Int(dblBP + 0.99)
Else
dblBP = Int((Field2Integer(dblNEWYDS) / 20) + 0.99)
End If
ElseIf moRSProj!bp_type = "B7" Then
If dblSP > 0 Then
dblBP = ((Field2Integer(dblNEWYDS) - (dblSP * 3.5)) / 16)
dblBP = dblBP + (((dblSP * 3.5) / 16)) ' Changed 10/12/15 per Jesse
' dblBP = dblBP + (((dblSP * 3.5) / 20) * 2)
dblBP = Int(dblBP + 0.99)
Else
dblBP = Int((Field2Integer(dblNEWYDS) / 16) + 0.99)
End If
ElseIf moRSProj!bp_type <> "B6" Or moRSProj!bp_type <> "B7" Then
If dblSP > 0 Then
dblBP = ((Field2Integer(dblNEWYDS) - (dblSP * 3.5)) / 33)
dblBP = dblBP + (((dblSP * 3.5) / 33) * 2)
dblBP = Int(dblBP + 0.99)
Else
dblBP = Int((Field2Integer(dblNEWYDS) / 33) + 0.99)
End If
End If
If moRSProj!bp_type = "B6" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1809' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1809'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
End If
End If
If moRSProj!bp_type = "B7" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1811' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1811'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
End If
End If
If moRSProj!bp_type <> "B6" Or moRSProj!bp_type <> "B7" Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '1810' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1810'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblBP
moRSCMat.Update
End If
End If
'Calculate 1 Kote, Cement, Lime, and Sand for the Current House
strGET = "SELECT * FROM tblTCInfo"
Set oRST = New Recordset
oRST.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3110' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3110'" 'Plastic
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = "S"
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 700) + 0.99)
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '3220' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '3220'" 'Red Tape
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = "S"
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((Field2Integer(dblNEWYDS) / 150) + 0.99)
moRSCMat.Update
End If
'Scratch Coat
dblBatch = Int((dblNEWYDS / oRST!scr_yd) + 0.99)
dblSCmnt = (dblBatch * oRST!scr_cmnt)
dblSLime = (dblBatch * oRST!scr_lime)
dblRS = (dblBatch * oRST!scr_rs)
'Brown Coat
dblBatch = Int((dblNEWYDS / oRST!brn_yd) + 0.99)
dblCMNT = (dblBatch * oRST!brn_cmnt)
dblLime = (dblBatch * oRST!brn_lime)
dblRS = dblRS + (dblBatch * oRST!brn_rs)
'Texture Coat
'This caluclates the materials needed for the primary texture
strGET = "SELECT * FROM tblFinish where ID = '" & Field2Str(moRS!texture) & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
strFIN2 = Field2Str(oRSC!Secondary)
strFIN1 = Field2Str(oRSC!Primary)
If moRS!fin2 > 0 Then
If oRSC!Secondary = "" Or IsNull(oRSC!Secondary) Then
' If moRS!texture = "SK" Or moRS!texture = "DA" Or moRS!texture = "SA" Or moRS!texture = "SM" Or moRS!texture = "QU" Or moRS!texture = "MN" Then
moRS!fin2 = 0
moRS.Update
End If
End If
dblBatch = Int((((Field2Integer(dblNEWYDS) - 10) - Field2Integer(moRS!fin2)) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Str(oRSC!id) = "SB" Then
dblSYN = Int((((Field2Integer(dblNEWYDS) - 10) * 9) / Field2Integer(oRSC!yds)) + 0.5)
' dblSYN = Int(dblBatch + 0.5)
End If
If Field2Integer(oRSC!cmnt) > 0 Then
dblTCMNT = Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
Else
dblTCMNT = 0
End If
If Field2Integer(oRSC!lime) > 0 Then
dblTLime = Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
Else
dblTLime = 0
End If
If Field2Integer(oRSC!s16) > 0 Then
dblS16 = Int((dblBatch * Field2Integer(oRSC!s16)) + 0.99)
Else
dblS16 = 0
End If
If Field2Integer(oRSC!s20) > 0 Then
dblS20 = Int((dblBatch * Field2Integer(oRSC!s20)) + 0.99)
Else
dblS20 = 0
End If
If Field2Integer(oRSC!s30) > 0 Then
dblS30 = Int((dblBatch * Field2Integer(oRSC!s30)) + 0.99)
Else
dblS30 = 0
End If
If Field2Integer(oRSC!trs) > 0 Then
dblRS = dblRS + ((dblBatch * Field2Integer(oRSC!trs)) + Field2Integer(oRSC!xrs))
' Else
' dblRS = 0
End If
'This calculates the additional materials needed for the second texture
If moRS!fin2 > 0 Then
strGET = "SELECT * FROM tblFinish where ID = '" & strFIN2 & "'"
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockReadOnly
dblBatch = Int((Field2Integer(moRS!fin2) / Field2Integer(oRSC!yds)) + 0.99)
If Field2Str2(oRSC!cmnt) > 0 Then
dblTCMNT = dblTCMNT + Int((dblBatch * Field2Str2(oRSC!cmnt)) + 0.99)
' Else
' dblTCMNT = 0
End If
If Field2Str2(oRSC!lime) > 0 Then
dblTLime = dblTLime + Int((dblBatch * Field2Str2(oRSC!lime)) + 0.99)
' Else
' dblTLime = 0
End If
If Field2Integer(oRSC!s16) > 0 Then
dblS16 = dblS16 + Int((dblBatch * Field2Integer(oRSC!s16)) + 0.99)
' Else
' dblS16 = 0
End If
If Field2Integer(oRSC!s20) > 0 Then
dblS20 = dblS20 + Int((dblBatch * Field2Integer(oRSC!s20)) + 0.99)
' Else
' dblS20 = 0
End If
If Field2Integer(oRSC!s30) > 0 Then
dblS30 = dblS30 + Int((dblBatch * Field2Integer(oRSC!s30)) + 0.99)
' Else
' dblS30 = 0
End If
End If
dblRS = Int((dblRS / 2000) + 0.99)
If dblSYN > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2600' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2600'" 'EIFS SANDBLAST
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSYN
moRSCMat.Update
End If
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2610' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2610'" 'EIFS SANDBLAST
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Int((dblSYN / 10) + 0.5)
moRSCMat.Update
End If
End If
If dblCMNT > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2411' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2411'" 'Brown Cement
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblCMNT
moRSCMat.Update
End If
End If
If dblSCmnt > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2412' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2412'" 'Scratch Cement
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSCmnt
moRSCMat.Update
End If
End If
If dblTCMNT > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2410' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2410'" 'Texture Cement
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblTCMNT
moRSCMat.Update
End If
End If
If dblLime > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2431' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2431'" 'Brown Lime
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblLime
moRSCMat.Update
End If
End If
If dblSLime > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2432' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2432'" 'Scratch Lime
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblSLime
moRSCMat.Update
End If
End If
If dblTLime > 0 Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2430' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2430'" 'Texture Lime
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblTLime
moRSCMat.Update
End If
End If
If dblS16 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2316' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2316'" 'Silica 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2366' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2366'" 'Marble Sand 16
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS16
moRSCMat.Update
End If
End If
End If
If dblS20 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2320' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2320'" 'Silica 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2370' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2370'" 'Marble Sand 20
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS20
moRSCMat.Update
End If
End If
End If
If dblS30 > 0 Then
If moRSProj!silica Then
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2330' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2330'" 'Silica 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
Else
strSql2 = "SELECT * FROM tblLotMatrl WHERE inv_no = '2380' and lot_id = " & gintLOTID
Set oRC = New Recordset
oRC.Open strSql2, goConn, adOpenForwardOnly, adLockOptimistic
If oRC.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '2380'" 'Marble Sand 30
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = dblS30
moRSCMat.Update
End If
End If
End If
If dblRS > 0 Then
txtSand = dblRS
End If
'Calculate 4d Nails
strSELECT = "inv_no = '1616'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
moRSCMat!qty = Round((Field2Str(dblNEWYDS) / 400) + 0.05, 1)
moRSCMat.Update
End If
End If
'Calculate Staples
strSELECT = "inv_no = '1705'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 250 Then
moRSCMat!qty = 1
Else
moRSCMat!qty = Round(((Field2Integer(dblNEWYDS) / 250) + 0.05), 1)
End If
End If
moRSCMat.Update
End If
'Rapid Staples
strSELECT = "inv_no = '1730'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
If Field2Integer(dblNEWYDS) <= 400 Then
moRSCMat!qty = 1
ElseIf Field2Integer(dblNEWYDS) > 400 And Field2Integer(dblNEWYDS) <= 700 Then
moRSCMat!qty = 2
ElseIf Field2Integer(dblNEWYDS) > 700 And Field2Integer(dblNEWYDS) <= 1000 Then
moRSCMat!qty = 3
ElseIf Field2Integer(dblNEWYDS) > 1000 And Field2Integer(dblNEWYDS) <= 1300 Then
moRSCMat!qty = 4
ElseIf Field2Integer(dblNEWYDS) > 1300 And Field2Integer(dblNEWYDS) <= 1600 Then
moRSCMat!qty = 5
ElseIf Field2Integer(dblNEWYDS) > 1600 And Field2Integer(dblNEWYDS) <= 1900 Then
moRSCMat!qty = 6
ElseIf Field2Integer(dblNEWYDS) > 1900 And Field2Integer(dblNEWYDS) <= 2200 Then
moRSCMat!qty = 7
ElseIf Field2Integer(dblNEWYDS) > 2200 And Field2Integer(dblNEWYDS) <= 2500 Then
moRSCMat!qty = 8
ElseIf Field2Integer(dblNEWYDS) > 2500 And Field2Integer(dblNEWYDS) <= 2800 Then
moRSCMat!qty = 9
ElseIf Field2Integer(dblNEWYDS) > 2800 And Field2Integer(dblNEWYDS) <= 3100 Then
moRSCMat!qty = 10
End If
End If
moRSCMat.Update
End If
'Latex Caulking
strSELECT = "inv_no = '1820'"
moRSCMat.MoveFirst
moRSCMat.Find strSELECT
If Not moRSCMat.EOF Then
If Not moRSCMat!ch_flag Then
moRSCMat!qty = Int(((Field2Integer(dblNEWYDS) / 100) * 1.5) + 0.99)
moRSCMat.Update
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module MatCalcThree"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ConvertSuper()
Dim strGET As String, strSQL As String
Dim oRSC As Recordset
On Error GoTo Error_EH
If txtSuper78 <> 0 Then
strSQL = "inv_no = '1150'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1120'" '78 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper78)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper78)
moRSCMat.Update
End If
End If
If txtSuper38 <> 0 Then
strSQL = "inv_no = '1150'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1150'" '38 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper38)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper38)
moRSCMat.Update
End If
End If
If txtSuper783 <> 0 Then
If moRSProj!zmetal Then
strSQL = "inv_no = '1145'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1145'" '78x3 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
End If
End If
If moRSProj!FHA Then
strSQL = "inv_no = '1565'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1565'" '78x3 FHA JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
End If
Else
strSQL = "inv_no = '1140'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1140'" '78x3 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper783)
moRSCMat.Update
End If
End If
End If
If txtSuperML <> 0 Then
strSQL = "inv_no = '1370'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1370'" 'Metal Lath
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuperML)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuperML)
moRSCMat.Update
End If
End If
If txtSuperDW <> 0 Then
strSQL = "inv_no = '1320'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
strGET = "SELECT * FROM tblInvtry where inv_no = '1320'" 'Drywall
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuperDW)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuperDW)
moRSCMat.Update
End If
End If
If txtSuper1383 <> 0 Then
If moRSProj!zmetal Then
strSQL = "inv_no = '1135'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
moRSCMat.MovePrevious
strGET = "SELECT * FROM tblInvtry where inv_no = '1135'" '138X3 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
End If
End If
If moRSProj!FHA Then
strSQL = "inv_no = '1130'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
strSQL = "inv_no = '1570'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
moRSCMat.MovePrevious
strGET = "SELECT * FROM tblInvtry where inv_no = '1570'" '138X3 FHA JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
End If
Else
strSQL = "inv_no = '1570'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If Not moRSCMat.EOF Then
moRSCMat.Delete
End If
strSQL = "inv_no = '1130'"
moRSCMat.MoveFirst
moRSCMat.Find strSQL
If moRSCMat.EOF Then
moRSCMat.MovePrevious
strGET = "SELECT * FROM tblInvtry where inv_no = '1130'" '138X3 JMB
Set oRSC = New Recordset
oRSC.Open strGET, goConn, adOpenForwardOnly, adLockOptimistic
moRSCMat.AddNew
moRSCMat!Lot_ID = gintLOTID
moRSCMat!inv_no = Field2Str(oRSC!inv_no)
moRSCMat!Desc = Field2Str(oRSC!Desc)
moRSCMat!d_flag = Field2Str(oRSC!d_flag)
moRSCMat!m_type = Field2Str(oRSC!m_type)
moRSCMat!calc_flag = Field2Str(oRSC!calc_flag)
moRSCMat!calc_amt = Field2Integer(oRSC!calc_amt)
moRSCMat!rc_flag = vbChecked
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
Else
moRSCMat!qty = Str2Field(txtSuper1383)
moRSCMat.Update
End If
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module ConvertSuper"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CalcMetal()
Dim oRS As Recordset
Dim strSQL As String, dblMETAL As Double
On Error GoTo Error_EH
moRS!METAL = 0
strSQL = "SELECT SUM(qty * calc_amt) as SUMmetal FROM tblLotMatrl where calc_flag = 'M' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
dblMETAL = Field2Str2(oRS!summetal)
moRS!METAL = dblMETAL
' moRS!calcdate = Now
moRS!calcdate = Date
moRS.Update
txtMetal = dblMETAL
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module CalcMetal"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub txtSuperSP_LostFocus()
txtSuperSP = Integer2Field(txtSuperSP)
End Sub
Private Sub txtWireAdj_GotFocus()
Call FieldSelect(txtWireAdj)
End Sub
Private Sub txtWireAdj_LostFocus()
txtWireAdj = Integer2Field(txtWireAdj)
End Sub
Private Sub txtYardMemo_LostFocus()
txtYardMemo = UCase(txtYardMemo)
End Sub
Private Sub PrintLathInv()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset
Dim oRSE As Recordset, strTEST As String, oRSX As Recordset
Dim strSQLE As String, strSQLINFO As String
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQL1 As String, strSQL3 As String, intDay As Integer
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
On Error GoTo Error_EH
gintCOPY = 1
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT * FROM tblARINVOICEM where Trans_ID = 1"
End If
Set oRSX = New Recordset
oRSX.Open strSQL, goConn, adOpenDynamic, adLockPessimistic
If oRSX.EOF Then
gstrMODULE = "oRSX failed "
End If
''' Set oRS = New Recordset
''' oRS.Open strSQL, goConn, adOpenDynamic, adLockPessimistic
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & moRS!est_id ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQLE = "SELECT * FROM tblplanbill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenForwardOnly, adLockReadOnly
If oRSE.EOF Then
End If
If moRSProj!cocode = 0 Then
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
ElseIf moRSProj!cocode = 1 Then
strSQL4 = "SELECT * FROM tblARMasterM where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
End If
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
dblINVTOTAL = 0
dblRETENTION = 0
gstrMODULE = gstrMODULE & "Line 28 "
With oRSX
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "L"
!ship_date = Field2Str(moRS!lorder)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
' If IsNumeric(moRS!lot_no) Then
If IsNumeric(moRS!lot_no) And IsNumeric(moRSProj!inv) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "0000") & "L"
' mstrINV = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "0000") & "L"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
End If
intCMonth = Month(moRS!lorder)
intCDay = Day(moRS!lorder)
intCYear = Year(moRS!lorder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
!invoice_date = DateAdd("d", 3, moRS!lorder)
' moRS!PRNT_L = Field2Str(strCDate)
' moRS.Update
' !invoice_date = DateAdd("d", 3, moRS!lorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
' If intDay = 0 Then
' intDay = 1
' End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
' !inv_due_date = Field2Str(strDate)
' !disc_due_date = DateAdd("d", 3, moRS!lorder)
!inv_due_date = DateAdd("d", 33, moRS!lorder)
' !inv_due_date = Field2Str(strDate)
!disc_due_date = DateAdd("d", 3, moRS!lorder)
!non_tax_amt = Field2Str2(oRSE!l_bill)
dblINVTOTAL = dblINVTOTAL + Val(oRSE!l_bill)
!sales_code = Field2Str(oRSE!l_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "LATH COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
!price = Field2Str2(oRSE!l_bill)
!amount = Field2Str2(oRSE!l_bill)
!header = vbChecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
gstrMODULE = "Before mlngINVID update"
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
mlngINVID = mlngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
gstrMODULE = "After Main Lath Information "
If Not moRSProj!opt Then
strSQL1 = "SELECT * FROM tblLOption where (not ostone or not invoice) and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!opt_id)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRSX
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "L"
!ship_date = Field2Str(moRS!lorder)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "L"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
End If
intCMonth = Month(moRS!lorder)
intCDay = Day(moRS!lorder)
intCYear = Year(moRS!lorder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
!invoice_date = Field2Str(strCDate)
' !invoice_date = Field2Str(strCDate)
' moRS!PRNT_L = Field2Str(strCDate)
' moRS.Update
' !invoice_date = DateAdd("d", 3, moRS!lorder)
!disc_due_date = DateAdd("d", 3, moRS!lorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
' If intDay = 0 Then
' intDay = 1
' End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!lorder)
' !inv_due_date = Field2Str(strDate)
' !inv_due_date = Field2Str(strDate)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Field2Str2(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!taxcode = mstrTAXCODE
!Description = Field2Str(oRSP!Desc)
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
mlngINVID = mlngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
oRSP.MoveNext
End If
oRSO.MoveNext
Loop
End If
gstrMODULE = "After Option Information "
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
If moRSProj!cocode = 0 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'L' and Lot_id = " & gintLOTID
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICEM where inv_type = 'L' and Lot_id = " & gintLOTID
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "After Open for Totals Setup "
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
gstrMODULE = "After Totals Setup "
If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
ElseIf moRSProj!cocode = 1 Then
strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
End If
' strSELECT = "{tblARInvoice.invoice_no} = '" & mstrINV & "'"
' crOrder.ReportFileName = App.Path & "\invoice.rpt"
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & "Form LotInfo5- Module PrintLathInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintWrapInv()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset
Dim oRSE As Recordset, strTEST As String
Dim strSQLE As String, oRSX As Recordset
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQL1 As String, strSQL3 As String, intDay As Integer
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
On Error GoTo Error_EH
gintCOPY = 1
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
' ElseIf moRSProj!cocode = 1 Then
' strSQL = "SELECT * FROM tblARINVOICEM where Trans_ID = 1"
End If
Set oRSX = New Recordset
oRSX.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRSX.EOF Then
gstrMODULE = "oRSX failed "
End If
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & moRS!est_id ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQLE = "SELECT * FROM tblplanbill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenForwardOnly, adLockReadOnly
If oRSE.EOF Then
End If
If moRSProj!cocode = 0 Then
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
' ElseIf moRSProj!cocode = 1 Then
' strSQL4 = "SELECT * FROM tblARMasterM where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
End If
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
dblINVTOTAL = 0
dblRETENTION = 0
gstrMODULE = gstrMODULE & "Line 28 "
With oRSX
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "L" '*** use L eventhough it is printed during wrap
' !inv_type = "W"
' !ship_date = Field2Str(moRS!lorder)
!ship_date = Field2Str(moRS!worder)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
' If IsNumeric(moRS!lot_no) Then
If IsNumeric(moRS!lot_no) And IsNumeric(moRSProj!inv) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
' !invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
' mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "0000") & "W"
' mstrINV = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "0000") & "W"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "L"
' !invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
' mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
End If
intCMonth = Month(moRS!worder)
intCDay = Day(moRS!worder)
intCYear = Year(moRS!lorder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
strCDate = DateAdd("d", 3, moRS!worder)
' strCDate = DateAdd("d", 3, moRS!lorder)
!invoice_date = Field2Str(strCDate)
' !invoice_date = DateAdd("d", 3, moRS!lorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
' If intDay = 0 Then
' intDay = 1
' End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!worder)
!disc_due_date = DateAdd("d", 3, moRS!worder)
' !inv_due_date = DateAdd("d", 33, moRS!lorder)
' !disc_due_date = DateAdd("d", 3, moRS!lorder)
!non_tax_amt = Field2Str2(oRSE!l_bill)
dblINVTOTAL = dblINVTOTAL + Val(oRSE!l_bill)
!sales_code = Field2Str(oRSE!l_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "LATH COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
!price = Field2Str2(oRSE!l_bill)
!amount = Field2Str2(oRSE!l_bill)
!header = vbChecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
mlngINVID = mlngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
gstrMODULE = "After Main Lath Information "
If Not moRSProj!opt Then
strSQL1 = "SELECT * FROM tblLOption where (not ostone or not invoice) and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!opt_id)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRSX
.AddNew
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "W"
!ship_date = Field2Str(moRS!worder)
' !ship_date = Field2Str(moRS!lorder)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "W"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "W"
End If
intCMonth = Month(moRS!worder)
intCDay = Day(moRS!worder)
intCYear = Year(moRS!worder)
' intCMonth = Month(moRS!lorder)
' intCDay = Day(moRS!lorder)
' intCYear = Year(moRS!lorder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
strCDate = DateAdd("d", 3, moRS!worder)
' strCDate = DateAdd("d", 3, moRS!lorder)
!invoice_date = Field2Str(strCDate)
' !invoice_date = DateAdd("d", 3, moRS!lorder)
!disc_due_date = DateAdd("d", 3, moRS!worder)
' !disc_due_date = DateAdd("d", 3, moRS!lorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
' If intDay = 0 Then
' intDay = 1
' End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!worder)
' !inv_due_date = DateAdd("d", 33, moRS!lorder)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Field2Str2(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!taxcode = mstrTAXCODE
!Description = Field2Str(oRSP!Desc)
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
End With
oRSP.MoveNext
End If
oRSO.MoveNext
Loop
End If
gstrMODULE = "After Option Information "
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
If moRSProj!cocode = 0 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'L' and Lot_id = " & gintLOTID
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICEM where inv_type = 'L' and Lot_id = " & gintLOTID
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
gstrMODULE = "After Open for Totals Setup "
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
gstrMODULE = "After Totals Setup "
If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\invoiceW.rpt"
' crOrder.ReportFileName = App.Path & "\Winvoice.rpt"
' ElseIf moRSProj!cocode = 1 Then
' strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
End If
' strSELECT = "{tblARInvoice.invoice_no} = '" & mstrINV & "'"
' crOrder.ReportFileName = App.Path & "\invoice.rpt"
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & "Form LotInfo5- Module PrintWrapInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintCompleteInv()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQL1 As String, strSQL3 As String, intDay As Integer
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & moRS!est_id ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSC.EOF Then
If Field2Str(oRSC!Address2) = "" Then
strADD3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
strADD3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
strADD4 = ""
Else
strADD4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
End If
dblINVTOTAL = 0
dblRETENTION = 0
If oRS.EOF Then
End If
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "C"
!ship_date = Field2Str(moRS!SORDER)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "C"
' mstrINV = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "C"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
End If
intCMonth = Month(moRS!SORDER)
intCDay = Day(moRS!SORDER)
intCYear = Year(moRS!SORDER)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
' strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
strCDate = DateAdd("d", 3, moRS!SORDER)
!invoice_date = Field2Str(strCDate)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
' !inv_due_date = Field2Str(strDate)
!inv_due_date = DateAdd("d", 33, moRS!SORDER)
!disc_due_date = DateAdd("d", 3, moRS!SORDER)
!non_tax_amt = Field2Str2(oRSS!s_bill)
dblINVTOTAL = dblINVTOTAL + Val(oRSS!s_bill)
!sales_code = Field2Str(oRSS!s_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "STUCCO & LATH COMPLETE - PLAN " & Field2Str(oRSS!Mod_Elv)
!price = Field2Str2(oRSS!s_bill)
!amount = Field2Str2(oRSS!s_bill)
!header = vbChecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
!c_add3 = strADD3
!c_add4 = strADD4
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
mlngINVID = mlngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
strSQL1 = "SELECT * FROM tblLOption where (not ostone and not invoice) and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!Opt_ID)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRS
.AddNew
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "C"
!ship_date = Field2Str(moRS!SORDER)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "C"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "C"
End If
intCMonth = Month(moRS!SORDER)
intCDay = Day(moRS!SORDER)
intCYear = Year(moRS!SORDER)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
' strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
strCDate = DateAdd("d", 3, moRS!SORDER)
!invoice_date = Field2Str(strCDate)
' !invoice_date = DateAdd("d", 3, moRS!SORDER)
!disc_due_date = DateAdd("d", 3, moRS!SORDER)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!SORDER)
' !inv_due_date = Field2Str(strDate)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Val(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!taxcode = mstrTAXCODE
!Description = Field2Str(oRSP!Desc)
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
!c_add3 = strADD3
!c_add4 = strADD4
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
End With
oRSO.MoveNext
End If
Loop
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'C' and Lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module PrintCompleteInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStuccoInv()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset
Dim oRSE As Recordset, strTEST As String
Dim strSQLE As String, strSQLINFO As String
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQL1 As String, strSQL3 As String, intDay As Integer
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
On Error GoTo Error_EH
gintCOPY = 1
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT * FROM tblARINVOICEM where Trans_ID = 1"
End If
' strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockPessimistic
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & Field2Long(moRS!est_id) ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQLE = "SELECT * FROM tblplanbill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenForwardOnly, adLockReadOnly
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
dblINVTOTAL = 0
dblRETENTION = 0
gstrMODULE = "Before Add Inv To ARINVOICE"
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "S"
!customer_no = Field2Str(moRSProj!ar)
!ship_date = Field2Str(moRS!forder) 'Changed to allow printing with Brown
' !ship_date = Field2Str(moRS!SORDER)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S" '*** This may be causing the extra zeros on the front of the invoice numbers
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "S" '*** This may be causing the extra zeros on the front of the invoice numbers
' mstrINV = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "S"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S"
End If
' intCMonth = Month(moRS!SORDER)
' intCDay = Day(moRS!SORDER)
' intCYear = Year(moRS!SORDER)
intCMonth = Month(moRS!forder)
intCDay = Day(moRS!forder)
intCYear = Year(moRS!forder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
' strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
strCDate = DateAdd("d", 3, moRS!forder)
!invoice_date = Field2Str(strCDate)
' moRS!PRNT_S = Field2Str(strCDate)
' moRS.Update
' !invoice_date = DateAdd("d", 3, moRS!sorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
intDay = Field2Integer(moRSProj!DueDate)
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!forder)
!disc_due_date = DateAdd("d", 3, moRS!forder)
' !inv_due_date = Field2Str(strDate)
' !disc_due_date = DateAdd("d", 3, moRS!forder)
' !disc_due_date = DateAdd("d", 3, moRS!SORDER)
!non_tax_amt = Field2Str2(oRSE!s_bill)
dblINVTOTAL = dblINVTOTAL + Val(oRSE!s_bill)
!sales_code = Field2Str(oRSE!s_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
!taxcode = "AZ"
' !TAXCODE = mstrTAXCODE
Else
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
!taxcode = mstrTAXCODE
End If
If chkSynthetic Then
!Description = "SYNTHETIC COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
Else
!Description = "STUCCO COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
End If
!price = Field2Str2(oRSE!s_bill)
!amount = Field2Str2(oRSE!s_bill)
!header = vbChecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
gstrMODULE = "Before mlngINVID update"
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
mlngINVID = mlngINVID + 1
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
gstrMODULE = "Before Option Setup"
If moRSProj!opt Then
strSQL1 = "SELECT * FROM tblLOption where (Not ostone and not invoice) and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!opt_id)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "S"
!ship_date = Field2Str(moRS!forder)
' !ship_date = Field2Str(moRS!SORDER)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S"
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "S"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "S"
End If
intCMonth = Month(moRS!forder)
intCDay = Day(moRS!forder)
intCYear = Year(moRS!forder)
' intCMonth = Month(moRS!SORDER)
' intCDay = Day(moRS!SORDER)
' intCYear = Year(moRS!SORDER)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
strCDate = DateAdd("d", 3, moRS!forder)
!invoice_date = Field2Str(strCDate)
' moRS!PRNT_S = Field2Str(strCDate)
' moRS.Update
' !invoice_date = DateAdd("d", 3, moRS!sorder)
!disc_due_date = DateAdd("d", 3, moRS!forder)
' !disc_due_date = DateAdd("d", 3, moRS!SORDER)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
intDay = Field2Integer(moRSProj!DueDate)
' If intDay = 0 Then
' intDay = 1
' End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
' !inv_due_date = Field2Str(strDate)
!inv_due_date = DateAdd("d", 33, moRS!forder)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Field2Str2(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!taxcode = mstrTAXCODE
!Description = Field2Str(oRSP!Desc)
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
gstrMODULE = "Before Update mlngINVID second time"
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
oRSO.MoveNext
Loop
End If
gstrMODULE = "Before Print Invoice"
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
If moRSProj!cocode = 0 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'S' and Lot_id = " & gintLOTID
' ElseIf moRSProj!cocode = 1 Then
' strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICEM where inv_type = 'S' and Lot_id = " & gintLOTID
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
' ElseIf moRSProj!cocode = 1 Then
' strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
' crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = gstrMODULE & "Form LotInfo5- Module PrintStuccoInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStoneInv()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset ', oRSE As Recordset
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQLE As String, oRSE As Recordset
Dim strSQL1 As String, strSQL3 As String, intDay As Integer ' , strSQLE As String
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String, strSQLINFO As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
Dim strTEST2 As String, strMSG As String, strLEN As String, strModELEV As String
Dim dblBillAmt As Double, dblWAmt As Double, boolHEADER As Boolean, txtSALECD As String
On Error GoTo Error_EH
gintCOPY = 1
boolHEADER = False
txtSALECD = ""
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT * FROM tblARINVOICEM where Trans_ID = 1"
End If
' strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & Field2Long(moRS!est_id) ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQLE = "SELECT * FROM tblplanbill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenForwardOnly, adLockReadOnly
strModELEV = Field2Str(oRSE!Mod_Elv)
If oRSE!Wrap Then
mboolWRAP = True
Else
mboolWRAP = False
End If
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
'***************** To Put A "V" in the tblARInvoice
' strSQL3 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Long(moRS!est_id) & " AND B_code = 'VOPT' and effdate = #" & oRSE!effdate & "#"
strSQL3 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Long(moRS!est_id) & " AND (B_code = 'STONE' OR B_code = 'WSTONE') and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = 'VOPT' and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQLB = "SELECT * FROM tblPlanBill WHERE Proj_ID = " & Field2Str2(moRSProj!Proj_ID) & " AND Mod_Elv = '" & mstrPLNELEV & "'"
Set oRSO = New Recordset
oRSO.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSO.EOF Then
' If IsNull(oRSO!B_code) Then
mboolSTONE3 = True
Else
mboolSTONE3 = False
' End If
End If
dblBillAmt = 0
dblINVTOTAL = 0
dblRETENTION = 0
' 02/11/2020 commenting this out to prevent printing a blank stone items remove double marks to start using this again
'' If Not mboolSTONE3 Then
'' With oRS
'' .AddNew
'' !Trans_ID = mlngINVID
'' !Lot_ID = gintLOTID
'' !PROJ_ID = gintPROJID
'' !project = Field2Str(moRSProj!Proj_Desc)
'' !lot_no = Field2Str(moRS!lot_no)
'' !address = Field2Str(moRS!address)
'' !inv_type = "V"
'' !customer_no = Field2Str(moRSProj!ar)
' !ship_date = Field2Str(moRS!VOrder)
'' !ship_date = (moRS!VOrder)
'' !projcode = Field2Str(moRSProj!Proj_Code)
'' !CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
'' !ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
'' If IsNumeric(moRS!lot_no) Then
'' !invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
'' mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
'' Else
'' !invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
'' mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
'' End If
'' intCMonth = Month(moRS!VOrder)
'' intCDay = Day(moRS!VOrder)
'' intCYear = Year(moRS!VOrder)
'' If intCDay > moRSProj!inv_due Then
'' intCMonth = intCMonth + 1
'' If intCMonth > 12 Then
'' intCMonth = intCMonth - 12
'' intCYear = intCYear + 1
'' End If
'' End If
'' intCDay = Field2Integer(moRSProj!inv_due)
'' If intCDay = 0 Then
'' Select Case intCMonth
'' Case 2
'' intCDay = 28
'' Case 1, 3, 5, 7, 8, 10, 12
'' intCDay = 31
'' Case 4, 6, 9, 11
'' intCDay = 30
'' End Select
'' End If
'' strCDate = DateAdd("d", 3, moRS!VOrder)
'' !invoice_date = Field2Str(strCDate)
'' !job_number = Field2Str(moRS!jobcost)
'' intYear = Year(!invoice_date)
'' intMonth = Month(!invoice_date) + 1
'' intDay = Field2Integer(moRSProj!DueDate)
'' If intMonth > 12 Then
'' intMonth = intMonth - 12
'' intYear = intYear + 1
'' End If
'' Select Case intMonth
'' Case 2
'' If intDay = 0 Then
'' intDay = 28
'' End If
'' If intDay > 28 Then
'' intDay = 28
'' End If
'' Case 1, 3, 5, 7, 8, 10, 12
'' If intDay = 0 Then
'' intDay = 31
'' End If
'' If intDay > 31 Then
'' intDay = 31
'' End If
'' Case 4, 6, 9, 11
'' If intDay = 0 Then
'' intDay = 30
'' End If
'' If intDay > 30 Then
'' intDay = 30
'' End If
'' End Select
'' strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
'' !inv_due_date = DateAdd("d", 33, moRS!VOrder)
' !inv_due_date = Field2Str(strDate)
'' !disc_due_date = DateAdd("d", 3, moRS!VOrder)
'' !non_tax_amt = Field2Str2(oRSE!st_bill)
'' dblINVTOTAL = dblINVTOTAL + Val(oRSE!st_bill)
'' !sales_code = Field2Str(oRSE!st_code)
'' If txtSALECD <> "" Then
'' !header = vbChecked
'' boolHEADER = True
'' Else
'' !header = vbUnchecked
'' boolHEADER = False
'' End If
'' If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
'' !taxcode = "AZ"
'' Else
'' !taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
'' End If
'' !Description = "STONE COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
'' !price = Field2Str2(oRSE!st_bill)
'' !amount = Field2Str2(oRSE!st_bill)
' !header = vbChecked
'' If Not oRSC.EOF Then
'' !c_add1 = Field2Str(oRSC!Name)
'' !c_add2 = Field2Str(oRSC!Address1)
'' If Field2Str(oRSC!Address2) = "" Then
'' !c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
'' Else
'' !c_add3 = Field2Str(oRSC!Address2)
'' End If
'' If Field2Str(oRSC!Address2) = "" Then
'' !c_add4 = ""
'' Else
'' !c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
'' End If
'' Else
'' !c_add1 = ""
'' !c_add2 = ""
'' !c_add3 = ""
'' !c_add4 = ""
'' End If
'' !po_num = gstrPONUM
'' .Update
'' mlngINVID = mlngINVID + 1
'' strSQLINFO = "SELECT * FROM tblTABLE_INFO"
'' Set moRSInvINFO = New Recordset
'' moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
'' moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
'' moRSInvINFO.Update
'' End With
'' End If
'************************************************************************************************
'********** Print Options that are stone
If moRSProj!opt Then
' strSQL1 = "SELECT * FROM tblLOption where (Not ostone and not invoice) and lot_id = " & gintLOTID
strSQL1 = "SELECT * FROM tblLOption where ostone and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!opt_id)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
' !inv_type = "S"
!inv_type = "V"
' !ship_date = Field2Str(moRS!vorder)
!ship_date = (moRS!VOrder)
' !ship_date = Field2Str(moRS!SORDER)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "S"
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
End If
gstrMODULE = "During Option Setup for ARINVOICE"
strCDate = DateAdd("d", 3, moRS!VOrder)
!invoice_date = Field2Str(strCDate)
!disc_due_date = DateAdd("d", 3, moRS!VOrder)
!job_number = Field2Str(moRS!jobcost)
!inv_due_date = DateAdd("d", 33, moRS!VOrder)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Field2Str2(oRSP!Amt)
dblBillAmt = dblBillAmt + Val(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!taxcode = mstrTAXCODE
!Description = Field2Str(oRSP!Desc) & " - " & strModELEV
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
If boolHEADER Then
!header = vbUnchecked
boolHEADER = False
Else
!header = vbChecked
boolHEADER = True
End If
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
oRSO.MoveNext
Loop
End If
'************************************************************************************************
'************************************************************************************************
'*****Check to see if this is a WRAP project and bill a credit for the cost of the wrap insurance
'*****In billing grid, the percentage of deduction for Wrap Insurance will be seen
If mboolWRAP Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "S"
!customer_no = Field2Str(moRSProj!ar)
!ship_date = Field2Str(moRS!forder) 'Changed to allow printing with Brown
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
!invoice_no = strTEST2
mstrINV = Trim$(Field2Str(moRSProj!inv)) & Trim$(Field2Str(moRS!lot_no)) & "ST"
strCDate = DateAdd("d", 3, moRS!VOrder)
!invoice_date = Field2Str(strCDate)
!job_number = Field2Str(moRS!jobcost)
!inv_due_date = DateAdd("d", 33, moRS!VOrder)
!disc_due_date = DateAdd("d", 3, moRS!VOrder)
!non_tax_amt = Field2Str2(oRSE!st_bill)
' dblINVTOTAL = dblINVTOTAL + Val(oRSE!s_bill)
dblBillAmt = (dblBillAmt * (Val(Field2Str2(oRSE!WPctg)) / 100) * -1)
dblINVTOTAL = dblINVTOTAL + dblBillAmt
' dblINVTOTAL = dblINVTOTAL + Val(oRSE!l_bill) '*******
!sales_code = "WINS"
' dblBillAmt = Val(oRSE!s_bill)
' !sales_code = Field2Str(oRSE!st_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "WRAP INSURANCE CREDIT - " & Field2Str(oRSE!Mod_Elv)
!price = dblBillAmt
!amount = dblBillAmt
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
gstrMODULE = "Before UPDATE of ARINVOICE Wrap Credit Line"
.Update
gstrMODULE = "Before mlngINVID update"
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
'************************************************************************************************
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
If moRSProj!cocode = 0 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'V' and Lot_id = " & gintLOTID
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICEM where inv_type = 'V' and Lot_id = " & gintLOTID
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
ElseIf moRSProj!cocode = 1 Then
strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
moRS!st_flg = vbTrue
moRS.Update
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module PrintStoneInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub JCSetup()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblJCTrans"
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT * FROM tblJCTransM"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If IsNull(moRSProj!ar) Then
MsgBox "There is no MAS90 AR Code for this Project so No Job Cost Record will be setup", vbOKOnly, "Fix & ReEnter"
Exit Sub
End If
With oRS
.AddNew
!Lot_ID = gintLOTID
!job_number = Field2Str(moRS!jobcost)
!Desc = Trim(Left(Field2Str(moRSProj!Proj_Desc), 20)) & " LOT " & moRS!lot_no
!address = Field2Str(moRS!address)
!customer_no = Field2Str(moRSProj!ar)
!retention_pct = Field2Str2(moRSProj!retention)
!setup_date = Date
!status_date = Date
.Update
End With
MsgBox "Job Cost Record Has Been Setup For Transfer To MAS90", vbOKOnly, "Job Cost"
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module JCSetup"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PrintStoneInv_20200111()
Dim oRS As Recordset, oRSS As Recordset, oRSO As Recordset, oRSP As Recordset, oRSC As Recordset ', oRSE As Recordset
Dim strSQL As String, strSELECT As String, strSql2 As String, strSQL4 As String
Dim strSQLE As String, oRSE As Recordset
Dim strSQL1 As String, strSQL3 As String, intDay As Integer ' , strSQLE As String
Dim intYear As Integer, intMonth As Integer, strDate As String
Dim dblINVTOTAL As Double, dblRETENTION As Double
Dim strADD3 As String, strADD4 As String, strSQLINFO As String
Dim intCMonth As Integer, intCDay As Integer, strCDate As String, intCYear As Integer
Dim strTEST2 As String, strMSG As String, strLEN As String, strModELEV As String
Dim dblBillAmt As Double, dblWAmt As Double
On Error GoTo Error_EH
gintCOPY = 1
If moRSProj!cocode = 0 Then
strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT * FROM tblARINVOICEM where Trans_ID = 1"
End If
' strSQL = "SELECT * FROM tblARINVOICE where Trans_ID = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblplans WHERE est_id = " & Field2Long(moRS!est_id) ' & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
strSQLE = "SELECT * FROM tblplanbill WHERE est_id = " & moRS!est_id & " and effdate <= #" & moRS!startdate & "# ORDER BY effdate DESC"
Set oRSE = New Recordset
oRSE.Open strSQLE, goConn, adOpenForwardOnly, adLockReadOnly
strModELEV = Field2Str(oRSE!Mod_Elv)
If oRSE!Wrap Then
mboolWRAP = True
Else
mboolWRAP = False
End If
strSQL4 = "SELECT * FROM tblARMaster where Cust_no = '" & Field2Str(moRSProj!ar) & "'"
Set oRSC = New Recordset
oRSC.Open strSQL4, goConn, adOpenForwardOnly, adLockReadOnly
'***************** To Put A "V" in the tblARInvoice
' strSQL3 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Long(moRS!est_id) & " AND B_code = 'VOPT' and effdate = #" & oRSE!effdate & "#"
strSQL3 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Long(moRS!est_id) & " AND (B_code = 'STONE' OR B_code = 'WSTONE') and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = 'VOPT' and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQLB = "SELECT * FROM tblPlanBill WHERE Proj_ID = " & Field2Str2(moRSProj!Proj_ID) & " AND Mod_Elv = '" & mstrPLNELEV & "'"
Set oRSO = New Recordset
oRSO.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSO.EOF Then
' If IsNull(oRSO!B_code) Then
mboolSTONE3 = True
Else
mboolSTONE3 = False
' End If
End If
dblBillAmt = 0
dblINVTOTAL = 0
dblRETENTION = 0
If Not mboolSTONE3 Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "V"
!customer_no = Field2Str(moRSProj!ar)
' !ship_date = Field2Str(moRS!VOrder)
!ship_date = (moRS!VOrder)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
' !invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "V"
' mstrINV = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "V"
End If
intCMonth = Month(moRS!VOrder)
intCDay = Day(moRS!VOrder)
intCYear = Year(moRS!VOrder)
If intCDay > moRSProj!inv_due Then
intCMonth = intCMonth + 1
If intCMonth > 12 Then
intCMonth = intCMonth - 12
intCYear = intCYear + 1
End If
End If
intCDay = Field2Integer(moRSProj!inv_due)
If intCDay = 0 Then
Select Case intCMonth
Case 2
intCDay = 28
Case 1, 3, 5, 7, 8, 10, 12
intCDay = 31
Case 4, 6, 9, 11
intCDay = 30
End Select
End If
' strCDate = Format(intCMonth, "00") & "/" & Format(intCDay, "00") & "/" & intCYear
strCDate = DateAdd("d", 3, moRS!VOrder)
!invoice_date = Field2Str(strCDate)
' !invoice_date = DateAdd("d", 3, moRS!vorder)
!job_number = Field2Str(moRS!jobcost)
intYear = Year(!invoice_date)
intMonth = Month(!invoice_date) + 1
intDay = Field2Integer(moRSProj!DueDate)
If intMonth > 12 Then
intMonth = intMonth - 12
intYear = intYear + 1
End If
Select Case intMonth
Case 2
If intDay = 0 Then
intDay = 28
End If
If intDay > 28 Then
intDay = 28
End If
Case 1, 3, 5, 7, 8, 10, 12
If intDay = 0 Then
intDay = 31
End If
If intDay > 31 Then
intDay = 31
End If
Case 4, 6, 9, 11
If intDay = 0 Then
intDay = 30
End If
If intDay > 30 Then
intDay = 30
End If
End Select
strDate = Format(intMonth, "00") & "/" & Format(intDay, "00") & "/" & intYear
!inv_due_date = DateAdd("d", 33, moRS!VOrder)
' !inv_due_date = Field2Str(strDate)
!disc_due_date = DateAdd("d", 3, moRS!VOrder)
!non_tax_amt = Field2Str2(oRSE!st_bill)
dblINVTOTAL = dblINVTOTAL + Val(oRSE!st_bill)
!sales_code = Field2Str(oRSE!st_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "STONE COMPLETE - PLAN " & Field2Str(oRSE!Mod_Elv)
!price = Field2Str2(oRSE!st_bill)
!amount = Field2Str2(oRSE!st_bill)
!header = vbChecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
'************************************************************************************************
'********** Print Options that are stone
If moRSProj!opt Then
' strSQL1 = "SELECT * FROM tblLOption where (Not ostone and not invoice) and lot_id = " & gintLOTID
strSQL1 = "SELECT * FROM tblLOption where ostone and lot_id = " & gintLOTID
Set oRSO = New Recordset
oRSO.Open strSQL1, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRSO.EOF
strSQL3 = "SELECT * FROM tblPOptBill WHERE optid = " & Field2Double(oRSO!Opt_ID) & " and effdate = #" & oRSE!effdate & "#"
' strSQL3 = "SELECT * FROM tblPOption WHERE optid = " & Field2Double(oRSO!opt_id)
Set oRSP = New Recordset
oRSP.Open strSQL3, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSP.EOF Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "S"
' !ship_date = Field2Str(moRS!vorder)
!ship_date = (moRS!VOrder)
' !ship_date = Field2Str(moRS!SORDER)
!customer_no = Field2Str(moRSProj!ar)
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
If IsNumeric(moRS!lot_no) Then
' !invoice_no = Field2Str(moRSProj!inv) & Format(Field2Str(moRS!lot_no), "000") & "S"
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
Else
!invoice_no = Field2Str(moRSProj!inv) & Field2Str(moRS!lot_no) & "ST"
End If
gstrMODULE = "During Option Setup for ARINVOICE"
strCDate = DateAdd("d", 3, moRS!VOrder)
!invoice_date = Field2Str(strCDate)
!disc_due_date = DateAdd("d", 3, moRS!VOrder)
!job_number = Field2Str(moRS!jobcost)
!inv_due_date = DateAdd("d", 33, moRS!VOrder)
!non_tax_amt = Field2Str2(oRSP!Amt)
dblINVTOTAL = dblINVTOTAL + Field2Str2(oRSP!Amt)
dblBillAmt = dblBillAmt + Val(oRSP!Amt)
!sales_code = Field2Str(oRSP!b_code)
!Description = Field2Str(oRSP!Desc) & " - " & strModELEV
!Quantity = 1
!price = Field2Str2(oRSP!Amt)
!amount = Field2Str2(oRSP!Amt)
!header = vbChecked
' !header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
.Update
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
oRSO.MoveNext
Loop
End If
'************************************************************************************************
'************************************************************************************************
'*****Check to see if this is a WRAP project and bill a credit for the cost of the wrap insurance
'*****In billing grid, the percentage of deduction for Wrap Insurance will be seen
If mboolWRAP Then
With oRS
.AddNew
!Trans_ID = mlngINVID
!Lot_ID = gintLOTID
!PROJ_ID = gintPROJID
!project = Field2Str(moRSProj!Proj_Desc)
!lot_no = Field2Str(moRS!lot_no)
!address = Field2Str(moRS!address)
!inv_type = "S"
!customer_no = Field2Str(moRSProj!ar)
!ship_date = Field2Str(moRS!forder) 'Changed to allow printing with Brown
!projcode = Field2Str(moRSProj!Proj_Code)
!CodeDesc = Trim(Field2Str(moRSProj!Proj_Code)) & "-" & Trim(Field2Str(moRSProj!Proj_Desc))
!ProjLot = Trim(Field2Str(moRSProj!Proj_Desc)) & " Lot " & Field2Str(moRS!lot_no)
!invoice_no = strTEST2
mstrINV = Trim$(Field2Str(moRSProj!inv)) & Trim$(Field2Str(moRS!lot_no)) & "ST"
' mstrINV = Trim$(Field2Str(moRSProj!inv)) & Trim$(Field2Str(moRS!lot_no)) & "V"
strCDate = DateAdd("d", 3, moRS!VOrder)
!invoice_date = Field2Str(strCDate)
!job_number = Field2Str(moRS!jobcost)
!inv_due_date = DateAdd("d", 33, moRS!VOrder)
!disc_due_date = DateAdd("d", 3, moRS!VOrder)
!non_tax_amt = Field2Str2(oRSE!st_bill)
' dblINVTOTAL = dblINVTOTAL + Val(oRSE!s_bill)
dblBillAmt = (dblBillAmt * (Val(Field2Str2(oRSE!WPctg)) / 100) * -1)
dblINVTOTAL = dblINVTOTAL + dblBillAmt
' dblINVTOTAL = dblINVTOTAL + Val(oRSE!l_bill) '*******
!sales_code = "WINS"
' dblBillAmt = Val(oRSE!s_bill)
' !sales_code = Field2Str(oRSE!st_code)
If IsNull(moRSProj!taxcode) Or moRSProj!taxcode = "" Then
!taxcode = "AZ"
Else
!taxcode = mstrTAXCODE
' !TAXCODE = Field2Str(moRSProj!TAXCODE)
End If
!Description = "WRAP INSURANCE CREDIT - " & Field2Str(oRSE!Mod_Elv)
!price = dblBillAmt
!amount = dblBillAmt
!header = vbUnchecked
If Not oRSC.EOF Then
!c_add1 = Field2Str(oRSC!Name)
!c_add2 = Field2Str(oRSC!Address1)
If Field2Str(oRSC!Address2) = "" Then
!c_add3 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
Else
!c_add3 = Field2Str(oRSC!Address2)
End If
If Field2Str(oRSC!Address2) = "" Then
!c_add4 = ""
Else
!c_add4 = Trim(Field2Str(oRSC!City)) & ", " & Field2Str(oRSC!State) & " " & Field2Str(oRSC!ZipCode)
End If
Else
!c_add1 = ""
!c_add2 = ""
!c_add3 = ""
!c_add4 = ""
End If
!po_num = gstrPONUM
gstrMODULE = "Before UPDATE of ARINVOICE Wrap Credit Line"
.Update
gstrMODULE = "Before mlngINVID update"
mlngINVID = mlngINVID + 1
strSQLINFO = "SELECT * FROM tblTABLE_INFO"
Set moRSInvINFO = New Recordset
moRSInvINFO.Open strSQLINFO, goConn, adOpenDynamic, adLockPessimistic
moRSInvINFO!ARINVOICE_TRANS_ID = mlngINVID
moRSInvINFO.Update
End With
End If
'************************************************************************************************
If Field2Integer(moRSProj!retention) > 0 Then
dblRETENTION = Format(((dblINVTOTAL * Field2Integer(moRSProj!retention)) / 100), "##.00")
Else
dblRETENTION = 0
End If
If moRSProj!cocode = 0 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICE where inv_type = 'V' and Lot_id = " & gintLOTID
ElseIf moRSProj!cocode = 1 Then
strSQL = "SELECT trans_id, lot_id, inv_type, non_tax_amt, Retention_Amt FROM tblARINVOICEM where inv_type = 'V' and Lot_id = " & gintLOTID
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRS!non_tax_amt = dblINVTOTAL
oRS!retention_amt = dblRETENTION
oRS.Update
oRS.MoveNext
Loop
If moRSProj!cocode = 0 Then
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoice.rpt"
ElseIf moRSProj!cocode = 1 Then
strSELECT = "{tblARInvoiceM.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crOrder.ReportFileName = App.Path & "\invoiceM.rpt"
End If
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
moRS!st_flg = vbTrue
moRS.Update
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module PrintStoneInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub POInvoice()
Dim strSELECT As String
On Error GoTo Error_EH
If Not mboolSTPAY Then
If moRS!st_flg Then
MsgBox "This Lot Has Already Had A Stone Invoice Printed", vbOKOnly, "Invoice Not Available"
Exit Sub
End If
End If
gintCOPY = 1
strSELECT = "{tblOrders.PONum} = " & lstPO.ItemData(lstPO.ListIndex)
If gstrPONUM = "" Then
gstrPONUM = lstPO.ItemData(lstPO.ListIndex)
End If
'************************************************************************************* testing Stone Invoice
If optStone Then
' If optStucco Then
Call PrintStoneInv
Exit Sub
End If
'*************************************************************************************
If moRSProj!cocode = 0 Then
crOrder.ReportFileName = App.Path & "\invoicePO2.rpt"
ElseIf moRSProj!cocode = 1 Then
crOrder.ReportFileName = App.Path & "\invoicePO2M.rpt"
End If
crOrder.ReplaceSelectionFormula (strSELECT)
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo5- Module POInvoice"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ElevLoad()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSql2 As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblELEVATION WHERE Est_id = " & gintESTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
strSql2 = "DELETE * FROM tblLotElev where Lot_id = " & gintLOTID
goConn.Execute strSql2
strSql2 = "SELECT * FROM tblLotELEV" ' & gintESTID
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
oRSS.AddNew
oRSS!Lot_ID = gintLOTID
oRSS!Folder = oRS!Folder
oRSS!FileName = oRS!FileName
oRSS!Primary = oRS!Primary
oRSS.Update
oRS.MoveNext
Loop
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Form LotInfo5 - Module ElevLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Reference in New Issue View Git Blame Copy Permalink